diff options
Diffstat (limited to 'lisp/replace.el')
| -rw-r--r-- | lisp/replace.el | 626 |
1 files changed, 371 insertions, 255 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index 0ddebb12704..ad9be77a79b 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -39,7 +39,7 @@ (defcustom replace-char-fold nil "Non-nil means replacement commands should do character folding in matches. This means, for instance, that \\=' will match a large variety of -unicode quotes. +Unicode quotes. This variable affects `query-replace' and `replace-string', but not `replace-regexp'." :type 'boolean @@ -147,15 +147,27 @@ is highlighted lazily using isearch lazy highlighting (see See `replace-regexp' and `query-replace-regexp-eval'.") (defun query-replace-descr (string) - (mapconcat 'isearch-text-char-description string "")) + (setq string (copy-sequence string)) + (dotimes (i (length string)) + (let ((c (aref string i))) + (cond + ((< c ?\s) (add-text-properties + i (1+ i) + `(display ,(propertize (format "^%c" (+ c 64)) 'face 'escape-glyph)) + string)) + ((= c ?\^?) (add-text-properties + i (1+ i) + `(display ,(propertize "^?" 'face 'escape-glyph)) + string))))) + string) (defun query-replace--split-string (string) "Split string STRING at a substring with property `separator'." (let* ((length (length string)) (split-pos (text-property-any 0 length 'separator t string))) (if (not split-pos) - (substring-no-properties string) - (cons (substring-no-properties string 0 split-pos) + string + (cons (substring string 0 split-pos) (substring-no-properties string (or (text-property-not-all (1+ split-pos) length 'separator t string) @@ -273,7 +285,7 @@ the original string if not." (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))) (setq to (nreverse (delete "" (cons to list)))) (replace-match-string-symbols to) - (cons 'replace-eval-replacement + (cons #'replace-eval-replacement (if (cdr to) (cons 'concat to) (car to)))) @@ -301,7 +313,9 @@ the original string if not." (to (if (consp from) (prog1 (cdr from) (setq from (car from))) (query-replace-read-to from prompt regexp-flag)))) (list from to - (and current-prefix-arg (not (eq current-prefix-arg '-))) + (or (and current-prefix-arg (not (eq current-prefix-arg '-))) + (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 '-))))) (defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p) @@ -345,6 +359,9 @@ character strings. Fourth and fifth arg START and END specify the region to operate on. +Arguments FROM-STRING, TO-STRING, DELIMITED, START, END, BACKWARD, and +REGION-NONCONTIGUOUS-P are passed to `perform-replace' (which see). + To customize possible responses, change the bindings in `query-replace-map'." (interactive (let ((common @@ -427,7 +444,10 @@ to terminate it. One space there, if any, will be discarded. When using those Lisp features interactively in the replacement text, TO-STRING is actually made a list instead of a string. -Use \\[repeat-complex-command] after this command for details." +Use \\[repeat-complex-command] after this command for details. + +Arguments REGEXP, TO-STRING, DELIMITED, START, END, BACKWARD, and +REGION-NONCONTIGUOUS-P are passed to `perform-replace' (which see)." (interactive (let ((common (query-replace-read-args @@ -450,7 +470,7 @@ Use \\[repeat-complex-command] after this command for details." (define-key esc-map [?\C-%] 'query-replace-regexp) -(defun query-replace-regexp-eval (regexp to-expr &optional delimited start end) +(defun query-replace-regexp-eval (regexp to-expr &optional delimited start end region-noncontiguous-p) "Replace some things after point matching REGEXP with the result of TO-EXPR. Interactive use of this function is deprecated in favor of the @@ -496,7 +516,10 @@ This function is not affected by `replace-char-fold'. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches that are surrounded by word boundaries. -Fourth and fifth arg START and END specify the region to operate on." +Fourth and fifth arg START and END specify the region to operate on. + +Arguments REGEXP, DELIMITED, START, END, and REGION-NONCONTIGUOUS-P +are passed to `perform-replace' (which see)." (declare (obsolete "use the `\\,' feature of `query-replace-regexp' for interactive calls, and `search-forward-regexp'/`replace-match' for Lisp calls." "22.1")) @@ -518,11 +541,12 @@ for Lisp calls." "22.1")) (replace-match-string-symbols to) (list from (car to) current-prefix-arg (if (use-region-p) (region-beginning)) - (if (use-region-p) (region-end)))))) - (perform-replace regexp (cons 'replace-eval-replacement to-expr) - t 'literal delimited nil nil start end)) + (if (use-region-p) (region-end)) + (if (use-region-p) (region-noncontiguous-p)))))) + (perform-replace regexp (cons #'replace-eval-replacement to-expr) + t 'literal delimited nil nil start end nil region-noncontiguous-p)) -(defun map-query-replace-regexp (regexp to-strings &optional n start end) +(defun map-query-replace-regexp (regexp to-strings &optional n start end region-noncontiguous-p) "Replace some matches for REGEXP with various strings, in rotation. The second argument TO-STRINGS contains the replacement strings, separated by spaces. This command works like `query-replace-regexp' except that @@ -542,7 +566,10 @@ that reads REGEXP. A prefix argument N says to use each replacement string N times before rotating to the next. -Fourth and fifth arg START and END specify the region to operate on." +Fourth and fifth arg START and END specify the region to operate on. + +Arguments REGEXP, START, END, and REGION-NONCONTIGUOUS-P are passed to +`perform-replace' (which see)." (interactive (let* ((from (read-regexp "Map query replace (regexp): " nil query-replace-from-history-variable)) @@ -555,7 +582,8 @@ Fourth and fifth arg START and END specify the region to operate on." (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (if (use-region-p) (region-beginning)) - (if (use-region-p) (region-end))))) + (if (use-region-p) (region-end)) + (if (use-region-p) (region-noncontiguous-p))))) (let (replacements) (if (listp to-strings) (setq replacements to-strings) @@ -569,9 +597,9 @@ Fourth and fifth arg START and END specify the region to operate on." (1+ (string-match " " to-strings)))) (setq replacements (append replacements (list to-strings)) to-strings "")))) - (perform-replace regexp replacements t t nil n nil start end))) + (perform-replace regexp replacements t t nil n nil start end nil region-noncontiguous-p))) -(defun replace-string (from-string to-string &optional delimited start end backward) +(defun replace-string (from-string to-string &optional delimited start end backward region-noncontiguous-p) "Replace occurrences of FROM-STRING with TO-STRING. Preserve case in each match if `case-replace' and `case-fold-search' are non-nil and FROM-STRING has no uppercase letters. @@ -625,10 +653,11 @@ and TO-STRING is also null.)" (list (nth 0 common) (nth 1 common) (nth 2 common) (if (use-region-p) (region-beginning)) (if (use-region-p) (region-end)) - (nth 3 common)))) - (perform-replace from-string to-string nil nil delimited nil nil start end backward)) + (nth 3 common) + (if (use-region-p) (region-noncontiguous-p))))) + (perform-replace from-string to-string nil nil delimited nil nil start end backward region-noncontiguous-p)) -(defun replace-regexp (regexp to-string &optional delimited start end backward) +(defun replace-regexp (regexp to-string &optional delimited start end backward region-noncontiguous-p) "Replace things after point matching REGEXP with TO-STRING. Preserve case in each match if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. @@ -701,8 +730,9 @@ which will run faster and will not set the mark or print anything." (list (nth 0 common) (nth 1 common) (nth 2 common) (if (use-region-p) (region-beginning)) (if (use-region-p) (region-end)) - (nth 3 common)))) - (perform-replace regexp to-string nil t delimited nil nil start end backward)) + (nth 3 common) + (if (use-region-p) (region-noncontiguous-p))))) + (perform-replace regexp to-string nil t delimited nil nil start end backward region-noncontiguous-p)) (defvar regexp-history nil @@ -820,7 +850,6 @@ If nil, uses `regexp-history'." (defalias 'delete-matching-lines 'flush-lines) (defalias 'count-matches 'how-many) - (defun keep-lines-read-args (prompt) "Read arguments for `keep-lines' and friends. Prompt for a regexp with PROMPT. @@ -900,9 +929,8 @@ a previously found match." (set-marker rend nil) nil) - (defun flush-lines (regexp &optional rstart rend interactive) - "Delete lines containing matches for REGEXP. + "Delete 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 deleted if and only if it contains a @@ -923,7 +951,10 @@ a non-nil INTERACTIVE argument. If a match is split across lines, all the lines it lies in are deleted. They are deleted _before_ looking for the next match. Hence, a match -starting on the same line at which another match ended is ignored." +starting on the same line at which another match ended is ignored. + +Return the number of deleted matching lines. When called interactively, +also print the number." (interactive (progn (barf-if-buffer-read-only) @@ -938,7 +969,8 @@ starting on the same line at which another match ended is ignored." (setq rstart (point) rend (point-max-marker))) (goto-char rstart)) - (let ((case-fold-search + (let ((count 0) + (case-fold-search (if (and case-fold-search search-upper-case) (isearch-no-upper-case-p regexp t) case-fold-search))) @@ -948,10 +980,14 @@ starting on the same line at which another match ended is ignored." (delete-region (save-excursion (goto-char (match-beginning 0)) (forward-line 0) (point)) - (progn (forward-line 1) (point)))))) - (set-marker rend nil) - nil) - + (progn (forward-line 1) (point))) + (setq count (1+ count)))) + (set-marker rend nil) + (when interactive (message (ngettext "Deleted %d matching line" + "Deleted %d matching lines" + count) + count)) + count)) (defun how-many (regexp &optional rstart rend interactive) "Print and return number of matches for REGEXP following point. @@ -999,9 +1035,10 @@ a previously found match." (if (= opoint (point)) (forward-char 1) (setq count (1+ count)))) - (when interactive (message "%d occurrence%s" - count - (if (= count 1) "" "s"))) + (when interactive (message (ngettext "%d occurrence" + "%d occurrences" + count) + count)) count))) @@ -1069,10 +1106,9 @@ a previously found match." map) "Keymap for `occur-mode'.") -(defvar occur-revert-arguments nil +(defvar-local occur-revert-arguments nil "Arguments to pass to `occur-1' to revert an Occur mode buffer. See `occur-revert-function'.") -(make-variable-buffer-local 'occur-revert-arguments) (put 'occur-revert-arguments 'permanent-local t) (defcustom occur-mode-hook '(turn-on-font-lock) @@ -1092,6 +1128,11 @@ for this is to reveal context in an outline-mode when the occurrence is hidden." :type 'hook :group 'matching) +(defun occur--garbage-collect-revert-args () + (dolist (boo (nth 2 occur-revert-arguments)) + (when (overlayp boo) (delete-overlay boo))) + (kill-local-variable 'occur-revert-arguments)) + (put 'occur-mode 'mode-class 'special) (define-derived-mode occur-mode special-mode "Occur" "Major mode for output from \\[occur]. @@ -1100,8 +1141,9 @@ for this is to reveal context in an outline-mode when the occurrence is hidden." Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" - (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) - (setq next-error-function 'occur-next-error)) + (setq-local revert-buffer-function #'occur-revert-function) + (add-hook 'kill-buffer-hook #'occur--garbage-collect-revert-args nil t) + (setq next-error-function #'occur-next-error)) ;;; Occur Edit mode @@ -1124,7 +1166,7 @@ the originating buffer. To return to ordinary Occur mode, use \\[occur-cease-edit]." (setq buffer-read-only nil) - (add-hook 'after-change-functions 'occur-after-change-function nil t) + (add-hook 'after-change-functions #'occur-after-change-function nil t) (message (substitute-command-keys "Editing: Type \\[occur-cease-edit] to return to Occur mode."))) @@ -1178,7 +1220,7 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (defun occur-revert-function (_ignore1 _ignore2) "Handle `revert-buffer' for Occur mode buffers." - (apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))) + (apply #'occur-1 (append occur-revert-arguments (list (buffer-name))))) (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) @@ -1192,7 +1234,8 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (defun occur-mode-goto-occurrence (&optional event) "Go to the occurrence on the current line." (interactive (list last-nonmenu-event)) - (let ((pos + (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 @@ -1204,26 +1247,31 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (occur-mode-find-occurrence)))))) (pop-to-buffer (marker-buffer pos)) (goto-char pos) + (when buffer (next-error-found buffer (current-buffer))) (run-hooks 'occur-mode-find-occurrence-hook))) (defun occur-mode-goto-occurrence-other-window () "Go to the occurrence the current line describes, in another window." (interactive) - (let ((pos (occur-mode-find-occurrence))) + (let ((buffer (current-buffer)) + (pos (occur-mode-find-occurrence))) (switch-to-buffer-other-window (marker-buffer pos)) (goto-char pos) + (next-error-found buffer (current-buffer)) (run-hooks 'occur-mode-find-occurrence-hook))) (defun occur-mode-display-occurrence () "Display in another window the occurrence the current line describes." (interactive) - (let ((pos (occur-mode-find-occurrence)) + (let ((buffer (current-buffer)) + (pos (occur-mode-find-occurrence)) 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) + (next-error-found buffer (current-buffer)) (run-hooks 'occur-mode-find-occurrence-hook)))) (defun occur-find-match (n search message) @@ -1236,7 +1284,7 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (setq r (funcall search r 'occur-match))) (if r (goto-char r) - (error message)) + (user-error message)) (setq n (1- n))))) (defun occur-next (&optional n) @@ -1253,29 +1301,20 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." "Move to the Nth (default 1) next match in an Occur mode buffer. Compatibility function for \\[next-error] invocations." (interactive "p") - ;; we need to run occur-find-match from within the Occur buffer - (with-current-buffer - ;; Choose the buffer and make it current. - (if (next-error-buffer-p (current-buffer)) - (current-buffer) - (next-error-find-buffer nil nil - (lambda () - (eq major-mode 'occur-mode)))) - - (goto-char (cond (reset (point-min)) - ((< argp 0) (line-beginning-position)) - ((> argp 0) (line-end-position)) - ((point)))) - (occur-find-match - (abs argp) - (if (> 0 argp) - #'previous-single-property-change - #'next-single-property-change) - "No more matches") - ;; In case the *Occur* buffer is visible in a nonselected window. - (let ((win (get-buffer-window (current-buffer) t))) - (if win (set-window-point win (point)))) - (occur-mode-goto-occurrence))) + (goto-char (cond (reset (point-min)) + ((< argp 0) (line-beginning-position)) + ((> argp 0) (line-end-position)) + ((point)))) + (occur-find-match + (abs argp) + (if (> 0 argp) + #'previous-single-property-change + #'next-single-property-change) + "No more matches") + ;; In case the *Occur* buffer is visible in a nonselected window. + (let ((win (get-buffer-window (current-buffer) t))) + (if win (set-window-point win (point)))) + (occur-mode-goto-occurrence)) (defface match '((((class color) (min-colors 88) (background light)) @@ -1385,11 +1424,6 @@ invoke `occur'." (or unique-p (not interactive-p))))) ;; Region limits when `occur' applies on a region. -(defvar occur--region-start nil) -(defvar occur--region-end nil) -(defvar occur--matches-threshold nil) -(defvar occur--orig-line nil) -(defvar occur--orig-line-str nil) (defvar occur--final-pos nil) (defun occur (regexp &optional nlines region) @@ -1436,25 +1470,14 @@ is not modified." (and (use-region-p) (list (region-bounds))))) (let* ((start (and (caar region) (max (caar region) (point-min)))) (end (and (cdar region) (min (cdar region) (point-max)))) - (in-region-p (or start end))) - (when in-region-p - (or start (setq start (point-min))) - (or end (setq end (point-max)))) - (let ((occur--region-start start) - (occur--region-end end) - (occur--matches-threshold - (and in-region-p - (line-number-at-pos (min start end)))) - (occur--orig-line - (line-number-at-pos (point))) - (occur--orig-line-str - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)))) - (save-excursion ; If no matches `occur-1' doesn't restore the point. - (and in-region-p (narrow-to-region start end)) - (occur-1 regexp nlines (list (current-buffer))) - (and in-region-p (widen)))))) + (in-region (or start end)) + (bufs (if (not in-region) (list (current-buffer)) + (let ((ol (make-overlay + (or start (point-min)) + (or end (point-max))))) + (overlay-put ol 'occur--orig-point (point)) + (list ol))))) + (occur-1 regexp nlines bufs))) (defvar ido-ignore-item-temp-list) @@ -1525,17 +1548,27 @@ See also `multi-occur'." (query-replace-descr regexp)))) (defun occur-1 (regexp nlines bufs &optional buf-name) + ;; BUFS is a list of buffer-or-overlay! (unless (and regexp (not (equal regexp ""))) (error "Occur doesn't work with the empty regexp")) (unless buf-name (setq buf-name "*Occur*")) (let (occur-buf - (active-bufs (delq nil (mapcar #'(lambda (buf) - (when (buffer-live-p buf) buf)) - bufs)))) + (active-bufs + (delq nil (mapcar (lambda (boo) + (when (or (buffer-live-p boo) + (and (overlayp boo) + (overlay-buffer boo))) + boo)) + bufs)))) ;; Handle the case where one of the buffers we're searching is the ;; output buffer. Just rename it. - (when (member buf-name (mapcar 'buffer-name active-bufs)) + (when (member buf-name + ;; FIXME: Use cl-exists. + (mapcar + (lambda (boo) + (buffer-name (if (overlayp boo) (overlay-buffer boo) boo))) + active-bufs)) (with-current-buffer (get-buffer buf-name) (rename-uniquely))) @@ -1550,27 +1583,29 @@ See also `multi-occur'." (let ((inhibit-read-only t) ;; Don't generate undo entries for creation of the initial contents. (buffer-undo-list t) - (occur--final-pos nil)) + (occur--final-pos nil)) (erase-buffer) (let ((count (if (stringp nlines) ;; Treat nlines as a regexp to collect. - (let ((bufs active-bufs) - (count 0)) - (while bufs - (with-current-buffer (car bufs) + (let ((count 0)) + (dolist (boo active-bufs) + (with-current-buffer + (if (overlayp boo) (overlay-buffer boo) boo) (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - ;; Insert the replacement regexp. - (let ((str (match-substitute-replacement nlines))) - (if str - (with-current-buffer occur-buf - (insert str) - (setq count (1+ count)) - (or (zerop (current-column)) - (insert "\n")))))))) - (setq bufs (cdr bufs))) + (goto-char + (if (overlayp boo) (overlay-start boo) (point-min))) + (let ((end (if (overlayp boo) (overlay-end boo)))) + (while (re-search-forward regexp end t) + ;; Insert the replacement regexp. + (let ((str (match-substitute-replacement + nlines))) + (if str + (with-current-buffer occur-buf + (insert str) + (setq count (1+ count)) + (or (zerop (current-column)) + (insert "\n")))))))))) count) ;; Perform normal occur. (occur-engine @@ -1586,11 +1621,12 @@ See also `multi-occur'." (not (eq occur-excluded-properties t)))))) (let* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) - (message "Searched %d buffer%s%s; %s match%s%s" - bufcount (if (= bufcount 1) "" "s") + (message "Searched %d %s%s; %s %s%s" + bufcount + (ngettext "buffer" "buffers" bufcount) (if (zerop diff) "" (format " (%d killed)" diff)) (if (zerop count) "no" (format "%d" count)) - (if (= count 1) "" "es") + (ngettext "match" "matches" count) ;; Don't display regexp if with remaining text ;; it is longer than window-width. (if (> (+ (length (or (get-text-property 0 'isearch-string regexp) @@ -1598,6 +1634,7 @@ See also `multi-occur'." 42) (window-width)) "" (occur-regexp-descr regexp)))) + (occur--garbage-collect-revert-args) (setq occur-revert-arguments (list regexp nlines bufs)) (if (= count 0) (kill-buffer occur-buf) @@ -1613,51 +1650,55 @@ See also `multi-occur'." (defun occur-engine (regexp buffers out-buf nlines case-fold title-face prefix-face match-face keep-props) + ;; BUFFERS is a list of buffer-or-overlay! (with-current-buffer out-buf (let ((global-lines 0) ;; total count of matching lines (global-matches 0) ;; total count of matches (coding nil) (case-fold-search case-fold) - (in-region-p (and occur--region-start occur--region-end)) - (multi-occur-p (cdr buffers))) + (multi-occur-p (cdr buffers))) ;; Map over all the buffers - (dolist (buf buffers) - (when (buffer-live-p buf) - (let ((lines 0) ;; count of matching lines - (matches 0) ;; count of matches - (curr-line ;; line count - (or occur--matches-threshold 1)) - (orig-line occur--orig-line) - (orig-line-str occur--orig-line-str) - (orig-line-shown-p) - (prev-line nil) ;; line number of prev match endpt - (prev-after-lines nil) ;; context lines of prev match - (matchbeg 0) - (origpt nil) - (begpt nil) - (endpt nil) - (finalpt nil) - (marker nil) - (curstring "") - (ret nil) - (inhibit-field-text-motion t) - (headerpt (with-current-buffer out-buf (point)))) - (with-current-buffer buf - ;; The following binding is for when case-fold-search - ;; has a local binding in the original buffer, in which - ;; case we cannot bind it globally and let that have - ;; effect in every buffer we search. - (let ((case-fold-search case-fold)) - (or coding - ;; Set CODING only if the current buffer locally - ;; binds buffer-file-coding-system. - (not (local-variable-p 'buffer-file-coding-system)) - (setq coding buffer-file-coding-system)) - (save-excursion - (goto-char (point-min)) ;; begin searching in the buffer - (while (not (eobp)) + (dolist (boo buffers) + (when (if (overlayp boo) (overlay-buffer boo) (buffer-live-p boo)) + (with-current-buffer (if (overlayp boo) (overlay-buffer boo) boo) + (let ((inhibit-field-text-motion t) + (lines 0) ; count of matching lines + (matches 0) ; count of matches + (headerpt (with-current-buffer out-buf (point))) + (orig-line (if (not (overlayp boo)) + (line-number-at-pos) + (line-number-at-pos + (overlay-get boo 'occur--orig-point))))) + (save-excursion + ;; begin searching in the buffer + (goto-char (if (overlayp boo) (overlay-start boo) (point-min))) + (forward-line 0) + (let* ((limit (if (overlayp boo) (overlay-end boo) (point-max))) + (start-line (line-number-at-pos)) + (curr-line start-line) ; line count + (orig-line-shown-p) + (prev-line nil) ; line number of prev match endpt + (prev-after-lines nil) ; context lines of prev match + (matchbeg 0) + (origpt nil) + (begpt nil) + (endpt nil) + (marker nil) + (curstring "") + (ret nil) + ;; The following binding is for when case-fold-search + ;; has a local binding in the original buffer, in which + ;; case we cannot bind it globally and let that have + ;; effect in every buffer we search. + (case-fold-search case-fold)) + (or coding + ;; Set CODING only if the current buffer locally + ;; binds buffer-file-coding-system. + (not (local-variable-p 'buffer-file-coding-system)) + (setq coding buffer-file-coding-system)) + (while (< (point) limit) (setq origpt (point)) - (when (setq endpt (re-search-forward regexp nil t)) + (when (setq endpt (re-search-forward regexp limit t)) (setq lines (1+ lines)) ;; increment matching lines count (setq matchbeg (match-beginning 0)) ;; Get beginning of first match line and end of the last. @@ -1677,6 +1718,18 @@ See also `multi-occur'." ;; Count empty lines that don't use next loop (Bug#22062). (when (zerop len) (setq matches (1+ matches))) + (when (and list-matching-lines-jump-to-current-line + (not multi-occur-p)) + (or orig-line (setq orig-line 1)) + (or nlines (setq nlines (line-number-at-pos (point-max)))) + (when (= curr-line orig-line) + (add-face-text-property + 0 len list-matching-lines-current-line-face nil curstring) + (add-text-properties 0 len '(current-line t) curstring)) + (when (and (>= orig-line (- curr-line nlines)) + (<= orig-line (+ curr-line nlines))) + ;; Shown either here or will be shown by occur-context-lines + (setq orig-line-shown-p t))) (while (and (< start len) (string-match regexp curstring start)) (setq matches (1+ matches)) @@ -1698,36 +1751,39 @@ See also `multi-occur'." (append (when prefix-face `(font-lock-face ,prefix-face)) - `(occur-prefix t mouse-face (highlight) + `(occur-prefix t ;; Allow insertion of text ;; at the end of the prefix ;; (for Occur Edit mode). front-sticky t - rear-nonsticky t - occur-target ,marker - follow-link t + rear-nonsticky t + occur-target ,marker + follow-link t help-echo "mouse-2: go to this occurrence")))) (match-str ;; We don't put `mouse-face' on the newline, ;; because that loses. And don't put it ;; on context lines to reduce flicker. - (propertize curstring 'mouse-face (list 'highlight) + (propertize curstring 'occur-target marker 'follow-link t 'help-echo "mouse-2: go to this occurrence")) (out-line - (concat - match-prefix - ;; Add non-numeric prefix to all non-first lines - ;; of multi-line matches. + ;; Add non-numeric prefix to all non-first lines + ;; of multi-line matches. + (concat (replace-regexp-in-string "\n" (if prefix-face (propertize - "\n :" 'font-lock-face prefix-face) + "\n :" 'font-lock-face prefix-face) "\n :") - match-str) + ;; 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))) (data @@ -1737,27 +1793,33 @@ See also `multi-occur'." ;; The complex multi-line display style. (setq ret (occur-context-lines out-line nlines keep-props begpt - endpt curr-line prev-line - prev-after-lines prefix-face)) + endpt curr-line prev-line + prev-after-lines prefix-face + orig-line multi-occur-p)) ;; Set first elem of the returned list to `data', ;; and the second elem to `prev-after-lines'. (setq prev-after-lines (nth 1 ret)) - (nth 0 ret)))) + (nth 0 ret))) + (orig-line-str + (when (and list-matching-lines-jump-to-current-line + (null orig-line-shown-p) + (> curr-line orig-line)) + (setq orig-line-shown-p t) + (save-excursion + (goto-char (point-min)) + (forward-line (1- orig-line)) + (occur-engine-line (line-beginning-position) + (line-end-position) keep-props))))) ;; Actually insert the match display data (with-current-buffer out-buf - (when (and list-matching-lines-jump-to-current-line - (not multi-occur-p) - (not orig-line-shown-p) - orig-line - (>= curr-line orig-line)) - (insert - (concat - (propertize - (format "%7d:%s" orig-line orig-line-str) - 'face list-matching-lines-current-line-face - 'mouse-face 'mode-line-highlight - 'help-echo "Current line") "\n")) - (setq orig-line-shown-p t finalpt (point))) + (when orig-line-str + (add-face-text-property + 0 (length orig-line-str) + list-matching-lines-current-line-face nil orig-line-str) + (add-text-properties 0 (length orig-line-str) + '(current-line t) orig-line-str) + (insert (car (occur-engine-add-prefix + (list orig-line-str) prefix-face)))) (insert data))) (goto-char endpt)) (if endpt @@ -1766,30 +1828,34 @@ See also `multi-occur'." (setq curr-line (+ curr-line (count-lines begpt endpt) ;; Add 1 for empty last match line ;; since count-lines returns one - ;; line less. + ;; line less. (if (and (bolp) (eolp)) 1 0))) ;; On to the next match... (forward-line 1)) (goto-char (point-max))) (setq prev-line (1- curr-line))) - ;; Insert original line if haven't done yet. - (when (and list-matching-lines-jump-to-current-line - (not multi-occur-p) - (not orig-line-shown-p) - orig-line) - (with-current-buffer out-buf - (insert - (concat - (propertize - (format "%7d:%s" orig-line orig-line-str) - 'face list-matching-lines-current-line-face - 'mouse-face 'mode-line-highlight - 'help-echo "Current line") "\n")))) ;; Flush remaining context after-lines. (when prev-after-lines (with-current-buffer out-buf (insert (apply #'concat (occur-engine-add-prefix - prev-after-lines prefix-face))))))) + prev-after-lines prefix-face))))) + (when (and list-matching-lines-jump-to-current-line + (null orig-line-shown-p)) + (setq orig-line-shown-p t) + (let ((orig-line-str + (save-excursion + (goto-char (point-min)) + (forward-line (1- orig-line)) + (occur-engine-line (line-beginning-position) + (line-end-position) keep-props)))) + (add-face-text-property + 0 (length orig-line-str) + list-matching-lines-current-line-face nil orig-line-str) + (add-text-properties 0 (length orig-line-str) + '(current-line t) orig-line-str) + (with-current-buffer out-buf + (insert (car (occur-engine-add-prefix + (list orig-line-str) prefix-face)))))))) (when (not (zerop lines)) ;; is the count zero? (setq global-lines (+ global-lines lines) global-matches (+ global-matches matches)) @@ -1798,44 +1864,49 @@ See also `multi-occur'." (let ((beg (point)) end) (insert (propertize - (format "%d match%s%s%s in buffer: %s%s\n" - matches (if (= matches 1) "" "es") + (format "%d %s%s%s in buffer: %s%s\n" + matches + (ngettext "match" "matches" matches) ;; Don't display the same number of lines ;; and matches in case of 1 match per line. (if (= lines matches) - "" (format " in %d line%s" + "" (format " in %d %s" lines - (if (= lines 1) "" "s"))) + (ngettext "line" "lines" lines))) ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (occur-regexp-descr regexp)) - (buffer-name buf) - (if in-region-p - (format " within region: %d-%d" - occur--region-start - occur--region-end) - "")) + (buffer-name (if (overlayp boo) (overlay-buffer boo) boo)) + (if (overlayp boo) + (format " within region: %d-%d" + (overlay-start boo) + (overlay-end boo)) + "")) 'read-only t)) (setq end (point)) - (add-text-properties beg end `(occur-title ,buf)) (when title-face (add-face-text-property beg end title-face)) - (goto-char (if finalpt - (setq occur--final-pos - (cl-incf finalpt (- end beg))) - (point-min)))))))))) + (goto-char (if (and list-matching-lines-jump-to-current-line + (not multi-occur-p)) + (setq occur--final-pos + (and (goto-char (point-max)) + (or (previous-single-property-change (point) 'current-line) + (point-max)))) + (point-min)))))))))) ;; Display total match count and regexp for multi-buffer. (when (and (not (zerop global-lines)) (> (length buffers) 1)) (goto-char (point-min)) (let ((beg (point)) end) - (insert (format "%d match%s%s total%s:\n" - global-matches (if (= global-matches 1) "" "es") + (insert (format "%d %s%s total%s:\n" + global-matches + (ngettext "match" "matches" global-matches) ;; Don't display the same number of lines ;; and matches in case of 1 match per line. (if (= global-lines global-matches) - "" (format " in %d line%s" - global-lines (if (= global-lines 1) "" "s"))) + "" (format " in %d %s" + global-lines + (ngettext "line" "lines" global-lines))) (occur-regexp-descr regexp))) (setq end (point)) (when title-face @@ -1850,10 +1921,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 @@ -1897,7 +1966,8 @@ See also `multi-occur'." ;; then concatenate them all together. (defun occur-context-lines (out-line nlines keep-props begpt endpt curr-line prev-line prev-after-lines - &optional prefix-face) + &optional prefix-face + orig-line multi-occur-p) ;; Find after- and before-context lines of the current match. (let ((before-lines (nreverse (cdr (occur-accumulate-lines @@ -1907,13 +1977,32 @@ See also `multi-occur'." (1+ nlines) keep-props endpt))) separator) + (when (and list-matching-lines-jump-to-current-line + (not multi-occur-p)) + (when (and (>= orig-line (- curr-line nlines)) + (< orig-line curr-line)) + (let ((curstring (nth (- (length before-lines) (- curr-line orig-line)) before-lines))) + (add-face-text-property + 0 (length curstring) + list-matching-lines-current-line-face nil curstring) + (add-text-properties 0 (length curstring) + '(current-line t) curstring))) + (when (and (<= orig-line (+ curr-line nlines)) + (> orig-line curr-line)) + (let ((curstring (nth (- orig-line curr-line 1) after-lines))) + (add-face-text-property + 0 (length curstring) + list-matching-lines-current-line-face nil curstring) + (add-text-properties 0 (length curstring) + '(current-line t) curstring)))) + ;; Combine after-lines of the previous match ;; with before-lines of the current match. (when prev-after-lines ;; Don't overlap prev after-lines with current before-lines. (if (>= (+ prev-line (length prev-after-lines)) - (- curr-line (length before-lines))) + (- curr-line (length before-lines))) (setq prev-after-lines (butlast prev-after-lines (- (length prev-after-lines) @@ -2186,9 +2275,9 @@ It is called with three arguments, as if it were ;; used after `recursive-edit' might override them. (let* ((isearch-regexp regexp-flag) (isearch-regexp-function (or delimited-flag - (and replace-char-fold - (not regexp-flag) - #'char-fold-to-regexp))) + (and replace-char-fold + (not regexp-flag) + #'char-fold-to-regexp))) (isearch-lax-whitespace replace-lax-whitespace) (isearch-regexp-lax-whitespace @@ -2218,7 +2307,10 @@ It is called with three arguments, as if it were (if query-replace-lazy-highlight (let ((isearch-string search-string) (isearch-regexp regexp-flag) - (isearch-regexp-function delimited-flag) + (isearch-regexp-function (or delimited-flag + (and replace-char-fold + (not regexp-flag) + #'char-fold-to-regexp))) (isearch-lax-whitespace replace-lax-whitespace) (isearch-regexp-lax-whitespace @@ -2279,7 +2371,12 @@ REPLACEMENTS is either a string, a list of strings, or a cons cell containing a function and its first argument. The function is called to generate each replacement like this: (funcall (car replacements) (cdr replacements) replace-count) -It must return a string." +It must return a string. + +Non-nil REGION-NONCONTIGUOUS-P means that the region is composed of +noncontiguous pieces. The most common example of this is a +rectangular region, where the pieces are separated by newline +characters." (or map (setq map query-replace-map)) (and query-flag minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) @@ -2323,9 +2420,18 @@ It must return a string." (message (if query-flag - (apply 'propertize - (substitute-command-keys - "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ") + (apply #'propertize + (concat "Query replacing " + (if backward "backward " "") + (if delimited-flag + (or (and (symbolp delimited-flag) + (get delimited-flag + 'isearch-message-prefix)) + "word ") "") + (if regexp-flag "regexp " "") + "%s with %s: " + (substitute-command-keys + "(\\<query-replace-map>\\[help] for help) ")) minibuffer-prompt-properties)))) ;; Unless a single contiguous chunk is selected, operate on multiple chunks. @@ -2368,7 +2474,8 @@ It must return a string." replacements nil)) ((stringp (car replacements)) ; If it isn't a string, it must be a cons (or repeat-count (setq repeat-count 1)) - (setq replacements (cons 'replace-loop-through-replacements + ;; This is a hand-made `iterator'. + (setq replacements (cons #'replace-loop-through-replacements (vector repeat-count repeat-count replacements replacements))))) @@ -2493,6 +2600,11 @@ It must return a string." ;; Commands not setting `done' need to adjust ;; `real-match-data'. (while (not done) + ;; This sets match-data only for the next hook and + ;; replace-highlight that calls `sit-for' from + ;; isearch-lazy-highlight-new-loop whose redisplay + ;; might clobber match-data. So subsequent code should + ;; use only real-match-data, not match-data (bug#36328). (set-match-data real-match-data) (run-hooks 'replace-update-post-hook) ; Before `replace-highlight'. (replace-highlight @@ -2505,14 +2617,14 @@ It must return a string." (setq last-was-undo nil real-match-data (save-excursion - (goto-char (match-beginning 0)) + (goto-char (nth 0 real-match-data)) (looking-at search-string) (match-data t real-match-data)))) ;; Matched string and next-replacement-replaced ;; stored in stack. (setq search-string-replaced (buffer-substring-no-properties - (match-beginning 0) - (match-end 0)) + (nth 0 real-match-data) + (nth 1 real-match-data)) next-replacement-replaced (query-replace-descr (save-match-data @@ -2540,22 +2652,24 @@ It must return a string." (setq def (lookup-key map key)) ;; Restore the match data while we process the command. (cond ((eq def 'help) - (with-output-to-temp-buffer "*Help*" - (princ - (concat "Query replacing " - (if delimited-flag - (or (and (symbolp delimited-flag) - (get delimited-flag - 'isearch-message-prefix)) - "word ") "") - (if regexp-flag "regexp " "") - (if backward "backward " "") - from-string " with " - next-replacement ".\n\n" - (substitute-command-keys - query-replace-help))) - (with-current-buffer standard-output - (help-mode)))) + (let ((display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (with-output-to-temp-buffer "*Help*" + (princ + (concat "Query replacing " + (if backward "backward " "") + (if delimited-flag + (or (and (symbolp delimited-flag) + (get delimited-flag + 'isearch-message-prefix)) + "word ") "") + (if regexp-flag "regexp " "") + from-string " with " + next-replacement ".\n\n" + (substitute-command-keys + query-replace-help))) + (with-current-buffer standard-output + (help-mode))))) ((eq def 'exit) (setq keep-going nil) (setq done t)) @@ -2638,10 +2752,10 @@ It must return a string." (1+ num-replacements)))))) (when (and (eq def 'undo-all) (null (zerop num-replacements))) - (message "Undid %d %s" num-replacements - (if (= num-replacements 1) - "replacement" - "replacements")) + (message (ngettext "Undid %d replacement" + "Undid %d replacements" + num-replacements) + num-replacements) (ding 'no-terminate) (sit-for 1))) (setq replaced nil last-was-undo t last-was-act-and-show nil))) @@ -2767,15 +2881,17 @@ It must return a string." last-was-act-and-show nil)))))) (replace-dehighlight)) (or unread-command-events - (message "Replaced %d occurrence%s%s" + (message (ngettext "Replaced %d occurrence%s" + "Replaced %d occurrences%s" + replace-count) replace-count - (if (= replace-count 1) "" "s") (if (> (+ skip-read-only-count skip-filtered-count - skip-invisible-count) 0) + skip-invisible-count) + 0) (format " (skipped %s)" (mapconcat - 'identity + #'identity (delq nil (list (if (> skip-read-only-count 0) (format "%s read-only" |