*** empty log message ***
[bpt/emacs.git] / lisp / replace.el
index adf5629..e0b815a 100644 (file)
@@ -1,6 +1,6 @@
-;;; replace.el --- replace commands for Emacs.
+;;; replace.el --- replace commands for Emacs
 
-;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000
+;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000, 2001
 ;;  Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
@@ -28,7 +28,7 @@
 ;;; Code:
 
 (defcustom case-replace t
-  "*Non-nil means query-replace should preserve case in replacements."
+  "*Non-nil means `query-replace' should preserve case in replacements."
   :type 'boolean
   :group 'matching)
 
@@ -39,7 +39,7 @@
 That becomes the \"string to replace\".")
 
 (defcustom query-replace-from-history-variable 'query-replace-history
-  "History list to use for the FROM argument of query-replace commands.
+  "History list to use for the FROM argument of `query-replace' commands.
 The value of this variable should be a symbol; that symbol
 is used as a variable to hold a history list for the strings
 or patterns to be replaced."
@@ -48,7 +48,7 @@ or patterns to be replaced."
   :version "20.3")
 
 (defcustom query-replace-to-history-variable 'query-replace-history
-  "History list to use for the TO argument of query-replace commands.
+  "History list to use for the TO argument of `query-replace' commands.
 The value of this variable should be a symbol; that symbol
 is used as a variable to hold a history list for replacement
 strings or patterns."
@@ -136,8 +136,8 @@ If the result of TO-EXPR is not a string, it is converted to one using
 `prin1-to-string' with the NOESCAPE argument (which see).
 
 For convenience, when entering TO-EXPR interactively, you can use `\\&' or
-`\\0'to stand for whatever matched the whole of REGEXP, and `\\=\\N' (where
-N is a digit) stands for whatever what matched the Nth `\\(...\\)' in REGEXP.
+`\0' to stand for whatever matched the whole of REGEXP, and `\N' (where
+N is a digit) to stand for whatever matched the Nth `\(...\)' in REGEXP.
 Use `\\#&' or `\\#N' if you want a number instead of a string.
 
 In Transient Mark mode, if the mark is active, operate on the contents
@@ -151,7 +151,7 @@ Preserves case in each replacement if `case-replace' and `case-fold-search'
 are non-nil and REGEXP has no uppercase letters.
 
 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries.
+only matches that are surrounded by word boundaries.
 Fourth and fifth arg START and END specify the region to operate on."
   (interactive
    (let (from to start end)
@@ -170,7 +170,7 @@ Fourth and fifth arg START and END specify the region to operate on."
      ;; We make TO a list because replace-match-string-symbols requires one,
      ;; and the user might enter a single token.
      (replace-match-string-symbols to)
-     (list from (car to) start end current-prefix-arg)))
+     (list from (car to) current-prefix-arg start end)))
   (perform-replace regexp (cons 'replace-eval-replacement to-expr)
                   start end t t delimited))
 
@@ -279,94 +279,152 @@ 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" t))
   (perform-replace regexp to-string start end nil t delimited))
+
 \f
 (defvar regexp-history nil
   "History list for some commands that read regular expressions.")
 
+
 (defalias 'delete-non-matching-lines 'keep-lines)
