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