X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e730be7fbb147f2a5684b4a371e1842a4b8e180d..530893b26e86568f496415bead915d089469d3aa:/lisp/replace.el diff --git a/lisp/replace.el b/lisp/replace.el index adf56293f5..e0b815adfa 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1,6 +1,6 @@ -;;; replace.el --- replace commands for Emacs. +;;; replace.el --- replace commands for Emacs -;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000 +;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000, 2001 ;; Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -28,7 +28,7 @@ ;;; Code: (defcustom case-replace t - "*Non-nil means query-replace should preserve case in replacements." + "*Non-nil means `query-replace' should preserve case in replacements." :type 'boolean :group 'matching) @@ -39,7 +39,7 @@ That becomes the \"string to replace\".") (defcustom query-replace-from-history-variable 'query-replace-history - "History list to use for the FROM argument of query-replace commands. + "History list to use for the FROM argument of `query-replace' commands. The value of this variable should be a symbol; that symbol is used as a variable to hold a history list for the strings or patterns to be replaced." @@ -48,7 +48,7 @@ or patterns to be replaced." :version "20.3") (defcustom query-replace-to-history-variable 'query-replace-history - "History list to use for the TO argument of query-replace commands. + "History list to use for the TO argument of `query-replace' commands. The value of this variable should be a symbol; that symbol is used as a variable to hold a history list for replacement strings or patterns." @@ -136,8 +136,8 @@ If the result of TO-EXPR is not a string, it is converted to one using `prin1-to-string' with the NOESCAPE argument (which see). For convenience, when entering TO-EXPR interactively, you can use `\\&' or -`\\0'to stand for whatever matched the whole of REGEXP, and `\\=\\N' (where -N is a digit) stands for whatever what matched the Nth `\\(...\\)' in REGEXP. +`\0' to stand for whatever matched the whole of REGEXP, and `\N' (where +N is a digit) to stand for whatever matched the Nth `\(...\)' in REGEXP. Use `\\#&' or `\\#N' if you want a number instead of a string. In Transient Mark mode, if the mark is active, operate on the contents @@ -151,7 +151,7 @@ Preserves case in each replacement if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. +only matches that are surrounded by word boundaries. Fourth and fifth arg START and END specify the region to operate on." (interactive (let (from to start end) @@ -170,7 +170,7 @@ Fourth and fifth arg START and END specify the region to operate on." ;; We make TO a list because replace-match-string-symbols requires one, ;; and the user might enter a single token. (replace-match-string-symbols to) - (list from (car to) start end current-prefix-arg))) + (list from (car to) current-prefix-arg start end))) (perform-replace regexp (cons 'replace-eval-replacement to-expr) start end t t delimited)) @@ -279,94 +279,152 @@ What you probably want is a loop like this: which will run faster and will not set the mark or print anything." (interactive (query-replace-read-args "Replace regexp" t)) (perform-replace regexp to-string start end nil t delimited)) + (defvar regexp-history nil "History list for some commands that read regular expressions.") + (defalias 'delete-non-matching-lines 'keep-lines) -(defun keep-lines (regexp) +(defalias 'delete-matching-lines 'flush-lines) +(defalias 'count-matches 'how-many) + + +(defun keep-lines-read-args (prompt) + "Read arguments for `keep-lines' and friends. +Prompt for a regexp with PROMPT. +Value is a list, (REGEXP)." + (list (read-from-minibuffer prompt nil nil nil + 'regexp-history nil t))) + +(defun keep-lines (regexp &optional rstart rend) "Delete all lines except those containing matches for REGEXP. A match split across lines preserves all the lines it lies in. Applies to all lines after point. If REGEXP contains upper case characters (excluding those preceded by `\\'), -the matching is case-sensitive." - (interactive (list (read-from-minibuffer - "Keep lines (containing match for regexp): " - nil nil nil 'regexp-history nil t))) +the matching is case-sensitive. + +Second and third arg RSTART and REND specify the region to operate on. + +Interactively, in Transient Mark mode when the mark is active, operate +on the contents of the region. Otherwise, operate from point to the +end of the buffer." + + (interactive + (keep-lines-read-args "Keep lines (containing match for regexp): ")) + (if rstart + (goto-char (min rstart rend)) + (if (and transient-mark-mode mark-active) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (setq rstart (point) + rend (point-max-marker))) + (goto-char rstart)) (save-excursion (or (bolp) (forward-line 1)) (let ((start (point)) (case-fold-search (and case-fold-search (isearch-no-upper-case-p regexp t)))) - (while (not (eobp)) + (while (< (point) rend) ;; Start is first char not preserved by previous match. - (if (not (re-search-forward regexp nil 'move)) - (delete-region start (point-max)) + (if (not (re-search-forward regexp rend 'move)) + (delete-region start rend) (let ((end (save-excursion (goto-char (match-beginning 0)) (beginning-of-line) (point)))) ;; Now end is first char preserved by the new match. (if (< start end) (delete-region start end)))) - (setq start (save-excursion (forward-line 1) - (point))) + + (setq start (save-excursion (forward-line 1) (point))) ;; If the match was empty, avoid matching again at same place. - (and (not (eobp)) (= (match-beginning 0) (match-end 0)) + (and (< (point) rend) + (= (match-beginning 0) (match-end 0)) (forward-char 1)))))) -(defalias 'delete-matching-lines 'flush-lines) -(defun flush-lines (regexp) + +(defun flush-lines (regexp &optional rstart rend) "Delete lines containing matches for REGEXP. If a match is split across lines, all the lines it lies in are deleted. Applies to lines after point. If REGEXP contains upper case characters (excluding those preceded by `\\'), -the matching is case-sensitive." - (interactive (list (read-from-minibuffer - "Flush lines (containing match for regexp): " - nil nil nil 'regexp-history nil t))) +the matching is case-sensitive. + +Second and third arg RSTART and REND specify the region to operate on. + +Interactively, in Transient Mark mode when the mark is active, operate +on the contents of the region. Otherwise, operate from point to the +end of the buffer." + + (interactive + (keep-lines-read-args "Flush lines (containing match for regexp): ")) + (if rstart + (goto-char (min rstart rend)) + (if (and transient-mark-mode mark-active) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (setq rstart (point) + rend (point-max-marker))) + (goto-char rstart)) (let ((case-fold-search (and case-fold-search (isearch-no-upper-case-p regexp t)))) (save-excursion - (while (and (not (eobp)) - (re-search-forward regexp nil t)) + (while (and (< (point) rend) + (re-search-forward regexp rend t)) (delete-region (save-excursion (goto-char (match-beginning 0)) (beginning-of-line) (point)) (progn (forward-line 1) (point))))))) -(defalias 'count-matches 'how-many) -(defun how-many (regexp) + +(defun how-many (regexp &optional rstart rend) "Print number of matches for REGEXP following point. If REGEXP contains upper case characters (excluding those preceded by `\\'), -the matching is case-sensitive." - (interactive (list (read-from-minibuffer - "How many matches for (regexp): " - nil nil nil 'regexp-history nil t))) - (let ((count 0) opoint - (case-fold-search (and case-fold-search - (isearch-no-upper-case-p regexp t)))) - (save-excursion - (while (and (not (eobp)) - (progn (setq opoint (point)) - (re-search-forward regexp nil t))) - (if (= opoint (point)) - (forward-char 1) - (setq count (1+ count)))) - (message "%d occurrences" count)))) +the matching is case-sensitive. + +Second and third arg RSTART and REND specify the region to operate on. + +Interactively, in Transient Mark mode when the mark is active, operate +on the contents of the region. Otherwise, operate from point to the +end of the buffer." + + (interactive + (keep-lines-read-args "How many matches for (regexp): ")) + (save-excursion + (if rstart + (goto-char (min rstart rend)) + (if (and transient-mark-mode mark-active) + (setq rstart (region-beginning) + rend (copy-marker (region-end))) + (setq rstart (point) + rend (point-max-marker))) + (goto-char rstart)) + (let ((count 0) + opoint + (case-fold-search (and case-fold-search + (isearch-no-upper-case-p regexp t)))) + (while (and (< (point) rend) + (progn (setq opoint (point)) + (re-search-forward regexp rend t))) + (if (= opoint (point)) + (forward-char 1) + (setq count (1+ count)))) + (message "%d occurrences" count)))) + -(defvar occur-mode-map ()) -(if occur-mode-map - () - (setq occur-mode-map (make-sparse-keymap)) - (define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto) - (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence) - (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence) - (define-key occur-mode-map "\M-n" 'occur-next) - (define-key occur-mode-map "\M-p" 'occur-prev) - (define-key occur-mode-map "g" 'revert-buffer)) +(defvar occur-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'occur-mode-mouse-goto) + (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence) + (define-key map "\C-m" 'occur-mode-goto-occurrence) + (define-key map "\M-n" 'occur-next) + (define-key map "\M-p" 'occur-prev) + (define-key map "g" 'revert-buffer) + map) + "Keymap for `occur-mode'.") (defvar occur-buffer nil @@ -381,26 +439,20 @@ the matching is case-sensitive." (put 'occur-mode 'mode-class 'special) -(defun occur-mode () +(define-derived-mode occur-mode nil "Occur" "Major mode for output from \\[occur]. \\Move point to one of the items in this buffer, then use \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" - (kill-all-local-variables) - (use-local-map occur-mode-map) - (setq major-mode 'occur-mode) - (setq mode-name "Occur") - (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'occur-revert-function) + (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) (make-local-variable 'occur-buffer) (make-local-variable 'occur-nlines) - (make-local-variable 'occur-command-arguments) - (run-hooks 'occur-mode-hook)) + (make-local-variable 'occur-command-arguments)) (defun occur-revert-function (ignore1 ignore2) - "Handle revert-buffer for *Occur* buffers." + "Handle `revert-buffer' for *Occur* buffers." (let ((args occur-command-arguments )) (save-excursion (set-buffer occur-buffer) @@ -512,24 +564,39 @@ the matching is case-sensitive." (setq input default)) input) current-prefix-arg)) - (let ((nlines (if nlines - (prefix-numeric-value nlines) - list-matching-lines-default-context-lines)) - (first t) - ;;flag to prevent printing separator for first match - (occur-num-matches 0) - (buffer (current-buffer)) - (dir default-directory) - (linenum 1) - (prevpos - ;;position of most recent match - (point-min)) - (case-fold-search (and case-fold-search - (isearch-no-upper-case-p regexp t))) - (final-context-start - ;; Marker to the start of context immediately following - ;; the matched text in *Occur*. - (make-marker))) + (let* ((nlines (if nlines + (prefix-numeric-value nlines) + list-matching-lines-default-context-lines)) + (current-tab-width tab-width) + (inhibit-read-only t) + ;; Minimum width of line number plus trailing colon. + (min-line-number-width 6) + ;; Width of line number prefix without the colon. Choose a + ;; width that's a multiple of `tab-width' in the original + ;; buffer so that lines in *Occur* appear right. + (line-number-width (1- (* (/ (- (+ min-line-number-width + tab-width) + 1) + tab-width) + tab-width))) + ;; Format string for line numbers. + (line-number-format (format "%%%dd" line-number-width)) + (empty (make-string line-number-width ?\ )) + (first t) + ;;flag to prevent printing separator for first match + (occur-num-matches 0) + (buffer (current-buffer)) + (dir default-directory) + (linenum 1) + (prevpos + ;;position of most recent match + (point-min)) + (case-fold-search (and case-fold-search + (isearch-no-upper-case-p regexp t))) + (final-context-start + ;; Marker to the start of context immediately following + ;; the matched text in *Occur*. + (make-marker))) ;;; (save-excursion ;;; (beginning-of-line) ;;; (setq linenum (1+ (count-lines (point-min) (point)))) @@ -559,7 +626,7 @@ the matching is case-sensitive." (goto-char (point-max))) (save-excursion ;; Find next match, but give up if prev match was at end of buffer. - (while (and (not (= prevpos (point-max))) + (while (and (not (eobp)) (re-search-forward regexp nil t)) (goto-char (match-beginning 0)) (beginning-of-line) @@ -567,32 +634,27 @@ the matching is case-sensitive." (setq linenum (+ linenum (count-lines prevpos (point))))) (setq prevpos (point)) (goto-char (match-end 0)) - (let* ((start - ;;start point of text in source buffer to be put - ;;into *Occur* - (save-excursion + (let* (;;start point of text in source buffer to be put + ;;into *Occur* + (start (save-excursion (goto-char (match-beginning 0)) (forward-line (if (< nlines 0) nlines (- nlines))) (point))) - (end ;; end point of text in source buffer to be put ;; into *Occur* - (save-excursion - (goto-char (match-end 0)) - (if (> nlines 0) - (forward-line (1+ nlines)) - (forward-line 1)) - (point))) - (match-beg + (end (save-excursion + (goto-char (match-end 0)) + (if (> nlines 0) + (forward-line (1+ nlines)) + (forward-line 1)) + (point))) ;; Amount of context before matching text - (- (match-beginning 0) start)) - (match-len + (match-beg (- (match-beginning 0) start)) ;; Length of matching text - (- (match-end 0) (match-beginning 0))) - (tag (format "%5d" linenum)) - (empty (make-string (length tag) ?\ )) + (match-len (- (match-end 0) (match-beginning 0))) + (tag (format line-number-format linenum)) tem insertion-start ;; Number of lines of context to show for current match. @@ -605,8 +667,7 @@ the matching is case-sensitive." (text-end ;; Marker pointing to end of text for one match ;; in *Occur*. - (make-marker)) - ) + (make-marker))) (save-excursion (setq occur-marker (make-marker)) (set-marker occur-marker (point)) @@ -615,6 +676,9 @@ the matching is case-sensitive." (or first (zerop nlines) (insert "--------\n")) (setq first nil) + (save-excursion + (set-buffer "*Occur*") + (setq tab-width current-tab-width)) ;; Insert matching text including context lines from ;; source buffer into *Occur* @@ -667,7 +731,7 @@ the matching is case-sensitive." (let ((this-linenum linenum)) (while (< (point) final-context-start) (if (null tag) - (setq tag (format "%5d" this-linenum))) + (setq tag (format line-number-format this-linenum))) (insert tag ?:) (forward-line 1) (setq tag nil) @@ -686,9 +750,10 @@ the matching is case-sensitive." ;; Add text properties. The `occur' prop is used to ;; store the marker of the matching text in the ;; source buffer. - (put-text-property (marker-position text-beg) - (- (marker-position text-end) 1) - 'mouse-face 'highlight) + (add-text-properties + (marker-position text-beg) (- (marker-position text-end) 1) + '(mouse-face highlight + help-echo "mouse-2: go to this occurence")) (put-text-property (marker-position text-beg) (marker-position text-end) 'occur occur-marker) @@ -719,7 +784,7 @@ C-l to clear the screen, redisplay, and offer same replacement again, ! to replace all remaining matches with no more questions, ^ to move point back to previous match, E to edit the replacement string" - "Help message while in query-replace") + "Help message while in `query-replace'.") (defvar query-replace-map (make-sparse-keymap) "Keymap that defines the responses to questions in `query-replace'. @@ -736,6 +801,7 @@ The valid answers include `act', `skip', `act-and-show', (define-key query-replace-map "n" 'skip) (define-key query-replace-map "Y" 'act) (define-key query-replace-map "N" 'skip) +(define-key query-replace-map "e" 'edit-replacement) (define-key query-replace-map "E" 'edit-replacement) (define-key query-replace-map "," 'act-and-show) (define-key query-replace-map "q" 'exit) @@ -810,9 +876,13 @@ type them." "Subroutine of `query-replace'. Its complexity handles interactive queries. Don't use this in your own program unless you want to query and set the mark just as `query-replace' does. Instead, write a simple loop like this: - (while (re-search-forward \"foo[ \t]+bar\" nil t) + + (while (re-search-forward \"foo[ \\t]+bar\" nil t) (replace-match \"foobar\" nil nil)) -which will run faster and probably do exactly what you want." + +which will run faster and probably do exactly what you want. Please +see the documentation of `replace-match' to find out how to simulate +`case-replace'." (or map (setq map query-replace-map)) (and query-flag minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) @@ -885,16 +955,13 @@ which will run faster and probably do exactly what you want." (progn (goto-char (nth 1 match-again)) match-again) (and (or match-again - ;; MATCH-AGAIN nil means in the - ;; regexp case that there's no - ;; match adjacent to the last - ;; one. So, we could move - ;; forward, but we don't want to - ;; because that moves point 1 - ;; position after the last - ;; replacement when everything - ;; has been done. - regexp-flag + ;; MATCH-AGAIN non-nil means we + ;; accept an adjacent match. If + ;; we don't, move one char to the + ;; right. This takes us a + ;; character too far at the end, + ;; but this is undone after the + ;; while-loop. (progn (forward-char 1) (not (eobp)))) (funcall search-function search-string limit t) ;; For speed, use only integers and @@ -906,15 +973,20 @@ which will run faster and probably do exactly what you want." (setq nonempty-match (/= (nth 0 real-match-data) (nth 1 real-match-data))) - ;; If the match is empty, record that the next one can't be adjacent. + ;; If the match is empty, record that the next one can't be + ;; adjacent. + ;; Otherwise, if matching a regular expression, do the next ;; match now, since the replacement for this match may ;; affect whether the next match is adjacent to this one. + ;; If that match is empty, don't use it. (setq match-again (and nonempty-match (or (not regexp-flag) (and (looking-at search-string) - (match-data))))) + (let ((match (match-data))) + (and (/= (nth 0 match) (nth 1 match)) + match)))))) ;; Calculate the replacement string, if necessary. (when replacements @@ -954,8 +1026,7 @@ which will run faster and probably do exactly what you want." next-replacement ".\n\n" (substitute-command-keys query-replace-help))) - (save-excursion - (set-buffer standard-output) + (with-current-buffer standard-output (help-mode)))) ((eq def 'exit) (setq keep-going nil) @@ -1048,6 +1119,13 @@ which will run faster and probably do exactly what you want." (cons (cons (point) (or replaced (match-data t))) stack))))) + + ;; The code preventing adjacent regexp matches in the condition + ;; of the while-loop above will haven taken us one character + ;; beyond the last replacement. Undo that. + (when (and regexp-flag (not match-again) (> replace-count 0)) + (backward-char 1)) + (replace-dehighlight)) (or unread-command-events (message "Replaced %d occurrence%s"