X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3a52ccf7c2effeba40fb15950495ccdf8e32ef12..88312cfc5990060c2d5d54002774ef07e354dd12:/lisp/replace.el

diff --git a/lisp/replace.el b/lisp/replace.el
index 86956a614c..2c6b02364b 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1,7 +1,7 @@
 ;;; replace.el --- replace commands for Emacs
 
-;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2013 Free
-;; Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2013
+;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Package: emacs
@@ -246,10 +246,14 @@ Matching is independent of case if `case-fold-search' is non-nil and
 FROM-STRING has no uppercase letters.  Replacement transfers the case
 pattern 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.  \(Transferring the case pattern means that if the old text
+letters.  (Transferring the case pattern means that if the old text
 matched is all caps, or capitalized, then its replacement is upcased
 or capitalized.)
 
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using `isearch-filter-predicate'.
+
 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'.
@@ -300,6 +304,10 @@ pattern of the old text to the new text, if `case-replace' and
 all caps, or capitalized, then its replacement is upcased or
 capitalized.)
 
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using `isearch-filter-predicate'.
+
 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'.
@@ -380,6 +388,10 @@ that reads REGEXP.
 Preserves case in each replacement if `case-replace' and `case-fold-search'
 are non-nil and REGEXP has no uppercase letters.
 
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using `isearch-filter-predicate'.
+
 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'.
@@ -470,16 +482,21 @@ 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.)
 
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using `isearch-filter-predicate'.
+
 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'.
 
-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.
-
 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 only matches surrounded by word boundaries.
-Fourth and fifth arg START and END specify the region to operate on.
+
+Operates on the region between START and END (if both are nil, from point
+to the end of the buffer).  Interactively, if Transient Mark mode is
+enabled and the mark is active, operates on the contents of the region;
+otherwise from point to the end of the buffer.
 
 Use \\<minibuffer-local-map>\\[next-history-element] \
 to pull the last incremental search string to the minibuffer
@@ -506,12 +523,18 @@ and TO-STRING is also null.)"
 	   (if (and transient-mark-mode mark-active)
 	       (region-end)))))
   (perform-replace from-string to-string nil nil delimited nil nil start end))
