X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/470bbe9bbee2c6f645bf75ea6c8e88857c7e78d3..327719ee8a3fcdb36ed6acaf6d8cb5fbdf0bd801:/lisp/replace.el diff --git a/lisp/replace.el b/lisp/replace.el index 6ece7d2b01..89f55c2829 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1,7 +1,9 @@ -;;; replace.el --- replace commands for Emacs. +;;; replace.el --- replace commands for Emacs -;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000, 2001 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000, 2001, 2002, +;; 2003, 2004 Free Software Foundation, Inc. + +;; Maintainer: FSF ;; This file is part of GNU Emacs. @@ -28,18 +30,20 @@ ;;; Code: (defcustom case-replace t - "*Non-nil means query-replace should preserve case in replacements." + "*Non-nil means `query-replace' should preserve case in replacements." :type 'boolean :group 'matching) (defvar query-replace-history nil) -(defvar query-replace-interactive nil +(defcustom query-replace-interactive nil "Non-nil means `query-replace' uses the last search string. -That becomes the \"string to replace\".") +That becomes the \"string to replace\"." + :type 'boolean + :group 'matching) (defcustom query-replace-from-history-variable 'query-replace-history - "History list to use for the FROM argument of query-replace commands. + "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." @@ -48,7 +52,7 @@ or patterns to be replaced." :version "20.3") (defcustom query-replace-to-history-variable 'query-replace-history - "History list to use for the TO argument of query-replace commands. + "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." @@ -56,20 +60,42 @@ strings or patterns." :type 'symbol :version "20.3") -(defun query-replace-read-args (string regexp-flag) +(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-from-history-variable - nil t))) - (setq to (read-from-minibuffer (format "%s %s with: " string from) - nil nil nil - query-replace-to-history-variable from t)) - (if (and transient-mark-mode mark-active) - (list from to current-prefix-arg (region-beginning) (region-end)) - (list from to current-prefix-arg nil nil)))) + ;; 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. + (and regexp-flag + (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) + (let ((match (match-string 3 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 delimited start end) "Replace some occurrences of FROM-STRING with TO-STRING. @@ -83,19 +109,30 @@ 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. -Replacement transfers the case 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. -\(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 start end t nil delimited)) + (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) @@ -111,8 +148,13 @@ 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. @@ -120,9 +162,62 @@ 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 start end t t delimited)) +whatever what matched the Nth `\\(...\\)' in REGEXP. + +When this function is called interactively, the replacement text +can also contain `\\,' followed by a Lisp expression. The escaped +shorthands for `query-replace-regexp-eval' are also valid +here: within the Lisp expression, you can use `\\&' for the whole +match string, `\\N' for partial matches, `\\#&' and `\\#N' for +the respective numeric values, and `\\#' for `replace-count'. + +If your Lisp expression is an identifier and the next +letter in the replacement string would be interpreted as part of it, +you can wrap it with an expression like `\\,(or \\#)'. Incidentally, +for this particular case you may also enter `\\#' in the replacement +text directly. + +When you use `\\,' or `\\#' in the replacement, TO-STRING actually +becomes a list with expanded shorthands. +Use \\[repeat-complex-command] after this command to see details." + (interactive + (let ((common + (query-replace-read-args "Query replace regexp" t))) + (list + (nth 0 common) + (if (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" + (nth 1 common)) + (let ((to-string (nth 1 common)) pos to-expr char prompt) + (while (string-match + "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" + to-string) + (setq pos (match-end 0)) + (push (substring to-string 0 (- pos 2)) to-expr) + (setq char (aref to-string (1- pos)) + to-string (substring to-string pos)) + (cond ((eq char ?\#) + (push '(number-to-string replace-count) to-expr)) + ((eq char ?\,) + (setq pos (read-from-string to-string)) + (push `(replace-quote ,(car pos)) to-expr) + (setq to-string (substring to-string (cdr pos)))))) + (setq to-expr (nreverse (delete "" (cons to-string to-expr)))) + (replace-match-string-symbols to-expr) + (cons 'replace-eval-replacement + (if (> (length to-expr) 1) + (cons 'concat to-expr) + (car to-expr)))) + (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) @@ -136,9 +231,10 @@ 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. +`\\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 interactive use, `\\#' in itself stands for `replace-count'. 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. @@ -154,10 +250,7 @@ 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 start end) - (when (and transient-mark-mode mark-active) - (setq start (region-beginning) - end (region-end))) + (let (from to) (if query-replace-interactive (setq from (car regexp-search-ring)) (setq from (read-from-minibuffer "Query replace regexp: " @@ -170,9 +263,13 @@ Fourth and fifth arg START and END specify the region to operate on." ;; 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) start end current-prefix-arg))) + (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) - start end t t delimited)) + t 'literal delimited nil nil start end)) (defun map-query-replace-regexp (regexp to-strings &optional n start end) "Replace some matches for REGEXP with various strings, in rotation. @@ -195,10 +292,7 @@ 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." (interactive - (let (from to start end) - (when (and transient-mark-mode mark-active) - (setq start (region-beginning) - end (region-end))) + (let (from to) (setq from (if query-replace-interactive (car regexp-search-ring) (read-from-minibuffer "Map query replace (regexp): " @@ -209,7 +303,13 @@ Fourth and fifth arg START and END specify the region to operate on." from) nil nil nil 'query-replace-history from t)) - (list from to start end current-prefix-arg))) + (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) @@ -223,7 +323,7 @@ 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 start end t t nil n))) + (perform-replace regexp replacements t t nil n nil start end))) (defun replace-string (from-string to-string &optional delimited start end) "Replace occurrences of FROM-STRING with TO-STRING. @@ -250,8 +350,15 @@ What you probably want is a loop like this: 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 (query-replace-read-args "Replace string" nil)) - (perform-replace from-string to-string start end nil nil delimited)) + (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 start end) "Replace things after point matching REGEXP with TO-STRING. @@ -277,8 +384,15 @@ 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 start end 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 @@ -293,22 +407,9 @@ which will run faster and will not set the mark or print anything." (defun keep-lines-read-args (prompt) "Read arguments for `keep-lines' and friends. Prompt for a regexp with PROMPT. - -Value is a list (REGEXP START END). - -If in Transient Mark node, and the mark is active, START is the -start of the region, and end is a marker for the end of the region. -Otherwise, START is the current point, and END is `point-max-marker'." - (let ((regexp (read-from-minibuffer prompt nil nil nil - 'regexp-history nil t)) - start end) - (if (and transient-mark-mode mark-active) - (setq start (region-beginning) - end (save-excursion (goto-char (region-end)) (point-marker))) - (setq start (point) - end (point-max-marker))) - (list regexp start end))) - +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. @@ -320,13 +421,24 @@ the matching is case-sensitive. Second and third arg RSTART and REND specify the region to operate on. -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." +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 "Keep lines (containing match for regexp): ")) + (progn + (barf-if-buffer-read-only) + (keep-lines-read-args "Keep lines (containing match for regexp): "))) (if rstart - (goto-char (min rstart rend)) - (setq rstart (point) rend (point-max-marker))) + (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)) @@ -342,7 +454,7 @@ of the region. Otherwise, operate from point to the end of the buffer." ;; 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))) ;; If the match was empty, avoid matching again at same place. (and (< (point) rend) @@ -360,13 +472,24 @@ the matching is case-sensitive. Second and third arg RSTART and REND specify the region to operate on. -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." +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 "Flush lines (containing match for regexp): ")) + (progn + (barf-if-buffer-read-only) + (keep-lines-read-args "Flush lines (containing match for regexp): "))) (if rstart - (goto-char (min rstart rend)) - (setq rstart (point) rend (point-max-marker))) + (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 @@ -386,51 +509,66 @@ the matching is case-sensitive. Second and third arg RSTART and REND specify the region to operate on. -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." +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): ")) - (if rstart - (goto-char (min rstart rend)) - (setq rstart (point) rend (point-max-marker))) - (let ((count 0) - opoint - (case-fold-search (and case-fold-search - (isearch-no-upper-case-p regexp t)))) - (save-excursion - (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)))) + (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 "\M-n" 'occur-next) - (define-key occur-mode-map "\M-p" 'occur-prev) - (define-key occur-mode-map "g" 'revert-buffer)) - - -(defvar occur-buffer nil - "Name of buffer for last occur.") - - -(defvar occur-nlines nil - "Number of lines of context to show around matching line.") +(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) -(defvar occur-command-arguments nil - "Arguments that were given to `occur' when it made this buffer.") +(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 @@ -438,87 +576,106 @@ of the region. Otherwise, operate from point to the end of the buffer." 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-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) + (setq next-error-function 'occur-next-error) (run-hooks 'occur-mode-hook)) (defun occur-revert-function (ignore1 ignore2) - "Handle revert-buffer for *Occur* buffers." - (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) - (error "Buffer in which occurrences were found is deleted"))) - (let ((pos (get-text-property (point) 'occur))) - (if (null pos) - (error "No occurrence on this line") - pos))) + (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-next (&optional n) - "Move to the Nth (default 1) next match in the *Occur* buffer." - (interactive "p") +(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) - (if (get-text-property (point) 'occur-point) - (forward-char 1)) - (setq r (next-single-property-change (point) 'occur-point)) + (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 "No more matches")) + (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 the *Occur* buffer." + "Move to the Nth (default 1) previous match in an Occur mode buffer." (interactive "p") - (if (not n) (setq n 1)) - (let ((r)) - (while (> n 0) - - (setq r (get-text-property (point) 'occur-point)) - (if r (forward-char -1)) - - (setq r (previous-single-property-change (point) 'occur-point)) - (if r - (goto-char (- r 1)) - (error "No earlier matches")) - - (setq n (1- n))))) + (occur-find-match n #'previous-single-property-change "No earlier matches")) + +(defun occur-next-error (&optional argp reset) + "Move to the Nth (default 1) next match in an Occur mode buffer. +Compatibility function for \\[next-error] invocations." + (interactive "p") + (when reset + (occur-find-match 0 #'next-single-property-change "No first match")) + (occur-find-match + (prefix-numeric-value argp) + (if (> 0 (prefix-numeric-value argp)) + #'previous-single-property-change + #'next-single-property-change) + "No more matches") + (occur-mode-goto-occurrence)) + (defcustom list-matching-lines-default-context-lines 0 "*Default number of context lines included around `list-matching-lines' matches. @@ -529,9 +686,70 @@ A positive number means to include that many lines both before and after." (defalias 'list-matching-lines 'occur) -(defvar list-matching-lines-face 'bold +(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.") +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. @@ -549,224 +767,237 @@ It serves as a menu to find any of the occurrences in this buffer. 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 default t))) - (and (equal input "") default - (setq input default)) - input) - current-prefix-arg)) - (let* ((nlines (if nlines - (prefix-numeric-value nlines) - list-matching-lines-default-context-lines)) - (current-tab-width tab-width) - ;; Minimum width of line number plus trailing colon. - (min-line-number-width 6) - ;; Width of line number prefix without the colon. Choose a - ;; width that's a multiple of `tab-width' in the original - ;; buffer so that lines in *Occur* appear right. - (line-number-width (1- (* (/ (- (+ min-line-number-width - tab-width) - 1) - tab-width) - tab-width))) - ;; Format string for line numbers. - (line-number-format (format "%%%dd" line-number-width)) - (empty (make-string line-number-width ?\ )) - (first t) - ;;flag to prevent printing separator for first match - (occur-num-matches 0) - (buffer (current-buffer)) - (dir default-directory) - (linenum 1) - (prevpos - ;;position of most recent match - (point-min)) - (case-fold-search (and case-fold-search - (isearch-no-upper-case-p regexp t))) - (final-context-start - ;; Marker to the start of context immediately following - ;; the matched text in *Occur*. - (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-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 (eobp)) - (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 point of text in source buffer to be put - ;;into *Occur* - (start (save-excursion - (goto-char (match-beginning 0)) - (forward-line (if (< nlines 0) - nlines - (- nlines))) - (point))) - ;; end point of text in source buffer to be put - ;; into *Occur* - (end (save-excursion - (goto-char (match-end 0)) - (if (> nlines 0) - (forward-line (1+ nlines)) - (forward-line 1)) - (point))) - ;; Amount of context before matching text - (match-beg (- (match-beginning 0) start)) - ;; Length of matching text - (match-len (- (match-end 0) (match-beginning 0))) - (tag (format line-number-format linenum)) - tem - insertion-start - ;; Number of lines of context to show for current match. - occur-marker - ;; Marker pointing to end of match in source buffer. - (text-beg - ;; Marker pointing to start of text for one - ;; match in *Occur*. - (make-marker)) - (text-end - ;; Marker pointing to end of text for one match - ;; in *Occur*. - (make-marker))) - (save-excursion - (setq occur-marker (make-marker)) - (set-marker occur-marker (point)) - (set-buffer standard-output) - (setq occur-num-matches (1+ occur-num-matches)) - (or first (zerop nlines) - (insert "--------\n")) - (setq first nil) - (save-excursion - (set-buffer "*Occur*") - (setq tab-width current-tab-width)) - - ;; Insert matching text including context lines from - ;; source buffer into *Occur* - (set-marker text-beg (point)) - (setq insertion-start (point)) - (insert-buffer-substring buffer start end) - (or (and (/= (+ start match-beg) end) - (with-current-buffer buffer - (eq (char-before end) ?\n))) - (insert "\n")) - (set-marker final-context-start - (+ (- (point) (- end (match-end 0))) - (if (save-excursion - (set-buffer buffer) - (save-excursion - (goto-char (match-end 0)) - (end-of-line) - (bolp))) - 1 0))) - (set-marker text-end (point)) - - ;; Highlight text that was matched. - (if list-matching-lines-face - (put-text-property - (+ (marker-position text-beg) match-beg) - (+ (marker-position text-beg) match-beg match-len) - 'face list-matching-lines-face)) - - ;; `occur-point' property is used by occur-next and - ;; occur-prev to move between matching lines. - (put-text-property - (+ (marker-position text-beg) match-beg match-len) - (+ (marker-position text-beg) match-beg match-len 1) - 'occur-point t) - - ;; Now go back to the start of the matching text - ;; adding the space and colon to the start of each line. - (goto-char insertion-start) - ;; Insert space and colon for lines of context before match. - (setq tem (if (< linenum nlines) - (- nlines linenum) - nlines)) - (while (> tem 0) - (insert empty ?:) - (forward-line 1) - (setq tem (1- tem))) - - ;; Insert line number and colon for the lines of - ;; matching text. - (let ((this-linenum linenum)) - (while (< (point) final-context-start) - (if (null tag) - (setq tag (format line-number-format this-linenum))) - (insert tag ?:) - (forward-line 1) - (setq tag nil) - (setq this-linenum (1+ this-linenum))) - (while (and (not (eobp)) (<= (point) final-context-start)) - (insert empty ?:) - (forward-line 1) - (setq this-linenum (1+ this-linenum)))) - - ;; Insert space and colon for lines of context after match. - (while (and (< (point) (point-max)) (< tem nlines)) - (insert empty ?:) - (forward-line 1) - (setq tem (1+ tem))) - - ;; Add text properties. The `occur' prop is used to - ;; store the marker of the matching text in the - ;; source buffer. - (put-text-property (marker-position text-beg) - (- (marker-position text-end) 1) - 'mouse-face 'highlight) - (put-text-property (marker-position text-beg) - (marker-position text-end) - 'occur occur-marker) - (goto-char (point-max))) - (forward-line 1))) - (set-buffer standard-output) - ;; Go back to top of *Occur* and finish off by printing the - ;; number of matching lines. - (goto-char (point-min)) - (let ((message-string - (if (= occur-num-matches 1) - "1 line" - (format "%d lines" occur-num-matches)))) - (insert message-string) - (if (interactive-p) - (message "%s matched" message-string))) - (setq buffer-read-only t))))))) + (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) + (progn + (display-buffer occur-buf) + (setq next-error-last-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. @@ -780,7 +1011,7 @@ 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, E to edit the replacement string" - "Help message while in query-replace") + "Help message while in `query-replace'.") (defvar query-replace-map (make-sparse-keymap) "Keymap that defines the responses to questions in `query-replace'. @@ -825,6 +1056,7 @@ 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)) +# replace-count Note that these symbols must be preceeded by a backslash in order to type them." @@ -844,7 +1076,9 @@ type them." ((string= "&" name) (setcar n '(match-string 0))) ((string= "#&" name) - (setcar n '(string-to-number (match-string 0)))))))) + (setcar n '(string-to-number (match-string 0)))) + ((string= "#" name) + (setcar n 'replace-count)))))) (setq n (cdr n)))) (defun replace-eval-replacement (expression replace-count) @@ -853,6 +1087,21 @@ type them." replacement (prin1-to-string replacement t)))) +(defun replace-quote (replacement) + "Quote a replacement string. +This just doubles all backslashes in REPLACEMENT and +returns the resulting string. If REPLACEMENT is not +a string, it is first passed through `prin1-to-string' +with the `noescape' argument set. + +`match-data' is preserved across the call." + (save-match-data + (replace-regexp-in-string "\\\\" "\\\\" + (if (stringp replacement) + replacement + (prin1-to-string replacement t)) + t t))) + (defun replace-loop-through-replacements (data replace-count) ;; DATA is a vector contaning the following values: ;; 0 next-rotate-count @@ -866,15 +1115,22 @@ type them." (aset data 2 (if (consp next) next (aref data 3)))))) (car (aref data 2))) -(defun perform-replace (from-string replacements start end +(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)))) @@ -884,7 +1140,7 @@ which will run faster and probably do exactly what you want." (case-fold-search (and case-fold-search (string-equal from-string (downcase from-string)))) - (literal (not regexp-flag)) + (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 @@ -938,7 +1194,7 @@ which will run faster and probably do exactly what you want." (unwind-protect ;; Loop finding occurrences that perhaps should be replaced. (while (and keep-going - (not (eobp)) + (not (or (eobp) (and limit (>= (point) limit)))) ;; Use the next match if it is already known; ;; otherwise, search for a match after moving forward ;; one char if progress is required. @@ -954,171 +1210,179 @@ which will run faster and probably do exactly what you want." ;; character too far at the end, ;; but this is undone after the ;; while-loop. - (progn (forward-char 1) (not (eobp)))) + (progn + (forward-char 1) + (not (or (eobp) + (and limit (>= (point) limit)))))) (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))))) - - ;; 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) - (progn - (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))) - (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 - (set-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) - (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 (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))))) + ;; 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" @@ -1150,4 +1414,5 @@ which will run faster and probably do exactly what you want." 'query-replace 'region)))) (move-overlay replace-overlay start end (current-buffer))))) +;;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4 ;;; replace.el ends here