X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/cd32a7baa4746f699fa4d945c1b1b9e50a9486da..0e9a110afd710bff9715076adbcdfd27b550cab0:/lisp/replace.el diff --git a/lisp/replace.el b/lisp/replace.el index 07d5892e45..76813d4e0b 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -80,7 +80,8 @@ If `query-replace-interactive' is non-nil, the last incremental search string is used as FROM-STRING--you don't have to specify it with the minibuffer. -Preserves case in each replacement if `case-replace' and `case-fold-search' +Replacement transfers the case of the old text to the new text, +if `case-replace' and `case-fold-search' are non-nil and FROM-STRING has no uppercase letters. \(Preserving case means that if the string matched is all caps, or capitalized, then its replacement is upcased or capitalized.) @@ -115,6 +116,50 @@ and `\\=\\N' (where N is a digit) stands for whatever what matched the Nth `\\(...\\)' in REGEXP." (interactive (query-replace-read-args "Query replace regexp" t)) (perform-replace regexp to-string t t arg)) +(define-key esc-map [?\C-%] 'query-replace-regexp) + +(defun query-replace-regexp-eval (regexp to-expr &optional arg) + "Replace some things after point matching REGEXP with the result of TO-EXPR. +As each match is found, the user must type a character saying +what to do with it. For directions, type \\[help-command] at that time. + +TO-EXPR is a Lisp expression evaluated to compute each replacement. It may +reference `replace-count' to get the number of replacements already made. +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. +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 +of the region. Otherwise, operate from point to the end of the buffer. + +If `query-replace-interactive' is non-nil, the last incremental search +regexp is used as REGEXP--you don't have to specify it with the +minibuffer. + +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." + (interactive + (let (from to) + (if query-replace-interactive + (setq from (car regexp-search-ring)) + (setq from (read-from-minibuffer "Query replace regexp: " + nil nil nil + query-replace-from-history-variable + nil t))) + (setq to (list (read-from-minibuffer + (format "Query replace regexp %s with eval: " from) + nil nil t query-replace-to-history-variable from t))) + ;; 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) current-prefix-arg))) + (perform-replace regexp (cons 'replace-eval-replacement to-expr) t t arg)) (defun map-query-replace-regexp (regexp to-strings &optional arg) "Replace some matches for REGEXP with various strings, in rotation. @@ -219,13 +264,18 @@ which will run faster and will not set the mark or print anything." (defun keep-lines (regexp) "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." +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))) (save-excursion (or (bolp) (forward-line 1)) - (let ((start (point))) + (let ((start (point)) + (case-fold-search (and case-fold-search + (isearch-no-upper-case-p regexp t)))) (while (not (eobp)) ;; Start is first char not preserved by previous match. (if (not (re-search-forward regexp nil 'move)) @@ -246,25 +296,35 @@ Applies to all lines after point." (defun flush-lines (regexp) "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." +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))) - (save-excursion - (while (and (not (eobp)) - (re-search-forward regexp nil t)) - (delete-region (save-excursion (goto-char (match-beginning 0)) - (beginning-of-line) - (point)) - (progn (forward-line 1) (point)))))) + (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)) + (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) - "Print number of matches for REGEXP following point." - (interactive (list(read-from-minibuffer - "How many matches for (regexp): " - nil nil nil 'regexp-history nil t))) - (let ((count 0) opoint) + "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)) @@ -621,7 +681,8 @@ the matching is case-sensitive." (format "%d lines" occur-num-matches)))) (insert message-string) (if (interactive-p) - (message "%s matched" message-string))))))))) + (message "%s matched" message-string))) + (setq buffer-read-only t))))))) ;; It would be nice to use \\[...], but there is no reasonable way ;; to make that display both SPC and Y. @@ -670,6 +731,54 @@ The valid answers include `act', `skip', `act-and-show', (define-key query-replace-map "\e" 'exit-prefix) (define-key query-replace-map [escape] 'exit-prefix) +(defun replace-match-string-symbols (n) + ;; Process a list (and any sub-lists), expanding certain symbols: + ;; Symbol Expands To + ;; N (match-string N) (where N is a string of digits) + ;; #N (string-to-number (match-string N)) + ;; & (match-string 0) + ;; #& (string-to-number (match-string 0)) + ;; + ;; Note that these symbols must be preceeded by a backslash in order to + ;; type them. + (while n + (cond + ((consp (car n)) + (replace-match-string-symbols (car n))) ;Process sub-list + ((symbolp (car n)) + (let ((name (symbol-name (car n)))) + (cond + ((string-match "^[0-9]+$" name) + (setcar n (list 'match-string (string-to-number name)))) + ((string-match "^#[0-9]+$" name) + (setcar n (list 'string-to-number + (list 'match-string + (string-to-number (substring name 1)))))) + ((string= "&" name) + (setcar n '(match-string 0))) + ((string= "#&" name) + (setcar n '(string-to-number (match-string 0)))))))) + (setq n (cdr n)))) + +(defun replace-eval-replacement (expression replace-count) + (let ((replacement (eval expression))) + (if (stringp replacement) + replacement + (prin1-to-string replacement t)))) + +(defun replace-loop-through-replacements (data replace-count) + ;; DATA is a vector contaning the following values: + ;; 0 next-rotate-count + ;; 1 repeat-count + ;; 2 next-replacement + ;; 3 replacements + (if (= (aref data 0) replace-count) + (progn + (aset data 0 (+ replace-count (aref data 1))) + (let ((next (cdr (aref data 2)))) + (aset data 2 (if (consp next) next (aref data 3)))))) + (car (aref data 2))) + (defun perform-replace (from-string replacements query-flag regexp-flag delimited-flag &optional repeat-count map) @@ -685,15 +794,16 @@ which will run faster and probably do exactly what you want." (let ((nocasify (not (and case-fold-search case-replace (string-equal from-string (downcase from-string))))) + (case-fold-search (and case-fold-search + (string-equal from-string + (downcase from-string)))) (literal (not regexp-flag)) (search-function (if regexp-flag 're-search-forward 'search-forward)) (search-string from-string) (real-match-data nil) ; the match data for the current match (next-replacement nil) - (replacement-index 0) (keep-going t) (stack nil) - (next-rotate-count 0) (replace-count 0) (nonempty-match nil) @@ -715,9 +825,22 @@ which will run faster and probably do exactly what you want." (setq limit (copy-marker (region-end))) (goto-char (region-beginning)) (deactivate-mark))) - (if (stringp replacements) - (setq next-replacement replacements) - (or repeat-count (setq repeat-count 1))) + + ;; REPLACEMENTS is either a string, a list of strings, or a cons cell + ;; containing a function and its first argument. The function is + ;; called to generate each replacement like this: + ;; (funcall (car replacements) (cdr replacements) replace-count) + ;; It must return a string. + (cond + ((stringp replacements) + (setq next-replacement replacements + replacements nil)) + ((stringp (car replacements)) ; If it isn't a string, it must be a cons + (or repeat-count (setq repeat-count 1)) + (setq replacements (cons 'replace-loop-through-replacements + (vector repeat-count repeat-count + replacements replacements))))) + (if delimited-flag (setq search-function 're-search-forward search-string (concat "\\b" @@ -761,14 +884,12 @@ which will run faster and probably do exactly what you want." (and (looking-at search-string) (match-data))))) - ;; If time for a change, advance to next replacement string. - (if (and (listp replacements) - (= next-rotate-count replace-count)) - (progn - (setq next-rotate-count - (+ next-rotate-count repeat-count)) - (setq next-replacement (nth replacement-index replacements)) - (setq replacement-index (% (1+ replacement-index) (length replacements))))) + ;; Calculate the replacement string, if necessary. + (when replacements + (set-match-data real-match-data) + (setq next-replacement + (funcall (car replacements) (cdr replacements) + replace-count))) (if (not query-flag) (progn (set-match-data real-match-data) @@ -848,10 +969,13 @@ which will run faster and probably do exactly what you want." ((eq def 'recenter) (recenter nil)) ((eq def 'edit) - (goto-char (match-beginning 0)) - (funcall search-function search-string limit t) - (setq real-match-data (match-data)) - (save-excursion (recursive-edit)) + (let ((opos (point-marker))) + (goto-char (match-beginning 0)) + (save-excursion + (funcall search-function search-string limit t) + (setq real-match-data (match-data))) + (save-excursion (recursive-edit)) + (goto-char opos)) (set-match-data real-match-data) ;; Before we make the replacement, ;; decide whether the search string