* lisp/emacs-lisp/bytecomp.el (byte-recompile-file): New fun.
[emacs.git] / lisp / replace.el
blobbaea2820433e1c409b0943d5c56abdc4b9068f9d
1 ;;; replace.el --- replace commands for Emacs
3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001,
4 ;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
5 ;; Free Software Foundation, Inc.
7 ;; Maintainer: FSF
8 ;; Package: emacs
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
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.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Commentary:
27 ;; This package supplies the string and regular-expression replace functions
28 ;; documented in the Emacs user's manual.
30 ;;; Code:
32 (defcustom case-replace t
33 "Non-nil means `query-replace' should preserve case in replacements."
34 :type 'boolean
35 :group 'matching)
37 (defvar query-replace-history nil
38 "Default history list for query-replace commands.
39 See `query-replace-from-history-variable' and
40 `query-replace-to-history-variable'.")
42 (defvar query-replace-defaults nil
43 "Default values of FROM-STRING and TO-STRING for `query-replace'.
44 This is a cons cell (FROM-STRING . TO-STRING), or nil if there is
45 no default value.")
47 (defvar query-replace-interactive nil
48 "Non-nil means `query-replace' uses the last search string.
49 That becomes the \"string to replace\".")
51 (defcustom query-replace-from-history-variable 'query-replace-history
52 "History list to use for the FROM argument of `query-replace' commands.
53 The value of this variable should be a symbol; that symbol
54 is used as a variable to hold a history list for the strings
55 or patterns to be replaced."
56 :group 'matching
57 :type 'symbol
58 :version "20.3")
60 (defcustom query-replace-to-history-variable 'query-replace-history
61 "History list to use for the TO argument of `query-replace' commands.
62 The value of this variable should be a symbol; that symbol
63 is used as a variable to hold a history list for replacement
64 strings or patterns."
65 :group 'matching
66 :type 'symbol
67 :version "20.3")
69 (defcustom query-replace-skip-read-only nil
70 "Non-nil means `query-replace' and friends ignore read-only matches."
71 :type 'boolean
72 :group 'matching
73 :version "22.1")
75 (defcustom query-replace-show-replacement t
76 "Non-nil means to show what actual replacement text will be."
77 :type 'boolean
78 :group 'matching
79 :version "23.1")
81 (defcustom query-replace-highlight t
82 "Non-nil means to highlight matches during query replacement."
83 :type 'boolean
84 :group 'matching)
86 (defcustom query-replace-lazy-highlight t
87 "Controls the lazy-highlighting during query replacements.
88 When non-nil, all text in the buffer matching the current match
89 is 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
94 :version "22.1")
96 (defface query-replace
97 '((t (:inherit isearch)))
98 "Face for highlighting query replacement matches."
99 :group 'matching
100 :version "22.1")
102 (defun query-replace-descr (string)
103 (mapconcat 'isearch-text-char-description string ""))
105 (defun query-replace-read-from (prompt regexp-flag)
106 "Query and return the `from' argument of a query-replace operation.
107 The return value can also be a pair (FROM . TO) indicating that the user
108 wants to replace FROM with TO."
109 (if query-replace-interactive
110 (car (if regexp-flag regexp-search-ring search-ring))
111 (let* ((history-add-new-input nil)
112 (from
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
118 (if query-replace-defaults
119 (format "%s (default %s -> %s): " prompt
120 (query-replace-descr (car query-replace-defaults))
121 (query-replace-descr (cdr query-replace-defaults)))
122 (format "%s: " prompt))
123 nil nil nil
124 query-replace-from-history-variable
125 nil t))))
126 (if (and (zerop (length from)) query-replace-defaults)
127 (cons (car query-replace-defaults)
128 (query-replace-compile-replacement
129 (cdr query-replace-defaults) regexp-flag))
130 (add-to-history query-replace-from-history-variable from nil t)
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))))
143 (defun query-replace-compile-replacement (to regexp-flag)
144 "Maybe convert a regexp replacement TO to Lisp.
145 Returns a list suitable for `perform-replace' if necessary,
146 the original string if not."
147 (if (and regexp-flag
148 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
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)
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)
168 (not (= ?\( (aref to 0)))))
169 (eq (string-match " " to (cdr pos))
170 (cdr pos)))
171 (1+ (cdr pos))
172 (cdr pos))))
173 (setq to (substring to end)))))
174 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)))
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))))
181 to))
184 (defun query-replace-read-to (from prompt regexp-flag)
185 "Query and return the `to' argument of a query-replace operation."
186 (query-replace-compile-replacement
187 (save-excursion
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)
194 (setq query-replace-defaults (cons from to))
195 to))
196 regexp-flag))
198 (defun query-replace-read-args (prompt regexp-flag &optional noerror)
199 (unless noerror
200 (barf-if-buffer-read-only))
201 (let* ((from (query-replace-read-from prompt regexp-flag))
202 (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
203 (query-replace-read-to from prompt regexp-flag))))
204 (list from to current-prefix-arg)))
206 (defun query-replace (from-string to-string &optional delimited start end)
207 "Replace some occurrences of FROM-STRING with TO-STRING.
208 As each match is found, the user must type a character saying
209 what to do with it. For directions, type \\[help-command] at that time.
211 In Transient Mark mode, if the mark is active, operate on the contents
212 of the region. Otherwise, operate from point to the end of the buffer.
214 If `query-replace-interactive' is non-nil, the last incremental search
215 string is used as FROM-STRING--you don't have to specify it with the
216 minibuffer.
218 Matching is independent of case if `case-fold-search' is non-nil and
219 FROM-STRING has no uppercase letters. Replacement transfers the case
220 pattern 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
222 letters. \(Transferring the case pattern means that if the old text
223 matched is all caps, or capitalized, then its replacement is upcased
224 or capitalized.)
226 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
227 only matches surrounded by word boundaries.
228 Fourth and fifth arg START and END specify the region to operate on.
230 To customize possible responses, change the \"bindings\" in `query-replace-map'."
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)))))
246 (perform-replace from-string to-string t nil delimited nil nil start end))
248 (define-key esc-map "%" 'query-replace)
250 (defun query-replace-regexp (regexp to-string &optional delimited start end)
251 "Replace some things after point matching REGEXP with TO-STRING.
252 As each match is found, the user must type a character saying
253 what to do with it. For directions, type \\[help-command] at that time.
255 In Transient Mark mode, if the mark is active, operate on the contents
256 of the region. Otherwise, operate from point to the end of the buffer.
258 If `query-replace-interactive' is non-nil, the last incremental search
259 regexp is used as REGEXP--you don't have to specify it with the
260 minibuffer.
262 Matching is independent of case if `case-fold-search' is non-nil and
263 REGEXP has no uppercase letters. Replacement transfers the case
264 pattern 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
267 all caps, or capitalized, then its replacement is upcased or
268 capitalized.)
270 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
271 only matches surrounded by word boundaries.
272 Fourth and fifth arg START and END specify the region to operate on.
274 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
275 and `\\=\\N' (where N is a digit) stands for
276 whatever what matched the Nth `\\(...\\)' in REGEXP.
277 `\\?' lets you edit the replacement text in the minibuffer
278 at the given position for each replacement.
280 In interactive calls, the replacement text can contain `\\,'
281 followed by a Lisp expression. Each
282 replacement evaluates that expression to compute the replacement
283 string. Inside of that expression, `\\&' is a string denoting the
284 whole match as a string, `\\N' for a partial match, `\\#&' and `\\#N'
285 for the whole or a partial match converted to a number with
286 `string-to-number', and `\\#' itself for the number of replacements
287 done so far (starting with zero).
289 If the replacement expression is a symbol, write a space after it
290 to terminate it. One space there, if any, will be discarded.
292 When using those Lisp features interactively in the replacement
293 text, TO-STRING is actually made a list instead of a string.
294 Use \\[repeat-complex-command] after this command for details."
295 (interactive
296 (let ((common
297 (query-replace-read-args
298 (concat "Query replace"
299 (if current-prefix-arg " word" "")
300 " regexp"
301 (if (and transient-mark-mode mark-active) " in region" ""))
302 t)))
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)))))
311 (perform-replace regexp to-string t t delimited nil nil start end))
313 (define-key esc-map [?\C-%] 'query-replace-regexp)
315 (defun query-replace-regexp-eval (regexp to-expr &optional delimited start end)
316 "Replace some things after point matching REGEXP with the result of TO-EXPR.
318 Interactive use of this function is deprecated in favor of the
319 `\\,' feature of `query-replace-regexp'. For non-interactive use, a loop
320 using `search-forward-regexp' and `replace-match' is preferred.
322 As each match is found, the user must type a character saying
323 what to do with it. For directions, type \\[help-command] at that time.
325 TO-EXPR is a Lisp expression evaluated to compute each replacement. It may
326 reference `replace-count' to get the number of replacements already made.
327 If 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).
330 For convenience, when entering TO-EXPR interactively, you can use `\\&' or
331 `\\0' to stand for whatever matched the whole of REGEXP, and `\\N' (where
332 N is a digit) to stand for whatever matched the Nth `\\(...\\)' in REGEXP.
333 Use `\\#&' or `\\#N' if you want a number instead of a string.
334 In interactive use, `\\#' in itself stands for `replace-count'.
336 In Transient Mark mode, if the mark is active, operate on the contents
337 of the region. Otherwise, operate from point to the end of the buffer.
339 If `query-replace-interactive' is non-nil, the last incremental search
340 regexp is used as REGEXP--you don't have to specify it with the
341 minibuffer.
343 Preserves case in each replacement if `case-replace' and `case-fold-search'
344 are non-nil and REGEXP has no uppercase letters.
346 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
347 only matches that are surrounded by word boundaries.
348 Fourth and fifth arg START and END specify the region to operate on."
349 (interactive
350 (progn
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)))
358 (to (list (read-from-minibuffer
359 (format "Query replace regexp %s with eval: "
360 (query-replace-descr from))
361 nil nil t query-replace-to-history-variable from t))))
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)
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)
369 (region-end))))))
370 (perform-replace regexp (cons 'replace-eval-replacement to-expr)
371 t 'literal delimited nil nil start end))
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
376 using `search-forward-regexp' and `replace-match' is preferred." "22.1")
378 (defun map-query-replace-regexp (regexp to-strings &optional n start end)
379 "Replace some matches for REGEXP with various strings, in rotation.
380 The second argument TO-STRINGS contains the replacement strings, separated
381 by spaces. This command works like `query-replace-regexp' except that
382 each successive replacement uses the next successive replacement string,
383 wrapping around from the last such string to the first.
385 In Transient Mark mode, if the mark is active, operate on the contents
386 of the region. Otherwise, operate from point to the end of the buffer.
388 Non-interactively, TO-STRINGS may be a list of replacement strings.
390 If `query-replace-interactive' is non-nil, the last incremental search
391 regexp is used as REGEXP--you don't have to specify it with the minibuffer.
393 A prefix argument N says to use each replacement string N times
394 before rotating to the next.
395 Fourth and fifth arg START and END specify the region to operate on."
396 (interactive
397 (let* ((from (if query-replace-interactive
398 (car regexp-search-ring)
399 (read-from-minibuffer "Map query replace (regexp): "
400 nil nil nil
401 query-replace-from-history-variable
402 nil t)))
403 (to (read-from-minibuffer
404 (format "Query replace %s with (space-separated strings): "
405 (query-replace-descr from))
406 nil nil nil
407 query-replace-to-history-variable from t)))
408 (list from to
409 (and current-prefix-arg
410 (prefix-numeric-value current-prefix-arg))
411 (if (and transient-mark-mode mark-active)
412 (region-beginning))
413 (if (and transient-mark-mode mark-active)
414 (region-end)))))
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 ""))))
428 (perform-replace regexp replacements t t nil n nil start end)))
430 (defun replace-string (from-string to-string &optional delimited start end)
431 "Replace occurrences of FROM-STRING with TO-STRING.
432 Preserve case in each match if `case-replace' and `case-fold-search'
433 are non-nil and FROM-STRING has no uppercase letters.
434 \(Preserving case means that if the string matched is all caps, or capitalized,
435 then its replacement is upcased or capitalized.)
437 In Transient Mark mode, if the mark is active, operate on the contents
438 of the region. Otherwise, operate from point to the end of the buffer.
440 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
441 only matches surrounded by word boundaries.
442 Fourth and fifth arg START and END specify the region to operate on.
444 If `query-replace-interactive' is non-nil, the last incremental search
445 string is used as FROM-STRING--you don't have to specify it with the
446 minibuffer.
448 This function is usually the wrong thing to use in a Lisp program.
449 What you probably want is a loop like this:
450 (while (search-forward FROM-STRING nil t)
451 (replace-match TO-STRING nil t))
452 which 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
454 and TO-STRING is also null.)"
455 (interactive
456 (let ((common
457 (query-replace-read-args
458 (concat "Replace"
459 (if current-prefix-arg " word" "")
460 " string"
461 (if (and transient-mark-mode mark-active) " in region" ""))
462 nil)))
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)))))
468 (perform-replace from-string to-string nil nil delimited nil nil start end))
470 (defun replace-regexp (regexp to-string &optional delimited start end)
471 "Replace things after point matching REGEXP with TO-STRING.
472 Preserve case in each match if `case-replace' and `case-fold-search'
473 are non-nil and REGEXP has no uppercase letters.
475 In Transient Mark mode, if the mark is active, operate on the contents
476 of the region. Otherwise, operate from point to the end of the buffer.
478 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
479 only matches surrounded by word boundaries.
480 Fourth and fifth arg START and END specify the region to operate on.
482 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
483 and `\\=\\N' (where N is a digit) stands for
484 whatever what matched the Nth `\\(...\\)' in REGEXP.
485 `\\?' lets you edit the replacement text in the minibuffer
486 at the given position for each replacement.
488 In interactive calls, the replacement text may contain `\\,'
489 followed by a Lisp expression used as part of the replacement
490 text. Inside of that expression, `\\&' is a string denoting the
491 whole match, `\\N' a partial match, `\\#&' and `\\#N' the respective
492 numeric values from `string-to-number', and `\\#' itself for
493 `replace-count', the number of replacements occurred so far.
495 If your Lisp expression is an identifier and the next letter in
496 the replacement string would be interpreted as part of it, you
497 can wrap it with an expression like `\\,(or \\#)'. Incidentally,
498 for this particular case you may also enter `\\#' in the
499 replacement text directly.
501 When using those Lisp features interactively in the replacement
502 text, TO-STRING is actually made a list instead of a string.
503 Use \\[repeat-complex-command] after this command for details.
505 If `query-replace-interactive' is non-nil, the last incremental search
506 regexp is used as REGEXP--you don't have to specify it with the minibuffer.
508 This function is usually the wrong thing to use in a Lisp program.
509 What you probably want is a loop like this:
510 (while (re-search-forward REGEXP nil t)
511 (replace-match TO-STRING nil nil))
512 which will run faster and will not set the mark or print anything."
513 (interactive
514 (let ((common
515 (query-replace-read-args
516 (concat "Replace"
517 (if current-prefix-arg " word" "")
518 " regexp"
519 (if (and transient-mark-mode mark-active) " in region" ""))
520 t)))
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)))))
526 (perform-replace regexp to-string nil t delimited nil nil start end))
529 (defvar regexp-history nil
530 "History list for some commands that read regular expressions.
532 Maximum length of the history list is determined by the value
533 of `history-length', which see.")
535 (defun read-regexp (prompt &optional default-value)
536 "Read regexp as a string using the regexp history and some useful defaults.
537 Prompt for a regular expression with PROMPT (without a colon and
538 space) in the minibuffer. The optional argument DEFAULT-VALUE
539 provides the value to display in the minibuffer prompt that is
540 returned if the user just types RET.
541 Values available via M-n are the string at point, the last isearch
542 regexp, the last isearch string, and the last replacement regexp."
543 (let* ((defaults
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
558 (if default-value
559 (format "%s (default %s): " prompt
560 (query-replace-descr default-value))
561 (format "%s: " prompt))
562 nil nil nil 'regexp-history defaults t)))
563 (if (equal input "")
564 (or default-value input)
565 (prog1 input
566 (add-to-history 'regexp-history input)))))
569 (defalias 'delete-non-matching-lines 'keep-lines)
570 (defalias 'delete-matching-lines 'flush-lines)
571 (defalias 'count-matches 'how-many)
574 (defun keep-lines-read-args (prompt)
575 "Read arguments for `keep-lines' and friends.
576 Prompt for a regexp with PROMPT.
577 Value is a list, (REGEXP)."
578 (list (read-regexp prompt) nil nil t))
580 (defun keep-lines (regexp &optional rstart rend interactive)
581 "Delete all lines except those containing matches for REGEXP.
582 A match split across lines preserves all the lines it lies in.
583 When called from Lisp (and usually interactively as well, see below)
584 applies to all lines starting after point.
586 If REGEXP contains upper case characters (excluding those preceded by `\\')
587 and `search-upper-case' is non-nil, the matching is case-sensitive.
589 Second and third arg RSTART and REND specify the region to operate on.
590 This command operates on (the accessible part of) all lines whose
591 accessible part is entirely contained in the region determined by RSTART
592 and REND. (A newline ending a line counts as part of that line.)
594 Interactively, in Transient Mark mode when the mark is active, operate
595 on all lines whose accessible part is entirely contained in the region.
596 Otherwise, the command applies to all lines starting after point.
597 When calling this function from Lisp, you can pretend that it was
598 called interactively by passing a non-nil INTERACTIVE argument.
600 This function starts looking for the next match from the end of
601 the previous match. Hence, it ignores matches that overlap
602 a previously found match."
604 (interactive
605 (progn
606 (barf-if-buffer-read-only)
607 (keep-lines-read-args "Keep lines containing match for regexp")))
608 (if rstart
609 (progn
610 (goto-char (min rstart rend))
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)
619 (setq rstart (region-beginning)
620 rend (progn
621 (goto-char (region-end))
622 (unless (or (bolp) (eobp))
623 (forward-line 0))
624 (point-marker)))
625 (setq rstart (point)
626 rend (point-max-marker)))
627 (goto-char rstart))
628 (save-excursion
629 (or (bolp) (forward-line 1))
630 (let ((start (point))
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)))
635 (while (< (point) rend)
636 ;; Start is first char not preserved by previous match.
637 (if (not (re-search-forward regexp rend 'move))
638 (delete-region start rend)
639 (let ((end (save-excursion (goto-char (match-beginning 0))
640 (forward-line 0)
641 (point))))
642 ;; Now end is first char preserved by the new match.
643 (if (< start end)
644 (delete-region start end))))
646 (setq start (save-excursion (forward-line 1) (point)))
647 ;; If the match was empty, avoid matching again at same place.
648 (and (< (point) rend)
649 (= (match-beginning 0) (match-end 0))
650 (forward-char 1)))))
651 (set-marker rend nil)
652 nil)
655 (defun flush-lines (regexp &optional rstart rend interactive)
656 "Delete lines containing matches for REGEXP.
657 When called from Lisp (and usually when called interactively as
658 well, see below), applies to the part of the buffer after point.
659 The line point is in is deleted if and only if it contains a
660 match for regexp starting after point.
662 If REGEXP contains upper case characters (excluding those preceded by `\\')
663 and `search-upper-case' is non-nil, the matching is case-sensitive.
665 Second and third arg RSTART and REND specify the region to operate on.
666 Lines partially contained in this region are deleted if and only if
667 they contain a match entirely contained in it.
669 Interactively, in Transient Mark mode when the mark is active, operate
670 on the contents of the region. Otherwise, operate from point to the
671 end of (the accessible portion of) the buffer. When calling this function
672 from Lisp, you can pretend that it was called interactively by passing
673 a non-nil INTERACTIVE argument.
675 If a match is split across lines, all the lines it lies in are deleted.
676 They are deleted _before_ looking for the next match. Hence, a match
677 starting on the same line at which another match ended is ignored."
679 (interactive
680 (progn
681 (barf-if-buffer-read-only)
682 (keep-lines-read-args "Flush lines containing match for regexp")))
683 (if rstart
684 (progn
685 (goto-char (min rstart rend))
686 (setq rend (copy-marker (max rstart rend))))
687 (if (and interactive transient-mark-mode mark-active)
688 (setq rstart (region-beginning)
689 rend (copy-marker (region-end)))
690 (setq rstart (point)
691 rend (point-max-marker)))
692 (goto-char rstart))
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)))
697 (save-excursion
698 (while (and (< (point) rend)
699 (re-search-forward regexp rend t))
700 (delete-region (save-excursion (goto-char (match-beginning 0))
701 (forward-line 0)
702 (point))
703 (progn (forward-line 1) (point))))))
704 (set-marker rend nil)
705 nil)
708 (defun how-many (regexp &optional rstart rend interactive)
709 "Print and return number of matches for REGEXP following point.
710 When called from Lisp and INTERACTIVE is omitted or nil, just return
711 the number, do not print it; if INTERACTIVE is t, the function behaves
712 in all respects as if it had been called interactively.
714 If REGEXP contains upper case characters (excluding those preceded by `\\')
715 and `search-upper-case' is non-nil, the matching is case-sensitive.
717 Second and third arg RSTART and REND specify the region to operate on.
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.
723 This function starts looking for the next match from the end of
724 the previous match. Hence, it ignores matches that overlap
725 a previously found match."
727 (interactive
728 (keep-lines-read-args "How many matches for regexp"))
729 (save-excursion
730 (if rstart
731 (progn
732 (goto-char (min rstart rend))
733 (setq rend (max rstart rend)))
734 (if (and interactive transient-mark-mode mark-active)
735 (setq rstart (region-beginning)
736 rend (region-end))
737 (setq rstart (point)
738 rend (point-max)))
739 (goto-char rstart))
740 (let ((count 0)
741 opoint
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)))
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))))
752 (when interactive (message "%d occurrence%s"
753 count
754 (if (= count 1) "" "s")))
755 count)))
758 (defvar occur-mode-map
759 (let ((map (make-sparse-keymap)))
760 ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
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)
764 (define-key map "o" 'occur-mode-goto-occurrence-other-window)
765 (define-key map "\C-o" 'occur-mode-display-occurrence)
766 (define-key map "\M-n" 'occur-next)
767 (define-key map "\M-p" 'occur-prev)
768 (define-key map "r" 'occur-rename-buffer)
769 (define-key map "c" 'clone-buffer)
770 (define-key map "g" 'revert-buffer)
771 (define-key map "q" 'quit-window)
772 (define-key map "z" 'kill-this-buffer)
773 (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
774 (define-key map [menu-bar] (make-sparse-keymap))
775 (define-key map [menu-bar occur]
776 `(cons ,(purecopy "Occur") map))
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"))
781 (define-key map [separator-1] menu-bar-separator)
782 (define-key map [kill-this-buffer]
783 `(menu-item ,(purecopy "Kill occur buffer") kill-this-buffer
784 :help ,(purecopy "Kill the current *Occur* buffer")))
785 (define-key map [quit-window]
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")))
788 (define-key map [revert-buffer]
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")))
791 (define-key map [clone-buffer]
792 `(menu-item ,(purecopy "Clone occur buffer") clone-buffer
793 :help ,(purecopy "Create and return a twin copy of the current *Occur* buffer")))
794 (define-key map [occur-rename-buffer]
795 `(menu-item ,(purecopy "Rename occur buffer") occur-rename-buffer
796 :help ,(purecopy "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")))
797 (define-key map [separator-2] menu-bar-separator)
798 (define-key map [occur-mode-goto-occurrence-other-window]
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")))
801 (define-key map [occur-mode-goto-occurrence]
802 `(menu-item ,(purecopy "Go To Occurrence") occur-mode-goto-occurrence
803 :help ,(purecopy "Go to the occurrence the current line describes")))
804 (define-key map [occur-mode-display-occurrence]
805 `(menu-item ,(purecopy "Display Occurrence") occur-mode-display-occurrence
806 :help ,(purecopy "Display in another window the occurrence the current line describes")))
807 (define-key map [occur-next]
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")))
810 (define-key map [occur-prev]
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")))
813 map)
814 "Keymap for `occur-mode'.")
816 (defvar occur-revert-arguments nil
817 "Arguments to pass to `occur-1' to revert an Occur mode buffer.
818 See `occur-revert-function'.")
820 (defcustom occur-mode-hook '(turn-on-font-lock)
821 "Hook run when entering Occur mode."
822 :type 'hook
823 :group 'matching)
825 (defcustom occur-hook nil
826 "Hook run by Occur when there are any matches."
827 :type 'hook
828 :group 'matching)
830 (defcustom occur-mode-find-occurrence-hook nil
831 "Hook run by Occur after locating an occurrence.
832 This will be called with the cursor position at the occurrence. An application
833 for this is to reveal context in an outline-mode when the occurrence is hidden."
834 :type 'hook
835 :group 'matching)
837 (put 'occur-mode 'mode-class 'special)
838 (defun occur-mode ()
839 "Major mode for output from \\[occur].
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.
842 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
844 \\{occur-mode-map}"
845 (interactive)
846 (kill-all-local-variables)
847 (use-local-map occur-mode-map)
848 (setq major-mode 'occur-mode)
849 (setq mode-name "Occur")
850 (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
851 (make-local-variable 'occur-revert-arguments)
852 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
853 (setq next-error-function 'occur-next-error)
854 (run-mode-hooks 'occur-mode-hook))
856 (defun occur-revert-function (ignore1 ignore2)
857 "Handle `revert-buffer' for Occur mode buffers."
858 (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
860 (defun occur-mode-find-occurrence ()
861 (let ((pos (get-text-property (point) 'occur-target)))
862 (unless pos
863 (error "No occurrence on this line"))
864 (unless (buffer-live-p (marker-buffer pos))
865 (error "Buffer for this occurrence was killed"))
866 pos))
868 (defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
869 (defun occur-mode-goto-occurrence (&optional event)
870 "Go to the occurrence the current line describes."
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)
884 (pop-to-buffer (marker-buffer pos))
885 (goto-char pos)
886 (run-hooks 'occur-mode-find-occurrence-hook)))
888 (defun occur-mode-goto-occurrence-other-window ()
889 "Go to the occurrence the current line describes, in another window."
890 (interactive)
891 (let ((pos (occur-mode-find-occurrence)))
892 (switch-to-buffer-other-window (marker-buffer pos))
893 (goto-char pos)
894 (run-hooks 'occur-mode-find-occurrence-hook)))
896 (defun occur-mode-display-occurrence ()
897 "Display in another window the occurrence the current line describes."
898 (interactive)
899 (let ((pos (occur-mode-find-occurrence))
900 window
901 ;; Bind these to ensure `display-buffer' puts it in another window.
902 same-window-buffer-names
903 same-window-regexps)
904 (setq window (display-buffer (marker-buffer pos)))
905 ;; This is the way to set point in the proper window.
906 (save-selected-window
907 (select-window window)
908 (goto-char pos)
909 (run-hooks 'occur-mode-find-occurrence-hook))))
911 (defun occur-find-match (n search message)
912 (if (not n) (setq n 1))
913 (let ((r))
914 (while (> n 0)
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)))
919 (if r
920 (goto-char r)
921 (error message))
922 (setq n (1- n)))))
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"))
929 (defun occur-prev (&optional n)
930 "Move to the Nth (default 1) previous match in an Occur mode buffer."
931 (interactive "p")
932 (occur-find-match n #'previous-single-property-change "No earlier matches"))
934 (defun occur-next-error (&optional argp reset)
935 "Move to the Nth (default 1) next match in an Occur mode buffer.
936 Compatibility function for \\[next-error] invocations."
937 (interactive "p")
938 ;; we need to run occur-find-match from within the Occur buffer
939 (with-current-buffer
940 ;; Choose the buffer and make it current.
941 (if (next-error-buffer-p (current-buffer))
942 (current-buffer)
943 (next-error-find-buffer nil nil
944 (lambda ()
945 (eq major-mode 'occur-mode))))
947 (goto-char (cond (reset (point-min))
948 ((< argp 0) (line-beginning-position))
949 ((> argp 0) (line-end-position))
950 ((point))))
951 (occur-find-match
952 (abs argp)
953 (if (> 0 argp)
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.
958 (let ((win (get-buffer-window (current-buffer) t)))
959 (if win (set-window-point win (point))))
960 (occur-mode-goto-occurrence)))
962 (defface match
963 '((((class color) (min-colors 88) (background light))
964 :background "yellow1")
965 (((class color) (min-colors 88) (background dark))
966 :background "RoyalBlue3")
967 (((class color) (min-colors 8) (background light))
968 :background "yellow" :foreground "black")
969 (((class color) (min-colors 8) (background dark))
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
976 :version "22.1")
978 (defcustom list-matching-lines-default-context-lines 0
979 "Default number of context lines included around `list-matching-lines' matches.
980 A negative number means to include that many lines before the match.
981 A positive number means to include that many lines both before and after."
982 :type 'integer
983 :group 'matching)
985 (defalias 'list-matching-lines 'occur)
987 (defcustom list-matching-lines-face 'match
988 "Face used by \\[list-matching-lines] to show the text that matches.
989 If the value is nil, don't highlight the matching portions specially."
990 :type 'face
991 :group 'matching)
993 (defcustom list-matching-lines-buffer-name-face 'underline
994 "Face used by \\[list-matching-lines] to show the names of buffers.
995 If the value is nil, don't highlight the buffer names specially."
996 :type 'face
997 :group 'matching)
999 (defcustom occur-excluded-properties
1000 '(read-only invisible intangible field mouse-face help-echo local-map keymap
1001 yank-handler follow-link)
1002 "Text properties to discard when copying lines to the *Occur* buffer.
1003 The value should be a list of text properties to discard or t,
1004 which means to discard all text properties."
1005 :type '(choice (const :tag "All" t) (repeat symbol))
1006 :group 'matching
1007 :version "22.1")
1009 (defun occur-read-primary-args ()
1010 (list (read-regexp "List lines matching regexp"
1011 (car regexp-history))
1012 (when current-prefix-arg
1013 (prefix-numeric-value current-prefix-arg))))
1015 (defun occur-rename-buffer (&optional unique-p interactive-p)
1016 "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
1017 Here `original-buffer-name' is the buffer name where Occur was originally run.
1018 When given the prefix argument, or called non-interactively, the renaming
1019 will not clobber the existing buffer(s) of that name, but use
1020 `generate-new-buffer-name' instead. You can add this to `occur-hook'
1021 if you always want a separate *Occur* buffer for each buffer where you
1022 invoke `occur'."
1023 (interactive "P\np")
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 "*")
1030 (or unique-p (not interactive-p)))))
1032 (defun occur (regexp &optional nlines)
1033 "Show all lines in the current buffer containing a match for REGEXP.
1034 If a match spreads across multiple lines, all those lines are shown.
1036 Each line is displayed with NLINES lines before and after, or -NLINES
1037 before if NLINES is negative.
1038 NLINES defaults to `list-matching-lines-default-context-lines'.
1039 Interactively it is the prefix arg.
1041 The lines are shown in a buffer named `*Occur*'.
1042 It serves as a menu to find any of the occurrences in this buffer.
1043 \\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
1045 If REGEXP contains upper case characters (excluding those preceded by `\\')
1046 and `search-upper-case' is non-nil, the matching is case-sensitive."
1047 (interactive (occur-read-primary-args))
1048 (occur-1 regexp nlines (list (current-buffer))))
1050 (defun multi-occur (bufs regexp &optional nlines)
1051 "Show all lines in buffers BUFS containing a match for REGEXP.
1052 This function acts on multiple buffers; otherwise, it is exactly like
1053 `occur'. When you invoke this command interactively, you must specify
1054 the buffer names that you want, one by one."
1055 (interactive
1056 (cons
1057 (let* ((bufs (list (read-buffer "First buffer to search: "
1058 (current-buffer) t)))
1059 (buf nil)
1060 (ido-ignore-item-temp-list bufs))
1061 (while (not (string-equal
1062 (setq buf (read-buffer
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))
1067 ""))
1068 (add-to-list 'bufs buf)
1069 (setq ido-ignore-item-temp-list bufs))
1070 (nreverse (mapcar #'get-buffer bufs)))
1071 (occur-read-primary-args)))
1072 (occur-1 regexp nlines bufs))
1074 (defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs)
1075 "Show all lines matching REGEXP in buffers specified by BUFREGEXP.
1076 Normally BUFREGEXP matches against each buffer's visited file name,
1077 but if you specify a prefix argument, it matches against the buffer name.
1078 See also `multi-occur'."
1079 (interactive
1080 (cons
1081 (let* ((default (car regexp-history))
1082 (input
1083 (read-from-minibuffer
1084 (if current-prefix-arg
1085 "List lines in buffers whose names match regexp: "
1086 "List lines in buffers whose filenames match regexp: ")
1090 'regexp-history)))
1091 (if (equal input "")
1092 default
1093 input))
1094 (occur-read-primary-args)))
1095 (when bufregexp
1096 (occur-1 regexp nil
1097 (delq nil
1098 (mapcar (lambda (buf)
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))))
1105 buf))
1106 (buffer-list))))))
1108 (defun occur-1 (regexp nlines bufs &optional buf-name)
1109 (unless (and regexp (not (equal regexp "")))
1110 (error "Occur doesn't work with the empty regexp"))
1111 (unless buf-name
1112 (setq buf-name "*Occur*"))
1113 (let (occur-buf
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
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)))
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))
1127 (with-current-buffer occur-buf
1128 (occur-mode)
1129 (let ((inhibit-read-only t)
1130 ;; Don't generate undo entries for creation of the initial contents.
1131 (buffer-undo-list t))
1132 (erase-buffer)
1133 (let ((count (occur-engine
1134 regexp active-bufs occur-buf
1135 (or nlines list-matching-lines-default-context-lines)
1136 (if (and case-fold-search search-upper-case)
1137 (isearch-no-upper-case-p regexp t)
1138 case-fold-search)
1139 list-matching-lines-buffer-name-face
1140 nil list-matching-lines-face
1141 (not (eq occur-excluded-properties t)))))
1142 (let* ((bufcount (length active-bufs))
1143 (diff (- (length bufs) bufcount)))
1144 (message "Searched %d buffer%s%s; %s match%s%s"
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")
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)))))
1153 (setq occur-revert-arguments (list regexp nlines bufs))
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)))))))
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
1165 (let ((globalcount 0)
1166 (coding nil))
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
1172 (prev-after-lines nil) ;; context lines of prev match
1173 (prev-lines nil) ;; line number of prev match endpt
1174 (matchbeg 0)
1175 (origpt nil)
1176 (begpt nil)
1177 (endpt nil)
1178 (marker nil)
1179 (curstring "")
1180 (ret nil)
1181 (inhibit-field-text-motion t)
1182 (headerpt (with-current-buffer out-buf (point))))
1183 (with-current-buffer buf
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))
1189 (save-excursion
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
1195 (setq matchbeg (match-beginning 0))
1196 ;; Get beginning of first match line and end of the last.
1197 (save-excursion
1198 (goto-char matchbeg)
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)))
1204 (setq marker (make-marker))
1205 (set-marker marker matchbeg)
1206 (setq curstring (occur-engine-line begpt endpt keep-props))
1207 ;; Highlight the matches
1208 (let ((len (length curstring))
1209 (start 0))
1210 (while (and (< start len)
1211 (string-match regexp curstring start))
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)
1221 (setq start (match-end 0))))
1222 ;; Generate the string to insert for this match
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
1242 (concat
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)
1250 ;; Add marker at eol, but no mouse props.
1251 (propertize "\n" 'occur-target marker)))
1252 (data
1253 (if (= nlines 0)
1254 ;; The simple display style
1255 out-line
1256 ;; The complex multi-line display style.
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))))
1264 ;; Actually insert the match display data
1265 (with-current-buffer out-buf
1266 (let ((beg (point))
1267 (end (progn (insert data) (point)))))))
1268 (goto-char endpt))
1269 (if endpt
1270 (progn
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)))
1276 ;; On to the next match...
1277 (forward-line 1))
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)))))))
1285 (when (not (zerop matches)) ;; is the count zero?
1286 (setq globalcount (+ globalcount matches))
1287 (with-current-buffer out-buf
1288 (goto-char headerpt)
1289 (let ((beg (point))
1290 end)
1291 (insert (format "%d match%s%s in buffer: %s\n"
1292 matches (if (= matches 1) "" "es")
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)))
1298 (setq end (point))
1299 (add-text-properties beg end
1300 (append
1301 (when title-face
1302 `(font-lock-face ,title-face))
1303 `(occur-title ,buf))))
1304 (goto-char (point-min)))))))
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)))
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))
1322 ;; Return the number of matches
1323 globalcount)))
1325 (defun occur-engine-line (beg end &optional keep-props)
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)))
1337 (defun occur-engine-add-prefix (lines)
1338 (mapcar
1339 #'(lambda (line)
1340 (concat " :" line "\n"))
1341 lines))
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))))
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.
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.
1366 ;; Generate a list of lines, add prefixes to all but OUT-LINE,
1367 ;; then concatenate them all together.
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)
1379 ;; Combine after-lines of the previous match
1380 ;; with before-lines of the current match.
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")))
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"))))
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))))
1418 ;; It would be nice to use \\[...], but there is no reasonable way
1419 ;; to make that display both SPC and Y.
1420 (defconst query-replace-help
1421 "Type Space or `y' to replace one match, Delete or `n' to skip to next,
1422 RET or `q' to exit, Period to replace one match and exit,
1423 Comma to replace but not move point immediately,
1424 C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
1425 C-w to delete match and recursive edit,
1426 C-l to clear the screen, redisplay, and offer same replacement again,
1427 ! to replace all remaining matches with no more questions,
1428 ^ to move point back to previous match,
1429 E to edit the replacement string"
1430 "Help message while in `query-replace'.")
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)
1463 "Keymap that defines the responses to questions in `query-replace'.
1464 The \"bindings\" in this map are not commands; they are answers.
1465 The valid answers include `act', `skip', `act-and-show',
1466 `exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
1467 `automatic', `backup', `exit-prefix', and `help'.")
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.
1476 It extends its parent map `query-replace-map' with new bindings to
1477 operate on a set of buffers/files. The difference with its parent map
1478 is the additional answers `automatic-all' to replace all remaining
1479 matches in all remaining buffers with no more questions, and
1480 `exit-current' to skip remaining matches in the current buffer
1481 and to continue with the next buffer in the sequence.")
1483 (defun replace-match-string-symbols (n)
1484 "Process a list (and any sub-lists), expanding certain symbols.
1485 Symbol Expands To
1486 N (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))
1490 # replace-count
1492 Note that these symbols must be preceeded by a backslash in order to
1493 type them using Lisp syntax."
1494 (while (consp n)
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)
1510 (setcar n '(string-to-number (match-string 0))))
1511 ((string= "#" name)
1512 (setcar n 'replace-count))))))
1513 (setq n (cdr n))))
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))))
1521 (defun replace-quote (replacement)
1522 "Quote a replacement string.
1523 This just doubles all backslashes in REPLACEMENT and
1524 returns the resulting string. If REPLACEMENT is not
1525 a string, it is first passed through `prin1-to-string'
1526 with the `noescape' argument set.
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)))
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)))
1549 (defun replace-match-data (integers reuse &optional new)
1550 "Like `match-data', but markers in REUSE get invalidated.
1551 If NEW is non-nil, it is set and returned instead of fresh data,
1552 but 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)))
1559 (match-data integers reuse t)))
1561 (defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data)
1562 "Make a replacement with `replace-match', editing `\\?'.
1563 NEWTEXT, FIXEDCASE, LITERAL are just passed on. If NOEDIT is true, no
1564 check for `\\?' is made to save time. MATCH-DATA is used for the
1565 replacement. In case editing is done, it is changed to use markers.
1567 The return value is non-nil if there has been no `\\?' or NOEDIT was
1568 passed 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
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))))
1582 noedit nil)))
1583 (set-match-data match-data)
1584 (replace-match newtext fixedcase literal)
1585 noedit)
1587 (defvar replace-search-function 'search-forward
1588 "Function to use when searching for strings to replace.
1589 It is used by `query-replace' and `replace-string', and is called
1590 with three arguments, as if it were `search-forward'.")
1592 (defvar replace-re-search-function 're-search-forward
1593 "Function to use when searching for regexps to replace.
1594 It is used by `query-replace-regexp', `replace-regexp',
1595 `query-replace-regexp-eval', and `map-query-replace-regexp'.
1596 It is called with three arguments, as if it were
1597 `re-search-forward'.")
1599 (defun perform-replace (from-string replacements
1600 query-flag regexp-flag delimited-flag
1601 &optional repeat-count map start end)
1602 "Subroutine of `query-replace'. Its complexity handles interactive queries.
1603 Don't use this in your own program unless you want to query and set the mark
1604 just as `query-replace' does. Instead, write a simple loop like this:
1606 (while (re-search-forward \"foo[ \\t]+bar\" nil t)
1607 (replace-match \"foobar\" nil nil))
1609 which will run faster and probably do exactly what you want. Please
1610 see the documentation of `replace-match' to find out how to simulate
1611 `case-replace'.
1613 This function returns nil if and only if there were no matches to
1614 make, or the user didn't cancel the call."
1615 (or map (setq map query-replace-map))
1616 (and query-flag minibuffer-auto-raise
1617 (raise-frame (window-frame (minibuffer-window))))
1618 (let* ((case-fold-search
1619 (if (and case-fold-search search-upper-case)
1620 (isearch-no-upper-case-p from-string regexp-flag)
1621 case-fold-search))
1622 (nocasify (not (and case-replace case-fold-search)))
1623 (literal (or (not regexp-flag) (eq regexp-flag 'literal)))
1624 (search-function
1625 (if regexp-flag
1626 replace-re-search-function
1627 replace-search-function))
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)
1638 (multi-buffer nil)
1639 (recenter-last-op nil) ; Start cycling order with initial position.
1641 ;; If non-nil, it is marker saying where in the buffer to stop.
1642 (limit nil)
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)
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))))
1655 ;; If region is active, in Transient Mark mode, operate on region.
1656 (when start
1657 (setq limit (copy-marker (max start end)))
1658 (goto-char (min start end))
1659 (deactivate-mark))
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
1663 (when (eq (lookup-key map (vector last-input-event)) 'automatic-all)
1664 (setq query-flag nil multi-buffer t))
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)))))
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")))
1687 (when query-replace-lazy-highlight
1688 (setq isearch-lazy-highlight-last-string nil))
1690 (push-mark)
1691 (undo-boundary)
1692 (unwind-protect
1693 ;; Loop finding occurrences that perhaps should be replaced.
1694 (while (and keep-going
1695 (not (or (eobp) (and limit (>= (point) limit))))
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
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))))))
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)))
1735 ;; If the match is empty, record that the next one can't be
1736 ;; adjacent.
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))))))
1750 ;; Optionally ignore matches that have a read-only property.
1751 (unless (and query-replace-skip-read-only
1752 (text-property-not-all
1753 (nth 0 real-match-data) (nth 1 real-match-data)
1754 'read-only nil))
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)
1761 replace-count)))
1762 (if (not query-flag)
1763 (progn
1764 (unless (or literal noedit)
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))
1769 (setq noedit
1770 (replace-match-maybe-edit
1771 next-replacement nocasify literal
1772 noedit real-match-data)
1773 replace-count (1+ replace-count)))
1774 (undo-boundary)
1775 (let (done replaced key def)
1776 ;; Loop reading commands until one of them sets done,
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'.
1782 (while (not done)
1783 (set-match-data real-match-data)
1784 (replace-highlight
1785 (match-beginning 0) (match-end 0)
1786 start end search-string
1787 (or delimited-flag regexp-flag) case-fold-search)
1788 ;; Bind message-log-max so we don't fill up the message log
1789 ;; with a bunch of identical messages.
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)))
1798 (message message
1799 (query-replace-descr from-string)
1800 (query-replace-descr replacement-presentation)))
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 "
1812 (if delimited-flag "word " "")
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))
1823 ((eq def 'exit-current)
1824 (setq multi-buffer t keep-going nil done t))
1825 ((eq def 'backup)
1826 (if stack
1827 (let ((elt (pop stack)))
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))))
1834 (message "No previous match")
1835 (ding 'no-terminate)
1836 (sit-for 1)))
1837 ((eq def 'act)
1838 (or replaced
1839 (setq noedit
1840 (replace-match-maybe-edit
1841 next-replacement nocasify literal
1842 noedit real-match-data)
1843 replace-count (1+ replace-count)))
1844 (setq done t replaced t))
1845 ((eq def 'act-and-exit)
1846 (or replaced
1847 (setq noedit
1848 (replace-match-maybe-edit
1849 next-replacement nocasify literal
1850 noedit real-match-data)
1851 replace-count (1+ replace-count)))
1852 (setq keep-going nil)
1853 (setq done t replaced t))
1854 ((eq def 'act-and-show)
1855 (if (not replaced)
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)))
1864 ((or (eq def 'automatic) (eq def 'automatic-all))
1865 (or replaced
1866 (setq noedit
1867 (replace-match-maybe-edit
1868 next-replacement nocasify literal
1869 noedit real-match-data)
1870 replace-count (1+ replace-count)))
1871 (setq done t query-flag nil replaced t)
1872 (if (eq def 'automatic-all) (setq multi-buffer t)))
1873 ((eq def 'skip)
1874 (setq done t))
1875 ((eq def 'recenter)
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)))
1882 ((eq def 'edit)
1883 (let ((opos (point-marker)))
1884 (setq real-match-data (replace-match-data
1885 nil real-match-data
1886 real-match-data))
1887 (goto-char (match-beginning 0))
1888 (save-excursion
1889 (save-window-excursion
1890 (recursive-edit)))
1891 (goto-char opos)
1892 (set-marker opos nil))
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)))))
1899 ;; Edit replacement.
1900 ((eq def 'edit-replacement)
1901 (setq real-match-data (replace-match-data
1902 nil real-match-data
1903 real-match-data)
1904 next-replacement
1905 (read-string "Edit replacement string: "
1906 next-replacement)
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))
1915 (setq done t))
1917 ((eq def 'delete-and-edit)
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))
1923 (setq replaced t))
1924 ;; Note: we do not need to treat `exit-prefix'
1925 ;; specially here, since we reread
1926 ;; any unrecognized character.
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))
1933 (setq done t)))
1934 (when query-replace-lazy-highlight
1935 ;; Force lazy rehighlighting only after replacements.
1936 (if (not (memq def '(skip backup)))
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)))
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.
1944 (push (list (point) replaced
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.
1954 (if replaced
1955 (list
1956 (match-beginning 0)
1957 (match-end 0)
1958 (current-buffer))
1959 (match-data t)))
1960 stack)))))
1962 (replace-dehighlight))
1963 (or unread-command-events
1964 (message "Replaced %d occurrence%s"
1965 replace-count
1966 (if (= replace-count 1) "" "s")))
1967 (or (and keep-going stack) multi-buffer)))
1969 (defvar replace-overlay nil)
1971 (defun replace-highlight (match-beg match-end range-beg range-end
1972 string regexp case-fold)
1973 (if query-replace-highlight
1974 (if replace-overlay
1975 (move-overlay replace-overlay match-beg match-end (current-buffer))
1976 (setq replace-overlay (make-overlay match-beg match-end))
1977 (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
1978 (overlay-put replace-overlay 'face 'query-replace)))
1979 (if query-replace-lazy-highlight
1980 (let ((isearch-string string)
1981 (isearch-regexp regexp)
1982 (search-whitespace-regexp nil)
1983 (isearch-case-fold-search case-fold)
1984 (isearch-forward t)
1985 (isearch-error nil))
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))
1989 (isearch-lazy-highlight-new-loop range-beg range-end))))
1991 (defun replace-dehighlight ()
1992 (when replace-overlay
1993 (delete-overlay replace-overlay))
1994 (when query-replace-lazy-highlight
1995 (lazy-highlight-cleanup lazy-highlight-cleanup)
1996 (setq isearch-lazy-highlight-last-string nil)))
1998 ;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
1999 ;;; replace.el ends here