X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/237e6ab0561e86e787b2ccd129f009aa06d81c27..7c7ff7f5d18ebe74842db645eb6ff4b63e778f0b:/lisp/replace.el

diff --git a/lisp/replace.el b/lisp/replace.el
index ab7f2b13ce..fcb7ad423b 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1,6 +1,7 @@
 ;;; replace.el --- replace commands for Emacs.
 
-;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000
+;;  Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
@@ -15,8 +16,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
@@ -25,74 +27,187 @@
 
 ;;; Code:
 
-(defconst case-replace t "\
-*Non-nil means query-replace should preserve case in replacements.")
+(defcustom case-replace t
+  "*Non-nil means query-replace should preserve case in replacements."
+  :type 'boolean
+  :group 'matching)
 
 (defvar query-replace-history nil)
 
-(defun query-replace-read-args (string)
+(defvar query-replace-interactive nil
+  "Non-nil means `query-replace' uses the last search string.
+That becomes the \"string to replace\".")
+
+(defcustom query-replace-from-history-variable 'query-replace-history
+  "History list to use for the FROM argument of query-replace commands.
+The value of this variable should be a symbol; that symbol
+is used as a variable to hold a history list for the strings
+or patterns to be replaced."
+  :group 'matching
+  :type 'symbol
+  :version "20.3")
+
+(defcustom query-replace-to-history-variable 'query-replace-history
+  "History list to use for the TO argument of query-replace commands.
+The value of this variable should be a symbol; that symbol
+is used as a variable to hold a history list for replacement
+strings or patterns."
+  :group 'matching
+  :type 'symbol
+  :version "20.3")
+
+(defun query-replace-read-args (string regexp-flag)
   (let (from to)
-    (setq from (read-from-minibuffer (format "%s: " string)
-				     nil nil nil
-				     'query-replace-history))
+    (if query-replace-interactive
+	(setq from (car (if regexp-flag regexp-search-ring search-ring)))
+      (setq from (read-from-minibuffer (format "%s: " string)
+				       nil nil nil
+				       query-replace-from-history-variable
+				       nil t)))
     (setq to (read-from-minibuffer (format "%s %s with: " string from)
 				   nil nil nil
-				   'query-replace-history))
-    (list from to current-prefix-arg)))
+				   query-replace-to-history-variable from t))
+    (if (and transient-mark-mode mark-active)
+	(list from to current-prefix-arg (region-beginning) (region-end))
+      (list from to current-prefix-arg nil nil))))
 
-(defun query-replace (from-string to-string &optional arg)
+(defun query-replace (from-string to-string &optional delimited start end)
   "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.
 
-Preserves case in each replacement if  case-replace  and  case-fold-search
+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
+string is used as FROM-STRING--you don't have to specify it with the
+minibuffer.
+
+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.
-Third arg DELIMITED (prefix arg if interactive) non-nil means replace
+\(Preserving case means that if the string matched is all caps, or capitalized,
+then its replacement is upcased or capitalized.)
+
+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.
 
 To customize possible responses, change the \"bindings\" in `query-replace-map'."
-  (interactive (query-replace-read-args "Query replace"))
-  (perform-replace from-string to-string t nil arg)
-  (or unread-command-events (message "Done")))
+  (interactive (query-replace-read-args "Query replace" nil))
+  (perform-replace from-string to-string start end t nil delimited))
+
 (define-key esc-map "%" 'query-replace)
 
-(defun query-replace-regexp (regexp to-string &optional arg)
+(defun query-replace-regexp (regexp to-string &optional delimited start end)
   "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.
 
-Preserves case in each replacement if  case-replace  and  case-fold-search
+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.
+Fourth and fifth arg START and END specify the region to operate on.
+
+In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
+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 start end t t delimited))
+(define-key esc-map [?\C-%] 'query-replace-regexp)
+
+(defun query-replace-regexp-eval (regexp to-expr &optional delimited start end)
+  "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) non-nil means replace
+
+Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 only matches surrounded by word boundaries.
-In TO-STRING, \\& means insert what matched REGEXP,
-and \\=\\<n> means insert what matched <n>th \\(...\\) in REGEXP."
-  (interactive (query-replace-read-args "Query replace regexp"))
-  (perform-replace regexp to-string t t arg)
-  (or unread-command-events (message "Done")))
+Fourth and fifth arg START and END specify the region to operate on."
+  (interactive
+   (let (from to start end)
+     (when (and transient-mark-mode mark-active)
+       (setq start (region-beginning)
+	     end (region-end)))
+     (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) start end current-prefix-arg)))
+  (perform-replace regexp (cons 'replace-eval-replacement to-expr)
+		   start end t t delimited))
 
-(defun map-query-replace-regexp (regexp to-strings &optional arg)
+(defun map-query-replace-regexp (regexp to-strings &optional n start end)
   "Replace some matches for REGEXP with various strings, in rotation.
 The second argument TO-STRINGS contains the replacement strings, separated
 by spaces.  This command works like `query-replace-regexp' except
 that each successive replacement uses the next successive replacement string,
 wrapping around from the last such string to the first.
 
+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.
+
 Non-interactively, TO-STRINGS may be a list of replacement strings.
 
+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.
+
 A prefix argument N says to use each replacement string N times
-before rotating to the next."
+before rotating to the next.
+Fourth and fifth arg START and END specify the region to operate on."
   (interactive
-   (let (from to)
-     (setq from (read-from-minibuffer "Map query replace (regexp): "
-				      nil nil nil
-				      'query-replace-history))
+   (let (from to start end)
+     (when (and transient-mark-mode mark-active)
+       (setq start (region-beginning)
+	     end (region-end)))
+     (setq from (if query-replace-interactive
+		    (car regexp-search-ring)
+		  (read-from-minibuffer "Map query replace (regexp): "
+					nil nil nil
+					'query-replace-history nil t)))
      (setq to (read-from-minibuffer
 	       (format "Query replace %s with (space-separated strings): "
 		       from)
 	       nil nil nil
-	       'query-replace-history))
-     (list from to current-prefix-arg)))
+	       'query-replace-history from t))
+     (list from to start end current-prefix-arg)))
   (let (replacements)
     (if (listp to-strings)
 	(setq replacements to-strings)
@@ -106,42 +221,62 @@ before rotating to the next."
 				       (1+ (string-match " " to-strings))))
 	  (setq replacements (append replacements (list to-strings))
 		to-strings ""))))
-    (perform-replace regexp replacements t t nil arg))
-  (or unread-command-events (message "Done")))
+    (perform-replace regexp replacements start end t t nil n)))
 
-(defun replace-string (from-string to-string &optional delimited)
+(defun replace-string (from-string to-string &optional delimited start end)
   "Replace occurrences of FROM-STRING with TO-STRING.
 Preserve case in each match if `case-replace' and `case-fold-search'
 are non-nil and FROM-STRING has no uppercase letters.
-Third arg DELIMITED (prefix arg if interactive) non-nil means replace
+\(Preserving case means that if the string matched is all caps, or capitalized,
+then its replacement is upcased or capitalized.)
+
+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.
+
+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.
 
 This function is usually the wrong thing to use in a Lisp program.
 What you probably want is a loop like this:
-  (while (search-forward OLD-STRING nil t)
-    (replace-match REPLACEMENT nil t))
-which will run faster and will not set the mark or print anything."
-  (interactive (query-replace-read-args "Replace string"))
-  (perform-replace from-string to-string nil nil delimited)
-  (or unread-command-events (message "Done")))
+  (while (search-forward FROM-STRING nil t)
+    (replace-match TO-STRING nil t))
+which will run faster and will not set the mark or print anything.
+\(You may need a more complex loop if FROM-STRING can match the null string
+and TO-STRING is also null.)"
+  (interactive (query-replace-read-args "Replace string" nil))
+  (perform-replace from-string to-string start end nil nil delimited))
 
-(defun replace-regexp (regexp to-string &optional delimited)
+(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
+Preserve case in each match if `case-replace' and `case-fold-search'
 are non-nil and REGEXP has no uppercase letters.
-Third arg DELIMITED (prefix arg if interactive) non-nil means replace
+
+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.
-In TO-STRING, \\& means insert what matched REGEXP,
-and \\=\\<n> means insert what matched <n>th \\(...\\) in REGEXP.
+Fourth and fifth arg START and END specify the region to operate on.
+
+In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
+and `\\=\\N' (where N is a digit) stands for
+ whatever what matched the Nth `\\(...\\)' in REGEXP.
+
+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.
 
 This function is usually the wrong thing to use in a Lisp program.
 What you probably want is a loop like this:
   (while (re-search-forward REGEXP nil t)
-    (replace-match REPLACEMENT nil nil))
+    (replace-match TO-STRING nil nil))
 which will run faster and will not set the mark or print anything."
-  (interactive (query-replace-read-args "Replace regexp"))
-  (perform-replace regexp to-string nil t delimited)
-  (or unread-command-events (message "Done")))
+  (interactive (query-replace-read-args "Replace regexp" t))
+  (perform-replace regexp to-string start end nil t delimited))
 
 (defvar regexp-history nil
   "History list for some commands that read regular expressions.")
@@ -150,13 +285,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 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))
@@ -177,25 +317,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)))
-  (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))))))
+		      nil nil nil 'regexp-history nil t)))
+  (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."
+  "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)))
-  (let ((count 0) opoint)
+		      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))
@@ -209,60 +359,128 @@ Applies to lines after point."
 (if occur-mode-map
     ()
   (setq occur-mode-map (make-sparse-keymap))
-  (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence))
+  (define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto)
+  (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence)
+  (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence)
+  (define-key occur-mode-map "\M-n" 'occur-next)
+  (define-key occur-mode-map "\M-p" 'occur-prev)
+  (define-key occur-mode-map "g" 'revert-buffer))
+
+
+(defvar occur-buffer nil
+  "Name of buffer for last occur.")
 
-(defvar occur-buffer nil)
-(defvar occur-nlines nil)
-(defvar occur-pos-list nil)
+
+(defvar occur-nlines nil
+  "Number of lines of context to show around matching line.")
+
+(defvar occur-command-arguments nil
+  "Arguments that were given to `occur' when it made this buffer.")
+
+(put 'occur-mode 'mode-class 'special)
 
 (defun occur-mode ()
   "Major mode for output from \\[occur].
-Move point to one of the occurrences in this buffer,
-then use \\[occur-mode-goto-occurrence] to go to the same occurrence
-in the buffer that the occurrences were found in.
+\\<occur-mode-map>Move point to one of the items in this buffer, then use
+\\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
+Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
+
 \\{occur-mode-map}"
   (kill-all-local-variables)
   (use-local-map occur-mode-map)
   (setq major-mode 'occur-mode)
   (setq mode-name "Occur")
+  (make-local-variable 'revert-buffer-function)
+  (setq revert-buffer-function 'occur-revert-function)
   (make-local-variable 'occur-buffer)
   (make-local-variable 'occur-nlines)
-  (make-local-variable 'occur-pos-list)
+  (make-local-variable 'occur-command-arguments)
   (run-hooks 'occur-mode-hook))
 
-(defun occur-mode-goto-occurrence ()
-  "Go to the line this occurrence was found in, in the buffer it was found in."
-  (interactive)
+;; Handle revert-buffer for *Occur* buffers.
+(defun occur-revert-function (ignore1 ignore2)
+  (let ((args occur-command-arguments ))
+    (save-excursion
+      (set-buffer occur-buffer)
+      (apply 'occur args))))
+
+(defun occur-mode-mouse-goto (event)
+  "In Occur mode, go to the occurrence whose line you click on."
+  (interactive "e")
+  (let (buffer pos)
+    (save-excursion
+      (set-buffer (window-buffer (posn-window (event-end event))))
+      (save-excursion
+	(goto-char (posn-point (event-end event)))
+	(setq pos (occur-mode-find-occurrence))
+	(setq buffer occur-buffer)))
+    (pop-to-buffer buffer)
+    (goto-char (marker-position pos))))
+
+(defun occur-mode-find-occurrence ()
   (if (or (null occur-buffer)
 	  (null (buffer-name occur-buffer)))
       (progn
-	(setq occur-buffer nil
-	      occur-pos-list nil)
+	(setq occur-buffer nil)
 	(error "Buffer in which occurrences were found is deleted")))
-  (let* ((occur-number (save-excursion
-			 (beginning-of-line)
-			 (/ (1- (count-lines (point-min)
-					     (save-excursion
-					       (beginning-of-line)
-					       (point))))
-			    (cond ((< occur-nlines 0)
-				   (- 2 occur-nlines))
-				  ((> occur-nlines 0)
-				   (+ 2 (* 2 occur-nlines)))
-				  (t 1)))))
-	 (pos (nth occur-number occur-pos-list)))
-    (or pos
-	(error "No occurrence on this line"))
+  (let ((pos (get-text-property (point) 'occur)))
+    (if (null pos)
+	(error "No occurrence on this line")
+      pos)))
+
+(defun occur-mode-goto-occurrence ()
+  "Go to the occurrence the current line describes."
+  (interactive)
+  (let ((pos (occur-mode-find-occurrence)))
     (pop-to-buffer occur-buffer)
     (goto-char (marker-position pos))))
+
+(defun occur-next (&optional n)
+  "Move to the Nth (default 1) next match in the *Occur* buffer."
+  (interactive "p")
+  (if (not n) (setq n 1))
+  (let ((r))
+    (while (> n 0)
+      (if (get-text-property (point) 'occur-point)
+	  (forward-char 1))
+      (setq r (next-single-property-change (point) 'occur-point))
+      (if r
+	  (goto-char r)
+	(error "no more matches"))
+      (setq n (1- n)))))
+
+
+
+(defun occur-prev (&optional n)
+  "Move to the Nth (default 1) previous match in the *Occur* buffer."
+  (interactive "p")
+  (if (not n) (setq n 1))
+  (let ((r))
+    (while (> n 0)
+    
+      (setq r (get-text-property (point) 'occur-point))
+      (if r (forward-char -1))
+      
+      (setq r (previous-single-property-change (point) 'occur-point))
+      (if r
+	  (goto-char (- r 1))
+	(error "no earlier matches"))
+      
+      (setq n (1- n)))))
 
-(defvar list-matching-lines-default-context-lines 0
+(defcustom list-matching-lines-default-context-lines 0
   "*Default number of context lines to include around a `list-matching-lines'
 match.  A negative number means to include that many lines before the match.
-A positive number means to include that many lines both before and after.")
+A positive number means to include that many lines both before and after."
+  :type 'integer
+  :group 'matching)
 
 (defalias 'list-matching-lines 'occur)
 
+(defvar list-matching-lines-face 'bold
+  "*Face used by M-x list-matching-lines to show the text that matches.
+If the value is nil, don't highlight the matching portions specially.")
+
 (defun occur (regexp &optional nlines)
   "Show all lines in the current buffer containing a match for REGEXP.
 
@@ -275,100 +493,217 @@ Interactively it is the prefix arg.
 
 The lines are shown in a buffer named `*Occur*'.
 It serves as a menu to find any of the occurrences in this buffer.
-\\[describe-mode] in that buffer will explain how."
-  (interactive (list (let* ((default (car regexp-history))
-			    (input 
-			     (read-from-minibuffer
-			      (if default
-				  (format "List lines matching regexp (default `%s'): " default)
-				"List lines matching regexp: ")
-			      nil nil nil
-			      'regexp-history)))
-		       (if (> (length input) 0) input
-			 (setcar regexp-history default)))
-		     current-prefix-arg))
-  (setq nlines (if nlines (prefix-numeric-value nlines)
-		 list-matching-lines-default-context-lines))
-  (let ((first t)
+\\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
+
+If REGEXP contains upper case characters (excluding those preceded by `\\'),
+the matching is case-sensitive."
+  (interactive
+   (list (let* ((default (car regexp-history))
+		(input
+		 (read-from-minibuffer
+		  (if default
+		      (format "List lines matching regexp (default `%s'): "
+			      default)
+		    "List lines matching regexp: ")
+		  nil nil nil 'regexp-history default t)))
+	   (and (equal input "") default
+		(setq input default))
+	   input)
+	 current-prefix-arg))
+  (let ((nlines (if nlines
+		    (prefix-numeric-value nlines)
+		  list-matching-lines-default-context-lines))
+	(first t)
+	;;flag to prevent printing separator for first match
+	(occur-num-matches 0)
 	(buffer (current-buffer))
+	(dir default-directory)
 	(linenum 1)
-	(prevpos (point-min))
-	(final-context-start (make-marker)))
+	(prevpos 
+	 ;;position of most recent match
+	 (point-min))
+	(case-fold-search  (and case-fold-search
+				(isearch-no-upper-case-p regexp t)))
+	(final-context-start
+	 ;; Marker to the start of context immediately following
+	 ;; the matched text in *Occur*.
+	 (make-marker)))
 ;;;	(save-excursion
 ;;;	  (beginning-of-line)
 ;;;	  (setq linenum (1+ (count-lines (point-min) (point))))
 ;;;	  (setq prevpos (point)))
-    (with-output-to-temp-buffer "*Occur*"
-      (save-excursion
-	(set-buffer standard-output)
-	(insert "Lines matching ")
-	(prin1 regexp)
-	(insert " in buffer " (buffer-name buffer) ?. ?\n)
-	(occur-mode)
-	(setq occur-buffer buffer)
-	(setq occur-nlines nlines)
-	(setq occur-pos-list ()))
-      (if (eq buffer standard-output)
-	  (goto-char (point-max)))
-      (save-excursion
-	(beginning-of-buffer)
-	;; Find next match, but give up if prev match was at end of buffer.
-	(while (and (not (= prevpos (point-max)))
-		    (re-search-forward regexp nil t))
-	  (goto-char (match-beginning 0))
-	  (beginning-of-line)
-	  (save-match-data
-	    (setq linenum (+ linenum (count-lines prevpos (point)))))
-	  (setq prevpos (point))
-	  (goto-char (match-end 0))
-	  (let* ((start (save-excursion
-			  (goto-char (match-beginning 0))
-			  (forward-line (if (< nlines 0) nlines (- nlines)))
-			  (point)))
-		 (end (save-excursion
+    (save-excursion
+      (goto-char (point-min))
+      ;; Check first whether there are any matches at all.
+      (if (not (re-search-forward regexp nil t))
+	  (message "No matches for `%s'" regexp)
+	;; Back up, so the search loop below will find the first match.
+	(goto-char (match-beginning 0))
+	(with-output-to-temp-buffer "*Occur*"
+	  (save-excursion
+	    (set-buffer standard-output)
+	    (setq default-directory dir)
+	    ;; We will insert the number of lines, and "lines", later.
+	    (insert " matching ")
+	    (let ((print-escape-newlines t))
+	      (prin1 regexp))
+	    (insert " in buffer " (buffer-name buffer) ?. ?\n)
+	    (occur-mode)
+	    (setq occur-buffer buffer)
+	    (setq occur-nlines nlines)
+	    (setq occur-command-arguments
+		  (list regexp nlines)))
+	  (if (eq buffer standard-output)
+	      (goto-char (point-max)))
+	  (save-excursion
+	    ;; Find next match, but give up if prev match was at end of buffer.
+	    (while (and (not (= prevpos (point-max)))
+			(re-search-forward regexp nil t))
+	      (goto-char (match-beginning 0))
+	      (beginning-of-line)
+	      (save-match-data
+		(setq linenum (+ linenum (count-lines prevpos (point)))))
+	      (setq prevpos (point))
+	      (goto-char (match-end 0))
+	      (let* ((start
+		      ;;start point of text in source buffer to be put
+		      ;;into *Occur*
+		      (save-excursion
+			      (goto-char (match-beginning 0))
+			      (forward-line (if (< nlines 0)
+						nlines
+					      (- nlines)))
+			      (point)))
+		     (end	
+		      ;; end point of text in source buffer to be put
+		      ;; into *Occur*
+		      (save-excursion 
 			(goto-char (match-end 0))
 			(if (> nlines 0)
 			    (forward-line (1+ nlines))
-			    (forward-line 1))
+			  (forward-line 1))
 			(point)))
-		 (tag (format "%3d" linenum))
-		 (empty (make-string (length tag) ?\ ))
-		 tem)
-	    (save-excursion
-	      (setq tem (make-marker))
-	      (set-marker tem (point))
-	      (set-buffer standard-output)
-	      (setq occur-pos-list (cons tem occur-pos-list))
-	      (or first (zerop nlines)
-		  (insert "--------\n"))
-	      (setq first nil)
-	      (insert-buffer-substring buffer start end)
-	      (backward-char (- end start))
-	      (setq tem nlines)
-	      (while (> tem 0)
-		(insert empty ?:)
-		(forward-line 1)
-		(setq tem (1- tem)))
-	      (let ((this-linenum linenum))
-		(set-marker final-context-start
-			    (+ (point) (- (match-end 0) (match-beginning 0))))
-		(while (< (point) final-context-start)
-		  (if (null tag)
-		      (setq tag (format "%3d" this-linenum)))
-		  (insert tag ?:)
-		  (setq tag nil)
-		  (forward-line 1)
-		  (setq this-linenum (1+ this-linenum))))
-	      (while (< tem nlines)
-		(insert empty ?:)
-		(forward-line 1)
-		(setq tem (1+ tem))))				
-	    (forward-line 1)))
-	(set-buffer standard-output)
-	;; Put positions in increasing order to go with buffer.
-	(setq occur-pos-list (nreverse occur-pos-list))
-	(if (interactive-p)
-	    (message "%d matching lines." (length occur-pos-list)))))))
+		     (match-beg
+		      ;; Amount of context before matching text
+		      (- (match-beginning 0) start))
+		     (match-len		
+		      ;; Length of matching text
+		      (- (match-end 0) (match-beginning 0)))
+		     (tag (format "%5d" linenum))
+		     (empty (make-string (length tag) ?\ ))
+		     tem		
+		     insertion-start
+		     ;; Number of lines of context to show for current match.
+		     occur-marker	
+		     ;; Marker pointing to end of match in source buffer.
+		     (text-beg
+		      ;; Marker pointing to start of text for one
+		      ;; match in *Occur*.
+		      (make-marker))
+		     (text-end 
+		      ;; Marker pointing to end of text for one match
+		      ;; in *Occur*.
+		      (make-marker))
+		     )
+		(save-excursion
+		  (setq occur-marker (make-marker))
+		  (set-marker occur-marker (point))
+		  (set-buffer standard-output)
+		  (setq occur-num-matches (1+ occur-num-matches))
+		  (or first (zerop nlines)
+		      (insert "--------\n"))
+		  (setq first nil)
+
+		  ;; Insert matching text including context lines from
+		  ;; source buffer into *Occur*
+		  (set-marker text-beg (point))
+		  (setq insertion-start (point))
+		  (insert-buffer-substring buffer start end)
+		  (or (and (/= (+ start match-beg) end)
+			   (with-current-buffer buffer
+			     (eq (char-before end) ?\n)))
+		      (insert "\n"))
+		  (set-marker final-context-start 
+			      (+ (- (point) (- end (match-end 0)))
+				 (if (save-excursion
+				       (set-buffer buffer)
+				       (save-excursion
+					 (goto-char (match-end 0))
+					 (end-of-line)
+					 (bolp)))
+				     1 0)))
+		  (set-marker text-end (point))
+		  
+		  ;; Highlight text that was matched.
+		  (if list-matching-lines-face
+		      (put-text-property
+		       (+ (marker-position text-beg) match-beg)
+		       (+ (marker-position text-beg) match-beg match-len)
+		       'face list-matching-lines-face))
+
+		  ;; `occur-point' property is used by occur-next and
+		  ;; occur-prev to move between matching lines.
+		  (put-text-property
+		   (+ (marker-position text-beg) match-beg match-len)
+		   (+ (marker-position text-beg) match-beg match-len 1)
+		   'occur-point t)
+		  
+		  ;; Now go back to the start of the matching text
+		  ;; adding the space and colon to the start of each line.
+		  (goto-char insertion-start)
+		  ;; Insert space and colon for lines of context before match.
+		  (setq tem (if (< linenum nlines)
+				(- nlines linenum)
+			      nlines))
+		  (while (> tem 0)
+		    (insert empty ?:)
+		    (forward-line 1)
+		    (setq tem (1- tem)))
+
+		  ;; Insert line number and colon for the lines of
+		  ;; matching text.
+		  (let ((this-linenum linenum))
+		    (while (< (point) final-context-start)
+		      (if (null tag)
+			  (setq tag (format "%5d" this-linenum)))
+		      (insert tag ?:)
+		      (forward-line 1)
+		      (setq tag nil)
+		      (setq this-linenum (1+ this-linenum)))
+		    (while (and (not (eobp)) (<= (point) final-context-start))
+		      (insert empty ?:)
+		      (forward-line 1)
+		      (setq this-linenum (1+ this-linenum))))
+
+		  ;; Insert space and colon for lines of context after match.
+		  (while (and (< (point) (point-max)) (< tem nlines))
+		    (insert empty ?:)
+		    (forward-line 1)
+		    (setq tem (1+ tem)))
+		  
+		  ;; Add text properties.  The `occur' prop is used to
+		  ;; store the marker of the matching text in the
+		  ;; source buffer.
+		  (put-text-property (marker-position text-beg)
+				     (- (marker-position text-end) 1)
+				     'mouse-face 'highlight)
+		  (put-text-property (marker-position text-beg)
+				     (marker-position text-end)
+				     'occur occur-marker)
+		  (goto-char (point-max)))
+		(forward-line 1)))
+	    (set-buffer standard-output)
+	    ;; Go back to top of *Occur* and finish off by printing the
+	    ;; number of matching lines.
+	    (goto-char (point-min))
+	    (let ((message-string
+		   (if (= occur-num-matches 1)
+		       "1 line"
+		     (format "%d lines" occur-num-matches))))
+	      (insert message-string)
+	      (if (interactive-p)
+		  (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.
@@ -388,7 +723,7 @@ C-l to clear the screen, redisplay, and offer same replacement again,
 The \"bindings\" in this map are not commands; they are answers.
 The valid answers include `act', `skip', `act-and-show',
 `exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
-`automatic', `backup', and `help'.")
+`automatic', `backup', `exit-prefix', and `help'.")
 
 (define-key query-replace-map " " 'act)
 (define-key query-replace-map "\d" 'skip)
@@ -396,6 +731,8 @@ The valid answers include `act', `skip', `act-and-show',
 (define-key query-replace-map [backspace] 'skip)
 (define-key query-replace-map "y" 'act)
 (define-key query-replace-map "n" 'skip)
+(define-key query-replace-map "Y" 'act)
+(define-key query-replace-map "N" 'skip)
 (define-key query-replace-map "," 'act-and-show)
 (define-key query-replace-map "q" 'exit)
 (define-key query-replace-map "\r" 'exit)
@@ -407,11 +744,63 @@ The valid answers include `act', `skip', `act-and-show',
 (define-key query-replace-map "!" 'automatic)
 (define-key query-replace-map "^" 'backup)
 (define-key query-replace-map "\C-h" 'help)
+(define-key query-replace-map [f1] 'help)
+(define-key query-replace-map [help] 'help)
 (define-key query-replace-map "?" 'help)
 (define-key query-replace-map "\C-g" 'quit)
 (define-key query-replace-map "\C-]" 'quit)
+(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 perform-replace (from-string replacements
+(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 start end
 		        query-flag regexp-flag delimited-flag
 			&optional repeat-count map)
   "Subroutine of `query-replace'.  Its complexity handles interactive queries.
@@ -421,24 +810,57 @@ just as `query-replace' does.  Instead, write a simple loop like this:
     (replace-match \"foobar\" nil nil))
 which will run faster and probably do exactly what you want."
   (or map (setq map query-replace-map))
+  (and query-flag minibuffer-auto-raise
+       (raise-frame (window-frame (minibuffer-window))))
   (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)
-	(lastrepl nil)			;Position after last match considered.
-	(match-again t))
-    (if (stringp replacements)
-	(setq next-replacement replacements)
-      (or repeat-count (setq repeat-count 1)))
+	(nonempty-match nil)
+
+	;; If non-nil, it is marker saying where in the buffer to stop.
+	(limit 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.
+	(match-again t)
+
+	(message
+	 (if query-flag
+	     (substitute-command-keys
+	      "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) "))))
+
+    ;; If region is active, in Transient Mark mode, operate on region.
+    (when start
+      (setq limit (copy-marker (max start end)))
+      (goto-char (min start end))
+      (deactivate-mark))
+
+    ;; 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"
@@ -451,40 +873,54 @@ which will run faster and probably do exactly what you want."
 	;; Loop finding occurrences that perhaps should be replaced.
 	(while (and keep-going
 		    (not (eobp))
-		    (funcall search-function search-string nil t)
-		    ;; If the search string matches immediately after
-		    ;; the previous match, but it did not match there
-		    ;; before the replacement was done, ignore the match.
-		    (if (or (eq lastrepl (point))
-			    (and regexp-flag
-				 (eq lastrepl (match-beginning 0))
-				 (not match-again)))
-			(if (eobp)
-			    nil
-			  ;; Don't replace the null string 
-			  ;; right after end of previous replacement.
-			  (forward-char 1)
-			  (funcall search-function search-string nil t))
-		      t))
-
-	  ;; Save the data associated with the real match.
-	  (setq real-match-data (match-data))
-
-	  ;; Before we make the replacement, decide whether the search string
-	  ;; can match again just after this match.
-	  (if regexp-flag
-	      (setq match-again (looking-at search-string)))
-	  ;; 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)))))
+		    ;; Use the next match if it is already known;
+		    ;; otherwise, search for a match after moving forward
+		    ;; one char if progress is required.
+		    (setq real-match-data
+			  (if (consp match-again)
+			      (progn (goto-char (nth 1 match-again))
+				     match-again)
+			    (and (or match-again
+				     ;; MATCH-AGAIN nil means in the
+				     ;; regexp case that there's no
+				     ;; match adjacent to the last
+				     ;; one.  So, we could move
+				     ;; forward, but we don't want to
+				     ;; because that moves point 1
+				     ;; position after the last
+				     ;; replacement when everything
+				     ;; has been done.
+				     regexp-flag
+				     (progn (forward-char 1) (not (eobp))))
+				 (funcall search-function search-string limit t)
+				 ;; For speed, use only integers and
+				 ;; reuse the list used last time.
+				 (match-data t real-match-data)))))
+
+	  ;; Record whether the match is nonempty, to avoid an infinite loop
+	  ;; repeatedly matching the same empty string.
+	  (setq nonempty-match
+		(/= (nth 0 real-match-data) (nth 1 real-match-data)))
+
+	  ;; If the match is empty, record that the next one can't be adjacent.
+	  ;; Otherwise, if matching a regular expression, do the next
+	  ;; match now, since the replacement for this match may
+	  ;; affect whether the next match is adjacent to this one.
+	  (setq match-again
+		(and nonempty-match
+		     (or (not regexp-flag)
+			 (and (looking-at search-string)
+			      (match-data)))))
+
+	  ;; 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
-		(store-match-data real-match-data)
+		(set-match-data real-match-data)
 		(replace-match next-replacement nocasify literal)
 		(setq replace-count (1+ replace-count)))
 	    (undo-boundary)
@@ -492,15 +928,19 @@ which will run faster and probably do exactly what you want."
 	      ;; Loop reading commands until one of them sets done,
 	      ;; which means it has finished handling this occurrence.
 	      (while (not done)
+		(set-match-data real-match-data)
 		(replace-highlight (match-beginning 0) (match-end 0))
-		(message (substitute-command-keys
-			  "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
-			 from-string next-replacement)
+		;; Bind message-log-max so we don't fill up the message log
+		;; with a bunch of identical messages.
+		(let ((message-log-max nil))
+		  (message message from-string next-replacement))
 		(setq key (read-event))
+		;; Necessary in case something happens during read-event
+		;; that clobbers the match data.
+		(set-match-data real-match-data)
 		(setq key (vector key))
 		(setq def (lookup-key map key))
 		;; Restore the match data while we process the command.
-		(store-match-data real-match-data)
 		(cond ((eq def 'help)
 		       (with-output-to-temp-buffer "*Help*"
 			 (princ
@@ -509,7 +949,10 @@ which will run faster and probably do exactly what you want."
 				  from-string " with "
 				  next-replacement ".\n\n"
 				  (substitute-command-keys
-				   query-replace-help)))))
+				   query-replace-help)))
+			 (save-excursion
+			   (set-buffer standard-output)
+			   (help-mode))))
 		      ((eq def 'exit)
 		       (setq keep-going nil)
 		       (setq done t))
@@ -519,49 +962,66 @@ which will run faster and probably do exactly what you want."
 			     (goto-char (car elt))
 			     (setq replaced (eq t (cdr elt)))
 			     (or replaced
-				 (store-match-data (cdr elt)))
+				 (set-match-data (cdr elt)))
 			     (setq stack (cdr stack)))
 			 (message "No previous match")
 			 (ding 'no-terminate)
 			 (sit-for 1)))
 		      ((eq def 'act)
 		       (or replaced
-			   (replace-match next-replacement nocasify literal))
+			   (progn
+			     (replace-match next-replacement nocasify literal)
+			     (setq replace-count (1+ replace-count))))
 		       (setq done t replaced t))
 		      ((eq def 'act-and-exit)
 		       (or replaced
-			   (replace-match next-replacement nocasify literal))
+			   (progn
+			     (replace-match next-replacement nocasify literal)
+			     (setq replace-count (1+ replace-count))))
 		       (setq keep-going nil)
 		       (setq done t replaced t))
 		      ((eq def 'act-and-show)
 		       (if (not replaced)
 			   (progn
 			     (replace-match next-replacement nocasify literal)
+			     (setq replace-count (1+ replace-count))
 			     (setq replaced t))))
 		      ((eq def 'automatic)
 		       (or replaced
-			   (replace-match next-replacement nocasify literal))
+			   (progn
+			     (replace-match next-replacement nocasify literal)
+			     (setq replace-count (1+ replace-count))))
 		       (setq done t query-flag nil replaced t))
 		      ((eq def 'skip)
 		       (setq done t))
 		      ((eq def 'recenter)
 		       (recenter nil))
 		      ((eq def 'edit)
-		       (store-match-data
-			(prog1 (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
 		       ;; can match again just after this match.
-		       (if regexp-flag
-			   (setq match-again (looking-at search-string))))
+		       (if (and regexp-flag nonempty-match)
+			   (setq match-again (and (looking-at search-string)
+						  (match-data)))))
 		      ((eq def 'delete-and-edit)
 		       (delete-region (match-beginning 0) (match-end 0))
-		       (store-match-data
+		       (set-match-data
 			(prog1 (match-data)
 			  (save-excursion (recursive-edit))))
 		       (setq replaced t))
+		      ;; Note: we do not need to treat `exit-prefix'
+		      ;; specially here, since we reread
+		      ;; any unrecognized character.
 		      (t
+		       (setq this-command 'mode-exited)
 		       (setq keep-going nil)
 		       (setq unread-command-events
 			     (append (listify-key-sequence key)
@@ -572,20 +1032,19 @@ which will run faster and probably do exactly what you want."
 	      ;; since lots of markers slow down editing.
 	      (setq stack
 		    (cons (cons (point)
-				(or replaced
-				    (mapcar
-				     (function (lambda (elt)
-						 (and elt
-						      (marker-position elt))))
-				     (match-data))))
-			  stack))
-	      (if replaced (setq replace-count (1+ replace-count)))))
-	  (setq lastrepl (point)))
+				(or replaced (match-data t)))
+			  stack)))))
       (replace-dehighlight))
-  (and keep-going stack)))
+    (or unread-command-events
+	(message "Replaced %d occurrence%s"
+		 replace-count
+		 (if (= replace-count 1) "" "s")))
+    (and keep-going stack)))
 
-(defvar query-replace-highlight nil
-  "*Non-nil means to highlight words during query replacement.")
+(defcustom query-replace-highlight t
+  "*Non-nil means to highlight words during query replacement."
+  :type 'boolean
+  :group 'matching)
 
 (defvar replace-overlay nil)