Improve where the replacement is previewed (bug#81583)

* lisp/replace.el (replace-preview--input): New function.
(replace-preview-update): Add optional START and END, and
preview only the matches between them.
(replace-preview-setup): Accept a nil FROM, read from the
minibuffer along with the replacement, and add optional
BACKWARD.  Limit the preview to the part of the buffer that the
replacement will cover.
(query-replace-read-to): Add optional BACKWARD and pass it on.
(query-replace-read-args): Preview the replacement while reading
FROM as well, and preview nothing when the caller asks for no
highlighting.
* lisp/isearch.el (isearch-query-replace): Pass BACKWARD to
`query-replace-read-to'.
* test/lisp/replace-tests.el (replace-tests--preview): Add START
and END.
(replace-tests-preview-bounds, replace-tests-preview-input): New
tests.
* doc/emacs/search.texi (Replace): Document the above.

doc/emacs/search.texi

@@ -1573,8 +1573,16 @@ value, the replace commands show a preview of the replacement while you
 type it: the matches visible in the window are displayed as they would
 look after the replacement.  This tells you what back-references like
 @samp{\1} (@pxref{Regexp Replace}) expand to before you commit to the
-replacement.  However, replacements that use @samp{\,} or @samp{\#} are
-not previewed.
+replacement.  The preview also appears at the prompt that reads the text
+to replace, as soon as its input holds both halves separated by an
+arrow, which is what @kbd{M-p} recalls from the history.  However,
+replacements that use @samp{\,} or @samp{\#} are not previewed.
+
+  Only the matches that the command will replace are previewed: those
+after point, or those before it when replacing backward
+(@pxref{Query Replace}).  The other ones are still highlighted, to show
+that the buffer has more of them.  When the region is active, the
+preview covers all of it, as the replacement does.
 
   The value can be @code{replacement-only}, to display the replacement
 alone, @code{both}, to display the match next to its replacement,

etc/NEWS

@@ -136,7 +136,11 @@ of the terminal emulator:
 ** New user option 'query-replace-show-preview'.
 If 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.  Replacements that use '\,' or '\#' are not
+after the replacement.  Only the matches that the command will replace
+are previewed: those after point, or those before it when replacing
+backward.  The preview also appears at the first prompt, as soon as its
+input holds both halves, as it does after recalling a replacement from
+the history with 'M-p'.  Replacements that use '\,' or '\#' are not
 previewed.  The preview is off by default.
 
 The value can be the symbol 'replacement-only', which shows the

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 (or delimited isearch-regexp-function))
+      isearch-regexp (or delimited isearch-regexp-function) backward)
      t isearch-regexp (or delimited isearch-regexp-function) nil nil
      (use-region-beginning) (use-region-end)
      backward))

lisp/replace.el

@@ -436,22 +436,41 @@ replace it.  They are combined as `query-replace-show-preview' says."
                 (funcall query-replace-show-preview match replacement))))))
     (and (stringp s) s)))
 
-(defun replace-preview-update (from to regexp-flag delimited-flag case-fold)
+(defun replace-preview--input (from contents)
+  "Return the pair of strings to preview, or nil if there is none.
+FROM is the string to search for and CONTENTS is the minibuffer input,
+which is then the replacement text.  FROM nil means that CONTENTS holds
+both halves, as at the prompt of `query-replace-read-from', which splits
+them on the `separator' text property; until the input has both of them
+there is nothing to preview, and nil is returned."
+  (if from
+      (cons from (substring-no-properties contents))
+    (let ((split (query-replace--split-string contents)))
+      (when (consp split)
+	(cons (substring-no-properties (car split)) (cdr split))))))
+
+(defun replace-preview-update (from to regexp-flag delimited-flag case-fold
+				    &optional start end)
   "Preview the result of replacing FROM with TO in the current buffer.
 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.
 
+START and END limit the previewed portion of the buffer, as in
+`perform-replace': a visible match outside of them will not be replaced,
+so previewing it would be misleading.  Matches to leave alone for other
+reasons are still expected to be rejected by `isearch-filter-predicate'.
+
 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)))
