diff options
Diffstat (limited to 'lisp/replace.el')
| -rw-r--r-- | lisp/replace.el | 233 |
1 files changed, 153 insertions, 80 deletions
diff --git a/lisp/replace.el b/lisp/replace.el index de57ddccff2..0217e73e44c 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -69,6 +69,12 @@ strings or patterns." :group 'matching :version "22.1") +(defcustom query-replace-show-replacement t + "*Non-nil means to show what actual replacement text will be." + :type 'boolean + :group 'matching + :version "23.1") + (defcustom query-replace-highlight t "*Non-nil means to highlight matches during query replacement." :type 'boolean @@ -528,9 +534,20 @@ of `history-length', which see.") "Read arguments for `keep-lines' and friends. Prompt for a regexp with PROMPT. Value is a list, (REGEXP)." - (list (read-from-minibuffer prompt nil nil nil - 'regexp-history nil t) - nil nil t)) + (let* ((default (list + (regexp-quote + (or (funcall (or find-tag-default-function + (get major-mode 'find-tag-default-function) + 'find-tag-default)) + "")) + (car regexp-search-ring) + (regexp-quote (or (car search-ring) "")) + (car (symbol-value + query-replace-from-history-variable)))) + (default (delete-dups (delq nil (delete "" default))))) + (list (read-from-minibuffer prompt nil nil nil + 'regexp-history default t) + nil nil t))) (defun keep-lines (regexp &optional rstart rend interactive) "Delete all lines except those containing matches for REGEXP. @@ -538,8 +555,8 @@ A match split across lines preserves all the lines it lies in. When called from Lisp (and usually interactively as well, see below) applies to all lines starting after point. -If REGEXP contains upper case characters (excluding those preceded by `\\'), -the matching is case-sensitive. +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 arg RSTART and REND specify the region to operate on. This command operates on (the accessible part of) all lines whose @@ -583,8 +600,10 @@ a previously found match." (save-excursion (or (bolp) (forward-line 1)) (let ((start (point)) - (case-fold-search (and case-fold-search - (isearch-no-upper-case-p regexp t)))) + (case-fold-search + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search))) (while (< (point) rend) ;; Start is first char not preserved by previous match. (if (not (re-search-forward regexp rend 'move)) @@ -612,8 +631,8 @@ 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 match for regexp starting after point. -If REGEXP contains upper case characters (excluding those preceded by `\\'), -the matching is case-sensitive. +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 arg RSTART and REND specify the region to operate on. Lines partially contained in this region are deleted if and only if @@ -643,8 +662,10 @@ 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 (and case-fold-search - (isearch-no-upper-case-p regexp t)))) + (let ((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)) @@ -662,8 +683,8 @@ When called from Lisp and INTERACTIVE is omitted or nil, just return the number, do not print it; if INTERACTIVE is t, the function behaves in all respects has if it had been called interactively. -If REGEXP contains upper case characters (excluding those preceded by `\\'), -the matching is case-sensitive. +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 arg RSTART and REND specify the region to operate on. @@ -690,8 +711,10 @@ a previously found match." (goto-char rstart)) (let ((count 0) opoint - (case-fold-search (and case-fold-search - (isearch-no-upper-case-p regexp t)))) + (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))) @@ -720,6 +743,35 @@ a previously found match." (define-key map "q" 'quit-window) (define-key map "z" 'kill-this-buffer) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) + (define-key map [menu-bar] (make-sparse-keymap)) + (define-key map [menu-bar occur] + (cons "Occur" map)) + (define-key map [next-error-follow-minor-mode] + (menu-bar-make-mm-toggle next-error-follow-minor-mode + "Auto Occurrence Display" + "Display another occurrence when moving the cursor")) + (define-key map [separator-1] '("--")) + (define-key map [kill-this-buffer] + '("Kill occur buffer" . kill-this-buffer)) + (define-key map [quit-window] + '("Quit occur window" . quit-window)) + (define-key map [revert-buffer] + '("Revert occur buffer" . revert-buffer)) + (define-key map [clone-buffer] + '("Clone occur buffer" . clone-buffer)) + (define-key map [occur-rename-buffer] + '("Rename occur buffer" . occur-rename-buffer)) + (define-key map [separator-2] '("--")) + (define-key map [occur-mode-goto-occurrence-other-window] + '("Go To Occurrence Other Window" . occur-mode-goto-occurrence-other-window)) + (define-key map [occur-mode-goto-occurrence] + '("Go To Occurrence" . occur-mode-goto-occurrence)) + (define-key map [occur-mode-display-occurrence] + '("Display Occurrence" . occur-mode-display-occurrence)) + (define-key map [occur-next] + '("Move to next match" . occur-next)) + (define-key map [occur-prev] + '("Move to previous match" . occur-prev)) map) "Keymap for `occur-mode'.") @@ -933,23 +985,29 @@ which means to discard all text properties." (nreverse result)))) (defun occur-read-primary-args () - (list (let* ((default (car regexp-history)) - (input - (read-from-minibuffer - (if default - (format "List lines matching regexp (default %s): " - (query-replace-descr default)) - "List lines matching regexp: ") - nil - nil - nil - 'regexp-history - default))) - (if (equal input "") - default - input)) - (when current-prefix-arg - (prefix-numeric-value current-prefix-arg)))) + (let* ((default + (list (and transient-mark-mode mark-active + (regexp-quote + (buffer-substring-no-properties + (region-beginning) (region-end)))) + (regexp-quote + (or (funcall + (or find-tag-default-function + (get major-mode 'find-tag-default-function) + 'find-tag-default)) + "")) + (car regexp-search-ring) + (regexp-quote (or (car search-ring) "")) + (car (symbol-value + query-replace-from-history-variable)))) + (default (delete-dups (delq nil (delete "" default)))) + (input + (read-from-minibuffer + "List lines matching regexp: " + nil nil nil 'regexp-history default))) + (list input + (when current-prefix-arg + (prefix-numeric-value current-prefix-arg))))) (defun occur-rename-buffer (&optional unique-p interactive-p) "Rename the current *Occur* buffer to *Occur: original-buffer-name*. @@ -981,8 +1039,8 @@ 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 REGEXP contains upper case characters (excluding those preceded by `\\'), -the matching is case-sensitive." +If REGEXP contains upper case characters (excluding those preceded by `\\') +and `search-upper-case' is non-nil, the matching is case-sensitive." (interactive (occur-read-primary-args)) (occur-1 regexp nlines (list (current-buffer)))) @@ -1070,8 +1128,9 @@ See also `multi-occur'." (let ((count (occur-engine regexp active-bufs occur-buf (or nlines list-matching-lines-default-context-lines) - (and case-fold-search - (isearch-no-upper-case-p regexp t)) + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search) list-matching-lines-buffer-name-face nil list-matching-lines-face (not (eq occur-excluded-properties t))))) @@ -1187,16 +1246,9 @@ See also `multi-occur'." (if (= nlines 0) ;; The simple display style out-line - ;; The complex multi-line display - ;; style. Generate a list of lines, - ;; concatenate them all together. - (apply #'concat - (nconc - (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props)))) - (list out-line) - (if (> nlines 0) - (occur-engine-add-prefix - (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))))) + ;; The complex multi-line display style. + (occur-context-lines out-line nlines keep-props) + ))) ;; Actually insert the match display data (with-current-buffer out-buf (let ((beg (point)) @@ -1234,6 +1286,21 @@ See also `multi-occur'." ;; Return the number of matches globalcount))) +;; Generate context display for occur. +;; OUT-LINE is the line where the match is. +;; NLINES and KEEP-PROPS are args to occur-engine. +;; Generate a list of lines, add prefixes to all but OUT-LINE, +;; then concatenate them all together. +(defun occur-context-lines (out-line nlines keep-props) + (apply #'concat + (nconc + (occur-engine-add-prefix + (nreverse (cdr (occur-accumulate-lines + (- (1+ (abs nlines))) keep-props)))) + (list out-line) + (if (> nlines 0) + (occur-engine-add-prefix + (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))) ;; It would be nice to use \\[...], but there is no reasonable way ;; to make that display both SPC and Y. @@ -1409,38 +1476,37 @@ make, or the user didn't cancel the call." (or map (setq map query-replace-map)) (and query-flag minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) - (let ((nocasify (not (and case-fold-search case-replace - (string-equal from-string - (downcase from-string))))) - (case-fold-search (and case-fold-search - (string-equal from-string - (downcase from-string)))) - (literal (or (not regexp-flag) (eq regexp-flag 'literal))) - (search-function (if regexp-flag 're-search-forward 'search-forward)) - (search-string from-string) - (real-match-data nil) ; the match data for the current match - (next-replacement nil) - ;; This is non-nil if we know there is nothing for the user - ;; to edit in the replacement. - (noedit nil) - (keep-going t) - (stack nil) - (replace-count 0) - (nonempty-match nil) - - ;; If non-nil, it is marker saying where in the buffer to stop. - (limit 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. - (match-again t) - - (message - (if query-flag - (apply 'propertize - (substitute-command-keys - "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ") - minibuffer-prompt-properties)))) + (let* ((case-fold-search + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p from-string regexp-flag) + case-fold-search)) + (nocasify (not (and case-replace case-fold-search))) + (literal (or (not regexp-flag) (eq regexp-flag 'literal))) + (search-function (if regexp-flag 're-search-forward 'search-forward)) + (search-string from-string) + (real-match-data nil) ; The match data for the current match. + (next-replacement nil) + ;; This is non-nil if we know there is nothing for the user + ;; to edit in the replacement. + (noedit nil) + (keep-going t) + (stack nil) + (replace-count 0) + (nonempty-match nil) + + ;; If non-nil, it is marker saying where in the buffer to stop. + (limit 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. + (match-again t) + + (message + (if query-flag + (apply 'propertize + (substitute-command-keys + "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ") + minibuffer-prompt-properties)))) ;; If region is active, in Transient Mark mode, operate on region. (when start @@ -1573,10 +1639,17 @@ make, or the user didn't cancel the call." (or delimited-flag regexp-flag) case-fold-search) ;; Bind message-log-max so we don't fill up the message log ;; with a bunch of identical messages. - (let ((message-log-max nil)) + (let ((message-log-max nil) + (replacement-presentation + (if query-replace-show-replacement + (save-match-data + (set-match-data real-match-data) + (match-substitute-replacement next-replacement + nocasify literal)) + next-replacement))) (message message (query-replace-descr from-string) - (query-replace-descr next-replacement))) + (query-replace-descr replacement-presentation))) (setq key (read-event)) ;; Necessary in case something happens during read-event ;; that clobbers the match data. |