unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Augusto Stoffel <arstoffel@gmail.com>
To: Juri Linkov <juri@linkov.net>
Cc: 53126@debbugs.gnu.org
Subject: bug#53126: 29.0.50; [PATCH] Lazy highlight/count when reading query-replace string, etc.
Date: Thu, 24 Mar 2022 20:03:33 +0100	[thread overview]
Message-ID: <878rsz6um2.fsf@gmail.com> (raw)
In-Reply-To: <86fsnc4fvm.fsf@mail.linkov.net> (Juri Linkov's message of "Sun,  20 Mar 2022 20:51:09 +0200")

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

On Sun, 20 Mar 2022 at 20:51, Juri Linkov <juri@linkov.net> wrote:

> Sorry, I have no idea who and how might want to use lazy-highlighting
> in the minibuffer.  I'd just provide a hook that any user can add
> to the minibuffer-setup-hook, or any package author can add
> to minibuffer-with-setup-hook.  But in any case we need more opinions.

All right, I think this brings us back to the original idea: we add lazy
highlight to query-replace now and decide later about the other commands
in replace.el.

I've attached an updated patch that applies over the already merged
changes.

Juri: you mentioned the idea of adding a new option
`query-replace-read-lazy-highlight'.  This is easier to add then remove
in the future, so my suggestion would be to first wait and see if anyone
actually needs that option.  For now lazy highlight when reading the
query-replace args is controlled by the good old
`query-replace-lazy-highlight'.


[-- 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: 8983 bytes --]

From bc85df88bf3bee99997163b6233ff82445eac66b 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 | 21 +++++++----
 lisp/replace.el | 99 ++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 87 insertions(+), 33 deletions(-)

diff --git a/lisp/isearch.el b/lisp/isearch.el
index 9b311cb49e..e93e4d8b92 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2352,7 +2352,9 @@ isearch-query-replace
 	(isearch-recursive-edit nil)
 	(isearch-string-propertized
          (isearch-string-propertize isearch-string)))