+	(limit (min (window-end nil t) (or end (point-max)))))
     (save-excursion
       (save-match-data
-	(goto-char (window-start))
+	(goto-char (max (window-start) (or start (point-min))))
 	(while (and (< (point) limit)
 		    (replace-search from limit regexp-flag delimited-flag
 				    case-fold))
@@ -473,21 +492,31 @@ in `replace-search'."
 	    (when (and (= beg end) (not (eobp)))
 	      (forward-char 1))))))))
 
-(defun replace-preview-setup (from regexp-flag delimited-flag)
+(defun replace-preview-setup (from regexp-flag delimited-flag
+			      &optional backward)
   "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.
+
+FROM nil means that the same minibuffer reads it too, as at the prompt
+of `query-replace-read-from': then both halves come from the input, and
+nothing is previewed until it has both of them.
+
 REGEXP-FLAG and DELIMITED-FLAG say how to search for FROM, as in
-`replace-search'."
+`replace-search'.  BACKWARD non-nil means that the replacement will go
+from point to the beginning of the buffer instead of to its end."
   (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))
+	  ;; All of an active region is replaced, and only the
+	  ;; filter below keeps the preview inside it.
+	  (bounds (unless (use-region-p)
+		    (if backward
+			(cons (point-min) (point))
+		      (cons (point) (point-max)))))
 	  (region-filter (when (use-region-p)
 			   (replace--region-filter
 			    (funcall region-extract-function 'bounds)))))
@@ -503,29 +532,39 @@ REGEXP-FLAG and DELIMITED-FLAG say how to search for FROM, as in
 		  (replace-preview-cleanup)))))
       (fset after-change
 	    (lambda (_beg _end _len)
-	      (let ((to (minibuffer-contents-no-properties)))
+	      (let* ((input (replace-preview--input
+			     from (minibuffer-contents)))
+		     (search (car input))
+		     (replacement (cdr input)))
 		(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...
+		      (if (or
+			   (null input) (equal search "")
+			   ;; 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...
+			   (and regexp-flag
+				(string-match
+				 query-replace-eval-replacement-regexp
+				 replacement)))
 			  (replace-preview-cleanup)
-			(replace-preview-update from to regexp-flag
-						delimited-flag case-fold))
+			(replace-preview-update
+			 search replacement regexp-flag delimited-flag
+			 (if (and case-fold-search search-upper-case)
+			     (isearch-no-upper-case-p search regexp-flag)
+			   case-fold-search)
+			 (car bounds) (cdr bounds)))
 		    (error (replace-preview-cleanup)))))))
       (lambda ()
 	(add-hook 'minibuffer-exit-hook unwind nil t)
@@ -536,17 +575,19 @@ REGEXP-FLAG and DELIMITED-FLAG say how to search for FROM, as in
 			  region-filter)))
 	(funcall after-change nil nil nil)))))
 
