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