diff options
Diffstat (limited to 'lisp/replace.el')
| -rw-r--r-- | lisp/replace.el | 539 |
1 files changed, 359 insertions, 180 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index eb7a439b54a..69bdfe1331d 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -213,7 +213,7 @@ wants to replace FROM with TO." (when query-replace-from-to-separator ;; Check if the first non-whitespace char is displayable (if (char-displayable-p - (string-to-char (replace-regexp-in-string + (string-to-char (string-replace " " "" query-replace-from-to-separator))) query-replace-from-to-separator " -> "))) @@ -310,7 +310,7 @@ the original string if not." ;; but not after (quote foo). (and (eq (car-safe (car pos)) 'quote) (not (= ?\( (aref to 0))))) - (eq (string-match " " to (cdr pos)) + (eq (string-search " " to (cdr pos)) (cdr pos))) (1+ (cdr pos)) (cdr pos)))) @@ -432,6 +432,9 @@ In Transient Mark mode, if the mark is active, operate on the contents of the region. Otherwise, operate from point to the end of the buffer's accessible portion. +When invoked interactively, matching a newline with `\\n' will not work; +use `C-q C-j' instead. To match a tab character (`\\t'), just press `TAB'. + Use \\<minibuffer-local-map>\\[next-history-element] \ to pull the last incremental search regexp to the minibuffer that reads REGEXP, or invoke replacements from @@ -630,13 +633,13 @@ Arguments REGEXP, START, END, and REGION-NONCONTIGUOUS-P are passed to (if (listp to-strings) (setq replacements to-strings) (while (/= (length to-strings) 0) - (if (string-match " " to-strings) + (if (string-search " " to-strings) (setq replacements (append replacements (list (substring to-strings 0 - (string-match " " to-strings)))) + (string-search " " to-strings)))) to-strings (substring to-strings - (1+ (string-match " " to-strings)))) + (1+ (string-search " " to-strings)))) (setq replacements (append replacements (list to-strings)) to-strings "")))) (perform-replace regexp replacements t t nil n nil start end nil region-noncontiguous-p))) @@ -789,12 +792,8 @@ 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-highlight-overlays nil + "Overlays used to temporarily highlight occur matches.") (defvar occur-collect-regexp-history '("\\1") "History of regexp for occur's collect operation") @@ -1051,6 +1050,130 @@ also print the number." count)) count)) +(defun kill-matching-lines (regexp &optional rstart rend interactive) + "Kill lines containing matches for REGEXP. + +When called from Lisp (and usually when called interactively as +well, see below), applies to the part of the buffer after point. +The line point is in is killed if and only if it contains a match +for REGEXP starting after point. + +If REGEXP contains upper case characters (excluding those +preceded by `\\') and `search-upper-case' is non-nil, the +matching is case-sensitive. + +Second and third args RSTART and REND specify the region to +operate on. Lines partially contained in this region are killed +if and only if they contain a match entirely contained in the +region. + +Interactively, in Transient Mark mode when the mark is active, +operate on the contents of the region. Otherwise, operate from +point to the end of (the accessible portion of) the buffer. + +If a match is split across lines, all the lines it lies in are +killed. They are killed _before_ looking for the next match. +Hence, a match starting on the same line at which another match +ended is ignored. + +Return the number of killed matching lines. When called +interactively, also print the number." + (interactive + (progn + (barf-if-buffer-read-only) + (keep-lines-read-args "Kill lines containing match for regexp"))) + (if rstart + (progn + (goto-char (min rstart rend)) + (setq rend (copy-marker (max rstart rend)))) + (if (and interactive (use-region-p)) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (setq rstart (point) + rend (point-max-marker))) + (goto-char rstart)) + (let ((count 0) + (case-fold-search + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search))) + (save-excursion + (while (and (< (point) rend) + (re-search-forward regexp rend t)) + (unless (zerop count) + (setq last-command 'kill-region)) + (kill-region (save-excursion (goto-char (match-beginning 0)) + (forward-line 0) + (point)) + (progn (forward-line 1) (point))) + (setq count (1+ count)))) + (set-marker rend nil) + (when interactive (message (ngettext "Killed %d matching line" + "Killed %d matching lines" + count) + count)) + count)) + +(defun copy-matching-lines (regexp &optional rstart rend interactive) + "Copy lines containing matches for REGEXP to the kill ring. + +When called from Lisp (and usually when called interactively as +well, see below), applies to the part of the buffer after point. +The line point is in is copied if and only if it contains a match +for REGEXP starting after point. + +If REGEXP contains upper case characters (excluding those +preceded by `\\') and `search-upper-case' is non-nil, the +matching is case-sensitive. + +Second and third args RSTART and REND specify the region to +operate on. Lines partially contained in this region are copied +if and only if they contain a match entirely contained in the +region. + +Interactively, in Transient Mark mode when the mark is active, +operate on the contents of the region. Otherwise, operate from +point to the end of (the accessible portion of) the buffer. + +If a match is split across lines, all the lines it lies in are +copied. + +Return the number of copied matching lines. When called +interactively, also print the number." + (interactive + (keep-lines-read-args "Copy lines containing match for regexp")) + (if rstart + (progn + (goto-char (min rstart rend)) + (setq rend (copy-marker (max rstart rend)))) + (if (and interactive (use-region-p)) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (setq rstart (point) + rend (point-max-marker))) + (goto-char rstart)) + (let ((count 0) + (case-fold-search + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search))) + (save-excursion + (while (and (< (point) rend) + (re-search-forward regexp rend t)) + (unless (zerop count) + (setq last-command 'kill-region)) + (copy-region-as-kill (save-excursion (goto-char (match-beginning 0)) + (forward-line 0) + (point)) + (progn (forward-line 1) (point))) + (setq count (1+ count)))) + (set-marker rend nil) + (when interactive (message (ngettext "Copied %d matching line" + "Copied %d matching lines" + count) + count)) + count)) + (defun how-many (regexp &optional rstart rend interactive) "Print and return number of matches for REGEXP following point. When called from Lisp and INTERACTIVE is omitted or nil, just return @@ -1086,17 +1209,17 @@ a previously found match." rend (point-max))) (goto-char rstart)) (let ((count 0) - opoint (case-fold-search (if (and case-fold-search search-upper-case) (isearch-no-upper-case-p regexp t) case-fold-search))) (while (and (< (point) rend) - (progn (setq opoint (point)) - (re-search-forward regexp rend t))) - (if (= opoint (point)) - (forward-char 1) - (setq count (1+ count)))) + (re-search-forward regexp rend t)) + ;; Ensure forward progress on zero-length matches like "^$". + (when (and (= (match-beginning 0) (match-end 0)) + (not (eobp))) + (forward-char 1)) + (setq count (1+ count))) (when interactive (message (ngettext "%d occurrence" "%d occurrences" count) @@ -1104,51 +1227,39 @@ a previously found match." count))) -(defvar occur-menu-map - (let ((map (make-sparse-keymap))) - (bindings--define-key map [next-error-follow-minor-mode] - '(menu-item "Auto Occurrence Display" - next-error-follow-minor-mode - :help "Display another occurrence when moving the cursor" - :button (:toggle . (and (boundp 'next-error-follow-minor-mode) - next-error-follow-minor-mode)))) - (bindings--define-key map [separator-1] menu-bar-separator) - (bindings--define-key map [kill-this-buffer] - '(menu-item "Kill Occur Buffer" kill-this-buffer - :help "Kill the current *Occur* buffer")) - (bindings--define-key map [quit-window] - '(menu-item "Quit Occur Window" quit-window - :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame")) - (bindings--define-key map [revert-buffer] - '(menu-item "Revert Occur Buffer" revert-buffer - :help "Replace the text in the *Occur* buffer with the results of rerunning occur")) - (bindings--define-key map [clone-buffer] - '(menu-item "Clone Occur Buffer" clone-buffer - :help "Create and return a twin copy of the current *Occur* buffer")) - (bindings--define-key map [occur-rename-buffer] - '(menu-item "Rename Occur Buffer" occur-rename-buffer - :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")) - (bindings--define-key map [occur-edit-buffer] - '(menu-item "Edit Occur Buffer" occur-edit-mode - :help "Edit the *Occur* buffer and apply changes to the original buffers.")) - (bindings--define-key map [separator-2] menu-bar-separator) - (bindings--define-key map [occur-mode-goto-occurrence-other-window] - '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window - :help "Go to the occurrence the current line describes, in another window")) - (bindings--define-key map [occur-mode-goto-occurrence] - '(menu-item "Go To Occurrence" occur-mode-goto-occurrence - :help "Go to the occurrence the current line describes")) - (bindings--define-key map [occur-mode-display-occurrence] - '(menu-item "Display Occurrence" occur-mode-display-occurrence - :help "Display in another window the occurrence the current line describes")) - (bindings--define-key map [occur-next] - '(menu-item "Move to Next Match" occur-next - :help "Move to the Nth (default 1) next match in an Occur mode buffer")) - (bindings--define-key map [occur-prev] - '(menu-item "Move to Previous Match" occur-prev - :help "Move to the Nth (default 1) previous match in an Occur mode buffer")) - map) - "Menu keymap for `occur-mode'.") +(easy-menu-define occur-menu-map nil + "Menu for `occur-mode'." + '("Occur" + ["Move to Previous Match" occur-prev + :help "Move to the Nth (default 1) previous match in an Occur mode buffer"] + ["Move to Next Match" occur-next + :help "Move to the Nth (default 1) next match in an Occur mode buffer"] + ["Display Occurrence" occur-mode-display-occurrence + :help "Display in another window the occurrence the current line describes"] + ["Go To Occurrence" occur-mode-goto-occurrence + :help "Go to the occurrence the current line describes"] + ["Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window + :help "Go to the occurrence the current line describes, in another window"] + "---" + ["Edit Occur Buffer" occur-edit-mode + :help "Edit the *Occur* buffer and apply changes to the original buffers."] + ["Rename Occur Buffer" occur-rename-buffer + :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*."] + ["Clone Occur Buffer" clone-buffer + :help "Create and return a twin copy of the current *Occur* buffer"] + ["Revert Occur Buffer" revert-buffer + :help "Replace the text in the *Occur* buffer with the results of rerunning occur"] + ["Quit Occur Window" quit-window + :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"] + ["Kill Occur Buffer" kill-this-buffer + :help "Kill the current *Occur* buffer"] + "---" + ["Auto Occurrence Display" + next-error-follow-minor-mode + :help "Display another occurrence when moving the cursor" + :style toggle + :selected (and (boundp 'next-error-follow-minor-mode) + next-error-follow-minor-mode)])) (defvar occur-mode-map (let ((map (make-sparse-keymap))) @@ -1242,18 +1353,27 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (occur-mode) (message "Switching to Occur mode."))) +(defun occur--targets-start (targets) + "First marker of the `occur-target' property value TARGETS." + (if (consp targets) + (caar targets) + ;; Tolerate an `occur-target' value that is a single marker for + ;; compatibility. + targets)) + (defun occur-after-change-function (beg end length) (save-excursion (goto-char beg) (let* ((line-beg (line-beginning-position)) - (m (get-text-property line-beg 'occur-target)) + (targets (get-text-property line-beg 'occur-target)) + (m (occur--targets-start targets)) (buf (marker-buffer m)) col) (when (and (get-text-property line-beg 'occur-prefix) (not (get-text-property end 'occur-prefix))) (when (= length 0) ;; Apply occur-target property to inserted (e.g. yanked) text. - (put-text-property beg end 'occur-target m) + (put-text-property beg end 'occur-target targets) ;; Did we insert a newline? Occur Edit mode can't create new ;; Occur entries; just discard everything after the newline. (save-excursion @@ -1278,8 +1398,27 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (recenter line) (if readonly (message "Buffer `%s' is read only." buf) - (delete-region (line-beginning-position) (line-end-position)) - (insert text)) + ;; Replace the line, but make the change as small as + ;; possible by shrink-wrapping. That way, we avoid + ;; disturbing markers unnecessarily. + (let* ((beg-pos (line-beginning-position)) + (end-pos (line-end-position)) + (buf-str (buffer-substring-no-properties beg-pos end-pos)) + (common-prefix + (lambda (s1 s2) + (let ((c (compare-strings s1 nil nil s2 nil nil))) + (if (numberp c) + (1- (abs c)) + (length s1))))) + (prefix-len (funcall common-prefix buf-str text)) + (suffix-len (funcall common-prefix + (reverse buf-str) (reverse text)))) + (setq beg-pos (+ beg-pos prefix-len)) + (setq end-pos (- end-pos suffix-len)) + (setq text (substring text prefix-len (- suffix-len))) + (delete-region beg-pos end-pos) + (goto-char beg-pos) + (insert text))) (move-to-column col))))))) @@ -1287,35 +1426,56 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." "Handle `revert-buffer' for Occur mode buffers." (apply #'occur-1 (append occur-revert-arguments (list (buffer-name))))) +;; Retained for compatibility. (defun occur-mode-find-occurrence () - (let ((pos (get-text-property (point) 'occur-target))) - (unless pos + "Return a marker to the first match of the line at point." + (occur--targets-start (occur-mode--find-occurrences))) + +(defun occur-mode--find-occurrences () + ;; The `occur-target' property value is a list of (BEG . END) for each + ;; match on the line, or (for compatibility) a single marker to the start + ;; of the first match. + (let* ((targets (get-text-property (point) 'occur-target)) + (start (occur--targets-start targets))) + (unless targets (error "No occurrence on this line")) - (unless (buffer-live-p (marker-buffer pos)) + (unless (buffer-live-p (marker-buffer start)) (error "Buffer for this occurrence was killed")) - pos)) + targets)) + +(defun occur--set-arrow () + "Set the overlay arrow at the first line of the occur match at point." + (save-excursion + (let ((target (get-text-property (point) 'occur-target)) + ;; Find the start of the occur match, in case it's multi-line. + (prev (previous-single-property-change (point) 'occur-target))) + (when (and prev (eq (get-text-property prev 'occur-target) target)) + (goto-char prev)) + (setq overlay-arrow-position + (set-marker (or overlay-arrow-position (make-marker)) + (line-beginning-position)))))) (defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence) (defun occur-mode-goto-occurrence (&optional event) "Go to the occurrence specified by EVENT, a mouse click. If not invoked by a mouse click, go to occurrence on the current line." (interactive (list last-nonmenu-event)) - (let ((buffer (when event (current-buffer))) - (pos - (if (null event) - ;; Actually `event-end' works correctly with a nil argument as - ;; well, so we could dispense with this test, but let's not - ;; rely on this undocumented behavior. - (occur-mode-find-occurrence) - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion - (goto-char (posn-point (event-end event))) - (occur-mode-find-occurrence))))) - (regexp occur-highlight-regexp)) + (let* ((buffer (when event (current-buffer))) + (targets + (if (null event) + ;; Actually `event-end' works correctly with a nil argument as + ;; well, so we could dispense with this test, but let's not + ;; rely on this undocumented behavior. + (occur-mode--find-occurrences) + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion + (goto-char (posn-point (event-end event))) + (occur-mode--find-occurrences))))) + (pos (occur--targets-start targets))) + (occur--set-arrow) (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)) + (occur--highlight-occurrences targets) (when buffer (next-error-found buffer (current-buffer))) (run-hooks 'occur-mode-find-occurrence-hook))) @@ -1323,15 +1483,16 @@ If not invoked by a mouse click, go to occurrence on the current line." "Go to the occurrence the current line describes, in another window." (interactive) (let ((buffer (current-buffer)) - (pos (occur-mode-find-occurrence))) + (pos (occur--targets-start (occur-mode--find-occurrences)))) + (occur--set-arrow) (switch-to-buffer-other-window (marker-buffer pos)) (goto-char pos) (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) + (mapc #'delete-overlay occur-highlight-overlays) + (setq occur-highlight-overlays nil) ;; 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)) @@ -1339,64 +1500,56 @@ If not invoked by a mouse click, go to occurrence on the current line." #'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--highlight-occurrences (targets) + (let ((start-marker (occur--targets-start targets))) + (occur-goto-locus-delete-o) + (with-current-buffer (marker-buffer start-marker) + (when (or (eq next-error-highlight t) + (numberp next-error-highlight)) + (setq occur-highlight-overlays + (mapcar (lambda (target) + (let ((o (make-overlay (car target) (cdr target)))) + (overlay-put o 'face 'next-error) + o)) + (if (listp targets) + targets + ;; `occur-target' compatibility: when we only + ;; have a single starting point, highlight the + ;; rest of the line. + (let ((end-pos (save-excursion + (goto-char start-marker) + (line-end-position)))) + (list (cons start-marker end-pos)))))) + (add-hook 'pre-command-hook #'occur-goto-locus-delete-o) + (when (numberp next-error-highlight) + ;; We want highlighting for a limited time: + ;; set up a timer to delete it. + (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) + (let* ((buffer (current-buffer)) + (targets (occur-mode--find-occurrences)) + (pos (occur--targets-start targets)) + (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)) + (occur--set-arrow) ;; 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)) + (occur--highlight-occurrences targets) (next-error-found buffer (current-buffer)) (run-hooks 'occur-mode-find-occurrence-hook)))) @@ -1445,7 +1598,7 @@ This is a compatibility function for \\[next-error] invocations." (defface match '((((class color) (min-colors 88) (background light)) - :background "yellow1") + :background "khaki1") (((class color) (min-colors 88) (background dark)) :background "RoyalBlue3") (((class color) (min-colors 8) (background light)) @@ -1489,15 +1642,22 @@ If the value is nil, don't highlight the buffer names specially." (defcustom list-matching-lines-jump-to-current-line nil "If non-nil, \\[list-matching-lines] shows the current line highlighted. -Set the point right after such line when there are matches after it." +The current line for this purpose is the line of the original buffer +which was current when \\[list-matching-lines] was invoked. +Point in the `*Occur*' buffer will be set right after such line when +there are matches after it." :type 'boolean :group 'matching :version "26.1") (defcustom list-matching-lines-prefix-face 'shadow "Face used by \\[list-matching-lines] to show the prefix column. -If the face doesn't differ from the default face, -don't highlight the prefix with line numbers specially." +The prefix column is the part of display that precedes the actual +contents of the line; it normally shows the line number. \(For +multiline matches, the prefix column shows the line number for the +first line and whitespace for the rest of the lines.\) +If this face will display the same as the default face, the prefix +column will not be highlighted speciall." :type 'face :group 'matching :version "24.4") @@ -1577,11 +1737,24 @@ REGION must be a list of (START . END) positions as returned by `region-bounds'. The lines are shown in a buffer named `*Occur*'. -It serves as a menu to find any of the occurrences in this buffer. +That buffer can serve as a menu for finding any of the matches for REGEXP +in the current buffer. \\<occur-mode-map>\\[describe-mode] in that buffer will explain how. -If `list-matching-lines-jump-to-current-line' is non-nil, then show -the current line highlighted with `list-matching-lines-current-line-face' -and set point at the first match after such line. + +Matches for REGEXP are shown in the face determined by the +variable `list-matching-lines-face'. +Names of buffers with matched lines are shown in the face determined +by the variable `list-matching-lines-buffer-name-face'. +The line numbers of the matching lines are shown in the face +determined by the variable `list-matching-lines-prefix-face'. + +If `list-matching-lines-jump-to-current-line' is non-nil, then the +line in the current buffer which was current when the command was +invoked will be shown in the `*Occur*' buffer highlighted with +the `list-matching-lines-current-line-face', with point at the end +of that line. (If the current line doesn't match REGEXP, it will +nonetheless be inserted into the `*Occur*' buffer between the 2 +closest lines that do match REGEXP.) If REGEXP contains upper case characters (excluding those preceded by `\\') and `search-upper-case' is non-nil, the matching is case-sensitive. @@ -1725,6 +1898,7 @@ See also `multi-occur'." ;; 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) + (setq overlay-arrow-position nil) (if (stringp nlines) (fundamental-mode) ;; This is for collect operation. (occur-mode)) @@ -1733,7 +1907,6 @@ See also `multi-occur'." (buffer-undo-list t) (occur--final-pos nil)) (erase-buffer) - (setq-local occur-highlight-regexp regexp) (let ((count (if (stringp nlines) ;; Treat nlines as a regexp to collect. @@ -1833,7 +2006,7 @@ See also `multi-occur'." (origpt nil) (begpt nil) (endpt nil) - (marker nil) + markers ; list of (BEG-MARKER . END-MARKER) (curstring "") (ret nil) ;; The following binding is for when case-fold-search @@ -1859,8 +2032,7 @@ See also `multi-occur'." (setq endpt (line-end-position))) ;; Sum line numbers up to the first match line. (setq curr-line (+ curr-line (count-lines origpt begpt))) - (setq marker (make-marker)) - (set-marker marker matchbeg) + (setq markers nil) (setq curstring (occur-engine-line begpt endpt keep-props)) ;; Highlight the matches (let ((len (length curstring)) @@ -1882,6 +2054,11 @@ See also `multi-occur'." (setq orig-line-shown-p t))) (while (and (< start len) (string-match regexp curstring start)) + (push (cons (set-marker (make-marker) + (+ begpt (match-beginning 0))) + (set-marker (make-marker) + (+ begpt (match-end 0)))) + markers) (setq matches (1+ matches)) (add-text-properties (match-beginning 0) (match-end 0) @@ -1894,6 +2071,7 @@ See also `multi-occur'." ;; Avoid infloop (Bug#7593). (let ((end (match-end 0))) (setq start (if (= start end) (1+ start) end))))) + (setq markers (nreverse markers)) ;; Generate the string to insert for this match (let* ((match-prefix ;; Using 7 digits aligns tabs properly. @@ -1907,7 +2085,7 @@ See also `multi-occur'." ;; (for Occur Edit mode). front-sticky t rear-nonsticky t - occur-target ,marker + occur-target ,markers follow-link t help-echo "mouse-2: go to this occurrence")))) (match-str @@ -1915,7 +2093,7 @@ See also `multi-occur'." ;; because that loses. And don't put it ;; on context lines to reduce flicker. (propertize curstring - 'occur-target marker + 'occur-target markers 'follow-link t 'help-echo "mouse-2: go to this occurrence")) @@ -1923,19 +2101,21 @@ See also `multi-occur'." ;; Add non-numeric prefix to all non-first lines ;; of multi-line matches. (concat - (replace-regexp-in-string + (string-replace "\n" (if prefix-face (propertize - "\n :" 'font-lock-face prefix-face) - "\n :") + "\n :" 'font-lock-face prefix-face + 'occur-target markers) + (propertize + "\n :" 'occur-target markers)) ;; Add mouse face in one section to ;; ensure the prefix and the string ;; get a contiguous highlight. (propertize (concat match-prefix match-str) 'mouse-face 'highlight)) - ;; Add marker at eol, but no mouse props. - (propertize "\n" 'occur-target marker))) + ;; Add markers at eol, but no mouse props. + (propertize "\n" 'occur-target markers))) (data (if (= nlines 0) ;; The simple display style @@ -2326,12 +2506,10 @@ a string, it is first passed through `prin1-to-string' with the `noescape' argument set. `match-data' is preserved across the call." - (save-match-data - (replace-regexp-in-string "\\\\" "\\\\" - (if (stringp replacement) - replacement - (prin1-to-string replacement t)) - t t))) + (string-replace "\\" "\\\\" + (if (stringp replacement) + replacement + (prin1-to-string replacement t)))) (defun replace-loop-through-replacements (data count) ;; DATA is a vector containing the following values: @@ -2587,9 +2765,7 @@ characters." ;; If non-nil, it is marker saying where in the buffer to stop. (limit nil) - ;; Use local binding in add-function below. - (isearch-filter-predicate isearch-filter-predicate) - (region-bounds nil) + (region-filter nil) ;; Data for the next match. If a cons, it has the same format as ;; (match-data); otherwise it is t if a match is possible at point. @@ -2613,21 +2789,22 @@ characters." ;; Unless a single contiguous chunk is selected, operate on multiple chunks. (when region-noncontiguous-p - (setq region-bounds - (mapcar (lambda (position) - (cons (copy-marker (car position)) - (copy-marker (cdr position)))) - (funcall region-extract-function 'bounds))) - (add-function :after-while isearch-filter-predicate - (lambda (start end) - (delq nil (mapcar - (lambda (bounds) - (and - (>= start (car bounds)) - (<= start (cdr bounds)) - (>= end (car bounds)) - (<= end (cdr bounds)))) - region-bounds))))) + (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))) ;; If region is active, in Transient Mark mode, operate on region. (if backward @@ -3060,7 +3237,9 @@ characters." (setq next-replacement-replaced nil search-string-replaced nil last-was-act-and-show nil)))))) - (replace-dehighlight)) + (replace-dehighlight) + (when region-filter + (remove-function isearch-filter-predicate region-filter))) (or unread-command-events (message (ngettext "Replaced %d occurrence%s" "Replaced %d occurrences%s" |