From 3e08f33fe45e41419278a614f7edb4f184ca9f5b Mon Sep 17 00:00:00 2001 From: Augusto Stoffel Date: Sat, 12 Mar 2022 10:43:54 +0100 Subject: [PATCH] Display lazy highlight and match count in when reading regexps * lisp/isearch.el (lazy-count-update-hook): New hook allowing to display the lazy count in special ways. (isearch-edit-string): Add lazy highlight and count of matching text. (isearch-lazy-highlight-new-loop, isearch-lazy-highlight-buffer-update): Use `isearch-lazy-count-display-function' instead of hardcoded call to `isearch-message'. (minibuffer-lazy-count-format, minibuffer-lazy-highlight-transform, minibuffer-lazy-highlight--overlay, minibuffer-lazy-highlight--count, minibuffer-lazy-highlight--after-change, minibuffer-lazy-highlight--exit, minibuffer-lazy-highlight-setup): Variables and functions implementing the lazy highlight functionality while reading from minibuffer. * lisp/replace.el (query-replace-read-args): Add lazy highlighting. (replace--region-filter): New function, extracted from 'perform-replace'. (perform-replace): Use 'replace--region-filter'. * lisp/comint.el (comint-history-isearch-setup, comint-history-isearch-end): Make sure no lazy count is displayed. * lisp/simple.el (minibuffer-history-isearch-setup): Make sure no lazy count is displayed. --- lisp/comint.el | 2 + lisp/isearch.el | 106 +++++++++++++++++++++++++++++++++++++++++------- lisp/replace.el | 99 ++++++++++++++++++++++++++++++++------------ lisp/simple.el | 1 + 4 files changed, 169 insertions(+), 39 deletions(-) diff --git a/lisp/comint.el b/lisp/comint.el index 4c82e74e4b..56082f622a 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1515,6 +1515,7 @@ comint-history-isearch-setup #'comint-history-isearch-wrap) (setq-local isearch-push-state-function #'comint-history-isearch-push-state) + (setq-local isearch-lazy-count nil) (add-hook 'isearch-mode-end-hook 'comint-history-isearch-end nil t))) (defun comint-history-isearch-end () @@ -1526,6 +1527,7 @@ comint-history-isearch-end (setq isearch-message-function nil) (setq isearch-wrap-function nil) (setq isearch-push-state-function nil) + (kill-local-variable 'isearch-lazy-count) (remove-hook 'isearch-mode-end-hook 'comint-history-isearch-end t) (unless isearch-suspended (custom-reevaluate-setting 'comint-history-isearch))) diff --git a/lisp/isearch.el b/lisp/isearch.el index 8970216398..bd337f38b7 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1812,6 +1812,8 @@ 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) @@ -2350,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 @@ -2366,13 +2370,15 @@ 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) + (unwind-protect + (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) + (lazy-highlight-cleanup lazy-highlight-cleanup)) t isearch-regexp (or delimited isearch-regexp-function) nil nil (if (use-region-p) (region-beginning)) (if (use-region-p) (region-end)) @@ -3990,6 +3996,8 @@ isearch-lazy-highlight-error (defvar isearch-lazy-count-current nil) (defvar isearch-lazy-count-total nil) (defvar isearch-lazy-count-hash (make-hash-table)) +(defvar lazy-count-update-hook nil + "Hook run after new lazy count results are computed.") (defun lazy-highlight-cleanup (&optional force procrastinate) "Stop lazy highlighting and remove extra highlighting from current buffer. @@ -4048,7 +4056,7 @@ isearch-lazy-highlight-new-loop isearch-lazy-highlight-window-end)))))) ;; something important did indeed change (lazy-highlight-cleanup t (not (equal isearch-string ""))) ;stop old timer - (when (and isearch-lazy-count isearch-mode (null isearch-message-function)) + (when isearch-lazy-count (when (or (equal isearch-string "") ;; Check if this place was reached by a condition above ;; other than changed window boundaries (that shouldn't @@ -4067,7 +4075,10 @@ isearch-lazy-highlight-new-loop (setq isearch-lazy-count-current nil isearch-lazy-count-total nil) ;; Delay updating the message if possible, to avoid flicker - (when (string-equal isearch-string "") (isearch-message)))) + (when (string-equal isearch-string "") + (when (and isearch-mode (null isearch-message-function)) + (isearch-message)) + (run-hooks 'lazy-count-update-hook)))) (setq isearch-lazy-highlight-window-start-changed nil) (setq isearch-lazy-highlight-window-end-changed nil) (setq isearch-lazy-highlight-error isearch-error) @@ -4120,13 +4131,15 @@ isearch-lazy-highlight-new-loop 'isearch-lazy-highlight-start)))) ;; Update the current match number only in isearch-mode and ;; unless isearch-mode is used specially with isearch-message-function - (when (and isearch-lazy-count isearch-mode (null isearch-message-function)) + (when isearch-lazy-count ;; Update isearch-lazy-count-current only when it was already set ;; at the end of isearch-lazy-highlight-buffer-update (when isearch-lazy-count-current (setq isearch-lazy-count-current (gethash (point) isearch-lazy-count-hash 0)) - (isearch-message)))) + (when (and isearch-mode (null isearch-message-function)) + (isearch-message)) + (run-hooks 'lazy-count-update-hook)))) (defun isearch-lazy-highlight-search (string bound) "Search ahead for the next or previous match, for lazy highlighting. @@ -4327,16 +4340,81 @@ isearch-lazy-highlight-buffer-update (setq looping nil nomore t)))) (if nomore - (when (and isearch-lazy-count isearch-mode (null isearch-message-function)) + (when isearch-lazy-count (unless isearch-lazy-count-total (setq isearch-lazy-count-total 0)) (setq isearch-lazy-count-current (gethash opoint isearch-lazy-count-hash 0)) - (isearch-message)) + (when (and isearch-mode (null isearch-message-function)) + (isearch-message)) + (run-hooks 'lazy-count-update-hook)) (setq isearch-lazy-highlight-timer (run-at-time lazy-highlight-interval nil 'isearch-lazy-highlight-buffer-update))))))))) + +;; Reading from minibuffer with lazy highlight and match count + +(defcustom minibuffer-lazy-count-format "%s " + "Format of the total number of matches for the prompt prefix." + :type '(choice (const :tag "Don't display a count" nil) + (string :tag "Display match count" "%s ")) + :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 () + "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)) + + (defun isearch-resume (string regexp word forward message case-fold) "Resume an incremental search. STRING is the string or regexp searched for. diff --git a/lisp/replace.el b/lisp/replace.el index 06be597855..f45fb5fb25 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. + (lazy-highlight-cleanup nil) + (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))) + (isearch-case-fold-search case-fold-search) + (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 diff --git a/lisp/simple.el b/lisp/simple.el index accc119e2b..61319b6060 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2840,6 +2840,7 @@ minibuffer-history-isearch-setup #'minibuffer-history-isearch-wrap) (setq-local isearch-push-state-function #'minibuffer-history-isearch-push-state) + (setq-local isearch-lazy-count nil) (add-hook 'isearch-mode-end-hook 'minibuffer-history-isearch-end nil t)) (defun minibuffer-history-isearch-end () -- 2.35.1