diff options
Diffstat (limited to 'lisp/replace.el')
| -rw-r--r-- | lisp/replace.el | 311 |
1 files changed, 260 insertions, 51 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index 752f3bdebf7..0841ba11b8b 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1,4 +1,4 @@ -;;; replace.el --- replace commands for Emacs +;;; replace.el --- replace commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2017 Free ;; Software Foundation, Inc. @@ -28,6 +28,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defcustom case-replace t "Non-nil means `query-replace' should preserve case in replacements." :type 'boolean @@ -77,15 +79,14 @@ That becomes the \"string to replace\".") to the minibuffer that reads the string to replace, or invoke replacements from Isearch by using a key sequence like `C-s C-s M-%'." "24.3") -(defcustom query-replace-from-to-separator - (propertize (if (char-displayable-p ?→) " → " " -> ") - 'face 'minibuffer-prompt) - "String that separates FROM and TO in the history of replacement pairs." - ;; Avoids error when attempt to autoload char-displayable-p fails - ;; while preparing to dump, also stops customize-rogue listing this. - :initialize 'custom-initialize-delay +(defcustom query-replace-from-to-separator " → " + "String that separates FROM and TO in the history of replacement pairs. +When nil, the pair will not be added to the history (same behavior +as in emacs 24.5)." :group 'matching - :type '(choice string (sexp :tag "Display specification")) + :type '(choice + (const :tag "Disabled" nil) + string) :version "25.1") (defcustom query-replace-from-history-variable 'query-replace-history @@ -148,14 +149,17 @@ See `replace-regexp' and `query-replace-regexp-eval'.") (mapconcat 'isearch-text-char-description string "")) (defun query-replace--split-string (string) - "Split string STRING at a character with property `separator'" + "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) - (cl-assert (not (text-property-any (1+ split-pos) length 'separator t string))) (cons (substring-no-properties string 0 split-pos) - (substring-no-properties string (1+ split-pos) length))))) + (substring-no-properties + string (or (text-property-not-all + (1+ split-pos) length 'separator t string) + length) + length))))) (defun query-replace-read-from (prompt regexp-flag) "Query and return the `from' argument of a query-replace operation. @@ -163,16 +167,22 @@ The return value can also be a pair (FROM . TO) indicating that the user wants to replace FROM with TO." (if query-replace-interactive (car (if regexp-flag regexp-search-ring search-ring)) - ;; Reevaluating will check char-displayable-p that is - ;; unavailable while preparing to dump. - (custom-reevaluate-setting 'query-replace-from-to-separator) (let* ((history-add-new-input nil) - (separator + (separator-string (when query-replace-from-to-separator - (propertize "\0" - 'display 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 + " " "" query-replace-from-to-separator))) + query-replace-from-to-separator + " -> "))) + (separator + (when separator-string + (propertize separator-string + 'display separator-string + 'face 'minibuffer-prompt 'separator t))) - (query-replace-from-to-history + (minibuffer-history (append (when separator (mapcar (lambda (from-to) @@ -183,9 +193,13 @@ wants to replace FROM with TO." (symbol-value query-replace-from-history-variable))) (minibuffer-allow-text-properties t) ; separator uses text-properties (prompt - (if (and query-replace-defaults separator) - (format "%s (default %s): " prompt (car query-replace-from-to-history)) - (format "%s: " prompt))) + (cond ((and query-replace-defaults separator) + (format "%s (default %s): " prompt (car minibuffer-history))) + (query-replace-defaults + (format "%s (default %s -> %s): " prompt + (query-replace-descr (caar query-replace-defaults)) + (query-replace-descr (cdar query-replace-defaults)))) + (t (format "%s: " prompt)))) (from ;; The save-excursion here is in case the user marks and copies ;; a region in order to specify the minibuffer input. @@ -194,12 +208,12 @@ wants to replace FROM with TO." (minibuffer-with-setup-hook (lambda () (setq-local text-property-default-nonsticky - (cons '(separator . t) text-property-default-nonsticky))) + (append '((separator . t) (face . t)) + text-property-default-nonsticky))) (if regexp-flag - (read-regexp prompt nil 'query-replace-from-to-history) + (read-regexp prompt nil 'minibuffer-history) (read-from-minibuffer - prompt nil nil nil 'query-replace-from-to-history - (car (if regexp-flag regexp-search-ring search-ring)) t))))) + prompt nil nil nil nil (car search-ring) t))))) (to)) (if (and (zerop (length from)) query-replace-defaults) (cons (caar query-replace-defaults) @@ -1302,6 +1316,19 @@ If the value is nil, don't highlight the buffer names specially." :type 'face :group 'matching) +(defcustom list-matching-lines-current-line-face 'lazy-highlight + "Face used by \\[list-matching-lines] to highlight the current line." + :type 'face + :group 'matching + :version "26.1") + +(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." +: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, @@ -1358,7 +1385,15 @@ invoke `occur'." "*") (or unique-p (not interactive-p))))) -(defun occur (regexp &optional nlines) +;; 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) "Show all lines in the current buffer containing a match for REGEXP. If a match spreads across multiple lines, all those lines are shown. @@ -1367,9 +1402,17 @@ before if NLINES is negative. NLINES defaults to `list-matching-lines-default-context-lines'. Interactively it is the prefix arg. +Optional arg REGION, if non-nil, mean restrict search to the +specified region. Otherwise search the entire buffer. +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. \\<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. If REGEXP contains upper case characters (excluding those preceded by `\\') and `search-upper-case' is non-nil, the matching is case-sensitive. @@ -1384,8 +1427,30 @@ For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and program. When there is no parenthesized subexpressions in REGEXP the entire match is collected. In any case the searched buffer is not modified." - (interactive (occur-read-primary-args)) - (occur-1 regexp nlines (list (current-buffer)))) + (interactive + (nconc (occur-read-primary-args) + (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)))))) (defvar ido-ignore-item-temp-list) @@ -1408,7 +1473,7 @@ See also `multi-occur-in-matching-buffers'." "Next buffer to search (RET to end): ") nil t)) "")) - (add-to-list 'bufs buf) + (cl-pushnew buf bufs) (setq ido-ignore-item-temp-list bufs)) (nreverse (mapcar #'get-buffer bufs))) (occur-read-primary-args))) @@ -1480,7 +1545,8 @@ See also `multi-occur'." (occur-mode)) (let ((inhibit-read-only t) ;; Don't generate undo entries for creation of the initial contents. - (buffer-undo-list t)) + (buffer-undo-list t) + (occur--final-pos nil)) (erase-buffer) (let ((count (if (stringp nlines) @@ -1532,6 +1598,10 @@ See also `multi-occur'." (if (= count 0) (kill-buffer occur-buf) (display-buffer occur-buf) + (when occur--final-pos + (set-window-point + (get-buffer-window occur-buf 'all-frames) + occur--final-pos)) (setq next-error-last-buffer occur-buf) (setq buffer-read-only t) (set-buffer-modified-p nil) @@ -1543,19 +1613,26 @@ See also `multi-occur'." (let ((global-lines 0) ;; total count of matching lines (global-matches 0) ;; total count of matches (coding nil) - (case-fold-search case-fold)) + (case-fold-search case-fold) + (in-region-p (and occur--region-start occur--region-end)) + (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 1) ;; line count + (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) @@ -1656,6 +1733,18 @@ See also `multi-occur'." (nth 0 ret)))) ;; 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) + (>= 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))) (insert data))) (goto-char endpt)) (if endpt @@ -1669,6 +1758,18 @@ See also `multi-occur'." (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)) + (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 @@ -1682,7 +1783,7 @@ See also `multi-occur'." (let ((beg (point)) end) (insert (propertize - (format "%d match%s%s%s in buffer: %s\n" + (format "%d match%s%s%s in buffer: %s%s\n" matches (if (= matches 1) "" "es") ;; Don't display the same number of lines ;; and matches in case of 1 match per line. @@ -1692,13 +1793,21 @@ See also `multi-occur'." ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (occur-regexp-descr regexp)) - (buffer-name buf)) + (buffer-name buf) + (if in-region-p + (format " within region: %d-%d" + occur--region-start + occur--region-end) + "")) '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 (point-min))))))) + (add-face-text-property beg end title-face)) + (goto-char (if finalpt + (setq occur--final-pos + (cl-incf finalpt (- end beg))) + (point-min))))))))) ;; Display total match count and regexp for multi-buffer. (when (and (not (zerop global-lines)) (> (length buffers) 1)) (goto-char (point-min)) @@ -1835,6 +1944,8 @@ C-w to delete match and recursive edit, C-l to clear the screen, redisplay, and offer same replacement again, ! to replace all remaining matches in this buffer with no more questions, ^ to move point back to previous match, +u to undo previous replacement, +U to undo all replacements, E to edit the replacement string. In multi-buffer replacements type `Y' to replace all remaining matches in all remaining buffers with no more questions, @@ -1864,6 +1975,8 @@ in the current buffer." (define-key map "\C-l" 'recenter) (define-key map "!" 'automatic) (define-key map "^" 'backup) + (define-key map "u" 'undo) + (define-key map "U" 'undo-all) (define-key map "\C-h" 'help) (define-key map [f1] 'help) (define-key map [help] 'help) @@ -1889,7 +2002,7 @@ The valid answers include `act', `skip', `act-and-show', `act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up', `scroll-down', `scroll-other-window', `scroll-other-window-down', `edit', `edit-replacement', `delete-and-edit', `automatic', -`backup', `quit', and `help'. +`backup', `undo', `undo-all', `quit', and `help'. This keymap is used by `y-or-n-p' as well as `query-replace'.") @@ -1941,7 +2054,6 @@ type them using Lisp syntax." (defun replace-eval-replacement (expression count) (let* ((replace-count count) - err (replacement (condition-case err (eval expression) @@ -2042,7 +2154,7 @@ It is called with three arguments, as if it were `re-search-forward'.") (defun replace-search (search-string limit regexp-flag delimited-flag - case-fold-search &optional backward) + case-fold &optional backward) "Search for the next occurrence of SEARCH-STRING to replace." ;; Let-bind global isearch-* variables to values used ;; to search the next replacement. These let-bindings @@ -2061,7 +2173,7 @@ It is called with three arguments, as if it were replace-lax-whitespace) (isearch-regexp-lax-whitespace replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) + (isearch-case-fold-search case-fold) (isearch-adjusted nil) (isearch-nonincremental t) ; don't use lax word mode (isearch-forward (not backward)) @@ -2076,7 +2188,7 @@ It is called with three arguments, as if it were (defun replace-highlight (match-beg match-end range-beg range-end search-string regexp-flag delimited-flag - case-fold-search &optional backward) + case-fold &optional backward) (if query-replace-highlight (if replace-overlay (move-overlay replace-overlay match-beg match-end (current-buffer)) @@ -2091,7 +2203,7 @@ It is called with three arguments, as if it were replace-lax-whitespace) (isearch-regexp-lax-whitespace replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) + (isearch-case-fold-search case-fold) (isearch-forward (not backward)) (isearch-other-end match-beg) (isearch-error nil)) @@ -2145,6 +2257,10 @@ It must return a string." (noedit nil) (keep-going t) (stack nil) + (search-string-replaced nil) ; last string matching `from-string' + (next-replacement-replaced nil) ; replacement string + ; (substituted regexp) + (last-was-undo) (replace-count 0) (skip-read-only-count 0) (skip-filtered-count 0) @@ -2341,8 +2457,28 @@ It must return a string." (match-beginning 0) (match-end 0) start end search-string regexp-flag delimited-flag case-fold-search backward) - ;; Bind message-log-max so we don't fill up the message log - ;; with a bunch of identical messages. + ;; Obtain the matched groups: needed only when + ;; regexp-flag non nil. + (when (and last-was-undo regexp-flag) + (setq last-was-undo nil + real-match-data + (save-excursion + (goto-char (match-beginning 0)) + (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)) + next-replacement-replaced + (query-replace-descr + (save-match-data + (set-match-data real-match-data) + (match-substitute-replacement + next-replacement nocasify literal)))) + ;; Bind message-log-max so we don't fill up the + ;; message log with a bunch of identical messages. (let ((message-log-max nil) (replacement-presentation (if query-replace-show-replacement @@ -2355,8 +2491,8 @@ It must return a string." (query-replace-descr from-string) (query-replace-descr replacement-presentation))) (setq key (read-event)) - ;; Necessary in case something happens during read-event - ;; that clobbers the match data. + ;; Necessary in case something happens during + ;; read-event that clobbers the match data. (set-match-data real-match-data) (setq key (vector key)) (setq def (lookup-key map key)) @@ -2367,7 +2503,8 @@ It must return a string." (concat "Query replacing " (if delimited-flag (or (and (symbolp delimited-flag) - (get delimited-flag 'isearch-message-prefix)) + (get delimited-flag + 'isearch-message-prefix)) "word ") "") (if regexp-flag "regexp " "") (if backward "backward " "") @@ -2394,6 +2531,73 @@ It must return a string." (message "No previous match") (ding 'no-terminate) (sit-for 1))) + ((or (eq def 'undo) (eq def 'undo-all)) + (if (null stack) + (progn + (message "Nothing to undo") + (ding 'no-terminate) + (sit-for 1)) + (let ((stack-idx 0) + (stack-len (length stack)) + (num-replacements 0) + search-string + next-replacement) + (while (and (< stack-idx stack-len) + stack + (null replaced)) + (let* ((elt (nth stack-idx stack))) + (setq + stack-idx (1+ stack-idx) + replaced (nth 1 elt) + ;; Bind swapped values + ;; (search-string <--> replacement) + search-string (nth (if replaced 4 3) elt) + next-replacement (nth (if replaced 3 4) elt) + search-string-replaced search-string + next-replacement-replaced next-replacement) + + (when (and (= stack-idx stack-len) + (null replaced) + (zerop num-replacements)) + (message "Nothing to undo") + (ding 'no-terminate) + (sit-for 1)) + + (when replaced + (setq stack (nthcdr stack-idx stack)) + (goto-char (nth 0 elt)) + (set-match-data (nth 2 elt)) + (setq real-match-data + (save-excursion + (goto-char (match-beginning 0)) + (looking-at search-string) + (match-data t (nth 2 elt))) + noedit + (replace-match-maybe-edit + next-replacement nocasify literal + noedit real-match-data backward) + replace-count (1- replace-count) + real-match-data + (save-excursion + (goto-char (match-beginning 0)) + (looking-at next-replacement) + (match-data t (nth 2 elt)))) + ;; Set replaced nil to keep in loop + (when (eq def 'undo-all) + (setq replaced nil + stack-len (- stack-len stack-idx) + stack-idx 0 + num-replacements + (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")) + (ding 'no-terminate) + (sit-for 1))) + (setq replaced nil last-was-undo t))) ((eq def 'act) (or replaced (setq noedit @@ -2516,9 +2720,12 @@ It must return a string." (match-beginning 0) (match-end 0) (current-buffer)) - (match-data t))) - stack)))))) - + (match-data t)) + search-string-replaced + next-replacement-replaced) + stack) + (setq next-replacement-replaced nil + search-string-replaced nil)))))) (replace-dehighlight)) (or unread-command-events (message "Replaced %d occurrence%s%s" @@ -2544,4 +2751,6 @@ It must return a string." ""))) (or (and keep-going stack) multi-buffer))) +(provide 'replace) + ;;; replace.el ends here |