![[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] / 43BSD / contrib / emacs / lisp|
Return to replace.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 root 1: ;; Replace commands for Emacs.
2: ;; Copyright (C) 1985 Richard M. Stallman.
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 lines not containing matches for REGEXP.
25: Applies to lines after point."
26: (interactive "sKeep lines (containing match for regexp): ")
27: (save-excursion
28: (while (not (eobp))
29: (let ((end (scan-buffer (point) 1 ?\n)))
30: (if (re-search-forward regexp end t)
31: (goto-char end)
32: (delete-region (point)
33: (if (re-search-forward regexp nil t)
34: (progn (beginning-of-line) (point))
35: (point-max))))))))
36:
37: (fset 'delete-matching-lines 'flush-lines)
38: (defun flush-lines (regexp)
39: "Delete lines containing matches for REGEXP.
40: Applies to lines after point."
41: (interactive "sFlush lines (containing match for regexp): ")
42: (save-excursion
43: (while (and (not (eobp))
44: (re-search-forward regexp nil t))
45: (beginning-of-line)
46: (delete-region (point)
47: (progn (forward-line 1) (point))))))
48:
49: (fset 'count-matches 'how-many)
50: (defun how-many (regexp)
51: "Print number of matches for REGEXP following point."
52: (interactive "sHow many (matches for regexp): ")
53: (let ((count 0) opoint)
54: (save-excursion
55: (while (and (not (eobp))
56: (progn (setq opoint (point))
57: (re-search-forward regexp nil t)))
58: (if (= opoint (point))
59: (forward-char 1)
60: (setq count (1+ count))))
61: (message "%d occurrences" count))))
62:
63: (fset 'list-matching-lines 'occur)
64: (defun occur (regexp &optional nlines)
65: "Show all lines containing of REGEXP following point.
66: Display each line with NLINES lines before and after.
67: NLINES defaults to 0. Interactively it is the prefix arg."
68: (interactive "sOccur (show lines matching regexp): \nP")
69: (setq nlines (if nlines (prefix-numeric-value nlines) 0))
70: (let ((first t))
71: (with-output-to-temp-buffer "*Occur*"
72: (save-excursion
73: (while (re-search-forward regexp nil t)
74: (let ((buffer (current-buffer))
75: (start
76: (save-excursion
77: (beginning-of-line)
78: (forward-line (- nlines))
79: (point)))
80: (end
81: (save-excursion
82: (forward-line (1+ nlines))
83: (point))))
84: (save-excursion
85: (set-buffer standard-output)
86: (or first
87: (insert "--------\n"))
88: (setq first nil)
89: (insert-buffer-substring buffer start end))
90: (forward-line 1)))))))
91:
92: (defconst query-replace-help
93: "Type Space to replace one match, Delete to skip to next,
94: ESC to exit, Period to replace one match and exit,
95: Comma to replace but not move point immediately,
96: C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
97: C-w to delete match and recursive edit,
98: ! to replace all remaining matches with no more questions,
99: ^ to move point back to previous match."
100: "Help message while in query-replace")
101:
102: (defun perform-replace (from-string to-string
103: query-flag regexp-flag delimited-flag)
104: (let ((nocasify (not (and case-fold-search case-replace
105: (string-equal from-string
106: (downcase from-string)))))
107: (literal (not regexp-flag))
108: (search-function (if regexp-flag 're-search-forward 'search-forward))
109: (search-string from-string)
110: (keep-going t)
111: (lastrepl nil) ;Position after last match considered.
112: (help-form
113: '(concat "Query replacing "
114: (if regexp-flag "regexp " "")
115: from-string " with " to-string ".\n\n"
116: (substitute-command-keys query-replace-help))))
117: (if delimited-flag
118: (setq search-function 're-search-forward
119: search-string (concat "\\b"
120: (if regexp-flag from-string
121: (regexp-quote from-string))
122: "\\b")))
123: (push-mark)
124: (push-mark)
125: (while (and keep-going
126: (not (eobp))
127: (progn
128: (set-mark (point))
129: (funcall search-function search-string nil t)))
130: ;; Don't replace the null string
131: ;; right after end of previous replacement.
132: (if (eq lastrepl (point))
133: (forward-char 1)
134: (undo-boundary)
135: (if (not query-flag)
136: (replace-match to-string nocasify literal)
137: (let (done replaced)
138: (while (not done)
139: (message "Query replacing %s with %s: " from-string to-string)
140: ;; Preserve the match data. Process filters and sentinels
141: ;; could run inside read-char..
142: (let ((data (match-data)))
143: (setq char (read-char))
144: (store-match-data data))
145: (cond ((not (memq char '(?\e ?\ ?\, ?\. ?! ?\177 ?\C-r ?\C-w ?^)))
146: (setq keep-going nil)
147: (setq unread-command-char char)
148: (setq done t))
149: ((= char ?\e)
150: (setq keep-going nil)
151: (setq done t))
152: ((= char ?^)
153: (goto-char (mark))
154: (setq replaced t))
155: ((= char ?\ )
156: (or replaced
157: (replace-match to-string nocasify literal))
158: (setq done t))
159: ((= char ?\.)
160: (or replaced
161: (replace-match to-string nocasify literal))
162: (setq keep-going nil)
163: (setq done t))
164: ((and (not replaced) (= char ?\,))
165: (replace-match to-string nocasify literal)
166: (setq replaced t))
167: ((= char ?!)
168: (or replaced
169: (replace-match to-string nocasify literal))
170: (setq done t query-flag nil))
171: ((= char ?\177)
172: (setq done t))
173: ((= char ?\C-r)
174: (store-match-data
175: (prog1 (match-data)
176: (save-excursion (recursive-edit)))))
177: ((= char ?\C-w)
178: (delete-region (match-beginning 0) (match-end 0))
179: (store-match-data
180: (prog1 (match-data)
181: (save-excursion (recursive-edit))))
182: (setq replaced t))))))
183: (setq lastrepl (point))))
184: (pop-mark)
185: (message "Done")
186: keep-going))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.