]> code.delx.au - gnu-emacs/blobdiff - lisp/replace.el
Update copyright year to 2016
[gnu-emacs] / lisp / replace.el
index 3a908ac4d8d6430b11472ecb164ea05da93432a0..f5c8d33b5f56ab990adde2266c409a956aa6903e 100644 (file)
@@ -1,6 +1,6 @@
 ;;; 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
   :group 'matching)
 
 (defcustom replace-character-fold nil
-  "Non-nil means `query-replace' should do character folding in matches.
+  "Non-nil means replacement commands should do character folding in matches.
 This means, for instance, that \\=' will match a large variety of
-unicode quotes."
+unicode quotes.
+This variable affects `query-replace' and `replace-string', but not
+`replace-regexp'."
   :type 'boolean
   :group 'matching
   :version "25.1")
@@ -111,7 +113,8 @@ strings or patterns."
   :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")
@@ -284,7 +287,7 @@ the original string if not."
          (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.
@@ -314,6 +317,10 @@ If `replace-lax-whitespace' is non-nil, a space or spaces in the string
 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.
@@ -328,22 +335,21 @@ To customize possible responses, change the bindings in `query-replace-map'."
                   (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.
@@ -373,6 +379,8 @@ If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the 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 surrounded by word boundaries.  A negative prefix arg means
 replace backward.
@@ -408,18 +416,17 @@ Use \\[repeat-complex-command] after this command for details."
                       (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)
 
@@ -462,6 +469,8 @@ If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the 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."
@@ -485,10 +494,8 @@ for Lisp calls." "22.1"))
        ;; 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))
 
@@ -523,10 +530,8 @@ Fourth and fifth arg START and END specify the region to operate on."
      (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)
@@ -557,6 +562,10 @@ If `replace-lax-whitespace' is non-nil, a space or spaces in the string
 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.
@@ -587,13 +596,11 @@ and TO-STRING is also null.)"
                       (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))
 
@@ -610,6 +617,8 @@ If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the 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'
+
 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.
 
@@ -661,13 +670,11 @@ which will run faster and will not set the mark or print anything."
                       (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))
 
@@ -832,7 +839,7 @@ a previously found match."
                  (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))
@@ -901,7 +908,7 @@ starting on the same line at which another match ended is ignored."
       (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)
@@ -951,7 +958,7 @@ a previously found match."
               (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)
@@ -1426,6 +1433,17 @@ See also `multi-occur'."
                               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"))
@@ -1494,9 +1512,11 @@ See also `multi-occur'."
                     (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-message
-                             " 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)
@@ -1557,6 +1577,9 @@ See also `multi-occur'."
                    ;; 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))
@@ -1657,8 +1680,7 @@ See also `multi-occur'."
                                                  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))
@@ -1671,14 +1693,14 @@ See also `multi-occur'."
        (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)))
@@ -1989,6 +2011,9 @@ passed in.  If LITERAL is set, no checking is done, anyway."
   (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
@@ -2013,7 +2038,7 @@ It is called with three arguments, as if it were
   ;; outside of this function because then another I-search
   ;; used after `recursive-edit' might override them.
   (let* ((isearch-regexp regexp-flag)
-        (isearch-word (or delimited-flag
+        (isearch-regexp-function (or delimited-flag
                            (and replace-character-fold
                                 (not regexp-flag)
                                 #'character-fold-to-regexp)))
@@ -2046,7 +2071,7 @@ It is called with three arguments, as if it were
   (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
@@ -2068,7 +2093,7 @@ It is called with three arguments, as if it were
 
 (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:
@@ -2115,6 +2140,9 @@ It must return a string."
 
          ;; 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.
@@ -2127,6 +2155,24 @@ It must return a string."
                       "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
@@ -2221,7 +2267,7 @@ It must return a string."
                (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))
@@ -2275,7 +2321,8 @@ It must return a string."
                ;; `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)