diff options
Diffstat (limited to 'lisp/replace.el')
| -rw-r--r-- | lisp/replace.el | 142 |
1 files changed, 122 insertions, 20 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index eb5e0cfffcb..a1721746330 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1,4 +1,4 @@ -;;; replace.el --- replace commands for Emacs +;;; replace.el --- replace commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2016 Free ;; Software Foundation, Inc. @@ -28,6 +28,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defcustom case-replace t "Non-nil means `query-replace' should preserve case in replacements." :type 'boolean @@ -172,7 +174,7 @@ wants to replace FROM with TO." (propertize "\0" 'display query-replace-from-to-separator 'separator t))) - (query-replace-from-to-history + (minibuffer-history (append (when separator (mapcar (lambda (from-to) @@ -184,7 +186,7 @@ wants to replace FROM with TO." (minibuffer-allow-text-properties t) ; separator uses text-properties (prompt (if (and query-replace-defaults separator) - (format "%s (default %s): " prompt (car query-replace-from-to-history)) + (format "%s (default %s): " prompt (car minibuffer-history)) (format "%s: " prompt))) (from ;; The save-excursion here is in case the user marks and copies @@ -196,9 +198,9 @@ wants to replace FROM with TO." (setq-local text-property-default-nonsticky (cons '(separator . t) text-property-default-nonsticky))) (if regexp-flag - (read-regexp prompt nil 'query-replace-from-to-history) + (read-regexp prompt nil 'minibuffer-history) (read-from-minibuffer - prompt nil nil nil 'query-replace-from-to-history + prompt nil nil nil nil (car (if regexp-flag regexp-search-ring search-ring)) t))))) (to)) (if (and (zerop (length from)) query-replace-defaults) @@ -1408,7 +1410,7 @@ See also `multi-occur-in-matching-buffers'." "Next buffer to search (RET to end): ") nil t)) "")) - (add-to-list 'bufs buf) + (cl-pushnew buf bufs) (setq ido-ignore-item-temp-list bufs)) (nreverse (mapcar #'get-buffer bufs))) (occur-read-primary-args))) @@ -1835,6 +1837,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, @@ -1864,6 +1868,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) @@ -1889,7 +1895,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'.") @@ -1941,7 +1947,6 @@ type them using Lisp syntax." (defun replace-eval-replacement (expression count) (let* ((replace-count count) - err (replacement (condition-case err (eval expression) @@ -2042,7 +2047,7 @@ It is called with three arguments, as if it were `re-search-forward'.") (defun replace-search (search-string limit regexp-flag delimited-flag - case-fold-search &optional backward) + case-fold &optional backward) "Search for the next occurrence of SEARCH-STRING to replace." ;; Let-bind global isearch-* variables to values used ;; to search the next replacement. These let-bindings @@ -2061,7 +2066,7 @@ It is called with three arguments, as if it were replace-lax-whitespace) (isearch-regexp-lax-whitespace replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) + (isearch-case-fold-search case-fold) (isearch-adjusted nil) (isearch-nonincremental t) ; don't use lax word mode (isearch-forward (not backward)) @@ -2076,7 +2081,7 @@ It is called with three arguments, as if it were (defun replace-highlight (match-beg match-end range-beg range-end search-string regexp-flag delimited-flag - case-fold-search &optional backward) + case-fold &optional backward) (if query-replace-highlight (if replace-overlay (move-overlay replace-overlay match-beg match-end (current-buffer)) @@ -2091,7 +2096,7 @@ It is called with three arguments, as if it were replace-lax-whitespace) (isearch-regexp-lax-whitespace replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) + (isearch-case-fold-search case-fold) (isearch-forward (not backward)) (isearch-other-end match-beg) (isearch-error nil)) @@ -2145,6 +2150,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) @@ -2341,8 +2350,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 @@ -2355,8 +2384,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)) @@ -2367,7 +2396,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 " "") @@ -2394,6 +2424,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 @@ -2516,9 +2613,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" @@ -2544,4 +2644,6 @@ It must return a string." ""))) (or (and keep-going stack) multi-buffer))) +(provide 'replace) + ;;; replace.el ends here |