diff options
Diffstat (limited to 'lisp/replace.el')
| -rw-r--r-- | lisp/replace.el | 119 |
1 files changed, 102 insertions, 17 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index 0880cbdb1ea..2d17ec9097c 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -208,12 +208,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 +760,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") @@ -1113,6 +1123,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 +1273,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 +1292,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 +1490,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 +1572,18 @@ is not modified." (defvar ido-ignore-item-temp-list) +(defun multi-occur--prompt () + (concat + "Next buffer to search " + (cond + ((eq read-buffer-function #'ido-read-buffer) + (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 +1599,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 +1663,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 +1681,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 +1692,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 +2029,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 @@ -2878,6 +2961,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. |