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.
This commit is contained in:
Tino Calancha 2016-02-24 12:35:46 +11:00 committed by Lars Ingebrigtsen
parent bbd86c5642
commit e1d749bd7e
3 changed files with 121 additions and 9 deletions

View file

@ -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.

View file

@ -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

View file

@ -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"