1 ;; Replace commands for Emacs.
2 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
4 ;; This file is part of GNU Emacs.
6 ;; GNU Emacs is free software; you can redistribute it and/or modify
7 ;; it under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 1, or (at your option)
11 ;; GNU Emacs is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;; GNU General Public License for more details.
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with GNU Emacs; see the file COPYING. If not, write to
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21 (fset 'delete-non-matching-lines
'keep-lines
)
22 (defun keep-lines (regexp)
23 "Delete all lines except those containing matches for REGEXP.
24 A match split across lines preserves all the lines it lies in.
25 Applies to all lines after point."
26 (interactive "sKeep lines (containing match for regexp): ")
28 (or (bolp) (forward-line 1))
29 (let ((start (point)))
31 ;; Start is first char not preserved by previous match.
32 (if (not (re-search-forward regexp nil
'move
))
33 (delete-region start
(point-max))
34 (let ((end (save-excursion (goto-char (match-beginning 0))
37 ;; Now end is first char preserved by the new match.
39 (delete-region start end
))))
40 (setq start
(save-excursion (forward-line 1)
43 (fset 'delete-matching-lines
'flush-lines
)
44 (defun flush-lines (regexp)
45 "Delete lines containing matches for REGEXP.
46 If a match is split across lines, all the lines it lies in are deleted.
47 Applies to lines after point."
48 (interactive "sFlush lines (containing match for regexp): ")
50 (while (and (not (eobp))
51 (re-search-forward regexp nil t
))
52 (delete-region (save-excursion (goto-char (match-beginning 0))
55 (progn (forward-line 1) (point))))))
57 (fset 'count-matches
'how-many
)
58 (defun how-many (regexp)
59 "Print number of matches for REGEXP following point."
60 (interactive "sHow many matches for (regexp): ")
61 (let ((count 0) (opoint -
1))
63 ;; If we did forward-char on the previous loop,
64 ;; and that brought us to eof, search anyway.
65 (while (and (or (not (eobp)) (/= opoint
(point)))
66 (re-search-forward regexp nil t
))
67 (if (prog1 (= opoint
(point)) (setq opoint
(point)))
69 (setq count
(1+ count
))))
70 (message "%d occurrences" count
))))
72 (defvar occur-mode-map
())
75 (setq occur-mode-map
(make-sparse-keymap))
76 (define-key occur-mode-map
"\C-c\C-c" 'occur-mode-goto-occurrence
))
78 (defvar occur-buffer nil
)
79 (defvar occur-nlines nil
)
80 (defvar occur-pos-list nil
)
83 "Major mode for output from \\[occur].
84 Move point to one of the occurrences in this buffer,
85 then use \\[occur-mode-goto-occurrence] to go to the same occurrence
86 in the buffer that the occurrences were found in.
88 (kill-all-local-variables)
89 (use-local-map occur-mode-map
)
90 (setq major-mode
'occur-mode
)
91 (setq mode-name
"Occur")
92 (make-local-variable 'occur-buffer
)
93 (make-local-variable 'occur-nlines
)
94 (make-local-variable 'occur-pos-list
))
96 (defun occur-mode-goto-occurrence ()
97 "Go to the line this occurrence was found in, in the buffer it was found in."
99 (if (or (null occur-buffer
)
100 (null (buffer-name occur-buffer
)))
102 (setq occur-buffer nil
104 (error "Buffer in which occurences were found is deleted.")))
105 (let* ((occur-number (save-excursion
107 (/ (1- (count-lines (point-min) (point)))
108 (cond ((< occur-nlines
0)
111 (+ 2 (* 2 occur-nlines
)))
113 (pos (nth occur-number occur-pos-list
)))
114 (pop-to-buffer occur-buffer
)
115 (goto-char (marker-position pos
))))
117 (defvar list-matching-lines-default-context-lines
0
118 "*Default number of context lines to include around a list-matching-lines
119 match. A negative number means to include that many lines before the match.
120 A positive number means to include that many lines both before and after.")
122 (fset 'list-matching-lines
'occur
)
123 (defun occur (regexp &optional nlines
)
124 "Show all lines following point containing a match for REGEXP.
125 Display each line with NLINES lines before and after,
126 or -NLINES before if NLINES is negative.
127 NLINES defaults to list-matching-lines-default-context-lines.
128 Interactively it is the prefix arg.
130 The lines are shown in a buffer named *Occur*.
131 It serves as a menu to find any of the occurrences in this buffer.
132 \\[describe-mode] in that buffer will explain how."
133 (interactive "sList lines matching regexp: \nP")
134 (setq nlines
(if nlines
(prefix-numeric-value nlines
)
135 list-matching-lines-default-context-lines
))
137 (buffer (current-buffer))
141 (setq linenum
(1+ (count-lines (point-min) (point))))
142 (setq prevpos
(point)))
143 (with-output-to-temp-buffer "*Occur*"
145 (set-buffer standard-output
)
146 (insert "Lines matching ")
148 (insert " in buffer " (buffer-name buffer
) ?. ?
\n)
150 (setq occur-buffer buffer
)
151 (setq occur-nlines nlines
)
152 (setq occur-pos-list
()))
153 (if (eq buffer standard-output
)
154 (goto-char (point-max)))
156 ;; Find next match, but give up if prev match was at end of buffer.
157 (while (and (not (= prevpos
(point-max)))
158 (re-search-forward regexp nil t
))
159 (beginning-of-line 1)
161 (setq linenum
(+ linenum
(count-lines prevpos
(point))))
162 (setq prevpos
(point)))
163 (let* ((start (save-excursion
164 (forward-line (if (< nlines
0) nlines
(- nlines
)))
168 (forward-line (1+ nlines
))
171 (tag (format "%3d" linenum
))
172 (empty (make-string (length tag
) ?\
))
175 (setq tem
(make-marker))
176 (set-marker tem
(point))
177 (set-buffer standard-output
)
178 (setq occur-pos-list
(cons tem occur-pos-list
))
179 (or first
(zerop nlines
)
180 (insert "--------\n"))
182 (insert-buffer-substring buffer start end
)
183 (backward-char (- end start
))
184 (setq tem
(if (< nlines
0) (- nlines
) nlines
))
191 (while (< tem nlines
)
194 (setq tem
(1+ tem
))))
196 (set-buffer standard-output
)
197 ;; Put positions in increasing order to go with buffer.
198 (setq occur-pos-list
(nreverse occur-pos-list
))
200 (message "%d matching lines." (length occur-pos-list
)))))))
202 (defconst query-replace-help
203 "Type Space or `y' to replace one match, Delete or `n' to skip to next,
204 ESC or `q' to exit, Period to replace one match and exit,
205 Comma to replace but not move point immediately,
206 C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
207 C-w to delete match and recursive edit,
208 C-l to clear the screen, redisplay, and offer same replacement again,
209 ! to replace all remaining matches with no more questions,
210 ^ to move point back to previous match.
212 Type a Space now to remove this message."
213 "Help message while in query-replace")
215 (defun perform-replace (from-string to-string
216 query-flag regexp-flag delimited-flag
)
217 (let ((nocasify (not (and case-fold-search case-replace
218 (string-equal from-string
219 (downcase from-string
)))))
220 (literal (not regexp-flag
))
221 (search-function (if regexp-flag
're-search-forward
'search-forward
))
222 (search-string from-string
)
224 (lastrepl nil
)) ;Position after last match considered.
226 (setq search-function
're-search-forward
227 search-string
(concat "\\b"
228 (if regexp-flag from-string
229 (regexp-quote from-string
))
233 (while (and keep-going
237 (funcall search-function search-string nil t
)))
238 ;; Don't replace the null string
239 ;; right after end of previous replacement.
240 (if (eq lastrepl
(point))
244 (replace-match to-string nocasify literal
)
247 ;; Preserve the match data. Process filters and sentinels
248 ;; could run inside read-char..
249 (let ((data (match-data))
251 '(concat "Query replacing "
252 (if regexp-flag
"regexp " "")
253 from-string
" with " to-string
".\n\n"
254 (substitute-command-keys query-replace-help
))))
255 (setq char help-char
)
256 (while (= char help-char
)
257 (message "Query replacing %s with %s: " from-string to-string
)
258 (setq char
(read-char))
260 (setq unread-command-char help-char char help-char
)))
261 (store-match-data data
))
262 (cond ((or (= char ?\e
)
264 (setq keep-going nil
)
272 (replace-match to-string nocasify literal
))
276 (replace-match to-string nocasify literal
))
277 (setq keep-going nil
)
282 (replace-match to-string nocasify literal
)
286 (replace-match to-string nocasify literal
))
287 (setq done t query-flag nil
))
296 (save-excursion (recursive-edit)))))
298 (delete-region (match-beginning 0) (match-end 0))
301 (save-excursion (recursive-edit))))
304 (setq keep-going nil
)
305 (setq unread-command-char char
)
307 (setq lastrepl
(point))))