Always include termhooks.h.
[bpt/emacs.git] / lisp / replace.el
index 24a4818..ad0c172 100644 (file)
 ;; along with GNU Emacs; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
+;;; Commentary:
+
+;; This package supplies the string and regular-expression replace functions
+;; documented in the Emacs user's manual.
+
 ;;; Code:
 
 (defconst case-replace t "\
@@ -43,10 +48,12 @@ what to do with it.  For directions, type \\[help-command] at that time.
 Preserves case in each replacement if  case-replace  and  case-fold-search
 are non-nil and FROM-STRING has no uppercase letters.
 Third arg DELIMITED (prefix arg if interactive) non-nil means replace
-only matches surrounded by word boundaries."
+only matches surrounded by word boundaries.
+
+To customize possible responses, change the \"bindings\" in `query-replace-map'."
   (interactive (query-replace-read-args "Query replace"))
   (perform-replace from-string to-string t nil arg)
-  (message "Done"))
+  (or unread-command-events (message "Done")))
 (define-key esc-map "%" 'query-replace)
 
 (defun query-replace-regexp (regexp to-string &optional arg)
@@ -62,7 +69,7 @@ In TO-STRING, \\& means insert what matched REGEXP,
 and \\=\\<n> means insert what matched <n>th \\(...\\) in REGEXP."
   (interactive (query-replace-read-args "Query replace regexp"))
   (perform-replace regexp to-string t t arg)
-  (message "Done"))
+  (or unread-command-events (message "Done")))
 
 (defun map-query-replace-regexp (regexp to-strings &optional arg)
   "Replace some matches for REGEXP with various strings, in rotation.
@@ -100,7 +107,7 @@ before rotating to the next."
          (setq replacements (append replacements (list to-strings))
                to-strings ""))))
     (perform-replace regexp replacements t t nil arg))
-  (message "Done"))
+  (or unread-command-events (message "Done")))
 
 (defun replace-string (from-string to-string &optional delimited)
   "Replace occurrences of FROM-STRING with TO-STRING.
@@ -116,7 +123,7 @@ What you probably want is a loop like this:
 which will run faster and will not set the mark or print anything."
   (interactive (query-replace-read-args "Replace string"))
   (perform-replace from-string to-string nil nil delimited)
-  (message "Done"))
+  (or unread-command-events (message "Done")))
 
 (defun replace-regexp (regexp to-string &optional delimited)
   "Replace things after point matching REGEXP with TO-STRING.
@@ -134,14 +141,19 @@ What you probably want is a loop like this:
 which will run faster and will not set the mark or print anything."
   (interactive (query-replace-read-args "Replace regexp"))
   (perform-replace regexp to-string nil t delimited)
-  (message "Done"))
+  (or unread-command-events (message "Done")))
+\f
+(defvar regexp-history nil
+  "History list for some commands that read regular expressions.")
 