-(defun query-replace-read-to (from prompt regexp-flag &optional delimited-flag)
+(defun query-replace-read-to (from prompt regexp-flag &optional delimited-flag
+				   backward)
   "Query and return the TO argument of a `query-replace' operation.
 Prompt with PROMPT.  REGEXP-FLAG non-nil means the response
 should a regexp.
-DELIMITED-FLAG is used to search for the occurrences of FROM when
-previewing the replacement (see `query-replace-show-preview')."
+DELIMITED-FLAG and BACKWARD are 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 (minibuffer-with-setup-hook
-		    (replace-preview-setup from regexp-flag delimited-flag)
+		    (replace-preview-setup from regexp-flag delimited-flag
+					   backward)
 		  (read-from-minibuffer
 		   (format "%s %s with: " prompt (query-replace-descr from))
 		   nil nil nil
@@ -560,39 +601,47 @@ previewing the replacement (see `query-replace-show-preview')."
   (unless noerror
     (barf-if-buffer-read-only))
   (save-mark-and-excursion
-    (let* ((delimited-flag (and current-prefix-arg
+    (let* ((query-replace-show-preview
+            ;; No highlighting in this buffer means no preview in it.
+            (and (not no-highlight) query-replace-show-preview))
+           (delimited-flag (and current-prefix-arg
                                 (not (eq current-prefix-arg '-))))
+           (backward (and current-prefix-arg (eq current-prefix-arg '-)))
            (from (minibuffer-with-setup-hook
-                     (minibuffer-lazy-highlight-setup
-                      :case-fold case-fold-search
-                      :filter (when (use-region-p)
-                                (replace--region-filter
-                                 (funcall region-extract-function 'bounds)))
-                      :highlight (and query-replace-lazy-highlight (not no-highlight))
-                      :lax-whitespace (if regexp-flag replace-regexp-lax-whitespace
+                     ;; A nil FROM: this input can hold both halves.
+                     (replace-preview-setup nil regexp-flag delimited-flag
+                                            backward)
+                   (minibuffer-with-setup-hook
+                       (minibuffer-lazy-highlight-setup
+                        :case-fold case-fold-search
+                        :filter (when (use-region-p)
+                                  (replace--region-filter
+                                   (funcall region-extract-function 'bounds)))
+                        :highlight (and query-replace-lazy-highlight (not no-highlight))
+                        :lax-whitespace (if regexp-flag replace-regexp-lax-whitespace
                                           replace-lax-whitespace)
-                      :regexp regexp-flag
-                      :regexp-function (or replace-regexp-function
-                                           delimited-flag
-                                           (and replace-char-fold
-	                                        (not regexp-flag)
-	                                        #'char-fold-to-regexp))
-                      :transform (lambda (string)
-                                   (let* ((split (query-replace--split-string string))
-                                          (from-string (if (consp split) (car split) split)))
-                                     (when (and case-fold-search search-upper-case)
-	                               (setq isearch-case-fold-search
-                                             (isearch-no-upper-case-p from-string regexp-flag)))
-                                     from-string)))
-                   (query-replace-read-from prompt regexp-flag)))
+                        :regexp regexp-flag
+                        :regexp-function (or replace-regexp-function
+                                             delimited-flag
+                                             (and replace-char-fold
+	                                          (not regexp-flag)
+	                                          #'char-fold-to-regexp))
+                        :transform (lambda (string)
+                                     (let* ((split (query-replace--split-string string))
+                                            (from-string (if (consp split) (car split) split)))
+                                       (when (and case-fold-search search-upper-case)
+	                                 (setq isearch-case-fold-search
+                                               (isearch-no-upper-case-p from-string regexp-flag)))
+                                       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
-                                        delimited-flag))))
+                                        delimited-flag backward))))
       (list from to
             (or delimited-flag
                 (and (plist-member (text-properties-at 0 from) 'isearch-regexp-function)
                      (get-text-property 0 'isearch-regexp-function from)))
-            (and current-prefix-arg (eq current-prefix-arg '-))))))
+            backward))))
 
 (defun query-replace-read-transpose-from-to ()
   "Transpose the FROM and TO arguments of a `query-replace' operation.

test/lisp/replace-tests.el

@@ -705,9 +705,11 @@ 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)
+(defun replace-tests--preview (text from to regexp-flag &optional case-fold
+                                    start end)
   "Return the previews of replacing FROM with TO in a buffer holding TEXT.
-Each preview is a list (BEG END STRING).
+Each preview is a list (BEG END STRING).  START and END limit the
+previewed portion of the buffer.
 Unless the caller binds `query-replace-show-preview' to something else,
 the previews are those of `replacement-only'."
   (let ((query-replace-show-preview
@@ -717,7 +719,8 @@ the previews are those of `replacement-only'."
       (set-window-buffer (selected-window) (current-buffer))
       (unwind-protect
           (progn
-            (replace-preview-update from to regexp-flag nil case-fold)
+            (replace-preview-update from to regexp-flag nil case-fold
+                                    start end)
             (mapcar (lambda (ov)
                       (list (overlay-start ov)
                             (overlay-end ov)
@@ -750,6 +753,26 @@ the previews are those of `replacement-only'."
   (should (equal (replace-tests--preview "foo\n" "foo" "" nil)
                  '((1 4 " ")))))
 
+(ert-deftest replace-tests-preview-bounds ()
+  ;; Only the matches that would be replaced are previewed.
+  (should (equal (replace-tests--preview "foo foo foo\n" "foo" "bar" nil nil 5)
+                 '((5 8 "bar") (9 12 "bar"))))
+  ;; When the replacement goes backward, the other side is the valid one.
+  (should (equal (replace-tests--preview "foo foo foo\n" "foo" "bar" nil nil
+                                         nil 8)
+                 '((1 4 "bar") (5 8 "bar")))))
+
+(ert-deftest replace-tests-preview-input ()
+  (let ((from-to (concat "foo" (propertize " \N{RIGHTWARDS ARROW} "
+                                           'separator t)
+                         "bar")))
+    ;; While only the replacement is read, FROM is fixed.
+    (should (equal (replace-preview--input "foo" "bar") '("foo" . "bar")))
+    ;; While both halves are read, they are split apart.
+    (should (equal (replace-preview--input nil from-to) '("foo" . "bar")))
+    ;; There is nothing to preview until the input has both of them.
+    (should-not (replace-preview--input nil "foo"))))
+
 (ert-deftest replace-tests-preview-both ()
   (let ((query-replace-show-preview 'both)
         (arrow (if (char-displayable-p ?→) "→" "->")))