diff options
Diffstat (limited to 'lisp/replace.el')
| -rw-r--r-- | lisp/replace.el | 485 |
1 files changed, 290 insertions, 195 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index 4f0cbf4b958..dcae12e9b76 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) @@ -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)))))) + (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)) + 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 @@ -1069,10 +1099,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 +1121,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 +1134,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 +1159,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 +1213,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 +1227,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 +1240,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 +1277,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 +1294,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 +1417,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 +1463,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 +1541,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 +1576,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 @@ -1598,6 +1626,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 +1642,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 +1710,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)) @@ -1703,9 +1748,9 @@ See also `multi-occur'." ;; 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, @@ -1725,7 +1770,7 @@ See also `multi-occur'." "\n" (if prefix-face (propertize - "\n :" 'font-lock-face prefix-face) + "\n :" 'font-lock-face prefix-face) "\n :") match-str) ;; Add marker at eol, but no mouse props. @@ -1737,27 +1782,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 +1817,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)) @@ -1805,25 +1860,27 @@ See also `multi-occur'." (if (= lines matches) "" (format " in %d line%s" lines - (if (= lines 1) "" "s"))) + (if (= lines 1) "" "s"))) ;; 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)) @@ -1897,7 +1954,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 +1965,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 +2263,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 +2295,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 +2359,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 +2408,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. @@ -2543,13 +2637,13 @@ It must return a string." (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 " "") - (if backward "backward " "") from-string " with " next-replacement ".\n\n" (substitute-command-keys @@ -2769,10 +2863,11 @@ It must return a string." (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" |