master 765411f0cd6: Preview the replacement text while it is typed (bug#81583)
Juri Linkov <[email protected]>
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: master commit 765411f0cd6ffcf532ee94f6add602771ef189ae Author: Rahul Martim Juliato <[email protected]> Commit: Juri Linkov <[email protected]> Preview the replacement text while it is typed (bug#81583) * lisp/replace.el (query-replace-show-preview): New user option. (query-replace-preview): New face. (query-replace-eval-replacement-regexp): New constant, extracted from... (query-replace-compile-replacement): ...here. (replace-preview-overlays): New variable. (replace-preview-cleanup, replace-preview-update) (replace-preview-setup): New functions. (query-replace-read-to): New optional argument DELIMITED-FLAG. (query-replace-read-args): Pass the delimited flag to 'query-replace-read-to'. * lisp/isearch.el (isearch-query-replace): Pass the delimited flag to 'query-replace-read-to'. * test/lisp/replace-tests.el (replace-tests--preview): New helper. (replace-tests-preview-update, replace-tests-preview-cleanup) (replace-tests-preview-disabled): New tests. * doc/emacs/search.texi (Replace): Document the preview. * etc/NEWS: Announce it. --- doc/emacs/search.texi | 11 ++++ etc/NEWS | 8 +++ lisp/isearch.el | 2 +- lisp/replace.el | 152 ++++++++++++++++++++++++++++++++++++++++++--- test/lisp/replace-tests.el | 49 +++++++++++++++ 5 files changed, 212 insertions(+), 10 deletions(-) diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 314f1de8e83..38ce36ee017 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1564,6 +1564,17 @@ instead (@pxref{Mark}). The basic replace commands replace one is possible to perform several replacements in parallel, using the command @code{expand-region-abbrevs} (@pxref{Expanding Abbrevs}). +@cindex preview of replacement text +@cindex @code{query-replace-preview} face +@vindex query-replace-show-preview + If you set @code{query-replace-show-preview} to a non-@code{nil} +value, the replace commands preview the replacement while you type it: +the matches visible in the window are displayed as they would look +after the replacement, using the face @code{query-replace-preview}. +This tells you what back-references like @samp{\1} (@pxref{Regexp +Replace}) expand to before you commit to the edit. Replacements that +use @samp{\,} or @samp{\#} are not previewed. + @menu * Unconditional Replace:: Replacing all matches for a string. * Regexp Replace:: Replacing all matches for a regexp. diff --git a/etc/NEWS b/etc/NEWS index 0456354feac..a9628a32e1e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -110,6 +110,14 @@ to your initialization file no longer apply, and you may remove it. * Editing Changes in Emacs 32.1 ++++ +** New user option 'query-replace-show-preview'. +When set to t, the replacement commands preview the replacement while +you type it: the matches visible in the window are shown as they would +look after the replacement, using the new face 'query-replace-preview'. +This tells you what back-references like '\1' expand to before you +commit to the edit. The preview is off by default. + * Changes in Specialized Modes and Packages in Emacs 32.1 diff --git a/lisp/isearch.el b/lisp/isearch.el index 3d594c72780..0b4acfc589f 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2450,7 +2450,7 @@ type \\[help-command] at that time." (isearch--describe-regexp-mode (or delimited isearch-regexp-function) t) (if backward " backward" "") (if (use-region-p) " in region" "")) - isearch-regexp) + isearch-regexp (or delimited isearch-regexp-function)) t isearch-regexp (or delimited isearch-regexp-function) nil nil (use-region-beginning) (use-region-end) backward)) diff --git a/lisp/replace.el b/lisp/replace.el index be8b4d1baff..0101978439f 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -114,6 +114,16 @@ This variable affects only `query-replace-regexp'." :group 'matching :version "23.1") +(defcustom query-replace-show-preview nil + "Non-nil means preview the replacement while you type it. +The matches visible in the window are shown as they would look after +the replacement, using the `query-replace-preview' face. This tells +you what back-references like \\1 expand to before you commit to the +edit. Replacements that use \\, or \\# are never previewed." + :type 'boolean + :group 'matching + :version "32.1") + (defcustom query-replace-highlight t "Non-nil means to highlight matches during query replacement." :type 'boolean @@ -151,6 +161,14 @@ when `query-replace-highlight' is non-nil" :group 'matching :version "22.1") +(defface query-replace-preview + '((t (:inherit query-replace))) + "Face for the preview of the replacement text. +Used while reading the replacement string of `query-replace' and +friends when `query-replace-show-preview' is non-nil." + :group 'matching + :version "32.1") + (defvar replace-count 0 "Number of replacements done so far. See `replace-regexp'.") @@ -298,13 +316,19 @@ wants to replace FROM with TO." (add-to-history 'query-replace-defaults (cons from to) nil t) (cons from (query-replace-compile-replacement to regexp-flag)))))) +(defconst query-replace-eval-replacement-regexp + "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" + "Regexp matching a replacement string that needs to be evaluated. +This matches the replacement strings that use \\, or \\#, and thus +have to be converted to Lisp by `query-replace-compile-replacement'.") + (defun query-replace-compile-replacement (to regexp-flag) "Maybe convert a regexp replacement TO to Lisp. REGEXP-FLAG non-nil means TO is a regexp. Returns a list suitable for `perform-replace' if necessary, the original string if not." (if (and regexp-flag - (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)) + (string-match query-replace-eval-replacement-regexp to)) (let (pos list char) (while (progn @@ -330,7 +354,7 @@ the original string if not." (1+ (cdr pos)) (cdr pos)))) (setq to (substring to end))))) - (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))) + (string-match query-replace-eval-replacement-regexp to))) (setq to (nreverse (delete "" (cons to list)))) (replace-match-string-symbols to) (cons #'replace-eval-replacement @@ -340,17 +364,126 @@ the original string if not." to)) -(defun query-replace-read-to (from prompt regexp-flag) +(defvar replace-preview-overlays nil + "List of overlays used to preview the replacement text.") + +(defun replace-preview-cleanup () + "Remove the overlays that preview the replacement text." + (mapc #'delete-overlay replace-preview-overlays) + (setq replace-preview-overlays nil)) + +(defun replace-preview-update (from to regexp-flag delimited-flag case-fold) + "Preview the result of replacing FROM with TO in the current buffer. +Each match of FROM visible in the selected window is displayed as the +text it would be replaced with, using the `query-replace-preview' face. +REGEXP-FLAG, DELIMITED-FLAG and CASE-FOLD say how to search for FROM, +as in `replace-search'." + (replace-preview-cleanup) + (let ((nocasify (not (and case-replace case-fold))) + (literal (or (not regexp-flag) (eq regexp-flag 'literal))) + (limit (window-end nil t))) + (save-excursion + (save-match-data + (goto-char (window-start)) + (while (and (< (point) limit) + (replace-search from limit regexp-flag delimited-flag + case-fold)) + (let* ((beg (match-beginning 0)) + (end (match-end 0)) + (text (propertize (match-substitute-replacement + to nocasify literal) + 'face 'query-replace-preview))) + (when (funcall isearch-filter-predicate beg end) + (let ((ov (make-overlay beg end))) + ;; A zero-length overlay displays nothing, so for an + ;; empty match show the replacement next to it instead. + (if (= beg end) + (overlay-put ov 'before-string text) + (overlay-put ov 'display text)) + (overlay-put ov 'priority 1001) ;higher than lazy overlays + (push ov replace-preview-overlays))) + ;; Don't loop forever on a zero-length match. + (when (and (= beg end) (not (eobp))) + (forward-char 1)))))))) + +(defun replace-preview-setup (from regexp-flag delimited-flag) + "Return a closure that previews the replacement of FROM. +Add it to `minibuffer-setup-hook' while reading the replacement text: +on every change it shows, in the original window, how the visible +matches of FROM would look after the replacement. +REGEXP-FLAG and DELIMITED-FLAG say how to search for FROM, as in +`replace-search'." + (if (or (not query-replace-show-preview) (minibufferp)) + #'ignore + (let ((unwind (make-symbol "replace-preview--unwind")) + (after-change (make-symbol "replace-preview--after-change")) + (buffer (current-buffer)) + (case-fold (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p from regexp-flag) + case-fold-search)) + (region-filter (when (use-region-p) + (replace--region-filter + (funcall region-extract-function 'bounds))))) + (fset unwind + (lambda () + (remove-hook 'after-change-functions after-change t) + (remove-hook 'minibuffer-exit-hook unwind t) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when region-filter + (remove-function (local 'isearch-filter-predicate) + region-filter)) + (replace-preview-cleanup))))) + (fset after-change + (lambda (_beg _end _len) + (let ((to (minibuffer-contents-no-properties))) + (with-minibuffer-selected-window + ;; The replacement text is typed one character at a + ;; time, so it's expected to be invalid meanwhile, + ;; e.g. when it ends with a backslash or refers to a + ;; group that the regexp doesn't have. + (condition-case nil + (if (and regexp-flag + (string-match + query-replace-eval-replacement-regexp to)) + ;; Neither \, nor \# can be previewed, for + ;; different reasons. \, is a Lisp expression + ;; that the user is still typing: evaluating it + ;; on each keystroke would run the side effects + ;; of a half-typed form as soon as it happens + ;; to be readable. \# expands to the number of + ;; replacements made so far, and none has been + ;; made yet, so the preview would show 0 for + ;; every match where the replacement itself + ;; will show 0, 1, 2... + (replace-preview-cleanup) + (replace-preview-update from to regexp-flag + delimited-flag case-fold)) + (error (replace-preview-cleanup))))))) + (lambda () + (add-hook 'minibuffer-exit-hook unwind nil t) + (add-hook 'after-change-functions after-change nil t) + (when region-filter + (with-current-buffer buffer + (add-function :after-while (local 'isearch-filter-predicate) + region-filter))) + (funcall after-change nil nil nil))))) + +(defun query-replace-read-to (from prompt regexp-flag &optional delimited-flag) "Query and return the TO argument of a `query-replace' operation. Prompt with PROMPT. REGEXP-FLAG non-nil means the response -should a regexp." +should a regexp. +DELIMITED-FLAG is used to search for the occurrences of FROM when +previewing the replacement (see `query-replace-show-preview')." (query-replace-compile-replacement (save-excursion (let* ((history-add-new-input nil) - (to (read-from-minibuffer - (format "%s %s with: " prompt (query-replace-descr from)) - nil nil nil - query-replace-to-history-variable from t))) + (to (minibuffer-with-setup-hook + (replace-preview-setup from regexp-flag delimited-flag) + (read-from-minibuffer + (format "%s %s with: " prompt (query-replace-descr from)) + nil nil nil + query-replace-to-history-variable from t)))) (add-to-history query-replace-to-history-variable to nil t) (add-to-history 'query-replace-defaults (cons from to) nil t) to)) @@ -386,7 +519,8 @@ should a regexp." from-string))) (query-replace-read-from prompt regexp-flag))) (to (if (consp from) (prog1 (cdr from) (setq from (car from))) - (query-replace-read-to from prompt regexp-flag)))) + (query-replace-read-to from prompt regexp-flag + delimited-flag)))) (list from to (or delimited-flag (and (plist-member (text-properties-at 0 from) 'isearch-regexp-function) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 15140ca46c5..ae27e3e4b67 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -705,6 +705,55 @@ bound to HIGHLIGHT-LOCUS." (if (match-string 2) "R" "L")))) (should (equal (buffer-string) after))))) +(defun replace-tests--preview (text from to regexp-flag &optional case-fold) + "Return the previews of replacing FROM with TO in a buffer holding TEXT. +Each preview is a list (BEG END STRING)." + (with-temp-buffer + (insert text) + (set-window-buffer (selected-window) (current-buffer)) + (unwind-protect + (progn + (replace-preview-update from to regexp-flag nil case-fold) + (mapcar (lambda (ov) + (list (overlay-start ov) + (overlay-end ov) + (substring-no-properties + (or (overlay-get ov 'display) + (overlay-get ov 'before-string))))) + (reverse replace-preview-overlays))) + (replace-preview-cleanup)))) + +(ert-deftest replace-tests-preview-update () + ;; Back-references are expanded in the preview. + (should (equal (replace-tests--preview "foo1 foo2\n" "foo\\([0-9]\\)" + "bar-\\1" t) + '((1 5 "bar-1") (6 10 "bar-2")))) + ;; So is the whole match. + (should (equal (replace-tests--preview "abc\n" "b" "[\\&]" t) + '((2 3 "[b]")))) + ;; The preview adapts the case like the replacement itself does. + (should (equal (replace-tests--preview "Foo foo\n" "foo" "bar" nil t) + '((1 4 "Bar") (5 8 "bar")))) + ;; An empty match is previewed with a zero-length overlay. + (should (equal (replace-tests--preview "ab\n" "x*" "Z" t) + '((1 1 "Z") (2 2 "Z") (3 3 "Z"))))) + +(ert-deftest replace-tests-preview-cleanup () + (with-temp-buffer + (insert "foo foo\n") + (set-window-buffer (selected-window) (current-buffer)) + (replace-preview-update "foo" "bar" nil nil nil) + (should replace-preview-overlays) + (replace-preview-cleanup) + (should-not replace-preview-overlays) + (should-not (overlays-in (point-min) (point-max))))) + +(ert-deftest replace-tests-preview-disabled () + (let ((query-replace-show-preview nil)) + (should (eq (replace-preview-setup "foo" nil nil) #'ignore))) + (let ((query-replace-show-preview t)) + (should-not (eq (replace-preview-setup "foo" nil nil) #'ignore)))) + (ert-deftest test-count-matches () (with-temp-buffer (insert "oooooooooo")