-    (isearch-done nil t)
+    (let ((lazy-highlight-cleanup (and lazy-highlight-cleanup
+                                       (not query-replace-lazy-highlight))))
+      (isearch-done nil t))
     (isearch-clean-overlays)
     (if (and isearch-other-end
 	     (if backward
@@ -2368,13 +2370,16 @@ isearch-query-replace
                (symbol-value query-replace-from-history-variable)))
     (perform-replace
      isearch-string-propertized
-     (query-replace-read-to
-      isearch-string-propertized
-      (concat "Query replace"
-              (isearch--describe-regexp-mode (or delimited isearch-regexp-function) t)
-	      (if backward " backward" "")
-	      (if (use-region-p) " in region" ""))
-      isearch-regexp)
+     (condition-case error
+         (query-replace-read-to
+          isearch-string-propertized
+          (concat "Query replace"
+                  (isearch--describe-regexp-mode (or delimited isearch-regexp-function) t)
+	          (if backward " backward" "")
+	          (if (use-region-p) " in region" ""))
+          isearch-regexp)
+       (t (lazy-highlight-cleanup lazy-highlight-cleanup)
+          (signal (car error) (cdr error))))
      t isearch-regexp (or delimited isearch-regexp-function) nil nil
      (if (use-region-p) (region-beginning))
      (if (use-region-p) (region-end))
diff --git a/lisp/replace.el b/lisp/replace.el
index 06be597855..a56e493d99 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,14 +372,49 @@ query-replace-read-args
   (unless noerror
     (barf-if-buffer-read-only))
   (save-mark-and-excursion
-    (let* ((from (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 '-)))
-                (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 '-))))))
+    (condition-case error
+        (let (;; Variables controlling lazy highlighting while reading
+              ;; FROM and TO.
+              (isearch-case-fold-search case-fold-search)
+              (isearch-lazy-highlight query-replace-lazy-highlight)
+              (isearch-regexp regexp-flag)
+              (isearch-regexp-function (or replace-regexp-function
+                                           (and current-prefix-arg
+                                                (not (eq current-prefix-arg '-)))
+                                           (and replace-char-fold
+                                                (not regexp-flag)
+                                                #'char-fold-to-regexp)))
+              (lazy-highlight-cleanup nil)
+              (minibuffer-lazy-highlight-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)))
+              from to)
+          (when query-replace-lazy-highlight
+            (add-hook 'minibuffer-setup-hook #'minibuffer-lazy-highlight-setup)
+            (when (use-region-p)
+              (letrec ((region-filter (replace--region-filter
+                                       (funcall region-extract-function 'bounds)))
+                       (cleanup (lambda ()
+                                  (remove-function isearch-filter-predicate region-filter)
+                                  (remove-hook 'minibuffer-exit-hook cleanup))))
+                (add-function :after-while isearch-filter-predicate region-filter)
+                (add-hook 'minibuffer-exit-hook cleanup))))
+          (setq from (query-replace-read-from prompt regexp-flag))
+          (setq 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 '-)))
+                    (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 '-))))
+      (t (lazy-highlight-cleanup)
+         (signal (car error) (cdr error))))))
 
 (defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p)
   "Replace some occurrences of FROM-STRING with TO-STRING.
@@ -2773,6 +2815,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)
@@ -2857,22 +2919,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


  reply	other threads:[~2022-03-24 19:03 UTC|newest]

Thread overview: 57+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-01-08 13:24 bug#53126: 29.0.50; [PATCH] Lazy highlight/count when reading query-replace string, etc Augusto Stoffel
2022-01-08 18:59 ` Juri Linkov
2022-01-08 19:35   ` Augusto Stoffel
2022-01-09  9:10     ` Juri Linkov
2022-01-09 10:02       ` Augusto Stoffel
2022-01-09 10:30         ` Augusto Stoffel
2022-01-09 18:58         ` Juri Linkov
2022-01-10 17:34           ` Augusto Stoffel
2022-01-10 19:09             ` Juri Linkov
2022-02-26 16:13               ` Augusto Stoffel
2022-03-15 17:09                 ` Juri Linkov
2022-03-15 21:33                   ` Augusto Stoffel
2022-03-16 18:56                     ` Juri Linkov
2022-03-16 20:09                       ` Augusto Stoffel
2022-03-17 17:09                         ` Juri Linkov
2022-03-17 19:10                           ` Augusto Stoffel
2022-03-17 20:40                             ` Juri Linkov
2022-03-17 21:42                               ` Augusto Stoffel
2022-03-20  9:38                               ` Augusto Stoffel
2022-03-20 18:51                                 ` Juri Linkov
2022-03-24 19:03                                   ` Augusto Stoffel [this message]
2022-03-25  8:39                                     ` Juri Linkov
2022-03-25  9:43                                       ` Augusto Stoffel
2022-03-27  7:46                                         ` Juri Linkov
2022-04-01  9:06                                           ` Augusto Stoffel
2022-04-01 16:35                                             ` Juri Linkov
2022-04-01 18:12                                               ` Augusto Stoffel
2022-04-02 18:23                                                 ` Juri Linkov
2022-04-03  8:32                                                   ` Augusto Stoffel
2022-04-03 17:06                                                     ` Juri Linkov
2022-04-04 16:37                                                     ` Juri Linkov
2022-04-05 16:38                                                       ` Augusto Stoffel
2022-04-05 17:12                                                         ` Juri Linkov
2022-04-07 19:32                                                           ` Augusto Stoffel
2022-04-08  7:32                                                             ` Juri Linkov
2022-04-08  7:53                                                               ` Augusto Stoffel
2022-04-09 11:06                                                               ` Augusto Stoffel
2022-04-10 19:38                                                                 ` Juri Linkov
2022-03-15 17:24                 ` Juri Linkov
2022-03-15 21:21                   ` Augusto Stoffel
2022-03-16 19:02                     ` Juri Linkov
2022-03-16 20:25                       ` Augusto Stoffel
2022-03-17 17:05                         ` Juri Linkov
2022-03-17 19:06                           ` Augusto Stoffel
2022-03-20 19:24                             ` Juri Linkov
2022-03-20 19:59                               ` Augusto Stoffel
2022-03-20 20:29                                 ` Juri Linkov
2022-03-20 20:56                                   ` Augusto Stoffel
2022-03-23 18:20                                     ` Juri Linkov
2022-03-23 18:54                                       ` Augusto Stoffel
2022-03-23 19:17                                         ` Eli Zaretskii
2022-03-23 19:53                                         ` Juri Linkov
2022-03-23 20:06                                           ` Juri Linkov
2022-03-23 20:30                                             ` Augusto Stoffel
2022-03-23 20:43                                               ` Juri Linkov
2022-03-17 19:45                           ` Augusto Stoffel
2022-03-17 20:43                             ` Juri Linkov

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=878rsz6um2.fsf@gmail.com \
    --to=arstoffel@gmail.com \
    --cc=53126@debbugs.gnu.org \
    --cc=juri@linkov.net \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).