1 files changed, 92 insertions, 54 deletions

diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b5632af13ab..f651dc9cd18 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -521,58 +521,86 @@ references displayed in the current *xref* buffer."
    (let ((fr (read-regexp "Xref query-replace (regexp)" ".*")))
      (list fr
            (read-regexp (format "Xref query-replace (regexp) %s with: " fr)))))
-  (let ((reporter (make-progress-reporter (format "Saving search results...")
-                                          0 (line-number-at-pos (point-max))))
-        (counter 0)
-        pairs item)
+  (let* (item xrefs iter)
+    (save-excursion
+      (while (setq item (xref--search-property 'xref-item))
+        (when (xref-match-length item)
+          (push item xrefs))))
     (unwind-protect
         (progn
-          (save-excursion
-            (goto-char (point-min))
-            ;; TODO: This list should be computed on-demand instead.
-            ;; As long as the UI just iterates through matches one by
-            ;; one, there's no need to compute them all in advance.
-            ;; Then we can throw away the reporter.
-            (while (setq item (xref--search-property 'xref-item))
-              (when (xref-match-length item)
-                (save-excursion
-                  (let* ((loc (xref-item-location item))
-                         (beg (xref-location-marker loc))
-                         (end (move-marker (make-marker)
-                                           (+ beg (xref-match-length item))
-                                           (marker-buffer beg))))
-                    ;; Perform sanity check first.
-                    (xref--goto-location loc)
-                    ;; FIXME: The check should probably be a generic
-                    ;; function, instead of the assumption that all
-                    ;; matches contain the full line as summary.
-                    ;; TODO: Offer to re-scan otherwise.
-                    (unless (equal (buffer-substring-no-properties
-                                    (line-beginning-position)
-                                    (line-end-position))
-                                   (xref-item-summary item))
-                      (user-error "Search results out of date"))
-                    (progress-reporter-update reporter (cl-incf counter))
-                    (push (cons beg end) pairs)))))
-            (setq pairs (nreverse pairs)))
-          (unless pairs (user-error "No suitable matches here"))
-          (progress-reporter-done reporter)
-          (xref--query-replace-1 from to pairs))
-      (dolist (pair pairs)
-        (move-marker (car pair) nil)
-        (move-marker (cdr pair) nil)))))
+          (goto-char (point-min))
+          (setq iter (xref--buf-pairs-iterator (nreverse xrefs)))
+          (xref--query-replace-1 from to iter))
+      (funcall iter :cleanup))))
+
+(defun xref--buf-pairs-iterator (xrefs)
+  (let (chunk-done item next-pair file-buf pairs all-pairs)
+    (lambda (action)
+      (pcase action
+        (:next
+         (when (or xrefs next-pair)
+           (setq chunk-done nil)
+           (when next-pair
+             (setq file-buf (marker-buffer (car next-pair))
+                   pairs (list next-pair)
+                   next-pair nil))
+           (while (and (not chunk-done)
+                       (setq item (pop xrefs)))
+             (save-excursion
+               (let* ((loc (xref-item-location item))
+                      (beg (xref-location-marker loc))
+                      (end (move-marker (make-marker)
+                                        (+ beg (xref-match-length item))
+                                        (marker-buffer beg))))
+                 (let ((pair (cons beg end)))
+                   (push pair all-pairs)
+                   ;; Perform sanity check first.
+                   (xref--goto-location loc)
+                   (if (xref--outdated-p item
+                                         (buffer-substring-no-properties
+                                          (line-beginning-position)
+                                          (line-end-position)))
+                       (message "Search result out of date, skipping")
+                     (cond
+                      ((null file-buf)
+                       (setq file-buf (marker-buffer beg))
+                       (push pair pairs))
+                      ((equal file-buf (marker-buffer beg))
+                       (push pair pairs))
+                      (t
+                       (setq chunk-done t
+                             next-pair pair))))))))
+           (cons file-buf (nreverse pairs))))
+        (:cleanup
+         (dolist (pair all-pairs)
+           (move-marker (car pair) nil)
+           (move-marker (cdr pair) nil)))))))
+
+(defun xref--outdated-p (item line-text)
+  ;; FIXME: The check should probably be a generic function instead of
+  ;; the assumption that all matches contain the full line as summary.
+  (let ((summary (xref-item-summary item))
+        (strip (lambda (s) (if (string-match "\r\\'" s)
+                          (substring-no-properties s 0 -1)
+                        s))))
+    (not
+     ;; Sometimes buffer contents include ^M, and sometimes Grep
+     ;; output includes it, and they don't always match.
+     (equal (funcall strip line-text)
+            (funcall strip summary)))))
 
 ;; FIXME: Write a nicer UI.
