Add "Package:" file headers to denote built-in packages.
[bpt/emacs.git] / lisp / replace.el
CommitLineData
60370d40 1;;; replace.el --- replace commands for Emacs
c88ab9ce 2
0d30b337 3;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001,
114f9c96 4;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
1e4bd40d 5;; Free Software Foundation, Inc.
3a801d0c 6
30764597 7;; Maintainer: FSF
bd78fa1d 8;; Package: emacs
30764597 9
698e1804
RS
10;; This file is part of GNU Emacs.
11
eb3fa2cf 12;; GNU Emacs is free software: you can redistribute it and/or modify
698e1804 13;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
698e1804
RS
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
eb3fa2cf 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
698e1804 24
d9ecc911
ER
25;;; Commentary:
26
27;; This package supplies the string and regular-expression replace functions
28;; documented in the Emacs user's manual.
29
4f4b8eff 30;;; Code:
698e1804 31
9d325ebf 32(defcustom case-replace t
9201cc28 33 "Non-nil means `query-replace' should preserve case in replacements."
9d325ebf
RS
34 :type 'boolean
35 :group 'matching)
77176e73 36
84d0a5f8
GM
37(defvar query-replace-history nil
38 "Default history list for query-replace commands.
39See `query-replace-from-history-variable' and
40`query-replace-to-history-variable'.")
770970cb 41
6b59b130
CY
42(defvar query-replace-defaults nil
43 "Default values of FROM-STRING and TO-STRING for `query-replace'.
44This is a cons cell (FROM-STRING . TO-STRING), or nil if there is
45no default value.")
46
5291cbca 47(defvar query-replace-interactive nil
151270f3 48 "Non-nil means `query-replace' uses the last search string.
5291cbca 49That becomes the \"string to replace\".")
151270f3 50
bdb1c08f 51(defcustom query-replace-from-history-variable 'query-replace-history
f54701d1 52 "History list to use for the FROM argument of `query-replace' commands.
bdb1c08f
RS
53The value of this variable should be a symbol; that symbol
54is used as a variable to hold a history list for the strings
55or patterns to be replaced."
56 :group 'matching
cd32a7ba
DN
57 :type 'symbol
58 :version "20.3")
bdb1c08f
RS
59
60(defcustom query-replace-to-history-variable 'query-replace-history
f54701d1 61 "History list to use for the TO argument of `query-replace' commands.
bdb1c08f
RS
62The value of this variable should be a symbol; that symbol
63is used as a variable to hold a history list for replacement
64strings or patterns."
65 :group 'matching
cd32a7ba
DN
66 :type 'symbol
67 :version "20.3")
bdb1c08f 68
1c4fe319 69(defcustom query-replace-skip-read-only nil
9201cc28 70 "Non-nil means `query-replace' and friends ignore read-only matches."
1c4fe319
RS
71 :type 'boolean
72 :group 'matching
bf247b6e 73 :version "22.1")
1c4fe319 74
7abe68aa 75(defcustom query-replace-show-replacement t
9201cc28 76 "Non-nil means to show what actual replacement text will be."
7abe68aa
JL
77 :type 'boolean
78 :group 'matching
79 :version "23.1")
80
afd33362 81(defcustom query-replace-highlight t
9201cc28 82 "Non-nil means to highlight matches during query replacement."
afd33362
JL
83 :type 'boolean
84 :group 'matching)
85
86(defcustom query-replace-lazy-highlight t
9201cc28 87 "Controls the lazy-highlighting during query replacements.
afd33362
JL
88When non-nil, all text in the buffer matching the current match
89is highlighted lazily using isearch lazy highlighting (see
90`lazy-highlight-initial-delay' and `lazy-highlight-interval')."
91 :type 'boolean
92 :group 'lazy-highlight
93 :group 'matching
bf247b6e 94 :version "22.1")
afd33362
JL
95
96(defface query-replace
97 '((t (:inherit isearch)))
98 "Face for highlighting query replacement matches."
99 :group 'matching
bf247b6e 100 :version "22.1")
afd33362 101
6f1df6d9
SM
102(defun query-replace-descr (string)
103 (mapconcat 'isearch-text-char-description string ""))
104
90c9fc2a 105(defun query-replace-read-from (prompt regexp-flag)
6f1df6d9
SM
106 "Query and return the `from' argument of a query-replace operation.
107The return value can also be a pair (FROM . TO) indicating that the user
108wants to replace FROM with TO."
1606466a
SM
109 (if query-replace-interactive
110 (car (if regexp-flag regexp-search-ring search-ring))
2bf2b947
JL
111 (let* ((history-add-new-input nil)
112 (from
1606466a
SM
113 ;; The save-excursion here is in case the user marks and copies
114 ;; a region in order to specify the minibuffer input.
115 ;; That should not clobber the region for the query-replace itself.
116 (save-excursion
117 (read-from-minibuffer
6b59b130 118 (if query-replace-defaults
90c9fc2a 119 (format "%s (default %s -> %s): " prompt
6b59b130
CY
120 (query-replace-descr (car query-replace-defaults))
121 (query-replace-descr (cdr query-replace-defaults)))
90c9fc2a 122 (format "%s: " prompt))
1606466a
SM
123 nil nil nil
124 query-replace-from-history-variable
311f8bac 125 nil t))))
6b59b130 126 (if (and (zerop (length from)) query-replace-defaults)
5dae4b11
CY
127 (cons (car query-replace-defaults)
128 (query-replace-compile-replacement
129 (cdr query-replace-defaults) regexp-flag))
2bf2b947 130 (add-to-history query-replace-from-history-variable from nil t)
6f1df6d9
SM
131 ;; Warn if user types \n or \t, but don't reject the input.
132 (and regexp-flag
133 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
134 (let ((match (match-string 3 from)))
135 (cond
136 ((string= match "\\n")
137 (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
138 ((string= match "\\t")
139 (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
140 (sit-for 2)))
141 from))))
1606466a 142
78629844
DK
143(defun query-replace-compile-replacement (to regexp-flag)
144 "Maybe convert a regexp replacement TO to Lisp.
145Returns a list suitable for `perform-replace' if necessary,
146the original string if not."
147 (if (and regexp-flag
148 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
7c1c02ac
DK
149 (let (pos list char)
150 (while
151 (progn
152 (setq pos (match-end 0))
153 (push (substring to 0 (- pos 2)) list)
154 (setq char (aref to (1- pos))
155 to (substring to pos))
156 (cond ((eq char ?\#)
157 (push '(number-to-string replace-count) list))
158 ((eq char ?\,)
159 (setq pos (read-from-string to))
160 (push `(replace-quote ,(car pos)) list)
9e5d1b63
RS
161 (let ((end
162 ;; Swallow a space after a symbol
163 ;; if there is a space.
164 (if (and (or (symbolp (car pos))
165 ;; Swallow a space after 'foo
166 ;; but not after (quote foo).
167 (and (eq (car-safe (car pos)) 'quote)
f1f6079c
JL
168 (not (= ?\( (aref to 0)))))
169 (eq (string-match " " to (cdr pos))
170 (cdr pos)))
9e5d1b63
RS
171 (1+ (cdr pos))
172 (cdr pos))))
173 (setq to (substring to end)))))
7c1c02ac 174 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)))
78629844
DK
175 (setq to (nreverse (delete "" (cons to list))))
176 (replace-match-string-symbols to)
177 (cons 'replace-eval-replacement
178 (if (cdr to)
179 (cons 'concat to)
180 (car to))))
1606466a
SM
181 to))
182
78629844 183
90c9fc2a 184(defun query-replace-read-to (from prompt regexp-flag)
78629844
DK
185 "Query and return the `to' argument of a query-replace operation."
186 (query-replace-compile-replacement
187 (save-excursion
2bf2b947
JL
188 (let* ((history-add-new-input nil)
189 (to (read-from-minibuffer
190 (format "%s %s with: " prompt (query-replace-descr from))
191 nil nil nil
192 query-replace-to-history-variable from t)))
193 (add-to-history query-replace-to-history-variable to nil t)
6b59b130
CY
194 (setq query-replace-defaults (cons from to))
195 to))
78629844
DK
196 regexp-flag))
197
90c9fc2a 198(defun query-replace-read-args (prompt regexp-flag &optional noerror)
1606466a
SM
199 (unless noerror
200 (barf-if-buffer-read-only))
90c9fc2a 201 (let* ((from (query-replace-read-from prompt regexp-flag))
6f1df6d9 202 (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
90c9fc2a 203 (query-replace-read-to from prompt regexp-flag))))
10784bac 204 (list from to current-prefix-arg)))
770970cb 205
47d72254 206(defun query-replace (from-string to-string &optional delimited start end)
da44e784
RM
207 "Replace some occurrences of FROM-STRING with TO-STRING.
208As each match is found, the user must type a character saying
209what to do with it. For directions, type \\[help-command] at that time.
210
7ef5c431
KH
211In Transient Mark mode, if the mark is active, operate on the contents
212of the region. Otherwise, operate from point to the end of the buffer.
213
151270f3
RS
214If `query-replace-interactive' is non-nil, the last incremental search
215string is used as FROM-STRING--you don't have to specify it with the
216minibuffer.
217
446d9629
RS
218Matching is independent of case if `case-fold-search' is non-nil and
219FROM-STRING has no uppercase letters. Replacement transfers the case
220pattern of the old text to the new text, if `case-replace' and
221`case-fold-search' are non-nil and FROM-STRING has no uppercase
222letters. \(Transferring the case pattern means that if the old text
223matched is all caps, or capitalized, then its replacement is upcased
224or capitalized.)
9b0bf2b6 225
118a01c9 226Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
81bdc14d 227only matches surrounded by word boundaries.
47d72254 228Fourth and fifth arg START and END specify the region to operate on.
81bdc14d
RS
229
230To customize possible responses, change the \"bindings\" in `query-replace-map'."
04ff2dee
JL
231 (interactive
232 (let ((common
233 (query-replace-read-args
234 (concat "Query replace"
235 (if current-prefix-arg " word" "")
236 (if (and transient-mark-mode mark-active) " in region" ""))
237 nil)))
238 (list (nth 0 common) (nth 1 common) (nth 2 common)
239 ;; These are done separately here
240 ;; so that command-history will record these expressions
241 ;; rather than the values they had this time.
242 (if (and transient-mark-mode mark-active)
243 (region-beginning))
244 (if (and transient-mark-mode mark-active)
245 (region-end)))))
99a7559f 246 (perform-replace from-string to-string t nil delimited nil nil start end))
7ef5c431 247
73fa8346 248(define-key esc-map "%" 'query-replace)
da44e784 249
47d72254 250(defun query-replace-regexp (regexp to-string &optional delimited start end)
da44e784
RM
251 "Replace some things after point matching REGEXP with TO-STRING.
252As each match is found, the user must type a character saying
253what to do with it. For directions, type \\[help-command] at that time.
254
7ef5c431
KH
255In Transient Mark mode, if the mark is active, operate on the contents
256of the region. Otherwise, operate from point to the end of the buffer.
257
151270f3
RS
258If `query-replace-interactive' is non-nil, the last incremental search
259regexp is used as REGEXP--you don't have to specify it with the
260minibuffer.
261
446d9629
RS
262Matching is independent of case if `case-fold-search' is non-nil and
263REGEXP has no uppercase letters. Replacement transfers the case
264pattern of the old text to the new text, if `case-replace' and
265`case-fold-search' are non-nil and REGEXP has no uppercase letters.
266\(Transferring the case pattern means that if the old text matched is
267all caps, or capitalized, then its replacement is upcased or
268capitalized.)
47d72254 269
118a01c9 270Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
da44e784 271only matches surrounded by word boundaries.
47d72254
GM
272Fourth and fifth arg START and END specify the region to operate on.
273
118a01c9
RS
274In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
275and `\\=\\N' (where N is a digit) stands for
2f57bf85 276whatever what matched the Nth `\\(...\\)' in REGEXP.
7c1c02ac
DK
277`\\?' lets you edit the replacement text in the minibuffer
278at the given position for each replacement.
279
ba8d15f9
RS
280In interactive calls, the replacement text can contain `\\,'
281followed by a Lisp expression. Each
282replacement evaluates that expression to compute the replacement
283string. Inside of that expression, `\\&' is a string denoting the
f1f6079c 284whole match as a string, `\\N' for a partial match, `\\#&' and `\\#N'
ba8d15f9
RS
285for the whole or a partial match converted to a number with
286`string-to-number', and `\\#' itself for the number of replacements
287done so far (starting with zero).
7c1c02ac 288
ba8d15f9
RS
289If the replacement expression is a symbol, write a space after it
290to terminate it. One space there, if any, will be discarded.
7c1c02ac
DK
291
292When using those Lisp features interactively in the replacement
293text, TO-STRING is actually made a list instead of a string.
294Use \\[repeat-complex-command] after this command for details."
10784bac
RS
295 (interactive
296 (let ((common
10ddc30e 297 (query-replace-read-args
04ff2dee
JL
298 (concat "Query replace"
299 (if current-prefix-arg " word" "")
300 " regexp"
301 (if (and transient-mark-mode mark-active) " in region" ""))
f79bdb3a 302 t)))
7c1c02ac
DK
303 (list (nth 0 common) (nth 1 common) (nth 2 common)
304 ;; These are done separately here
305 ;; so that command-history will record these expressions
306 ;; rather than the values they had this time.
307 (if (and transient-mark-mode mark-active)
308 (region-beginning))
309 (if (and transient-mark-mode mark-active)
310 (region-end)))))
99a7559f 311 (perform-replace regexp to-string t t delimited nil nil start end))
2f57bf85 312
cbc127de 313(define-key esc-map [?\C-%] 'query-replace-regexp)
da44e784 314
47d72254 315(defun query-replace-regexp-eval (regexp to-expr &optional delimited start end)
84482eb3 316 "Replace some things after point matching REGEXP with the result of TO-EXPR.
fc6a2250
DK
317
318Interactive use of this function is deprecated in favor of the
319`\\,' feature of `query-replace-regexp'. For non-interactive use, a loop
320using `search-forward-regexp' and `replace-match' is preferred.
321
84482eb3
RS
322As each match is found, the user must type a character saying
323what to do with it. For directions, type \\[help-command] at that time.
324
325TO-EXPR is a Lisp expression evaluated to compute each replacement. It may
326reference `replace-count' to get the number of replacements already made.
327If the result of TO-EXPR is not a string, it is converted to one using
328`prin1-to-string' with the NOESCAPE argument (which see).
329
330For convenience, when entering TO-EXPR interactively, you can use `\\&' or
653479ad
AS
331`\\0' to stand for whatever matched the whole of REGEXP, and `\\N' (where
332N is a digit) to stand for whatever matched the Nth `\\(...\\)' in REGEXP.
84482eb3 333Use `\\#&' or `\\#N' if you want a number instead of a string.
2f57bf85 334In interactive use, `\\#' in itself stands for `replace-count'.
84482eb3
RS
335
336In Transient Mark mode, if the mark is active, operate on the contents
337of the region. Otherwise, operate from point to the end of the buffer.
338
339If `query-replace-interactive' is non-nil, the last incremental search
340regexp is used as REGEXP--you don't have to specify it with the
341minibuffer.
342
343Preserves case in each replacement if `case-replace' and `case-fold-search'
344are non-nil and REGEXP has no uppercase letters.
47d72254 345
84482eb3 346Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
470bbe9b 347only matches that are surrounded by word boundaries.
47d72254 348Fourth and fifth arg START and END specify the region to operate on."
84482eb3 349 (interactive
cc0aea1a 350 (progn
6f1df6d9
SM
351 (barf-if-buffer-read-only)
352 (let* ((from
353 ;; Let-bind the history var to disable the "foo -> bar" default.
354 ;; Maybe we shouldn't disable this default, but for now I'll
355 ;; leave it off. --Stef
356 (let ((query-replace-to-history-variable nil))
357 (query-replace-read-from "Query replace regexp" t)))
5291cbca 358 (to (list (read-from-minibuffer
6f1df6d9
SM
359 (format "Query replace regexp %s with eval: "
360 (query-replace-descr from))
5291cbca 361 nil nil t query-replace-to-history-variable from t))))
84482eb3
RS
362 ;; We make TO a list because replace-match-string-symbols requires one,
363 ;; and the user might enter a single token.
364 (replace-match-string-symbols to)
10784bac
RS
365 (list from (car to) current-prefix-arg
366 (if (and transient-mark-mode mark-active)
367 (region-beginning))
368 (if (and transient-mark-mode mark-active)
cc0aea1a 369 (region-end))))))
d2ce3151 370 (perform-replace regexp (cons 'replace-eval-replacement to-expr)
d83a97ab 371 t 'literal delimited nil nil start end))
84482eb3 372
fc6a2250
DK
373(make-obsolete 'query-replace-regexp-eval
374 "for interactive use, use the special `\\,' feature of
375`query-replace-regexp' instead. Non-interactively, a loop
376using `search-forward-regexp' and `replace-match' is preferred." "22.1")
377
47d72254 378(defun map-query-replace-regexp (regexp to-strings &optional n start end)
da44e784 379 "Replace some matches for REGEXP with various strings, in rotation.
d8f1d2f3
JB
380The second argument TO-STRINGS contains the replacement strings, separated
381by spaces. This command works like `query-replace-regexp' except that
382each successive replacement uses the next successive replacement string,
da44e784
RM
383wrapping around from the last such string to the first.
384
7ef5c431
KH
385In Transient Mark mode, if the mark is active, operate on the contents
386of the region. Otherwise, operate from point to the end of the buffer.
387
da44e784
RM
388Non-interactively, TO-STRINGS may be a list of replacement strings.
389
151270f3
RS
390If `query-replace-interactive' is non-nil, the last incremental search
391regexp is used as REGEXP--you don't have to specify it with the minibuffer.
392
da44e784 393A prefix argument N says to use each replacement string N times
47d72254
GM
394before rotating to the next.
395Fourth and fifth arg START and END specify the region to operate on."
770970cb 396 (interactive
5291cbca 397 (let* ((from (if query-replace-interactive
151270f3
RS
398 (car regexp-search-ring)
399 (read-from-minibuffer "Map query replace (regexp): "
400 nil nil nil
84d0a5f8
GM
401 query-replace-from-history-variable
402 nil t)))
5291cbca 403 (to (read-from-minibuffer
770970cb 404 (format "Query replace %s with (space-separated strings): "
6f1df6d9 405 (query-replace-descr from))
770970cb 406 nil nil nil
84d0a5f8 407 query-replace-to-history-variable from t)))
2f2f7e58
RS
408 (list from to
409 (and current-prefix-arg
410 (prefix-numeric-value current-prefix-arg))
10784bac
RS
411 (if (and transient-mark-mode mark-active)
412 (region-beginning))
413 (if (and transient-mark-mode mark-active)
414 (region-end)))))
da44e784
RM
415 (let (replacements)
416 (if (listp to-strings)
417 (setq replacements to-strings)
418 (while (/= (length to-strings) 0)
419 (if (string-match " " to-strings)
420 (setq replacements
421 (append replacements
422 (list (substring to-strings 0
423 (string-match " " to-strings))))
424 to-strings (substring to-strings
425 (1+ (string-match " " to-strings))))
426 (setq replacements (append replacements (list to-strings))
427 to-strings ""))))
99a7559f 428 (perform-replace regexp replacements t t nil n nil start end)))
da44e784 429
47d72254 430(defun replace-string (from-string to-string &optional delimited start end)
da44e784
RM
431 "Replace occurrences of FROM-STRING with TO-STRING.
432Preserve case in each match if `case-replace' and `case-fold-search'
433are non-nil and FROM-STRING has no uppercase letters.
9b0bf2b6
RS
434\(Preserving case means that if the string matched is all caps, or capitalized,
435then its replacement is upcased or capitalized.)
436
7ef5c431
KH
437In Transient Mark mode, if the mark is active, operate on the contents
438of the region. Otherwise, operate from point to the end of the buffer.
439
118a01c9 440Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
da44e784 441only matches surrounded by word boundaries.
47d72254 442Fourth and fifth arg START and END specify the region to operate on.
da44e784 443
151270f3
RS
444If `query-replace-interactive' is non-nil, the last incremental search
445string is used as FROM-STRING--you don't have to specify it with the
446minibuffer.
447
da44e784
RM
448This function is usually the wrong thing to use in a Lisp program.
449What you probably want is a loop like this:
118a01c9
RS
450 (while (search-forward FROM-STRING nil t)
451 (replace-match TO-STRING nil t))
87532fbe
RS
452which will run faster and will not set the mark or print anything.
453\(You may need a more complex loop if FROM-STRING can match the null string
454and TO-STRING is also null.)"
10784bac
RS
455 (interactive
456 (let ((common
10ddc30e 457 (query-replace-read-args
04ff2dee
JL
458 (concat "Replace"
459 (if current-prefix-arg " word" "")
460 " string"
461 (if (and transient-mark-mode mark-active) " in region" ""))
f79bdb3a 462 nil)))
10784bac
RS
463 (list (nth 0 common) (nth 1 common) (nth 2 common)
464 (if (and transient-mark-mode mark-active)
465 (region-beginning))
466 (if (and transient-mark-mode mark-active)
467 (region-end)))))
99a7559f 468 (perform-replace from-string to-string nil nil delimited nil nil start end))
da44e784 469
47d72254 470(defun replace-regexp (regexp to-string &optional delimited start end)
da44e784 471 "Replace things after point matching REGEXP with TO-STRING.
118a01c9 472Preserve case in each match if `case-replace' and `case-fold-search'
da44e784 473are non-nil and REGEXP has no uppercase letters.
47d72254
GM
474
475In Transient Mark mode, if the mark is active, operate on the contents
476of the region. Otherwise, operate from point to the end of the buffer.
477
118a01c9 478Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
da44e784 479only matches surrounded by word boundaries.
47d72254
GM
480Fourth and fifth arg START and END specify the region to operate on.
481
118a01c9
RS
482In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
483and `\\=\\N' (where N is a digit) stands for
7c1c02ac
DK
484whatever what matched the Nth `\\(...\\)' in REGEXP.
485`\\?' lets you edit the replacement text in the minibuffer
486at the given position for each replacement.
487
488In interactive calls, the replacement text may contain `\\,'
489followed by a Lisp expression used as part of the replacement
490text. Inside of that expression, `\\&' is a string denoting the
107173cf
JB
491whole match, `\\N' a partial match, `\\#&' and `\\#N' the respective
492numeric values from `string-to-number', and `\\#' itself for
493`replace-count', the number of replacements occurred so far.
7c1c02ac
DK
494
495If your Lisp expression is an identifier and the next letter in
496the replacement string would be interpreted as part of it, you
497can wrap it with an expression like `\\,(or \\#)'. Incidentally,
498for this particular case you may also enter `\\#' in the
499replacement text directly.
500
501When using those Lisp features interactively in the replacement
502text, TO-STRING is actually made a list instead of a string.
503Use \\[repeat-complex-command] after this command for details.
da44e784 504
151270f3
RS
505If `query-replace-interactive' is non-nil, the last incremental search
506regexp is used as REGEXP--you don't have to specify it with the minibuffer.
507
da44e784
RM
508This function is usually the wrong thing to use in a Lisp program.
509What you probably want is a loop like this:
510 (while (re-search-forward REGEXP nil t)
118a01c9 511 (replace-match TO-STRING nil nil))
da44e784 512which will run faster and will not set the mark or print anything."
10784bac
RS
513 (interactive
514 (let ((common
10ddc30e 515 (query-replace-read-args
04ff2dee
JL
516 (concat "Replace"
517 (if current-prefix-arg " word" "")
518 " regexp"
519 (if (and transient-mark-mode mark-active) " in region" ""))
f79bdb3a 520 t)))
10784bac
RS
521 (list (nth 0 common) (nth 1 common) (nth 2 common)
522 (if (and transient-mark-mode mark-active)
523 (region-beginning))
524 (if (and transient-mark-mode mark-active)
525 (region-end)))))
99a7559f 526 (perform-replace regexp to-string nil t delimited nil nil start end))
e32eb3e6 527
4c53bd2b
RS
528\f
529(defvar regexp-history nil
fae97ed8
EZ
530 "History list for some commands that read regular expressions.
531
532Maximum length of the history list is determined by the value
533of `history-length', which see.")
da44e784 534
10965505 535(defun read-regexp (prompt &optional default-value)
96f606c5 536 "Read regexp as a string using the regexp history and some useful defaults.
714da757 537Prompt for a regular expression with PROMPT (without a colon and
10965505
JL
538space) in the minibuffer. The optional argument DEFAULT-VALUE
539provides the value to display in the minibuffer prompt that is
540returned if the user just types RET.
541Values available via M-n are the string at point, the last isearch
542regexp, the last isearch string, and the last replacement regexp."
714da757 543 (let* ((defaults
96f606c5
JL
544 (list (regexp-quote
545 (or (funcall (or find-tag-default-function
546 (get major-mode 'find-tag-default-function)
547 'find-tag-default))
548 ""))
549 (car regexp-search-ring)
550 (regexp-quote (or (car search-ring) ""))
551 (car (symbol-value
552 query-replace-from-history-variable))))
553 (defaults (delete-dups (delq nil (delete "" defaults))))
554 ;; Don't add automatically the car of defaults for empty input
555 (history-add-new-input nil)
556 (input
557 (read-from-minibuffer
10965505
JL
558 (if default-value
559 (format "%s (default %s): " prompt
560 (query-replace-descr default-value))
96f606c5
JL
561 (format "%s: " prompt))
562 nil nil nil 'regexp-history defaults t)))
563 (if (equal input "")
99910cf4 564 (or default-value input)
96f606c5
JL
565 (prog1 input
566 (add-to-history 'regexp-history input)))))
567
e32eb3e6 568
31e1d920 569(defalias 'delete-non-matching-lines 'keep-lines)
e32eb3e6
GM
570(defalias 'delete-matching-lines 'flush-lines)
571(defalias 'count-matches 'how-many)
572
573
574(defun keep-lines-read-args (prompt)
575 "Read arguments for `keep-lines' and friends.
576Prompt for a regexp with PROMPT.
2ced751f 577Value is a list, (REGEXP)."
99910cf4 578 (list (read-regexp prompt) nil nil t))
e32eb3e6 579
bace7209 580(defun keep-lines (regexp &optional rstart rend interactive)
698e1804
RS
581 "Delete all lines except those containing matches for REGEXP.
582A match split across lines preserves all the lines it lies in.
bace7209
LT
583When called from Lisp (and usually interactively as well, see below)
584applies to all lines starting after point.
d2a0ee8b 585
3be42fcd
JL
586If REGEXP contains upper case characters (excluding those preceded by `\\')
587and `search-upper-case' is non-nil, the matching is case-sensitive.
e32eb3e6
GM
588
589Second and third arg RSTART and REND specify the region to operate on.
bace7209
LT
590This command operates on (the accessible part of) all lines whose
591accessible part is entirely contained in the region determined by RSTART
592and REND. (A newline ending a line counts as part of that line.)
e32eb3e6 593
2ced751f 594Interactively, in Transient Mark mode when the mark is active, operate
bace7209
LT
595on all lines whose accessible part is entirely contained in the region.
596Otherwise, the command applies to all lines starting after point.
597When calling this function from Lisp, you can pretend that it was
598called interactively by passing a non-nil INTERACTIVE argument.
599
600This function starts looking for the next match from the end of
601the previous match. Hence, it ignores matches that overlap
602a previously found match."
2ced751f 603
e32eb3e6 604 (interactive
98faf1bb
RS
605 (progn
606 (barf-if-buffer-read-only)
96f606c5 607 (keep-lines-read-args "Keep lines containing match for regexp")))
e32eb3e6 608 (if rstart
119831da
RS
609 (progn
610 (goto-char (min rstart rend))
bace7209
LT
611 (setq rend
612 (progn
613 (save-excursion
614 (goto-char (max rstart rend))
615 (unless (or (bolp) (eobp))
616 (forward-line 0))
617 (point-marker)))))
618 (if (and interactive transient-mark-mode mark-active)
2ced751f 619 (setq rstart (region-beginning)
bace7209
LT
620 rend (progn
621 (goto-char (region-end))
622 (unless (or (bolp) (eobp))
623 (forward-line 0))
624 (point-marker)))
2ced751f
RS
625 (setq rstart (point)
626 rend (point-max-marker)))
627 (goto-char rstart))
698e1804
RS
628 (save-excursion
629 (or (bolp) (forward-line 1))
d2a0ee8b 630 (let ((start (point))
3be42fcd
JL
631 (case-fold-search
632 (if (and case-fold-search search-upper-case)
633 (isearch-no-upper-case-p regexp t)
634 case-fold-search)))
e32eb3e6 635 (while (< (point) rend)
698e1804 636 ;; Start is first char not preserved by previous match.
e32eb3e6
GM
637 (if (not (re-search-forward regexp rend 'move))
638 (delete-region start rend)
698e1804 639 (let ((end (save-excursion (goto-char (match-beginning 0))
bace7209 640 (forward-line 0)
698e1804
RS
641 (point))))
642 ;; Now end is first char preserved by the new match.
643 (if (< start end)
644 (delete-region start end))))
d99118b0 645
e32eb3e6 646 (setq start (save-excursion (forward-line 1) (point)))
698e1804 647 ;; If the match was empty, avoid matching again at same place.
e32eb3e6
GM
648 (and (< (point) rend)
649 (= (match-beginning 0) (match-end 0))
bace7209
LT
650 (forward-char 1)))))
651 (set-marker rend nil)
652 nil)
698e1804 653
e32eb3e6 654
bace7209
LT
655(defun flush-lines (regexp &optional rstart rend interactive)
656 "Delete lines containing matches for REGEXP.
657When called from Lisp (and usually when called interactively as
658well, see below), applies to the part of the buffer after point.
659The line point is in is deleted if and only if it contains a
660match for regexp starting after point.
d2a0ee8b 661
3be42fcd
JL
662If REGEXP contains upper case characters (excluding those preceded by `\\')
663and `search-upper-case' is non-nil, the matching is case-sensitive.
e32eb3e6
GM
664
665Second and third arg RSTART and REND specify the region to operate on.
bace7209
LT
666Lines partially contained in this region are deleted if and only if
667they contain a match entirely contained in it.
e32eb3e6 668
2ced751f
RS
669Interactively, in Transient Mark mode when the mark is active, operate
670on the contents of the region. Otherwise, operate from point to the
bace7209
LT
671end of (the accessible portion of) the buffer. When calling this function
672from Lisp, you can pretend that it was called interactively by passing
673a non-nil INTERACTIVE argument.
674
675If a match is split across lines, all the lines it lies in are deleted.
676They are deleted _before_ looking for the next match. Hence, a match
677starting on the same line at which another match ended is ignored."
2ced751f 678
e32eb3e6 679 (interactive
98faf1bb
RS
680 (progn
681 (barf-if-buffer-read-only)
96f606c5 682 (keep-lines-read-args "Flush lines containing match for regexp")))
e32eb3e6 683 (if rstart
119831da
RS
684 (progn
685 (goto-char (min rstart rend))
686 (setq rend (copy-marker (max rstart rend))))
bace7209 687 (if (and interactive transient-mark-mode mark-active)
2ced751f
RS
688 (setq rstart (region-beginning)
689 rend (copy-marker (region-end)))
690 (setq rstart (point)
691 rend (point-max-marker)))
692 (goto-char rstart))
3be42fcd
JL
693 (let ((case-fold-search
694 (if (and case-fold-search search-upper-case)
695 (isearch-no-upper-case-p regexp t)
696 case-fold-search)))
d2a0ee8b 697 (save-excursion
e32eb3e6
GM
698 (while (and (< (point) rend)
699 (re-search-forward regexp rend t))
d2a0ee8b 700 (delete-region (save-excursion (goto-char (match-beginning 0))
bace7209 701 (forward-line 0)
d2a0ee8b 702 (point))
bace7209
LT
703 (progn (forward-line 1) (point))))))
704 (set-marker rend nil)
705 nil)
698e1804 706
e32eb3e6 707
bace7209
LT
708(defun how-many (regexp &optional rstart rend interactive)
709 "Print and return number of matches for REGEXP following point.
710When called from Lisp and INTERACTIVE is omitted or nil, just return
711the number, do not print it; if INTERACTIVE is t, the function behaves
3f2372cb 712in all respects as if it had been called interactively.
d2a0ee8b 713
3be42fcd
JL
714If REGEXP contains upper case characters (excluding those preceded by `\\')
715and `search-upper-case' is non-nil, the matching is case-sensitive.
e32eb3e6
GM
716
717Second and third arg RSTART and REND specify the region to operate on.
718
2ced751f
RS
719Interactively, in Transient Mark mode when the mark is active, operate
720on the contents of the region. Otherwise, operate from point to the
bace7209
LT
721end of (the accessible portion of) the buffer.
722
723This function starts looking for the next match from the end of
724the previous match. Hence, it ignores matches that overlap
725a previously found match."
2ced751f 726
e32eb3e6 727 (interactive
96f606c5 728 (keep-lines-read-args "How many matches for regexp"))
f601efb0
SM
729 (save-excursion
730 (if rstart
bace7209
LT
731 (progn
732 (goto-char (min rstart rend))
733 (setq rend (max rstart rend)))
734 (if (and interactive transient-mark-mode mark-active)
2ced751f 735 (setq rstart (region-beginning)
bace7209 736 rend (region-end))
2ced751f 737 (setq rstart (point)
bace7209 738 rend (point-max)))
2ced751f 739 (goto-char rstart))
f601efb0
SM
740 (let ((count 0)
741 opoint
3be42fcd
JL
742 (case-fold-search
743 (if (and case-fold-search search-upper-case)
744 (isearch-no-upper-case-p regexp t)
745 case-fold-search)))
f601efb0
SM
746 (while (and (< (point) rend)
747 (progn (setq opoint (point))
748 (re-search-forward regexp rend t)))
749 (if (= opoint (point))
750 (forward-char 1)
751 (setq count (1+ count))))
bace7209
LT
752 (when interactive (message "%d occurrence%s"
753 count
754 (if (= count 1) "" "s")))
755 count)))
e32eb3e6 756
4c53bd2b 757\f
f601efb0
SM
758(defvar occur-mode-map
759 (let ((map (make-sparse-keymap)))
cedbd3f0 760 ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
f601efb0
SM
761 (define-key map [mouse-2] 'occur-mode-mouse-goto)
762 (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
763 (define-key map "\C-m" 'occur-mode-goto-occurrence)
daae70bf 764 (define-key map "o" 'occur-mode-goto-occurrence-other-window)
365486d6 765 (define-key map "\C-o" 'occur-mode-display-occurrence)
f601efb0
SM
766 (define-key map "\M-n" 'occur-next)
767 (define-key map "\M-p" 'occur-prev)
d99118b0
SS
768 (define-key map "r" 'occur-rename-buffer)
769 (define-key map "c" 'clone-buffer)
f601efb0 770 (define-key map "g" 'revert-buffer)
d99118b0
SS
771 (define-key map "q" 'quit-window)
772 (define-key map "z" 'kill-this-buffer)
b938735a 773 (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
85ea5b19
DN
774 (define-key map [menu-bar] (make-sparse-keymap))
775 (define-key map [menu-bar occur]
8f43cbf3 776 `(cons ,(purecopy "Occur") map))
85ea5b19
DN
777 (define-key map [next-error-follow-minor-mode]
778 (menu-bar-make-mm-toggle next-error-follow-minor-mode
779 "Auto Occurrence Display"
780 "Display another occurrence when moving the cursor"))
6d341a2a 781 (define-key map [separator-1] menu-bar-separator)
9201cc28 782 (define-key map [kill-this-buffer]
8f43cbf3
DN
783 `(menu-item ,(purecopy "Kill occur buffer") kill-this-buffer
784 :help ,(purecopy "Kill the current *Occur* buffer")))
9201cc28 785 (define-key map [quit-window]
8f43cbf3
DN
786 `(menu-item ,(purecopy "Quit occur window") quit-window
787 :help ,(purecopy "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame")))
9201cc28 788 (define-key map [revert-buffer]
8f43cbf3
DN
789 `(menu-item ,(purecopy "Revert occur buffer") revert-buffer
790 :help ,(purecopy "Replace the text in the *Occur* buffer with the results of rerunning occur")))
9201cc28 791 (define-key map [clone-buffer]
8f43cbf3
DN
792 `(menu-item ,(purecopy "Clone occur buffer") clone-buffer
793 :help ,(purecopy "Create and return a twin copy of the current *Occur* buffer")))
9201cc28 794 (define-key map [occur-rename-buffer]
8f43cbf3
DN
795 `(menu-item ,(purecopy "Rename occur buffer") occur-rename-buffer
796 :help ,(purecopy "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")))
a3c20c83 797 (define-key map [separator-2] menu-bar-separator)
85ea5b19 798 (define-key map [occur-mode-goto-occurrence-other-window]
8f43cbf3
DN
799 `(menu-item ,(purecopy "Go To Occurrence Other Window") occur-mode-goto-occurrence-other-window
800 :help ,(purecopy "Go to the occurrence the current line describes, in another window")))
85ea5b19 801 (define-key map [occur-mode-goto-occurrence]
8f43cbf3
DN
802 `(menu-item ,(purecopy "Go To Occurrence") occur-mode-goto-occurrence
803 :help ,(purecopy "Go to the occurrence the current line describes")))
85ea5b19 804 (define-key map [occur-mode-display-occurrence]
8f43cbf3
DN
805 `(menu-item ,(purecopy "Display Occurrence") occur-mode-display-occurrence
806 :help ,(purecopy "Display in another window the occurrence the current line describes")))
9201cc28 807 (define-key map [occur-next]
8f43cbf3
DN
808 `(menu-item ,(purecopy "Move to next match") occur-next
809 :help ,(purecopy "Move to the Nth (default 1) next match in an Occur mode buffer")))
9201cc28 810 (define-key map [occur-prev]
8f43cbf3
DN
811 `(menu-item ,(purecopy "Move to previous match") occur-prev
812 :help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer")))
f601efb0
SM
813 map)
814 "Keymap for `occur-mode'.")
698e1804 815
46b3d18e
RS
816(defvar occur-revert-arguments nil
817 "Arguments to pass to `occur-1' to revert an Occur mode buffer.
818See `occur-revert-function'.")
698e1804 819
c9ae8cbb
JB
820(defcustom occur-mode-hook '(turn-on-font-lock)
821 "Hook run when entering Occur mode."
822 :type 'hook
823 :group 'matching)
824
825(defcustom occur-hook nil
c7d2f2cc 826 "Hook run by Occur when there are any matches."
daae70bf
CW
827 :type 'hook
828 :group 'matching)
829
8e62d5e8
CD
830(defcustom occur-mode-find-occurrence-hook nil
831 "Hook run by Occur after locating an occurrence.
832This will be called with the cursor position at the occurrence. An application
833for this is to reveal context in an outline-mode when the occurrence is hidden."
834 :type 'hook
835 :group 'matching)
836
de3c9b09 837(put 'occur-mode 'mode-class 'special)
505847d4 838(defun occur-mode ()
698e1804 839 "Major mode for output from \\[occur].
0081c8a1
RS
840\\<occur-mode-map>Move point to one of the items in this buffer, then use
841\\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
842Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
843
698e1804 844\\{occur-mode-map}"
ce8b7b9f 845 (interactive)
505847d4
RS
846 (kill-all-local-variables)
847 (use-local-map occur-mode-map)
848 (setq major-mode 'occur-mode)
849 (setq mode-name "Occur")
f601efb0 850 (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
c9ae8cbb 851 (make-local-variable 'occur-revert-arguments)
fbefbe33 852 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
423e4de7 853 (setq next-error-function 'occur-next-error)
92e9557c 854 (run-mode-hooks 'occur-mode-hook))
698e1804 855
a41284da 856(defun occur-revert-function (ignore1 ignore2)
46b3d18e 857 "Handle `revert-buffer' for Occur mode buffers."
e1690783 858 (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
a41284da 859
78bead73 860(defun occur-mode-find-occurrence ()
46b3d18e
RS
861 (let ((pos (get-text-property (point) 'occur-target)))
862 (unless pos
68608d9c 863 (error "No occurrence on this line"))
46b3d18e
RS
864 (unless (buffer-live-p (marker-buffer pos))
865 (error "Buffer for this occurrence was killed"))
866 pos))
78bead73 867
cedbd3f0
SM
868(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
869(defun occur-mode-goto-occurrence (&optional event)
78bead73 870 "Go to the occurrence the current line describes."
cedbd3f0
SM
871 (interactive (list last-nonmenu-event))
872 (let ((pos
873 (if (null event)
874 ;; Actually `event-end' works correctly with a nil argument as
875 ;; well, so we could dispense with this test, but let's not
876 ;; rely on this undocumented behavior.
877 (occur-mode-find-occurrence)
878 (with-current-buffer (window-buffer (posn-window (event-end event)))
879 (save-excursion
880 (goto-char (posn-point (event-end event)))
881 (occur-mode-find-occurrence)))))
882 same-window-buffer-names
883 same-window-regexps)
7e1d31d4 884 (pop-to-buffer (marker-buffer pos))
8e62d5e8
CD
885 (goto-char pos)
886 (run-hooks 'occur-mode-find-occurrence-hook)))
8d15583f 887
029024e2
RS
888(defun occur-mode-goto-occurrence-other-window ()
889 "Go to the occurrence the current line describes, in another window."
890 (interactive)
46b3d18e
RS
891 (let ((pos (occur-mode-find-occurrence)))
892 (switch-to-buffer-other-window (marker-buffer pos))
8e62d5e8
CD
893 (goto-char pos)
894 (run-hooks 'occur-mode-find-occurrence-hook)))
029024e2 895
365486d6
RS
896(defun occur-mode-display-occurrence ()
897 "Display in another window the occurrence the current line describes."
898 (interactive)
46b3d18e
RS
899 (let ((pos (occur-mode-find-occurrence))
900 window
901 ;; Bind these to ensure `display-buffer' puts it in another window.
365486d6 902 same-window-buffer-names
46b3d18e
RS
903 same-window-regexps)
904 (setq window (display-buffer (marker-buffer pos)))
365486d6
RS
905 ;; This is the way to set point in the proper window.
906 (save-selected-window
907 (select-window window)
8e62d5e8
CD
908 (goto-char pos)
909 (run-hooks 'occur-mode-find-occurrence-hook))))
365486d6 910
123d5548 911(defun occur-find-match (n search message)
8d15583f
RS
912 (if (not n) (setq n 1))
913 (let ((r))
914 (while (> n 0)
123d5548
JB
915 (setq r (funcall search (point) 'occur-match))
916 (and r
917 (get-text-property r 'occur-match)
918 (setq r (funcall search r 'occur-match)))
8d15583f 919 (if r
123d5548
JB
920 (goto-char r)
921 (error message))
8d15583f
RS
922 (setq n (1- n)))))
923
123d5548
JB
924(defun occur-next (&optional n)
925 "Move to the Nth (default 1) next match in an Occur mode buffer."
926 (interactive "p")
927 (occur-find-match n #'next-single-property-change "No more matches"))
928
8d15583f 929(defun occur-prev (&optional n)
46b3d18e 930 "Move to the Nth (default 1) previous match in an Occur mode buffer."
8d15583f 931 (interactive "p")
123d5548 932 (occur-find-match n #'previous-single-property-change "No earlier matches"))
423e4de7
KS
933
934(defun occur-next-error (&optional argp reset)
935 "Move to the Nth (default 1) next match in an Occur mode buffer.
936Compatibility function for \\[next-error] invocations."
937 (interactive "p")
5f9e0ca5 938 ;; we need to run occur-find-match from within the Occur buffer
f1f007dc 939 (with-current-buffer
f42a241b 940 ;; Choose the buffer and make it current.
5f9e0ca5
TZ
941 (if (next-error-buffer-p (current-buffer))
942 (current-buffer)
f42a241b
RS
943 (next-error-find-buffer nil nil
944 (lambda ()
945 (eq major-mode 'occur-mode))))
f1f007dc
JL
946
947 (goto-char (cond (reset (point-min))
948 ((< argp 0) (line-beginning-position))
6c6605b2
JL
949 ((> argp 0) (line-end-position))
950 ((point))))
5f9e0ca5 951 (occur-find-match
f1f007dc
JL
952 (abs argp)
953 (if (> 0 argp)
5f9e0ca5
TZ
954 #'previous-single-property-change
955 #'next-single-property-change)
956 "No more matches")
957 ;; In case the *Occur* buffer is visible in a nonselected window.
084c41ca
SM
958 (let ((win (get-buffer-window (current-buffer) t)))
959 (if win (set-window-point win (point))))
5f9e0ca5 960 (occur-mode-goto-occurrence)))
4c53bd2b 961\f
aaaecfcd
JL
962(defface match
963 '((((class color) (min-colors 88) (background light))
5183d4c9 964 :background "yellow1")
aaaecfcd 965 (((class color) (min-colors 88) (background dark))
4bc30b74 966 :background "RoyalBlue3")
330167fc
RS
967 (((class color) (min-colors 8) (background light))
968 :background "yellow" :foreground "black")
969 (((class color) (min-colors 8) (background dark))
aaaecfcd
JL
970 :background "blue" :foreground "white")
971 (((type tty) (class mono))
972 :inverse-video t)
973 (t :background "gray"))
974 "Face used to highlight matches permanently."
975 :group 'matching
bf247b6e 976 :version "22.1")
aaaecfcd 977
9d325ebf 978(defcustom list-matching-lines-default-context-lines 0
9201cc28 979 "Default number of context lines included around `list-matching-lines' matches.
e730be7f 980A negative number means to include that many lines before the match.
9d325ebf
RS
981A positive number means to include that many lines both before and after."
982 :type 'integer
983 :group 'matching)
698e1804 984
31e1d920 985(defalias 'list-matching-lines 'occur)
698e1804 986
aaaecfcd 987(defcustom list-matching-lines-face 'match
9201cc28 988 "Face used by \\[list-matching-lines] to show the text that matches.
68608d9c
CW
989If the value is nil, don't highlight the matching portions specially."
990 :type 'face
991 :group 'matching)
992
993(defcustom list-matching-lines-buffer-name-face 'underline
9201cc28 994 "Face used by \\[list-matching-lines] to show the names of buffers.
68608d9c
CW
995If the value is nil, don't highlight the buffer names specially."
996 :type 'face
997 :group 'matching)
998
8b363e6f
JL
999(defcustom occur-excluded-properties
1000 '(read-only invisible intangible field mouse-face help-echo local-map keymap
1001 yank-handler follow-link)
9201cc28 1002 "Text properties to discard when copying lines to the *Occur* buffer.
8b363e6f
JL
1003The value should be a list of text properties to discard or t,
1004which means to discard all text properties."
1005 :type '(choice (const :tag "All" t) (repeat symbol))
1006 :group 'matching
1007 :version "22.1")
1008
68608d9c 1009(defun occur-read-primary-args ()
714da757
JL
1010 (list (read-regexp "List lines matching regexp"
1011 (car regexp-history))
96f606c5
JL
1012 (when current-prefix-arg
1013 (prefix-numeric-value current-prefix-arg))))
c9daced0 1014
a653724b 1015(defun occur-rename-buffer (&optional unique-p interactive-p)
d99118b0 1016 "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
47c88c06 1017Here `original-buffer-name' is the buffer name where Occur was originally run.
a653724b
JB
1018When given the prefix argument, or called non-interactively, the renaming
1019will not clobber the existing buffer(s) of that name, but use
1020`generate-new-buffer-name' instead. You can add this to `occur-hook'
1021if you always want a separate *Occur* buffer for each buffer where you
1022invoke `occur'."
1023 (interactive "P\np")
d99118b0
SS
1024 (with-current-buffer
1025 (if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*"))
1026 (rename-buffer (concat "*Occur: "
1027 (mapconcat #'buffer-name
1028 (car (cddr occur-revert-arguments)) "/")
1029 "*")
a653724b 1030 (or unique-p (not interactive-p)))))
d99118b0 1031
698e1804 1032(defun occur (regexp &optional nlines)
99976f85 1033 "Show all lines in the current buffer containing a match for REGEXP.
774642e5 1034If a match spreads across multiple lines, all those lines are shown.
698e1804 1035
da44e784
RM
1036Each line is displayed with NLINES lines before and after, or -NLINES
1037before if NLINES is negative.
1038NLINES defaults to `list-matching-lines-default-context-lines'.
698e1804
RS
1039Interactively it is the prefix arg.
1040
4c53bd2b 1041The lines are shown in a buffer named `*Occur*'.
698e1804 1042It serves as a menu to find any of the occurrences in this buffer.
de3c9b09 1043\\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
9483d601 1044
3be42fcd
JL
1045If REGEXP contains upper case characters (excluding those preceded by `\\')
1046and `search-upper-case' is non-nil, the matching is case-sensitive."
68608d9c
CW
1047 (interactive (occur-read-primary-args))
1048 (occur-1 regexp nlines (list (current-buffer))))
1049
1050(defun multi-occur (bufs regexp &optional nlines)
1051 "Show all lines in buffers BUFS containing a match for REGEXP.
1052This function acts on multiple buffers; otherwise, it is exactly like
191b577e
RS
1053`occur'. When you invoke this command interactively, you must specify
1054the buffer names that you want, one by one."
a5dfed3e 1055 (interactive
68608d9c 1056 (cons
52698d45
KS
1057 (let* ((bufs (list (read-buffer "First buffer to search: "
1058 (current-buffer) t)))
1059 (buf nil)
1060 (ido-ignore-item-temp-list bufs))
68608d9c 1061 (while (not (string-equal
f1180544 1062 (setq buf (read-buffer
52698d45
KS
1063 (if (eq read-buffer-function 'ido-read-buffer)
1064 "Next buffer to search (C-j to end): "
1065 "Next buffer to search (RET to end): ")
1066 nil t))
68608d9c 1067 ""))
52698d45
KS
1068 (add-to-list 'bufs buf)
1069 (setq ido-ignore-item-temp-list bufs))
68608d9c
CW
1070 (nreverse (mapcar #'get-buffer bufs)))
1071 (occur-read-primary-args)))
1072 (occur-1 regexp nlines bufs))
1073
191b577e
RS
1074(defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs)
1075 "Show all lines matching REGEXP in buffers specified by BUFREGEXP.
1076Normally BUFREGEXP matches against each buffer's visited file name,
1077but if you specify a prefix argument, it matches against the buffer name.
68608d9c
CW
1078See also `multi-occur'."
1079 (interactive
1080 (cons
1081 (let* ((default (car regexp-history))
1082 (input
1083 (read-from-minibuffer
689f4394 1084 (if current-prefix-arg
191b577e
RS
1085 "List lines in buffers whose names match regexp: "
1086 "List lines in buffers whose filenames match regexp: ")
68608d9c
CW
1087 nil
1088 nil
1089 nil
1090 'regexp-history)))
1091 (if (equal input "")
1092 default
1093 input))
1094 (occur-read-primary-args)))
1095 (when bufregexp
689f4394 1096 (occur-1 regexp nil
68608d9c
CW
1097 (delq nil
1098 (mapcar (lambda (buf)
191b577e
RS
1099 (when (if allbufs
1100 (string-match bufregexp
1101 (buffer-name buf))
1102 (and (buffer-file-name buf)
1103 (string-match bufregexp
1104 (buffer-file-name buf))))
68608d9c
CW
1105 buf))
1106 (buffer-list))))))
1107
e1690783 1108(defun occur-1 (regexp nlines bufs &optional buf-name)
360289a6
JL
1109 (unless (and regexp (not (equal regexp "")))
1110 (error "Occur doesn't work with the empty regexp"))
e1690783
CW
1111 (unless buf-name
1112 (setq buf-name "*Occur*"))
f42a241b 1113 (let (occur-buf
70ed2a76
CW
1114 (active-bufs (delq nil (mapcar #'(lambda (buf)
1115 (when (buffer-live-p buf) buf))
1116 bufs))))
1117 ;; Handle the case where one of the buffers we're searching is the
f42a241b
RS
1118 ;; output buffer. Just rename it.
1119 (when (member buf-name (mapcar 'buffer-name active-bufs))
1120 (with-current-buffer (get-buffer buf-name)
1121 (rename-uniquely)))
1122
1123 ;; Now find or create the output buffer.
1124 ;; If we just renamed that buffer, we will make a new one here.
1125 (setq occur-buf (get-buffer-create buf-name))
1126
68608d9c 1127 (with-current-buffer occur-buf
68608d9c 1128 (occur-mode)
8121414a
CY
1129 (let ((inhibit-read-only t)
1130 ;; Don't generate undo entries for creation of the initial contents.
1131 (buffer-undo-list t))
06df7f87
EZ
1132 (erase-buffer)
1133 (let ((count (occur-engine
1134 regexp active-bufs occur-buf
1135 (or nlines list-matching-lines-default-context-lines)
3be42fcd
JL
1136 (if (and case-fold-search search-upper-case)
1137 (isearch-no-upper-case-p regexp t)
1138 case-fold-search)
06df7f87 1139 list-matching-lines-buffer-name-face
8b363e6f
JL
1140 nil list-matching-lines-face
1141 (not (eq occur-excluded-properties t)))))
06df7f87
EZ
1142 (let* ((bufcount (length active-bufs))
1143 (diff (- (length bufs) bufcount)))
d66ecdbb 1144 (message "Searched %d buffer%s%s; %s match%s%s"
06df7f87
EZ
1145 bufcount (if (= bufcount 1) "" "s")
1146 (if (zerop diff) "" (format " (%d killed)" diff))
1147 (if (zerop count) "no" (format "%d" count))
1148 (if (= count 1) "" "es")
d66ecdbb
JL
1149 ;; Don't display regexp if with remaining text
1150 ;; it is longer than window-width.
1151 (if (> (+ (length regexp) 42) (window-width))
1152 "" (format " for `%s'" (query-replace-descr regexp)))))
06df7f87 1153 (setq occur-revert-arguments (list regexp nlines bufs))
c7d2f2cc
JB
1154 (if (= count 0)
1155 (kill-buffer occur-buf)
1156 (display-buffer occur-buf)
1157 (setq next-error-last-buffer occur-buf)
1158 (setq buffer-read-only t)
1159 (set-buffer-modified-p nil)
1160 (run-hooks 'occur-hook)))))))
68608d9c 1161
46b3d18e
RS
1162(defun occur-engine (regexp buffers out-buf nlines case-fold-search
1163 title-face prefix-face match-face keep-props)
1164 (with-current-buffer out-buf
5cb4031d
KH
1165 (let ((globalcount 0)
1166 (coding nil))
46b3d18e
RS
1167 ;; Map over all the buffers
1168 (dolist (buf buffers)
1169 (when (buffer-live-p buf)
1170 (let ((matches 0) ;; count of matched lines
1171 (lines 1) ;; line count
dc2d2590
JL
1172 (prev-after-lines nil) ;; context lines of prev match
1173 (prev-lines nil) ;; line number of prev match endpt
46b3d18e 1174 (matchbeg 0)
46b3d18e
RS
1175 (origpt nil)
1176 (begpt nil)
1177 (endpt nil)
1178 (marker nil)
1179 (curstring "")
dc2d2590 1180 (ret nil)
bc16bf5e 1181 (inhibit-field-text-motion t)
46b3d18e 1182 (headerpt (with-current-buffer out-buf (point))))
cedbd3f0 1183 (with-current-buffer buf
5cb4031d
KH
1184 (or coding
1185 ;; Set CODING only if the current buffer locally
1186 ;; binds buffer-file-coding-system.
1187 (not (local-variable-p 'buffer-file-coding-system))
1188 (setq coding buffer-file-coding-system))
68608d9c 1189 (save-excursion
46b3d18e
RS
1190 (goto-char (point-min)) ;; begin searching in the buffer
1191 (while (not (eobp))
1192 (setq origpt (point))
1193 (when (setq endpt (re-search-forward regexp nil t))
1194 (setq matches (1+ matches)) ;; increment match count
5291cbca 1195 (setq matchbeg (match-beginning 0))
774642e5 1196 ;; Get beginning of first match line and end of the last.
f1f007dc
JL
1197 (save-excursion
1198 (goto-char matchbeg)
774642e5
JL
1199 (setq begpt (line-beginning-position))
1200 (goto-char endpt)
1201 (setq endpt (line-end-position)))
1202 ;; Sum line numbers up to the first match line.
1203 (setq lines (+ lines (count-lines origpt begpt)))
46b3d18e
RS
1204 (setq marker (make-marker))
1205 (set-marker marker matchbeg)
53e87c57 1206 (setq curstring (occur-engine-line begpt endpt keep-props))
8b363e6f 1207 ;; Highlight the matches
46b3d18e
RS
1208 (let ((len (length curstring))
1209 (start 0))
46b3d18e
RS
1210 (while (and (< start len)
1211 (string-match regexp curstring start))
f1f007dc
JL
1212 (add-text-properties
1213 (match-beginning 0) (match-end 0)
1214 (append
1215 `(occur-match t)
1216 (when match-face
1217 ;; Use `face' rather than `font-lock-face' here
1218 ;; so as to override faces copied from the buffer.
1219 `(face ,match-face)))
1220 curstring)
46b3d18e
RS
1221 (setq start (match-end 0))))
1222 ;; Generate the string to insert for this match
774642e5
JL
1223 (let* ((match-prefix
1224 ;; Using 7 digits aligns tabs properly.
1225 (apply #'propertize (format "%7d:" lines)
1226 (append
1227 (when prefix-face
1228 `(font-lock-face prefix-face))
1229 `(occur-prefix t mouse-face (highlight)
1230 occur-target ,marker follow-link t
1231 help-echo "mouse-2: go to this occurrence"))))
1232 (match-str
1233 ;; We don't put `mouse-face' on the newline,
1234 ;; because that loses. And don't put it
1235 ;; on context lines to reduce flicker.
1236 (propertize curstring 'mouse-face (list 'highlight)
1237 'occur-target marker
1238 'follow-link t
1239 'help-echo
1240 "mouse-2: go to this occurrence"))
1241 (out-line
46b3d18e 1242 (concat
774642e5
JL
1243 match-prefix
1244 ;; Add non-numeric prefix to all non-first lines
1245 ;; of multi-line matches.
1246 (replace-regexp-in-string
1247 "\n"
1248 "\n :"
1249 match-str)
61f570e2
RF
1250 ;; Add marker at eol, but no mouse props.
1251 (propertize "\n" 'occur-target marker)))
46b3d18e
RS
1252 (data
1253 (if (= nlines 0)
1254 ;; The simple display style
1255 out-line
f8edc67e 1256 ;; The complex multi-line display style.
dc2d2590
JL
1257 (setq ret (occur-context-lines
1258 out-line nlines keep-props begpt endpt
1259 lines prev-lines prev-after-lines))
1260 ;; Set first elem of the returned list to `data',
1261 ;; and the second elem to `prev-after-lines'.
1262 (setq prev-after-lines (nth 1 ret))
1263 (nth 0 ret))))
46b3d18e
RS
1264 ;; Actually insert the match display data
1265 (with-current-buffer out-buf
1266 (let ((beg (point))
dc2d2590 1267 (end (progn (insert data) (point)))))))
46b3d18e 1268 (goto-char endpt))
e1690783
CW
1269 (if endpt
1270 (progn
774642e5
JL
1271 ;; Sum line numbers between first and last match lines.
1272 (setq lines (+ lines (count-lines begpt endpt)
1273 ;; Add 1 for empty last match line since
1274 ;; count-lines returns 1 line less.
1275 (if (and (bolp) (eolp)) 1 0)))
e1690783
CW
1276 ;; On to the next match...
1277 (forward-line 1))
dc2d2590
JL
1278 (goto-char (point-max)))
1279 (setq prev-lines (1- lines)))
1280 ;; Flush remaining context after-lines.
1281 (when prev-after-lines
1282 (with-current-buffer out-buf
1283 (insert (apply #'concat (occur-engine-add-prefix
1284 prev-after-lines)))))))
46b3d18e 1285 (when (not (zerop matches)) ;; is the count zero?
daae70bf 1286 (setq globalcount (+ globalcount matches))
46b3d18e
RS
1287 (with-current-buffer out-buf
1288 (goto-char headerpt)
1289 (let ((beg (point))
1290 end)
d66ecdbb 1291 (insert (format "%d match%s%s in buffer: %s\n"
dbed3cd3 1292 matches (if (= matches 1) "" "es")
d66ecdbb
JL
1293 ;; Don't display regexp for multi-buffer.
1294 (if (> (length buffers) 1)
1295 "" (format " for \"%s\""
1296 (query-replace-descr regexp)))
1297 (buffer-name buf)))
46b3d18e
RS
1298 (setq end (point))
1299 (add-text-properties beg end
1300 (append
1301 (when title-face
506a6d7e
CW
1302 `(font-lock-face ,title-face))
1303 `(occur-title ,buf))))
46b3d18e 1304 (goto-char (point-min)))))))
d66ecdbb
JL
1305 ;; Display total match count and regexp for multi-buffer.
1306 (when (and (not (zerop globalcount)) (> (length buffers) 1))
1307 (goto-char (point-min))
1308 (let ((beg (point))
1309 end)
1310 (insert (format "%d match%s total for \"%s\":\n"
1311 globalcount (if (= globalcount 1) "" "es")
1312 (query-replace-descr regexp)))
1313 (setq end (point))
1314 (add-text-properties beg end (when title-face
1315 `(font-lock-face ,title-face))))
1316 (goto-char (point-min)))
5cb4031d
KH
1317 (if coding
1318 ;; CODING is buffer-file-coding-system of the first buffer
1319 ;; that locally binds it. Let's use it also for the output
1320 ;; buffer.
1321 (set-buffer-file-coding-system coding))
46b3d18e
RS
1322 ;; Return the number of matches
1323 globalcount)))
68608d9c 1324
53e87c57 1325(defun occur-engine-line (beg end &optional keep-props)
f14d1172
JL
1326 (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
1327 (text-property-not-all beg end 'fontified t))
1328 (if (fboundp 'jit-lock-fontify-now)
1329 (jit-lock-fontify-now beg end)))
1330 (if (and keep-props (not (eq occur-excluded-properties t)))
1331 (let ((str (buffer-substring beg end)))
1332 (remove-list-of-text-properties
1333 0 (length str) occur-excluded-properties str)
1334 str)
1335 (buffer-substring-no-properties beg end)))
1336
0ef84fc8
JL
1337(defun occur-engine-add-prefix (lines)
1338 (mapcar
1339 #'(lambda (line)
1340 (concat " :" line "\n"))
1341 lines))
1342
1343(defun occur-accumulate-lines (count &optional keep-props pt)
1344 (save-excursion
1345 (when pt
1346 (goto-char pt))
1347 (let ((forwardp (> count 0))
1348 result beg end moved)
1349 (while (not (or (zerop count)
1350 (if forwardp
1351 (eobp)
1352 (and (bobp) (not moved)))))
1353 (setq count (+ count (if forwardp -1 1)))
1354 (setq beg (line-beginning-position)
1355 end (line-end-position))
1356 (push (occur-engine-line beg end keep-props) result)
1357 (setq moved (= 0 (forward-line (if forwardp 1 -1)))))
1358 (nreverse result))))
1359
f8edc67e
RS
1360;; Generate context display for occur.
1361;; OUT-LINE is the line where the match is.
1362;; NLINES and KEEP-PROPS are args to occur-engine.
dc2d2590
JL
1363;; LINES is line count of the current match,
1364;; PREV-LINES is line count of the previous match,
1365;; PREV-AFTER-LINES is a list of after-context lines of the previous match.
f8edc67e
RS
1366;; Generate a list of lines, add prefixes to all but OUT-LINE,
1367;; then concatenate them all together.
dc2d2590
JL
1368(defun occur-context-lines (out-line nlines keep-props begpt endpt
1369 lines prev-lines prev-after-lines)
1370 ;; Find after- and before-context lines of the current match.
1371 (let ((before-lines
1372 (nreverse (cdr (occur-accumulate-lines
1373 (- (1+ (abs nlines))) keep-props begpt))))
1374 (after-lines
1375 (cdr (occur-accumulate-lines
1376 (1+ nlines) keep-props endpt)))
1377 separator)
1378
1379 ;; Combine after-lines of the previous match
1380 ;; with before-lines of the current match.
1381
1382 (when prev-after-lines
1383 ;; Don't overlap prev after-lines with current before-lines.
1384 (if (>= (+ prev-lines (length prev-after-lines))
1385 (- lines (length before-lines)))
1386 (setq prev-after-lines
1387 (butlast prev-after-lines
1388 (- (length prev-after-lines)
1389 (- lines prev-lines (length before-lines) 1))))
1390 ;; Separate non-overlapping context lines with a dashed line.
1391 (setq separator "-------\n")))
1392
1393 (when prev-lines
1394 ;; Don't overlap current before-lines with previous match line.
1395 (if (<= (- lines (length before-lines))
1396 prev-lines)
1397 (setq before-lines
1398 (nthcdr (- (length before-lines)
1399 (- lines prev-lines 1))
1400 before-lines))
1401 ;; Separate non-overlapping before-context lines.
1402 (unless (> nlines 0)
1403 (setq separator "-------\n"))))
1404
1405 (list
1406 ;; Return a list where the first element is the output line.
1407 (apply #'concat
1408 (append
1409 (and prev-after-lines
1410 (occur-engine-add-prefix prev-after-lines))
1411 (and separator (list separator))
1412 (occur-engine-add-prefix before-lines)
1413 (list out-line)))
1414 ;; And the second element is the list of context after-lines.
1415 (if (> nlines 0) after-lines))))
1416
698e1804 1417\f
81bdc14d
RS
1418;; It would be nice to use \\[...], but there is no reasonable way
1419;; to make that display both SPC and Y.
698e1804
RS
1420(defconst query-replace-help
1421 "Type Space or `y' to replace one match, Delete or `n' to skip to next,
be44f62c 1422RET or `q' to exit, Period to replace one match and exit,
698e1804
RS
1423Comma to replace but not move point immediately,
1424C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
1425C-w to delete match and recursive edit,
1426C-l to clear the screen, redisplay, and offer same replacement again,
1427! to replace all remaining matches with no more questions,
7ce278f3
GM
1428^ to move point back to previous match,
1429E to edit the replacement string"
f54701d1 1430 "Help message while in `query-replace'.")
698e1804 1431
cedbd3f0
SM
1432(defvar query-replace-map
1433 (let ((map (make-sparse-keymap)))
1434 (define-key map " " 'act)
1435 (define-key map "\d" 'skip)
1436 (define-key map [delete] 'skip)
1437 (define-key map [backspace] 'skip)
1438 (define-key map "y" 'act)
1439 (define-key map "n" 'skip)
1440 (define-key map "Y" 'act)
1441 (define-key map "N" 'skip)
1442 (define-key map "e" 'edit-replacement)
1443 (define-key map "E" 'edit-replacement)
1444 (define-key map "," 'act-and-show)
1445 (define-key map "q" 'exit)
1446 (define-key map "\r" 'exit)
1447 (define-key map [return] 'exit)
1448 (define-key map "." 'act-and-exit)
1449 (define-key map "\C-r" 'edit)
1450 (define-key map "\C-w" 'delete-and-edit)
1451 (define-key map "\C-l" 'recenter)
1452 (define-key map "!" 'automatic)
1453 (define-key map "^" 'backup)
1454 (define-key map "\C-h" 'help)
1455 (define-key map [f1] 'help)
1456 (define-key map [help] 'help)
1457 (define-key map "?" 'help)
1458 (define-key map "\C-g" 'quit)
1459 (define-key map "\C-]" 'quit)
1460 (define-key map "\e" 'exit-prefix)
1461 (define-key map [escape] 'exit-prefix)
1462 map)
81bdc14d
RS
1463 "Keymap that defines the responses to questions in `query-replace'.
1464The \"bindings\" in this map are not commands; they are answers.
1465The valid answers include `act', `skip', `act-and-show',
1466`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
d9121bc0 1467`automatic', `backup', `exit-prefix', and `help'.")
81bdc14d 1468
b591f338
JL
1469(defvar multi-query-replace-map
1470 (let ((map (make-sparse-keymap)))
1471 (set-keymap-parent map query-replace-map)
1472 (define-key map "Y" 'automatic-all)
1473 (define-key map "N" 'exit-current)
1474 map)
1475 "Keymap that defines additional bindings for multi-buffer replacements.
1476It extends its parent map `query-replace-map' with new bindings to
1477operate on a set of buffers/files. The difference with its parent map
1478is the additional answers `automatic-all' to replace all remaining
1479matches in all remaining buffers with no more questions, and
1480`exit-current' to skip remaining matches in the current buffer
1481and to continue with the next buffer in the sequence.")
1482
84482eb3 1483(defun replace-match-string-symbols (n)
e730be7f
DL
1484 "Process a list (and any sub-lists), expanding certain symbols.
1485Symbol Expands To
1486N (match-string N) (where N is a string of digits)
1487#N (string-to-number (match-string N))
1488& (match-string 0)
1489#& (string-to-number (match-string 0))
2f57bf85 1490# replace-count
e730be7f
DL
1491
1492Note that these symbols must be preceeded by a backslash in order to
f72f9f1a
RS
1493type them using Lisp syntax."
1494 (while (consp n)
84482eb3
RS
1495 (cond
1496 ((consp (car n))
1497 (replace-match-string-symbols (car n))) ;Process sub-list
1498 ((symbolp (car n))
1499 (let ((name (symbol-name (car n))))
1500 (cond
1501 ((string-match "^[0-9]+$" name)
1502 (setcar n (list 'match-string (string-to-number name))))
1503 ((string-match "^#[0-9]+$" name)
1504 (setcar n (list 'string-to-number
1505 (list 'match-string
1506 (string-to-number (substring name 1))))))
1507 ((string= "&" name)
1508 (setcar n '(match-string 0)))
1509 ((string= "#&" name)
2f57bf85
DK
1510 (setcar n '(string-to-number (match-string 0))))
1511 ((string= "#" name)
1512 (setcar n 'replace-count))))))
84482eb3
RS
1513 (setq n (cdr n))))
1514
1515(defun replace-eval-replacement (expression replace-count)
1516 (let ((replacement (eval expression)))
1517 (if (stringp replacement)
1518 replacement
1519 (prin1-to-string replacement t))))
1520
2f57bf85
DK
1521(defun replace-quote (replacement)
1522 "Quote a replacement string.
1523This just doubles all backslashes in REPLACEMENT and
1524returns the resulting string. If REPLACEMENT is not
1525a string, it is first passed through `prin1-to-string'
1526with the `noescape' argument set.
1527
1528`match-data' is preserved across the call."
1529 (save-match-data
1530 (replace-regexp-in-string "\\\\" "\\\\"
1531 (if (stringp replacement)
1532 replacement
1533 (prin1-to-string replacement t))
1534 t t)))
1535
84482eb3
RS
1536(defun replace-loop-through-replacements (data replace-count)
1537 ;; DATA is a vector contaning the following values:
1538 ;; 0 next-rotate-count
1539 ;; 1 repeat-count
1540 ;; 2 next-replacement
1541 ;; 3 replacements
1542 (if (= (aref data 0) replace-count)
1543 (progn
1544 (aset data 0 (+ replace-count (aref data 1)))
1545 (let ((next (cdr (aref data 2))))
1546 (aset data 2 (if (consp next) next (aref data 3))))))
1547 (car (aref data 2)))
1548
7c1c02ac
DK
1549(defun replace-match-data (integers reuse &optional new)
1550 "Like `match-data', but markers in REUSE get invalidated.
6a964bb1 1551If NEW is non-nil, it is set and returned instead of fresh data,
7c1c02ac
DK
1552but coerced to the correct value of INTEGERS."
1553 (or (and new
1554 (progn
1555 (set-match-data new)
1556 (and (eq new reuse)
1557 (eq (null integers) (markerp (car reuse)))
1558 new)))
10ddc30e 1559 (match-data integers reuse t)))
7c1c02ac
DK
1560
1561(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data)
1562 "Make a replacement with `replace-match', editing `\\?'.
15fd7d5d 1563NEWTEXT, FIXEDCASE, LITERAL are just passed on. If NOEDIT is true, no
7c1c02ac
DK
1564check for `\\?' is made to save time. MATCH-DATA is used for the
1565replacement. In case editing is done, it is changed to use markers.
1566
6a964bb1 1567The return value is non-nil if there has been no `\\?' or NOEDIT was
7c1c02ac
DK
1568passed in. If LITERAL is set, no checking is done, anyway."
1569 (unless (or literal noedit)
1570 (setq noedit t)
1571 (while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\?\\)"
1572 newtext)
1573 (setq newtext
3981e5b5
JB
1574 (read-string "Edit replacement string: "
1575 (prog1
1576 (cons
1577 (replace-match "" t t newtext 3)
1578 (1+ (match-beginning 3)))
1579 (setq match-data
1580 (replace-match-data
1581 nil match-data match-data))))
7c1c02ac
DK
1582 noedit nil)))
1583 (set-match-data match-data)
1584 (replace-match newtext fixedcase literal)
1585 noedit)
1586
c35a09fc
CY
1587(defvar replace-search-function 'search-forward
1588 "Function to use when searching for strings to replace.
1589It is used by `query-replace' and `replace-string', and is called
1590with three arguments, as if it were `search-forward'.")
1591
1592(defvar replace-re-search-function 're-search-forward
1593 "Function to use when searching for regexps to replace.
1594It is used by `query-replace-regexp', `replace-regexp',
96f606c5
JL
1595`query-replace-regexp-eval', and `map-query-replace-regexp'.
1596It is called with three arguments, as if it were
1597`re-search-forward'.")
c35a09fc 1598
d99118b0 1599(defun perform-replace (from-string replacements
698e1804 1600 query-flag regexp-flag delimited-flag
99a7559f 1601 &optional repeat-count map start end)
698e1804
RS
1602 "Subroutine of `query-replace'. Its complexity handles interactive queries.
1603Don't use this in your own program unless you want to query and set the mark
1604just as `query-replace' does. Instead, write a simple loop like this:
698665d1
GM
1605
1606 (while (re-search-forward \"foo[ \\t]+bar\" nil t)
698e1804 1607 (replace-match \"foobar\" nil nil))
698665d1
GM
1608
1609which will run faster and probably do exactly what you want. Please
1610see the documentation of `replace-match' to find out how to simulate
588c915a
CW
1611`case-replace'.
1612
1613This function returns nil if and only if there were no matches to
1614make, or the user didn't cancel the call."
81bdc14d 1615 (or map (setq map query-replace-map))
1c1dadab
RS
1616 (and query-flag minibuffer-auto-raise
1617 (raise-frame (window-frame (minibuffer-window))))
26cc71af 1618 (let* ((case-fold-search
3be42fcd
JL
1619 (if (and case-fold-search search-upper-case)
1620 (isearch-no-upper-case-p from-string regexp-flag)
1621 case-fold-search))
26cc71af
SM
1622 (nocasify (not (and case-replace case-fold-search)))
1623 (literal (or (not regexp-flag) (eq regexp-flag 'literal)))
c35a09fc
CY
1624 (search-function
1625 (if regexp-flag
1626 replace-re-search-function
1627 replace-search-function))
26cc71af
SM
1628 (search-string from-string)
1629 (real-match-data nil) ; The match data for the current match.
1630 (next-replacement nil)
1631 ;; This is non-nil if we know there is nothing for the user
1632 ;; to edit in the replacement.
1633 (noedit nil)
1634 (keep-going t)
1635 (stack nil)
1636 (replace-count 0)
1637 (nonempty-match nil)
b591f338 1638 (multi-buffer nil)
2952b1ae 1639 (recenter-last-op nil) ; Start cycling order with initial position.
26cc71af
SM
1640
1641 ;; If non-nil, it is marker saying where in the buffer to stop.
1642 (limit nil)
1643
1644 ;; Data for the next match. If a cons, it has the same format as
1645 ;; (match-data); otherwise it is t if a match is possible at point.
1646 (match-again t)
1647
1648 (message
1649 (if query-flag
1650 (apply 'propertize
1651 (substitute-command-keys
1652 "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
1653 minibuffer-prompt-properties))))
7ef5c431
KH
1654
1655 ;; If region is active, in Transient Mark mode, operate on region.
47d72254
GM
1656 (when start
1657 (setq limit (copy-marker (max start end)))
1658 (goto-char (min start end))
1659 (deactivate-mark))
84482eb3 1660
b591f338
JL
1661 ;; If last typed key in previous call of multi-buffer perform-replace
1662 ;; was `automatic-all', don't ask more questions in next files
1e4bd40d 1663 (when (eq (lookup-key map (vector last-input-event)) 'automatic-all)
b591f338
JL
1664 (setq query-flag nil multi-buffer t))
1665
84482eb3
RS
1666 ;; REPLACEMENTS is either a string, a list of strings, or a cons cell
1667 ;; containing a function and its first argument. The function is
1668 ;; called to generate each replacement like this:
1669 ;; (funcall (car replacements) (cdr replacements) replace-count)
1670 ;; It must return a string.
1671 (cond
1672 ((stringp replacements)
1673 (setq next-replacement replacements
1674 replacements nil))
1675 ((stringp (car replacements)) ; If it isn't a string, it must be a cons
1676 (or repeat-count (setq repeat-count 1))
1677 (setq replacements (cons 'replace-loop-through-replacements
1678 (vector repeat-count repeat-count
1679 replacements replacements)))))
1680
698e1804
RS
1681 (if delimited-flag
1682 (setq search-function 're-search-forward
1683 search-string (concat "\\b"
1684 (if regexp-flag from-string
1685 (regexp-quote from-string))
1686 "\\b")))
ccec9764 1687 (when query-replace-lazy-highlight
444697a1 1688 (setq isearch-lazy-highlight-last-string nil))
35d59c0f 1689
698e1804
RS
1690 (push-mark)
1691 (undo-boundary)
e782e9f2
RS
1692 (unwind-protect
1693 ;; Loop finding occurrences that perhaps should be replaced.
1694 (while (and keep-going
22a76778 1695 (not (or (eobp) (and limit (>= (point) limit))))
5632eb27
PE
1696 ;; Use the next match if it is already known;
1697 ;; otherwise, search for a match after moving forward
1698 ;; one char if progress is required.
1699 (setq real-match-data
b3aad29e
CY
1700 (cond ((consp match-again)
1701 (goto-char (nth 1 match-again))
1702 (replace-match-data
1703 t real-match-data match-again))
1704 ;; MATCH-AGAIN non-nil means accept an
1705 ;; adjacent match.
1706 (match-again
1707 (and
1708 (funcall search-function search-string
1709 limit t)
1710 ;; For speed, use only integers and
1711 ;; reuse the list used last time.
1712 (replace-match-data t real-match-data)))
1713 ((and (< (1+ (point)) (point-max))
1714 (or (null limit)
1715 (< (1+ (point)) limit)))
1716 ;; If not accepting adjacent matches,
1717 ;; move one char to the right before
1718 ;; searching again. Undo the motion
1719 ;; if the search fails.
1720 (let ((opoint (point)))
1721 (forward-char 1)
1722 (if (funcall
1723 search-function search-string
1724 limit t)
1725 (replace-match-data
1726 t real-match-data)
1727 (goto-char opoint)
1728 nil))))))
6a964bb1 1729
c0b45763
RS
1730 ;; Record whether the match is nonempty, to avoid an infinite loop
1731 ;; repeatedly matching the same empty string.
1732 (setq nonempty-match
1733 (/= (nth 0 real-match-data) (nth 1 real-match-data)))
1734
1735 ;; If the match is empty, record that the next one can't be
1736 ;; adjacent.
1737
1738 ;; Otherwise, if matching a regular expression, do the next
1739 ;; match now, since the replacement for this match may
1740 ;; affect whether the next match is adjacent to this one.
1741 ;; If that match is empty, don't use it.
1742 (setq match-again
1743 (and nonempty-match
1744 (or (not regexp-flag)
1745 (and (looking-at search-string)
1746 (let ((match (match-data)))
1747 (and (/= (nth 0 match) (nth 1 match))
1748 match))))))
1749
1c4fe319
RS
1750 ;; Optionally ignore matches that have a read-only property.
1751 (unless (and query-replace-skip-read-only
1752 (text-property-not-all
c0b45763 1753 (nth 0 real-match-data) (nth 1 real-match-data)
1c4fe319
RS
1754 'read-only nil))
1755
1c4fe319
RS
1756 ;; Calculate the replacement string, if necessary.
1757 (when replacements
1758 (set-match-data real-match-data)
1759 (setq next-replacement
1760 (funcall (car replacements) (cdr replacements)
2f857176 1761 replace-count)))
1c4fe319 1762 (if (not query-flag)
f2e7b9ef 1763 (progn
15fd7d5d 1764 (unless (or literal noedit)
444697a1
JL
1765 (replace-highlight
1766 (nth 0 real-match-data) (nth 1 real-match-data)
1767 start end search-string
1768 (or delimited-flag regexp-flag) case-fold-search))
7c1c02ac
DK
1769 (setq noedit
1770 (replace-match-maybe-edit
1771 next-replacement nocasify literal
1772 noedit real-match-data)
1773 replace-count (1+ replace-count)))
1c4fe319
RS
1774 (undo-boundary)
1775 (let (done replaced key def)
1776 ;; Loop reading commands until one of them sets done,
7c1c02ac
DK
1777 ;; which means it has finished handling this
1778 ;; occurrence. Any command that sets `done' should
1779 ;; leave behind proper match data for the stack.
1780 ;; Commands not setting `done' need to adjust
1781 ;; `real-match-data'.
1c4fe319
RS
1782 (while (not done)
1783 (set-match-data real-match-data)
444697a1
JL
1784 (replace-highlight
1785 (match-beginning 0) (match-end 0)
1786 start end search-string
1787 (or delimited-flag regexp-flag) case-fold-search)
1c4fe319
RS
1788 ;; Bind message-log-max so we don't fill up the message log
1789 ;; with a bunch of identical messages.
7abe68aa
JL
1790 (let ((message-log-max nil)
1791 (replacement-presentation
1792 (if query-replace-show-replacement
1793 (save-match-data
1794 (set-match-data real-match-data)
1795 (match-substitute-replacement next-replacement
1796 nocasify literal))
1797 next-replacement)))
b938735a
JL
1798 (message message
1799 (query-replace-descr from-string)
7abe68aa 1800 (query-replace-descr replacement-presentation)))
1c4fe319
RS
1801 (setq key (read-event))
1802 ;; Necessary in case something happens during read-event
1803 ;; that clobbers the match data.
1804 (set-match-data real-match-data)
1805 (setq key (vector key))
1806 (setq def (lookup-key map key))
1807 ;; Restore the match data while we process the command.
1808 (cond ((eq def 'help)
1809 (with-output-to-temp-buffer "*Help*"
1810 (princ
1811 (concat "Query replacing "
04ff2dee 1812 (if delimited-flag "word " "")
1c4fe319
RS
1813 (if regexp-flag "regexp " "")
1814 from-string " with "
1815 next-replacement ".\n\n"
1816 (substitute-command-keys
1817 query-replace-help)))
1818 (with-current-buffer standard-output
1819 (help-mode))))
1820 ((eq def 'exit)
1821 (setq keep-going nil)
1822 (setq done t))
b591f338
JL
1823 ((eq def 'exit-current)
1824 (setq multi-buffer t keep-going nil done t))
1c4fe319
RS
1825 ((eq def 'backup)
1826 (if stack
588c915a 1827 (let ((elt (pop stack)))
7c1c02ac
DK
1828 (goto-char (nth 0 elt))
1829 (setq replaced (nth 1 elt)
1830 real-match-data
1831 (replace-match-data
1832 t real-match-data
1833 (nth 2 elt))))
1c4fe319
RS
1834 (message "No previous match")
1835 (ding 'no-terminate)
1836 (sit-for 1)))
1837 ((eq def 'act)
1838 (or replaced
7c1c02ac
DK
1839 (setq noedit
1840 (replace-match-maybe-edit
1841 next-replacement nocasify literal
1842 noedit real-match-data)
1843 replace-count (1+ replace-count)))
1c4fe319
RS
1844 (setq done t replaced t))
1845 ((eq def 'act-and-exit)
1846 (or replaced
7c1c02ac 1847 (setq noedit
da6eb51c 1848 (replace-match-maybe-edit
7c1c02ac
DK
1849 next-replacement nocasify literal
1850 noedit real-match-data)
1851 replace-count (1+ replace-count)))
1c4fe319
RS
1852 (setq keep-going nil)
1853 (setq done t replaced t))
1854 ((eq def 'act-and-show)
1855 (if (not replaced)
7c1c02ac
DK
1856 (setq noedit
1857 (replace-match-maybe-edit
1858 next-replacement nocasify literal
1859 noedit real-match-data)
1860 replace-count (1+ replace-count)
1861 real-match-data (replace-match-data
1862 t real-match-data)
1863 replaced t)))
b591f338 1864 ((or (eq def 'automatic) (eq def 'automatic-all))
1c4fe319 1865 (or replaced
7c1c02ac
DK
1866 (setq noedit
1867 (replace-match-maybe-edit
1868 next-replacement nocasify literal
1869 noedit real-match-data)
1870 replace-count (1+ replace-count)))
b591f338
JL
1871 (setq done t query-flag nil replaced t)
1872 (if (eq def 'automatic-all) (setq multi-buffer t)))
1c4fe319
RS
1873 ((eq def 'skip)
1874 (setq done t))
1875 ((eq def 'recenter)
2952b1ae
JL
1876 ;; `this-command' has the value `query-replace',
1877 ;; so we need to bind it to `recenter-top-bottom'
1878 ;; to allow it to detect a sequence of `C-l'.
1879 (let ((this-command 'recenter-top-bottom)
1880 (last-command 'recenter-top-bottom))
1881 (recenter-top-bottom)))
1c4fe319
RS
1882 ((eq def 'edit)
1883 (let ((opos (point-marker)))
7c1c02ac
DK
1884 (setq real-match-data (replace-match-data
1885 nil real-match-data
1886 real-match-data))
1c4fe319 1887 (goto-char (match-beginning 0))
86914dcc
RS
1888 (save-excursion
1889 (save-window-excursion
1890 (recursive-edit)))
7c1c02ac
DK
1891 (goto-char opos)
1892 (set-marker opos nil))
1c4fe319
RS
1893 ;; Before we make the replacement,
1894 ;; decide whether the search string
1895 ;; can match again just after this match.
1896 (if (and regexp-flag nonempty-match)
1897 (setq match-again (and (looking-at search-string)
1898 (match-data)))))
1c4fe319
RS
1899 ;; Edit replacement.
1900 ((eq def 'edit-replacement)
7c1c02ac
DK
1901 (setq real-match-data (replace-match-data
1902 nil real-match-data
1903 real-match-data)
1904 next-replacement
3981e5b5
JB
1905 (read-string "Edit replacement string: "
1906 next-replacement)
7c1c02ac
DK
1907 noedit nil)
1908 (if replaced
1909 (set-match-data real-match-data)
1910 (setq noedit
1911 (replace-match-maybe-edit
1912 next-replacement nocasify literal noedit
1913 real-match-data)
1914 replaced t))
1c4fe319 1915 (setq done t))
d99118b0 1916
1c4fe319 1917 ((eq def 'delete-and-edit)
7c1c02ac
DK
1918 (replace-match "" t t)
1919 (setq real-match-data (replace-match-data
1920 nil real-match-data))
1921 (replace-dehighlight)
1922 (save-excursion (recursive-edit))
1c4fe319
RS
1923 (setq replaced t))
1924 ;; Note: we do not need to treat `exit-prefix'
1925 ;; specially here, since we reread
1926 ;; any unrecognized character.
1927 (t
1928 (setq this-command 'mode-exited)
1929 (setq keep-going nil)
1930 (setq unread-command-events
1931 (append (listify-key-sequence key)
1932 unread-command-events))
35d59c0f 1933 (setq done t)))
ccec9764 1934 (when query-replace-lazy-highlight
2952b1ae 1935 ;; Force lazy rehighlighting only after replacements.
ccec9764 1936 (if (not (memq def '(skip backup)))
2952b1ae
JL
1937 (setq isearch-lazy-highlight-last-string nil)))
1938 (unless (eq def 'recenter)
1939 ;; Reset recenter cycling order to initial position.
1940 (setq recenter-last-op nil)))
1c4fe319
RS
1941 ;; Record previous position for ^ when we move on.
1942 ;; Change markers to numbers in the match data
1943 ;; since lots of markers slow down editing.
7c1c02ac 1944 (push (list (point) replaced
bace7209
LT
1945;;; If the replacement has already happened, all we need is the
1946;;; current match start and end. We could get this with a trivial
1947;;; match like
1948;;; (save-excursion (goto-char (match-beginning 0))
1949;;; (search-forward (match-string 0))
1950;;; (match-data t))
1951;;; if we really wanted to avoid manually constructing match data.
1952;;; Adding current-buffer is necessary so that match-data calls can
1953;;; return markers which are appropriate for editing.
7c1c02ac
DK
1954 (if replaced
1955 (list
1956 (match-beginning 0)
1957 (match-end 0)
1958 (current-buffer))
1959 (match-data t)))
1960 stack)))))
889617de 1961
e782e9f2 1962 (replace-dehighlight))
4d33492a
RS
1963 (or unread-command-events
1964 (message "Replaced %d occurrence%s"
1965 replace-count
1966 (if (= replace-count 1) "" "s")))
b591f338 1967 (or (and keep-going stack) multi-buffer)))
698e1804 1968
e782e9f2
RS
1969(defvar replace-overlay nil)
1970
444697a1
JL
1971(defun replace-highlight (match-beg match-end range-beg range-end
1972 string regexp case-fold)
ccec9764
JL
1973 (if query-replace-highlight
1974 (if replace-overlay
d532160f
RS
1975 (move-overlay replace-overlay match-beg match-end (current-buffer))
1976 (setq replace-overlay (make-overlay match-beg match-end))
a46961de 1977 (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
ccec9764 1978 (overlay-put replace-overlay 'face 'query-replace)))
444697a1
JL
1979 (if query-replace-lazy-highlight
1980 (let ((isearch-string string)
1981 (isearch-regexp regexp)
0b60cc09 1982 (search-whitespace-regexp nil)
e54a1075
JB
1983 (isearch-case-fold-search case-fold)
1984 (isearch-forward t)
1985 (isearch-error nil))
201d895a
JL
1986 ;; Set isearch-word to nil because word-replace is regexp-based,
1987 ;; so `isearch-search-fun' should not use `word-search-forward'.
1988 (if (and isearch-word isearch-regexp) (setq isearch-word nil))
444697a1 1989 (isearch-lazy-highlight-new-loop range-beg range-end))))
ccec9764 1990
e782e9f2 1991(defun replace-dehighlight ()
ccec9764
JL
1992 (when replace-overlay
1993 (delete-overlay replace-overlay))
1994 (when query-replace-lazy-highlight
444697a1 1995 (lazy-highlight-cleanup lazy-highlight-cleanup)
ccec9764 1996 (setq isearch-lazy-highlight-last-string nil)))
e782e9f2 1997
6f1df6d9 1998;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
c88ab9ce 1999;;; replace.el ends here