From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Augusto Stoffel Newsgroups: gmane.emacs.bugs Subject: bug#53126: 29.0.50; [PATCH] Lazy highlight/count when reading query-replace string, etc. Date: Thu, 07 Apr 2022 21:32:21 +0200 Message-ID: <87r168g056.fsf@gmail.com> References: <87sftyweb2.fsf@gmail.com> <87ee32yk7v.fsf@gmail.com> <861qz1zqfb.fsf@mail.linkov.net> <875yod1wyb.fsf@gmail.com> <86mtho5y56.fsf@mail.linkov.net> <87sfrgz979.fsf@gmail.com> <861qz0475w.fsf@mail.linkov.net> <87sfrd2cbb.fsf@gmail.com> <86fsnc4fvm.fsf@mail.linkov.net> <878rsz6um2.fsf@gmail.com> <86ils2mmbe.fsf@mail.linkov.net> <87v8w2qsee.fsf@gmail.com> <86y20vu9c6.fsf@mail.linkov.net> <875ynt41g9.fsf@gmail.com> <86pmm1azkd.fsf@mail.linkov.net> <87a6d43c6n.fsf@gmail.com> <86r16fz6bw.fsf@mail.linkov.net> <87o81i5zzn.fsf@gmail.com> <86v8vo6c2k.fsf@mail.linkov.net> <87bkxfeb8j.fsf@gmail.com> <86wng3laj3.fsf@mail.linkov.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="36754"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.1.50 (gnu/linux) Cc: 53126@debbugs.gnu.org To: Juri Linkov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Apr 07 21:33:12 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ncXsV-0009He-FV for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 07 Apr 2022 21:33:11 +0200 Original-Received: from localhost ([::1]:38048 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ncXsU-0006Yl-0l for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 07 Apr 2022 15:33:10 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:45086) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ncXsM-0006YR-Da for bug-gnu-emacs@gnu.org; Thu, 07 Apr 2022 15:33:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:39516) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ncXsM-0001y9-3v for bug-gnu-emacs@gnu.org; Thu, 07 Apr 2022 15:33:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ncXsL-0003Pr-PI for bug-gnu-emacs@gnu.org; Thu, 07 Apr 2022 15:33:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Augusto Stoffel Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 07 Apr 2022 19:33:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 53126 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 53126-submit@debbugs.gnu.org id=B53126.164935995313068 (code B ref 53126); Thu, 07 Apr 2022 19:33:01 +0000 Original-Received: (at 53126) by debbugs.gnu.org; 7 Apr 2022 19:32:33 +0000 Original-Received: from localhost ([127.0.0.1]:33410 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ncXrs-0003Oh-Ip for submit@debbugs.gnu.org; Thu, 07 Apr 2022 15:32:33 -0400 Original-Received: from mail-ed1-f54.google.com ([209.85.208.54]:43633) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ncXrq-0003OI-PE for 53126@debbugs.gnu.org; Thu, 07 Apr 2022 15:32:31 -0400 Original-Received: by mail-ed1-f54.google.com with SMTP id b24so7581583edu.10 for <53126@debbugs.gnu.org>; Thu, 07 Apr 2022 12:32:30 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=rYdHH9uneJRQMGsH7qO8oeSJQW+XOfCRE8NWccm7QoE=; b=KqNgHKGgRxmk7uCKfY9N+QISChnwyQ1Dcch7EckQaGiXIGnGAN3tWMIVbCh0aTDvLN 0Ci8Wf2olcCwI7bP+TBPL5bKgkY12WurP1qPihthzHUj8j24GqeQPp11IJ5JpzaePzKs 4GUq+w3+h/mSGhdeEB47boZeJCN7UlXeBR2W+0moINbL12GCrlVwpmKRTURb33Ebtf0E zwH7dramupHFNGGLx6KNfyWhDLd+nKEhs23BjB403tzMu+5WU7wdtRx9yJI3TfwBkxHa TnV1r/jmTPiRD3i19de52vC53PF3HC+zluzPrucopdNajzJnaI3vDBnQ3huCHSGK2Na9 eXjw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=rYdHH9uneJRQMGsH7qO8oeSJQW+XOfCRE8NWccm7QoE=; b=du5hC1N88UjBieWih9D45v/9y2Jx5ImkccwKwsAb/X0GDhp8a411dhVG47T1kIMwAA uRF7vYNfAuuE4RlJvk4wQ4waS91oGn1mWP727v+UFEWBvGM2zEwXJdYkxyQxH79+hxab e5VUTcxp34agdqXOKEPp5jzBl3pnXWEX3vXXpvMSE6F4NloqWRj/UJtP8E4dEfAElfyS 2xYm9J5Njt7NzlCnUtFEiwOC1GBnRlQZtKfGHxFPR6n+xGNxr1cM8XjZWv6FQ0u889MT YiGFaWgXZIcAXaEM+y4l1xhobu9SN0f95c6QqD1olWk8eYfdQ8xTBNueuGKp7OwBJ6dX OKFg== X-Gm-Message-State: AOAM530HJS7/0zAJftXpTnFAH07IC+DL3i3XbOsTfk26g15XfQ210DOa C6zxcjUttAosWKGXEPAD/5e8itZtlcw= X-Google-Smtp-Source: ABdhPJwhQuiK+gZnpcEl0bROXX2S2ZjAlcD+DJho20W4J8SMBWBli2Oehn4Y8idb9W5obVIzKrSkdA== X-Received: by 2002:aa7:db94:0:b0:410:f0e8:c39e with SMTP id u20-20020aa7db94000000b00410f0e8c39emr15558057edt.14.1649359944346; Thu, 07 Apr 2022 12:32:24 -0700 (PDT) Original-Received: from ars3 ([2a02:8109:8ac0:56d0::7039]) by smtp.gmail.com with ESMTPSA id jl11-20020a17090775cb00b006e7b1c5cf81sm5539404ejc.189.2022.04.07.12.32.22 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 07 Apr 2022 12:32:23 -0700 (PDT) In-Reply-To: <86wng3laj3.fsf@mail.linkov.net> (Juri Linkov's message of "Tue, 05 Apr 2022 20:12:16 +0300") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:229538 Archived-At: --=-=-= Content-Type: text/plain On Tue, 5 Apr 2022 at 20:12, Juri Linkov 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.) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Display-lazy-highlight-and-match-count-in-query-repl.patch >From 173c24fc4f90c92f5c9035c76fc578bf11d33294 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel 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))))) (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 --=-=-= Content-Type: text/plain >>> 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. --=-=-=--