bug#53126: 29.0.50; [PATCH] Lazy highlight/count when reading query-replace string, etc.

[Augusto Stoffel <arstoffel@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 833 bytes --]

On Tue,  5 Apr 2022 at 20:12, Juri Linkov <juri@linkov.net> wrote:

>> But that's a good point, we don't need a macro.  Among several
>> variations, we could make the setup code look like this:
>>
>>      (minibuffer-with-setup-hook
>>            (minibuffer-lazy-highlight-init :case-fold case-fold-search
>>                                            :regexp regexp-flag
>>                                            ...)
>>        (query-replace-read-from prompt regexp-flag))
>>
>> where now `minibuffer-lazy-highlight-init' is not the function that
>> initializes stuff, but rather a function that returns a closure that
>> initializes stuff.
>
> Looks good.

Okay, I've refactored my code like this.  I actually like it better that
way.  (As a downside, the stuff that was already merged to isearch.el is
completely changed.)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Display-lazy-highlight-and-match-count-in-query-repl.patch --]
[-- Type: text/x-patch, Size: 14361 bytes --]

From 173c24fc4f90c92f5c9035c76fc578bf11d33294 Mon Sep 17 00:00:00 2001
From: Augusto Stoffel <arstoffel@gmail.com>
Date: Thu, 17 Mar 2022 20:17:26 +0100
Subject: [PATCH] Display lazy highlight and match count in query-replace

* lisp/isearch.el (isearch-query-replace): Don't clean up lazy
highlight if applicable.
* lisp/replace.el (query-replace-read-args, query-replace-read-to):
Add lazy highlighting and count.
(replace--region-filter): New function, extracted from
'perform-replace'.
(perform-replace): Use 'replace--region-filter'.
---
 lisp/isearch.el | 144 +++++++++++++++++++++++++++---------------------
 lisp/replace.el |  77 +++++++++++++++++++-------
 2 files changed, 140 insertions(+), 81 deletions(-)

diff --git a/lisp/isearch.el b/lisp/isearch.el
index 956b115ce4..48f2c3bf41 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1812,20 +1812,20 @@ isearch-edit-string
 	  (minibuffer-history-symbol)
 	  ;; Search string might have meta information on text properties.
 	  (minibuffer-allow-text-properties t))
-     (when isearch-lazy-highlight
-       (add-hook 'minibuffer-setup-hook #'minibuffer-lazy-highlight-setup))
      (setq isearch-new-string
-	   (read-from-minibuffer
-	    (isearch-message-prefix nil isearch-nonincremental)
-	    (cons isearch-string (1+ (or (isearch-fail-pos)
-					 (length isearch-string))))
-	    minibuffer-local-isearch-map nil
-	    (if isearch-regexp
-		(cons 'regexp-search-ring
-		      (1+ (or regexp-search-ring-yank-pointer -1)))
-	      (cons 'search-ring
-		    (1+ (or search-ring-yank-pointer -1))))
-	    nil t)
+	   (minibuffer-with-setup-hook
+               (minibuffer-lazy-highlight-setup)
+             (read-from-minibuffer
+	      (isearch-message-prefix nil isearch-nonincremental)
+	      (cons isearch-string (1+ (or (isearch-fail-pos)
+					   (length isearch-string))))
+	      minibuffer-local-isearch-map nil
+	      (if isearch-regexp
+		  (cons 'regexp-search-ring
+		        (1+ (or regexp-search-ring-yank-pointer -1)))
+	        (cons 'search-ring
+		      (1+ (or search-ring-yank-pointer -1))))
+	      nil t))
 	   isearch-new-message
 	   (mapconcat 'isearch-text-char-description
 		      isearch-new-string "")))))
@@ -4361,57 +4361,77 @@ minibuffer-lazy-count-format
   :group 'lazy-count
   :version "29.1")
 
-(defvar minibuffer-lazy-highlight-transform #'identity
-  "Function to transform minibuffer text into a `isearch-string' for highlighting.")
-
-(defvar minibuffer-lazy-highlight--overlay nil
-  "Overlay for minibuffer prompt updates.")
-
-(defun minibuffer-lazy-highlight--count ()
-  "Display total match count in the minibuffer prompt."
-  (when minibuffer-lazy-highlight--overlay
-    (overlay-put minibuffer-lazy-highlight--overlay
-                 'before-string
-                 (and isearch-lazy-count-total
-                      (not isearch-error)
-                      (format minibuffer-lazy-count-format
-                              isearch-lazy-count-total)))))
-
-(defun minibuffer-lazy-highlight--after-change (_beg _end _len)
-  "Update lazy highlight state in minibuffer selected window."
-  (when isearch-lazy-highlight
-    (let ((inhibit-redisplay t) ;; Avoid cursor flickering
-          (string (minibuffer-contents)))
-      (with-minibuffer-selected-window
-        (setq isearch-string (funcall minibuffer-lazy-highlight-transform string))
-        (isearch-lazy-highlight-new-loop)))))
-
-(defun minibuffer-lazy-highlight--exit ()
-  "Unwind changes from `minibuffer-lazy-highlight-setup'."
-  (remove-hook 'after-change-functions
-               #'minibuffer-lazy-highlight--after-change)
-  (remove-hook 'lazy-count-update-hook #'minibuffer-lazy-highlight--count)
-  (remove-hook 'minibuffer-exit-hook #'minibuffer-lazy-highlight--exit)
-  (setq minibuffer-lazy-highlight--overlay nil)
-  (when lazy-highlight-cleanup
-    (lazy-highlight-cleanup)))
-
-(defun minibuffer-lazy-highlight-setup ()
+(cl-defun minibuffer-lazy-highlight-setup (&key (highlight isearch-lazy-highlight)
+                                                (cleanup lazy-highlight-cleanup)
+                                                (transform #'identity)
+                                                (filter nil)
+                                                (regexp isearch-regexp)
+                                                (regexp-function isearch-regexp-function)
+                                                (case-fold isearch-case-fold-search)
+                                                (lax-whitespace (if regexp
+                                                                    isearch-regexp-lax-whitespace
+                                                                  isearch-lax-whitespace)))
   "Set up minibuffer for lazy highlight of matches in the original window.
 
-This function is intended to be added to `minibuffer-setup-hook'.
-Note that several other isearch variables influence the lazy
-highlighting, including `isearch-regexp',
-`isearch-lazy-highlight' and `isearch-lazy-count'."
-  (remove-hook 'minibuffer-setup-hook #'minibuffer-lazy-highlight-setup)
-  (add-hook 'after-change-functions
-            #'minibuffer-lazy-highlight--after-change)
-  (add-hook 'lazy-count-update-hook #'minibuffer-lazy-highlight--count)
-  (add-hook 'minibuffer-exit-hook #'minibuffer-lazy-highlight--exit)
-  (setq minibuffer-lazy-highlight--overlay
-        (and minibuffer-lazy-count-format
-             (make-overlay (point-min) (point-min) (current-buffer) t)))
-  (minibuffer-lazy-highlight--after-change nil nil nil))
+This function return a closure intended to be added to
+`minibuffer-setup-hook'.  It accepts the following keyword
+arguments, all of which have a default based on the current
+isearch settings:
+
+HIGHLIGHT: Whether to perform lazy highlight.
+CLEANUP: Whether to clean up the lazy highlight when the minibuffer
+exits.
+TRANSFORM: A function to transform the minibuffer contents into a
+search string.
+FILTER: A function to add to `isearch-filter-predicate'.
+REGEXP: The value of `isearch-regexp' to use for lazy highlight.
+REGEXP-FUNCTION: The value of `isearch-regexp-function' to use for
+lazy highlight.
+CASE-FOLD: The value of `isearch-case-fold' to use for lazy highlight.
+LAX-WHITESPACE: The value of `isearch-(regexp-)lax-whitespace' to use
+for lazy highlight."
+  (if (not highlight)
+      #'ignore
+    (let ((unwind (make-symbol "minibuffer-lazy-highlight--unwind"))
+          (after-change (make-symbol "minibuffer-lazy-highlight--after-change"))
+          (display-count (make-symbol "minibuffer-lazy-highlight--display-count"))
+          overlay)
+      (fset unwind
+            (lambda ()
+              (remove-hook 'minibuffer-exit-hook unwind)
+              (remove-hook 'after-change-functions after-change)
+              (remove-hook 'lazy-count-update-hook display-count)
+              (remove-function isearch-filter-predicate filter)
+              (when cleanup (lazy-highlight-cleanup))))
+      (fset after-change
+            (lambda (_beg _end _len)
+              (let ((inhibit-redisplay t) ;; Avoid cursor flickering
+                    (string (minibuffer-contents)))
+                (with-minibuffer-selected-window
+                  (let* ((isearch-forward t)
+                         (isearch-regexp regexp)
+                         (isearch-regexp-function regexp-function)
+                         (isearch-case-fold-search case-fold)
+                         (isearch-lax-whitespace lax-whitespace)
+                         (isearch-regexp-lax-whitespace lax-whitespace)
+                         (isearch-string (funcall transform string)))
+                    (isearch-lazy-highlight-new-loop))))))
+      (fset display-count
+            (lambda ()
+              (overlay-put overlay 'before-string
+                           (and isearch-lazy-count-total
+                                (not isearch-error)
+                                (format minibuffer-lazy-count-format
+                                        isearch-lazy-count-total)))))
+      (lambda ()
+        (add-hook 'minibuffer-exit-hook unwind)
+        (add-hook 'after-change-functions after-change)
+        (when filter
+          (add-function :after-while isearch-filter-predicate filter))
+        (when minibuffer-lazy-count-format
+          (setq overlay (make-overlay (point-min) (point-min) (current-buffer) t))
+          (add-hook 'lazy-count-update-hook display-count))
+        (funcall after-change nil nil nil)))))
 
 \f
 (defun isearch-resume (string regexp word forward message case-fold)
diff --git a/lisp/replace.el b/lisp/replace.el
index e6f565d802..fed4dfd457 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -352,8 +352,15 @@ query-replace-read-to
   (query-replace-compile-replacement
    (save-excursion
      (let* ((history-add-new-input nil)
+            (count (if (and query-replace-lazy-highlight
+                            minibuffer-lazy-count-format
+                            isearch-lazy-count
+                            isearch-lazy-count-total)
+                       (format minibuffer-lazy-count-format
+                               isearch-lazy-count-total)
+                     ""))
 	    (to (read-from-minibuffer
-		 (format "%s %s with: " prompt (query-replace-descr from))
+		 (format "%s%s %s with: " count 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)
@@ -365,11 +372,29 @@ query-replace-read-args
   (unless noerror
     (barf-if-buffer-read-only))
   (save-mark-and-excursion
-    (let* ((from (query-replace-read-from prompt regexp-flag))
+    (let* ((delimited-flag (and current-prefix-arg
+                                (not (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 query-replace-lazy-highlight
+                      :regexp regexp-flag
+                      :regexp-function (replace-regexp-function delimited-flag regexp-flag)
+                      :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))))
       (list from to
-            (or (and current-prefix-arg (not (eq current-prefix-arg '-)))
+            (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 '-))))))
@@ -2656,6 +2681,13 @@ replace-regexp-function
 is not to be interpreted literally, but instead should be converted
 to a regexp that is actually used for the search.")
 
+(defun replace-regexp-function (delimited-flag regexp-flag)
+  (or replace-regexp-function
+      delimited-flag
+      (and replace-char-fold
+	   (not regexp-flag)
+	   #'char-fold-to-regexp)))
+
 (defun replace-search (search-string limit regexp-flag delimited-flag
 		       case-fold &optional backward)
   "Search for the next occurrence of SEARCH-STRING to replace."
@@ -2778,6 +2810,26 @@ replace--push-stack
 	       ,search-str ,next-replace)
          ,stack))
 
+(defun replace--region-filter (bounds)
+  "Return a function that decides if a region is inside BOUNDS.
+BOUNDS is a list of cons cells of the form (START . END).  The
+returned function takes as argument two buffer positions, START
+and END."
+  (let ((region-bounds
+         (mapcar (lambda (position)
+                   (cons (copy-marker (car position))
+                         (copy-marker (cdr position))))
+                 bounds)))
+    (lambda (start end)
+      (delq nil (mapcar
+                 (lambda (bounds)
+                   (and
+                    (>= start (car bounds))
+                    (<= start (cdr bounds))
+                    (>= end   (car bounds))
+                    (<= end   (cdr bounds))))
+                 region-bounds)))))
+
 (defun perform-replace (from-string replacements
 		        query-flag regexp-flag delimited-flag
 			&optional repeat-count map start end backward region-noncontiguous-p)
@@ -2862,22 +2914,9 @@ perform-replace
 
     ;; Unless a single contiguous chunk is selected, operate on multiple chunks.
     (when region-noncontiguous-p
-      (let ((region-bounds
-             (mapcar (lambda (position)
-                       (cons (copy-marker (car position))
-                             (copy-marker (cdr position))))
-                     (funcall region-extract-function 'bounds))))
-        (setq region-filter
-              (lambda (start end)
-                (delq nil (mapcar
-                           (lambda (bounds)
-                             (and
-                              (>= start (car bounds))
-                              (<= start (cdr bounds))
-                              (>= end   (car bounds))
-                              (<= end   (cdr bounds))))
-                           region-bounds))))
-        (add-function :after-while isearch-filter-predicate region-filter)))
+      (setq region-filter (replace--region-filter
+                           (funcall region-extract-function 'bounds)))
+      (add-function :after-while isearch-filter-predicate region-filter))
 
     ;; If region is active, in Transient Mark mode, operate on region.
     (if backward
-- 
2.35.1


[-- Attachment #3: Type: text/plain, Size: 1630 bytes --]



>>> Please also note that condition-case can be replaced by
>>> a hook in minibuffer-exit-hook that can remove highlighting
>>> after exiting the minibuffer.
>>
>> If it was a `unwind-protect', I would agree.  But I don't know how to
>> simulate a `condition-case'.  Specifically, how can we determine if some
>> hook (the minibuffer-exit-hook in this case) is being run "normally" or
>> as part of the recovery from a signaled error?
>
> Shouldn't both cases clean up highlight from the buffer?
> Then I see no need to distinguish each case.  Or if really needed,
> you can try to bind the cleanup to command-error-function.

My previous patch had only one case: if the user quits, we clean up the
highlighting.

I can only see one simpler alternative, which is to always
unconditionally clean up the highlight.  This is not as nice, but if
keeping the code as simple as possible is important here, then I guess
this is the way forward.  So that's what the current patch does.

I suspect people will see this as a bug, but maybe discussing this issue
by itself later will be easier.

>>> Alternatively, the same lambda above could be added to
>>>
>>>   (add-hook 'minibuffer-setup-hook (lambda () ...))
>>
>> Why was it again that we want to avoid saying something like this?
>>
>>     (let ((case-fold-search whatever)
>>           (isearch-regexp regexp-flag))
>>        (minibuffer-with-setup-hook #'minibuffer-lazy-highlight-init
>>          (query-replace-read-from prompt regexp-flag)))
>
> 4 lines look nice, unlike 20 lines in one of your patches ;-)

When you add all the bells and whistles, 4 lines just won't do it.