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