+(put 'replace-string 'interactive-only
+     "use `search-forward' and `replace-match' instead.")
 
 (defun replace-regexp (regexp to-string &optional delimited start end)
   "Replace things after point matching REGEXP with TO-STRING.
 Preserve case in each match if `case-replace' and `case-fold-search'
 are non-nil and REGEXP has no uppercase letters.
 
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using `isearch-filter-predicate'.
+
 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'.
@@ -569,6 +592,8 @@ which will run faster and will not set the mark or print anything."
 	   (if (and transient-mark-mode mark-active)
 	       (region-end)))))
   (perform-replace regexp to-string nil t delimited nil nil start end))
+(put 'replace-regexp 'interactive-only
+     "use `re-search-forward' and `replace-match' instead.")
 
 
 (defvar regexp-history nil
@@ -789,9 +814,12 @@ a previously found match."
    (keep-lines-read-args "How many matches for regexp"))
   (save-excursion
     (if rstart
-	(progn
-	  (goto-char (min rstart rend))
-	  (setq rend (max rstart rend)))
+        (if rend
+            (progn
+              (goto-char (min rstart rend))
+              (setq rend (max rstart rend)))
+          (goto-char rstart)
+          (setq rend (point-max)))
       (if (and interactive transient-mark-mode mark-active)
 	  (setq rstart (region-beginning)
 		rend (region-end))
@@ -1155,8 +1183,8 @@ is called only during interactive use.
 
 For example, to check for occurrence of symbol at point use
 
-    \(setq occur-read-regexp-defaults-function
-	  'find-tag-default-as-regexp\).")
+    (setq occur-read-regexp-defaults-function
+	  'find-tag-default-as-regexp).")
 
 (defun occur-read-regexp-defaults ()
   "Return the latest regexp from `regexp-history'.
@@ -1369,16 +1397,18 @@ See also `multi-occur'."
 (defun occur-engine (regexp buffers out-buf nlines case-fold
 			    title-face prefix-face match-face keep-props)
   (with-current-buffer out-buf
-    (let ((globalcount 0)
+    (let ((global-lines 0)    ;; total count of matching lines
+	  (global-matches 0)  ;; total count of matches
 	  (coding nil)
 	  (case-fold-search case-fold))
       ;; Map over all the buffers
       (dolist (buf buffers)
 	(when (buffer-live-p buf)
-	  (let ((matches 0)	;; count of matched lines
-		(lines 1)	;; line count
-		(prev-after-lines nil)	;; context lines of prev match
-		(prev-lines nil)        ;; line number of prev match endpt
+	  (let ((lines 0)               ;; count of matching lines
+		(matches 0)             ;; count of matches
+		(curr-line 1)           ;; line count
+		(prev-line nil)         ;; line number of prev match endpt
+		(prev-after-lines nil)  ;; context lines of prev match
 		(matchbeg 0)
 		(origpt nil)
 		(begpt nil)
@@ -1399,7 +1429,7 @@ See also `multi-occur'."
 		(while (not (eobp))
 		  (setq origpt (point))
 		  (when (setq endpt (re-search-forward regexp nil t))
-		    (setq matches (1+ matches)) ;; increment match count
+		    (setq lines (1+ lines)) ;; increment matching lines count
 		    (setq matchbeg (match-beginning 0))
 		    ;; Get beginning of first match line and end of the last.
 		    (save-excursion
@@ -1408,7 +1438,7 @@ See also `multi-occur'."
 		      (goto-char endpt)
 		      (setq endpt (line-end-position)))
 		    ;; Sum line numbers up to the first match line.
-		    (setq lines (+ lines (count-lines origpt begpt)))
+		    (setq curr-line (+ curr-line (count-lines origpt begpt)))
 		    (setq marker (make-marker))
 		    (set-marker marker matchbeg)
 		    (setq curstring (occur-engine-line begpt endpt keep-props))
@@ -1417,6 +1447,7 @@ See also `multi-occur'."
 			  (start 0))
 		      (while (and (< start len)
 				  (string-match regexp curstring start))
+			(setq matches (1+ matches))
 			(add-text-properties
 			 (match-beginning 0) (match-end 0)
 			 (append
@@ -1426,11 +1457,13 @@ See also `multi-occur'."
 			    ;; so as to override faces copied from the buffer.
 			    `(face ,match-face)))
 			 curstring)
-			(setq start (match-end 0))))
+			;; Avoid infloop (Bug#7593).
+			(let ((end (match-end 0)))
+			  (setq start (if (= start end) (1+ start) end)))))
 		    ;; Generate the string to insert for this match
 		    (let* ((match-prefix
 			    ;; Using 7 digits aligns tabs properly.
-			    (apply #'propertize (format "%7d:" lines)
+			    (apply #'propertize (format "%7d:" curr-line)
 				   (append
 				    (when prefix-face
 				      `(font-lock-face ,prefix-face))
@@ -1470,7 +1503,7 @@ See also `multi-occur'."
 			      ;; The complex multi-line display style.
 			      (setq ret (occur-context-lines
 					 out-line nlines keep-props begpt endpt
-					 lines prev-lines prev-after-lines
+					 curr-line prev-line prev-after-lines
 					 prefix-face))
 			      ;; Set first elem of the returned list to `data',
 			      ;; and the second elem to `prev-after-lines'.
@@ -1483,28 +1516,34 @@ See also `multi-occur'."
 		  (if endpt
 		      (progn
 			;; Sum line numbers between first and last match lines.
-			(setq lines (+ lines (count-lines begpt endpt)
-				       ;; Add 1 for empty last match line since
-				       ;; count-lines returns 1 line less.
-				       (if (and (bolp) (eolp)) 1 0)))
+			(setq curr-line (+ curr-line (count-lines begpt endpt)
+					   ;; Add 1 for empty last match line since
+					   ;; count-lines returns 1 line less.
+					   (if (and (bolp) (eolp)) 1 0)))
 			;; On to the next match...
 			(forward-line 1))
 		    (goto-char (point-max)))
-		  (setq prev-lines (1- lines)))
+		  (setq prev-line (1- curr-line)))
 		;; Flush remaining context after-lines.
 		(when prev-after-lines
 		  (with-current-buffer out-buf
 		    (insert (apply #'concat (occur-engine-add-prefix
 					     prev-after-lines prefix-face)))))))
-	    (when (not (zerop matches)) ;; is the count zero?
-	      (setq globalcount (+ globalcount matches))
+	    (when (not (zerop lines)) ;; is the count zero?
+	      (setq global-lines (+ global-lines lines)
+		    global-matches (+ global-matches matches))
 	      (with-current-buffer out-buf
 		(goto-char headerpt)
 		(let ((beg (point))
 		      end)
 		  (insert (propertize
-			   (format "%d match%s%s in buffer: %s\n"
+			   (format "%d match%s%s%s in buffer: %s\n"
 				   matches (if (= matches 1) "" "es")
+				   ;; Don't display the same number of lines
+				   ;; and matches in case of 1 match per line.
+				   (if (= lines matches)
+				       "" (format " in %d line%s"
+						  lines (if (= lines 1) "" "s")))
 				   ;; Don't display regexp for multi-buffer.
 				   (if (> (length buffers) 1)
 				       "" (format " for \"%s\""
@@ -1519,12 +1558,17 @@ See also `multi-occur'."
 					`(occur-title ,buf))))
 		(goto-char (point-min)))))))
       ;; Display total match count and regexp for multi-buffer.
-      (when (and (not (zerop globalcount)) (> (length buffers) 1))
+      (when (and (not (zerop global-lines)) (> (length buffers) 1))
 	(goto-char (point-min))
 	(let ((beg (point))
 	      end)
-	  (insert (format "%d match%s total for \"%s\":\n"
-			  globalcount (if (= globalcount 1) "" "es")
+	  (insert (format "%d match%s%s total for \"%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)))
 	  (setq end (point))
 	  (add-text-properties beg end (when title-face
@@ -1536,7 +1580,7 @@ See also `multi-occur'."
 	  ;; buffer.
 	  (set-buffer-file-coding-system coding))
       ;; Return the number of matches
-      globalcount)))
+      global-matches)))
 
 (defun occur-engine-line (beg end &optional keep-props)
   (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
@@ -1579,13 +1623,13 @@ See also `multi-occur'."
 ;; Generate context display for occur.
 ;; OUT-LINE is the line where the match is.
 ;; NLINES and KEEP-PROPS are args to occur-engine.
-;; LINES is line count of the current match,
-;; PREV-LINES is line count of the previous match,
+;; CURR-LINE is line count of the current match,
+;; PREV-LINE is line count of the previous match,
 ;; PREV-AFTER-LINES is a list of after-context lines of the previous match.
 ;; Generate a list of lines, add prefixes to all but OUT-LINE,
 ;; then concatenate them all together.
 (defun occur-context-lines (out-line nlines keep-props begpt endpt
-				     lines prev-lines prev-after-lines
+				     curr-line prev-line prev-after-lines
 				     &optional prefix-face)
   ;; Find after- and before-context lines of the current match.
   (let ((before-lines
@@ -1601,22 +1645,22 @@ See also `multi-occur'."
 
     (when prev-after-lines
       ;; Don't overlap prev after-lines with current before-lines.
-      (if (>= (+ prev-lines (length prev-after-lines))
-	      (- lines      (length before-lines)))
+      (if (>= (+ prev-line (length prev-after-lines))
+	      (- curr-line      (length before-lines)))
 	  (setq prev-after-lines
 		(butlast prev-after-lines
 			 (- (length prev-after-lines)
-			    (- lines prev-lines (length before-lines) 1))))
+			    (- curr-line prev-line (length before-lines) 1))))
 	;; Separate non-overlapping context lines with a dashed line.
 	(setq separator "-------\n")))
 
-    (when prev-lines
+    (when prev-line
       ;; Don't overlap current before-lines with previous match line.
-      (if (<= (- lines (length before-lines))
-	      prev-lines)
+      (if (<= (- curr-line (length before-lines))
+	      prev-line)
 	  (setq before-lines
 		(nthcdr (- (length before-lines)
-			   (- lines prev-lines 1))
+			   (- curr-line prev-line 1))
 			before-lines))
 	;; Separate non-overlapping before-context lines.
 	(unless (> nlines 0)
@@ -1755,7 +1799,12 @@ type them using Lisp syntax."
 
 (defun replace-eval-replacement (expression count)
   (let* ((replace-count count)
-         (replacement (eval expression)))
+         err
+         (replacement
+          (condition-case err
+              (eval expression)
+            (error
+             (error "Error evaluating replacement expression: %S" err)))))
     (if (stringp replacement)
         replacement
       (prin1-to-string replacement t))))
@@ -1840,7 +1889,7 @@ It is called with three arguments, as if it were
 
 (defun replace-search (search-string limit regexp-flag delimited-flag
 				     case-fold-search)
-  "Search for the next occurence of SEARCH-STRING to replace."
+  "Search for the next occurrence of SEARCH-STRING to replace."
   ;; Let-bind global isearch-* variables to values used
   ;; to search the next replacement.  These let-bindings
   ;; should be effective both at the time of calling
@@ -1934,6 +1983,9 @@ make, or the user didn't cancel the call."
          (keep-going t)
          (stack nil)
          (replace-count 0)
+         (skip-read-only-count 0)
+         (skip-filtered-count 0)
+         (skip-invisible-count 0)
          (nonempty-match nil)
 	 (multi-buffer nil)
 	 (recenter-last-op nil)	; Start cycling order with initial position.
@@ -2042,20 +2094,26 @@ make, or the user didn't cancel the call."
 				(and (/= (nth 0 match) (nth 1 match))
 				     match))))))
 
-	  ;; Optionally ignore matches that have a read-only property.
-	  (when (and (or (not query-replace-skip-read-only)
-			 (not (text-property-not-all
-			       (nth 0 real-match-data) (nth 1 real-match-data)
-			       'read-only nil)))
-		     ;; Optionally filter out matches.
-		     (run-hook-with-args-until-failure
-		      'isearch-filter-predicates
-		      (nth 0 real-match-data) (nth 1 real-match-data))
-		     ;; Optionally ignore invisible matches.
-		     (or (eq search-invisible t)
-			 (not (isearch-range-invisible
-			       (nth 0 real-match-data) (nth 1 real-match-data)))))
-
+	  (cond
+	   ;; Optionally ignore matches that have a read-only property.
+	   ((not (or (not query-replace-skip-read-only)
+		     (not (text-property-not-all
+			   (nth 0 real-match-data) (nth 1 real-match-data)
+			   'read-only nil))))
+	    (setq skip-read-only-count (1+ skip-read-only-count)))
+	   ;; Optionally filter out matches.
+	   ((not (funcall isearch-filter-predicate
+                          (nth 0 real-match-data) (nth 1 real-match-data)))
+	    (setq skip-filtered-count (1+ skip-filtered-count)))
+	   ;; Optionally ignore invisible matches.
+	   ((not (or (eq search-invisible t)
+		     ;; Don't open overlays for automatic replacements.
+		     (and (not query-flag) search-invisible)
+		     ;; Open hidden overlays for interactive replacements.
+		     (not (isearch-range-invisible
+			   (nth 0 real-match-data) (nth 1 real-match-data)))))
+	    (setq skip-invisible-count (1+ skip-invisible-count)))
+	   (t
 	    ;; Calculate the replacement string, if necessary.
 	    (when replacements
 	      (set-match-data real-match-data)
@@ -2112,7 +2170,10 @@ make, or the user didn't cancel the call."
 			 (with-output-to-temp-buffer "*Help*"
 			   (princ
 			    (concat "Query replacing "
-				    (if delimited-flag "word " "")
+				    (if delimited-flag
+					(or (and (symbolp delimited-flag)
+						 (get delimited-flag 'isearch-message-prefix))
+					    "word ") "")
 				    (if regexp-flag "regexp " "")
 				    from-string " with "
 				    next-replacement ".\n\n"
@@ -2260,13 +2321,31 @@ make, or the user didn't cancel the call."
 				 (match-end 0)
 				 (current-buffer))
 			      (match-data t)))
-		      stack)))))
+		      stack))))))
 
       (replace-dehighlight))
     (or unread-command-events
-	(message "Replaced %d occurrence%s"
+	(message "Replaced %d occurrence%s%s"
 		 replace-count
-		 (if (= replace-count 1) "" "s")))
+		 (if (= replace-count 1) "" "s")
+		 (if (> (+ skip-read-only-count
+			   skip-filtered-count
+			   skip-invisible-count) 0)
+		     (format " (skipped %s)"
+			     (mapconcat
+			      'identity
+			      (delq nil (list
+					 (if (> skip-read-only-count 0)
+					     (format "%s read-only"
+						     skip-read-only-count))
+					 (if (> skip-invisible-count 0)
+					     (format "%s invisible"
+						     skip-invisible-count))
+					 (if (> skip-filtered-count 0)
+					     (format "%s filtered out"
+						     skip-filtered-count))))
+			      ", "))
+		   "")))
     (or (and keep-going stack) multi-buffer)))
 
 ;;; replace.el ends here