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.)
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.
(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))
(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))
(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)))))))
\f
;; It would be nice to use \\[...], but there is no reasonable way
;; to make that display both SPC and Y.
(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)
(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)
(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"
(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)
((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