bug#81583: 32.0.50; Optional preview of the replacement text while typing it

Rahul Martim Juliato <[email protected]>
Newsgroups gmane.emacs.bugs
Message-ID <[email protected]>
Juri Linkov <[email protected]> writes:

> OTOH, there are other packages that do something similar,
> e.g. flymake.el:
>
>   (require 'compile) ; for some faces
>
> The only drawback is that 'M-x list-faces-display'
> shows these faces with the default colors, but this is
> not a problem.  So maybe your latest patch could be pushed.

Thanks.  For the record, I just grepped a few more of these, both at top
level:

  lisp/vc/compare-w.el:32        (require 'diff-mode) ; For diff faces.
  lisp/progmodes/flymake.el:116  (require 'compile)   ; for some faces
  lisp/progmodes/eglot.el:104    (require 'compile)   ; for some faces

and inside a function or a mode, like the one in the patch:

  lisp/progmodes/xref.el:1154      ; For the compilation faces.
  lisp/emacs-lisp/package.el:3074  ; for the custom-button face
  lisp/vc/vc-git.el:1977           ;; We need the faces add-log.
  lisp/vc/vc-hg.el:475             ;; we need the add-log faces

compare-w.el is the closest to ours, it inherits from 'diff-removed' and
'diff-added' for the same reason, and it does it at top level actually.

> I don't remember why we don't use ###autoload for defface.
> But adding ###autoload to these two faces in diff-mode.el
> could solve the problem.

That would be nicer, and it would fix 'M-x list-faces-display' for every
package doing this, not only for this one.  But it touches diff-mode and
the autoload machinery, so I would rather not make this patch depend on
it.

> Yes, for the value 'both' a placeholder for an empty match is not much
> needed.  But still it would be better to have it at least for the 't'
> case.

Agreed.  I will work on it next, together with the manual and the tests.

So this is ready from my side.  Attached is a formatted patch, the same
as the previous diff plus the etc/NEWS entry, just rebased on current
master.  If nobody else has comments, it could go in.

-- 
Rahul Martim Juliato
0001-Add-new-options-to-query-replace-show-preview-bug-81583.patch (application/octet-stream, 8.1 KB)
From 2761def658b6c9bb56045385e66acf6364958c87 Mon Sep 17 00:00:00 2001
From: Rahul Martim Juliato <[email protected]>
Date: Thu, 20 Aug 2026 20:44:57 -0300
Subject: [PATCH] Add new options to 'query-replace-show-preview' (bug#81583)

* lisp/replace.el (query-replace-show-preview): Accept 'both'
and a function of two arguments as values.  Doc fix.
(query-replace-preview): Inherit from 'diff-added'.
(query-replace-preview-match): New face.
(replace-preview--propertize, replace-preview--format): New
functions.
(replace-preview-update): Use 'replace-preview--format'.
(replace-preview-setup): Require diff-mode, for the diff faces.
* etc/NEWS: Update the entry.
---
 etc/NEWS        | 18 +++++++----
 lisp/replace.el | 86 ++++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 82 insertions(+), 22 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 6f95672272b..b00477b1e52 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -112,13 +112,19 @@ the user option 'icomplete-in-buffer' to the value 'with-completions-popup'.
 
 * 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.
+When non-nil, 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.  This tells you what back-references like '\1'
+expand to before you commit to the edit.  However, replacements that use
+'\,' or '\#' are not previewed.  The preview is off by default.
+
+With a value of t, each match is shown as the replacement text, in the
+new face 'query-replace-preview'.  With a value of 'both', the match and
+the replacement are shown side by side, separated by an arrow, in the
+new faces 'query-replace-preview-match' and 'query-replace-preview'.
+The value can also be a function of two arguments, the match and the
+replacement, returning the string to show in place of the match.
 
 ** Electric Pair mode
 
diff --git a/lisp/replace.el b/lisp/replace.el
index b209bd3a92e..ec48e4cb322 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -116,11 +116,28 @@ query-replace-show-replacement
 
 (defcustom query-replace-show-preview nil
   "Non-nil means show preview of the result of replacement while you type it.
-The matches that are 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.  However, replacements that use \\, or \\# are not previewed."
-  :type 'boolean
+The matches visible in the window are shown as they would look after the
+replacement, showing what back-references like \\1 expand to before you
+commit.  Replacements using \\, or \\# are not previewed.
+
+If the value is t, each match is shown as the replacement text in the
+`query-replace-preview' face.
+
+If `both', the match and the replacement appear side by side, separated
+by an arrow, in the faces `query-replace-preview-match' and
+`query-replace-preview'.
+
+The value can also be a function of two arguments, the match and the
+replacement, returning the string to show in place of the match, or nil
+to leave it alone.  It must propertize the string itself, be fast and
+free of side effects, and cope with a replacement still being typed:
+
+  (lambda (match replacement)
+    (concat \"[\" match \"]~>{\" replacement \"}\"))"
+  :type '(choice (const    :tag "No preview" nil)
+                 (const    :tag "Show the replacement" t)
+                 (const    :tag "Show the match and the replacement" both)
+                 (function :tag "Function"))
   :group 'matching
   :version "32.1")
 
@@ -162,13 +179,21 @@ query-replace
   :version "22.1")
 
 (defface query-replace-preview
-  '((t (:inherit query-replace)))
+  '((t (:inherit diff-added)))
   "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")
 
+(defface query-replace-preview-match
+  '((t (:inherit diff-removed)))
+  "Face for the matched text in the preview.
+Used for the left half of the preview when `query-replace-show-preview'
+is `both'."
+  :group 'matching
+  :version "32.1")
+
 (defvar replace-count 0
   "Number of replacements done so far.
 See `replace-regexp'.")
@@ -372,12 +397,39 @@ replace-preview-cleanup
   (mapc #'delete-overlay replace-preview-overlays)
   (setq replace-preview-overlays nil))
 
+(defun replace-preview--propertize (text face)
+  "Return a copy of TEXT with all its text properties replaced by FACE.
+Original properties are dropped because TEXT can come from the buffer,
+and a `display' or `invisible' property inside an overlay string would
+show something other than the preview."
+  (setq text (substring-no-properties text))
+  (add-face-text-property 0 (length text) face nil text)
+  text)
+
+(defun replace-preview--format (match replacement)
+  "Return the text to show in place of MATCH, or nil for no preview.
+MATCH is the matched text and REPLACEMENT is the text that would replace
+it.  How they are combined is decided by `query-replace-show-preview'."
+  (pcase query-replace-show-preview
+    ('both (let ((sep (if (char-displayable-p ?→) "→" "->")))
+             (concat (replace-preview--propertize (concat match sep)
+                                                  'query-replace-preview-match)
+                     (replace-preview--propertize replacement
+                                                  'query-replace-preview))))
+    ((and (pred functionp) fun)
+     (let ((s (save-match-data (funcall fun match replacement))))
+       (and (stringp s) s)))
+    (_ (replace-preview--propertize replacement 'query-replace-preview))))
+
 (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'."
+Each match of FROM visible in the selected window gets an overlay
+showing the text that `replace-preview--format' returns for it, which
+depends on `query-replace-show-preview'.  Matches for which it returns
+nil are left alone.
+
+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)))
@@ -390,13 +442,14 @@ replace-preview-update
 				    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)
+		 (text (replace-preview--format
+			(buffer-substring beg end)
+			(match-substitute-replacement to nocasify literal))))
+	    (when (and text (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.
+		;; FIXME: 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))
@@ -415,6 +468,7 @@ replace-preview-setup
 `replace-search'."
   (if (or (not query-replace-show-preview) (minibufferp))
       #'ignore
+    (require 'diff-mode)       ; For diff faces
     (let ((unwind (make-symbol "replace-preview--unwind"))
 	  (after-change (make-symbol "replace-preview--after-change"))
 	  (buffer (current-buffer))
-- 
2.55.0
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.