![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to replace.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to replace.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Replace commands for Emacs.
2: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
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)
9: ;; any later version.
10:
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.
15:
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.
19:
20:
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): ")
27: (save-excursion
28: (or (bolp) (forward-line 1))
29: (let ((start (point)))
30: (while (not (eobp))
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))
35: (beginning-of-line)
36: (point))))
37: ;; Now end is first char preserved by the new match.
38: (if (< start end)
39: (delete-region start end))))
40: (setq start (save-excursion (forward-line 1)
41: (point)))))))
42:
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): ")
49: (save-excursion
50: (while (and (not (eobp))
51: (re-search-forward regexp nil t))
52: (delete-region (save-excursion (goto-char (match-beginning 0))
53: (beginning-of-line)
54: (point))
55: (progn (forward-line 1) (point))))))
56:
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))
62: (save-excursion
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)))
68: (forward-char 1)
69: (setq count (1+ count))))
70: (message "%d occurrences" count))))
71:
72: (defvar occur-mode-map ())
73: (if occur-mode-map
74: ()
75: (setq occur-mode-map (make-sparse-keymap))
76: (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence))
77:
78: (defvar occur-buffer nil)
79: (defvar occur-nlines nil)
80: (defvar occur-pos-list nil)
81:
82: (defun occur-mode ()
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.
87: \\{occur-mode-map}"
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))
95:
96: (defun occur-mode-goto-occurrence ()
97: "Go to the line this occurrence was found in, in the buffer it was found in."
98: (interactive)
99: (if (or (null occur-buffer)
100: (null (buffer-name occur-buffer)))
101: (progn
102: (setq occur-buffer nil
103: occur-pos-list nil)
104: (error "Buffer in which occurences were found is deleted.")))
105: (let* ((occur-number (save-excursion
106: (beginning-of-line)
107: (/ (1- (count-lines (point-min) (point)))
108: (cond ((< occur-nlines 0)
109: (- 2 occur-nlines))
110: ((> occur-nlines 0)
111: (+ 2 (* 2 occur-nlines)))
112: (t 1)))))
113: (pos (nth occur-number occur-pos-list)))
114: (pop-to-buffer occur-buffer)
115: (goto-char (marker-position pos))))
116:
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.")
121:
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.
129:
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))
136: (let ((first t)
137: (buffer (current-buffer))
138: linenum prevpos)
139: (save-excursion
140: (beginning-of-line)
141: (setq linenum (1+ (count-lines (point-min) (point))))
142: (setq prevpos (point)))
143: (with-output-to-temp-buffer "*Occur*"
144: (save-excursion
145: (set-buffer standard-output)
146: (insert "Lines matching ")
147: (prin1 regexp)
148: (insert " in buffer " (buffer-name buffer) ?. ?\n)
149: (occur-mode)
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)))
155: (save-excursion
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)
160: (save-excursion
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)))
165: (point)))
166: (end (save-excursion
167: (if (> nlines 0)
168: (forward-line (1+ nlines))
169: (forward-line 1))
170: (point)))
171: (tag (format "%3d" linenum))
172: (empty (make-string (length tag) ?\ ))
173: tem)
174: (save-excursion
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"))
181: (setq first nil)
182: (insert-buffer-substring buffer start end)
183: (backward-char (- end start))
184: (setq tem (if (< nlines 0) (- nlines) nlines))
185: (while (> tem 0)
186: (insert empty ?:)
187: (forward-line 1)
188: (setq tem (1- tem)))
189: (insert tag ?:)
190: (forward-line 1)
191: (while (< tem nlines)
192: (insert empty ?:)
193: (forward-line 1)
194: (setq tem (1+ tem))))
195: (forward-line 1)))
196: (set-buffer standard-output)
197: ;; Put positions in increasing order to go with buffer.
198: (setq occur-pos-list (nreverse occur-pos-list))
199: (if (interactive-p)
200: (message "%d matching lines." (length occur-pos-list)))))))
201:
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.
211:
212: Type a Space now to remove this message."
213: "Help message while in query-replace")
214:
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)
223: (keep-going t)
224: (lastrepl nil)) ;Position after last match considered.
225: (if delimited-flag
226: (setq search-function 're-search-forward
227: search-string (concat "\\b"
228: (if regexp-flag from-string
229: (regexp-quote from-string))
230: "\\b")))
231: (push-mark)
232: (push-mark)
233: (while (and keep-going
234: (not (eobp))
235: (progn
236: (set-mark (point))
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))
241: (forward-char 1)
242: (undo-boundary)
243: (if (not query-flag)
244: (replace-match to-string nocasify literal)
245: (let (done replaced)
246: (while (not done)
247: ;; Preserve the match data. Process filters and sentinels
248: ;; could run inside read-char..
249: (let ((data (match-data))
250: (help-form
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))
259: (if (= char ??)
260: (setq unread-command-char help-char char help-char)))
261: (store-match-data data))
262: (cond ((or (= char ?\e)
263: (= char ?q))
264: (setq keep-going nil)
265: (setq done t))
266: ((= char ?^)
267: (goto-char (mark))
268: (setq replaced t))
269: ((or (= char ?\ )
270: (= char ?y))
271: (or replaced
272: (replace-match to-string nocasify literal))
273: (setq done t))
274: ((= char ?\.)
275: (or replaced
276: (replace-match to-string nocasify literal))
277: (setq keep-going nil)
278: (setq done t))
279: ((= char ?\,)
280: (if (not replaced)
281: (progn
282: (replace-match to-string nocasify literal)
283: (setq replaced t))))
284: ((= char ?!)
285: (or replaced
286: (replace-match to-string nocasify literal))
287: (setq done t query-flag nil))
288: ((or (= char ?\177)
289: (= char ?n))
290: (setq done t))
291: ((= char ?\C-l)
292: (recenter nil))
293: ((= char ?\C-r)
294: (store-match-data
295: (prog1 (match-data)
296: (save-excursion (recursive-edit)))))
297: ((= char ?\C-w)
298: (delete-region (match-beginning 0) (match-end 0))
299: (store-match-data
300: (prog1 (match-data)
301: (save-excursion (recursive-edit))))
302: (setq replaced t))
303: (t
304: (setq keep-going nil)
305: (setq unread-command-char char)
306: (setq done t))))))
307: (setq lastrepl (point))))
308: (pop-mark)
309: keep-going))
310:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.