(rmail-get-new-mail): Position on first unseen message.
[bpt/emacs.git] / lisp / replace.el
CommitLineData
c88ab9ce
ER
1;;; replace.el --- replace commands for Emacs.
2
eab69997 3;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
3a801d0c 4
698e1804
RS
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
e5d77022 9;; the Free Software Foundation; either version 2, or (at your option)
698e1804
RS
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to
19;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20
d9ecc911
ER
21;;; Commentary:
22
23;; This package supplies the string and regular-expression replace functions
24;; documented in the Emacs user's manual.
25
4f4b8eff 26;;; Code:
698e1804 27
73fa8346
BP
28(defconst case-replace t "\
29*Non-nil means query-replace should preserve case in replacements.")
77176e73 30
770970cb
RS
31(defvar query-replace-history nil)
32
151270f3
RS
33(defvar query-replace-interactive nil
34 "Non-nil means `query-replace' uses the last search string.
35That becomes the \"string to replace\".")
36
37(defun query-replace-read-args (string regexp-flag)
770970cb 38 (let (from to)
151270f3
RS
39 (if query-replace-interactive
40 (setq from (car (if regexp-flag regexp-search-ring search-ring)))
41 (setq from (read-from-minibuffer (format "%s: " string)
42 nil nil nil
43 'query-replace-history)))
770970cb
RS
44 (setq to (read-from-minibuffer (format "%s %s with: " string from)
45 nil nil nil
46 'query-replace-history))
47 (list from to current-prefix-arg)))
48
da44e784
RM
49(defun query-replace (from-string to-string &optional arg)
50 "Replace some occurrences of FROM-STRING with TO-STRING.
51As each match is found, the user must type a character saying
52what to do with it. For directions, type \\[help-command] at that time.
53
151270f3
RS
54If `query-replace-interactive' is non-nil, the last incremental search
55string is used as FROM-STRING--you don't have to specify it with the
56minibuffer.
57
118a01c9 58Preserves case in each replacement if `case-replace' and `case-fold-search'
da44e784 59are non-nil and FROM-STRING has no uppercase letters.
118a01c9 60Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
81bdc14d
RS
61only matches surrounded by word boundaries.
62
63To customize possible responses, change the \"bindings\" in `query-replace-map'."
151270f3 64 (interactive (query-replace-read-args "Query replace" nil))
da44e784 65 (perform-replace from-string to-string t nil arg)
81bdc14d 66 (or unread-command-events (message "Done")))
73fa8346 67(define-key esc-map "%" 'query-replace)
da44e784 68
da44e784
RM
69(defun query-replace-regexp (regexp to-string &optional arg)
70 "Replace some things after point matching REGEXP with TO-STRING.
71As each match is found, the user must type a character saying
72what to do with it. For directions, type \\[help-command] at that time.
73
151270f3
RS
74If `query-replace-interactive' is non-nil, the last incremental search
75regexp is used as REGEXP--you don't have to specify it with the
76minibuffer.
77
118a01c9 78Preserves case in each replacement if `case-replace' and `case-fold-search'
da44e784 79are non-nil and REGEXP has no uppercase letters.
118a01c9 80Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
da44e784 81only matches surrounded by word boundaries.
118a01c9
RS
82In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
83and `\\=\\N' (where N is a digit) stands for
84 whatever what matched the Nth `\\(...\\)' in REGEXP."
151270f3 85 (interactive (query-replace-read-args "Query replace regexp" t))
da44e784 86 (perform-replace regexp to-string t t arg)
81bdc14d 87 (or unread-command-events (message "Done")))
da44e784 88
da44e784
RM
89(defun map-query-replace-regexp (regexp to-strings &optional arg)
90 "Replace some matches for REGEXP with various strings, in rotation.
91The second argument TO-STRINGS contains the replacement strings, separated
92by spaces. This command works like `query-replace-regexp' except
93that each successive replacement uses the next successive replacement string,
94wrapping around from the last such string to the first.
95
96Non-interactively, TO-STRINGS may be a list of replacement strings.
97
151270f3
RS
98If `query-replace-interactive' is non-nil, the last incremental search
99regexp is used as REGEXP--you don't have to specify it with the minibuffer.
100
da44e784
RM
101A prefix argument N says to use each replacement string N times
102before rotating to the next."
770970cb
RS
103 (interactive
104 (let (from to)
151270f3
RS
105 (setq from (if query-replace-interactive
106 (car regexp-search-ring)
107 (read-from-minibuffer "Map query replace (regexp): "
108 nil nil nil
109 'query-replace-history)))
770970cb
RS
110 (setq to (read-from-minibuffer
111 (format "Query replace %s with (space-separated strings): "
112 from)
113 nil nil nil
114 'query-replace-history))
115 (list from to current-prefix-arg)))
da44e784
RM
116 (let (replacements)
117 (if (listp to-strings)
118 (setq replacements to-strings)
119 (while (/= (length to-strings) 0)
120 (if (string-match " " to-strings)
121 (setq replacements
122 (append replacements
123 (list (substring to-strings 0
124 (string-match " " to-strings))))
125 to-strings (substring to-strings
126 (1+ (string-match " " to-strings))))
127 (setq replacements (append replacements (list to-strings))
128 to-strings ""))))
129 (perform-replace regexp replacements t t nil arg))
81bdc14d 130 (or unread-command-events (message "Done")))
da44e784 131
da44e784
RM
132(defun replace-string (from-string to-string &optional delimited)
133 "Replace occurrences of FROM-STRING with TO-STRING.
134Preserve case in each match if `case-replace' and `case-fold-search'
135are non-nil and FROM-STRING has no uppercase letters.
118a01c9 136Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
da44e784
RM
137only matches surrounded by word boundaries.
138
151270f3
RS
139If `query-replace-interactive' is non-nil, the last incremental search
140string is used as FROM-STRING--you don't have to specify it with the
141minibuffer.
142
da44e784
RM
143This function is usually the wrong thing to use in a Lisp program.
144What you probably want is a loop like this:
118a01c9
RS
145 (while (search-forward FROM-STRING nil t)
146 (replace-match TO-STRING nil t))
da44e784 147which will run faster and will not set the mark or print anything."
151270f3 148 (interactive (query-replace-read-args "Replace string" nil))
da44e784 149 (perform-replace from-string to-string nil nil delimited)
81bdc14d 150 (or unread-command-events (message "Done")))
da44e784 151
da44e784
RM
152(defun replace-regexp (regexp to-string &optional delimited)
153 "Replace things after point matching REGEXP with TO-STRING.
118a01c9 154Preserve case in each match if `case-replace' and `case-fold-search'
da44e784 155are non-nil and REGEXP has no uppercase letters.
118a01c9 156Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
da44e784 157only matches surrounded by word boundaries.
118a01c9
RS
158In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
159and `\\=\\N' (where N is a digit) stands for
880f22a1 160 whatever what matched the Nth `\\(...\\)' in REGEXP.
da44e784 161
151270f3
RS
162If `query-replace-interactive' is non-nil, the last incremental search
163regexp is used as REGEXP--you don't have to specify it with the minibuffer.
164
da44e784
RM
165This function is usually the wrong thing to use in a Lisp program.
166What you probably want is a loop like this:
167 (while (re-search-forward REGEXP nil t)
118a01c9 168 (replace-match TO-STRING nil nil))
da44e784 169which will run faster and will not set the mark or print anything."
151270f3 170 (interactive (query-replace-read-args "Replace regexp" t))
da44e784 171 (perform-replace regexp to-string nil t delimited)
81bdc14d 172 (or unread-command-events (message "Done")))
4c53bd2b
RS
173\f
174(defvar regexp-history nil
175 "History list for some commands that read regular expressions.")
da44e784 176
31e1d920 177(defalias 'delete-non-matching-lines 'keep-lines)
698e1804
RS
178(defun keep-lines (regexp)
179 "Delete all lines except those containing matches for REGEXP.
180A match split across lines preserves all the lines it lies in.
181Applies to all lines after point."
4c53bd2b 182 (interactive (list (read-from-minibuffer
72f21cdf 183 "Keep lines (containing match for regexp): "
4c53bd2b 184 nil nil nil 'regexp-history)))
698e1804
RS
185 (save-excursion
186 (or (bolp) (forward-line 1))
187 (let ((start (point)))
188 (while (not (eobp))
189 ;; Start is first char not preserved by previous match.
190 (if (not (re-search-forward regexp nil 'move))
191 (delete-region start (point-max))
192 (let ((end (save-excursion (goto-char (match-beginning 0))
193 (beginning-of-line)
194 (point))))
195 ;; Now end is first char preserved by the new match.
196 (if (< start end)
197 (delete-region start end))))
198 (setq start (save-excursion (forward-line 1)
199 (point)))
200 ;; If the match was empty, avoid matching again at same place.
201 (and (not (eobp)) (= (match-beginning 0) (match-end 0))
202 (forward-char 1))))))
203
31e1d920 204(defalias 'delete-matching-lines 'flush-lines)
698e1804
RS
205(defun flush-lines (regexp)
206 "Delete lines containing matches for REGEXP.
207If a match is split across lines, all the lines it lies in are deleted.
208Applies to lines after point."
4c53bd2b 209 (interactive (list (read-from-minibuffer
72f21cdf 210 "Flush lines (containing match for regexp): "
4c53bd2b 211 nil nil nil 'regexp-history)))
698e1804
RS
212 (save-excursion
213 (while (and (not (eobp))
214 (re-search-forward regexp nil t))
215 (delete-region (save-excursion (goto-char (match-beginning 0))
216 (beginning-of-line)
217 (point))
218 (progn (forward-line 1) (point))))))
219
31e1d920 220(defalias 'count-matches 'how-many)
698e1804
RS
221(defun how-many (regexp)
222 "Print number of matches for REGEXP following point."
4c53bd2b 223 (interactive (list (read-from-minibuffer
72f21cdf 224 "How many matches for (regexp): "
4c53bd2b 225 nil nil nil 'regexp-history)))
698e1804
RS
226 (let ((count 0) opoint)
227 (save-excursion
228 (while (and (not (eobp))
229 (progn (setq opoint (point))
230 (re-search-forward regexp nil t)))
231 (if (= opoint (point))
232 (forward-char 1)
233 (setq count (1+ count))))
234 (message "%d occurrences" count))))
4c53bd2b 235\f
698e1804
RS
236(defvar occur-mode-map ())
237(if occur-mode-map
238 ()
239 (setq occur-mode-map (make-sparse-keymap))
78bead73 240 (define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto)
698e1804
RS
241 (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence))
242
243(defvar occur-buffer nil)
244(defvar occur-nlines nil)
245(defvar occur-pos-list nil)
246
247(defun occur-mode ()
248 "Major mode for output from \\[occur].
249Move point to one of the occurrences in this buffer,
250then use \\[occur-mode-goto-occurrence] to go to the same occurrence
251in the buffer that the occurrences were found in.
26649bdf 252Or click \\<occur-mode-map>\\[occur-mode-mouse-goto] on an occurrence line.
698e1804
RS
253\\{occur-mode-map}"
254 (kill-all-local-variables)
255 (use-local-map occur-mode-map)
256 (setq major-mode 'occur-mode)
257 (setq mode-name "Occur")
258 (make-local-variable 'occur-buffer)
259 (make-local-variable 'occur-nlines)
4baf5620
RS
260 (make-local-variable 'occur-pos-list)
261 (run-hooks 'occur-mode-hook))
698e1804 262
78bead73
RS
263(defun occur-mode-mouse-goto (event)
264 "In Occur mode, go to the occurrence whose line you click on."
265 (interactive "e")
266 (let (buffer pos)
267 (save-excursion
268 (set-buffer (window-buffer (posn-window (event-end event))))
269 (save-excursion
270 (goto-char (posn-point (event-end event)))
271 (setq pos (occur-mode-find-occurrence))
272 (setq buffer occur-buffer)))
273 (pop-to-buffer buffer)
274 (goto-char (marker-position pos))))
275
276(defun occur-mode-find-occurrence ()
698e1804
RS
277 (if (or (null occur-buffer)
278 (null (buffer-name occur-buffer)))
279 (progn
280 (setq occur-buffer nil
281 occur-pos-list nil)
282 (error "Buffer in which occurrences were found is deleted")))
78bead73
RS
283 (let* ((line-count
284 (count-lines (point-min)
285 (save-excursion
286 (beginning-of-line)
287 (point))))
288 (occur-number (save-excursion
698e1804 289 (beginning-of-line)
78bead73 290 (/ (1- line-count)
698e1804
RS
291 (cond ((< occur-nlines 0)
292 (- 2 occur-nlines))
293 ((> occur-nlines 0)
294 (+ 2 (* 2 occur-nlines)))
295 (t 1)))))
296 (pos (nth occur-number occur-pos-list)))
78bead73
RS
297 (if (< line-count 1)
298 (error "No occurrence on this line"))
43549f18
RS
299 (or pos
300 (error "No occurrence on this line"))
78bead73
RS
301 pos))
302
303(defun occur-mode-goto-occurrence ()
304 "Go to the occurrence the current line describes."
305 (interactive)
306 (let ((pos (occur-mode-find-occurrence)))
698e1804 307 (pop-to-buffer occur-buffer)
121e2227 308 (goto-char (marker-position pos))))
4c53bd2b 309\f
698e1804 310(defvar list-matching-lines-default-context-lines 0
da44e784 311 "*Default number of context lines to include around a `list-matching-lines'
698e1804
RS
312match. A negative number means to include that many lines before the match.
313A positive number means to include that many lines both before and after.")
314
31e1d920 315(defalias 'list-matching-lines 'occur)
698e1804
RS
316
317(defun occur (regexp &optional nlines)
99976f85 318 "Show all lines in the current buffer containing a match for REGEXP.
da44e784
RM
319
320If a match spreads across multiple lines, all those lines are shown.
698e1804 321
da44e784
RM
322Each line is displayed with NLINES lines before and after, or -NLINES
323before if NLINES is negative.
324NLINES defaults to `list-matching-lines-default-context-lines'.
698e1804
RS
325Interactively it is the prefix arg.
326
4c53bd2b 327The lines are shown in a buffer named `*Occur*'.
698e1804
RS
328It serves as a menu to find any of the occurrences in this buffer.
329\\[describe-mode] in that buffer will explain how."
4c53bd2b
RS
330 (interactive (list (let* ((default (car regexp-history))
331 (input
332 (read-from-minibuffer
166aaf6f
RS
333 (if default
334 (format "List lines matching regexp (default `%s'): " default)
335 "List lines matching regexp: ")
4c53bd2b
RS
336 nil nil nil
337 'regexp-history)))
338 (if (> (length input) 0) input
339 (setcar regexp-history default)))
f1c9e147 340 current-prefix-arg))
698e1804
RS
341 (setq nlines (if nlines (prefix-numeric-value nlines)
342 list-matching-lines-default-context-lines))
343 (let ((first t)
344 (buffer (current-buffer))
345 (linenum 1)
79c2e52b
JB
346 (prevpos (point-min))
347 (final-context-start (make-marker)))
99976f85
RS
348;;; (save-excursion
349;;; (beginning-of-line)
350;;; (setq linenum (1+ (count-lines (point-min) (point))))
351;;; (setq prevpos (point)))
698e1804
RS
352 (with-output-to-temp-buffer "*Occur*"
353 (save-excursion
354 (set-buffer standard-output)
e6d63eff
RS
355 ;; We will insert the number of lines, and "lines", later.
356 (insert " matching ")
698e1804
RS
357 (prin1 regexp)
358 (insert " in buffer " (buffer-name buffer) ?. ?\n)
359 (occur-mode)
360 (setq occur-buffer buffer)
361 (setq occur-nlines nlines)
362 (setq occur-pos-list ()))
363 (if (eq buffer standard-output)
364 (goto-char (point-max)))
365 (save-excursion
99976f85 366 (beginning-of-buffer)
698e1804
RS
367 ;; Find next match, but give up if prev match was at end of buffer.
368 (while (and (not (= prevpos (point-max)))
369 (re-search-forward regexp nil t))
da44e784 370 (goto-char (match-beginning 0))
698e1804 371 (beginning-of-line)
4c53bd2b
RS
372 (save-match-data
373 (setq linenum (+ linenum (count-lines prevpos (point)))))
698e1804 374 (setq prevpos (point))
da44e784 375 (goto-char (match-end 0))
698e1804 376 (let* ((start (save-excursion
da44e784 377 (goto-char (match-beginning 0))
698e1804
RS
378 (forward-line (if (< nlines 0) nlines (- nlines)))
379 (point)))
380 (end (save-excursion
da44e784 381 (goto-char (match-end 0))
698e1804
RS
382 (if (> nlines 0)
383 (forward-line (1+ nlines))
384 (forward-line 1))
385 (point)))
386 (tag (format "%3d" linenum))
387 (empty (make-string (length tag) ?\ ))
388 tem)
389 (save-excursion
79c2e52b
JB
390 (setq tem (make-marker))
391 (set-marker tem (point))
698e1804
RS
392 (set-buffer standard-output)
393 (setq occur-pos-list (cons tem occur-pos-list))
394 (or first (zerop nlines)
395 (insert "--------\n"))
396 (setq first nil)
397 (insert-buffer-substring buffer start end)
398 (backward-char (- end start))
da44e784 399 (setq tem nlines)
698e1804
RS
400 (while (> tem 0)
401 (insert empty ?:)
402 (forward-line 1)
403 (setq tem (1- tem)))
79c2e52b 404 (let ((this-linenum linenum))
da44e784
RM
405 (set-marker final-context-start
406 (+ (point) (- (match-end 0) (match-beginning 0))))
407 (while (< (point) final-context-start)
408 (if (null tag)
409 (setq tag (format "%3d" this-linenum)))
410 (insert tag ?:)
f81ed6cf
RS
411 (put-text-property (save-excursion
412 (beginning-of-line)
413 (point))
414 (save-excursion
415 (end-of-line)
416 (point))
417 'mouse-face 'highlight)
da44e784
RM
418 (setq tag nil)
419 (forward-line 1)
420 (setq this-linenum (1+ this-linenum))))
698e1804
RS
421 (while (< tem nlines)
422 (insert empty ?:)
423 (forward-line 1)
424 (setq tem (1+ tem))))
425 (forward-line 1)))
426 (set-buffer standard-output)
427 ;; Put positions in increasing order to go with buffer.
428 (setq occur-pos-list (nreverse occur-pos-list))
e6d63eff
RS
429 (goto-char (point-min))
430 (if (= (length occur-pos-list) 1)
431 (insert "1 line")
432 (insert (format "%d lines" (length occur-pos-list))))
698e1804
RS
433 (if (interactive-p)
434 (message "%d matching lines." (length occur-pos-list)))))))
435\f
81bdc14d
RS
436;; It would be nice to use \\[...], but there is no reasonable way
437;; to make that display both SPC and Y.
698e1804
RS
438(defconst query-replace-help
439 "Type Space or `y' to replace one match, Delete or `n' to skip to next,
be44f62c 440RET or `q' to exit, Period to replace one match and exit,
698e1804
RS
441Comma to replace but not move point immediately,
442C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
443C-w to delete match and recursive edit,
444C-l to clear the screen, redisplay, and offer same replacement again,
445! to replace all remaining matches with no more questions,
446^ to move point back to previous match."
447 "Help message while in query-replace")
448
81bdc14d
RS
449(defvar query-replace-map (make-sparse-keymap)
450 "Keymap that defines the responses to questions in `query-replace'.
451The \"bindings\" in this map are not commands; they are answers.
452The valid answers include `act', `skip', `act-and-show',
453`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
d9121bc0 454`automatic', `backup', `exit-prefix', and `help'.")
81bdc14d
RS
455
456(define-key query-replace-map " " 'act)
457(define-key query-replace-map "\d" 'skip)
458(define-key query-replace-map [delete] 'skip)
9275e5e3 459(define-key query-replace-map [backspace] 'skip)
81bdc14d
RS
460(define-key query-replace-map "y" 'act)
461(define-key query-replace-map "n" 'skip)
633a305a
RS
462(define-key query-replace-map "Y" 'act)
463(define-key query-replace-map "N" 'skip)
81bdc14d 464(define-key query-replace-map "," 'act-and-show)
81bdc14d 465(define-key query-replace-map "q" 'exit)
919592c0 466(define-key query-replace-map "\r" 'exit)
384c7da4 467(define-key query-replace-map [return] 'exit)
81bdc14d
RS
468(define-key query-replace-map "." 'act-and-exit)
469(define-key query-replace-map "\C-r" 'edit)
470(define-key query-replace-map "\C-w" 'delete-and-edit)
471(define-key query-replace-map "\C-l" 'recenter)
472(define-key query-replace-map "!" 'automatic)
473(define-key query-replace-map "^" 'backup)
474(define-key query-replace-map "\C-h" 'help)
475(define-key query-replace-map "?" 'help)
bc6312e1
RS
476(define-key query-replace-map "\C-g" 'quit)
477(define-key query-replace-map "\C-]" 'quit)
d9121bc0
RS
478(define-key query-replace-map "\e" 'exit-prefix)
479(define-key query-replace-map [escape] 'exit-prefix)
81bdc14d 480
698e1804
RS
481(defun perform-replace (from-string replacements
482 query-flag regexp-flag delimited-flag
81bdc14d 483 &optional repeat-count map)
698e1804
RS
484 "Subroutine of `query-replace'. Its complexity handles interactive queries.
485Don't use this in your own program unless you want to query and set the mark
486just as `query-replace' does. Instead, write a simple loop like this:
487 (while (re-search-forward \"foo[ \t]+bar\" nil t)
488 (replace-match \"foobar\" nil nil))
e782e9f2 489which will run faster and probably do exactly what you want."
81bdc14d 490 (or map (setq map query-replace-map))
698e1804
RS
491 (let ((nocasify (not (and case-fold-search case-replace
492 (string-equal from-string
493 (downcase from-string)))))
494 (literal (not regexp-flag))
495 (search-function (if regexp-flag 're-search-forward 'search-forward))
496 (search-string from-string)
e5d77022 497 (real-match-data nil) ; the match data for the current match
698e1804
RS
498 (next-replacement nil)
499 (replacement-index 0)
500 (keep-going t)
501 (stack nil)
502 (next-rotate-count 0)
503 (replace-count 0)
da44e784 504 (lastrepl nil) ;Position after last match considered.
02d95a27
RS
505 (match-again t)
506 (message
507 (if query-flag
508 (substitute-command-keys
509 "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) "))))
698e1804
RS
510 (if (stringp replacements)
511 (setq next-replacement replacements)
512 (or repeat-count (setq repeat-count 1)))
513 (if delimited-flag
514 (setq search-function 're-search-forward
515 search-string (concat "\\b"
516 (if regexp-flag from-string
517 (regexp-quote from-string))
518 "\\b")))
519 (push-mark)
520 (undo-boundary)
e782e9f2
RS
521 (unwind-protect
522 ;; Loop finding occurrences that perhaps should be replaced.
523 (while (and keep-going
524 (not (eobp))
525 (funcall search-function search-string nil t)
526 ;; If the search string matches immediately after
527 ;; the previous match, but it did not match there
528 ;; before the replacement was done, ignore the match.
529 (if (or (eq lastrepl (point))
530 (and regexp-flag
531 (eq lastrepl (match-beginning 0))
532 (not match-again)))
533 (if (eobp)
534 nil
535 ;; Don't replace the null string
536 ;; right after end of previous replacement.
537 (forward-char 1)
538 (funcall search-function search-string nil t))
539 t))
540
541 ;; Save the data associated with the real match.
542 (setq real-match-data (match-data))
543
544 ;; Before we make the replacement, decide whether the search string
545 ;; can match again just after this match.
546 (if regexp-flag
547 (setq match-again (looking-at search-string)))
548 ;; If time for a change, advance to next replacement string.
549 (if (and (listp replacements)
550 (= next-rotate-count replace-count))
551 (progn
552 (setq next-rotate-count
553 (+ next-rotate-count repeat-count))
554 (setq next-replacement (nth replacement-index replacements))
555 (setq replacement-index (% (1+ replacement-index) (length replacements)))))
556 (if (not query-flag)
557 (progn
558 (store-match-data real-match-data)
559 (replace-match next-replacement nocasify literal)
560 (setq replace-count (1+ replace-count)))
561 (undo-boundary)
562 (let (done replaced key def)
563 ;; Loop reading commands until one of them sets done,
564 ;; which means it has finished handling this occurrence.
565 (while (not done)
301a9d17 566 (store-match-data real-match-data)
e782e9f2 567 (replace-highlight (match-beginning 0) (match-end 0))
02d95a27 568 (message message from-string next-replacement)
e782e9f2
RS
569 (setq key (read-event))
570 (setq key (vector key))
571 (setq def (lookup-key map key))
572 ;; Restore the match data while we process the command.
e782e9f2
RS
573 (cond ((eq def 'help)
574 (with-output-to-temp-buffer "*Help*"
575 (princ
576 (concat "Query replacing "
577 (if regexp-flag "regexp " "")
578 from-string " with "
579 next-replacement ".\n\n"
580 (substitute-command-keys
b905ac33
KH
581 query-replace-help)))
582 (save-excursion
583 (set-buffer standard-output)
584 (help-mode))))
e782e9f2
RS
585 ((eq def 'exit)
586 (setq keep-going nil)
587 (setq done t))
588 ((eq def 'backup)
237e6ab0
KH
589 (if stack
590 (let ((elt (car stack)))
591 (goto-char (car elt))
592 (setq replaced (eq t (cdr elt)))
593 (or replaced
594 (store-match-data (cdr elt)))
595 (setq stack (cdr stack)))
596 (message "No previous match")
597 (ding 'no-terminate)
598 (sit-for 1)))
e782e9f2
RS
599 ((eq def 'act)
600 (or replaced
601 (replace-match next-replacement nocasify literal))
602 (setq done t replaced t))
603 ((eq def 'act-and-exit)
604 (or replaced
605 (replace-match next-replacement nocasify literal))
606 (setq keep-going nil)
607 (setq done t replaced t))
608 ((eq def 'act-and-show)
609 (if (not replaced)
610 (progn
611 (replace-match next-replacement nocasify literal)
612 (setq replaced t))))
613 ((eq def 'automatic)
614 (or replaced
615 (replace-match next-replacement nocasify literal))
616 (setq done t query-flag nil replaced t))
617 ((eq def 'skip)
618 (setq done t))
619 ((eq def 'recenter)
620 (recenter nil))
621 ((eq def 'edit)
622 (store-match-data
623 (prog1 (match-data)
624 (save-excursion (recursive-edit))))
625 ;; Before we make the replacement,
626 ;; decide whether the search string
627 ;; can match again just after this match.
628 (if regexp-flag
629 (setq match-again (looking-at search-string))))
630 ((eq def 'delete-and-edit)
631 (delete-region (match-beginning 0) (match-end 0))
632 (store-match-data
633 (prog1 (match-data)
634 (save-excursion (recursive-edit))))
635 (setq replaced t))
d9121bc0
RS
636 ;; Note: we do not need to treat `exit-prefix'
637 ;; specially here, since we reread
638 ;; any unrecognized character.
e782e9f2 639 (t
d9121bc0 640 (setq this-command 'mode-exited)
e782e9f2
RS
641 (setq keep-going nil)
642 (setq unread-command-events
643 (append (listify-key-sequence key)
644 unread-command-events))
645 (setq done t))))
646 ;; Record previous position for ^ when we move on.
647 ;; Change markers to numbers in the match data
648 ;; since lots of markers slow down editing.
649 (setq stack
650 (cons (cons (point)
651 (or replaced
eab69997
RM
652 (mapcar (lambda (elt)
653 (and elt
654 (prog1 (marker-position elt)
655 (set-marker elt nil))))
e782e9f2
RS
656 (match-data))))
657 stack))
658 (if replaced (setq replace-count (1+ replace-count)))))
659 (setq lastrepl (point)))
660 (replace-dehighlight))
81bdc14d 661 (and keep-going stack)))
698e1804 662
e782e9f2
RS
663(defvar query-replace-highlight nil
664 "*Non-nil means to highlight words during query replacement.")
665
666(defvar replace-overlay nil)
667
668(defun replace-dehighlight ()
669 (and replace-overlay
670 (progn
671 (delete-overlay replace-overlay)
672 (setq replace-overlay nil))))
673
674(defun replace-highlight (start end)
675 (and query-replace-highlight
676 (progn
677 (or replace-overlay
678 (progn
679 (setq replace-overlay (make-overlay start end))
680 (overlay-put replace-overlay 'face
681 (if (internal-find-face 'query-replace)
682 'query-replace 'region))))
683 (move-overlay replace-overlay start end (current-buffer)))))
684
c88ab9ce 685;;; replace.el ends here