*** empty log message ***
[bpt/emacs.git] / lisp / replace.el
CommitLineData
c88ab9ce
ER
1;;; replace.el --- replace commands for Emacs.
2
e5d77022 3;; Copyright (C) 1985, 86, 87, 88, 89, 90, 91, 92 Free Software Foundation, Inc.
698e1804 4
3a801d0c
ER
5;; Maintainer: FSF
6
698e1804
RS
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
e5d77022 11;; the Free Software Foundation; either version 2, or (at your option)
698e1804
RS
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to
21;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
4f4b8eff 23;;; Code:
698e1804 24
73fa8346
BP
25(defconst case-replace t "\
26*Non-nil means query-replace should preserve case in replacements.")
77176e73 27
da44e784
RM
28(defun query-replace (from-string to-string &optional arg)
29 "Replace some occurrences of FROM-STRING with TO-STRING.
30As each match is found, the user must type a character saying
31what to do with it. For directions, type \\[help-command] at that time.
32
33Preserves case in each replacement if case-replace and case-fold-search
34are non-nil and FROM-STRING has no uppercase letters.
35Third arg DELIMITED (prefix arg if interactive) non-nil means replace
36only matches surrounded by word boundaries."
37 (interactive "sQuery replace: \nsQuery replace %s with: \nP")
38 (perform-replace from-string to-string t nil arg)
39 (message "Done"))
73fa8346 40(define-key esc-map "%" 'query-replace)
da44e784 41
da44e784
RM
42(defun query-replace-regexp (regexp to-string &optional arg)
43 "Replace some things after point matching REGEXP with TO-STRING.
44As each match is found, the user must type a character saying
45what to do with it. For directions, type \\[help-command] at that time.
46
47Preserves case in each replacement if case-replace and case-fold-search
48are non-nil and REGEXP has no uppercase letters.
49Third arg DELIMITED (prefix arg if interactive) non-nil means replace
50only matches surrounded by word boundaries.
51In TO-STRING, \\& means insert what matched REGEXP,
52and \\=\\<n> means insert what matched <n>th \\(...\\) in REGEXP."
53 (interactive "sQuery replace regexp: \nsQuery replace regexp %s with: \nP")
54 (perform-replace regexp to-string t t arg)
55 (message "Done"))
56
da44e784
RM
57(defun map-query-replace-regexp (regexp to-strings &optional arg)
58 "Replace some matches for REGEXP with various strings, in rotation.
59The second argument TO-STRINGS contains the replacement strings, separated
60by spaces. This command works like `query-replace-regexp' except
61that each successive replacement uses the next successive replacement string,
62wrapping around from the last such string to the first.
63
64Non-interactively, TO-STRINGS may be a list of replacement strings.
65
66A prefix argument N says to use each replacement string N times
67before rotating to the next."
68 (interactive "sMap query replace (regexp): \nsQuery replace %s with (space-separated strings): \nP")
69 (let (replacements)
70 (if (listp to-strings)
71 (setq replacements to-strings)
72 (while (/= (length to-strings) 0)
73 (if (string-match " " to-strings)
74 (setq replacements
75 (append replacements
76 (list (substring to-strings 0
77 (string-match " " to-strings))))
78 to-strings (substring to-strings
79 (1+ (string-match " " to-strings))))
80 (setq replacements (append replacements (list to-strings))
81 to-strings ""))))
82 (perform-replace regexp replacements t t nil arg))
83 (message "Done"))
84
da44e784
RM
85(defun replace-string (from-string to-string &optional delimited)
86 "Replace occurrences of FROM-STRING with TO-STRING.
87Preserve case in each match if `case-replace' and `case-fold-search'
88are non-nil and FROM-STRING has no uppercase letters.
89Third arg DELIMITED (prefix arg if interactive) non-nil means replace
90only matches surrounded by word boundaries.
91
92This function is usually the wrong thing to use in a Lisp program.
93What you probably want is a loop like this:
94 (while (search-forward OLD-STRING nil t)
95 (replace-match REPLACEMENT nil t))
96which will run faster and will not set the mark or print anything."
97 (interactive "sReplace string: \nsReplace string %s with: \nP")
98 (perform-replace from-string to-string nil nil delimited)
99 (message "Done"))
100
da44e784
RM
101(defun replace-regexp (regexp to-string &optional delimited)
102 "Replace things after point matching REGEXP with TO-STRING.
103Preserve case in each match if case-replace and case-fold-search
104are non-nil and REGEXP has no uppercase letters.
105Third arg DELIMITED (prefix arg if interactive) non-nil means replace
106only matches surrounded by word boundaries.
107In TO-STRING, \\& means insert what matched REGEXP,
108and \\=\\<n> means insert what matched <n>th \\(...\\) in REGEXP.
109
110This function is usually the wrong thing to use in a Lisp program.
111What you probably want is a loop like this:
112 (while (re-search-forward REGEXP nil t)
113 (replace-match REPLACEMENT nil nil))
114which will run faster and will not set the mark or print anything."
115 (interactive "sReplace regexp: \nsReplace regexp %s with: \nP")
116 (perform-replace regexp to-string nil t delimited)
117 (message "Done"))
118
698e1804
RS
119(fset 'delete-non-matching-lines 'keep-lines)
120(defun keep-lines (regexp)
121 "Delete all lines except those containing matches for REGEXP.
122A match split across lines preserves all the lines it lies in.
123Applies to all lines after point."
124 (interactive "sKeep lines (containing match for regexp): ")
125 (save-excursion
126 (or (bolp) (forward-line 1))
127 (let ((start (point)))
128 (while (not (eobp))
129 ;; Start is first char not preserved by previous match.
130 (if (not (re-search-forward regexp nil 'move))
131 (delete-region start (point-max))
132 (let ((end (save-excursion (goto-char (match-beginning 0))
133 (beginning-of-line)
134 (point))))
135 ;; Now end is first char preserved by the new match.
136 (if (< start end)
137 (delete-region start end))))
138 (setq start (save-excursion (forward-line 1)
139 (point)))
140 ;; If the match was empty, avoid matching again at same place.
141 (and (not (eobp)) (= (match-beginning 0) (match-end 0))
142 (forward-char 1))))))
143
144(fset 'delete-matching-lines 'flush-lines)
145(defun flush-lines (regexp)
146 "Delete lines containing matches for REGEXP.
147If a match is split across lines, all the lines it lies in are deleted.
148Applies to lines after point."
149 (interactive "sFlush lines (containing match for regexp): ")
150 (save-excursion
151 (while (and (not (eobp))
152 (re-search-forward regexp nil t))
153 (delete-region (save-excursion (goto-char (match-beginning 0))
154 (beginning-of-line)
155 (point))
156 (progn (forward-line 1) (point))))))
157
158(fset 'count-matches 'how-many)
159(defun how-many (regexp)
160 "Print number of matches for REGEXP following point."
161 (interactive "sHow many matches for (regexp): ")
162 (let ((count 0) opoint)
163 (save-excursion
164 (while (and (not (eobp))
165 (progn (setq opoint (point))
166 (re-search-forward regexp nil t)))
167 (if (= opoint (point))
168 (forward-char 1)
169 (setq count (1+ count))))
170 (message "%d occurrences" count))))
171
172(defvar occur-mode-map ())
173(if occur-mode-map
174 ()
175 (setq occur-mode-map (make-sparse-keymap))
176 (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence))
177
178(defvar occur-buffer nil)
179(defvar occur-nlines nil)
180(defvar occur-pos-list nil)
f1c9e147 181(defvar occur-last-string "")
698e1804
RS
182
183(defun occur-mode ()
184 "Major mode for output from \\[occur].
185Move point to one of the occurrences in this buffer,
186then use \\[occur-mode-goto-occurrence] to go to the same occurrence
187in the buffer that the occurrences were found in.
188\\{occur-mode-map}"
189 (kill-all-local-variables)
190 (use-local-map occur-mode-map)
191 (setq major-mode 'occur-mode)
192 (setq mode-name "Occur")
193 (make-local-variable 'occur-buffer)
194 (make-local-variable 'occur-nlines)
195 (make-local-variable 'occur-pos-list))
196
197(defun occur-mode-goto-occurrence ()
198 "Go to the line this occurrence was found in, in the buffer it was found in."
199 (interactive)
200 (if (or (null occur-buffer)
201 (null (buffer-name occur-buffer)))
202 (progn
203 (setq occur-buffer nil
204 occur-pos-list nil)
205 (error "Buffer in which occurrences were found is deleted")))
206 (let* ((occur-number (save-excursion
207 (beginning-of-line)
208 (/ (1- (count-lines (point-min)
209 (save-excursion
210 (beginning-of-line)
211 (point))))
212 (cond ((< occur-nlines 0)
213 (- 2 occur-nlines))
214 ((> occur-nlines 0)
215 (+ 2 (* 2 occur-nlines)))
216 (t 1)))))
217 (pos (nth occur-number occur-pos-list)))
218 (pop-to-buffer occur-buffer)
219 (goto-char (marker-position pos))))
220
221(defvar list-matching-lines-default-context-lines 0
da44e784 222 "*Default number of context lines to include around a `list-matching-lines'
698e1804
RS
223match. A negative number means to include that many lines before the match.
224A positive number means to include that many lines both before and after.")
225
226(defvar occur-whole-buffer nil
227 "If t, occur operates on whole buffer, otherwise occur starts from point.
228default is nil.")
229
230(fset 'list-matching-lines 'occur)
231
232(defun occur (regexp &optional nlines)
f1c9e147 233 "Show lines containing a match for REGEXP. If the global variable
da44e784 234`occur-whole-buffer' is non-nil, the entire buffer is searched, otherwise
f1c9e147 235search begins at point. Interactively, REGEXP defaults to the last REGEXP
da44e784
RM
236used interactively with \\[occur].
237
238If a match spreads across multiple lines, all those lines are shown.
698e1804 239
da44e784
RM
240Each line is displayed with NLINES lines before and after, or -NLINES
241before if NLINES is negative.
242NLINES defaults to `list-matching-lines-default-context-lines'.
698e1804
RS
243Interactively it is the prefix arg.
244
245The lines are shown in a buffer named *Occur*.
246It serves as a menu to find any of the occurrences in this buffer.
247\\[describe-mode] in that buffer will explain how."
f1c9e147 248 (interactive (list (setq occur-last-string
249 (read-string "List lines matching regexp: "
250 occur-last-string))
251 current-prefix-arg))
698e1804
RS
252 (setq nlines (if nlines (prefix-numeric-value nlines)
253 list-matching-lines-default-context-lines))
254 (let ((first t)
255 (buffer (current-buffer))
256 (linenum 1)
79c2e52b
JB
257 (prevpos (point-min))
258 (final-context-start (make-marker)))
698e1804
RS
259 (if (not occur-whole-buffer)
260 (save-excursion
261 (beginning-of-line)
262 (setq linenum (1+ (count-lines (point-min) (point))))
263 (setq prevpos (point))))
264 (with-output-to-temp-buffer "*Occur*"
265 (save-excursion
266 (set-buffer standard-output)
267 (insert "Lines matching ")
268 (prin1 regexp)
269 (insert " in buffer " (buffer-name buffer) ?. ?\n)
270 (occur-mode)
271 (setq occur-buffer buffer)
272 (setq occur-nlines nlines)
273 (setq occur-pos-list ()))
274 (if (eq buffer standard-output)
275 (goto-char (point-max)))
276 (save-excursion
277 (if occur-whole-buffer
278 (beginning-of-buffer))
279 ;; Find next match, but give up if prev match was at end of buffer.
280 (while (and (not (= prevpos (point-max)))
281 (re-search-forward regexp nil t))
da44e784 282 (goto-char (match-beginning 0))
698e1804
RS
283 (beginning-of-line)
284 (setq linenum (+ linenum (count-lines prevpos (point))))
285 (setq prevpos (point))
da44e784 286 (goto-char (match-end 0))
698e1804 287 (let* ((start (save-excursion
da44e784 288 (goto-char (match-beginning 0))
698e1804
RS
289 (forward-line (if (< nlines 0) nlines (- nlines)))
290 (point)))
291 (end (save-excursion
da44e784 292 (goto-char (match-end 0))
698e1804
RS
293 (if (> nlines 0)
294 (forward-line (1+ nlines))
295 (forward-line 1))
296 (point)))
297 (tag (format "%3d" linenum))
298 (empty (make-string (length tag) ?\ ))
299 tem)
300 (save-excursion
79c2e52b
JB
301 (setq tem (make-marker))
302 (set-marker tem (point))
698e1804
RS
303 (set-buffer standard-output)
304 (setq occur-pos-list (cons tem occur-pos-list))
305 (or first (zerop nlines)
306 (insert "--------\n"))
307 (setq first nil)
308 (insert-buffer-substring buffer start end)
309 (backward-char (- end start))
da44e784 310 (setq tem nlines)
698e1804
RS
311 (while (> tem 0)
312 (insert empty ?:)
313 (forward-line 1)
314 (setq tem (1- tem)))
79c2e52b 315 (let ((this-linenum linenum))
da44e784
RM
316 (set-marker final-context-start
317 (+ (point) (- (match-end 0) (match-beginning 0))))
318 (while (< (point) final-context-start)
319 (if (null tag)
320 (setq tag (format "%3d" this-linenum)))
321 (insert tag ?:)
322 (setq tag nil)
323 (forward-line 1)
324 (setq this-linenum (1+ this-linenum))))
698e1804
RS
325 (while (< tem nlines)
326 (insert empty ?:)
327 (forward-line 1)
328 (setq tem (1+ tem))))
329 (forward-line 1)))
330 (set-buffer standard-output)
331 ;; Put positions in increasing order to go with buffer.
332 (setq occur-pos-list (nreverse occur-pos-list))
333 (if (interactive-p)
334 (message "%d matching lines." (length occur-pos-list)))))))
335\f
336(defconst query-replace-help
337 "Type Space or `y' to replace one match, Delete or `n' to skip to next,
338ESC or `q' to exit, Period to replace one match and exit,
339Comma to replace but not move point immediately,
340C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
341C-w to delete match and recursive edit,
342C-l to clear the screen, redisplay, and offer same replacement again,
343! to replace all remaining matches with no more questions,
344^ to move point back to previous match."
345 "Help message while in query-replace")
346
347(defun perform-replace (from-string replacements
348 query-flag regexp-flag delimited-flag
349 &optional repeat-count)
350 "Subroutine of `query-replace'. Its complexity handles interactive queries.
351Don't use this in your own program unless you want to query and set the mark
352just as `query-replace' does. Instead, write a simple loop like this:
353 (while (re-search-forward \"foo[ \t]+bar\" nil t)
354 (replace-match \"foobar\" nil nil))
355which will run faster and do exactly what you probably want."
356 (let ((nocasify (not (and case-fold-search case-replace
357 (string-equal from-string
358 (downcase from-string)))))
359 (literal (not regexp-flag))
360 (search-function (if regexp-flag 're-search-forward 'search-forward))
361 (search-string from-string)
e5d77022 362 (real-match-data nil) ; the match data for the current match
698e1804
RS
363 (next-replacement nil)
364 (replacement-index 0)
365 (keep-going t)
366 (stack nil)
367 (next-rotate-count 0)
368 (replace-count 0)
da44e784
RM
369 (lastrepl nil) ;Position after last match considered.
370 (match-after t))
698e1804
RS
371 (if (stringp replacements)
372 (setq next-replacement replacements)
373 (or repeat-count (setq repeat-count 1)))
374 (if delimited-flag
375 (setq search-function 're-search-forward
376 search-string (concat "\\b"
377 (if regexp-flag from-string
378 (regexp-quote from-string))
379 "\\b")))
380 (push-mark)
381 (undo-boundary)
382 (while (and keep-going
383 (not (eobp))
384 (funcall search-function search-string nil t)
da44e784
RM
385 ;; If the search string matches immediately after
386 ;; the previous match, but it did not match there
387 ;; before the replacement was done, ignore the match.
388 (if (or (eq lastrepl (point))
389 (and regexp-flag
390 (eq lastrepl (match-beginning 0))
391 (not match-again)))
392 (if (eobp)
393 nil
698e1804
RS
394 ;; Don't replace the null string
395 ;; right after end of previous replacement.
396 (forward-char 1)
397 (funcall search-function search-string nil t))
398 t))
e5d77022
JB
399
400 ;; Save the data associated with the real match.
401 (setq real-match-data (match-data))
402
da44e784
RM
403 ;; Before we make the replacement, decide whether the search string
404 ;; can match again just after this match.
405 (if regexp-flag
406 (setq match-again (looking-at search-string)))
698e1804
RS
407 ;; If time for a change, advance to next replacement string.
408 (if (and (listp replacements)
409 (= next-rotate-count replace-count))
410 (progn
411 (setq next-rotate-count
412 (+ next-rotate-count repeat-count))
413 (setq next-replacement (nth replacement-index replacements))
414 (setq replacement-index (% (1+ replacement-index) (length replacements)))))
415 (if (not query-flag)
416 (progn
e5d77022 417 (store-match-data real-match-data)
698e1804
RS
418 (replace-match next-replacement nocasify literal)
419 (setq replace-count (1+ replace-count)))
420 (undo-boundary)
421 (let (done replaced)
422 (while (not done)
e5d77022 423 (let ((help-form
698e1804
RS
424 '(concat "Query replacing "
425 (if regexp-flag "regexp " "")
426 from-string " with " next-replacement ".\n\n"
427 (substitute-command-keys query-replace-help))))
428 (setq char help-char)
429 (while (or (not (numberp char)) (= char help-char))
430 (message "Query replacing %s with %s: " from-string next-replacement)
431 (setq char (read-event))
432 (if (and (numberp char) (= char ??))
e5d77022
JB
433 (setq unread-command-char help-char char help-char))))
434 ;; Restore the match data while we process the command.
435 (store-match-data real-match-data)
698e1804
RS
436 (cond ((or (= char ?\e)
437 (= char ?q))
438 (setq keep-going nil)
439 (setq done t))
440 ((= char ?^)
441 (let ((elt (car stack)))
442 (goto-char (car elt))
443 (setq replaced (eq t (cdr elt)))
444 (or replaced
445 (store-match-data (cdr elt)))
446 (setq stack (cdr stack))))
447 ((or (= char ?\ )
448 (= char ?y))
449 (or replaced
450 (replace-match next-replacement nocasify literal))
451 (setq done t replaced t))
452 ((= char ?\.)
453 (or replaced
454 (replace-match next-replacement nocasify literal))
455 (setq keep-going nil)
456 (setq done t replaced t))
457 ((= char ?\,)
458 (if (not replaced)
459 (progn
460 (replace-match next-replacement nocasify literal)
461 (setq replaced t))))
462 ((= char ?!)
463 (or replaced
464 (replace-match next-replacement nocasify literal))
465 (setq done t query-flag nil replaced t))
466 ((or (= char ?\177)
467 (= char ?n))
468 (setq done t))
469 ((= char ?\C-l)
470 (recenter nil))
471 ((= char ?\C-r)
472 (store-match-data
473 (prog1 (match-data)
da44e784
RM
474 (save-excursion (recursive-edit))))
475 ;; Before we make the replacement,
476 ;; decide whether the search string
477 ;; can match again just after this match.
478 (if regexp-flag
479 (setq match-again (looking-at search-string))))
698e1804
RS
480 ((= char ?\C-w)
481 (delete-region (match-beginning 0) (match-end 0))
482 (store-match-data
483 (prog1 (match-data)
484 (save-excursion (recursive-edit))))
485 (setq replaced t))
486 (t
487 (setq keep-going nil)
488 (setq unread-command-char char)
489 (setq done t))))
490 ;; Record previous position for ^ when we move on.
491 ;; Change markers to numbers in the match data
492 ;; since lots of markers slow down editing.
493 (setq stack
494 (cons (cons (point)
495 (or replaced
496 (mapcar
497 (function (lambda (elt)
498 (and elt
499 (marker-position elt))))
500 (match-data))))
501 stack))
502 (if replaced (setq replace-count (1+ replace-count)))))
503 (setq lastrepl (point)))
504 (and keep-going stack)))
505\f
506(defun map-query-replace-regexp (regexp to-strings &optional arg)
507 "Replace some matches for REGEXP with various strings, in rotation.
508The second argument TO-STRINGS contains the replacement strings, separated
509by spaces. This command works like `query-replace-regexp' except
da44e784
RM
510that each successive replacement uses the next successive replacement
511string, wrapping around from the last such string to the first.
698e1804
RS
512
513Non-interactively, TO-STRINGS may be a list of replacement strings.
514
515A prefix argument N says to use each replacement string N times
516before rotating to the next."
517 (interactive "sMap query replace (regexp): \nsQuery replace %s with (space-separated strings): \nP")
518 (let (replacements)
519 (if (listp to-strings)
520 (setq replacements to-strings)
521 (while (/= (length to-strings) 0)
522 (if (string-match " " to-strings)
523 (setq replacements
524 (append replacements
525 (list (substring to-strings 0
526 (string-match " " to-strings))))
527 to-strings (substring to-strings
528 (1+ (string-match " " to-strings))))
529 (setq replacements (append replacements (list to-strings))
530 to-strings ""))))
531 (perform-replace regexp replacements t t nil arg))
532 (message "Done"))
533
c88ab9ce 534;;; replace.el ends here