Initial revision

[gnu-emacs] / lisp / simple.el

diff --git a/lisp/simple.el b/lisp/simple.el
index b4eda5b4d9b287ef9b7eb469ed06fef902c662d4..dfca44cffc6968dabe2603e9141e71a679e7456f 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1040,11 +1040,18 @@ to make one entry in the kill ring."
             (eq last-command 'kill-region)
             (eq beg end)))
     ;; Don't let the undo list be truncated before we can even access it.
-    (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100)))
+    (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
+         (old-list buffer-undo-list)
+         tail)
       (delete-region beg end)
+      ;; Search back in buffer-undo-list for this string,
+      ;; in case a change hook made property changes.
+      (setq tail buffer-undo-list)
+      (while (not (stringp (car (car tail))))
+       (setq tail (cdr tail)))
       ;; Take the same string recorded for undo
       ;; and put it in the kill-ring.
-      (kill-new (car (car buffer-undo-list)))
+      (kill-new (car (car tail)))
       (setq this-command 'kill-region)))
 
    (t
@@ -1087,11 +1094,10 @@ system cut and paste."
              (goto-char opoint)
              ;; If user quit, deactivate the mark
              ;; as C-g would as a command.
-             (and quit-flag transient-mark-mode mark-active
+             (and quit-flag mark-active
                   (progn
-                    (message "foo")
-                    (setq mark-active nil)
-                    (run-hooks 'deactivate-mark-hook))))
+                    (message "foo")    ;XXX what is this here for?  --roland
+                    (deactivate-mark))))
          (let* ((killed-text (current-kill 0))
                 (message-len (min (length killed-text) 40)))
            (if (= (point) beg)
@@ -1237,6 +1243,9 @@ When the option is non-nil, deactivation of the mark
 turns off region highlighting, but commands that use the mark
 behave as if the mark were still active.")
 
+(put 'mark-inactive 'error-conditions '(mark-inactive error))
+(put 'mark-inactive 'error-message "The mark is not active now")
+
 (defun mark (&optional force)
   "Return this buffer's mark value as integer; error if mark inactive.
 If optional argument FORCE is non-nil, access the mark value
@@ -1247,7 +1256,15 @@ If you are using this in an editing command, you are most likely making
 a mistake; see the documentation of `set-mark'."
   (if (or force mark-active mark-even-if-inactive)
       (marker-position (mark-marker))
-    (error "The mark is not currently active")))
+    (signal 'mark-inactive nil)))
+
+;; Many places set mark-active directly, and several of them failed to also
+;; run deactivate-mark-hook.  This shorthand should simplify.
+(defsubst deactivate-mark ()
+  "Deactivate the mark by setting `mark-active' to nil.
+Also runs the hook `deactivate-mark-hook'."
+  (setq mark-active nil)
+  (run-hooks 'deactivate-mark-hook))
 
 (defun set-mark (pos)
   "Set this buffer's mark to POS.  Don't use this function!
@@ -1324,8 +1341,7 @@ Does not set point.  Does nothing if mark ring is empty."
       (progn
        (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
        (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
-       (if transient-mark-mode
-           (setq mark-active nil))
+       (deactivate-mark)
        (move-marker (car mark-ring) nil)
        (if (null (mark t)) (ding))
        (setq mark-ring (cdr mark-ring)))))
@@ -2139,10 +2155,7 @@ in the mode line."
 During execution of Lisp code, this character causes a quit directly.
 At top-level, as an editor command, this simply beeps."
   (interactive)
-  (and transient-mark-mode mark-active
-       (progn
-        (setq mark-active nil)
-        (run-hooks 'deactivate-mark-hook)))
+  (deactivate-mark)
   (signal 'quit nil))
 
 (define-key global-map "\C-g" 'keyboard-quit)
@@ -2182,4 +2195,30 @@ it were the arg to `interactive' (which see) to interactively read the value."
               (eval-minibuffer (format "Set %s to value: " var)))))))
   (set var val))
 
+\f
+;;;; Keypad support.
+
+;;; Make the keypad keys act like ordinary typing keys.  If people add
+;;; bindings for the function key symbols, then those bindings will
+;;; override these, so this shouldn't interfere with any existing
+;;; bindings.
+
+(mapcar
+ (lambda (keypad-normal)
+   (let ((keypad (nth 0 keypad-normal))
+        (normal (nth 1 keypad-normal)))
+     (define-key function-key-map (vector keypad) (vector normal))))
+ '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
+   (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
+   (kp-space ?\ )
+   (kp-tab ?\t)
+   (kp-enter ?\r)
+   (kp-multiply ?*)
+   (kp-add ?+)
+   (kp-separator ?,)
+   (kp-subtract ?-)
+   (kp-decimal ?.)
+   (kp-divide ?/)
+   (kp-equal ?=)))
+
 ;;; simple.el ends here