diff options
Diffstat (limited to 'lisp/replace.el')
| -rw-r--r-- | lisp/replace.el | 158 |
1 files changed, 140 insertions, 18 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index 0880cbdb1ea..3a2ab1d24c8 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -126,6 +126,18 @@ This variable affects only `query-replace-regexp'." :type 'boolean :group 'matching) +(defcustom query-replace-highlight-submatches t + "Whether to highlight regexp subexpressions during query replacement. +The faces used to do the highlights are named `isearch-group-1', +`isearch-group-2', etc. (By default, only these 2 are defined.) +When there are more matches than faces, then faces are reused from the +beginning, in a cyclical manner, so the `isearch-group-1' face is +isreused for the third match. If you want to use more distinctive colors, +you can define more of these faces using the same numbering scheme." + :type 'boolean + :group 'matching + :version "28.1") + (defcustom query-replace-lazy-highlight t "Controls the lazy-highlighting during query replacements. When non-nil, all text in the buffer matching the current match @@ -208,12 +220,15 @@ wants to replace FROM with TO." (minibuffer-allow-text-properties t) ; separator uses text-properties (prompt (cond ((and query-replace-defaults separator) - (format "%s (default %s): " prompt (car minibuffer-history))) + (format-prompt prompt (car minibuffer-history))) (query-replace-defaults - (format "%s (default %s -> %s): " prompt - (query-replace-descr (caar query-replace-defaults)) - (query-replace-descr (cdar query-replace-defaults)))) - (t (format "%s: " prompt)))) + (format-prompt + prompt (format "%s -> %s" + (query-replace-descr + (caar query-replace-defaults)) + (query-replace-descr + (cdar query-replace-defaults))))) + (t (format-prompt prompt nil)))) (from ;; The save-excursion here is in case the user marks and copies ;; a region in order to specify the minibuffer input. @@ -757,6 +772,13 @@ which will run faster and will not set the mark or print anything." Maximum length of the history list is determined by the value of `history-length', which see.") +(defvar occur-highlight-regexp t + "Regexp matching part of visited source lines to highlight temporarily. +Highlight entire line if t; don't highlight source lines if nil.") + +(defvar occur-highlight-overlay nil + "Overlay used to temporarily highlight occur matches.") + (defvar occur-collect-regexp-history '("\\1") "History of regexp for occur's collect operation") @@ -884,7 +906,8 @@ and `search-upper-case' is non-nil, the matching is case-sensitive. Second and third arg RSTART and REND specify the region to operate on. This command operates on (the accessible part of) all lines whose accessible part is entirely contained in the region determined by RSTART -and REND. (A newline ending a line counts as part of that line.) +and REND. (A newline ending a line counts as part of that line.) If RSTART +is non-nil, REND also has to be given. Interactively, in Transient Mark mode when the mark is active, operate on all lines whose accessible part is entirely contained in the region. @@ -1113,6 +1136,8 @@ a previously found match." (define-key map "\C-m" 'occur-mode-goto-occurrence) (define-key map "o" 'occur-mode-goto-occurrence-other-window) (define-key map "\C-o" 'occur-mode-display-occurrence) + (define-key map "n" 'next-error-no-select) + (define-key map "p" 'previous-error-no-select) (define-key map "\M-n" 'occur-next) (define-key map "\M-p" 'occur-prev) (define-key map "r" 'occur-rename-buffer) @@ -1261,9 +1286,12 @@ If not invoked by a mouse click, go to occurrence on the current line." (with-current-buffer (window-buffer (posn-window (event-end event))) (save-excursion (goto-char (posn-point (event-end event))) - (occur-mode-find-occurrence)))))) + (occur-mode-find-occurrence))))) + (regexp occur-highlight-regexp)) (pop-to-buffer (marker-buffer pos)) (goto-char pos) + (let ((end-mk (save-excursion (re-search-forward regexp nil t)))) + (occur--highlight-occurrence pos end-mk)) (when buffer (next-error-found buffer (current-buffer))) (run-hooks 'occur-mode-find-occurrence-hook))) @@ -1277,17 +1305,74 @@ If not invoked by a mouse click, go to occurrence on the current line." (next-error-found buffer (current-buffer)) (run-hooks 'occur-mode-find-occurrence-hook))) +;; Stolen from compile.el +(defun occur-goto-locus-delete-o () + (delete-overlay occur-highlight-overlay) + ;; Get rid of timer and hook that would try to do this again. + (if (timerp next-error-highlight-timer) + (cancel-timer next-error-highlight-timer)) + (remove-hook 'pre-command-hook + #'occur-goto-locus-delete-o)) + +;; Highlight the current visited occurrence. +;; Adapted from `compilation-goto-locus'. +(defun occur--highlight-occurrence (mk end-mk) + (let ((highlight-regexp occur-highlight-regexp)) + (if (timerp next-error-highlight-timer) + (cancel-timer next-error-highlight-timer)) + (unless occur-highlight-overlay + (setq occur-highlight-overlay + (make-overlay (point-min) (point-min))) + (overlay-put occur-highlight-overlay 'face 'next-error)) + (with-current-buffer (marker-buffer mk) + (save-excursion + (if end-mk (goto-char end-mk) (end-of-line)) + (let ((end (point))) + (if mk (goto-char mk) (beginning-of-line)) + (if (and (stringp highlight-regexp) + (re-search-forward highlight-regexp end t)) + (progn + (goto-char (match-beginning 0)) + (move-overlay occur-highlight-overlay + (match-beginning 0) (match-end 0) + (current-buffer))) + (move-overlay occur-highlight-overlay + (point) end (current-buffer))) + (if (or (eq next-error-highlight t) + (numberp next-error-highlight)) + ;; We want highlighting: delete overlay on next input. + (add-hook 'pre-command-hook + #'occur-goto-locus-delete-o) + ;; We don't want highlighting: delete overlay now. + (delete-overlay occur-highlight-overlay)) + ;; We want highlighting for a limited time: + ;; set up a timer to delete it. + (when (numberp next-error-highlight) + (setq next-error-highlight-timer + (run-at-time next-error-highlight nil + 'occur-goto-locus-delete-o)))))) + (when (eq next-error-highlight 'fringe-arrow) + ;; We want a fringe arrow (instead of highlighting). + (setq next-error-overlay-arrow-position + (copy-marker (line-beginning-position)))))) + (defun occur-mode-display-occurrence () "Display in another window the occurrence the current line describes." (interactive) (let ((buffer (current-buffer)) (pos (occur-mode-find-occurrence)) + (regexp occur-highlight-regexp) + (next-error-highlight next-error-highlight-no-select) + (display-buffer-overriding-action + '(nil (inhibit-same-window . t))) window) (setq window (display-buffer (marker-buffer pos) t)) ;; This is the way to set point in the proper window. (save-selected-window (select-window window) (goto-char pos) + (let ((end-mk (save-excursion (re-search-forward regexp nil t)))) + (occur--highlight-occurrence pos end-mk)) (next-error-found buffer (current-buffer)) (run-hooks 'occur-mode-find-occurrence-hook)))) @@ -1418,7 +1503,7 @@ which means to discard all text properties." ;; Get the regexp for collection pattern. (let ((default (car occur-collect-regexp-history))) (read-regexp - (format "Regexp to collect (default %s): " default) + (format-prompt "Regexp to collect" default) default 'occur-collect-regexp-history))) ;; Otherwise normal occur takes numerical prefix argument. (when current-prefix-arg @@ -1500,6 +1585,19 @@ is not modified." (defvar ido-ignore-item-temp-list) +(defun multi-occur--prompt () + (concat + "Next buffer to search " + (cond + ((or (eq read-buffer-function #'ido-read-buffer) + (bound-and-true-p ido-everywhere)) + (substitute-command-keys + "(\\<ido-completion-map>\\[ido-select-text] to end): ")) + ((bound-and-true-p fido-mode) + (substitute-command-keys + "(\\<icomplete-fido-mode-map>\\[icomplete-fido-exit] to end): ")) + (t "(RET to end): ")))) + (defun multi-occur (bufs regexp &optional nlines) "Show all lines in buffers BUFS containing a match for REGEXP. Optional argument NLINES specifies the number of context lines to show @@ -1515,11 +1613,7 @@ See also `multi-occur-in-matching-buffers'." (buf nil) (ido-ignore-item-temp-list bufs)) (while (not (string-equal - (setq buf (read-buffer - (if (eq read-buffer-function #'ido-read-buffer) - "Next buffer to search (C-j to end): " - "Next buffer to search (RET to end): ") - nil t)) + (setq buf (read-buffer (multi-occur--prompt) nil t)) "")) (cl-pushnew buf bufs) (setq ido-ignore-item-temp-list bufs)) @@ -1583,7 +1677,8 @@ See also `multi-occur'." (and (overlayp boo) (overlay-buffer boo))) boo)) - bufs)))) + bufs))) + (source-buffer-default-directory default-directory)) ;; Handle the case where one of the buffers we're searching is the ;; output buffer. Just rename it. (when (member buf-name @@ -1600,6 +1695,9 @@ See also `multi-occur'." (setq occur-buf (get-buffer-create buf-name)) (with-current-buffer occur-buf + ;; Make the default-directory of the *Occur* buffer match that of + ;; the buffer where the occurrences come from + (setq default-directory source-buffer-default-directory) (if (stringp nlines) (fundamental-mode) ;; This is for collect operation. (occur-mode)) @@ -1608,6 +1706,7 @@ See also `multi-occur'." (buffer-undo-list t) (occur--final-pos nil)) (erase-buffer) + (set (make-local-variable 'occur-highlight-regexp) regexp) (let ((count (if (stringp nlines) ;; Treat nlines as a regexp to collect. @@ -1944,10 +2043,8 @@ See also `multi-occur'." global-matches))) (defun occur-engine-line (beg end &optional keep-props) - (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) - (text-property-not-all beg end 'fontified t)) - (if (fboundp 'jit-lock-fontify-now) - (jit-lock-fontify-now beg end))) + (if (and keep-props font-lock-mode) + (font-lock-ensure beg end)) (if (and keep-props (not (eq occur-excluded-properties t))) (let ((str (buffer-substring beg end))) (remove-list-of-text-properties @@ -2319,6 +2416,7 @@ It is called with three arguments, as if it were (funcall search-function search-string limit t))) (defvar replace-overlay nil) +(defvar replace-submatches-overlays nil) (defun replace-highlight (match-beg match-end range-beg range-end search-string regexp-flag delimited-flag @@ -2329,6 +2427,25 @@ It is called with three arguments, as if it were (setq replace-overlay (make-overlay match-beg match-end)) (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays (overlay-put replace-overlay 'face 'query-replace))) + + (when (and query-replace-highlight-submatches + regexp-flag) + (mapc 'delete-overlay replace-submatches-overlays) + (setq replace-submatches-overlays nil) + (let ((submatch-data (cddr (butlast (match-data t)))) + (group 0) + ov face) + (while submatch-data + (setq group (1+ group)) + (setq ov (make-overlay (pop submatch-data) (pop submatch-data)) + face (intern-soft (format "isearch-group-%d" group))) + ;; Recycle faces from beginning. + (unless (facep face) + (setq group 1 face 'isearch-group-1)) + (overlay-put ov 'face face) + (overlay-put ov 'priority 1002) + (push ov replace-submatches-overlays)))) + (if query-replace-lazy-highlight (let ((isearch-string search-string) (isearch-regexp regexp-flag) @@ -2349,6 +2466,9 @@ It is called with three arguments, as if it were (defun replace-dehighlight () (when replace-overlay (delete-overlay replace-overlay)) + (when query-replace-highlight-submatches + (mapc 'delete-overlay replace-submatches-overlays) + (setq replace-submatches-overlays nil)) (when query-replace-lazy-highlight (lazy-highlight-cleanup lazy-highlight-cleanup) (setq isearch-lazy-highlight-last-string nil)) @@ -2878,6 +2998,8 @@ characters." (replace-dehighlight) (save-excursion (recursive-edit)) (setq replaced t)) + ((commandp def t) + (call-interactively def)) ;; Note: we do not need to treat `exit-prefix' ;; specially here, since we reread ;; any unrecognized character. |