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