![[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 [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to replace.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / 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 distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: (fset 'delete-non-matching-lines 'keep-lines)
23: (defun keep-lines (regexp)
24: "Delete all lines except those containing matches for REGEXP.
25: A match split across lines preserves all the lines it lies in.
26: Applies to all lines after point."
27: (interactive "sKeep lines (containing match for regexp): ")
28: (save-excursion
29: (or (bolp) (forward-line 1))
30: (let ((start (point)))
31: (while (not (eobp))
32: ;; Start is first char not preserved by previous match.
33: (if (not (re-search-forward regexp nil 'move))
34: (delete-region start (point-max))
35: (let ((end (save-excursion (goto-char (match-beginning 0))
36: (beginning-of-line)
37: (point))))
38: ;; Now end is first char preserved by the new match.
39: (if (< start end)
40: (delete-region start end))))
41: (setq start (save-excursion (forward-line 1)
42: (point)))))))
43:
44: (fset 'delete-matching-lines 'flush-lines)
45: (defun flush-lines (regexp)
46: "Delete lines containing matches for REGEXP.
47: If a match is split across lines, all the lines it lies in are deleted.
48: Applies to lines after point."
49: (interactive "sFlush lines (containing match for regexp): ")
50: (save-excursion
51: (while (and (not (eobp))
52: (re-search-forward regexp nil t))
53: (delete-region (save-excursion (goto-char (match-beginning 0))
54: (beginning-of-line)
55: (point))
56: (progn (forward-line 1) (point))))))
57:
58: (fset 'count-matches 'how-many)
59: (defun how-many (regexp)
60: "Print number of matches for REGEXP following point."
61: (interactive "sHow many matches for (regexp): ")
62: (let ((count 0) opoint)
63: (save-excursion
64: (while (and (not (eobp))
65: (progn (setq opoint (point))
66: (re-search-forward regexp nil t)))
67: (if (= 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 (/ (1- (count-lines (point-min) (point)))
106: (cond ((< occur-nlines 0)
107: (- 2 occur-nlines))
108: ((> occur-nlines 0)
109: (+ 2 (* 2 occur-nlines)))
110: (t 1))))
111: (pos (nth occur-number occur-pos-list)))
112: (pop-to-buffer occur-buffer)
113: (goto-char (marker-position pos))))
114:
115: (defvar list-matching-lines-default-context-lines 0
116: "*Default number of context lines to include around a list-matching-lines
117: match. A negative number means to include that many lines before the match.
118: A positive number means to include that many lines both before and after.")
119:
120: (fset 'list-matching-lines 'occur)
121: (defun occur (regexp &optional nlines)
122: "Show all lines following point containing a match for REGEXP.
123: Display each line with NLINES lines before and after,
124: or -NLINES before if NLINES is negative.
125: NLINES defaults to list-matching-lines-default-context-lines.
126: Interactively it is the prefix arg.
127:
128: The lines are shown in a buffer named *Occur*.
129: It serves as a menu to find any of the occurrences in this buffer.
130: \\[describe-mode] in that buffer will explain how."
131: (interactive "sList lines matching regexp: \nP")
132: (setq nlines (if nlines (prefix-numeric-value nlines)
133: list-matching-lines-default-context-lines))
134: (let ((first t)
135: (buffer (current-buffer))
136: linenum prevpos)
137: (save-excursion
138: (beginning-of-line)
139: (setq linenum (1+ (count-lines (point-min) (point))))
140: (setq prevpos (point)))
141: (with-output-to-temp-buffer "*Occur*"
142: (save-excursion
143: (set-buffer standard-output)
144: (insert "Lines matching ")
145: (prin1 regexp)
146: (insert " in buffer " (buffer-name buffer) ?. ?\n)
147: (occur-mode)
148: (setq occur-buffer buffer)
149: (setq occur-nlines nlines)
150: (setq occur-pos-list ()))
151: (if (eq buffer standard-output)
152: (goto-char (point-max)))
153: (save-excursion
154: (while (re-search-forward regexp nil t)
155: (beginning-of-line 1)
156: (save-excursion
157: (setq linenum (+ linenum (count-lines prevpos (point))))
158: (setq prevpos (point)))
159: (let* ((start (save-excursion
160: (forward-line (if (< nlines 0) nlines (- nlines)))
161: (point)))
162: (end (save-excursion
163: (if (> nlines 0)
164: (forward-line (1+ nlines))
165: (forward-line 1))
166: (point)))
167: (tag (format "%3d" linenum))
168: (empty (make-string (length tag) ?\ ))
169: tem)
170: (save-excursion
171: (setq tem (make-marker))
172: (set-marker tem (point))
173: (set-buffer standard-output)
174: (setq occur-pos-list (cons tem occur-pos-list))
175: (or first (zerop nlines)
176: (insert "--------\n"))
177: (setq first nil)
178: (insert-buffer-substring buffer start end)
179: (backward-char (- end start))
180: (setq tem (if (< nlines 0) (- nlines) nlines))
181: (while (> tem 0)
182: (insert empty ?:)
183: (forward-line 1)
184: (setq tem (1- tem)))
185: (insert tag ?:)
186: (forward-line 1)
187: (while (< tem nlines)
188: (insert empty ?:)
189: (forward-line 1)
190: (setq tem (1+ tem))))
191: (forward-line 1)))
192: (set-buffer standard-output)
193: ;; Put positions in increasing order to go with buffer.
194: (setq occur-pos-list (nreverse occur-pos-list))
195: (if (interactive-p)
196: (message "%d matching lines." (length occur-pos-list)))))))
197:
198: (defconst query-replace-help
199: "Type Space or `y' to replace one match, Delete or `n' to skip to next,
200: ESC or `q' to exit, Period to replace one match and exit,
201: Comma to replace but not move point immediately,
202: C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
203: C-w to delete match and recursive edit,
204: C-l to clear the screen, redisplay, and offer same replacement again,
205: ! to replace all remaining matches with no more questions,
206: ^ to move point back to previous match."
207: "Help message while in query-replace")
208:
209: (defun perform-replace (from-string to-string
210: query-flag regexp-flag delimited-flag)
211: (let ((nocasify (not (and case-fold-search case-replace
212: (string-equal from-string
213: (downcase from-string)))))
214: (literal (not regexp-flag))
215: (search-function (if regexp-flag 're-search-forward 'search-forward))
216: (search-string from-string)
217: (keep-going t)
218: (lastrepl nil)) ;Position after last match considered.
219: (if delimited-flag
220: (setq search-function 're-search-forward
221: search-string (concat "\\b"
222: (if regexp-flag from-string
223: (regexp-quote from-string))
224: "\\b")))
225: (push-mark)
226: (push-mark)
227: (while (and keep-going
228: (not (eobp))
229: (progn
230: (set-mark (point))
231: (funcall search-function search-string nil t)))
232: ;; Don't replace the null string
233: ;; right after end of previous replacement.
234: (if (eq lastrepl (point))
235: (forward-char 1)
236: (undo-boundary)
237: (if (not query-flag)
238: (replace-match to-string nocasify literal)
239: (let (done replaced)
240: (while (not done)
241: ;; Preserve the match data. Process filters and sentinels
242: ;; could run inside read-char..
243: (let ((data (match-data))
244: (help-form
245: '(concat "Query replacing "
246: (if regexp-flag "regexp " "")
247: from-string " with " to-string ".\n\n"
248: (substitute-command-keys query-replace-help))))
249: (setq char help-char)
250: (while (= char help-char)
251: (message "Query replacing %s with %s: " from-string to-string)
252: (setq char (read-char))
253: (if (= char ??)
254: (setq unread-command-char help-char char help-char)))
255: (store-match-data data))
256: (cond ((or (= char ?\e)
257: (= char ?q))
258: (setq keep-going nil)
259: (setq done t))
260: ((= char ?^)
261: (goto-char (mark))
262: (setq replaced t))
263: ((or (= char ?\ )
264: (= char ?y))
265: (or replaced
266: (replace-match to-string nocasify literal))
267: (setq done t))
268: ((= char ?\.)
269: (or replaced
270: (replace-match to-string nocasify literal))
271: (setq keep-going nil)
272: (setq done t))
273: ((= char ?\,)
274: (if (not replaced)
275: (progn
276: (replace-match to-string nocasify literal)
277: (setq replaced t))))
278: ((= char ?!)
279: (or replaced
280: (replace-match to-string nocasify literal))
281: (setq done t query-flag nil))
282: ((or (= char ?\177)
283: (= char ?n))
284: (setq done t))
285: ((= char ?\C-l)
286: (recenter nil))
287: ((= char ?\C-r)
288: (store-match-data
289: (prog1 (match-data)
290: (save-excursion (recursive-edit)))))
291: ((= char ?\C-w)
292: (delete-region (match-beginning 0) (match-end 0))
293: (store-match-data
294: (prog1 (match-data)
295: (save-excursion (recursive-edit))))
296: (setq replaced t))
297: (t
298: (setq keep-going nil)
299: (setq unread-command-char char)
300: (setq done t))))))
301: (setq lastrepl (point))))
302: (pop-mark)
303: keep-going))
304:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.