-(defun keep-lines (regexp)
+(defalias 'delete-matching-lines 'flush-lines)
+(defalias 'count-matches 'how-many)
+
+
+(defun keep-lines-read-args (prompt)
+  "Read arguments for `keep-lines' and friends.
+Prompt for a regexp with PROMPT.
+Value is a list, (REGEXP)."
+  (list (read-from-minibuffer prompt nil nil nil
+                             'regexp-history nil t)))
+
+(defun keep-lines (regexp &optional rstart rend)
   "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.
 
 If REGEXP contains upper case characters (excluding those preceded by `\\'),
-the matching is case-sensitive."
-  (interactive (list (read-from-minibuffer
-                     "Keep lines (containing match for regexp): "
-                     nil nil nil 'regexp-history nil t)))
+the matching is case-sensitive.
+
+Second and third arg RSTART and REND specify the region to operate on.
+
+Interactively, in Transient Mark mode when the mark is active, operate
+on the contents of the region.  Otherwise, operate from point to the
+end of the buffer."
+
+  (interactive
+   (keep-lines-read-args "Keep lines (containing match for regexp): "))
+  (if rstart
+      (goto-char (min rstart rend))
+    (if (and transient-mark-mode mark-active)
+       (setq rstart (region-beginning)
+             rend (copy-marker (region-end)))
+      (setq rstart (point)
+           rend (point-max-marker)))
+    (goto-char rstart))
   (save-excursion
     (or (bolp) (forward-line 1))
     (let ((start (point))
          (case-fold-search  (and case-fold-search
                                  (isearch-no-upper-case-p regexp t))))
-      (while (not (eobp))
+      (while (< (point) rend)
        ;; Start is first char not preserved by previous match.
-       (if (not (re-search-forward regexp nil 'move))
-           (delete-region start (point-max))
+       (if (not (re-search-forward regexp rend 'move))
+           (delete-region start rend)
          (let ((end (save-excursion (goto-char (match-beginning 0))
                                     (beginning-of-line)
                                     (point))))
            ;; Now end is first char preserved by the new match.
            (if (< start end)
                (delete-region start end))))
-       (setq start (save-excursion (forward-line 1)
-                                   (point)))
+       
+       (setq start (save-excursion (forward-line 1) (point)))
        ;; If the match was empty, avoid matching again at same place.
-       (and (not (eobp)) (= (match-beginning 0) (match-end 0))
+       (and (< (point) rend)
+            (= (match-beginning 0) (match-end 0))
             (forward-char 1))))))
 
-(defalias 'delete-matching-lines 'flush-lines)
-(defun flush-lines (regexp)
+
+(defun flush-lines (regexp &optional rstart rend)
   "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.
 
 If REGEXP contains upper case characters (excluding those preceded by `\\'),
-the matching is case-sensitive."
-  (interactive (list (read-from-minibuffer
-                     "Flush lines (containing match for regexp): "
-                     nil nil nil 'regexp-history nil t)))
+the matching is case-sensitive.
+
+Second and third arg RSTART and REND specify the region to operate on.
+
+Interactively, in Transient Mark mode when the mark is active, operate
+on the contents of the region.  Otherwise, operate from point to the
+end of the buffer."
+
+  (interactive
+   (keep-lines-read-args "Flush lines (containing match for regexp): "))
+  (if rstart
+      (goto-char (min rstart rend))
+    (if (and transient-mark-mode mark-active)
+       (setq rstart (region-beginning)
+             rend (copy-marker (region-end)))
+      (setq rstart (point)
+           rend (point-max-marker)))
+    (goto-char rstart))
   (let ((case-fold-search (and case-fold-search
                               (isearch-no-upper-case-p regexp t))))
     (save-excursion
-      (while (and (not (eobp))
-                 (re-search-forward regexp nil t))
+      (while (and (< (point) rend)
+                 (re-search-forward regexp rend t))
        (delete-region (save-excursion (goto-char (match-beginning 0))
                                       (beginning-of-line)
                                       (point))
                       (progn (forward-line 1) (point)))))))
 
-(defalias 'count-matches 'how-many)
-(defun how-many (regexp)
+
+(defun how-many (regexp &optional rstart rend)
   "Print number of matches for REGEXP following point.
 
 If REGEXP contains upper case characters (excluding those preceded by `\\'),
-the matching is case-sensitive."
-  (interactive (list (read-from-minibuffer
-                     "How many matches for (regexp): "
-                     nil nil nil 'regexp-history nil t)))
-  (let ((count 0) opoint
-       (case-fold-search  (and case-fold-search
-                               (isearch-no-upper-case-p regexp t))))
-    (save-excursion
-     (while (and (not (eobp))
-                (progn (setq opoint (point))
-                       (re-search-forward regexp nil t)))
-       (if (= opoint (point))
-          (forward-char 1)
-        (setq count (1+ count))))
-     (message "%d occurrences" count))))
+the matching is case-sensitive.
+
+Second and third arg RSTART and REND specify the region to operate on.
+
+Interactively, in Transient Mark mode when the mark is active, operate
+on the contents of the region.  Otherwise, operate from point to the
+end of the buffer."
+
+  (interactive
+   (keep-lines-read-args "How many matches for (regexp): "))
+  (save-excursion
+    (if rstart
+       (goto-char (min rstart rend))
+      (if (and transient-mark-mode mark-active)
+         (setq rstart (region-beginning)
+               rend (copy-marker (region-end)))
+       (setq rstart (point)
+             rend (point-max-marker)))
+      (goto-char rstart))
+    (let ((count 0)
+         opoint
+         (case-fold-search (and case-fold-search
+                                (isearch-no-upper-case-p regexp t))))
+      (while (and (< (point) rend)
+                 (progn (setq opoint (point))
+                        (re-search-forward regexp rend t)))
+       (if (= opoint (point))
+           (forward-char 1)
+         (setq count (1+ count))))
+      (message "%d occurrences" count))))
+
 \f
-(defvar occur-mode-map ())
-(if occur-mode-map
-    ()
-  (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-m" 'occur-mode-goto-occurrence)
-  (define-key occur-mode-map "\M-n" 'occur-next)
-  (define-key occur-mode-map "\M-p" 'occur-prev)
-  (define-key occur-mode-map "g" 'revert-buffer))
+(defvar occur-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-2] 'occur-mode-mouse-goto)
+    (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
+    (define-key map "\C-m" 'occur-mode-goto-occurrence)
+    (define-key map "\M-n" 'occur-next)
+    (define-key map "\M-p" 'occur-prev)
+    (define-key map "g" 'revert-buffer)
+    map)
+  "Keymap for `occur-mode'.")
 
 
 (defvar occur-buffer nil
@@ -381,26 +439,20 @@ the matching is case-sensitive."
 
 (put 'occur-mode 'mode-class 'special)
 
-(defun occur-mode ()
+(define-derived-mode occur-mode nil "Occur"
   "Major mode for output from \\[occur].
 \\<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)
+  (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
   (make-local-variable 'occur-buffer)
   (make-local-variable 'occur-nlines)
-  (make-local-variable 'occur-command-arguments)
-  (run-hooks 'occur-mode-hook))
+  (make-local-variable 'occur-command-arguments))
 
 (defun occur-revert-function (ignore1 ignore2)
-  "Handle revert-buffer for *Occur* buffers."
+  "Handle `revert-buffer' for *Occur* buffers."
   (let ((args occur-command-arguments ))
     (save-excursion
       (set-buffer occur-buffer)
@@ -512,24 +564,39 @@ the matching is case-sensitive."
                (setq input default))
           input)
         current-prefix-arg))
-  (let ((nlines (if nlines
-                   (prefix-numeric-value nlines)
-                 list-matching-lines-default-context-lines))
-       (first t)
-       ;;flag to prevent printing separator for first match
-       (occur-num-matches 0)
-       (buffer (current-buffer))
-       (dir default-directory)
-       (linenum 1)
-       (prevpos
-        ;;position of most recent match
-        (point-min))
-       (case-fold-search  (and case-fold-search
-                               (isearch-no-upper-case-p regexp t)))
-       (final-context-start
-        ;; Marker to the start of context immediately following
-        ;; the matched text in *Occur*.
-        (make-marker)))
+  (let* ((nlines (if nlines
+                    (prefix-numeric-value nlines)
+                  list-matching-lines-default-context-lines))
+        (current-tab-width tab-width)
+        (inhibit-read-only t)
+        ;; Minimum width of line number plus trailing colon.
+        (min-line-number-width 6)
+        ;; Width of line number prefix without the colon.  Choose a
+        ;; width that's a multiple of `tab-width' in the original
+        ;; buffer so that lines in *Occur* appear right.
+        (line-number-width (1- (* (/ (- (+ min-line-number-width
+                                           tab-width)
+                                        1)
+                                     tab-width)
+                                  tab-width)))
+        ;; Format string for line numbers.
+        (line-number-format (format "%%%dd" line-number-width))
+        (empty (make-string line-number-width ?\ ))
+        (first t)
+        ;;flag to prevent printing separator for first match
+        (occur-num-matches 0)
+        (buffer (current-buffer))
+        (dir default-directory)
+        (linenum 1)
+        (prevpos
+         ;;position of most recent match
+         (point-min))
+        (case-fold-search  (and case-fold-search
+                                (isearch-no-upper-case-p regexp t)))
+        (final-context-start
+         ;; Marker to the start of context immediately following
+         ;; the matched text in *Occur*.
+         (make-marker)))
 ;;;    (save-excursion
 ;;;      (beginning-of-line)
 ;;;      (setq linenum (1+ (count-lines (point-min) (point))))
@@ -559,7 +626,7 @@ the matching is case-sensitive."
              (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)))
+           (while (and (not (eobp))
                        (re-search-forward regexp nil t))
              (goto-char (match-beginning 0))
              (beginning-of-line)
@@ -567,32 +634,27 @@ the matching is case-sensitive."
                (setq linenum (+ linenum (count-lines prevpos (point)))))
              (setq prevpos (point))
              (goto-char (match-end 0))
-             (let* ((start
-                     ;;start point of text in source buffer to be put
-                     ;;into *Occur*
-                     (save-excursion
+             (let* (;;start point of text in source buffer to be put
+                    ;;into *Occur*
+                    (start (save-excursion
                              (goto-char (match-beginning 0))
                              (forward-line (if (< nlines 0)
                                                nlines
                                              (- nlines)))
                              (point)))
-                    (end
                      ;; end point of text in source buffer to be put
                      ;; into *Occur*
-                     (save-excursion
-                       (goto-char (match-end 0))
-                       (if (> nlines 0)
-                           (forward-line (1+ nlines))
-                         (forward-line 1))
-                       (point)))
-                    (match-beg
+                    (end (save-excursion
+                           (goto-char (match-end 0))
+                           (if (> nlines 0)
+                               (forward-line (1+ nlines))
+                             (forward-line 1))
+                           (point)))
                      ;; Amount of context before matching text
-                     (- (match-beginning 0) start))
-                    (match-len
+                    (match-beg (- (match-beginning 0) start))
                      ;; Length of matching text
-                     (- (match-end 0) (match-beginning 0)))
-                    (tag (format "%5d" linenum))
-                    (empty (make-string (length tag) ?\ ))
+                    (match-len (- (match-end 0) (match-beginning 0)))
+                    (tag (format line-number-format linenum))
                     tem
                     insertion-start
                     ;; Number of lines of context to show for current match.
@@ -605,8 +667,7 @@ the matching is case-sensitive."
                     (text-end
                      ;; Marker pointing to end of text for one match
                      ;; in *Occur*.
-                     (make-marker))
-                    )
+                     (make-marker)))
                (save-excursion
                  (setq occur-marker (make-marker))
                  (set-marker occur-marker (point))
@@ -615,6 +676,9 @@ the matching is case-sensitive."
                  (or first (zerop nlines)
                      (insert "--------\n"))
                  (setq first nil)
+                 (save-excursion
+                   (set-buffer "*Occur*")
+                   (setq tab-width current-tab-width))
 
                  ;; Insert matching text including context lines from
                  ;; source buffer into *Occur*
@@ -667,7 +731,7 @@ the matching is case-sensitive."
                  (let ((this-linenum linenum))
                    (while (< (point) final-context-start)
                      (if (null tag)
-                         (setq tag (format "%5d" this-linenum)))
+                         (setq tag (format line-number-format this-linenum)))
                      (insert tag ?:)
                      (forward-line 1)
                      (setq tag nil)
@@ -686,9 +750,10 @@ the matching is case-sensitive."
                  ;; Add text properties.  The `occur' prop is used to
                  ;; store the marker of the matching text in the
                  ;; source buffer.
-                 (put-text-property (marker-position text-beg)
-                                    (- (marker-position text-end) 1)
-                                    'mouse-face 'highlight)
+                 (add-text-properties
+                  (marker-position text-beg) (- (marker-position text-end) 1)
+                  '(mouse-face highlight
+                    help-echo "mouse-2: go to this occurence"))
                  (put-text-property (marker-position text-beg)
                                     (marker-position text-end)
                                     'occur occur-marker)
@@ -719,7 +784,7 @@ C-l to clear the screen, redisplay, and offer same replacement again,
 ! to replace all remaining matches with no more questions,
 ^ to move point back to previous match,
 E to edit the replacement string"
-  "Help message while in query-replace")
+  "Help message while in `query-replace'.")
 
 (defvar query-replace-map (make-sparse-keymap)
   "Keymap that defines the responses to questions in `query-replace'.
@@ -736,6 +801,7 @@ The valid answers include `act', `skip', `act-and-show',
 (define-key query-replace-map "n" 'skip)
 (define-key query-replace-map "Y" 'act)
 (define-key query-replace-map "N" 'skip)
+(define-key query-replace-map "e" 'edit-replacement)
 (define-key query-replace-map "E" 'edit-replacement)
 (define-key query-replace-map "," 'act-and-show)
 (define-key query-replace-map "q" 'exit)
@@ -810,9 +876,13 @@ type them."
   "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)
+
+  (while (re-search-forward \"foo[ \\t]+bar\" nil t)
     (replace-match \"foobar\" nil nil))
-which will run faster and probably do exactly what you want."
+
+which will run faster and probably do exactly what you want.  Please
+see the documentation of `replace-match' to find out how to simulate
+`case-replace'."
   (or map (setq map query-replace-map))
   (and query-flag minibuffer-auto-raise
        (raise-frame (window-frame (minibuffer-window))))
@@ -885,16 +955,13 @@ which will run faster and probably do exactly what you want."
                              (progn (goto-char (nth 1 match-again))
                                     match-again)
                            (and (or match-again
-                                    ;; MATCH-AGAIN nil means in the
-                                    ;; regexp case that there's no
-                                    ;; match adjacent to the last
-                                    ;; one.  So, we could move
-                                    ;; forward, but we don't want to
-                                    ;; because that moves point 1
-                                    ;; position after the last
-                                    ;; replacement when everything
-                                    ;; has been done.
-                                    regexp-flag
+                                    ;; MATCH-AGAIN non-nil means we
+                                    ;; accept an adjacent match.  If
+                                    ;; we don't, move one char to the
+                                    ;; right.  This takes us a
+                                    ;; character too far at the end,
+                                    ;; but this is undone after the
+                                    ;; while-loop.
                                     (progn (forward-char 1) (not (eobp))))
                                 (funcall search-function search-string limit t)
                                 ;; For speed, use only integers and
@@ -906,15 +973,20 @@ which will run faster and probably do exactly what you want."
          (setq nonempty-match
                (/= (nth 0 real-match-data) (nth 1 real-match-data)))
 
-         ;; If the match is empty, record that the next one can't be adjacent.
+         ;; If the match is empty, record that the next one can't be
+         ;; adjacent.
+
          ;; Otherwise, if matching a regular expression, do the next
          ;; match now, since the replacement for this match may
          ;; affect whether the next match is adjacent to this one.
+         ;; If that match is empty, don't use it.
          (setq match-again
                (and nonempty-match
                     (or (not regexp-flag)
                         (and (looking-at search-string)
-                             (match-data)))))
+                             (let ((match (match-data)))
+                               (and (/= (nth 0 match) (nth 1 match))
+                                    match))))))
 
          ;; Calculate the replacement string, if necessary.
          (when replacements
@@ -954,8 +1026,7 @@ which will run faster and probably do exactly what you want."
                                  next-replacement ".\n\n"
                                  (substitute-command-keys
                                   query-replace-help)))
-                        (save-excursion
-                          (set-buffer standard-output)
+                        (with-current-buffer standard-output
                           (help-mode))))
                      ((eq def 'exit)
                       (setq keep-going nil)
@@ -1048,6 +1119,13 @@ which will run faster and probably do exactly what you want."
                    (cons (cons (point)
                                (or replaced (match-data t)))
                          stack)))))
+
+      ;; The code preventing adjacent regexp matches in the condition
+      ;; of the while-loop above will haven taken us one character
+      ;; beyond the last replacement.  Undo that.
+      (when (and regexp-flag (not match-again) (> replace-count 0))
+       (backward-char 1))
+      
       (replace-dehighlight))
     (or unread-command-events
        (message "Replaced %d occurrence%s"