![[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.