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