Change release version from 21.4 to 22.1 throughout.
[bpt/emacs.git] / lisp / replace.el
index e5a320d..42480b6 100644 (file)
@@ -1,7 +1,7 @@
 ;;; replace.el --- replace commands for Emacs
 
-;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000, 2001, 2002
-;;  Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001, 2002,
+;;   2003, 2004  Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 
@@ -62,34 +62,131 @@ strings or patterns."
   "*Non-nil means `query-replace' and friends ignore read-only matches."
   :type 'boolean
   :group 'matching
-  :version "21.4")
+  :version "22.1")
+
+(defcustom query-replace-highlight t
+  "*Non-nil means to highlight matches during query replacement."
+  :type 'boolean
+  :group 'matching)
+
+(defcustom query-replace-lazy-highlight t
+  "*Controls the lazy-highlighting during query replacements.
+When non-nil, all text in the buffer matching the current match
+is highlighted lazily using isearch lazy highlighting (see
+`lazy-highlight-initial-delay' and `lazy-highlight-interval')."
+  :type 'boolean
+  :group 'lazy-highlight
+  :group 'matching
+  :version "22.1")
+
+(defface query-replace
+  '((t (:inherit isearch)))
+  "Face for highlighting query replacement matches."
+  :group 'matching
+  :version "22.1")
+
+(defun query-replace-descr (string)
+  (mapconcat 'isearch-text-char-description string ""))
+
+(defun query-replace-read-from (string regexp-flag)
+  "Query and return the `from' argument of a query-replace operation.
+The return value can also be a pair (FROM . TO) indicating that the user
+wants to replace FROM with TO."
+  (if query-replace-interactive
+      (car (if regexp-flag regexp-search-ring search-ring))
+    (let* ((lastfrom (car (symbol-value query-replace-from-history-variable)))
+          (lastto (car (symbol-value query-replace-to-history-variable)))
+          (from
+           ;; The save-excursion here is in case the user marks and copies
+           ;; a region in order to specify the minibuffer input.
+           ;; That should not clobber the region for the query-replace itself.
+           (save-excursion
+             (when (equal lastfrom lastto)
+               ;; Typically, this is because the two histlists are shared.
+               (setq lastfrom (cadr (symbol-value
+                                     query-replace-from-history-variable))))
+             (read-from-minibuffer
+              (if (and lastto lastfrom)
+                  (format "%s (default %s -> %s): " string
+                          (query-replace-descr lastfrom)
+                          (query-replace-descr lastto))
+                (format "%s: " string))
+              nil nil nil
+              query-replace-from-history-variable
+              nil t t))))
+      (if (and (zerop (length from)) lastto lastfrom)
+         (cons lastfrom
+               (query-replace-compile-replacement lastto regexp-flag))
+       ;; Warn if user types \n or \t, but don't reject the input.
+       (and regexp-flag
+            (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
+            (let ((match (match-string 3 from)))
+              (cond
+               ((string= match "\\n")
+                (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
+               ((string= match "\\t")
+                (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
+              (sit-for 2)))
+       from))))
+
+(defun query-replace-compile-replacement (to regexp-flag)
+  "Maybe convert a regexp replacement TO to Lisp.
+Returns a list suitable for `perform-replace' if necessary,
+the original string if not."
+  (if (and regexp-flag
+          (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
+      (let (pos list char)
+       (while
+           (progn
+             (setq pos (match-end 0))
+             (push (substring to 0 (- pos 2)) list)
+             (setq char (aref to (1- pos))
+                   to (substring to pos))
+             (cond ((eq char ?\#)
+                    (push '(number-to-string replace-count) list))
+                   ((eq char ?\,)
+                    (setq pos (read-from-string to))
+                    (push `(replace-quote ,(car pos)) list)
+                    (let ((end
+                           ;; Swallow a space after a symbol
+                           ;; if there is a space.
+                           (if (and (or (symbolp (car pos))
+                                        ;; Swallow a space after 'foo
+                                        ;; but not after (quote foo).
+                                        (and (eq (car-safe (car pos)) 'quote)
+                                             (not (= ?\( (aref to 0)))))
+                                    (eq (string-match " " to (cdr pos))
+                                        (cdr pos)))
+                               (1+ (cdr pos))
+                             (cdr pos))))
+                      (setq to (substring to end)))))
+             (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)))
+       (setq to (nreverse (delete "" (cons to list))))
+       (replace-match-string-symbols to)
+       (cons 'replace-eval-replacement
+             (if (cdr to)
+                 (cons 'concat to)
+               (car to))))
+    to))
+
+
+(defun query-replace-read-to (from string regexp-flag)
+  "Query and return the `to' argument of a query-replace operation."
+  (query-replace-compile-replacement
+   (save-excursion
+     (read-from-minibuffer
+      (format "%s %s with: " string (query-replace-descr from))
+      nil nil nil
+      query-replace-to-history-variable from t t))
+   regexp-flag))
 
 (defun query-replace-read-args (string regexp-flag &optional noerror)
   (unless noerror
     (barf-if-buffer-read-only))
-  (let (from to)
-    (if query-replace-interactive
-       (setq from (car (if regexp-flag regexp-search-ring search-ring)))
-      (setq from (read-from-minibuffer (format "%s: " string)
-                                      nil nil nil
-                                      query-replace-from-history-variable
-                                      nil t))
-      ;; Warn if user types \n or \t, but don't reject the input.
-      (if (string-match "\\\\[nt]" from)
-         (let ((match (match-string 0 from)))
-           (cond
-            ((string= match "\\n")
-             (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
-            ((string= match "\\t")
-             (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
-           (sit-for 2))))
-
-    (setq to (read-from-minibuffer (format "%s %s with: " string from)
-                                  nil nil nil
-                                  query-replace-to-history-variable from t))
-    (if (and transient-mark-mode mark-active)
-       (list from to current-prefix-arg (region-beginning) (region-end))
-      (list from to current-prefix-arg nil nil))))
+  (let* ((from (query-replace-read-from string regexp-flag))
+        (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
+              (query-replace-read-to from string regexp-flag))))
+    (list from to current-prefix-arg)))
 
 (defun query-replace (from-string to-string &optional delimited start end)
   "Replace some occurrences of FROM-STRING with TO-STRING.
@@ -103,18 +200,29 @@ If `query-replace-interactive' is non-nil, the last incremental search
 string is used as FROM-STRING--you don't have to specify it with the
 minibuffer.
 
-Replacement transfers the case of the old text to the new text,
-if `case-replace' and `case-fold-search'
-are non-nil and FROM-STRING has no uppercase letters.
-\(Preserving case means that if the string matched is all caps, or capitalized,
-then its replacement is upcased or capitalized.)
+Matching is independent of case if `case-fold-search' is non-nil and
+FROM-STRING has no uppercase letters.  Replacement transfers the case
+pattern of the old text to the new text, if `case-replace' and
+`case-fold-search' are non-nil and FROM-STRING has no uppercase
+letters.  \(Transferring the case pattern means that if the old text
+matched is all caps, or capitalized, then its replacement is upcased
+or capitalized.)
 
 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 only matches surrounded by word boundaries.
 Fourth and fifth arg START and END specify the region to operate on.
 
 To customize possible responses, change the \"bindings\" in `query-replace-map'."
-  (interactive (query-replace-read-args "Query replace" nil))
+  (interactive (let ((common
+                     (query-replace-read-args "Query replace" nil)))
+                (list (nth 0 common) (nth 1 common) (nth 2 common)
+                      ;; These are done separately here
+                      ;; so that command-history will record these expressions
+                      ;; rather than the values they had this time.
+                      (if (and transient-mark-mode mark-active)
+                          (region-beginning))
+                      (if (and transient-mark-mode mark-active)
+                          (region-end)))))
   (perform-replace from-string to-string t nil delimited nil nil start end))
 
 (define-key esc-map "%" 'query-replace)
@@ -131,8 +239,13 @@ If `query-replace-interactive' is non-nil, the last incremental search
 regexp is used as REGEXP--you don't have to specify it with the
 minibuffer.
 
-Preserves case in each replacement if `case-replace' and `case-fold-search'
-are non-nil and REGEXP has no uppercase letters.
+Matching is independent of case if `case-fold-search' is non-nil and
+REGEXP has no uppercase letters.  Replacement transfers the case
+pattern of the old text to the new text, if `case-replace' and
+`case-fold-search' are non-nil and REGEXP has no uppercase letters.
+\(Transferring the case pattern means that if the old text matched is
+all caps, or capitalized, then its replacement is upcased or
+capitalized.)
 
 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 only matches surrounded by word boundaries.
@@ -140,9 +253,38 @@ Fourth and fifth arg START and END specify the region to operate on.
 
 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))
+whatever what matched the Nth `\\(...\\)' in REGEXP.
+`\\?' lets you edit the replacement text in the minibuffer
+at the given position for each replacement.
+
+In interactive calls, the replacement text can contain `\\,'
+followed by a Lisp expression.  Each
+replacement evaluates that expression to compute the replacement
+string.  Inside of that expression, `\\&' is a string denoting the
+whole match as a string, `\\N' for a partial match, `\\#&' and `\\#N'
+for the whole or a partial match converted to a number with
+`string-to-number', and `\\#' itself for the number of replacements
+done so far (starting with zero).
+
+If the replacement expression is a symbol, write a space after it
+to terminate it.  One space there, if any, will be discarded.
+
+When using those Lisp features interactively in the replacement
+text, TO-STRING is actually made a list instead of a string.
+Use \\[repeat-complex-command] after this command for details."
+  (interactive
+   (let ((common
+         (query-replace-read-args "Query replace regexp" t)))
+     (list (nth 0 common) (nth 1 common) (nth 2 common)
+          ;; These are done separately here
+          ;; so that command-history will record these expressions
+          ;; rather than the values they had this time.
+          (if (and transient-mark-mode mark-active)
+              (region-beginning))
+          (if (and transient-mark-mode mark-active)
+              (region-end)))))
   (perform-replace regexp to-string t t delimited nil nil start end))
+
 (define-key esc-map [?\C-%] 'query-replace-regexp)
 
 (defun query-replace-regexp-eval (regexp to-expr &optional delimited start end)
@@ -159,6 +301,7 @@ 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) to stand for whatever matched the Nth `\\(...\\)' in REGEXP.
 Use `\\#&' or `\\#N' if you want a number instead of a string.
+In interactive use, `\\#' in itself stands for `replace-count'.
 
 In Transient Mark mode, if the mark is active, operate on the contents
 of the region.  Otherwise, operate from point to the end of the buffer.
@@ -174,25 +317,28 @@ Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 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)
-     (when (and transient-mark-mode mark-active)
-       (setq start (region-beginning)
-            end (region-end)))
-     (if query-replace-interactive
-         (setq from (car regexp-search-ring))
-       (setq from (read-from-minibuffer "Query replace regexp: "
-                                        nil nil nil
-                                        query-replace-from-history-variable
-                                        nil t)))
-     (setq to (list (read-from-minibuffer
-                     (format "Query replace regexp %s with eval: " from)
-                     nil nil t query-replace-to-history-variable from t)))
+   (progn
+   (barf-if-buffer-read-only)
+   (let* ((from
+          ;; Let-bind the history var to disable the "foo -> bar" default.
+          ;; Maybe we shouldn't disable this default, but for now I'll
+          ;; leave it off.  --Stef
+          (let ((query-replace-to-history-variable nil))
+            (query-replace-read-from "Query replace regexp" t)))
+         (to (list (read-from-minibuffer
+                    (format "Query replace regexp %s with eval: "
+                            (query-replace-descr from))
+                    nil nil t query-replace-to-history-variable from t))))
      ;; 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) current-prefix-arg start end)))
+     (list from (car to) current-prefix-arg
+          (if (and transient-mark-mode mark-active)
+              (region-beginning))
+          (if (and transient-mark-mode mark-active)
+              (region-end))))))
   (perform-replace regexp (cons 'replace-eval-replacement to-expr)
-                  t t delimited nil nil start end))
+                  t 'literal delimited nil nil start end))
 
 (defun map-query-replace-regexp (regexp to-strings &optional n start end)
   "Replace some matches for REGEXP with various strings, in rotation.
@@ -215,21 +361,23 @@ A prefix argument N says to use each replacement string N times
 before rotating to the next.
 Fourth and fifth arg START and END specify the region to operate on."
   (interactive
-   (let (from to start end)
-     (when (and transient-mark-mode mark-active)
-       (setq start (region-beginning)
-            end (region-end)))
-     (setq from (if query-replace-interactive
+   (let* ((from (if query-replace-interactive
                    (car regexp-search-ring)
                  (read-from-minibuffer "Map query replace (regexp): "
                                        nil nil nil
                                        'query-replace-history nil t)))
-     (setq to (read-from-minibuffer
+         (to (read-from-minibuffer
               (format "Query replace %s with (space-separated strings): "
-                      from)
+                      (query-replace-descr from))
               nil nil nil
-              'query-replace-history from t))
-     (list from to start end current-prefix-arg)))
+              'query-replace-history from t)))
+     (list from to
+          (and current-prefix-arg
+               (prefix-numeric-value current-prefix-arg))
+          (if (and transient-mark-mode mark-active)
+              (region-beginning))
+          (if (and transient-mark-mode mark-active)
+              (region-end)))))
   (let (replacements)
     (if (listp to-strings)
        (setq replacements to-strings)
@@ -270,7 +418,14 @@ What you probably want is a loop like this:
 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))
+  (interactive
+   (let ((common
+         (query-replace-read-args "Replace string" nil)))
+     (list (nth 0 common) (nth 1 common) (nth 2 common)
+          (if (and transient-mark-mode mark-active)
+              (region-beginning))
+          (if (and transient-mark-mode mark-active)
+              (region-end)))))
   (perform-replace from-string to-string nil nil delimited nil nil start end))
 
 (defun replace-regexp (regexp to-string &optional delimited start end)
@@ -287,7 +442,27 @@ Fourth and fifth arg START and END specify the region to operate on.
 
 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.
+whatever what matched the Nth `\\(...\\)' in REGEXP.
+`\\?' lets you edit the replacement text in the minibuffer
+at the given position for each replacement.
+
+In interactive calls, the replacement text may contain `\\,'
+followed by a Lisp expression used as part of the replacement
+text.  Inside of that expression, `\\&' is a string denoting the
+whole match, `\\N' a partial matches, `\\#&' and `\\#N' the
+respective numeric values from `string-to-number', and `\\#'
+itself for `replace-count', the number of replacements occured so
+far.
+
+If your Lisp expression is an identifier and the next letter in
+the replacement string would be interpreted as part of it, you
+can wrap it with an expression like `\\,(or \\#)'.  Incidentally,
+for this particular case you may also enter `\\#' in the
+replacement text directly.
+
+When using those Lisp features interactively in the replacement
+text, TO-STRING is actually made a list instead of a string.
+Use \\[repeat-complex-command] after this command for details.
 
 If `query-replace-interactive' is non-nil, the last incremental search
 regexp is used as REGEXP--you don't have to specify it with the minibuffer.
@@ -297,7 +472,14 @@ What you probably want is a loop like this:
   (while (re-search-forward REGEXP nil t)
     (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))
+  (interactive
+   (let ((common
+         (query-replace-read-args "Replace regexp" t)))
+     (list (nth 0 common) (nth 1 common) (nth 2 common)
+          (if (and transient-mark-mode mark-active)
+              (region-beginning))
+          (if (and transient-mark-mode mark-active)
+              (region-end)))))
   (perform-replace regexp to-string nil t delimited nil nil start end))
 
 \f
@@ -332,9 +514,13 @@ 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): "))
+   (progn
+     (barf-if-buffer-read-only)
+     (keep-lines-read-args "Keep lines (containing match for regexp): ")))
   (if rstart
-      (goto-char (min rstart rend))
+      (progn
+       (goto-char (min rstart rend))
+       (setq rend (copy-marker (max rstart rend))))
     (if (and transient-mark-mode mark-active)
        (setq rstart (region-beginning)
              rend (copy-marker (region-end)))
@@ -356,7 +542,7 @@ end of the buffer."
            ;; 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)))
        ;; If the match was empty, avoid matching again at same place.
        (and (< (point) rend)
@@ -379,9 +565,13 @@ 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): "))
+   (progn
+     (barf-if-buffer-read-only)
+     (keep-lines-read-args "Flush lines (containing match for regexp): ")))
   (if rstart
-      (goto-char (min rstart rend))
+      (progn
+       (goto-char (min rstart rend))
+       (setq rend (copy-marker (max rstart rend))))
     (if (and transient-mark-mode mark-active)
        (setq rstart (region-beginning)
              rend (copy-marker (region-end)))
@@ -440,12 +630,16 @@ end of the buffer."
     (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 "\o" 'occur-mode-goto-occurrence-other-window)
+    (define-key map "o" 'occur-mode-goto-occurrence-other-window)
     (define-key map "\C-o" 'occur-mode-display-occurrence)
     (define-key map "\M-n" 'occur-next)
     (define-key map "\M-p" 'occur-prev)
+    (define-key map "r" 'occur-rename-buffer)
+    (define-key map "c" 'clone-buffer)
     (define-key map "g" 'revert-buffer)
-    (define-key map "q" 'delete-window)
+    (define-key map "q" 'quit-window)
+    (define-key map "z" 'kill-this-buffer)
+    (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
     map)
   "Keymap for `occur-mode'.")
 
@@ -453,6 +647,16 @@ end of the buffer."
   "Arguments to pass to `occur-1' to revert an Occur mode buffer.
 See `occur-revert-function'.")
 
+(defcustom occur-mode-hook '(turn-on-font-lock)
+  "Hook run when entering Occur mode."
+  :type 'hook
+  :group 'matching)
+
+(defcustom occur-hook nil
+  "Hook run when `occur' is called."
+  :type 'hook
+  :group 'matching)
+
 (put 'occur-mode 'mode-class 'special)
 (defun occur-mode ()
   "Major mode for output from \\[occur].
@@ -461,17 +665,15 @@ See `occur-revert-function'.")
 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
 
 \\{occur-mode-map}"
+  (interactive)
   (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)
-  (set (make-local-variable 'font-lock-defaults)
-       '(nil t nil nil nil
-            (font-lock-fontify-region-function . occur-fontify-region-function)))
-  (setq revert-buffer-function 'occur-revert-function)
   (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
   (make-local-variable 'occur-revert-arguments)
+  (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
+  (setq next-error-function 'occur-next-error)
   (run-hooks 'occur-mode-hook))
 
 (defun occur-revert-function (ignore1 ignore2)
@@ -526,37 +728,69 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
       (select-window window)
       (goto-char pos))))
 
-(defun occur-next (&optional n)
-  "Move to the Nth (default 1) next match in an Occur mode buffer."
-  (interactive "p")
+(defun occur-find-match (n search message)
   (if (not n) (setq n 1))
   (let ((r))
     (while (> n 0)
-      (if (get-text-property (point) 'occur-point)
-         (forward-char 1))
-      (setq r (next-single-property-change (point) 'occur-point))
+      (setq r (funcall search (point) 'occur-match))
+      (and r
+           (get-text-property r 'occur-match)
+           (setq r (funcall search r 'occur-match)))
       (if r
-         (goto-char r)
-       (error "No more matches"))
+          (goto-char r)
+        (error message))
       (setq n (1- n)))))
 
+(defun occur-next (&optional n)
+  "Move to the Nth (default 1) next match in an Occur mode buffer."
+  (interactive "p")
+  (occur-find-match n #'next-single-property-change "No more matches"))
+
 (defun occur-prev (&optional n)
   "Move to the Nth (default 1) previous match in an Occur mode buffer."
   (interactive "p")
-  (if (not n) (setq n 1))
-  (let ((r))
-    (while (> n 0)
-    
-      (setq r (get-text-property (point) 'occur-point))
-      (if r (forward-char -1))
-      
-      (setq r (previous-single-property-change (point) 'occur-point))
-      (if r
-         (goto-char (- r 1))
-       (error "No earlier matches"))
-      
-      (setq n (1- n)))))
+  (occur-find-match n #'previous-single-property-change "No earlier matches"))
+
+(defun occur-next-error (&optional argp reset)
+  "Move to the Nth (default 1) next match in an Occur mode buffer.
+Compatibility function for \\[next-error] invocations."
+  (interactive "p")
+  ;; we need to run occur-find-match from within the Occur buffer
+  (with-current-buffer
+      ;; Choose the buffer and make it current.
+      (if (next-error-buffer-p (current-buffer))
+         (current-buffer)
+       (next-error-find-buffer nil nil
+                               (lambda ()
+                                 (eq major-mode 'occur-mode))))
+
+    (goto-char (cond (reset (point-min))
+                    ((< argp 0) (line-beginning-position))
+                    ((line-end-position))))
+    (occur-find-match
+     (abs argp)
+     (if (> 0 argp)
+        #'previous-single-property-change
+       #'next-single-property-change)
+     "No more matches")
+    ;; In case the *Occur* buffer is visible in a nonselected window.
+    (set-window-point (get-buffer-window (current-buffer)) (point))
+    (occur-mode-goto-occurrence)))
 \f
+(defface match
+  '((((class color) (min-colors 88) (background light))
+     :background "Tan")
+    (((class color) (min-colors 88) (background dark))
+     :background "RoyalBlue4")
+    (((class color) (min-colors 8))
+     :background "blue" :foreground "white")
+    (((type tty) (class mono))
+     :inverse-video t)
+    (t :background "gray"))
+  "Face used to highlight matches permanently."
+  :group 'matching
+  :version "22.1")
+
 (defcustom list-matching-lines-default-context-lines 0
   "*Default number of context lines included around `list-matching-lines' matches.
 A negative number means to include that many lines before the match.
@@ -566,7 +800,7 @@ A positive number means to include that many lines both before and after."
 
 (defalias 'list-matching-lines 'occur)
 
-(defcustom list-matching-lines-face 'bold
+(defcustom list-matching-lines-face 'match
   "*Face used by \\[list-matching-lines] to show the text that matches.
 If the value is nil, don't highlight the matching portions specially."
   :type 'face
@@ -578,21 +812,26 @@ If the value is nil, don't highlight the buffer names specially."
   :type 'face
   :group 'matching)
 
-(defun occur-accumulate-lines (count &optional no-props)
+(defun occur-accumulate-lines (count &optional keep-props)
   (save-excursion
     (let ((forwardp (> count 0))
-         (result nil))
+         result beg end)
       (while (not (or (zerop count)
                      (if forwardp
                          (eobp)
                        (bobp))))
        (setq count (+ count (if forwardp -1 1)))
+       (setq beg (line-beginning-position)
+             end (line-end-position))
+       (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
+                (text-property-not-all beg end 'fontified t))
+           (if (fboundp 'jit-lock-fontify-now)
+               (jit-lock-fontify-now beg end)))
        (push
-        (funcall (if no-props
-                     #'buffer-substring-no-properties
-                   #'buffer-substring)
-         (line-beginning-position)
-         (line-end-position))
+        (funcall (if keep-props
+                     #'buffer-substring
+                   #'buffer-substring-no-properties)
+                 beg end)
         result)
        (forward-line (if forwardp 1 -1)))
       (nreverse result))))
@@ -603,18 +842,35 @@ If the value is nil, don't highlight the buffer names specially."
                (read-from-minibuffer
                 (if default
                     (format "List lines matching regexp (default `%s'): "
-                            default)
+                            (query-replace-descr default))
                   "List lines matching regexp: ")
                 nil
                 nil
                 nil
-                'regexp-history)))
+                'regexp-history
+                default)))
          (if (equal input "")
              default
            input))
        (when current-prefix-arg
          (prefix-numeric-value current-prefix-arg))))
 
+(defun occur-rename-buffer (&optional unique-p)
+  "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
+Here `original-buffer-name' is the buffer name were occur was originally run.
+When given the prefix argument, the renaming will not clobber the existing
+buffer(s) of that name, but use `generate-new-buffer-name' instead.
+You can add this to `occur-hook' if you always want a separate *Occur*
+buffer for each buffer where you invoke `occur'."
+  (interactive "P")
+  (with-current-buffer
+      (if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*"))
+    (rename-buffer (concat "*Occur: "
+                           (mapconcat #'buffer-name
+                                      (car (cddr occur-revert-arguments)) "/")
+                           "*")
+                   unique-p)))
+
 (defun occur (regexp &optional nlines)
   "Show all lines in the current buffer containing a match for REGEXP.
 
@@ -640,14 +896,19 @@ This function acts on multiple buffers; otherwise, it is exactly like
 `occur'."
   (interactive
    (cons
-    (let ((bufs (list (read-buffer "First buffer to search: "
-                                  (current-buffer) t)))
-         (buf nil))
+    (let* ((bufs (list (read-buffer "First buffer to search: "
+                                   (current-buffer) t)))
+          (buf nil)
+          (ido-ignore-item-temp-list bufs))
       (while (not (string-equal
-                  (setq buf (read-buffer "Next buffer to search (RET to end): "
-                                         nil t))
+                  (setq buf (read-buffer
+                             (if (eq read-buffer-function 'ido-read-buffer)
+                                 "Next buffer to search (C-j to end): "
+                               "Next buffer to search (RET to end): ")
+                             nil t))
                   ""))
-       (push buf bufs))
+       (add-to-list 'bufs buf)
+       (setq ido-ignore-item-temp-list bufs))
       (nreverse (mapcar #'get-buffer bufs)))
     (occur-read-primary-args)))
   (occur-1 regexp nlines bufs))
@@ -682,17 +943,20 @@ See also `multi-occur'."
 (defun occur-1 (regexp nlines bufs &optional buf-name)
   (unless buf-name
     (setq buf-name "*Occur*"))
-  (let ((occur-buf (get-buffer-create buf-name))
-       (made-temp-buf nil)
+  (let (occur-buf
        (active-bufs (delq nil (mapcar #'(lambda (buf)
                                           (when (buffer-live-p buf) buf))
                                       bufs))))
     ;; Handle the case where one of the buffers we're searching is the
-    ;; *Occur* buffer itself.
-    (when (memq occur-buf bufs)
-      (setq occur-buf (with-current-buffer occur-buf
-                       (clone-buffer "*Occur-temp*"))
-           made-temp-buf t))
+    ;; output buffer.  Just rename it.
+    (when (member buf-name (mapcar 'buffer-name active-bufs))
+      (with-current-buffer (get-buffer buf-name)
+       (rename-uniquely)))
+
+    ;; Now find or create the output buffer.
+    ;; If we just renamed that buffer, we will make a new one here.
+    (setq occur-buf (get-buffer-create buf-name))
+
     (with-current-buffer occur-buf
       (setq buffer-read-only nil)
       (occur-mode)
@@ -702,53 +966,43 @@ See also `multi-occur'."
                    (or nlines list-matching-lines-default-context-lines)
                    (and case-fold-search
                         (isearch-no-upper-case-p regexp t))
-                   nil nil nil nil)))
-       (let* ((diff (- (length bufs) (length active-bufs)))
-              (bufcount (- (length bufs) diff))
-              (msg (concat
-                    (format "Searched %d buffer%s" bufcount (if (= bufcount 1) "" "s"))
-                    "%s; "
-                    (format "%s match%s for `%s'"
-                            (if (zerop count)
-                                "no"
-                              (format "%d" count))
-                            (if (= count 1)
-                                ""
-                              "es")
-                            regexp))))
-         (message msg (if (zerop diff)
-                          ""
-                        (format " (%d killed)" diff))))
-       ;; If we had to make a temporary buffer, make it the *Occur*
-       ;; buffer now.
-       (when made-temp-buf
-         (with-current-buffer (get-buffer buf-name)
-           (kill-buffer (current-buffer)))
-         (rename-buffer buf-name))
+                   list-matching-lines-buffer-name-face
+                   nil list-matching-lines-face t)))
+       (let* ((bufcount (length active-bufs))
+              (diff (- (length bufs) bufcount)))
+         (message "Searched %d buffer%s%s; %s match%s for `%s'"
+                  bufcount (if (= bufcount 1) "" "s")
+                  (if (zerop diff) "" (format " (%d killed)" diff))
+                  (if (zerop count) "no" (format "%d" count))
+                  (if (= count 1) "" "es")
+                  regexp))
        (setq occur-revert-arguments (list regexp nlines bufs)
              buffer-read-only t)
        (if (> count 0)
-           (display-buffer occur-buf)
-         (kill-buffer occur-buf))))))
+           (progn
+             (display-buffer occur-buf)
+             (setq next-error-last-buffer occur-buf))
+         (kill-buffer occur-buf)))
+      (run-hooks 'occur-hook))))
 
 (defun occur-engine-add-prefix (lines)
   (mapcar
    #'(lambda (line)
-       (concat "      :" line "\n"))
+       (concat "       :" line "\n"))
    lines))
 
 (defun occur-engine (regexp buffers out-buf nlines case-fold-search
                            title-face prefix-face match-face keep-props)
   (with-current-buffer out-buf
     (setq buffer-read-only nil)
-    (let ((globalcount 0))
+    (let ((globalcount 0)
+         (coding nil))
       ;; Map over all the buffers
       (dolist (buf buffers)
        (when (buffer-live-p buf)
          (let ((matches 0)     ;; count of matched lines
                (lines 1)       ;; line count
                (matchbeg 0)
-               (matchend 0)
                (origpt nil)
                (begpt nil)
                (endpt nil)
@@ -757,23 +1011,31 @@ See also `multi-occur'."
                (headerpt (with-current-buffer out-buf (point))))
            (save-excursion
              (set-buffer buf)
+             (or coding
+                 ;; Set CODING only if the current buffer locally
+                 ;; binds buffer-file-coding-system.
+                 (not (local-variable-p 'buffer-file-coding-system))
+                 (setq coding buffer-file-coding-system))
              (save-excursion
                (goto-char (point-min)) ;; begin searching in the buffer
                (while (not (eobp))
                  (setq origpt (point))
                  (when (setq endpt (re-search-forward regexp nil t))
                    (setq matches (1+ matches)) ;; increment match count
-                   (setq globalcount (1+ globalcount))
-                   (setq matchbeg (match-beginning 0)
-                         matchend (match-end 0))
-                   (setq begpt (save-excursion
-                                 (goto-char matchbeg)
-                                 (line-beginning-position)))
+                   (setq matchbeg (match-beginning 0))
                    (setq lines (+ lines (1- (count-lines origpt endpt))))
+                   (save-excursion
+                     (goto-char matchbeg)
+                     (setq begpt (line-beginning-position)
+                           endpt (line-end-position)))
                    (setq marker (make-marker))
                    (set-marker marker matchbeg)
-                   (setq curstring (buffer-substring begpt
-                                                     (line-end-position)))
+                   (if (and keep-props
+                            (if (boundp 'jit-lock-mode) jit-lock-mode)
+                            (text-property-not-all begpt endpt 'fontified t))
+                       (if (fboundp 'jit-lock-fontify-now)
+                           (jit-lock-fontify-now begpt endpt)))
+                   (setq curstring (buffer-substring begpt endpt))
                    ;; Depropertize the string, and maybe
                    ;; highlight the matches
                    (let ((len (length curstring))
@@ -782,23 +1044,29 @@ See also `multi-occur'."
                        (set-text-properties 0 len nil curstring))
                      (while (and (< start len)
                                  (string-match regexp curstring start))
-                       (add-text-properties (match-beginning 0)
-                                            (match-end 0)
-                                            (append
-                                             '(occur-match t)
-                                             (when match-face
-                                               `(face ,match-face)))
-                                            curstring)
+                       (add-text-properties
+                        (match-beginning 0) (match-end 0)
+                        (append
+                         `(occur-match t)
+                         (when match-face
+                           ;; Use `face' rather than `font-lock-face' here
+                           ;; so as to override faces copied from the buffer.
+                           `(face ,match-face)))
+                        curstring)
                        (setq start (match-end 0))))
                    ;; Generate the string to insert for this match
                    (let* ((out-line
                            (concat
-                            (apply #'propertize (format "%6d:" lines)
+                            ;; Using 7 digits aligns tabs properly.
+                            (apply #'propertize (format "%7d:" lines)
                                    (append
                                     (when prefix-face
-                                      `(face prefix-face))
+                                      `(font-lock-face prefix-face))
                                     '(occur-prefix t)))
-                            curstring
+                            ;; We don't put `mouse-face' on the newline,
+                            ;; because that loses.  And don't put it
+                            ;; on context lines to reduce flicker.
+                            (propertize curstring 'mouse-face 'highlight)
                             "\n"))
                           (data
                            (if (= nlines 0)
@@ -809,9 +1077,11 @@ See also `multi-occur'."
                              ;; concatenate them all together.
                              (apply #'concat
                                     (nconc
-                                     (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ nlines)) keep-props))))
+                                     (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props))))
                                      (list out-line)
-                                     (occur-engine-add-prefix (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))))
+                                     (if (> nlines 0)
+                                         (occur-engine-add-prefix
+                                          (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))))
                      ;; Actually insert the match display data
                      (with-current-buffer out-buf
                        (let ((beg (point))
@@ -819,10 +1089,8 @@ See also `multi-occur'."
                          (unless (= nlines 0)
                            (insert "-------\n"))
                          (add-text-properties
-                          beg (1- end)
-                          `(occur-target ,marker
-                                         mouse-face highlight help-echo
-                                         "mouse-2: go to this occurrence")))))
+                          beg end
+                          `(occur-target ,marker help-echo "mouse-2: go to this occurrence")))))
                    (goto-char endpt))
                  (if endpt
                      (progn
@@ -831,47 +1099,29 @@ See also `multi-occur'."
                        (forward-line 1))
                    (goto-char (point-max))))))
            (when (not (zerop matches)) ;; is the count zero?
+             (setq globalcount (+ globalcount matches))
              (with-current-buffer out-buf
                (goto-char headerpt)
                (let ((beg (point))
                      end)
-                 (insert (format "%d lines matching \"%s\" in buffer: %s\n"
-                                 matches regexp (buffer-name buf)))
+                 (insert (format "%d match%s for \"%s\" in buffer: %s\n"
+                                 matches (if (= matches 1) "" "es")
+                                 regexp (buffer-name buf)))
                  (setq end (point))
                  (add-text-properties beg end
                                       (append
                                        (when title-face
-                                         `(face ,title-face))
+                                         `(font-lock-face ,title-face))
                                        `(occur-title ,buf))))
                (goto-char (point-min)))))))
+      (if coding
+         ;; CODING is buffer-file-coding-system of the first buffer
+         ;; that locally binds it.  Let's use it also for the output
+         ;; buffer.
+         (set-buffer-file-coding-system coding))
       ;; Return the number of matches
       globalcount)))
 
-(defun occur-fontify-on-property (prop face beg end)
-  (let ((prop-beg (or (and (get-text-property (point) prop) (point))
-                     (next-single-property-change (point) prop nil end))))
-    (when (and prop-beg (not (= prop-beg end)))
-      (let ((prop-end (next-single-property-change beg prop nil end)))
-       (when (and prop-end (not (= prop-end end)))
-         (put-text-property prop-beg prop-end 'face face)
-         prop-end)))))
-
-(defun occur-fontify-region-function (beg end &optional verbose)
-  (when verbose (message "Fontifying..."))
-  (let ((inhibit-read-only t))
-    (save-excursion
-      (dolist (e `((occur-title . ,list-matching-lines-buffer-name-face)
-                  (occur-match . ,list-matching-lines-face)))
-                  ; (occur-prefix . ,list-matching-lines-prefix-face)))
-       (goto-char beg)
-       (let ((change-end nil))
-         (while (setq change-end (occur-fontify-on-property (car e)
-                                                            (cdr e)
-                                                            (point)
-                                                            end))
-           (goto-char change-end))))))
-  (when verbose (message "Fontifying...done")))
-
 \f
 ;; It would be nice to use \\[...], but there is no reasonable way
 ;; to make that display both SPC and Y.
@@ -930,6 +1180,7 @@ N     (match-string N)           (where N is a string of digits)
 #N    (string-to-number (match-string N))
 &     (match-string 0)
 #&    (string-to-number (match-string 0))
+#     replace-count
 
 Note that these symbols must be preceeded by a backslash in order to
 type them."
@@ -949,7 +1200,9 @@ type them."
          ((string= "&" name)
           (setcar n '(match-string 0)))
          ((string= "#&" name)
-          (setcar n '(string-to-number (match-string 0))))))))
+          (setcar n '(string-to-number (match-string 0))))
+        ((string= "#" name)
+         (setcar n 'replace-count))))))
     (setq n (cdr n))))
 
 (defun replace-eval-replacement (expression replace-count)
@@ -958,6 +1211,21 @@ type them."
         replacement
       (prin1-to-string replacement t))))
 
+(defun replace-quote (replacement)
+  "Quote a replacement string.
+This just doubles all backslashes in REPLACEMENT and
+returns the resulting string.  If REPLACEMENT is not
+a string, it is first passed through `prin1-to-string'
+with the `noescape' argument set.
+
+`match-data' is preserved across the call."
+  (save-match-data
+    (replace-regexp-in-string "\\\\" "\\\\"
+                             (if (stringp replacement)
+                                 replacement
+                               (prin1-to-string replacement t))
+                             t t)))
+
 (defun replace-loop-through-replacements (data replace-count)
   ;; DATA is a vector contaning the following values:
   ;;   0 next-rotate-count
@@ -971,7 +1239,50 @@ type them."
           (aset data 2 (if (consp next) next (aref data 3))))))
   (car (aref data 2)))
 
-(defun perform-replace (from-string replacements 
+(defun replace-match-data (integers reuse &optional new)
+  "Like `match-data', but markers in REUSE get invalidated.
+If NEW is non-NIL, it is set and returned instead of fresh data,
+but coerced to the correct value of INTEGERS."
+  (or (and new
+          (progn
+            (set-match-data new)
+            (and (eq new reuse)
+                 (eq (null integers) (markerp (car reuse)))
+                 new)))
+      (match-data integers
+                 (prog1 reuse
+                   (while reuse
+                     (if (markerp (car reuse))
+                         (set-marker (car reuse) nil))
+                     (setq reuse (cdr reuse)))))))
+
+(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data)
+  "Make a replacement with `replace-match', editing `\\?'.
+NEWTEXT, FIXEDCASE, LITERAL are just passed on.  If NOEDIT is true, no
+check for `\\?' is made to save time.  MATCH-DATA is used for the
+replacement.  In case editing is done, it is changed to use markers.
+
+The return value is non-NIL if there has been no `\\?' or NOEDIT was
+passed in.  If LITERAL is set, no checking is done, anyway."
+  (unless (or literal noedit)
+    (setq noedit t)
+    (while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\?\\)"
+                        newtext)
+      (setq newtext
+           (read-input "Edit replacement string: "
+                       (prog1
+                           (cons
+                            (replace-match "" t t newtext 3)
+                            (1+ (match-beginning 3)))
+                         (setq match-data
+                               (replace-match-data
+                                nil match-data match-data))))
+           noedit nil)))
+  (set-match-data match-data)
+  (replace-match newtext fixedcase literal)
+  noedit)
+
+(defun perform-replace (from-string replacements
                        query-flag regexp-flag delimited-flag
                        &optional repeat-count map start end)
   "Subroutine of `query-replace'.  Its complexity handles interactive queries.
@@ -983,7 +1294,10 @@ just as `query-replace' does.  Instead, write a simple loop like this:
 
 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'."
+`case-replace'.
+
+This function returns nil if and only if there were no matches to
+make, or the user didn't cancel the call."
   (or map (setq map query-replace-map))
   (and query-flag minibuffer-auto-raise
        (raise-frame (window-frame (minibuffer-window))))
@@ -993,11 +1307,12 @@ see the documentation of `replace-match' to find out how to simulate
        (case-fold-search (and case-fold-search
                               (string-equal from-string
                                             (downcase from-string))))
-       (literal (not regexp-flag))
+       (literal (or (not regexp-flag) (eq regexp-flag 'literal)))
        (search-function (if regexp-flag 're-search-forward 'search-forward))
        (search-string from-string)
        (real-match-data nil)           ; the match data for the current match
        (next-replacement nil)
+       (noedit nil)
        (keep-going t)
        (stack nil)
        (replace-count 0)
@@ -1010,6 +1325,9 @@ see the documentation of `replace-match' to find out how to simulate
        ;; (match-data); otherwise it is t if a match is possible at point.
        (match-again t)
 
+       (isearch-string isearch-string)
+       (isearch-regexp isearch-regexp)
+       (isearch-case-fold-search isearch-case-fold-search)
        (message
         (if query-flag
             (substitute-command-keys
@@ -1042,19 +1360,27 @@ see the documentation of `replace-match' to find out how to simulate
                                    (if regexp-flag from-string
                                      (regexp-quote from-string))
                                    "\\b")))
+    (when query-replace-lazy-highlight
+      (setq isearch-string search-string
+           isearch-regexp (or delimited-flag regexp-flag)
+           isearch-case-fold-search case-fold-search
+           isearch-lazy-highlight-last-string nil))
+
     (push-mark)
     (undo-boundary)
     (unwind-protect
        ;; Loop finding occurrences that perhaps should be replaced.
        (while (and keep-going
-                   (not (eobp))
+                   (not (or (eobp) (and limit (>= (point) limit))))
                    ;; Use the next match if it is already known;
                    ;; otherwise, search for a match after moving forward
                    ;; one char if progress is required.
                    (setq real-match-data
                          (if (consp match-again)
                              (progn (goto-char (nth 1 match-again))
-                                    match-again)
+                                    (replace-match-data t
+                                     real-match-data
+                                     match-again))
                            (and (or match-again
                                     ;; MATCH-AGAIN non-nil means we
                                     ;; accept an adjacent match.  If
@@ -1063,11 +1389,14 @@ see the documentation of `replace-match' to find out how to simulate
                                     ;; character too far at the end,
                                     ;; but this is undone after the
                                     ;; while-loop.
-                                    (progn (forward-char 1) (not (eobp))))
+                                    (progn
+                                      (forward-char 1)
+                                      (not (or (eobp)
+                                               (and limit (>= (point) limit))))))
                                 (funcall search-function search-string limit t)
                                 ;; For speed, use only integers and
                                 ;; reuse the list used last time.
-                                (match-data t real-match-data)))))
+                                (replace-match-data t real-match-data)))))
          ;; Optionally ignore matches that have a read-only property.
          (unless (and query-replace-skip-read-only
                       (text-property-not-all
@@ -1099,23 +1428,36 @@ see the documentation of `replace-match' to find out how to simulate
              (set-match-data real-match-data)
              (setq next-replacement
                    (funcall (car replacements) (cdr replacements)
-                            replace-count)))
+                            replace-count)
+                   noedit nil))
            (if (not query-flag)
-               (let ((inhibit-read-only query-replace-skip-read-only))
-                 (set-match-data real-match-data)
-                 (replace-match next-replacement nocasify literal)
-                 (setq replace-count (1+ replace-count)))
+               (let ((inhibit-read-only
+                      query-replace-skip-read-only))
+                 (unless (or literal noedit)
+                   (replace-highlight (nth 0 real-match-data)
+                                      (nth 1 real-match-data)))
+                 (setq noedit
+                       (replace-match-maybe-edit
+                        next-replacement nocasify literal
+                        noedit real-match-data)
+                       replace-count (1+ replace-count)))
              (undo-boundary)
              (let (done replaced key def)
                ;; Loop reading commands until one of them sets done,
-               ;; which means it has finished handling this occurrence.
+               ;; which means it has finished handling this
+               ;; occurrence.  Any command that sets `done' should
+               ;; leave behind proper match data for the stack.
+               ;; Commands not setting `done' need to adjust
+               ;; `real-match-data'.
                (while (not done)
                  (set-match-data real-match-data)
                  (replace-highlight (match-beginning 0) (match-end 0))
                  ;; 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))
+                   (message message
+                             (query-replace-descr from-string)
+                             (query-replace-descr next-replacement)))
                  (setq key (read-event))
                  ;; Necessary in case something happens during read-event
                  ;; that clobbers the match data.
@@ -1139,39 +1481,50 @@ see the documentation of `replace-match' to find out how to simulate
                         (setq done t))
                        ((eq def 'backup)
                         (if stack
-                            (let ((elt (car stack)))
-                              (goto-char (car elt))
-                              (setq replaced (eq t (cdr elt)))
-                              (or replaced
-                                  (set-match-data (cdr elt)))
-                              (setq stack (cdr stack)))
+                            (let ((elt (pop stack)))
+                              (goto-char (nth 0 elt))
+                              (setq replaced (nth 1 elt)
+                                    real-match-data
+                                    (replace-match-data
+                                     t real-match-data
+                                     (nth 2 elt))))
                           (message "No previous match")
                           (ding 'no-terminate)
                           (sit-for 1)))
                        ((eq def 'act)
                         (or replaced
-                            (progn
-                              (replace-match next-replacement nocasify literal)
-                              (setq replace-count (1+ replace-count))))
+                            (setq noedit
+                                  (replace-match-maybe-edit
+                                   next-replacement nocasify literal
+                                   noedit real-match-data)
+                                  replace-count (1+ replace-count)))
                         (setq done t replaced t))
                        ((eq def 'act-and-exit)
                         (or replaced
-                            (progn
-                              (replace-match next-replacement nocasify literal)
-                              (setq replace-count (1+ replace-count))))
+                            (setq noedit
+                                  (replace-match-maybe-edit
+                                   next-replacement nocasify literal
+                                   noedit real-match-data)
+                                  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))))
+                            (setq noedit
+                                  (replace-match-maybe-edit
+                                   next-replacement nocasify literal
+                                   noedit real-match-data)
+                                  replace-count (1+ replace-count)
+                                  real-match-data (replace-match-data
+                                                   t real-match-data)
+                                  replaced t)))
                        ((eq def 'automatic)
                         (or replaced
-                            (progn
-                              (replace-match next-replacement nocasify literal)
-                              (setq replace-count (1+ replace-count))))
+                            (setq noedit
+                                  (replace-match-maybe-edit
+                                   next-replacement nocasify literal
+                                   noedit real-match-data)
+                                  replace-count (1+ replace-count)))
                         (setq done t query-flag nil replaced t))
                        ((eq def 'skip)
                         (setq done t))
@@ -1179,36 +1532,45 @@ see the documentation of `replace-match' to find out how to simulate
                         (recenter nil))
                        ((eq def 'edit)
                         (let ((opos (point-marker)))
+                          (setq real-match-data (replace-match-data
+                                                 nil real-match-data
+                                                 real-match-data))
                           (goto-char (match-beginning 0))
-                          (save-excursion
-                            (funcall search-function search-string limit t)
-                            (setq real-match-data (match-data)))
                           (save-excursion
                             (save-window-excursion
                               (recursive-edit)))
-                          (goto-char opos))
-                        (set-match-data real-match-data)
+                          (goto-char opos)
+                          (set-marker opos nil))
                         ;; Before we make the replacement,
                         ;; decide whether the search string
                         ;; can match again just after this match.
                         (if (and regexp-flag nonempty-match)
                             (setq match-again (and (looking-at search-string)
                                                    (match-data)))))
-                     
                        ;; Edit replacement.
                        ((eq def 'edit-replacement)
-                        (setq next-replacement
+                        (setq real-match-data (replace-match-data
+                                               nil real-match-data
+                                               real-match-data)
+                              next-replacement
                               (read-input "Edit replacement string: "
-                                          next-replacement))
-                        (or replaced
-                            (replace-match next-replacement nocasify literal))
+                                          next-replacement)
+                              noedit nil)
+                        (if replaced
+                            (set-match-data real-match-data)
+                          (setq noedit
+                                (replace-match-maybe-edit
+                                 next-replacement nocasify literal noedit
+                                 real-match-data)
+                                replaced t))
                         (setq done t))
-                     
+
                        ((eq def 'delete-and-edit)
-                        (delete-region (match-beginning 0) (match-end 0))
-                        (set-match-data
-                         (prog1 (match-data)
-                           (save-excursion (recursive-edit))))
+                        (replace-match "" t t)
+                        (setq real-match-data (replace-match-data
+                                               nil real-match-data))
+                        (replace-dehighlight)
+                        (save-excursion (recursive-edit))
                         (setq replaced t))
                        ;; Note: we do not need to treat `exit-prefix'
                        ;; specially here, since we reread
@@ -1219,21 +1581,43 @@ see the documentation of `replace-match' to find out how to simulate
                         (setq unread-command-events
                               (append (listify-key-sequence key)
                                       unread-command-events))
-                        (setq done t))))
+                        (setq done t)))
+                 (when query-replace-lazy-highlight
+                   ;; Restore isearch data for lazy highlighting
+                   ;; in case of isearching during recursive edit
+                   (setq isearch-string search-string
+                         isearch-regexp (or delimited-flag regexp-flag)
+                         isearch-case-fold-search case-fold-search)
+                   ;; Force lazy rehighlighting only after replacements
+                   (if (not (memq def '(skip backup)))
+                       (setq isearch-lazy-highlight-last-string nil))))
                ;; Record previous position for ^ when we move on.
                ;; Change markers to numbers in the match data
                ;; since lots of markers slow down editing.
-               (setq stack
-                     (cons (cons (point)
-                                 (or replaced (match-data t)))
-                           stack))))))
+               (push (list (point) replaced
+;;; If the replacement has already happened, all we need is the
+;;; current match start and end.  We could get this with a trivial
+;;; match like
+;;; (save-excursion (goto-char (match-beginning 0))
+;;;                (search-forward (match-string 0))
+;;;                 (match-data t))
+;;; if we really wanted to avoid manually constructing match data.
+;;; Adding current-buffer is necessary so that match-data calls can
+;;; return markers which are appropriate for editing.
+                           (if replaced
+                               (list
+                                (match-beginning 0)
+                                (match-end 0)
+                                (current-buffer))
+                             (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"
@@ -1241,28 +1625,24 @@ see the documentation of `replace-match' to find out how to simulate
                 (if (= replace-count 1) "" "s")))
     (and keep-going stack)))
 
-(defcustom query-replace-highlight t
-  "*Non-nil means to highlight words during query replacement."
-  :type 'boolean
-  :group 'matching)
-
 (defvar replace-overlay nil)
 
+(defun replace-highlight (beg end)
+  (if query-replace-highlight
+      (if replace-overlay
+         (move-overlay replace-overlay beg end (current-buffer))
+       (setq replace-overlay (make-overlay beg end))
+       (overlay-put replace-overlay 'priority 1) ;higher than lazy overlays
+       (overlay-put replace-overlay 'face 'query-replace)))
+  (if query-replace-lazy-highlight
+      (isearch-lazy-highlight-new-loop)))
+
 (defun replace-dehighlight ()
-  (and replace-overlay
-       (progn
-        (delete-overlay replace-overlay)
-        (setq replace-overlay nil))))
-
-(defun replace-highlight (start end)
-  (and query-replace-highlight
-       (progn
-        (or replace-overlay
-            (progn
-              (setq replace-overlay (make-overlay start end))
-              (overlay-put replace-overlay 'face
-                           (if (facep 'query-replace)
-                               'query-replace 'region))))
-        (move-overlay replace-overlay start end (current-buffer)))))
+  (when replace-overlay
+    (delete-overlay replace-overlay))
+  (when query-replace-lazy-highlight
+    (isearch-lazy-highlight-cleanup lazy-highlight-cleanup)
+    (setq isearch-lazy-highlight-last-string nil)))
 
+;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
 ;;; replace.el ends here