]> code.delx.au - gnu-emacs/blobdiff - lisp/replace.el
Say "standard settings" instead of "factory settings".
[gnu-emacs] / lisp / replace.el
index 40b6c01bd04f27b01d79b9f3f44fbf0d08c0f7d3..30109b87ba72f4ffe4853b85a06d9c167b5ef5a8 100644 (file)
@@ -1,6 +1,6 @@
 ;;; replace.el --- replace commands for Emacs.
 
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996 Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
@@ -15,8 +15,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
@@ -25,7 +26,7 @@
 
 ;;; Code:
 
-(defconst case-replace t "\
+(defvar case-replace t "\
 *Non-nil means query-replace should preserve case in replacements.")
 
 (defvar query-replace-history nil)
@@ -65,8 +66,7 @@ only matches surrounded by word boundaries.
 
 To customize possible responses, change the \"bindings\" in `query-replace-map'."
   (interactive (query-replace-read-args "Query replace" nil))
-  (perform-replace from-string to-string t nil arg)
-  (or unread-command-events (message "Done")))
+  (perform-replace from-string to-string t nil arg))
 (define-key esc-map "%" 'query-replace)
 
 (defun query-replace-regexp (regexp to-string &optional arg)
@@ -86,8 +86,7 @@ In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
 and `\\=\\N' (where N is a digit) stands for
  whatever what matched the Nth `\\(...\\)' in REGEXP."
   (interactive (query-replace-read-args "Query replace regexp" t))
-  (perform-replace regexp to-string t t arg)
-  (or unread-command-events (message "Done")))
+  (perform-replace regexp to-string t t arg))
 
 (defun map-query-replace-regexp (regexp to-strings &optional arg)
   "Replace some matches for REGEXP with various strings, in rotation.
@@ -129,8 +128,7 @@ before rotating to the next."
                                       (1+ (string-match " " to-strings))))
          (setq replacements (append replacements (list to-strings))
                to-strings ""))))
-    (perform-replace regexp replacements t t nil arg))
-  (or unread-command-events (message "Done")))
+    (perform-replace regexp replacements t t nil arg)))
 
 (defun replace-string (from-string to-string &optional delimited)
   "Replace occurrences of FROM-STRING with TO-STRING.
@@ -150,10 +148,11 @@ This function is usually the wrong thing to use in a Lisp program.
 What you probably want is a loop like this:
   (while (search-forward FROM-STRING nil t)
     (replace-match TO-STRING nil t))
-which will run faster and will not set the mark or print anything."
+which will run faster and will not set the mark or print anything.
+\(You may need a more complex loop if FROM-STRING can match the null string
+and TO-STRING is also null.)"
   (interactive (query-replace-read-args "Replace string" nil))
-  (perform-replace from-string to-string nil nil delimited)
-  (or unread-command-events (message "Done")))
+  (perform-replace from-string to-string nil nil delimited))
 
 (defun replace-regexp (regexp to-string &optional delimited)
   "Replace things after point matching REGEXP with TO-STRING.
@@ -174,8 +173,7 @@ What you probably want is a loop like this:
     (replace-match TO-STRING nil nil))
 which will run faster and will not set the mark or print anything."
   (interactive (query-replace-read-args "Replace regexp" t))
-  (perform-replace regexp to-string nil t delimited)
-  (or unread-command-events (message "Done")))
+  (perform-replace regexp to-string nil t delimited))
 \f
 (defvar regexp-history nil
   "History list for some commands that read regular expressions.")
@@ -244,28 +242,42 @@ Applies to lines after point."
     ()
   (setq occur-mode-map (make-sparse-keymap))
   (define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto)
