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: 337 bytes --]

On Fri,  8 Apr 2022 at 10:32, Juri Linkov <juri@linkov.net> wrote:

>>> 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.)
>
> Thanks, now it looks much better!

Please find attached the patches.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Rewrite-the-minibuffer-lazy-highlight-feature.patch --]
[-- Type: text/x-patch, Size: 9429 bytes --]

From 5ed0e5a850992c62189c0dc74ef98b892522d4df Mon Sep 17 00:00:00 2001
From: Augusto Stoffel <arstoffel@gmail.com>
Date: Sat, 9 Apr 2022 12:38:14 +0200
Subject: [PATCH 1/2] Rewrite the minibuffer lazy highlight feature

The new API was discussed in bug#53126.  It's more robust and easier
to use in complex cases like that of 'query-replace'.

* etc/NEWS: Amend the feature announcement
* lisp/isearch.el (isearch-edit-string): Use new API.
(minibuffer-lazy-highlight-transform,
minibuffer-lazy-highlight--overlay, minibuffer-lazy-highlight--count,
minibuffer-lazy-highlight--after-change,
minibuffer-lazy-highlight--exit) Remove helper functions, which are
now kept together with the lazy highlight configuration variables
within a closure.
(minibuffer-lazy-highlight-setup): This function now takes the lazy
highlighting configuration variables as argument, and returns a
closure that is intended to run as part of the minibuffer setup.
---
 etc/NEWS        |   5 +-
 lisp/isearch.el | 148 ++++++++++++++++++++++++++++--------------------
 2 files changed, 88 insertions(+), 65 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 2fac893cc5..2cddfcc8db 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1593,9 +1593,8 @@ the clipboard, and insert it into the buffer.
 
 ---
 ** New function 'minibuffer-lazy-highlight-setup'.
-This function is intended to be added to 'minibuffer-setup-hook'.
-It sets up the minibuffer for lazy highlighting of matches
-in the original window.
+This function allows to set up the minibuffer so that lazy
+highlighting of its content is applied in the original window.
 
 +++
 ** New text property 'inhibit-isearch'.
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 956b115ce4..168d71ada3 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,81 @@ 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 taking one argument, the minibuffer contents,
+and returning the `isearch-string' to use for lazy highlighting.
+FILTER: A function to add to `isearch-filter-predicate'.
+REGEXP: The value of `isearch-regexp' to use for lazy highlighting.
+REGEXP-FUNCTION: The value of `isearch-regexp-function' to use for
+lazy highlighting.
+CASE-FOLD: The value of `isearch-case-fold' to use for lazy
+highlighting.
+LAX-WHITESPACE: The value of `isearch-lax-whitespace' and
+`isearch-regexp-lax-whitespace' to use for lazy highlighting."
+  (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-function isearch-filter-predicate filter)
+              (remove-hook 'lazy-count-update-hook display-count)
+              (when overlay (delete-overlay overlay))
+              (remove-hook 'after-change-functions after-change)
+              (remove-hook 'minibuffer-exit-hook unwind)
+              (let ((lazy-highlight-cleanup 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 minibuffer-lazy-count-format
+          (setq overlay (make-overlay (point-min) (point-min) (current-buffer) t))
+          (add-hook 'lazy-count-update-hook display-count))
+        (when filter
+          (add-function :after-while isearch-filter-predicate filter))
+        (funcall after-change nil nil nil)))))
 
 \f
 (defun isearch-resume (string regexp word forward message case-fold)
-- 
2.35.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Add-lazy-highlight-when-reading-query-replace-argume.patch --]
[-- Type: text/x-patch, Size: 5305 bytes --]

From 432fcd0172a538713d85e3d4a64c2586ae1a9a5b Mon Sep 17 00:00:00 2001
From: Augusto Stoffel <arstoffel@gmail.com>
Date: Sat, 9 Apr 2022 12:47:28 +0200
Subject: [PATCH 2/2] Add lazy highlight when reading 'query-replace' arguments

* lisp/replace.el (query-replace-read-args):  Use
'minibuffer-lazy-highlight-setup' to highlight the text to be replaced
in the original buffer (and a match count, if applicable).
(replace--region-filter): New function for code that
used to be inlined in perform-replace but is useful elsewhere.
(perform-replace): Use 'replace--region-filter'.
---
 lisp/replace.el | 65 +++++++++++++++++++++++++++++++++++--------------
 1 file changed, 47 insertions(+), 18 deletions(-)

diff --git a/lisp/replace.el b/lisp/replace.el
index e6f565d802..00d30d1e38 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -365,11 +365,33 @@ 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 (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))))
       (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 '-))))))
@@ -2778,6 +2800,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 +2904,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 #4: Type: text/plain, Size: 2483 bytes --]


> In `isearch-edit-string' you replaced:
>   (add-hook 'minibuffer-setup-hook #'minibuffer-lazy-highlight-setup)
> with
>   (minibuffer-with-setup-hook (minibuffer-lazy-highlight-setup)
> but the docstring of `minibuffer-lazy-highlight-setup' in your patch is:
>
>   This function return a closure intended to be added to
>   `minibuffer-setup-hook'.
>
> Maybe either a typo that needs to mention `minibuffer-with-setup-hook',
> or `minibuffer-setup-hook' needs to evaluate such closure with something like
>
>   (add-hook 'minibuffer-setup-hook (funcall 'minibuffer-lazy-highlight-setup))
>
> But since this is more ugly, then using `minibuffer-with-setup-hook' is fine.
>

Well, as a matter of fact the closure is meant to run in the
'minibuffer-setup-hook'.  This is not to say it's a good idea to use
'add-hook' to do add it there.  One should always use
'minibuffer-with-setup-hook' for that kind of stuff, I guess.

Feel free to copy edit the docstring, but in light of the above I didn't
change it for now.

>>> 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.
>
> Yep, let's do this later when people will ask for it.

All right, I've removed all the "clever business" related to delayed
clean up of the lazy highlight for now.

>>> 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.
>
> Now the parameters of minibuffer-lazy-highlight-setup look nice,
> so line count doesn't matter when code keeps simplicity.

So, my sample code from the previous message defined a function for this
snippet which already repeats 3 times

   (or replace-regexp-function
     delimited-flag
     (and replace-char-fold
          (not regexp-flag)
          #'char-fold-to-regexp))

I've removed that function for now.  We can reintroduce the function if
you deem it helpful.