Allow undoing changes while doing query-replace

* doc/lispref/searching.texi (Search and Replace): Mention
undo (bug#21684).

* lisp/replace.el (query-replace-help): Document undo.
(perform-replace): Implement undo while replacing text.

3 files changed, 121 insertions, 9 deletions

diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 1243d720bc3..644716a95c7 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1805,6 +1805,14 @@ Answer this question and all subsequent questions in the series with
 @item backup
 Move back to the previous place that a question was asked about.
 
+@item undo
+Undo last replacement and move back to the place where that
+replacement was performed.
+
+@item undo-all
+Undo all replacements and move back to the place where the first
+replacement was performed.
+
 @item edit
 Enter a recursive edit to deal with this question---instead of any
 other action that would normally be taken.
diff --git a/etc/NEWS b/etc/NEWS
index 255afde7463..cf121d0eec3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -435,6 +435,11 @@ is intended for adding to 'kill-emacs-query-functions'.
 in favor of the global `M-s h' bindings introduced in Emacs-23.1.
 They'll disappear soon.
 
++++
+** New bindings for 'query-replace-map'.
+`undo', undo the last replacement; bound to `u'.
+`undo-all', undo all replacements; bound to `U'.
+
 
 * Changes in Specialized Modes and Packages in Emacs 25.1
 
diff --git a/lisp/replace.el b/lisp/replace.el
index 488eff7928a..b7e26c96fc5 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1824,6 +1824,8 @@ C-w to delete match and recursive edit,
 C-l to clear the screen, redisplay, and offer same replacement again,
 ! to replace all remaining matches in this buffer with no more questions,
 ^ to move point back to previous match,
+u to undo previous replacement,
+U to undo all replacements,
 E to edit the replacement string.
 In multi-buffer replacements type `Y' to replace all remaining
 matches in all remaining buffers with no more questions,
@@ -1853,6 +1855,8 @@ in the current buffer."
     (define-key map "\C-l" 'recenter)
     (define-key map "!" 'automatic)
     (define-key map "^" 'backup)
+    (define-key map "u" 'undo)
+    (define-key map "U" 'undo-all)
     (define-key map "\C-h" 'help)
     (define-key map [f1] 'help)
     (define-key map [help] 'help)
@@ -1878,7 +1882,7 @@ The valid answers include `act', `skip', `act-and-show',
 `act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up',
 `scroll-down', `scroll-other-window', `scroll-other-window-down',
 `edit', `edit-replacement', `delete-and-edit', `automatic',
-`backup', `quit', and `help'.
+`backup', `undo', `undo-all', `quit', and `help'.
 
 This keymap is used by `y-or-n-p' as well as `query-replace'.")
 
@@ -2132,6 +2136,10 @@ It must return a string."
          (noedit nil)
          (keep-going t)
          (stack nil)
+         (search-string-replaced nil)    ; last string matching `from-string'
+         (next-replacement-replaced nil) ; replacement string
+                                         ; (substituted regexp)
+         (last-was-undo)
          (replace-count 0)
          (skip-read-only-count 0)
          (skip-filtered-count 0)
@@ -2328,8 +2336,28 @@ It must return a string."
                    (match-beginning 0) (match-end 0)
                    start end search-string
                    regexp-flag delimited-flag case-fold-search backward)
-                  ;; Bind message-log-max so we don't fill up the message log
-                  ;; with a bunch of identical messages.
+                  ;; Obtain the matched groups: needed only when
+                  ;; regexp-flag non nil.
+                  (when (and last-was-undo regexp-flag)
+                    (setq last-was-undo nil
+                          real-match-data
+                          (save-excursion
+                            (goto-char (match-beginning 0))
+                            (looking-at search-string)
+                            (match-data t real-match-data))))
+                  ;; Matched string and next-replacement-replaced
+                  ;; stored in stack.
+                  (setq search-string-replaced (buffer-substring-no-properties
+                                                (match-beginning 0)
+                                                (match-end 0))
+                        next-replacement-replaced
+                        (query-replace-descr
+                         (save-match-data
+                           (set-match-data real-match-data)
+                           (match-substitute-replacement
+                            next-replacement nocasify literal))))
+                  ;; Bind message-log-max so we don't fill up the
+                  ;; message log with a bunch of identical messages.
                   (let ((message-log-max nil)
                         (replacement-presentation
                          (if query-replace-show-replacement
@@ -2342,8 +2370,8 @@ It must return a string."
                              (query-replace-descr from-string)
                              (query-replace-descr replacement-presentation)))
                   (setq key (read-event))
-                  ;; Necessary in case something happens during read-event
-                  ;; that clobbers the match data.
+                  ;; Necessary in case something happens during
+                  ;; read-event that clobbers the match data.
                   (set-match-data real-match-data)
                   (setq key (vector key))
                   (setq def (lookup-key map key))
@@ -2354,7 +2382,8 @@ It must return a string."
                             (concat "Query replacing "
                                     (if delimited-flag
                                         (or (and (symbolp delimited-flag)
-                                                 (get delimited-flag 'isearch-message-prefix))
+                                                 (get delimited-flag
+                                                      'isearch-message-prefix))
                                             "word ") "")
                                     (if regexp-flag "regexp " "")
                                     (if backward "backward " "")
@@ -2381,6 +2410,73 @@ It must return a string."
                            (message "No previous match")
                            (ding 'no-terminate)
                            (sit-for 1)))
+                        ((or (eq def 'undo) (eq def 'undo-all))
+                         (if (null stack)
+                             (progn
+                               (message "Nothing to undo")
+                               (ding 'no-terminate)
+                               (sit-for 1))
+                           (let ((stack-idx         0)
+                                 (stack-len         (length stack))
+                                 (num-replacements  0)
+                                 search-string
+                                 next-replacement)
+                             (while (and (< stack-idx stack-len)
+                                         stack
+                                         (null replaced))
+                               (let* ((elt (nth stack-idx stack)))
+                                 (setq
+                                  stack-idx (1+ stack-idx)
+                                  replaced (nth 1 elt)
+                                  ;; Bind swapped values
+                                  ;; (search-string <--> replacement)
+                                  search-string (nth (if replaced 4 3) elt)
+                                  next-replacement (nth (if replaced 3 4) elt)
+                                  search-string-replaced search-string
+                                  next-replacement-replaced next-replacement)
+
+                                 (when (and (= stack-idx stack-len)
+                                            (null replaced)
+                                            (zerop num-replacements))
+                                          (message "Nothing to undo")
+                                          (ding 'no-terminate)
+                                          (sit-for 1))
+
+                                 (when replaced
+                                   (setq stack (nthcdr stack-idx stack))
+                                   (goto-char (nth 0 elt))
+                                   (set-match-data (nth 2 elt))
+                                   (setq real-match-data
+                                         (save-excursion
+                                           (goto-char (match-beginning 0))
+                                           (looking-at search-string)
+                                           (match-data t (nth 2 elt)))
+                                         noedit
+                                         (replace-match-maybe-edit
+                                          next-replacement nocasify literal
+                                          noedit real-match-data backward)
+                                         replace-count (1- replace-count)
+                                         real-match-data
+                                         (save-excursion
+                                           (goto-char (match-beginning 0))
+                                           (looking-at next-replacement)
+                                           (match-data t (nth 2 elt))))
+                                   ;; Set replaced nil to keep in loop
+                                   (when (eq def 'undo-all)
+                                     (setq replaced nil
+                                           stack-len (- stack-len stack-idx)
+                                           stack-idx 0
+                                           num-replacements
+                                           (1+ num-replacements))))))
+                             (when (and (eq def 'undo-all)
+                                        (null (zerop num-replacements)))
+                               (message "Undid %d %s" num-replacements
+                                        (if (= num-replacements 1)
+                                            "replacement"
+                                          "replacements"))
+                               (ding 'no-terminate)
+                               (sit-for 1)))
+                           (setq replaced nil last-was-undo t)))
                         ((eq def 'act)
                          (or replaced
                              (setq noedit
@@ -2503,9 +2599,12 @@ It must return a string."
                                  (match-beginning 0)
                                  (match-end 0)
                                  (current-buffer))
-                              (match-data t)))
-                      stack))))))
-
+                              (match-data t))
+                                search-string-replaced
+                                next-replacement-replaced)
+                      stack)
+                (setq next-replacement-replaced nil
+                      search-string-replaced    nil))))))
       (replace-dehighlight))
     (or unread-command-events
         (message "Replaced %d occurrence%s%s"