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:

>> Here's an almost final scratch of what I'm working on.
>
> Thanks for the patch.  I have tested it, and it makes UI nicer.
>

Thanks for your feedback!

>> Before I go ahead with tests and manual entries, I'd like to share it
>> with you for reviewing code, feature expectations, grammar, doc length
>> and so on.
>
> I have a comment about doc length: the amount of text
> in the paragraph explaining the details of the
> function of two arguments looks disproportionally long.
>

Yeah, I had the same feeling.  Tried to make it shorter now.

>> Users can also set 'query-replace-preview-separator' to:
>>
>> - nil (automatic default, will use → or -> if not available)
>> - ""  (a custom string in case of wanting another symbol or adding spaces
>>        around, like " → ")
>
> Not sure if we need a special option
> 'query-replace-preview-separator-string'
> since in rare cases it's possible to
> change the string using the function in
> 'query-replace-show-preview'.  (Or at least
> postpone addition until requested by users.)
>
> Also the face 'query-replace-preview-separator'
> doesn't look necessary now since it can be added
> by the same function (a face still could be added
> later when requested by users).
>

This simplifies it quite a bit.  Done.


>> Regarding faces, following this scheme:
>>
>> [match]→[replace]
>>    1   2    3
>>
>> The provided faces are:
>>
>> 1 -> query-replace-preview-match
>> 2 -> query-replace-preview-separator
>> 3 -> query-replace-preview
>>
>> Please find attached the diff and some screenshots.
>
> Since you added dedicated faces, I have a better suggestion
> for their default colors.  Like the result of replacements
> can be viewed as a diff (there is even a key 'd' that shows
> a diff during replacement), let's use diff colors by default
> where the match has the red background, and the replacement
> the green background, i.e. colors from diff-mode faces
> 'diff-removed' and 'diff-added'.  Like on the screenshot
> Karthik posted to emacs-devel.  This removes the need
> to use strike-through that makes the text less readable.

Adding Stéphane and Karthik.


I made it closer to Karthik's screenshot, also added the diff faces as
base for the feature.  Much better.

The diff faces are not autoloaded, so a top-level `require` would load
them even when they aren't needed.  That's why the `require` is in
`replace-preview-setup`, in the branch that only runs when the preview
is enabled. Is this acceptable?

The alternative would be to copy the color values from `diff-mode.el`
into the two faces.  That would avoid the load, but it would duplicate
the colors and ignore any customizations the user or theme has made to
the diff faces.


An extra: Zero-length matches are better than before (at least for the
'both case), since an empty match at least shows the arrow, so there is
something at the spot.  I still think it deserves a change of its own
when we finish this part of the feature.


Please find attached a new diff and new screenshots.

-- 
Rahul Martim Juliato
replace-01.png (image/png, 104.4 KB) - not displayed
replace-02.png (image/png, 120.4 KB) - not displayed
replace-preview-02.diff (application/octet-stream, 6 KB)
 lisp/replace.el | 86 ++++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 70 insertions(+), 16 deletions(-)

diff --git a/lisp/replace.el b/lisp/replace.el
index 4bdb80dc531..f0e124183ae 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))
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.