From 92394967d27bb2750a88a19951182d1465b57040 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 | 65 +++++++++++++++++++++++++++++++++++++++++++------ lisp/replace.el | 49 +++++++++++++++++++++++-------------- 2 files changed, 88 insertions(+), 26 deletions(-) diff --git a/lisp/isearch.el b/lisp/isearch.el index 956b115ce4..b28a7b88a8 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)) @@ -4413,6 +4418,50 @@ minibuffer-lazy-highlight-setup (make-overlay (point-min) (point-min) (current-buffer) t))) (minibuffer-lazy-highlight--after-change nil nil nil)) +(cl-defmacro with-minibuffer-lazy-highlight (lazy-highlight &rest body &keys (regexp 'unset) (regexp-function 'unset) (case-fold 'unset) (cleanup 'unset) (region 'unset) (transform 'unset)) + (while (keywordp (car body) (setq body (cddr body)))) + `(let ((isearch-lazy-highlight ,lazy-highlight) + ,@(unless (eq 'unset ,case-fold) `(isearch-case-fold-search ,case-fold)) + ,@(unless (eq 'unset ,regexp) `(isearch-regexp ,regexp)) + ,@(unless (eq 'unset ,regexp-function) `(isearch-regexp-function ,regexp-function)) + ,@(unless (eq 'unset ,cleanup) `(lazy-highlight-cleanup ,cleanup)) + ,@(unless (eq 'unset ,transform )`(minibuffer-lazy-highlight-transform ,transform))) + (when isearch-lazy-highlight + (add-hook 'minibuffer-setup-hook #'minibuffer-lazy-highlight-setup) + (when ,region + (letrec ((region-filter (isearch-region-filter + (funcall region-extract-function ,region))) + (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)))) + (condition-case error + (progn ,@body) + (t (lazy-highlight-cleanup) + (signal (car error) (cdr error)))))) + +(defun isearch-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 isearch-resume (string regexp word forward message case-fold) "Resume an incremental search. diff --git a/lisp/replace.el b/lisp/replace.el index e6f565d802..bed4a2824d 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,7 +372,26 @@ 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* ((from (with-minibuffer-lazy-highlight + query-replace-lazy-highlight + :case-fold case-fold-search + :regexp regexp-flag + :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))) + :cleanup nil + :transform (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))) + (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 @@ -2862,22 +2888,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 (isearch-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