Error if ps-lpr-switches is not a list.
[bpt/emacs.git] / lisp / replace.el
index 3016f5f..7876f9b 100644 (file)
@@ -1,7 +1,7 @@
 ;;; replace.el --- replace commands for Emacs
 
 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001,
-;;   2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;;   2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 
@@ -9,7 +9,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 
 (defvar query-replace-history nil)
 
+(defvar query-replace-defaults nil
+  "Default values of FROM-STRING and TO-STRING for `query-replace'.
+This is a cons cell (FROM-STRING . TO-STRING), or nil if there is
+no default value.")
+
 (defvar query-replace-interactive nil
   "Non-nil means `query-replace' uses the last search string.
 That becomes the \"string to replace\".")
@@ -64,6 +69,12 @@ strings or patterns."
   :group 'matching
   :version "22.1")
 
+(defcustom query-replace-show-replacement t
+  "*Non-nil means to show what actual replacement text will be."
+  :type 'boolean
+  :group 'matching
+  :version "23.1")
+
 (defcustom query-replace-highlight t
   "*Non-nil means to highlight matches during query replacement."
   :type 'boolean
@@ -94,32 +105,26 @@ The return value can also be a pair (FROM . TO) indicating that the user
 wants to replace FROM with TO."
   (if query-replace-interactive
       (car (if regexp-flag regexp-search-ring search-ring))
-    (let* ((lastfrom (car (symbol-value query-replace-from-history-variable)))
-          (lastto (car (symbol-value query-replace-to-history-variable)))
+    (let* ((history-add-new-input nil)
           (from
            ;; The save-excursion here is in case the user marks and copies
            ;; a region in order to specify the minibuffer input.
            ;; That should not clobber the region for the query-replace itself.
            (save-excursion
-             (when (equal lastfrom lastto)
-               ;; Typically, this is because the two histlists are shared.
-               (setq lastfrom (cadr (symbol-value
-                                     query-replace-from-history-variable))))
              (read-from-minibuffer
-              (if (and lastto lastfrom)
+              (if query-replace-defaults
                   (format "%s (default %s -> %s): " prompt
-                          (query-replace-descr lastfrom)
-                          (query-replace-descr lastto))
+                          (query-replace-descr (car query-replace-defaults))
+                          (query-replace-descr (cdr query-replace-defaults)))
                 (format "%s: " prompt))
               nil nil nil
               query-replace-from-history-variable
-              nil t t))))
-      (if (and (zerop (length from)) lastto lastfrom)
-         (progn
-           (set query-replace-from-history-variable
-                (cdr (symbol-value query-replace-from-history-variable)))
-           (cons lastfrom
-                 (query-replace-compile-replacement lastto regexp-flag)))
+              nil t))))
+      (if (and (zerop (length from)) query-replace-defaults)
+         (cons (car query-replace-defaults)
+               (query-replace-compile-replacement
+                (cdr query-replace-defaults) regexp-flag))
+       (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)
@@ -177,10 +182,14 @@ the original string if not."
   "Query and return the `to' argument of a query-replace operation."
   (query-replace-compile-replacement
    (save-excursion
-     (read-from-minibuffer
-      (format "%s %s with: " prompt (query-replace-descr from))
-      nil nil nil
-      query-replace-to-history-variable from t t))
+     (let* ((history-add-new-input nil)
+           (to (read-from-minibuffer
+                (format "%s %s with: " prompt (query-replace-descr from))
+                nil nil nil
+                query-replace-to-history-variable from t)))
+       (add-to-history query-replace-to-history-variable to nil t)
+       (setq query-replace-defaults (cons from to))
+       to))
    regexp-flag))
 
 (defun query-replace-read-args (prompt regexp-flag &optional noerror)
@@ -300,6 +309,11 @@ Use \\[repeat-complex-command] after this command for details."
 
 (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.
+
+Interactive use of this function is deprecated in favor of the
+`\\,' feature of `query-replace-regexp'.  For non-interactive use, a loop
+using `search-forward-regexp' and `replace-match' is preferred.
+
 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.
 
@@ -351,6 +365,11 @@ Fourth and fifth arg START and END specify the region to operate on."
   (perform-replace regexp (cons 'replace-eval-replacement to-expr)
                   t 'literal delimited nil nil start end))
 
+(make-obsolete 'query-replace-regexp-eval
+  "for interactive use, use the special `\\,' feature of
+`query-replace-regexp' instead.  Non-interactively, a loop
+using `search-forward-regexp' and `replace-match' is preferred." "22.1")
+
 (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,
@@ -464,10 +483,9 @@ at the given position for each replacement.
 In interactive calls, the replacement text may contain `\\,'
 followed by a Lisp expression used as part of the replacement
 text.  Inside of that expression, `\\&' is a string denoting the
-whole match, `\\N' a partial matches, `\\#&' and `\\#N' the
-respective numeric values from `string-to-number', and `\\#'
-itself for `replace-count', the number of replacements occured so
-far.
+whole match, `\\N' a partial match, `\\#&' and `\\#N' the respective
+numeric values from `string-to-number', and `\\#' itself for
+`replace-count', the number of replacements occurred so far.
 
 If your Lisp expression is an identifier and the next letter in
 the replacement string would be interpreted as part of it, you
@@ -693,6 +711,7 @@ a previously found match."
 \f
 (defvar occur-mode-map
   (let ((map (make-sparse-keymap)))
+    ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
     (define-key map [mouse-2] 'occur-mode-mouse-goto)
     (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
     (define-key map "\C-m" 'occur-mode-goto-occurrence)
@@ -746,18 +765,6 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
   "Handle `revert-buffer' for Occur mode buffers."
   (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
 
-(defun occur-mode-mouse-goto (event)
-  "In Occur mode, go to the occurrence whose line you click on."
-  (interactive "e")
-  (let (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))))
-    (switch-to-buffer-other-window (marker-buffer pos))
-    (goto-char pos)))
-
 (defun occur-mode-find-occurrence ()
   (let ((pos (get-text-property (point) 'occur-target)))
     (unless pos
@@ -766,11 +773,23 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
       (error "Buffer for this occurrence was killed"))
     pos))
 
-(defun occur-mode-goto-occurrence ()
+(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
+(defun occur-mode-goto-occurrence (&optional event)
   "Go to the occurrence the current line describes."
-  (interactive)
-  (let ((pos (occur-mode-find-occurrence)))
-    (switch-to-buffer (marker-buffer pos))
+  (interactive (list last-nonmenu-event))
+  (let ((pos
+         (if (null event)
+             ;; Actually `event-end' works correctly with a nil argument as
+             ;; well, so we could dispense with this test, but let's not
+             ;; rely on this undocumented behavior.
+             (occur-mode-find-occurrence)
+           (with-current-buffer (window-buffer (posn-window (event-end event)))
+             (save-excursion
+               (goto-char (posn-point (event-end event)))
+               (occur-mode-find-occurrence)))))
+        same-window-buffer-names
+        same-window-regexps)
+    (pop-to-buffer (marker-buffer pos))
     (goto-char pos)))
 
 (defun occur-mode-goto-occurrence-other-window ()
@@ -832,7 +851,8 @@ Compatibility function for \\[next-error] invocations."
 
     (goto-char (cond (reset (point-min))
                     ((< argp 0) (line-beginning-position))
-                    ((line-end-position))))
+                    ((> argp 0) (line-end-position))
+                    ((point))))
     (occur-find-match
      (abs argp)
      (if (> 0 argp)
@@ -840,15 +860,18 @@ Compatibility function for \\[next-error] invocations."
        #'next-single-property-change)
      "No more matches")
     ;; In case the *Occur* buffer is visible in a nonselected window.
-    (set-window-point (get-buffer-window (current-buffer)) (point))
+    (let ((win (get-buffer-window (current-buffer) t)))
+      (if win (set-window-point win (point))))
     (occur-mode-goto-occurrence)))
 \f
 (defface match
   '((((class color) (min-colors 88) (background light))
-     :background "Tan")
+     :background "yellow1")
     (((class color) (min-colors 88) (background dark))
      :background "RoyalBlue3")
-    (((class color) (min-colors 8))
+    (((class color) (min-colors 8) (background light))
+     :background "yellow" :foreground "black")
+    (((class color) (min-colors 8) (background dark))
      :background "blue" :foreground "white")
     (((type tty) (class mono))
      :inverse-video t)
@@ -878,6 +901,16 @@ If the value is nil, don't highlight the buffer names specially."
   :type 'face
   :group 'matching)
 
+(defcustom occur-excluded-properties
+  '(read-only invisible intangible field mouse-face help-echo local-map keymap
+    yank-handler follow-link)
+  "*Text properties to discard when copying lines to the *Occur* buffer.
+The value should be a list of text properties to discard or t,
+which means to discard all text properties."
+  :type '(choice (const :tag "All" t) (repeat symbol))
+  :group 'matching
+  :version "22.1")
+
 (defun occur-accumulate-lines (count &optional keep-props)
   (save-excursion
     (let ((forwardp (> count 0))
@@ -894,10 +927,12 @@ If the value is nil, don't highlight the buffer names specially."
            (if (fboundp 'jit-lock-fontify-now)
                (jit-lock-fontify-now beg end)))
        (push
-        (funcall (if keep-props
-                     #'buffer-substring
-                   #'buffer-substring-no-properties)
-                 beg end)
+        (if (and keep-props (not (eq occur-excluded-properties t)))
+            (let ((str (buffer-substring beg end)))
+              (remove-list-of-text-properties
+               0 (length str) occur-excluded-properties str)
+              str)
+          (buffer-substring-no-properties beg end))
         result)
        (forward-line (if forwardp 1 -1)))
       (nreverse result))))
@@ -959,7 +994,8 @@ the matching is case-sensitive."
 (defun multi-occur (bufs regexp &optional nlines)
   "Show all lines in buffers BUFS containing a match for REGEXP.
 This function acts on multiple buffers; otherwise, it is exactly like
-`occur'."
+`occur'.  When you invoke this command interactively, you must specify
+the buffer names that you want, one by one."
   (interactive
    (cons
     (let* ((bufs (list (read-buffer "First buffer to search: "
@@ -979,15 +1015,19 @@ This function acts on multiple buffers; otherwise, it is exactly like
     (occur-read-primary-args)))
   (occur-1 regexp nlines bufs))
 
-(defun multi-occur-by-filename-regexp (bufregexp regexp &optional nlines)
-  "Show all lines matching REGEXP in buffers named by BUFREGEXP.
+(defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs)
+  "Show all lines matching REGEXP in buffers specified by BUFREGEXP.
+Normally BUFREGEXP matches against each buffer's visited file name,
+but if you specify a prefix argument, it matches against the buffer name.
 See also `multi-occur'."
   (interactive
    (cons
     (let* ((default (car regexp-history))
           (input
            (read-from-minibuffer
-            "List lines in buffers whose filename matches regexp: "
+            (if current-prefix-arg
+                "List lines in buffers whose names match regexp: "
+              "List lines in buffers whose filenames match regexp: ")
             nil
             nil
             nil
@@ -997,12 +1037,15 @@ See also `multi-occur'."
        input))
     (occur-read-primary-args)))
   (when bufregexp
-    (occur-1 regexp nlines
+    (occur-1 regexp nil
             (delq nil
                   (mapcar (lambda (buf)
-                            (when (and (buffer-file-name buf)
-                                       (string-match bufregexp
-                                                     (buffer-file-name buf)))
+                            (when (if allbufs
+                                      (string-match bufregexp
+                                                    (buffer-name buf))
+                                    (and (buffer-file-name buf)
+                                         (string-match bufregexp
+                                                       (buffer-file-name buf))))
                               buf))
                           (buffer-list))))))
 
@@ -1025,7 +1068,9 @@ See also `multi-occur'."
 
     (with-current-buffer occur-buf
       (occur-mode)
-      (let ((inhibit-read-only t))
+      (let ((inhibit-read-only t)
+           ;; Don't generate undo entries for creation of the initial contents.
+           (buffer-undo-list t))
        (erase-buffer)
        (let ((count (occur-engine
                      regexp active-bufs occur-buf
@@ -1033,7 +1078,8 @@ See also `multi-occur'."
                      (and case-fold-search
                           (isearch-no-upper-case-p regexp t))
                      list-matching-lines-buffer-name-face
-                     nil list-matching-lines-face t)))
+                     nil list-matching-lines-face
+                     (not (eq occur-excluded-properties t)))))
          (let* ((bufcount (length active-bufs))
                 (diff (- (length bufs) bufcount)))
            (message "Searched %d buffer%s%s; %s match%s for `%s'"
@@ -1061,8 +1107,6 @@ See also `multi-occur'."
                            title-face prefix-face match-face keep-props)
   (with-current-buffer out-buf
     (let ((globalcount 0)
-         ;; Don't generate undo entries for creation of the initial contents.
-         (buffer-undo-list t)
          (coding nil))
       ;; Map over all the buffers
       (dolist (buf buffers)
@@ -1075,9 +1119,9 @@ See also `multi-occur'."
                (endpt nil)
                (marker nil)
                (curstring "")
+               (inhibit-field-text-motion t)
                (headerpt (with-current-buffer out-buf (point))))
-           (save-excursion
-             (set-buffer buf)
+           (with-current-buffer buf
              (or coding
                  ;; Set CODING only if the current buffer locally
                  ;; binds buffer-file-coding-system.
@@ -1102,13 +1146,15 @@ See also `multi-occur'."
                             (text-property-not-all begpt endpt 'fontified t))
                        (if (fboundp 'jit-lock-fontify-now)
                            (jit-lock-fontify-now begpt endpt)))
-                   (setq curstring (buffer-substring begpt endpt))
-                   ;; Depropertize the string, and maybe
-                   ;; highlight the matches
+                   (if (and keep-props (not (eq occur-excluded-properties t)))
+                       (progn
+                         (setq curstring (buffer-substring begpt endpt))
+                         (remove-list-of-text-properties
+                          0 (length curstring) occur-excluded-properties curstring))
+                     (setq curstring (buffer-substring-no-properties begpt endpt)))
+                   ;; Highlight the matches
                    (let ((len (length curstring))
                          (start 0))
-                     (unless keep-props
-                       (set-text-properties 0 len nil curstring))
                      (while (and (< start len)
                                  (string-match regexp curstring start))
                        (add-text-properties
@@ -1208,42 +1254,43 @@ C-l to clear the screen, redisplay, and offer same replacement again,
 E to edit the replacement string"
   "Help message while in `query-replace'.")
 
-(defvar query-replace-map (make-sparse-keymap)
+(defvar query-replace-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map " " 'act)
+    (define-key map "\d" 'skip)
+    (define-key map [delete] 'skip)
+    (define-key map [backspace] 'skip)
+    (define-key map "y" 'act)
+    (define-key map "n" 'skip)
+    (define-key map "Y" 'act)
+    (define-key map "N" 'skip)
+    (define-key map "e" 'edit-replacement)
+    (define-key map "E" 'edit-replacement)
+    (define-key map "," 'act-and-show)
+    (define-key map "q" 'exit)
+    (define-key map "\r" 'exit)
+    (define-key map [return] 'exit)
+    (define-key map "." 'act-and-exit)
+    (define-key map "\C-r" 'edit)
+    (define-key map "\C-w" 'delete-and-edit)
+    (define-key map "\C-l" 'recenter)
+    (define-key map "!" 'automatic)
+    (define-key map "^" 'backup)
+    (define-key map "\C-h" 'help)
+    (define-key map [f1] 'help)
+    (define-key map [help] 'help)
+    (define-key map "?" 'help)
+    (define-key map "\C-g" 'quit)
+    (define-key map "\C-]" 'quit)
+    (define-key map "\e" 'exit-prefix)
+    (define-key map [escape] 'exit-prefix)
+    map)
   "Keymap that defines the responses to questions in `query-replace'.
 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', `exit-prefix', and `help'.")
 
-(define-key query-replace-map " " 'act)
-(define-key query-replace-map "\d" 'skip)
-(define-key query-replace-map [delete] 'skip)
-(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 "e" 'edit-replacement)
-(define-key query-replace-map "E" 'edit-replacement)
-(define-key query-replace-map "," 'act-and-show)
-(define-key query-replace-map "q" 'exit)
-(define-key query-replace-map "\r" 'exit)
-(define-key query-replace-map [return] 'exit)
-(define-key query-replace-map "." 'act-and-exit)
-(define-key query-replace-map "\C-r" 'edit)
-(define-key query-replace-map "\C-w" 'delete-and-edit)
-(define-key query-replace-map "\C-l" 'recenter)
-(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
@@ -1254,8 +1301,8 @@ N     (match-string N)           (where N is a string of digits)
 #     replace-count
 
 Note that these symbols must be preceeded by a backslash in order to
-type them."
-  (while n
+type them using Lisp syntax."
+  (while (consp n)
     (cond
      ((consp (car n))
       (replace-match-string-symbols (car n))) ;Process sub-list
@@ -1312,7 +1359,7 @@ with the `noescape' argument set.
 
 (defun replace-match-data (integers reuse &optional new)
   "Like `match-data', but markers in REUSE get invalidated.
-If NEW is non-NIL, it is set and returned instead of fresh data,
+If NEW is non-nil, it is set and returned instead of fresh data,
 but coerced to the correct value of INTEGERS."
   (or (and new
           (progn
@@ -1328,7 +1375,7 @@ NEWTEXT, FIXEDCASE, LITERAL are just passed on.  If NOEDIT is true, no
 check for `\\?' is made to save time.  MATCH-DATA is used for the
 replacement.  In case editing is done, it is changed to use markers.
 
-The return value is non-NIL if there has been no `\\?' or NOEDIT was
+The return value is non-nil if there has been no `\\?' or NOEDIT was
 passed in.  If LITERAL is set, no checking is done, anyway."
   (unless (or literal noedit)
     (setq noedit t)
@@ -1367,34 +1414,36 @@ make, or the user didn't cancel the call."
   (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 (or (not regexp-flag) (eq regexp-flag 'literal)))
-       (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)
-       (noedit nil)
-       (keep-going t)
-       (stack nil)
-       (replace-count 0)
-       (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) "))))
+  (let* ((case-fold-search
+          (and case-fold-search
+               (isearch-no-upper-case-p from-string regexp-flag)))
+         (nocasify (not (and case-replace case-fold-search)))
+         (literal (or (not regexp-flag) (eq regexp-flag 'literal)))
+         (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)
+         ;; This is non-nil if we know there is nothing for the user
+         ;; to edit in the replacement.
+         (noedit nil)
+         (keep-going t)
+         (stack nil)
+         (replace-count 0)
+         (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
+              (apply 'propertize
+                     (substitute-command-keys
+                      "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
+                     minibuffer-prompt-properties))))
 
     ;; If region is active, in Transient Mark mode, operate on region.
     (when start
@@ -1436,60 +1485,68 @@ make, or the user didn't cancel the call."
                    ;; 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))
-                                    (replace-match-data t
-                                     real-match-data
-                                     match-again))
-                           (and (or match-again
-                                    ;; MATCH-AGAIN non-nil means we
-                                    ;; accept an adjacent match.  If
-                                    ;; we don't, move one char to the
-                                    ;; right.  This takes us a
-                                    ;; character too far at the end,
-                                    ;; but this is undone after the
-                                    ;; while-loop.
-                                    (progn
-                                      (forward-char 1)
-                                      (not (or (eobp)
-                                               (and limit (>= (point) limit))))))
-                                (funcall search-function search-string limit t)
-                                ;; For speed, use only integers and
-                                ;; reuse the list used last time.
-                                (replace-match-data t real-match-data)))))
+                         (cond ((consp match-again)
+                                (goto-char (nth 1 match-again))
+                                (replace-match-data
+                                 t real-match-data match-again))
+                               ;; MATCH-AGAIN non-nil means accept an
+                               ;; adjacent match.
+                               (match-again
+                                (and
+                                 (funcall search-function search-string
+                                          limit t)
+                                 ;; For speed, use only integers and
+                                 ;; reuse the list used last time.
+                                 (replace-match-data t real-match-data)))
+                               ((and (< (1+ (point)) (point-max))
+                                     (or (null limit)
+                                         (< (1+ (point)) limit)))
+                                ;; If not accepting adjacent matches,
+                                ;; move one char to the right before
+                                ;; searching again.  Undo the motion
+                                ;; if the search fails.
+                                (let ((opoint (point)))
+                                  (forward-char 1)
+                                  (if (funcall
+                                       search-function search-string
+                                       limit t)
+                                      (replace-match-data
+                                       t real-match-data)
+                                    (goto-char opoint)
+                                    nil))))))
+
+         ;; 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.
+         ;; If that match is empty, don't use it.
+         (setq match-again
+               (and nonempty-match
+                    (or (not regexp-flag)
+                        (and (looking-at search-string)
+                             (let ((match (match-data)))
+                               (and (/= (nth 0 match) (nth 1 match))
+                                    match))))))
+
          ;; Optionally ignore matches that have a read-only property.
          (unless (and query-replace-skip-read-only
                       (text-property-not-all
-                       (match-beginning 0) (match-end 0)
+                       (nth 0 real-match-data) (nth 1 real-match-data)
                        'read-only nil))
 
-           ;; 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.
-           ;; If that match is empty, don't use it.
-           (setq match-again
-                 (and nonempty-match
-                      (or (not regexp-flag)
-                          (and (looking-at search-string)
-                               (let ((match (match-data)))
-                                 (and (/= (nth 0 match) (nth 1 match))
-                                      match))))))
-
            ;; Calculate the replacement string, if necessary.
            (when replacements
              (set-match-data real-match-data)
              (setq next-replacement
                    (funcall (car replacements) (cdr replacements)
-                            replace-count)
-                   noedit nil))
+                            replace-count)))
            (if (not query-flag)
                (let ((inhibit-read-only
                       query-replace-skip-read-only))
@@ -1519,10 +1576,17 @@ make, or the user didn't cancel the call."
                   (or delimited-flag regexp-flag) case-fold-search)
                  ;; Bind message-log-max so we don't fill up the message log
                  ;; with a bunch of identical messages.
-                 (let ((message-log-max nil))
+                 (let ((message-log-max nil)
+                       (replacement-presentation
+                        (if query-replace-show-replacement
+                            (save-match-data
+                              (set-match-data real-match-data)
+                              (match-substitute-replacement next-replacement
+                                                            nocasify literal))
+                          next-replacement)))
                    (message message
                              (query-replace-descr from-string)
-                             (query-replace-descr next-replacement)))
+                             (query-replace-descr replacement-presentation)))
                  (setq key (read-event))
                  ;; Necessary in case something happens during read-event
                  ;; that clobbers the match data.
@@ -1672,12 +1736,6 @@ make, or the user didn't cancel the call."
                              (match-data t)))
                      stack)))))
 
-      ;; The code preventing adjacent regexp matches in the condition
-      ;; of the while-loop above will haven taken us one character
-      ;; beyond the last replacement.  Undo that.
-      (when (and regexp-flag (not match-again) (> replace-count 0))
-       (backward-char 1))
-
       (replace-dehighlight))
     (or unread-command-events
        (message "Replaced %d occurrence%s"
@@ -1693,11 +1751,12 @@ make, or the user didn't cancel the call."
       (if replace-overlay
          (move-overlay replace-overlay match-beg match-end (current-buffer))
        (setq replace-overlay (make-overlay match-beg match-end))
-       (overlay-put replace-overlay 'priority 1) ;higher than lazy overlays
+       (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
        (overlay-put replace-overlay 'face 'query-replace)))
   (if query-replace-lazy-highlight
       (let ((isearch-string string)
            (isearch-regexp regexp)
+           (search-whitespace-regexp nil)
            (isearch-case-fold-search case-fold))
        (isearch-lazy-highlight-new-loop range-beg range-end))))