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