(xmalloc, xrealloc): Add casts.
[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)
698e1804
RS
242 (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence))
243
244(defvar occur-buffer nil)
245(defvar occur-nlines nil)
246(defvar occur-pos-list nil)
247
248(defun occur-mode ()
249 "Major mode for output from \\[occur].
250Move point to one of the occurrences in this buffer,
251then use \\[occur-mode-goto-occurrence] to go to the same occurrence
252in the buffer that the occurrences were found in.
26649bdf 253Or click \\<occur-mode-map>\\[occur-mode-mouse-goto] on an occurrence line.
698e1804
RS
254\\{occur-mode-map}"
255 (kill-all-local-variables)
256 (use-local-map occur-mode-map)
257 (setq major-mode 'occur-mode)
258 (setq mode-name "Occur")
259 (make-local-variable 'occur-buffer)
260 (make-local-variable 'occur-nlines)
4baf5620
RS
261 (make-local-variable 'occur-pos-list)
262 (run-hooks 'occur-mode-hook))
698e1804 263
78bead73
RS
264(defun occur-mode-mouse-goto (event)
265 "In Occur mode, go to the occurrence whose line you click on."
266 (interactive "e")
267 (let (buffer pos)
268 (save-excursion
269 (set-buffer (window-buffer (posn-window (event-end event))))
270 (save-excursion
271 (goto-char (posn-point (event-end event)))
272 (setq pos (occur-mode-find-occurrence))
273 (setq buffer occur-buffer)))
274 (pop-to-buffer buffer)
275 (goto-char (marker-position pos))))
276
277(defun occur-mode-find-occurrence ()
698e1804
RS
278 (if (or (null occur-buffer)
279 (null (buffer-name occur-buffer)))
280 (progn
281 (setq occur-buffer nil
282 occur-pos-list nil)
283 (error "Buffer in which occurrences were found is deleted")))
78bead73
RS
284 (let* ((line-count
285 (count-lines (point-min)
286 (save-excursion
287 (beginning-of-line)
288 (point))))
289 (occur-number (save-excursion
698e1804 290 (beginning-of-line)
78bead73 291 (/ (1- line-count)
698e1804
RS
292 (cond ((< occur-nlines 0)
293 (- 2 occur-nlines))
294 ((> occur-nlines 0)
295 (+ 2 (* 2 occur-nlines)))
296 (t 1)))))
297 (pos (nth occur-number occur-pos-list)))
78bead73
RS
298 (if (< line-count 1)
299 (error "No occurrence on this line"))
43549f18
RS
300 (or pos
301 (error "No occurrence on this line"))
78bead73
RS
302 pos))
303
304(defun occur-mode-goto-occurrence ()
305 "Go to the occurrence the current line describes."
306 (interactive)
307 (let ((pos (occur-mode-find-occurrence)))
698e1804 308 (pop-to-buffer occur-buffer)
121e2227 309 (goto-char (marker-position pos))))
4c53bd2b 310\f
698e1804 311(defvar list-matching-lines-default-context-lines 0
da44e784 312 "*Default number of context lines to include around a `list-matching-lines'
698e1804
RS
313match. A negative number means to include that many lines before the match.
314A positive number means to include that many lines both before and after.")
315
31e1d920 316(defalias 'list-matching-lines 'occur)
698e1804
RS
317
318(defun occur (regexp &optional nlines)
99976f85 319 "Show all lines in the current buffer containing a match for REGEXP.
da44e784
RM
320
321If a match spreads across multiple lines, all those lines are shown.
698e1804 322
da44e784
RM
323Each line is displayed with NLINES lines before and after, or -NLINES
324before if NLINES is negative.
325NLINES defaults to `list-matching-lines-default-context-lines'.
698e1804
RS
326Interactively it is the prefix arg.
327
4c53bd2b 328The lines are shown in a buffer named `*Occur*'.
698e1804
RS
329It serves as a menu to find any of the occurrences in this buffer.
330\\[describe-mode] in that buffer will explain how."
4c53bd2b
RS
331 (interactive (list (let* ((default (car regexp-history))
332 (input
333 (read-from-minibuffer
166aaf6f
RS
334 (if default
335 (format "List lines matching regexp (default `%s'): " default)
336 "List lines matching regexp: ")
4c53bd2b
RS
337 nil nil nil
338 'regexp-history)))
339 (if (> (length input) 0) input
340 (setcar regexp-history default)))
f1c9e147 341 current-prefix-arg))
698e1804
RS
342 (setq nlines (if nlines (prefix-numeric-value nlines)
343 list-matching-lines-default-context-lines))
344 (let ((first t)
345 (buffer (current-buffer))
346 (linenum 1)
79c2e52b
JB
347 (prevpos (point-min))
348 (final-context-start (make-marker)))
99976f85
RS
349;;; (save-excursion
350;;; (beginning-of-line)
351;;; (setq linenum (1+ (count-lines (point-min) (point))))
352;;; (setq prevpos (point)))
698e1804
RS
353 (with-output-to-temp-buffer "*Occur*"
354 (save-excursion
355 (set-buffer standard-output)
e6d63eff
RS
356 ;; We will insert the number of lines, and "lines", later.
357 (insert " matching ")
d10ad24f
RS
358 (let ((print-escape-newlines t))
359 (prin1 regexp))
698e1804
RS
360 (insert " in buffer " (buffer-name buffer) ?. ?\n)
361 (occur-mode)
362 (setq occur-buffer buffer)
363 (setq occur-nlines nlines)
364 (setq occur-pos-list ()))
365 (if (eq buffer standard-output)
366 (goto-char (point-max)))
367 (save-excursion
99976f85 368 (beginning-of-buffer)
698e1804
RS
369 ;; Find next match, but give up if prev match was at end of buffer.
370 (while (and (not (= prevpos (point-max)))
371 (re-search-forward regexp nil t))
da44e784 372 (goto-char (match-beginning 0))
698e1804 373 (beginning-of-line)
4c53bd2b
RS
374 (save-match-data
375 (setq linenum (+ linenum (count-lines prevpos (point)))))
698e1804 376 (setq prevpos (point))
da44e784 377 (goto-char (match-end 0))
698e1804 378 (let* ((start (save-excursion
da44e784 379 (goto-char (match-beginning 0))
698e1804
RS
380 (forward-line (if (< nlines 0) nlines (- nlines)))
381 (point)))
382 (end (save-excursion
da44e784 383 (goto-char (match-end 0))
698e1804
RS
384 (if (> nlines 0)
385 (forward-line (1+ nlines))
386 (forward-line 1))
387 (point)))
388 (tag (format "%3d" linenum))
389 (empty (make-string (length tag) ?\ ))
390 tem)
391 (save-excursion
79c2e52b
JB
392 (setq tem (make-marker))
393 (set-marker tem (point))
698e1804
RS
394 (set-buffer standard-output)
395 (setq occur-pos-list (cons tem occur-pos-list))
396 (or first (zerop nlines)
397 (insert "--------\n"))
398 (setq first nil)
399 (insert-buffer-substring buffer start end)
400 (backward-char (- end start))
da44e784 401 (setq tem nlines)
698e1804
RS
402 (while (> tem 0)
403 (insert empty ?:)
404 (forward-line 1)
405 (setq tem (1- tem)))
79c2e52b 406 (let ((this-linenum linenum))
da44e784
RM
407 (set-marker final-context-start
408 (+ (point) (- (match-end 0) (match-beginning 0))))
409 (while (< (point) final-context-start)
410 (if (null tag)
411 (setq tag (format "%3d" this-linenum)))
412 (insert tag ?:)
f81ed6cf
RS
413 (put-text-property (save-excursion
414 (beginning-of-line)
415 (point))
416 (save-excursion
417 (end-of-line)
418 (point))
419 'mouse-face 'highlight)
da44e784
RM
420 (setq tag nil)
421 (forward-line 1)
422 (setq this-linenum (1+ this-linenum))))
698e1804
RS
423 (while (< tem nlines)
424 (insert empty ?:)
425 (forward-line 1)
426 (setq tem (1+ tem))))
427 (forward-line 1)))
428 (set-buffer standard-output)
429 ;; Put positions in increasing order to go with buffer.
430 (setq occur-pos-list (nreverse occur-pos-list))
e6d63eff
RS
431 (goto-char (point-min))
432 (if (= (length occur-pos-list) 1)
433 (insert "1 line")
434 (insert (format "%d lines" (length occur-pos-list))))
698e1804
RS
435 (if (interactive-p)
436 (message "%d matching lines." (length occur-pos-list)))))))
437\f
81bdc14d
RS
438;; It would be nice to use \\[...], but there is no reasonable way
439;; to make that display both SPC and Y.
698e1804
RS
440(defconst query-replace-help
441 "Type Space or `y' to replace one match, Delete or `n' to skip to next,
be44f62c 442RET or `q' to exit, Period to replace one match and exit,
698e1804
RS
443Comma to replace but not move point immediately,
444C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
445C-w to delete match and recursive edit,
446C-l to clear the screen, redisplay, and offer same replacement again,
447! to replace all remaining matches with no more questions,
448^ to move point back to previous match."
449 "Help message while in query-replace")
450
81bdc14d
RS
451(defvar query-replace-map (make-sparse-keymap)
452 "Keymap that defines the responses to questions in `query-replace'.
453The \"bindings\" in this map are not commands; they are answers.
454The valid answers include `act', `skip', `act-and-show',
455`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
d9121bc0 456`automatic', `backup', `exit-prefix', and `help'.")
81bdc14d
RS
457
458(define-key query-replace-map " " 'act)
459(define-key query-replace-map "\d" 'skip)
460(define-key query-replace-map [delete] 'skip)
9275e5e3 461(define-key query-replace-map [backspace] 'skip)
81bdc14d
RS
462(define-key query-replace-map "y" 'act)
463(define-key query-replace-map "n" 'skip)
633a305a
RS
464(define-key query-replace-map "Y" 'act)
465(define-key query-replace-map "N" 'skip)
81bdc14d 466(define-key query-replace-map "," 'act-and-show)
81bdc14d 467(define-key query-replace-map "q" 'exit)
919592c0 468(define-key query-replace-map "\r" 'exit)
384c7da4 469(define-key query-replace-map [return] 'exit)
81bdc14d
RS
470(define-key query-replace-map "." 'act-and-exit)
471(define-key query-replace-map "\C-r" 'edit)
472(define-key query-replace-map "\C-w" 'delete-and-edit)
473(define-key query-replace-map "\C-l" 'recenter)
474(define-key query-replace-map "!" 'automatic)
475(define-key query-replace-map "^" 'backup)
476(define-key query-replace-map "\C-h" 'help)
477(define-key query-replace-map "?" 'help)
bc6312e1
RS
478(define-key query-replace-map "\C-g" 'quit)
479(define-key query-replace-map "\C-]" 'quit)
d9121bc0
RS
480(define-key query-replace-map "\e" 'exit-prefix)
481(define-key query-replace-map [escape] 'exit-prefix)
81bdc14d 482
698e1804
RS
483(defun perform-replace (from-string replacements
484 query-flag regexp-flag delimited-flag
81bdc14d 485 &optional repeat-count map)
698e1804
RS
486 "Subroutine of `query-replace'. Its complexity handles interactive queries.
487Don't use this in your own program unless you want to query and set the mark
488just as `query-replace' does. Instead, write a simple loop like this:
489 (while (re-search-forward \"foo[ \t]+bar\" nil t)
490 (replace-match \"foobar\" nil nil))
e782e9f2 491which will run faster and probably do exactly what you want."
81bdc14d 492 (or map (setq map query-replace-map))
698e1804
RS
493 (let ((nocasify (not (and case-fold-search case-replace
494 (string-equal from-string
495 (downcase from-string)))))
496 (literal (not regexp-flag))
497 (search-function (if regexp-flag 're-search-forward 'search-forward))
498 (search-string from-string)
e5d77022 499 (real-match-data nil) ; the match data for the current match
698e1804
RS
500 (next-replacement nil)
501 (replacement-index 0)
502 (keep-going t)
503 (stack nil)
504 (next-rotate-count 0)
505 (replace-count 0)
da44e784 506 (lastrepl nil) ;Position after last match considered.
02d95a27
RS
507 (match-again t)
508 (message
509 (if query-flag
510 (substitute-command-keys
511 "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) "))))
698e1804
RS
512 (if (stringp replacements)
513 (setq next-replacement replacements)
514 (or repeat-count (setq repeat-count 1)))
515 (if delimited-flag
516 (setq search-function 're-search-forward
517 search-string (concat "\\b"
518 (if regexp-flag from-string
519 (regexp-quote from-string))
520 "\\b")))
521 (push-mark)
522 (undo-boundary)
e782e9f2
RS
523 (unwind-protect
524 ;; Loop finding occurrences that perhaps should be replaced.
525 (while (and keep-going
526 (not (eobp))
527 (funcall search-function search-string nil t)
528 ;; If the search string matches immediately after
529 ;; the previous match, but it did not match there
530 ;; before the replacement was done, ignore the match.
531 (if (or (eq lastrepl (point))
532 (and regexp-flag
533 (eq lastrepl (match-beginning 0))
534 (not match-again)))
535 (if (eobp)
536 nil
537 ;; Don't replace the null string
538 ;; right after end of previous replacement.
539 (forward-char 1)
540 (funcall search-function search-string nil t))
541 t))
542
543 ;; Save the data associated with the real match.
544 (setq real-match-data (match-data))
545
546 ;; Before we make the replacement, decide whether the search string
547 ;; can match again just after this match.
548 (if regexp-flag
549 (setq match-again (looking-at search-string)))
550 ;; If time for a change, advance to next replacement string.
551 (if (and (listp replacements)
552 (= next-rotate-count replace-count))
553 (progn
554 (setq next-rotate-count
555 (+ next-rotate-count repeat-count))
556 (setq next-replacement (nth replacement-index replacements))
557 (setq replacement-index (% (1+ replacement-index) (length replacements)))))
558 (if (not query-flag)
559 (progn
560 (store-match-data real-match-data)
561 (replace-match next-replacement nocasify literal)
562 (setq replace-count (1+ replace-count)))
563 (undo-boundary)
564 (let (done replaced key def)
565 ;; Loop reading commands until one of them sets done,
566 ;; which means it has finished handling this occurrence.
567 (while (not done)
301a9d17 568 (store-match-data real-match-data)
e782e9f2 569 (replace-highlight (match-beginning 0) (match-end 0))
02d95a27 570 (message message from-string next-replacement)
e782e9f2
RS
571 (setq key (read-event))
572 (setq key (vector key))
573 (setq def (lookup-key map key))
574 ;; Restore the match data while we process the command.
e782e9f2
RS
575 (cond ((eq def 'help)
576 (with-output-to-temp-buffer "*Help*"
577 (princ
578 (concat "Query replacing "
579 (if regexp-flag "regexp " "")
580 from-string " with "
581 next-replacement ".\n\n"
582 (substitute-command-keys
b905ac33
KH
583 query-replace-help)))
584 (save-excursion
585 (set-buffer standard-output)
586 (help-mode))))
e782e9f2
RS
587 ((eq def 'exit)
588 (setq keep-going nil)
589 (setq done t))
590 ((eq def 'backup)
237e6ab0
KH
591 (if stack
592 (let ((elt (car stack)))
593 (goto-char (car elt))
594 (setq replaced (eq t (cdr elt)))
595 (or replaced
596 (store-match-data (cdr elt)))
597 (setq stack (cdr stack)))
598 (message "No previous match")
599 (ding 'no-terminate)
600 (sit-for 1)))
e782e9f2
RS
601 ((eq def 'act)
602 (or replaced
603 (replace-match next-replacement nocasify literal))
604 (setq done t replaced t))
605 ((eq def 'act-and-exit)
606 (or replaced
607 (replace-match next-replacement nocasify literal))
608 (setq keep-going nil)
609 (setq done t replaced t))
610 ((eq def 'act-and-show)
611 (if (not replaced)
612 (progn
613 (replace-match next-replacement nocasify literal)
614 (setq replaced t))))
615 ((eq def 'automatic)
616 (or replaced
617 (replace-match next-replacement nocasify literal))
618 (setq done t query-flag nil replaced t))
619 ((eq def 'skip)
620 (setq done t))
621 ((eq def 'recenter)
622 (recenter nil))
623 ((eq def 'edit)
624 (store-match-data
625 (prog1 (match-data)
626 (save-excursion (recursive-edit))))
627 ;; Before we make the replacement,
628 ;; decide whether the search string
629 ;; can match again just after this match.
630 (if regexp-flag
631 (setq match-again (looking-at search-string))))
632 ((eq def 'delete-and-edit)
633 (delete-region (match-beginning 0) (match-end 0))
634 (store-match-data
635 (prog1 (match-data)
636 (save-excursion (recursive-edit))))
637 (setq replaced t))
d9121bc0
RS
638 ;; Note: we do not need to treat `exit-prefix'
639 ;; specially here, since we reread
640 ;; any unrecognized character.
e782e9f2 641 (t
d9121bc0 642 (setq this-command 'mode-exited)
e782e9f2
RS
643 (setq keep-going nil)
644 (setq unread-command-events
645 (append (listify-key-sequence key)
646 unread-command-events))
647 (setq done t))))
648 ;; Record previous position for ^ when we move on.
649 ;; Change markers to numbers in the match data
650 ;; since lots of markers slow down editing.
651 (setq stack
652 (cons (cons (point)
653 (or replaced
eab69997
RM
654 (mapcar (lambda (elt)
655 (and elt
656 (prog1 (marker-position elt)
657 (set-marker elt nil))))
e782e9f2
RS
658 (match-data))))
659 stack))
660 (if replaced (setq replace-count (1+ replace-count)))))
661 (setq lastrepl (point)))
662 (replace-dehighlight))
4d33492a
RS
663 (or unread-command-events
664 (message "Replaced %d occurrence%s"
665 replace-count
666 (if (= replace-count 1) "" "s")))
667 (and keep-going stack)))
698e1804 668
e782e9f2
RS
669(defvar query-replace-highlight nil
670 "*Non-nil means to highlight words during query replacement.")
671
672(defvar replace-overlay nil)
673
674(defun replace-dehighlight ()
675 (and replace-overlay
676 (progn
677 (delete-overlay replace-overlay)
678 (setq replace-overlay nil))))
679
680(defun replace-highlight (start end)
681 (and query-replace-highlight
682 (progn
683 (or replace-overlay
684 (progn
685 (setq replace-overlay (make-overlay start end))
686 (overlay-put replace-overlay 'face
687 (if (internal-find-face 'query-replace)
688 'query-replace 'region))))
689 (move-overlay replace-overlay start end (current-buffer)))))
690
c88ab9ce 691;;; replace.el ends here