-(fset 'delete-non-matching-lines 'keep-lines)
+(defalias 'delete-non-matching-lines 'keep-lines)
 (defun keep-lines (regexp)
   "Delete all lines except those containing matches for REGEXP.
 A match split across lines preserves all the lines it lies in.
 Applies to all lines after point."
-  (interactive "sKeep lines (containing match for regexp): ")
+  (interactive (list (read-from-minibuffer
+                     "Keep lines (containing match for regexp): "
+                     nil nil nil 'regexp-history)))
   (save-excursion
     (or (bolp) (forward-line 1))
     (let ((start (point)))
@@ -161,12 +173,14 @@ Applies to all lines after point."
        (and (not (eobp)) (= (match-beginning 0) (match-end 0))
             (forward-char 1))))))
 
-(fset 'delete-matching-lines 'flush-lines)
+(defalias 'delete-matching-lines 'flush-lines)
 (defun flush-lines (regexp)
   "Delete lines containing matches for REGEXP.
 If a match is split across lines, all the lines it lies in are deleted.
 Applies to lines after point."
-  (interactive "sFlush lines (containing match for regexp): ")
+  (interactive (list (read-from-minibuffer
+                     "Flush lines (containing match for regexp): "
+                     nil nil nil 'regexp-history)))
   (save-excursion
     (while (and (not (eobp))
                (re-search-forward regexp nil t))
@@ -175,10 +189,12 @@ Applies to lines after point."
                                     (point))
                     (progn (forward-line 1) (point))))))
 
-(fset 'count-matches 'how-many)
+(defalias 'count-matches 'how-many)
 (defun how-many (regexp)
   "Print number of matches for REGEXP following point."
-  (interactive "sHow many matches for (regexp): ")
+  (interactive (list (read-from-minibuffer
+                     "How many matches for (regexp): "
+                     nil nil nil 'regexp-history)))
   (let ((count 0) opoint)
     (save-excursion
      (while (and (not (eobp))
@@ -188,7 +204,7 @@ Applies to lines after point."
           (forward-char 1)
         (setq count (1+ count))))
      (message "%d occurrences" count))))
-
+\f
 (defvar occur-mode-map ())
 (if occur-mode-map
     ()
@@ -198,7 +214,6 @@ Applies to lines after point."
 (defvar occur-buffer nil)
 (defvar occur-nlines nil)
 (defvar occur-pos-list nil)
-(defvar occur-last-string "")
 
 (defun occur-mode ()
   "Major mode for output from \\[occur].
@@ -212,7 +227,8 @@ in the buffer that the occurrences were found in.
   (setq mode-name "Occur")
   (make-local-variable 'occur-buffer)
   (make-local-variable 'occur-nlines)
-  (make-local-variable 'occur-pos-list))
+  (make-local-variable 'occur-pos-list)
+  (run-hooks 'occur-mode-hook))
 
 (defun occur-mode-goto-occurrence ()
   "Go to the line this occurrence was found in, in the buffer it was found in."
@@ -235,25 +251,20 @@ in the buffer that the occurrences were found in.
                                   (+ 2 (* 2 occur-nlines)))
                                  (t 1)))))
         (pos (nth occur-number occur-pos-list)))
+    (or pos
+       (error "No occurrence on this line"))
     (pop-to-buffer occur-buffer)
     (goto-char (marker-position pos))))
-
+\f
 (defvar list-matching-lines-default-context-lines 0
   "*Default number of context lines to include around a `list-matching-lines'
 match.  A negative number means to include that many lines before the match.
 A positive number means to include that many lines both before and after.")
 
-(defvar occur-whole-buffer nil
-  "If t, occur operates on whole buffer, otherwise occur starts from point.
-default is nil.")
-
-(fset 'list-matching-lines 'occur)
+(defalias 'list-matching-lines 'occur)
 
 (defun occur (regexp &optional nlines)
-  "Show lines containing a match for REGEXP.  If the global variable
-`occur-whole-buffer' is non-nil, the entire buffer is searched, otherwise
-search begins at point.  Interactively, REGEXP defaults to the last REGEXP
-used interactively with \\[occur].
+  "Show all lines in the current buffer containing a match for REGEXP.
 
 If a match spreads across multiple lines, all those lines are shown.
 
@@ -262,12 +273,19 @@ before if NLINES is negative.
 NLINES defaults to `list-matching-lines-default-context-lines'.
 Interactively it is the prefix arg.
 
-The lines are shown in a buffer named *Occur*.
+The lines are shown in a buffer named `*Occur*'.
 It serves as a menu to find any of the occurrences in this buffer.
 \\[describe-mode] in that buffer will explain how."
-  (interactive (list (setq occur-last-string
-                          (read-string "List lines matching regexp: "
-                                       occur-last-string))
+  (interactive (list (let* ((default (car regexp-history))
+                           (input 
+                            (read-from-minibuffer
+                             (if default
+                                 (format "List lines matching regexp (default `%s'): " default)
+                               "List lines matching regexp: ")
+                             nil nil nil
+                             'regexp-history)))
+                      (if (> (length input) 0) input
+                        (setcar regexp-history default)))
                     current-prefix-arg))
   (setq nlines (if nlines (prefix-numeric-value nlines)
                 list-matching-lines-default-context-lines))
@@ -276,11 +294,10 @@ It serves as a menu to find any of the occurrences in this buffer.
        (linenum 1)
        (prevpos (point-min))
        (final-context-start (make-marker)))
-    (if (not occur-whole-buffer)
-       (save-excursion
-         (beginning-of-line)
-         (setq linenum (1+ (count-lines (point-min) (point))))
-         (setq prevpos (point))))
+;;;    (save-excursion
+;;;      (beginning-of-line)
+;;;      (setq linenum (1+ (count-lines (point-min) (point))))
+;;;      (setq prevpos (point)))
     (with-output-to-temp-buffer "*Occur*"
       (save-excursion
        (set-buffer standard-output)
@@ -294,14 +311,14 @@ It serves as a menu to find any of the occurrences in this buffer.
       (if (eq buffer standard-output)
          (goto-char (point-max)))
       (save-excursion
-       (if occur-whole-buffer
-           (beginning-of-buffer))
+       (beginning-of-buffer)
        ;; Find next match, but give up if prev match was at end of buffer.
        (while (and (not (= prevpos (point-max)))
                    (re-search-forward regexp nil t))
          (goto-char (match-beginning 0))
          (beginning-of-line)
-         (setq linenum (+ linenum (count-lines prevpos (point))))
+         (save-match-data
+           (setq linenum (+ linenum (count-lines prevpos (point)))))
          (setq prevpos (point))
          (goto-char (match-end 0))
          (let* ((start (save-excursion
@@ -353,9 +370,11 @@ It serves as a menu to find any of the occurrences in this buffer.
        (if (interactive-p)
            (message "%d matching lines." (length occur-pos-list)))))))
 \f
+;; It would be nice to use \\[...], but there is no reasonable way
+;; to make that display both SPC and Y.
 (defconst query-replace-help
   "Type Space or `y' to replace one match, Delete or `n' to skip to next,
-ESC or `q' to exit, Period to replace one match and exit,
+RET or `q' to exit, Period to replace one match and exit,
 Comma to replace but not move point immediately,
 C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
 C-w to delete match and recursive edit,
@@ -364,15 +383,44 @@ C-l to clear the screen, redisplay, and offer same replacement again,
 ^ to move point back to previous match."
   "Help message while in query-replace")
 
+(defvar query-replace-map (make-sparse-keymap)
+  "Keymap that defines the responses to questions in `query-replace'.
+The \"bindings\" in this map are not commands; they are answers.
+The valid answers include `act', `skip', `act-and-show',
+`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
+`automatic', `backup', and `help'.")
+
+(define-key query-replace-map " " 'act)
+(define-key query-replace-map "\d" 'skip)
+(define-key query-replace-map [delete] 'skip)
+(define-key query-replace-map [backspace] 'skip)
+(define-key query-replace-map "y" 'act)
+(define-key query-replace-map "n" 'skip)
+(define-key query-replace-map "," 'act-and-show)
+(define-key query-replace-map "q" 'exit)
+(define-key query-replace-map "\r" 'exit)
+(define-key query-replace-map [return] 'exit)
+(define-key query-replace-map "." 'act-and-exit)
+(define-key query-replace-map "\C-r" 'edit)
+(define-key query-replace-map "\C-w" 'delete-and-edit)
+(define-key query-replace-map "\C-l" 'recenter)
+(define-key query-replace-map "!" 'automatic)
+(define-key query-replace-map "^" 'backup)
+(define-key query-replace-map "\C-h" 'help)
+(define-key query-replace-map "?" 'help)
+(define-key query-replace-map "\C-g" 'quit)
+(define-key query-replace-map "\C-]" 'quit)
+
 (defun perform-replace (from-string replacements
                        query-flag regexp-flag delimited-flag
-                       &optional repeat-count)
+                       &optional repeat-count map)
   "Subroutine of `query-replace'.  Its complexity handles interactive queries.
 Don't use this in your own program unless you want to query and set the mark
 just as `query-replace' does.  Instead, write a simple loop like this:
   (while (re-search-forward \"foo[ \t]+bar\" nil t)
     (replace-match \"foobar\" nil nil))
 which will run faster and do exactly what you probably want."
+  (or map (setq map query-replace-map))
   (let ((nocasify (not (and case-fold-search case-replace
                            (string-equal from-string
                                          (downcase from-string)))))
@@ -399,6 +447,7 @@ which will run faster and do exactly what you probably want."
                                    "\\b")))
     (push-mark)
     (undo-boundary)
+    ;; Loop finding occurrences that perhaps should be replaced.
     (while (and keep-going
                (not (eobp))
                (funcall search-function search-string nil t)
@@ -438,57 +487,60 @@ which will run faster and do exactly what you probably want."
            (replace-match next-replacement nocasify literal)
            (setq replace-count (1+ replace-count)))
        (undo-boundary)
-       (let (done replaced)
+       (let (done replaced key def)
+         ;; Loop reading commands until one of them sets done,
+         ;; which means it has finished handling this occurrence.
          (while (not done)
-           (let ((help-form
-                  '(concat "Query replacing "
-                           (if regexp-flag "regexp " "")
-                           from-string " with " next-replacement ".\n\n"
-                           (substitute-command-keys query-replace-help))))
-             (setq char help-char)
-             (while (or (not (numberp char)) (= char help-char))
-               (message "Query replacing %s with %s: " from-string next-replacement)
-               (setq char (read-event))
-               (if (and (numberp char) (= char ??))
-                   (setq unread-command-char help-char char help-char))))
+           (message (substitute-command-keys
+                     "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
+                    from-string next-replacement)
+           (setq key (read-event))
+           (setq key (vector key))
+           (setq def (lookup-key map key))
            ;; Restore the match data while we process the command.
            (store-match-data real-match-data)
-           (cond ((or (= char ?\e)
-                      (= char ?q))
+           (cond ((eq def 'help)
+                  (with-output-to-temp-buffer "*Help*"
+                    (princ
+                     (concat "Query replacing "
+                             (if regexp-flag "regexp " "")
+                             from-string " with "
+                             next-replacement ".\n\n"
+                             (substitute-command-keys
+                              query-replace-help)))))
+                 ((eq def 'exit)
                   (setq keep-going nil)
                   (setq done t))
-                 ((= char ?^)
+                 ((eq def 'backup)
                   (let ((elt (car stack)))
                     (goto-char (car elt))
                     (setq replaced (eq t (cdr elt)))
                     (or replaced
                         (store-match-data (cdr elt)))
                     (setq stack (cdr stack))))              
-                 ((or (= char ?\ )
-                      (= char ?y))
+                 ((eq def 'act)
                   (or replaced
                       (replace-match next-replacement nocasify literal))
                   (setq done t replaced t))
-                 ((= char ?\.)
+                 ((eq def 'act-and-exit)
                   (or replaced
                       (replace-match next-replacement nocasify literal))
                   (setq keep-going nil)
                   (setq done t replaced t))
-                 ((= char ?\,)
+                 ((eq def 'act-and-show)
                   (if (not replaced)
                       (progn
                         (replace-match next-replacement nocasify literal)
                         (setq replaced t))))
-                 ((= char ?!)
+                 ((eq def 'automatic)
                   (or replaced
                       (replace-match next-replacement nocasify literal))
                   (setq done t query-flag nil replaced t))
-                 ((or (= char ?\177)
-                      (= char ?n))
+                 ((eq def 'skip)
                   (setq done t))
-                 ((= char ?\C-l)
+                 ((eq def 'recenter)
                   (recenter nil))
-                 ((= char ?\C-r)
+                 ((eq def 'edit)
                   (store-match-data
                    (prog1 (match-data)
                      (save-excursion (recursive-edit))))
@@ -497,7 +549,7 @@ which will run faster and do exactly what you probably want."
                   ;; can match again just after this match.
                   (if regexp-flag
                       (setq match-again (looking-at search-string))))
-                 ((= char ?\C-w)
+                 ((eq def 'delete-and-edit)
                   (delete-region (match-beginning 0) (match-end 0))
                   (store-match-data
                    (prog1 (match-data)
@@ -505,7 +557,9 @@ which will run faster and do exactly what you probably want."
                   (setq replaced t))
                  (t
                   (setq keep-going nil)
-                  (setq unread-command-char char)
+                  (setq unread-command-events
+                        (append (listify-key-sequence key)
+                                unread-command-events))
                   (setq done t))))
          ;; Record previous position for ^ when we move on.
          ;; Change markers to numbers in the match data
@@ -521,6 +575,6 @@ which will run faster and do exactly what you probably want."
                      stack))
          (if replaced (setq replace-count (1+ replace-count)))))
       (setq lastrepl (point)))
-    (and keep-going stack)))
+  (and keep-going stack)))
 
 ;;; replace.el ends here