X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a41284da64e27af4becf2c03069428af8c6c721e..dc0485c4f86e8754635ecd2003188d3894c23974:/lisp/replace.el diff --git a/lisp/replace.el b/lisp/replace.el index 086fea6745..2d26cb5cc6 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1,6 +1,9 @@ -;;; replace.el --- replace commands for Emacs. +;;; replace.el --- replace commands for Emacs -;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000, 2001, 2002 +;; Free Software Foundation, Inc. + +;; Maintainer: FSF ;; This file is part of GNU Emacs. @@ -26,8 +29,10 @@ ;;; Code: -(defvar case-replace t "\ -*Non-nil means query-replace should preserve case in replacements.") +(defcustom case-replace t + "*Non-nil means `query-replace' should preserve case in replacements." + :type 'boolean + :group 'matching) (defvar query-replace-history nil) @@ -35,86 +40,230 @@ "Non-nil means `query-replace' uses the last search string. That becomes the \"string to replace\".") -(defun query-replace-read-args (string regexp-flag) +(defcustom query-replace-from-history-variable 'query-replace-history + "History list to use for the FROM argument of `query-replace' commands. +The value of this variable should be a symbol; that symbol +is used as a variable to hold a history list for the strings +or patterns to be replaced." + :group 'matching + :type 'symbol + :version "20.3") + +(defcustom query-replace-to-history-variable 'query-replace-history + "History list to use for the TO argument of `query-replace' commands. +The value of this variable should be a symbol; that symbol +is used as a variable to hold a history list for replacement +strings or patterns." + :group 'matching + :type 'symbol + :version "20.3") + +(defcustom query-replace-skip-read-only nil + "*Non-nil means `query-replace' and friends ignore read-only matches." + :type 'boolean + :group 'matching + :version "21.4") + +(defun query-replace-read-args (string regexp-flag &optional noerror) + (unless noerror + (barf-if-buffer-read-only)) (let (from to) (if query-replace-interactive (setq from (car (if regexp-flag regexp-search-ring search-ring))) - (setq from (read-from-minibuffer (format "%s: " string) - nil nil nil - 'query-replace-history))) - (setq to (read-from-minibuffer (format "%s %s with: " string from) - nil nil nil - 'query-replace-history)) + ;; The save-excursion here is in case the user marks and copies + ;; a region in order to specify the minibuffer input. + ;; That should not clobber the region for the query-replace itself. + (save-excursion + (setq from (read-from-minibuffer (format "%s: " string) + nil nil nil + query-replace-from-history-variable + nil t))) + ;; Warn if user types \n or \t, but don't reject the input. + (if (string-match "\\\\[nt]" from) + (let ((match (match-string 0 from))) + (cond + ((string= match "\\n") + (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead")) + ((string= match "\\t") + (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB"))) + (sit-for 2)))) + + (save-excursion + (setq to (read-from-minibuffer (format "%s %s with: " string from) + nil nil nil + query-replace-to-history-variable from t))) (list from to current-prefix-arg))) -(defun query-replace (from-string to-string &optional arg) +(defun query-replace (from-string to-string &optional delimited start end) "Replace some occurrences of FROM-STRING with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. +In Transient Mark mode, if the mark is active, operate on the contents +of the region. Otherwise, operate from point to the end of the buffer. + If `query-replace-interactive' is non-nil, the last incremental search string is used as FROM-STRING--you don't have to specify it with the minibuffer. -Preserves case in each replacement if `case-replace' and `case-fold-search' -are non-nil and FROM-STRING has no uppercase letters. -\(Preserving case means that if the string matched is all caps, or capitalized, -then its replacement is upcased or capitalized.) +Matching is independent of case if `case-fold-search' is non-nil and +FROM-STRING has no uppercase letters. Replacement transfers the case +pattern of the old text to the new text, if `case-replace' and +`case-fold-search' are non-nil and FROM-STRING has no uppercase +letters. \(Transferring the case pattern means that if the old text +matched is all caps, or capitalized, then its replacement is upcased +or capitalized.) Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. +Fourth and fifth arg START and END specify the region to operate on. To customize possible responses, change the \"bindings\" in `query-replace-map'." - (interactive (query-replace-read-args "Query replace" nil)) - (perform-replace from-string to-string t nil arg)) + (interactive (let ((common + (query-replace-read-args "Query replace" nil))) + (list (nth 0 common) (nth 1 common) (nth 2 common) + ;; These are done separately here + ;; so that command-history will record these expressions + ;; rather than the values they had this time. + (if (and transient-mark-mode mark-active) + (region-beginning)) + (if (and transient-mark-mode mark-active) + (region-end))))) + (perform-replace from-string to-string t nil delimited nil nil start end)) + (define-key esc-map "%" 'query-replace) -(defun query-replace-regexp (regexp to-string &optional arg) +(defun query-replace-regexp (regexp to-string &optional delimited start end) "Replace some things after point matching REGEXP with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. +In Transient Mark mode, if the mark is active, operate on the contents +of the region. Otherwise, operate from point to the end of the buffer. + If `query-replace-interactive' is non-nil, the last incremental search regexp is used as REGEXP--you don't have to specify it with the minibuffer. -Preserves case in each replacement if `case-replace' and `case-fold-search' -are non-nil and REGEXP has no uppercase letters. +Matching is independent of case if `case-fold-search' is non-nil and +REGEXP has no uppercase letters. Replacement transfers the case +pattern of the old text to the new text, if `case-replace' and +`case-fold-search' are non-nil and REGEXP has no uppercase letters. +\(Transferring the case pattern means that if the old text matched is +all caps, or capitalized, then its replacement is upcased or +capitalized.) + Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. +Fourth and fifth arg START and END specify the region to operate on. + In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, and `\\=\\N' (where N is a digit) stands for whatever what matched the Nth `\\(...\\)' in REGEXP." - (interactive (query-replace-read-args "Query replace regexp" t)) - (perform-replace regexp to-string t t arg)) + (interactive + (let ((common + (query-replace-read-args "Query replace regexp" t))) + (list (nth 0 common) (nth 1 common) (nth 2 common) + ;; These are done separately here + ;; so that command-history will record these expressions + ;; rather than the values they had this time. + (if (and transient-mark-mode mark-active) + (region-beginning)) + (if (and transient-mark-mode mark-active) + (region-end))))) + + (perform-replace regexp to-string t t delimited nil nil start end)) +(define-key esc-map [?\C-%] 'query-replace-regexp) + +(defun query-replace-regexp-eval (regexp to-expr &optional delimited start end) + "Replace some things after point matching REGEXP with the result of TO-EXPR. +As each match is found, the user must type a character saying +what to do with it. For directions, type \\[help-command] at that time. + +TO-EXPR is a Lisp expression evaluated to compute each replacement. It may +reference `replace-count' to get the number of replacements already made. +If the result of TO-EXPR is not a string, it is converted to one using +`prin1-to-string' with the NOESCAPE argument (which see). + +For convenience, when entering TO-EXPR interactively, you can use `\\&' or +`\\0' to stand for whatever matched the whole of REGEXP, and `\\N' (where +N is a digit) to stand for whatever matched the Nth `\\(...\\)' in REGEXP. +Use `\\#&' or `\\#N' if you want a number instead of a string. + +In Transient Mark mode, if the mark is active, operate on the contents +of the region. Otherwise, operate from point to the end of the buffer. + +If `query-replace-interactive' is non-nil, the last incremental search +regexp is used as REGEXP--you don't have to specify it with the +minibuffer. + +Preserves case in each replacement if `case-replace' and `case-fold-search' +are non-nil and REGEXP has no uppercase letters. + +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." + (interactive + (let (from to) + (if query-replace-interactive + (setq from (car regexp-search-ring)) + (setq from (read-from-minibuffer "Query replace regexp: " + nil nil nil + query-replace-from-history-variable + nil t))) + (setq to (list (read-from-minibuffer + (format "Query replace regexp %s with eval: " from) + nil nil t query-replace-to-history-variable from t))) + ;; We make TO a list because replace-match-string-symbols requires one, + ;; and the user might enter a single token. + (replace-match-string-symbols to) + (list from (car to) current-prefix-arg + (if (and transient-mark-mode mark-active) + (region-beginning)) + (if (and transient-mark-mode mark-active) + (region-end))))) + (perform-replace regexp (cons 'replace-eval-replacement to-expr) + t 'literal delimited nil nil start end)) -(defun map-query-replace-regexp (regexp to-strings &optional arg) +(defun map-query-replace-regexp (regexp to-strings &optional n start end) "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 each successive replacement uses the next successive replacement string, +The second argument TO-STRINGS contains the replacement strings, +separated by spaces. Third arg DELIMITED (prefix arg if interactive), +if non-nil, means replace only matches surrounded by word boundaries. +This command works like `query-replace-regexp' except that each +successive replacement uses the next successive replacement string, wrapping around from the last such string to the first. +In Transient Mark mode, if the mark is active, operate on the contents +of the region. Otherwise, operate from point to the end of the buffer. + Non-interactively, TO-STRINGS may be a list of replacement strings. If `query-replace-interactive' is non-nil, the last incremental search regexp is used as REGEXP--you don't have to specify it with the minibuffer. A prefix argument N says to use each replacement string N times -before rotating to the next." +before rotating to the next. +Fourth and fifth arg START and END specify the region to operate on." (interactive (let (from to) (setq from (if query-replace-interactive (car regexp-search-ring) (read-from-minibuffer "Map query replace (regexp): " nil nil nil - 'query-replace-history))) + 'query-replace-history nil t))) (setq to (read-from-minibuffer (format "Query replace %s with (space-separated strings): " from) nil nil nil - 'query-replace-history)) - (list from to current-prefix-arg))) + 'query-replace-history from t)) + (list from to + (and current-prefix-arg + (prefix-numeric-value current-prefix-arg)) + (if (and transient-mark-mode mark-active) + (region-beginning)) + (if (and transient-mark-mode mark-active) + (region-end))))) (let (replacements) (if (listp to-strings) (setq replacements to-strings) @@ -128,17 +277,21 @@ before rotating to the next." (1+ (string-match " " to-strings)))) (setq replacements (append replacements (list to-strings)) to-strings "")))) - (perform-replace regexp replacements t t nil arg))) + (perform-replace regexp replacements t t nil n nil start end))) -(defun replace-string (from-string to-string &optional delimited) +(defun replace-string (from-string to-string &optional delimited start end) "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. \(Preserving case means that if the string matched is all caps, or capitalized, then its replacement is upcased or capitalized.) +In Transient Mark mode, if the mark is active, operate on the contents +of the region. Otherwise, operate from point to the end of the buffer. + Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. +Fourth and fifth arg START and END specify the region to operate on. If `query-replace-interactive' is non-nil, the last incremental search string is used as FROM-STRING--you don't have to specify it with the @@ -148,16 +301,31 @@ This function is usually the wrong thing to use in a Lisp program. What you probably want is a loop like this: (while (search-forward FROM-STRING nil t) (replace-match TO-STRING nil t)) -which will run faster and will not set the mark or print anything." - (interactive (query-replace-read-args "Replace string" nil)) - (perform-replace from-string to-string nil nil delimited)) +which will run faster and will not set the mark or print anything. +\(You may need a more complex loop if FROM-STRING can match the null string +and TO-STRING is also null.)" + (interactive + (let ((common + (query-replace-read-args "Replace string" nil))) + (list (nth 0 common) (nth 1 common) (nth 2 common) + (if (and transient-mark-mode mark-active) + (region-beginning)) + (if (and transient-mark-mode mark-active) + (region-end))))) + (perform-replace from-string to-string nil nil delimited nil nil start end)) -(defun replace-regexp (regexp to-string &optional delimited) +(defun replace-regexp (regexp to-string &optional delimited start end) "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. + +In Transient Mark mode, if the mark is active, operate on the contents +of the region. Otherwise, operate from point to the end of the buffer. + Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. +Fourth and fifth arg START and END specify the region to operate on. + In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, and `\\=\\N' (where N is a digit) stands for whatever what matched the Nth `\\(...\\)' in REGEXP. @@ -170,86 +338,191 @@ What you probably want is a loop like this: (while (re-search-forward REGEXP nil t) (replace-match TO-STRING nil nil)) which will run faster and will not set the mark or print anything." - (interactive (query-replace-read-args "Replace regexp" t)) - (perform-replace regexp to-string nil t delimited)) + (interactive + (let ((common + (query-replace-read-args "Replace regexp" t))) + (list (nth 0 common) (nth 1 common) (nth 2 common) + (if (and transient-mark-mode mark-active) + (region-beginning)) + (if (and transient-mark-mode mark-active) + (region-end))))) + (perform-replace regexp to-string nil t delimited nil nil start end)) + (defvar regexp-history nil "History list for some commands that read regular expressions.") + (defalias 'delete-non-matching-lines 'keep-lines) -(defun keep-lines (regexp) +(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. +Value is a list, (REGEXP)." + (list (read-from-minibuffer prompt nil nil nil + 'regexp-history nil t))) + +(defun keep-lines (regexp &optional rstart rend) "Delete all lines except those containing matches for REGEXP. A match split across lines preserves all the lines it lies in. -Applies to all lines after point." - (interactive (list (read-from-minibuffer - "Keep lines (containing match for regexp): " - nil nil nil 'regexp-history))) +Applies to all lines after point. + +If REGEXP contains upper case characters (excluding those preceded by `\\'), +the matching is case-sensitive. + +Second and third arg RSTART and REND specify the region to operate on. + +Interactively, in Transient Mark mode when the mark is active, operate +on the contents of the region. Otherwise, operate from point to the +end of the buffer." + + (interactive + (progn + (barf-if-buffer-read-only) + (keep-lines-read-args "Keep lines (containing match for regexp): "))) + (if rstart + (progn + (goto-char (min rstart rend)) + (setq rend (copy-marker (max rstart rend)))) + (if (and transient-mark-mode mark-active) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (setq rstart (point) + rend (point-max-marker))) + (goto-char rstart)) (save-excursion (or (bolp) (forward-line 1)) - (let ((start (point))) - (while (not (eobp)) + (let ((start (point)) + (case-fold-search (and case-fold-search + (isearch-no-upper-case-p regexp t)))) + (while (< (point) rend) ;; Start is first char not preserved by previous match. - (if (not (re-search-forward regexp nil 'move)) - (delete-region start (point-max)) + (if (not (re-search-forward regexp rend 'move)) + (delete-region start rend) (let ((end (save-excursion (goto-char (match-beginning 0)) (beginning-of-line) (point)))) ;; Now end is first char preserved by the new match. (if (< start end) (delete-region start end)))) - (setq start (save-excursion (forward-line 1) - (point))) + + (setq start (save-excursion (forward-line 1) (point))) ;; If the match was empty, avoid matching again at same place. - (and (not (eobp)) (= (match-beginning 0) (match-end 0)) + (and (< (point) rend) + (= (match-beginning 0) (match-end 0)) (forward-char 1)))))) -(defalias 'delete-matching-lines 'flush-lines) -(defun flush-lines (regexp) + +(defun flush-lines (regexp &optional rstart rend) "Delete lines containing matches for REGEXP. If a match is split across lines, all the lines it lies in are deleted. -Applies to lines after point." - (interactive (list (read-from-minibuffer - "Flush lines (containing match for regexp): " - nil nil nil 'regexp-history))) - (save-excursion - (while (and (not (eobp)) - (re-search-forward regexp nil t)) - (delete-region (save-excursion (goto-char (match-beginning 0)) - (beginning-of-line) - (point)) - (progn (forward-line 1) (point)))))) +Applies to lines after point. -(defalias 'count-matches 'how-many) -(defun how-many (regexp) - "Print number of matches for REGEXP following point." - (interactive (list (read-from-minibuffer - "How many matches for (regexp): " - nil nil nil 'regexp-history))) - (let ((count 0) opoint) +If REGEXP contains upper case characters (excluding those preceded by `\\'), +the matching is case-sensitive. + +Second and third arg RSTART and REND specify the region to operate on. + +Interactively, in Transient Mark mode when the mark is active, operate +on the contents of the region. Otherwise, operate from point to the +end of the buffer." + + (interactive + (progn + (barf-if-buffer-read-only) + (keep-lines-read-args "Flush lines (containing match for regexp): "))) + (if rstart + (progn + (goto-char (min rstart rend)) + (setq rend (copy-marker (max rstart rend)))) + (if (and transient-mark-mode mark-active) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (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)))) (save-excursion - (while (and (not (eobp)) - (progn (setq opoint (point)) - (re-search-forward regexp nil t))) - (if (= opoint (point)) - (forward-char 1) - (setq count (1+ count)))) - (message "%d occurrences" count)))) + (while (and (< (point) rend) + (re-search-forward regexp rend t)) + (delete-region (save-excursion (goto-char (match-beginning 0)) + (beginning-of-line) + (point)) + (progn (forward-line 1) (point))))))) + + +(defun how-many (regexp &optional rstart rend) + "Print number of matches for REGEXP following point. + +If REGEXP contains upper case characters (excluding those preceded by `\\'), +the matching is case-sensitive. + +Second and third arg RSTART and REND specify the region to operate on. + +Interactively, in Transient Mark mode when the mark is active, operate +on the contents of the region. Otherwise, operate from point to the +end of the buffer." + + (interactive + (keep-lines-read-args "How many matches for (regexp): ")) + (save-excursion + (if rstart + (goto-char (min rstart rend)) + (if (and transient-mark-mode mark-active) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (setq rstart (point) + rend (point-max-marker))) + (goto-char rstart)) + (let ((count 0) + opoint + (case-fold-search (and case-fold-search + (isearch-no-upper-case-p regexp t)))) + (while (and (< (point) rend) + (progn (setq opoint (point)) + (re-search-forward regexp rend t))) + (if (= opoint (point)) + (forward-char 1) + (setq count (1+ count)))) + (message "%d occurrences" count)))) + -(defvar occur-mode-map ()) -(if occur-mode-map - () - (setq occur-mode-map (make-sparse-keymap)) - (define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto) - (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence) - (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence) - (define-key occur-mode-map "g" 'revert-buffer)) - -(defvar occur-buffer nil) -(defvar occur-nlines nil) -(defvar occur-pos-list nil) -(defvar occur-command-arguments nil - "Arguments that were given to `occur' when it made this buffer.") +(defvar occur-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'occur-mode-mouse-goto) + (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence) + (define-key map "\C-m" 'occur-mode-goto-occurrence) + (define-key map "o" 'occur-mode-goto-occurrence-other-window) + (define-key map "\C-o" 'occur-mode-display-occurrence) + (define-key map "\M-n" 'occur-next) + (define-key map "\M-p" 'occur-prev) + (define-key map "r" 'occur-rename-buffer) + (define-key map "c" 'clone-buffer) + (define-key map "g" 'revert-buffer) + (define-key map "q" 'quit-window) + (define-key map "z" 'kill-this-buffer) + map) + "Keymap for `occur-mode'.") + +(defvar occur-revert-arguments nil + "Arguments to pass to `occur-1' to revert an Occur mode buffer. +See `occur-revert-function'.") + +(defcustom occur-mode-hook '(turn-on-font-lock) + "Hook run when entering Occur mode." + :type 'hook + :group 'matching) +(defcustom occur-hook nil + "Hook run when `occur' is called." + :type 'hook + :group 'matching) + +(put 'occur-mode 'mode-class 'special) (defun occur-mode () "Major mode for output from \\[occur]. \\Move point to one of the items in this buffer, then use @@ -257,82 +530,164 @@ Applies to lines after point." Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" + (interactive) (kill-all-local-variables) (use-local-map occur-mode-map) (setq major-mode 'occur-mode) (setq mode-name "Occur") - (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'occur-revert-function) - (make-local-variable 'occur-buffer) - (make-local-variable 'occur-nlines) - (make-local-variable 'occur-pos-list) - (make-local-variable 'occur-command-arguments) + (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) + (make-local-variable 'occur-revert-arguments) + (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (run-hooks 'occur-mode-hook)) -;; Handle revert-buffer for *Occur* buffers. (defun occur-revert-function (ignore1 ignore2) - (let ((args occur-command-arguments )) - (save-excursion - (set-buffer occur-buffer) - (apply 'occur args)))) + "Handle `revert-buffer' for Occur mode buffers." + (apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))) (defun occur-mode-mouse-goto (event) "In Occur mode, go to the occurrence whose line you click on." (interactive "e") - (let (buffer pos) + (let (pos) (save-excursion (set-buffer (window-buffer (posn-window (event-end event)))) (save-excursion (goto-char (posn-point (event-end event))) - (setq pos (occur-mode-find-occurrence)) - (setq buffer occur-buffer))) - (pop-to-buffer buffer) - (goto-char (marker-position pos)))) + (setq pos (occur-mode-find-occurrence)))) + (pop-to-buffer (marker-buffer pos)) + (goto-char pos))) (defun occur-mode-find-occurrence () - (if (or (null occur-buffer) - (null (buffer-name occur-buffer))) - (progn - (setq occur-buffer nil - occur-pos-list nil) - (error "Buffer in which occurrences were found is deleted"))) - (let* ((line-count - (count-lines (point-min) - (save-excursion - (beginning-of-line) - (point)))) - (occur-number (save-excursion - (beginning-of-line) - (/ (1- line-count) - (cond ((< occur-nlines 0) - (- 2 occur-nlines)) - ((> occur-nlines 0) - (+ 2 (* 2 occur-nlines))) - (t 1))))) - (pos (nth occur-number occur-pos-list))) - (if (< line-count 1) - (error "No occurrence on this line")) - (or pos - (error "No occurrence on this line")) + (let ((pos (get-text-property (point) 'occur-target))) + (unless pos + (error "No occurrence on this line")) + (unless (buffer-live-p (marker-buffer pos)) + (error "Buffer for this occurrence was killed")) pos)) (defun occur-mode-goto-occurrence () "Go to the occurrence the current line describes." (interactive) (let ((pos (occur-mode-find-occurrence))) - (pop-to-buffer occur-buffer) - (goto-char (marker-position pos)))) + (pop-to-buffer (marker-buffer pos)) + (goto-char pos))) + +(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))) + (switch-to-buffer-other-window (marker-buffer pos)) + (goto-char pos))) + +(defun occur-mode-display-occurrence () + "Display in another window the occurrence the current line describes." + (interactive) + (let ((pos (occur-mode-find-occurrence)) + window + ;; Bind these to ensure `display-buffer' puts it in another window. + same-window-buffer-names + same-window-regexps) + (setq window (display-buffer (marker-buffer pos))) + ;; This is the way to set point in the proper window. + (save-selected-window + (select-window window) + (goto-char pos)))) + +(defun occur-find-match (n search message) + (if (not n) (setq n 1)) + (let ((r)) + (while (> n 0) + (setq r (funcall search (point) 'occur-match)) + (and r + (get-text-property r 'occur-match) + (setq r (funcall search r 'occur-match))) + (if r + (goto-char r) + (error message)) + (setq n (1- n))))) + +(defun occur-next (&optional n) + "Move to the Nth (default 1) next match in an Occur mode buffer." + (interactive "p") + (occur-find-match n #'next-single-property-change "No more matches")) + +(defun occur-prev (&optional n) + "Move to the Nth (default 1) previous match in an Occur mode buffer." + (interactive "p") + (occur-find-match n #'previous-single-property-change "No earlier matches")) -(defvar list-matching-lines-default-context-lines 0 - "*Default number of context lines to include around a `list-matching-lines' -match. A negative number means to include that many lines before the match. -A positive number means to include that many lines both before and after.") +(defcustom list-matching-lines-default-context-lines 0 + "*Default number of context lines included around `list-matching-lines' matches. +A negative number means to include that many lines before the match. +A positive number means to include that many lines both before and after." + :type 'integer + :group 'matching) (defalias 'list-matching-lines 'occur) -(defvar list-matching-lines-face 'bold - "*Face used by M-x list-matching-lines to show the text that matches. -If the value is nil, don't highlight the matching portions specially.") +(defcustom list-matching-lines-face 'bold + "*Face used by \\[list-matching-lines] to show the text that matches. +If the value is nil, don't highlight the matching portions specially." + :type 'face + :group 'matching) + +(defcustom list-matching-lines-buffer-name-face 'underline + "*Face used by \\[list-matching-lines] to show the names of buffers. +If the value is nil, don't highlight the buffer names specially." + :type 'face + :group 'matching) + +(defun occur-accumulate-lines (count &optional no-props) + (save-excursion + (let ((forwardp (> count 0)) + (result nil)) + (while (not (or (zerop count) + (if forwardp + (eobp) + (bobp)))) + (setq count (+ count (if forwardp -1 1))) + (push + (funcall (if no-props + #'buffer-substring-no-properties + #'buffer-substring) + (line-beginning-position) + (line-end-position)) + result) + (forward-line (if forwardp 1 -1))) + (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'): " + default) + "List lines matching regexp: ") + nil + nil + nil + 'regexp-history))) + (if (equal input "") + default + input)) + (when current-prefix-arg + (prefix-numeric-value current-prefix-arg)))) + +(defun occur-rename-buffer (&optional unique-p) + "Rename the current *Occur* buffer to *Occur: original-buffer-name*. +Here `original-buffer-name' is the buffer name were occur was originally run. +When given the prefix argument, the renaming will not clobber the existing +buffer(s) of that name, but use `generate-new-buffer-name' instead. +You can add this to `occur-hook' if you always want a separate *Occur* +buffer for each buffer where you invoke `occur'." + (interactive "P") + (with-current-buffer + (if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*")) + (rename-buffer (concat "*Occur: " + (mapconcat #'buffer-name + (car (cddr occur-revert-arguments)) "/") + "*") + unique-p))) (defun occur (regexp &optional nlines) "Show all lines in the current buffer containing a match for REGEXP. @@ -346,150 +701,239 @@ Interactively it is the prefix arg. The lines are shown in a buffer named `*Occur*'. It serves as a menu to find any of the occurrences in this buffer. -\\[describe-mode] in that buffer will explain how." +\\\\[describe-mode] in that buffer will explain how. + +If REGEXP contains upper case characters (excluding those preceded by `\\'), +the matching is case-sensitive." + (interactive (occur-read-primary-args)) + (occur-1 regexp nlines (list (current-buffer)))) + +(defun multi-occur (bufs regexp &optional nlines) + "Show all lines in buffers BUFS containing a match for REGEXP. +This function acts on multiple buffers; otherwise, it is exactly like +`occur'." (interactive - (list (let* ((default (car regexp-history)) - (input - (read-from-minibuffer - (if default - (format "List lines matching regexp (default `%s'): " - default) - "List lines matching regexp: ") - nil nil nil 'regexp-history))) - (if (string-equal input "") - default - (set-text-properties 0 (length input) nil input) - input)) - current-prefix-arg)) - (let ((nlines (if nlines - (prefix-numeric-value nlines) - list-matching-lines-default-context-lines)) - (first t) - (buffer (current-buffer)) - (dir default-directory) - (linenum 1) - (prevpos (point-min)) - (final-context-start (make-marker))) -;;; (save-excursion -;;; (beginning-of-line) -;;; (setq linenum (1+ (count-lines (point-min) (point)))) -;;; (setq prevpos (point))) - (save-excursion - (goto-char (point-min)) - ;; Check first whether there are any matches at all. - (if (not (re-search-forward regexp nil t)) - (message "No matches for `%s'" regexp) - ;; Back up, so the search loop below will find the first match. - (goto-char (match-beginning 0)) - (with-output-to-temp-buffer "*Occur*" - (save-excursion - (set-buffer standard-output) - (setq default-directory dir) - ;; We will insert the number of lines, and "lines", later. - (insert " matching ") - (let ((print-escape-newlines t)) - (prin1 regexp)) - (insert " in buffer " (buffer-name buffer) ?. ?\n) - (occur-mode) - (setq occur-buffer buffer) - (setq occur-nlines nlines) - (setq occur-pos-list ()) - (setq occur-command-arguments - (list regexp nlines))) - (if (eq buffer standard-output) - (goto-char (point-max))) - (save-excursion - ;; Find next match, but give up if prev match was at end of buffer. - (while (and (not (= prevpos (point-max))) - (re-search-forward regexp nil t)) - (goto-char (match-beginning 0)) - (beginning-of-line) - (save-match-data - (setq linenum (+ linenum (count-lines prevpos (point))))) - (setq prevpos (point)) - (goto-char (match-end 0)) - (let* ((start (save-excursion - (goto-char (match-beginning 0)) - (forward-line (if (< nlines 0) nlines (- nlines))) - (point))) - (end (save-excursion - (goto-char (match-end 0)) - (if (> nlines 0) - (forward-line (1+ nlines)) - (forward-line 1)) - (point))) - ;; Record where the actual match - (match-offset - (save-excursion - (goto-char (match-beginning 0)) - (beginning-of-line) - ;; +6 to skip over line number - (+ 6 (- (match-beginning 0) (point))))) - (match-len (- (match-end 0) (match-beginning 0))) - (tag (format "%5d" linenum)) - (empty (make-string (length tag) ?\ )) - tem) - (save-excursion - (setq tem (make-marker)) - (set-marker tem (point)) - (set-buffer standard-output) - (setq occur-pos-list (cons tem occur-pos-list)) - (or first (zerop nlines) - (insert "--------\n")) - (setq first nil) - (insert-buffer-substring buffer start end) - (set-marker final-context-start - (- (point) (- end (match-end 0)))) - (backward-char (- end start)) - (setq tem nlines) - (while (> tem 0) - (insert empty ?:) - (forward-line 1) - (setq tem (1- tem))) - (let ((this-linenum linenum) - line-start) - (while (< (point) final-context-start) - (if (null tag) - (setq tag (format "%5d" this-linenum))) - (insert tag ?:) - (setq line-start - (save-excursion - (beginning-of-line) - (point))) - (put-text-property line-start - (save-excursion - (end-of-line) - (point)) - 'mouse-face 'highlight) - (if list-matching-lines-face - (put-text-property - (+ line-start match-offset) - (+ line-start match-offset match-len) - 'face list-matching-lines-face)) - (forward-line 1) - (setq tag nil) - (setq this-linenum (1+ this-linenum))) - (while (<= (point) final-context-start) - (insert empty ?:) - (forward-line 1) - (setq this-linenum (1+ this-linenum)))) - (while (< tem nlines) - (insert empty ?:) - (forward-line 1) - (setq tem (1+ tem))) - (goto-char (point-max))) - (forward-line 1))) - (set-buffer standard-output) - ;; Put positions in increasing order to go with buffer. - (setq occur-pos-list (nreverse occur-pos-list)) - (goto-char (point-min)) - (let ((message-string - (if (= (length occur-pos-list) 1) - "1 line" - (format "%d lines" (length occur-pos-list))))) - (insert message-string) - (if (interactive-p) - (message "%s matched" message-string))))))))) + (cons + (let* ((bufs (list (read-buffer "First buffer to search: " + (current-buffer) t))) + (buf nil) + (ido-ignore-item-temp-list bufs)) + (while (not (string-equal + (setq buf (read-buffer + (if (eq read-buffer-function 'ido-read-buffer) + "Next buffer to search (C-j to end): " + "Next buffer to search (RET to end): ") + nil t)) + "")) + (add-to-list 'bufs buf) + (setq ido-ignore-item-temp-list bufs)) + (nreverse (mapcar #'get-buffer bufs))) + (occur-read-primary-args))) + (occur-1 regexp nlines bufs)) + +(defun multi-occur-by-filename-regexp (bufregexp regexp &optional nlines) + "Show all lines matching REGEXP in buffers named by BUFREGEXP. +See also `multi-occur'." + (interactive + (cons + (let* ((default (car regexp-history)) + (input + (read-from-minibuffer + "List lines in buffers whose filename matches regexp: " + nil + nil + nil + 'regexp-history))) + (if (equal input "") + default + input)) + (occur-read-primary-args))) + (when bufregexp + (occur-1 regexp nlines + (delq nil + (mapcar (lambda (buf) + (when (and (buffer-file-name buf) + (string-match bufregexp + (buffer-file-name buf))) + buf)) + (buffer-list)))))) + +(defun occur-1 (regexp nlines bufs &optional buf-name) + (unless buf-name + (setq buf-name "*Occur*")) + (let ((occur-buf (get-buffer-create buf-name)) + (made-temp-buf nil) + (active-bufs (delq nil (mapcar #'(lambda (buf) + (when (buffer-live-p buf) buf)) + bufs)))) + ;; Handle the case where one of the buffers we're searching is the + ;; *Occur* buffer itself. + (when (memq occur-buf bufs) + (setq occur-buf (with-current-buffer occur-buf + (clone-buffer "*Occur-temp*")) + made-temp-buf t)) + (with-current-buffer occur-buf + (setq buffer-read-only nil) + (occur-mode) + (erase-buffer) + (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)) + list-matching-lines-buffer-name-face + nil list-matching-lines-face nil))) + (let* ((bufcount (length active-bufs)) + (diff (- (length bufs) bufcount))) + (message "Searched %d buffer%s%s; %s match%s for `%s'" + bufcount (if (= bufcount 1) "" "s") + (if (zerop diff) "" (format " (%d killed)" diff)) + (if (zerop count) "no" (format "%d" count)) + (if (= count 1) "" "es") + regexp)) + ;; If we had to make a temporary buffer, make it the *Occur* + ;; buffer now. + (when made-temp-buf + (with-current-buffer (get-buffer buf-name) + (kill-buffer (current-buffer))) + (rename-buffer buf-name)) + (setq occur-revert-arguments (list regexp nlines bufs) + buffer-read-only t) + (if (> count 0) + (display-buffer occur-buf) + (kill-buffer occur-buf))) + (run-hooks 'occur-hook)))) + +(defun occur-engine-add-prefix (lines) + (mapcar + #'(lambda (line) + (concat " :" line "\n")) + lines)) + +(defun occur-engine (regexp buffers out-buf nlines case-fold-search + title-face prefix-face match-face keep-props) + (with-current-buffer out-buf + (setq buffer-read-only nil) + (let ((globalcount 0) + (coding nil)) + ;; Map over all the buffers + (dolist (buf buffers) + (when (buffer-live-p buf) + (let ((matches 0) ;; count of matched lines + (lines 1) ;; line count + (matchbeg 0) + (matchend 0) + (origpt nil) + (begpt nil) + (endpt nil) + (marker nil) + (curstring "") + (headerpt (with-current-buffer out-buf (point)))) + (save-excursion + (set-buffer buf) + (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)) + (setq origpt (point)) + (when (setq endpt (re-search-forward regexp nil t)) + (setq matches (1+ matches)) ;; increment match count + (setq matchbeg (match-beginning 0) + matchend (match-end 0)) + (setq begpt (save-excursion + (goto-char matchbeg) + (line-beginning-position))) + (setq lines (+ lines (1- (count-lines origpt endpt)))) + (setq marker (make-marker)) + (set-marker marker matchbeg) + (setq curstring (buffer-substring begpt + (line-end-position))) + ;; Depropertize the string, and maybe + ;; highlight the matches + (let ((len (length curstring)) + (start 0)) + (unless keep-props + (set-text-properties 0 len nil curstring)) + (while (and (< start len) + (string-match regexp curstring start)) + (add-text-properties (match-beginning 0) + (match-end 0) + (append + `(occur-match t) + (when match-face + `(font-lock-face ,match-face))) + curstring) + (setq start (match-end 0)))) + ;; Generate the string to insert for this match + (let* ((out-line + (concat + ;; Using 7 digits aligns tabs properly. + (apply #'propertize (format "%7d:" lines) + (append + (when prefix-face + `(font-lock-face prefix-face)) + '(occur-prefix t))) + curstring + "\n")) + (data + (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+ nlines)) keep-props)))) + (list out-line) + (occur-engine-add-prefix (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))) + ;; Actually insert the match display data + (with-current-buffer out-buf + (let ((beg (point)) + (end (progn (insert data) (point)))) + (unless (= nlines 0) + (insert "-------\n")) + (add-text-properties + beg end + `(occur-target ,marker help-echo "mouse-2: go to this occurrence")) + ;; We don't put `mouse-face' on the newline, + ;; because that loses. + (add-text-properties beg (1- end) '(mouse-face highlight))))) + (goto-char endpt)) + (if endpt + (progn + (setq lines (1+ lines)) + ;; On to the next match... + (forward-line 1)) + (goto-char (point-max)))))) + (when (not (zerop matches)) ;; is the count zero? + (setq globalcount (+ globalcount matches)) + (with-current-buffer out-buf + (goto-char headerpt) + (let ((beg (point)) + end) + (insert (format "%d match%s for \"%s\" in buffer: %s\n" + matches (if (= matches 1) "" "es") + regexp (buffer-name buf))) + (setq end (point)) + (add-text-properties beg end + (append + (when title-face + `(font-lock-face ,title-face)) + `(occur-title ,buf)))) + (goto-char (point-min))))))) + (if coding + ;; CODING is buffer-file-coding-system of the first buffer + ;; that locally binds it. Let's use it also for the output + ;; buffer. + (set-buffer-file-coding-system coding)) + ;; Return the number of matches + globalcount))) + ;; It would be nice to use \\[...], but there is no reasonable way ;; to make that display both SPC and Y. @@ -501,8 +945,9 @@ C-r to enter recursive edit (\\[exit-recursive-edit] to get out again), 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 with no more questions, -^ to move point back to previous match." - "Help message while in query-replace") +^ to move point back to previous match, +E to edit the replacement string" + "Help message while in `query-replace'.") (defvar query-replace-map (make-sparse-keymap) "Keymap that defines the responses to questions in `query-replace'. @@ -519,6 +964,8 @@ The valid answers include `act', `skip', `act-and-show', (define-key query-replace-map "n" 'skip) (define-key query-replace-map "Y" 'act) (define-key query-replace-map "N" 'skip) +(define-key query-replace-map "e" 'edit-replacement) +(define-key query-replace-map "E" 'edit-replacement) (define-key query-replace-map "," 'act-and-show) (define-key query-replace-map "q" 'exit) (define-key query-replace-map "\r" 'exit) @@ -538,40 +985,122 @@ The valid answers include `act', `skip', `act-and-show', (define-key query-replace-map "\e" 'exit-prefix) (define-key query-replace-map [escape] 'exit-prefix) +(defun replace-match-string-symbols (n) + "Process a list (and any sub-lists), expanding certain symbols. +Symbol Expands To +N (match-string N) (where N is a string of digits) +#N (string-to-number (match-string N)) +& (match-string 0) +#& (string-to-number (match-string 0)) + +Note that these symbols must be preceeded by a backslash in order to +type them." + (while n + (cond + ((consp (car n)) + (replace-match-string-symbols (car n))) ;Process sub-list + ((symbolp (car n)) + (let ((name (symbol-name (car n)))) + (cond + ((string-match "^[0-9]+$" name) + (setcar n (list 'match-string (string-to-number name)))) + ((string-match "^#[0-9]+$" name) + (setcar n (list 'string-to-number + (list 'match-string + (string-to-number (substring name 1)))))) + ((string= "&" name) + (setcar n '(match-string 0))) + ((string= "#&" name) + (setcar n '(string-to-number (match-string 0)))))))) + (setq n (cdr n)))) + +(defun replace-eval-replacement (expression replace-count) + (let ((replacement (eval expression))) + (if (stringp replacement) + replacement + (prin1-to-string replacement t)))) + +(defun replace-loop-through-replacements (data replace-count) + ;; DATA is a vector contaning the following values: + ;; 0 next-rotate-count + ;; 1 repeat-count + ;; 2 next-replacement + ;; 3 replacements + (if (= (aref data 0) replace-count) + (progn + (aset data 0 (+ replace-count (aref data 1))) + (let ((next (cdr (aref data 2)))) + (aset data 2 (if (consp next) next (aref data 3)))))) + (car (aref data 2))) + (defun perform-replace (from-string replacements query-flag regexp-flag delimited-flag - &optional repeat-count map) + &optional repeat-count map start end) "Subroutine of `query-replace'. Its complexity handles interactive queries. Don't use this in your own program unless you want to query and set the mark just as `query-replace' does. Instead, write a simple loop like this: - (while (re-search-forward \"foo[ \t]+bar\" nil t) + + (while (re-search-forward \"foo[ \\t]+bar\" nil t) (replace-match \"foobar\" nil nil)) -which will run faster and probably do exactly what you want." + +which will run faster and probably do exactly what you want. Please +see the documentation of `replace-match' to find out how to simulate +`case-replace'. + +This function returns nil if and only if there were no matches to +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))))) - (literal (not regexp-flag)) + (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) - (replacement-index 0) (keep-going t) (stack nil) - (next-rotate-count 0) (replace-count 0) - (lastrepl nil) ;Position after last match considered. + (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 (substitute-command-keys "Query replacing %s with %s: (\\\\[help] for help) ")))) - (if (stringp replacements) - (setq next-replacement replacements) - (or repeat-count (setq repeat-count 1))) + + ;; If region is active, in Transient Mark mode, operate on region. + (when start + (setq limit (copy-marker (max start end))) + (goto-char (min start end)) + (deactivate-mark)) + + ;; 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. + (cond + ((stringp replacements) + (setq next-replacement replacements + 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 + (vector repeat-count repeat-count + replacements replacements))))) + (if delimited-flag (setq search-function 're-search-forward search-string (concat "\\b" @@ -584,146 +1113,191 @@ which will run faster and probably do exactly what you want." ;; Loop finding occurrences that perhaps should be replaced. (while (and keep-going (not (eobp)) - (funcall search-function search-string nil t) - ;; If the search string matches immediately after - ;; the previous match, but it did not match there - ;; before the replacement was done, ignore the match. - (if (or (eq lastrepl (point)) - (and regexp-flag - (eq lastrepl (match-beginning 0)) - (not match-again))) - (if (eobp) - nil - ;; Don't replace the null string - ;; right after end of previous replacement. - (forward-char 1) - (funcall search-function search-string nil t)) - t)) - - ;; Save the data associated with the real match. - ;; For speed, use only integers and reuse the list used last time. - (setq real-match-data (match-data t real-match-data)) - - ;; Before we make the replacement, decide whether the search string - ;; can match again just after this match. - (if regexp-flag - (setq match-again (looking-at search-string))) - ;; If time for a change, advance to next replacement string. - (if (and (listp replacements) - (= next-rotate-count replace-count)) - (progn - (setq next-rotate-count - (+ next-rotate-count repeat-count)) - (setq next-replacement (nth replacement-index replacements)) - (setq replacement-index (% (1+ replacement-index) (length replacements))))) - (if (not query-flag) - (progn - (store-match-data real-match-data) - (replace-match next-replacement nocasify literal) - (setq replace-count (1+ replace-count))) - (undo-boundary) - (let (done replaced key def) - ;; Loop reading commands until one of them sets done, - ;; which means it has finished handling this occurrence. - (while (not done) - (store-match-data real-match-data) - (replace-highlight (match-beginning 0) (match-end 0)) - ;; Bind message-log-max so we don't fill up the message log - ;; with a bunch of identical messages. - (let ((message-log-max nil)) - (message message from-string next-replacement)) - (setq key (read-event)) - (setq key (vector key)) - (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 regexp-flag "regexp " "") - from-string " with " - next-replacement ".\n\n" - (substitute-command-keys - query-replace-help))) - (save-excursion - (set-buffer standard-output) - (help-mode)))) - ((eq def 'exit) - (setq keep-going nil) - (setq done t)) - ((eq def 'backup) - (if stack - (let ((elt (car stack))) - (goto-char (car elt)) - (setq replaced (eq t (cdr elt))) - (or replaced - (store-match-data (cdr elt))) - (setq stack (cdr stack))) - (message "No previous match") - (ding 'no-terminate) - (sit-for 1))) - ((eq def 'act) - (or replaced - (progn - (replace-match next-replacement nocasify literal) - (setq replace-count (1+ replace-count)))) - (setq done t replaced t)) - ((eq def 'act-and-exit) - (or replaced - (progn - (replace-match next-replacement nocasify literal) - (setq replace-count (1+ replace-count)))) - (setq keep-going nil) - (setq done t replaced t)) - ((eq def 'act-and-show) - (if (not replaced) - (progn - (replace-match next-replacement nocasify literal) - (setq replace-count (1+ replace-count)) - (setq replaced t)))) - ((eq def 'automatic) - (or replaced - (progn - (replace-match next-replacement nocasify literal) - (setq replace-count (1+ replace-count)))) - (setq done t query-flag nil replaced t)) - ((eq def 'skip) - (setq done t)) - ((eq def 'recenter) - (recenter nil)) - ((eq def 'edit) - (store-match-data - (prog1 (match-data) - (save-excursion (recursive-edit)))) - ;; Before we make the replacement, - ;; decide whether the search string - ;; can match again just after this match. - (if regexp-flag - (setq match-again (looking-at search-string)))) - ((eq def 'delete-and-edit) - (delete-region (match-beginning 0) (match-end 0)) - (store-match-data - (prog1 (match-data) - (save-excursion (recursive-edit)))) - (setq replaced t)) - ;; Note: we do not need to treat `exit-prefix' - ;; specially here, since we reread - ;; any unrecognized character. - (t - (setq this-command 'mode-exited) - (setq keep-going nil) - (setq unread-command-events - (append (listify-key-sequence key) - unread-command-events)) - (setq done t)))) - ;; Record previous position for ^ when we move on. - ;; Change markers to numbers in the match data - ;; since lots of markers slow down editing. - (setq stack - (cons (cons (point) - (or replaced (match-data t))) - stack)))) - (setq lastrepl (point))) + ;; Use the next match if it is already known; + ;; otherwise, search for a match after moving forward + ;; one char if progress is required. + (setq real-match-data + (if (consp match-again) + (progn (goto-char (nth 1 match-again)) + match-again) + (and (or match-again + ;; MATCH-AGAIN non-nil means we + ;; accept an adjacent match. If + ;; we don't, move one char to the + ;; right. This takes us a + ;; character too far at the end, + ;; but this is undone after the + ;; while-loop. + (progn (forward-char 1) (not (eobp)))) + (funcall search-function search-string limit t) + ;; For speed, use only integers and + ;; reuse the list used last time. + (match-data t real-match-data))))) + ;; Optionally ignore matches that have a read-only property. + (unless (and query-replace-skip-read-only + (text-property-not-all + (match-beginning 0) (match-end 0) + 'read-only nil)) + + ;; Record whether the match is nonempty, to avoid an infinite loop + ;; repeatedly matching the same empty string. + (setq nonempty-match + (/= (nth 0 real-match-data) (nth 1 real-match-data))) + + ;; If the match is empty, record that the next one can't be + ;; adjacent. + + ;; Otherwise, if matching a regular expression, do the next + ;; match now, since the replacement for this match may + ;; affect whether the next match is adjacent to this one. + ;; If that match is empty, don't use it. + (setq match-again + (and nonempty-match + (or (not regexp-flag) + (and (looking-at search-string) + (let ((match (match-data))) + (and (/= (nth 0 match) (nth 1 match)) + match)))))) + + ;; Calculate the replacement string, if necessary. + (when replacements + (set-match-data real-match-data) + (setq next-replacement + (funcall (car replacements) (cdr replacements) + replace-count))) + (if (not query-flag) + (let ((inhibit-read-only query-replace-skip-read-only)) + (set-match-data real-match-data) + (replace-match next-replacement nocasify literal) + (setq replace-count (1+ replace-count))) + (undo-boundary) + (let (done replaced key def) + ;; Loop reading commands until one of them sets done, + ;; which means it has finished handling this occurrence. + (while (not done) + (set-match-data real-match-data) + (replace-highlight (match-beginning 0) (match-end 0)) + ;; Bind message-log-max so we don't fill up the message log + ;; with a bunch of identical messages. + (let ((message-log-max nil)) + (message message from-string next-replacement)) + (setq key (read-event)) + ;; 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)) + ;; Restore the match data while we process the command. + (cond ((eq def 'help) + (with-output-to-temp-buffer "*Help*" + (princ + (concat "Query replacing " + (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)) + ((eq def 'backup) + (if stack + (let ((elt (pop stack))) + (goto-char (car elt)) + (setq replaced (eq t (cdr elt))) + (or replaced + (set-match-data (cdr elt)))) + (message "No previous match") + (ding 'no-terminate) + (sit-for 1))) + ((eq def 'act) + (or replaced + (progn + (replace-match next-replacement nocasify literal) + (setq replace-count (1+ replace-count)))) + (setq done t replaced t)) + ((eq def 'act-and-exit) + (or replaced + (progn + (replace-match next-replacement nocasify literal) + (setq replace-count (1+ replace-count)))) + (setq keep-going nil) + (setq done t replaced t)) + ((eq def 'act-and-show) + (if (not replaced) + (progn + (replace-match next-replacement nocasify literal) + (setq replace-count (1+ replace-count)) + (setq replaced t)))) + ((eq def 'automatic) + (or replaced + (progn + (replace-match next-replacement nocasify literal) + (setq replace-count (1+ replace-count)))) + (setq done t query-flag nil replaced t)) + ((eq def 'skip) + (setq done t)) + ((eq def 'recenter) + (recenter nil)) + ((eq def 'edit) + (let ((opos (point-marker))) + (goto-char (match-beginning 0)) + (save-excursion + (funcall search-function search-string limit t) + (setq real-match-data (match-data))) + (save-excursion + (save-window-excursion + (recursive-edit))) + (goto-char opos)) + (set-match-data real-match-data) + ;; Before we make the replacement, + ;; decide whether the search string + ;; can match again just after this match. + (if (and regexp-flag nonempty-match) + (setq match-again (and (looking-at search-string) + (match-data))))) + + ;; Edit replacement. + ((eq def 'edit-replacement) + (setq next-replacement + (read-input "Edit replacement string: " + next-replacement)) + (or replaced + (replace-match next-replacement nocasify literal)) + (setq done t)) + + ((eq def 'delete-and-edit) + (delete-region (match-beginning 0) (match-end 0)) + (set-match-data + (prog1 (match-data) + (save-excursion (recursive-edit)))) + (setq replaced t)) + ;; Note: we do not need to treat `exit-prefix' + ;; specially here, since we reread + ;; any unrecognized character. + (t + (setq this-command 'mode-exited) + (setq keep-going nil) + (setq unread-command-events + (append (listify-key-sequence key) + unread-command-events)) + (setq done t)))) + ;; Record previous position for ^ when we move on. + ;; Change markers to numbers in the match data + ;; since lots of markers slow down editing. + (setq stack + (cons (cons (point) + (or replaced (match-data t))) + stack)))))) + + ;; The code preventing adjacent regexp matches in the condition + ;; of the while-loop above will haven taken us one character + ;; beyond the last replacement. Undo that. + (when (and regexp-flag (not match-again) (> replace-count 0)) + (backward-char 1)) + (replace-dehighlight)) (or unread-command-events (message "Replaced %d occurrence%s" @@ -731,8 +1305,10 @@ which will run faster and probably do exactly what you want." (if (= replace-count 1) "" "s"))) (and keep-going stack))) -(defvar query-replace-highlight nil - "*Non-nil means to highlight words during query replacement.") +(defcustom query-replace-highlight t + "*Non-nil means to highlight words during query replacement." + :type 'boolean + :group 'matching) (defvar replace-overlay nil) @@ -749,8 +1325,9 @@ which will run faster and probably do exactly what you want." (progn (setq replace-overlay (make-overlay start end)) (overlay-put replace-overlay 'face - (if (internal-find-face 'query-replace) + (if (facep 'query-replace) 'query-replace 'region)))) (move-overlay replace-overlay start end (current-buffer))))) +;;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4 ;;; replace.el ends here