;;; replace.el --- replace commands for Emacs
-;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2015 Free
+;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2016 Free
;; Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
:type 'boolean
:group 'matching)
+(defcustom replace-character-fold nil
+ "Non-nil means replacement commands should do character folding in matches.
+This means, for instance, that \\=' will match a large variety of
+unicode quotes.
+This variable affects `query-replace' and `replace-string', but not
+`replace-regexp'."
+ :type 'boolean
+ :group 'matching
+ :version "25.1")
+
(defcustom replace-lax-whitespace nil
"Non-nil means `query-replace' matches a sequence of whitespace chars.
When you enter a space or spaces in the strings to be replaced,
from Isearch by using a key sequence like `C-s C-s M-%'." "24.3")
(defcustom query-replace-from-to-separator
- (propertize
- (or (ignore-errors
- ;; Ignore errors when attempt to autoload char-displayable-p
- ;; fails while preparing to dump.
- (if (char-displayable-p ?\u2192) " \u2192 " " -> "))
- " -> ")
- 'face 'minibuffer-prompt)
+ (propertize (if (char-displayable-p ?→) " → " " -> ")
+ 'face 'minibuffer-prompt)
"String that separates FROM and TO in the history of replacement pairs."
+ ;; Avoids error when attempt to autoload char-displayable-p fails
+ ;; while preparing to dump, also stops customize-rogue listing this.
+ :initialize 'custom-initialize-delay
:group 'matching
:type 'sexp
:version "25.1")
:version "22.1")
(defcustom query-replace-show-replacement t
- "Non-nil means to show what actual replacement text will be."
+ "Non-nil means show substituted replacement text in the minibuffer.
+This variable affects only `query-replace-regexp'."
:type 'boolean
:group 'matching
:version "23.1")
(defun query-replace-descr (string)
(mapconcat 'isearch-text-char-description string ""))
+(defun query-replace--split-string (string)
+ "Split string STRING at a character with property `separator'"
+ (let* ((length (length string))
+ (split-pos (text-property-any 0 length 'separator t string)))
+ (if (not split-pos)
+ (substring-no-properties string)
+ (cl-assert (not (text-property-any (1+ split-pos) length 'separator t string)))
+ (cons (substring-no-properties string 0 split-pos)
+ (substring-no-properties string (1+ split-pos) length)))))
+
(defun query-replace-read-from (prompt regexp-flag)
"Query and return the `from' argument of a query-replace operation.
The return value can also be a pair (FROM . TO) indicating that the user
;; unavailable while preparing to dump.
(custom-reevaluate-setting 'query-replace-from-to-separator)
(let* ((history-add-new-input nil)
+ (text-property-default-nonsticky
+ (cons '(separator . t) text-property-default-nonsticky))
(separator
(when query-replace-from-to-separator
(propertize "\0"
(read-regexp prompt nil 'query-replace-from-to-history)
(read-from-minibuffer
prompt nil nil nil 'query-replace-from-to-history
- (car (if regexp-flag regexp-search-ring search-ring)) t)))))
+ (car (if regexp-flag regexp-search-ring search-ring)) t))))
+ (to))
(if (and (zerop (length from)) query-replace-defaults)
(cons (caar query-replace-defaults)
(query-replace-compile-replacement
(cdar query-replace-defaults) regexp-flag))
- (let* ((to (if (and (string-match separator from)
- (get-text-property (match-beginning 0) 'separator from))
- (substring-no-properties from (match-end 0))))
- (from (if to (substring-no-properties from 0 (match-beginning 0))
- (substring-no-properties from))))
- (add-to-history query-replace-from-history-variable from nil t)
- ;; Warn if user types \n or \t, but don't reject the input.
- (and regexp-flag
- (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
- (let ((match (match-string 3 from)))
- (cond
- ((string= match "\\n")
- (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
- ((string= match "\\t")
- (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
- (sit-for 2)))
- (if (not to)
- from
- (add-to-history query-replace-to-history-variable to nil t)
- (add-to-history 'query-replace-defaults (cons from to) nil t)
- (cons from (query-replace-compile-replacement to regexp-flag))))))))
+ (setq from (query-replace--split-string from))
+ (when (consp from) (setq to (cdr from) from (car from)))
+ (add-to-history query-replace-from-history-variable from nil t)
+ ;; Warn if user types \n or \t, but don't reject the input.
+ (and regexp-flag
+ (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
+ (let ((match (match-string 3 from)))
+ (cond
+ ((string= match "\\n")
+ (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
+ ((string= match "\\t")
+ (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
+ (sit-for 2)))
+ (if (not to)
+ from
+ (add-to-history query-replace-to-history-variable to nil t)
+ (add-to-history 'query-replace-defaults (cons from to) nil t)
+ (cons from (query-replace-compile-replacement to regexp-flag)))))))
(defun query-replace-compile-replacement (to regexp-flag)
"Maybe convert a regexp replacement TO to Lisp.
(and current-prefix-arg (not (eq current-prefix-arg '-)))
(and current-prefix-arg (eq current-prefix-arg '-)))))
-(defun query-replace (from-string to-string &optional delimited start end backward)
+(defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p)
"Replace some occurrences of FROM-STRING with TO-STRING.
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 be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
+If `replace-character-fold' is non-nil, matching uses character folding,
+i.e. it ignores diacritics and other differences between equivalent
+character strings.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries. A negative prefix arg means
replace backward.
(if current-prefix-arg
(if (eq current-prefix-arg '-) " backward" " word")
"")
- (if (and transient-mark-mode mark-active) " in region" ""))
+ (if (use-region-p) " in region" ""))
nil)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
;; These are done separately here
;; so that command-history will record these expressions
;; rather than the values they had this time.
- (if (and transient-mark-mode mark-active)
- (region-beginning))
- (if (and transient-mark-mode mark-active)
- (region-end))
- (nth 3 common))))
- (perform-replace from-string to-string t nil delimited nil nil start end backward))
+ (if (use-region-p) (region-beginning))
+ (if (use-region-p) (region-end))
+ (nth 3 common)
+ (if (use-region-p) (region-noncontiguous-p)))))
+ (perform-replace from-string to-string t nil delimited nil nil start end backward region-noncontiguous-p))
(define-key esc-map "%" 'query-replace)
-(defun query-replace-regexp (regexp to-string &optional delimited start end backward)
+(defun query-replace-regexp (regexp to-string &optional delimited start end backward region-noncontiguous-p)
"Replace some things after point matching REGEXP with TO-STRING.
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 be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
+This function is not affected by `replace-character-fold'.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries. A negative prefix arg means
replace backward.
(if (eq current-prefix-arg '-) " backward" " word")
"")
" regexp"
- (if (and transient-mark-mode mark-active) " in region" ""))
+ (if (use-region-p) " in region" ""))
t)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
;; These are done separately here
;; so that command-history will record these expressions
;; rather than the values they had this time.
- (if (and transient-mark-mode mark-active)
- (region-beginning))
- (if (and transient-mark-mode mark-active)
- (region-end))
- (nth 3 common))))
- (perform-replace regexp to-string t t delimited nil nil start end backward))
+ (if (use-region-p) (region-beginning))
+ (if (use-region-p) (region-end))
+ (nth 3 common)
+ (if (use-region-p) (region-noncontiguous-p)))))
+ (perform-replace regexp to-string t t delimited nil nil start end backward region-noncontiguous-p))
(define-key esc-map [?\C-%] 'query-replace-regexp)
to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
+This function is not affected by `replace-character-fold'.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches that are surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on."
;; and the user might enter a single token.
(replace-match-string-symbols to)
(list from (car to) current-prefix-arg
- (if (and transient-mark-mode mark-active)
- (region-beginning))
- (if (and transient-mark-mode mark-active)
- (region-end))))))
+ (if (use-region-p) (region-beginning))
+ (if (use-region-p) (region-end))))))
(perform-replace regexp (cons 'replace-eval-replacement to-expr)
t 'literal delimited nil nil start end))
(list from to
(and current-prefix-arg
(prefix-numeric-value current-prefix-arg))
- (if (and transient-mark-mode mark-active)
- (region-beginning))
- (if (and transient-mark-mode mark-active)
- (region-end)))))
+ (if (use-region-p) (region-beginning))
+ (if (use-region-p) (region-end)))))
(let (replacements)
(if (listp to-strings)
(setq replacements to-strings)
to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
+If `replace-character-fold' is non-nil, matching uses character folding,
+i.e. it ignores diacritics and other differences between equivalent
+character strings.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries. A negative prefix arg means
replace backward.
(if (eq current-prefix-arg '-) " backward" " word")
"")
" string"
- (if (and transient-mark-mode mark-active) " in region" ""))
+ (if (use-region-p) " in region" ""))
nil)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
- (if (and transient-mark-mode mark-active)
- (region-beginning))
- (if (and transient-mark-mode mark-active)
- (region-end))
+ (if (use-region-p) (region-beginning))
+ (if (use-region-p) (region-end))
(nth 3 common))))
(perform-replace from-string to-string nil nil delimited nil nil start end backward))
to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
+This function is not affected by `replace-character-fold'
+
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 (eq current-prefix-arg '-) " backward" " word")
"")
" regexp"
- (if (and transient-mark-mode mark-active) " in region" ""))
+ (if (use-region-p) " in region" ""))
t)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
- (if (and transient-mark-mode mark-active)
- (region-beginning))
- (if (and transient-mark-mode mark-active)
- (region-end))
+ (if (use-region-p) (region-beginning))
+ (if (use-region-p) (region-end))
(nth 3 common))))
(perform-replace regexp to-string nil t delimited nil nil start end backward))
(unless (or (bolp) (eobp))
(forward-line 0))
(point-marker)))))
- (if (and interactive transient-mark-mode mark-active)
+ (if (and interactive (use-region-p))
(setq rstart (region-beginning)
rend (progn
(goto-char (region-end))
(progn
(goto-char (min rstart rend))
(setq rend (copy-marker (max rstart rend))))
- (if (and interactive transient-mark-mode mark-active)
+ (if (and interactive (use-region-p))
(setq rstart (region-beginning)
rend (copy-marker (region-end)))
(setq rstart (point)
(setq rend (max rstart rend)))
(goto-char rstart)
(setq rend (point-max)))
- (if (and interactive transient-mark-mode mark-active)
+ (if (and interactive (use-region-p))
(setq rstart (region-beginning)
rend (region-end))
(setq rstart (point)
buf))
(buffer-list))))))
+(defun occur-regexp-descr (regexp)
+ (format " for %s\"%s\""
+ (or (get-text-property 0 'isearch-regexp-function-descr regexp)
+ "")
+ (if (get-text-property 0 'isearch-string regexp)
+ (propertize
+ (query-replace-descr
+ (get-text-property 0 'isearch-string regexp))
+ 'help-echo regexp)
+ (query-replace-descr regexp))))
+
(defun occur-1 (regexp nlines bufs &optional buf-name)
(unless (and regexp (not (equal regexp "")))
(error "Occur doesn't work with the empty regexp"))
(if (= count 1) "" "es")
;; Don't display regexp if with remaining text
;; it is longer than window-width.
- (if (> (+ (length regexp) 42) (window-width))
- "" (format " for `%s'" (query-replace-descr regexp)))))
+ (if (> (+ (length (or (get-text-property 0 'isearch-string regexp)
+ regexp))
+ 42)
+ (window-width))
+ "" (occur-regexp-descr regexp))))
(setq occur-revert-arguments (list regexp nlines bufs))
(if (= count 0)
(kill-buffer occur-buf)
;; Highlight the matches
(let ((len (length curstring))
(start 0))
+ ;; Count empty lines that don't use next loop (Bug#22062).
+ (when (zerop len)
+ (setq matches (1+ matches)))
(while (and (< start len)
(string-match regexp curstring start))
(setq matches (1+ matches))
lines (if (= lines 1) "" "s")))
;; Don't display regexp for multi-buffer.
(if (> (length buffers) 1)
- "" (format " for \"%s\""
- (query-replace-descr regexp)))
+ "" (occur-regexp-descr regexp))
(buffer-name buf))
'read-only t))
(setq end (point))
(goto-char (point-min))
(let ((beg (point))
end)
- (insert (format "%d match%s%s total for \"%s\":\n"
+ (insert (format "%d match%s%s total%s:\n"
global-matches (if (= global-matches 1) "" "es")
;; Don't display the same number of lines
;; and matches in case of 1 match per line.
(if (= global-lines global-matches)
"" (format " in %d line%s"
global-lines (if (= global-lines 1) "" "s")))
- (query-replace-descr regexp)))
+ (occur-regexp-descr regexp)))
(setq end (point))
(when title-face
(add-face-text-property beg end title-face)))
(when backward (goto-char (nth 0 match-data)))
noedit)
+(defvar replace-update-post-hook nil
+ "Function(s) to call after query-replace has found a match in the buffer.")
+
(defvar replace-search-function nil
"Function to use when searching for strings to replace.
It is used by `query-replace' and `replace-string', and is called
;; outside of this function because then another I-search
;; used after `recursive-edit' might override them.
(let* ((isearch-regexp regexp-flag)
- (isearch-word delimited-flag)
+ (isearch-regexp-function (or delimited-flag
+ (and replace-character-fold
+ (not regexp-flag)
+ #'character-fold-to-regexp)))
(isearch-lax-whitespace
replace-lax-whitespace)
(isearch-regexp-lax-whitespace
(if query-replace-lazy-highlight
(let ((isearch-string search-string)
(isearch-regexp regexp-flag)
- (isearch-word delimited-flag)
+ (isearch-regexp-function delimited-flag)
(isearch-lax-whitespace
replace-lax-whitespace)
(isearch-regexp-lax-whitespace
(defun perform-replace (from-string replacements
query-flag regexp-flag delimited-flag
- &optional repeat-count map start end backward)
+ &optional repeat-count map start end backward region-noncontiguous-p)
"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:
`case-replace'.
This function returns nil if and only if there were no matches to
-make, or the user didn't cancel the call."
+make, or the user didn't cancel the call.
+
+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."
(or map (setq map query-replace-map))
(and query-flag minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
;; If non-nil, it is marker saying where in the buffer to stop.
(limit nil)
+ ;; Use local binding in add-function below.
+ (isearch-filter-predicate isearch-filter-predicate)
+ (region-bounds nil)
;; Data for the next match. If a cons, it has the same format as
;; (match-data); otherwise it is t if a match is possible at point.
"Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
minibuffer-prompt-properties))))
+ ;; Unless a single contiguous chunk is selected, operate on multiple chunks.
+ (when region-noncontiguous-p
+ (setq region-bounds
+ (mapcar (lambda (position)
+ (cons (copy-marker (car position))
+ (copy-marker (cdr position))))
+ (funcall region-extract-function 'bounds)))
+ (add-function :after-while isearch-filter-predicate
+ (lambda (start end)
+ (delq nil (mapcar
+ (lambda (bounds)
+ (and
+ (>= start (car bounds))
+ (<= start (cdr bounds))
+ (>= end (car bounds))
+ (<= end (cdr bounds))))
+ region-bounds)))))
+
;; If region is active, in Transient Mark mode, operate on region.
(if backward
(when end
(when (eq (lookup-key map (vector last-input-event)) 'automatic-all)
(setq query-flag nil multi-buffer t))
- ;; 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
(and nonempty-match
(or (not regexp-flag)
(and (if backward
- (looking-back search-string)
+ (looking-back search-string nil)
(looking-at search-string))
(let ((match (match-data)))
(and (/= (nth 0 match) (nth 1 match))
;; `real-match-data'.
(while (not done)
(set-match-data real-match-data)
- (replace-highlight
+ (run-hooks 'replace-update-post-hook) ; Before `replace-highlight'.
+ (replace-highlight
(match-beginning 0) (match-end 0)
start end search-string
regexp-flag delimited-flag case-fold-search backward)