-(defun xref--query-replace-1 (from to pairs)
+(defun xref--query-replace-1 (from to iter)
   (let* ((query-replace-lazy-highlight nil)
-         current-beg current-end current-buf
+         (continue t)
+         did-it-once buf-pairs pairs
+         current-beg current-end
          ;; Counteract the "do the next match now" hack in
          ;; `perform-replace'.  And still, it'll report that those
          ;; matches were "filtered out" at the end.
          (isearch-filter-predicate
           (lambda (beg end)
             (and current-beg
-                 (eq (current-buffer) current-buf)
                  (>= beg current-beg)
                  (<= end current-end))))
          (replace-re-search-function
@@ -581,19 +609,22 @@ references displayed in the current *xref* buffer."
               (while (and (not found) pairs)
                 (setq pair (pop pairs)
                       current-beg (car pair)
-                      current-end (cdr pair)
-                      current-buf (marker-buffer current-beg))
-                (xref--with-dedicated-window
-                 (pop-to-buffer current-buf))
+                      current-end (cdr pair))
                 (goto-char current-beg)
                 (when (re-search-forward from current-end noerror)
                   (setq found t)))
               found))))
-    ;; FIXME: Despite this being a multi-buffer replacement, `N'
-    ;; doesn't work, because we're not using
-    ;; `multi-query-replace-map', and it would expect the below
-    ;; function to be called once per buffer.
-    (perform-replace from to t t nil)))
+    (while (and continue (setq buf-pairs (funcall iter :next)))
+      (if did-it-once
+          ;; Reuse the same window for subsequent buffers.
+          (switch-to-buffer (car buf-pairs))
+        (xref--with-dedicated-window
+         (pop-to-buffer (car buf-pairs)))
+        (setq did-it-once t))
+      (setq pairs (cdr buf-pairs))
+      (setq continue
+            (perform-replace from to t t nil nil multi-query-replace-map)))
+    (unless did-it-once (user-error "No suitable matches here"))))
 
 (defvar xref--xref-buffer-mode-map
   (let ((map (make-sparse-keymap)))
@@ -687,7 +718,9 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
 (defun xref--show-xref-buffer (xrefs alist)
   (let ((xref-alist (xref--analyze xrefs)))
     (with-current-buffer (get-buffer-create xref-buffer-name)
-      (let ((inhibit-read-only t))
+      (setq buffer-undo-list nil)
+      (let ((inhibit-read-only t)
+            (buffer-undo-list t))
         (erase-buffer)
         (xref--insert-xrefs xref-alist)
         (xref--xref-buffer-mode)
@@ -908,6 +941,8 @@ IGNORES is a list of glob patterns."
   (require 'find-dired)      ; for `find-name-arg'
   (defvar grep-find-template)
   (defvar find-name-arg)
+  ;; `shell-quote-argument' quotes the tilde as well.
+  (cl-assert (not (string-match-p "\\`~" dir)))
   (grep-expand-template
    grep-find-template
    regexp
@@ -919,14 +954,13 @@ IGNORES is a list of glob patterns."
             (concat " -o " find-name-arg " "))
            " "
            (shell-quote-argument ")"))
-   dir
+   (shell-quote-argument dir)
    (xref--find-ignores-arguments ignores dir)))
 
 (defun xref--find-ignores-arguments (ignores dir)
   "Convert IGNORES and DIR to a list of arguments for 'find'.
 IGNORES is a list of glob patterns.  DIR is an absolute
 directory, used as the root of the ignore globs."
-  ;; `shell-quote-argument' quotes the tilde as well.
   (cl-assert (not (string-match-p "\\`~" dir)))
   (when ignores
     (concat
@@ -1014,7 +1048,11 @@ directory, used as the root of the ignore globs."
     (syntax-propertize line-end)
     ;; FIXME: This results in several lines with the same
     ;; summary. Solve with composite pattern?
-    (while (re-search-forward regexp line-end t)
+    (while (and
+            ;; REGEXP might match an empty string.  Or line.
+            (or (null matches)
+                (> (point) line-beg))
+            (re-search-forward regexp line-end t))
       (let* ((beg-column (- (match-beginning 0) line-beg))
              (end-column (- (match-end 0) line-beg))
              (loc (xref-make-file-location file line beg-column))