Initial revision
[bpt/emacs.git] / lisp / simple.el
index eca0b98..72bca14 100644 (file)
@@ -297,7 +297,7 @@ it is usually a mistake for a Lisp function to use any subroutine
 that uses or sets the mark."
   (interactive)
   (push-mark (point))
-  (push-mark (point-max))
+  (push-mark (point-max) nil t)
   (goto-char (point-min)))
 
 (defun count-lines-region (start end)
@@ -478,13 +478,18 @@ contains expressions rather than strings.")
 With prefix argument N, search for Nth previous match.
 If N is negative, find the next or Nth next match."
   (interactive
-   (let ((enable-recursive-minibuffers t)
-        (minibuffer-history-sexp-flag nil))
-     (list (read-from-minibuffer "Previous element matching (regexp): "
-                                nil
-                                minibuffer-local-map
-                                nil
-                                'minibuffer-history-search-history)
+   (let* ((enable-recursive-minibuffers t)
+         (minibuffer-history-sexp-flag nil)
+         (regexp (read-from-minibuffer "Previous element matching (regexp): "
+                                       nil
+                                       minibuffer-local-map
+                                       nil
+                                       'minibuffer-history-search-history)))
+     ;; Use the last regexp specified, by default, if input is empty.
+     (list (if (string= regexp "")
+              (setcar minibuffer-history-search-history
+                      (nth 1 minibuffer-history-search-history))
+            regexp)
           (prefix-numeric-value current-prefix-arg))))
   (let ((history (symbol-value minibuffer-history-variable))
        prevpos
@@ -518,13 +523,18 @@ If N is negative, find the next or Nth next match."
 With prefix argument N, search for Nth next match.
 If N is negative, find the previous or Nth previous match."
   (interactive
-   (let ((enable-recursive-minibuffers t)
-        (minibuffer-history-sexp-flag nil))
-     (list (read-from-minibuffer "Next element matching (regexp): "
-                                nil
-                                minibuffer-local-map
-                                nil
-                                'minibuffer-history-search-history)
+   (let* ((enable-recursive-minibuffers t)
+         (minibuffer-history-sexp-flag nil)
+         (regexp (read-from-minibuffer "Next element matching (regexp): "
+                                       nil
+                                       minibuffer-local-map
+                                       nil
+                                       'minibuffer-history-search-history)))
+     ;; Use the last regexp specified, by default, if input is empty.
+     (list (if (string= regexp "")
+              (setcar minibuffer-history-search-history
+                      (nth 1 minibuffer-history-search-history))
+            regexp)
           (prefix-numeric-value current-prefix-arg))))
   (previous-matching-history-element regexp (- n)))
 
@@ -598,6 +608,9 @@ A numeric argument serves as a repeat count."
     (and modified (not (buffer-modified-p))
         (delete-auto-save-file-if-necessary))))
 
+(defvar pending-undo-list nil
+  "Within a run of consecutive undo commands, list remaining to be undone.")
+
 (defun undo-start ()
   "Set `pending-undo-list' to the front of the undo list.
 The next call to `undo-more' will undo the most recently made change."
@@ -635,7 +648,12 @@ This cannot be done asynchronously."
             ;; aliases for shell commands then they can still have them.
             (call-process shell-file-name nil t nil
                           "-c" command)
-            (exchange-point-and-mark))
+            ;; This is like exchange-point-and-mark, but doesn't activate the mark.
+            ;; It is cleaner to avoid activation, even though the command
+            ;; loop would deactivate the mark because we inserted text.
+            (goto-char (prog1 (mark t)
+                         (set-marker (mark-marker) (point)
+                                     (current-buffer)))))
     ;; Preserve the match data in case called from a program.
     (let ((data (match-data)))
       (unwind-protect
@@ -882,20 +900,23 @@ when given no argument at the beginning of a line."
   "Function to call to make a killed region available to other programs.
 
 Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.  On startup,
-this variable is set to a function which emacs will call whenever text
-is put in the kill ring to make the new kill available to other
+pasting text between the windows of different programs.
+This variable holds a function that Emacs calls whenever text
+is put in the kill ring, to make the new kill available to other
 programs.
 
-The function takes one argument, TEXT, which is a string containing
-the text which should be made available.")
+The function takes one or two arguments.
+The first argument, TEXT, is a string containing
+the text which should be made available.
+The second, PUSH, if non-nil means this is a \"new\" kill;
+nil means appending to an \"old\" kill.")
 
 (defvar interprogram-paste-function nil
   "Function to call to get text cut from other programs.
 
 Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.  On startup,
-this variable is set to a function which emacs will call to obtain
+pasting text between the windows of different programs.
+This variable holds a function that Emacs calls to obtain
 text that other programs have provided for pasting.
 
 The function should be called with no arguments.  If the function
@@ -939,7 +960,7 @@ If `interprogram-cut-function' is non-nil, apply it to STRING."
       (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
   (setq kill-ring-yank-pointer kill-ring)
   (if interprogram-cut-function
-      (funcall interprogram-cut-function string)))
+      (funcall interprogram-cut-function string t)))
 
 (defun kill-append (string before-p)
   "Append STRING to the end of the latest kill in the kill ring.
@@ -1049,20 +1070,35 @@ system cut and paste."
   (interactive "r")
   (copy-region-as-kill beg end)
   (if (interactive-p)
-      (save-excursion
-       (let ((other-end (if (= (point) beg) end beg)))
-         (if (pos-visible-in-window-p other-end (selected-window))
-             (progn
-               (goto-char other-end)
-               (sit-for 1))
-           (let* ((killed-text (current-kill 0))
-                  (message-len (min (length killed-text) 40)))
-             (if (= (point) beg)
-                 ;; Don't say "killed"; that is misleading.
-                 (message "Saved text until \"%s\""
-                         (substring killed-text (- message-len)))
-               (message "Saved text from \"%s\""
-                       (substring killed-text 0 message-len)))))))))
+      (let ((other-end (if (= (point) beg) end beg))
+           (opoint (point))
+           ;; Inhibit quitting so we can make a quit here
+           ;; look like a C-g typed as a command.
+           (inhibit-quit t))
+       (if (pos-visible-in-window-p other-end (selected-window))
+           (progn
+             ;; Swap point and mark.
+             (set-marker (mark-marker) (point) (current-buffer))
+             (goto-char other-end)
+             (sit-for 1)
+             ;; Swap back.
+             (set-marker (mark-marker) other-end (current-buffer))
+             (goto-char opoint)
+             ;; If user quit, deactivate the mark
+             ;; as C-g would as a command.
+             (and quit-flag transient-mark-mode mark-active
+                  (progn
+                    (message "foo")
+                    (setq mark-active nil)
+                    (run-hooks 'deactivate-mark-hook))))
+         (let* ((killed-text (current-kill 0))
+                (message-len (min (length killed-text) 40)))
+           (if (= (point) beg)
+               ;; Don't say "killed"; that is misleading.
+               (message "Saved text until \"%s\""
+                       (substring killed-text (- message-len)))
+             (message "Saved text from \"%s\""
+                     (substring killed-text 0 message-len))))))))
 
 (defun append-next-kill ()
   "Cause following command, if it kills, to append to previous kill."
@@ -1090,11 +1126,16 @@ comes the newest one."
   (if (not (eq last-command 'yank))
       (error "Previous command was not a yank"))
   (setq this-command 'yank)
-  (let ((before (< (point) (mark))))
-    (delete-region (point) (mark))
-    (set-mark (point))
+  (let ((before (< (point) (mark t))))
+    (delete-region (point) (mark t))
+    (set-marker (mark-marker) (point) (current-buffer))
     (insert (current-kill arg))
-    (if before (exchange-point-and-mark)))
+    (if before
+       ;; This is like exchange-point-and-mark, but doesn't activate the mark.
+       ;; It is cleaner to avoid activation, even though the command
+       ;; loop would deactivate the mark because we inserted text.
+       (goto-char (prog1 (mark t)
+                    (set-marker (mark-marker) (point) (current-buffer))))))
   nil)
 
 (defun yank (&optional arg)
@@ -1112,7 +1153,11 @@ See also the command \\[yank-pop]."
                         ((eq arg '-) -1)
                         (t (1- arg)))))
   (if (consp arg)
-      (exchange-point-and-mark))
+      ;; This is like exchange-point-and-mark, but doesn't activate the mark.
+      ;; It is cleaner to avoid activation, even though the command
+      ;; loop would deactivate the mark because we inserted text.
+      (goto-char (prog1 (mark t)
+                  (set-marker (mark-marker) (point) (current-buffer)))))
   nil)
 
 (defun rotate-yank-pointer (arg)
@@ -1232,18 +1277,22 @@ Novice Emacs Lisp programmers often try to use the mark for the wrong
 purposes.  See the documentation of `set-mark' for more information."
   (interactive "P")
   (if (null arg)
-      (push-mark)
+      (progn
+       (push-mark nil nil t))
     (if (null (mark t))
        (error "No mark set in this buffer")
-      (goto-char (mark))
+      (goto-char (mark t))
       (pop-mark))))
 
-(defun push-mark (&optional location nomsg)
+(defun push-mark (&optional location nomsg activate)
   "Set mark at LOCATION (point, by default) and push old mark on mark ring.
-Displays \"Mark set\" unless the optional second arg NOMSG is non-nil.
+Display `Mark set' unless the optional second arg NOMSG is non-nil.
+In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
 
 Novice Emacs Lisp programmers often try to use the mark for the wrong
-purposes.  See the documentation of `set-mark' for more information."
+purposes.  See the documentation of `set-mark' for more information.
+
+In Transient Mark mode, this does not activate the mark."
   (if (null (mark t))
       nil
     (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
@@ -1251,9 +1300,11 @@ purposes.  See the documentation of `set-mark' for more information."
        (progn
          (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
          (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
-  (set-mark (or location (point)))
+  (set-marker (mark-marker) (or location (point)) (current-buffer))
   (or nomsg executing-macro (> (minibuffer-depth) 0)
       (message "Mark set"))
+  (if (or activate (not transient-mark-mode))
+      (set-mark (mark t)))
   nil)
 
 (defun pop-mark ()
@@ -1262,9 +1313,11 @@ Does not set point.  Does nothing if mark ring is empty."
   (if mark-ring
       (progn
        (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
-       (set-mark (+ 0 (car mark-ring)))
+       (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
+       (if transient-mark-mode
+           (setq mark-active nil))
        (move-marker (car mark-ring) nil)
-       (if (null (mark)) (ding))
+       (if (null (mark t)) (ding))
        (setq mark-ring (cdr mark-ring)))))
 
 (define-function 'exchange-dot-and-mark 'exchange-point-and-mark)
@@ -1279,6 +1332,18 @@ and it reactivates the mark."
     (set-mark (point))
     (goto-char omark)
     nil))
+
+(defun transient-mark-mode (arg)
+  "Toggle Transient Mark mode.
+With arg, turn Transient Mark mode on if arg is positive, off otherwise.
+
+In Transient Mark mode, changing the buffer \"deactivates\" the mark.
+While the mark is active, the region is highlighted."
+  (interactive "P")
+  (setq transient-mark-mode
+       (if (null arg)
+           (not transient-mark-mode)
+         (> (prefix-numeric-value arg) 0))))
 \f
 (defvar next-line-add-newlines t
   "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error.")
@@ -1728,7 +1793,8 @@ In programs, it is faster to call `forward-word' with negative arg."
   (push-mark
     (save-excursion
       (forward-word arg)
-      (point))))
+      (point))
+    nil t))
 
 (defun kill-word (arg)
   "Kill characters forward until encountering the end of a word.
@@ -1986,9 +2052,8 @@ in the mode line."
 (defvar blink-matching-paren t
   "*Non-nil means show matching open-paren when close-paren is inserted.")
 
-(defconst blink-matching-paren-distance 4000
-  "*If non-nil, is maximum distance to search for matching open-paren
-when close-paren is inserted.")
+(defconst blink-matching-paren-distance 12000
+  "*If non-nil, is maximum distance to search for matching open-paren.")
 
 (defun blink-matching-open ()
   "Move cursor momentarily to the beginning of the sexp before point."
@@ -2044,13 +2109,18 @@ when close-paren is inserted.")
 ;Turned off because it makes dbx bomb out.
 (setq blink-paren-function 'blink-matching-open)
 
-; this is just something for the luser to see in a keymap -- this is not
-;  how quitting works normally!
+;; This executes C-g typed while Emacs is waiting for a command.
+;; Quitting out of a program does not go through here;
+;; that happens in the QUIT macro at the C code level.
 (defun keyboard-quit ()
   "Signal a  quit  condition.
 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)))
   (signal 'quit nil))
 
 (define-key global-map "\C-g" 'keyboard-quit)