-  (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence))
+  (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence)
+  (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence)
+  (define-key occur-mode-map "g" 'revert-buffer))
 
 (defvar occur-buffer nil)
 (defvar occur-nlines nil)
 (defvar occur-pos-list nil)
+(defvar occur-command-arguments nil
+  "Arguments that were given to `occur' when it made this buffer.")
 
 (defun occur-mode ()
   "Major mode for output from \\[occur].
-Move point to one of the occurrences in this buffer,
-then use \\[occur-mode-goto-occurrence] to go to the same occurrence
-in the buffer that the occurrences were found in.
-Or click \\<occur-mode-map>\\[occur-mode-mouse-goto] on an occurrence line.
+\\<occur-mode-map>Move point to one of the items in this buffer, then use
+\\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
+Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
+
 \\{occur-mode-map}"
   (kill-all-local-variables)
   (use-local-map occur-mode-map)
   (setq major-mode 'occur-mode)
   (setq mode-name "Occur")
+  (make-local-variable 'revert-buffer-function)
+  (setq revert-buffer-function 'occur-revert-function)
   (make-local-variable 'occur-buffer)
   (make-local-variable 'occur-nlines)
   (make-local-variable 'occur-pos-list)
+  (make-local-variable 'occur-command-arguments)
   (run-hooks 'occur-mode-hook))
 
+;; Handle revert-buffer for *Occur* buffers.
+(defun occur-revert-function (ignore1 ignore2)
+  (let ((args occur-command-arguments ))
+    (save-excursion
+      (set-buffer occur-buffer)
+      (apply 'occur args))))
+
 (defun occur-mode-mouse-goto (event)
   "In Occur mode, go to the occurrence whose line you click on."
   (interactive "e")
@@ -320,6 +332,10 @@ A positive number means to include that many lines both before and after.")
 
 (defalias 'list-matching-lines 'occur)
 
+(defvar list-matching-lines-face 'bold
+  "*Face used by M-x list-matching-lines to show the text that matches.
+If the value is nil, don't highlight the matching portions specially.")
+
 (defun occur (regexp &optional nlines)
   "Show all lines in the current buffer containing a match for REGEXP.
 
@@ -332,112 +348,155 @@ Interactively it is the prefix arg.
 
 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 (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))
-  (let ((first t)
+\\[describe-mode] in that buffer will explain how.
+
+If REGEXP contains upper case characters (excluding those preceded by
+\\), the matching is case-sensitive."
+  (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 (string-equal input "")
+              default
+            (set-text-properties 0 (length input) nil input)
+            input))
+        current-prefix-arg))
+  (let ((nlines (if nlines
+                   (prefix-numeric-value nlines)
+                 list-matching-lines-default-context-lines))
+       (first t)
        (buffer (current-buffer))
+       (dir default-directory)
        (linenum 1)
        (prevpos (point-min))
+       (case-fold-search  (and case-fold-search
+                               (isearch-no-upper-case-p regexp t)))
        (final-context-start (make-marker)))
 ;;;    (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)
-       ;; We will insert the number of lines, and "lines", later.
-       (insert " matching ")
-       (prin1 regexp)
-       (insert " in buffer " (buffer-name buffer) ?. ?\n)
-       (occur-mode)
-       (setq occur-buffer buffer)
-       (setq occur-nlines nlines)
-       (setq occur-pos-list ()))
-      (if (eq buffer standard-output)
-         (goto-char (point-max)))
-      (save-excursion
-       (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)
-         (save-match-data
-           (setq linenum (+ linenum (count-lines prevpos (point)))))
-         (setq prevpos (point))
-         (goto-char (match-end 0))
-         (let* ((start (save-excursion
-                         (goto-char (match-beginning 0))
-                         (forward-line (if (< nlines 0) nlines (- nlines)))
-                         (point)))
-                (end (save-excursion
-                       (goto-char (match-end 0))
-                       (if (> nlines 0)
-                           (forward-line (1+ nlines))
-                           (forward-line 1))
-                       (point)))
-                (tag (format "%3d" linenum))
-                (empty (make-string (length tag) ?\ ))
-                tem)
-           (save-excursion
-             (setq tem (make-marker))
-             (set-marker tem (point))
-             (set-buffer standard-output)
-             (setq occur-pos-list (cons tem occur-pos-list))
-             (or first (zerop nlines)
-                 (insert "--------\n"))
-             (setq first nil)
-             (insert-buffer-substring buffer start end)
-             (backward-char (- end start))
-             (setq tem nlines)
-             (while (> tem 0)
-               (insert empty ?:)
-               (forward-line 1)
-               (setq tem (1- tem)))
-             (let ((this-linenum linenum))
-               (set-marker final-context-start
-                           (+ (point) (- (match-end 0) (match-beginning 0))))
-               (while (< (point) final-context-start)
-                 (if (null tag)
-                     (setq tag (format "%3d" this-linenum)))
-                 (insert tag ?:)
-                 (put-text-property (save-excursion
-                                      (beginning-of-line)
-                                      (point))
-                                    (save-excursion
-                                      (end-of-line)
-                                      (point))
-                                    'mouse-face 'highlight)
-                 (setq tag nil)
-                 (forward-line 1)
-                 (setq this-linenum (1+ this-linenum))))
-             (while (< tem nlines)
-               (insert empty ?:)
-               (forward-line 1)
-               (setq tem (1+ tem))))                           
-           (forward-line 1)))
-       (set-buffer standard-output)
-       ;; Put positions in increasing order to go with buffer.
-       (setq occur-pos-list (nreverse occur-pos-list))
-       (goto-char (point-min))
-       (if (= (length occur-pos-list) 1)
-           (insert "1 line")
-         (insert (format "%d lines" (length occur-pos-list))))
-       (if (interactive-p)
-           (message "%d matching lines." (length occur-pos-list)))))))
+    (save-excursion
+      (goto-char (point-min))
+      ;; Check first whether there are any matches at all.
+      (if (not (re-search-forward regexp nil t))
+         (message "No matches for `%s'" regexp)
+       ;; Back up, so the search loop below will find the first match.
+       (goto-char (match-beginning 0))
+       (with-output-to-temp-buffer "*Occur*"
+         (save-excursion
+           (set-buffer standard-output)
+           (setq default-directory dir)
+           ;; We will insert the number of lines, and "lines", later.
+           (insert " matching ")
+           (let ((print-escape-newlines t))
+             (prin1 regexp))
+           (insert " in buffer " (buffer-name buffer) ?. ?\n)
+           (occur-mode)
+           (setq occur-buffer buffer)
+           (setq occur-nlines nlines)
+           (setq occur-pos-list ())
+           (setq occur-command-arguments
+                 (list regexp nlines)))
+         (if (eq buffer standard-output)
+             (goto-char (point-max)))
+         (save-excursion
+           ;; 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)
+             (save-match-data
+               (setq linenum (+ linenum (count-lines prevpos (point)))))
+             (setq prevpos (point))
+             (goto-char (match-end 0))
+             (let* ((start (save-excursion
+                             (goto-char (match-beginning 0))
+                             (forward-line (if (< nlines 0) nlines (- nlines)))
+                             (point)))
+                    (end (save-excursion
+                           (goto-char (match-end 0))
+                           (if (> nlines 0)
+                               (forward-line (1+ nlines))
+                               (forward-line 1))
+                           (point)))
+                    ;; Record where the actual match 
+                    (match-offset
+                     (save-excursion
+                       (goto-char (match-beginning 0))
+                       (beginning-of-line)
+                       ;; +6 to skip over line number
+                       (+ 6 (- (match-beginning 0) (point)))))
+                    (match-len (- (match-end 0) (match-beginning 0)))
+                    (tag (format "%5d" linenum))
+                    (empty (make-string (length tag) ?\ ))
+                    tem)
+               (save-excursion
+                 (setq tem (make-marker))
+                 (set-marker tem (point))
+                 (set-buffer standard-output)
+                 (setq occur-pos-list (cons tem occur-pos-list))
+                 (or first (zerop nlines)
+                     (insert "--------\n"))
+                 (setq first nil)
+                 (insert-buffer-substring buffer start end)
+                 (set-marker final-context-start 
+                             (- (point) (- end (match-end 0))))
+                 (goto-char (- (point) (- end start)))
+                 (setq tem nlines)
+                 (while (> tem 0)
+                   (insert empty ?:)
+                   (forward-line 1)
+                   (setq tem (1- tem)))
+                 (let ((this-linenum linenum)
+                       line-start)
+                   (while (< (point) final-context-start)
+                     (if (null tag)
+                         (setq tag (format "%5d" this-linenum)))
+                     (insert tag ?:)
+                     (setq line-start
+                           (save-excursion
+                             (beginning-of-line)
+                             (point)))
+                     (put-text-property line-start
+                                        (save-excursion
+                                          (end-of-line)
+                                          (point))
+                                        'mouse-face 'highlight)
+                     (if list-matching-lines-face
+                         (put-text-property
+                          (+ line-start match-offset)
+                          (+ line-start match-offset match-len)
+                          'face list-matching-lines-face))
+                     (forward-line 1)
+                     (setq tag nil)
+                     (setq this-linenum (1+ this-linenum)))
+                   (while (<= (point) final-context-start)
+                     (insert empty ?:)
+                     (forward-line 1)
+                     (setq this-linenum (1+ this-linenum))))
+                 (while (< tem nlines)
+                   (insert empty ?:)
+                   (forward-line 1)
+                   (setq tem (1+ tem)))
+                 (goto-char (point-max)))
+               (forward-line 1)))
+           (set-buffer standard-output)
+           ;; Put positions in increasing order to go with buffer.
+           (setq occur-pos-list (nreverse occur-pos-list))
+           (goto-char (point-min))
+           (let ((message-string
+                  (if (= (length occur-pos-list) 1)
+                      "1 line"
+                    (format "%d lines" (length occur-pos-list)))))
+             (insert message-string)
+             (if (interactive-p)
+                 (message "%s matched" message-string)))))))))
 \f
 ;; It would be nice to use \\[...], but there is no reasonable way
 ;; to make that display both SPC and Y.
@@ -478,6 +537,8 @@ The valid answers include `act', `skip', `act-and-show',
 (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 [f1] 'help)
+(define-key query-replace-map [help] 'help)
 (define-key query-replace-map "?" 'help)
 (define-key query-replace-map "\C-g" 'quit)
 (define-key query-replace-map "\C-]" 'quit)
@@ -494,6 +555,8 @@ just as `query-replace' does.  Instead, write a simple loop like this:
     (replace-match \"foobar\" nil nil))
 which will run faster and probably do exactly what you want."
   (or map (setq map query-replace-map))
+  (and query-flag minibuffer-auto-raise
+       (raise-frame (window-frame (minibuffer-window))))
   (let ((nocasify (not (and case-fold-search case-replace
                            (string-equal from-string
                                          (downcase from-string)))))
@@ -545,7 +608,8 @@ which will run faster and probably do exactly what you want."
                      t))
 
          ;; Save the data associated with the real match.
-         (setq real-match-data (match-data))
+         ;; For speed, use only integers and reuse the list used last time.
+         (setq real-match-data (match-data t real-match-data))
 
          ;; Before we make the replacement, decide whether the search string
          ;; can match again just after this match.
@@ -571,7 +635,10 @@ which will run faster and probably do exactly what you want."
              (while (not done)
                (store-match-data real-match-data)
                (replace-highlight (match-beginning 0) (match-end 0))
-               (message message from-string next-replacement)
+               ;; Bind message-log-max so we don't fill up the message log
+               ;; with a bunch of identical messages.
+               (let ((message-log-max nil))
+                 (message message from-string next-replacement))
                (setq key (read-event))
                (setq key (vector key))
                (setq def (lookup-key map key))
@@ -604,21 +671,28 @@ which will run faster and probably do exactly what you want."
                         (sit-for 1)))
                      ((eq def 'act)
                       (or replaced
-                          (replace-match next-replacement nocasify literal))
+                          (progn
+                            (replace-match next-replacement nocasify literal)
+                            (setq replace-count (1+ replace-count))))
                       (setq done t replaced t))
                      ((eq def 'act-and-exit)
                       (or replaced
-                          (replace-match next-replacement nocasify literal))
+                          (progn
+                            (replace-match next-replacement nocasify literal)
+                            (setq replace-count (1+ replace-count))))
                       (setq keep-going nil)
                       (setq done t replaced t))
                      ((eq def 'act-and-show)
                       (if (not replaced)
                           (progn
                             (replace-match next-replacement nocasify literal)
+                            (setq replace-count (1+ replace-count))
                             (setq replaced t))))
                      ((eq def 'automatic)
                       (or replaced
-                          (replace-match next-replacement nocasify literal))
+                          (progn
+                            (replace-match next-replacement nocasify literal)
+                            (setq replace-count (1+ replace-count))))
                       (setq done t query-flag nil replaced t))
                      ((eq def 'skip)
                       (setq done t))
@@ -654,17 +728,15 @@ which will run faster and probably do exactly what you want."
              ;; since lots of markers slow down editing.
              (setq stack
                    (cons (cons (point)
-                               (or replaced
-                                   (mapcar (lambda (elt)
-                                             (and elt
-                                                  (prog1 (marker-position elt)
-                                                    (set-marker elt nil))))
-                                    (match-data))))
-                         stack))
-             (if replaced (setq replace-count (1+ replace-count)))))
+                               (or replaced (match-data t)))
+                         stack))))
          (setq lastrepl (point)))
       (replace-dehighlight))
-  (and keep-going stack)))
+    (or unread-command-events
+       (message "Replaced %d occurrence%s"
+                replace-count
+                (if (= replace-count 1) "" "s")))
+    (and keep-going stack)))
 
 (defvar query-replace-highlight nil
   "*Non-nil means to highlight words during query replacement.")