[Emacs-diffs] master 62349fe 3/4: Support "reverting" Xref buffers (bug#35702)

[Dmitry Gutov]

branch: master
commit 62349fe82ad42d7d2a7fb19e40860ee5d6ebd017
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Support "reverting" Xref buffers (bug#35702)
    
    * lisp/progmodes/xref.el (xref--fetcher): New variable.
    (xref--xref-buffer-mode-map): Add binding for 'g'.
    (xref--revert-xref-buffer): New command.
    (xref--show-xref-buffer): Accept a function as the first argument.
    (xref--show-xrefs): Same.
    (xref--find-xrefs): Pass the above a fetcher function.
    
    * lisp/progmodes/project.el (project-find-regexp)
    (project-or-external-find-regexp): Same.
    
    * lisp/dired-aux.el (dired-do-find-regexp): Same.
---
 lisp/dired-aux.el         | 21 +++++++++++--------
 lisp/progmodes/project.el | 10 ++++++---
 lisp/progmodes/xref.el    | 53 ++++++++++++++++++++++++++++++++++++++---------
 3 files changed, 62 insertions(+), 22 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index f699b79..51749ac 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -2906,15 +2906,18 @@ REGEXP should use constructs supported by your local 
`grep' command."
                           #'file-name-as-directory
                           (rgrep-find-ignored-directories default-directory))
                          grep-find-ignored-files))
-         (xrefs (mapcan
-                 (lambda (file)
-                   (xref-collect-matches regexp "*" file
-                                         (and (file-directory-p file)
-                                              ignores)))
-                 files)))
-    (unless xrefs
-      (user-error "No matches for: %s" regexp))
-    (xref--show-xrefs xrefs nil)))
+         (fetcher
+          (lambda ()
+            (let ((xrefs (mapcan
+                          (lambda (file)
+                            (xref-collect-matches regexp "*" file
+                                                  (and (file-directory-p file)
+                                                       ignores)))
+                          files)))
+              (unless xrefs
+                (user-error "No matches for: %s" regexp))
+              xrefs))))
+    (xref--show-xrefs fetcher nil)))
 
 ;;;###autoload
 (defun dired-do-find-regexp-and-replace (from to)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index e44cee2..d494efa 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -351,7 +351,9 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
               (project--files-in-directory dir
                                            nil
                                            (grep-read-files regexp))))))
-    (project--find-regexp-in-files regexp files)))
+    (xref--show-xrefs
+     (apply-partially #'project--find-regexp-in-files regexp files)
+     nil)))
 
 (defun project--dir-ignores (project dir)
   (let* ((roots (project-roots project))
@@ -376,7 +378,9 @@ pattern to search for."
           (project-files pr (append
                              (project-roots pr)
                              (project-external-roots pr)))))
-    (project--find-regexp-in-files regexp files)))
+    (xref--show-xrefs
+     (apply-partially #'project--find-regexp-in-files regexp files)
+     nil)))
 
 (defun project--find-regexp-in-files (regexp files)
   (pcase-let*
@@ -418,7 +422,7 @@ pattern to search for."
     (setq xrefs (xref--convert-hits (nreverse hits) regexp))
     (unless xrefs
       (user-error "No matches for: %s" regexp))
-    (xref--show-xrefs xrefs nil)))
+    xrefs))
 
 (defun project--process-file-region (start end program
                                      &optional buffer display
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b226a41..6a4906a 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -477,6 +477,9 @@ If SELECT is non-nil, select the target window."
 (defvar-local xref--original-window nil
   "The original window this xref buffer was created from.")
 
+(defvar-local xref--fetcher nil
+  "The original function to call to fetch the list of xrefs.")
+
 (defun xref--show-pos-in-buf (pos buf)
   "Goto and display position POS of buffer BUF in a window.
 Honor `xref--original-window-intent', run `xref-after-jump-hook'
@@ -692,6 +695,7 @@ references displayed in the current *xref* buffer."
     ;; suggested by Johan Claesson "to further reduce finger movement":
     (define-key map (kbd ".") #'xref-next-line)
     (define-key map (kbd ",") #'xref-prev-line)
+    (define-key map (kbd "g") #'xref--revert-xref-buffer)
     map))
 
 (define-derived-mode xref--xref-buffer-mode special-mode "XREF"
@@ -777,8 +781,9 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
                     (xref-location-group (xref-item-location x)))
                   #'equal))
 
-(defun xref--show-xref-buffer (xrefs alist)
-  (let ((xref-alist (xref--analyze xrefs)))
+(defun xref--show-xref-buffer (fetcher alist)
+  (let* ((xrefs (if (functionp fetcher) (funcall fetcher) fetcher))
+         (xref-alist (xref--analyze xrefs)))
     (with-current-buffer (get-buffer-create xref-buffer-name)
       (setq buffer-undo-list nil)
       (let ((inhibit-read-only t)
@@ -790,8 +795,28 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
         (goto-char (point-min))
         (setq xref--original-window (assoc-default 'window alist)
               xref--original-window-intent (assoc-default 'display-action 
alist))
+        (when (functionp fetcher)
+          (setq xref--fetcher fetcher))
         (current-buffer)))))
 
+(defun xref--revert-xref-buffer ()
+  (interactive)
+  (unless xref--fetcher
+    (user-error "Reverting not supported"))
+  (let ((inhibit-read-only t)
+        (buffer-undo-list t))
+    (save-excursion
+      (erase-buffer)
+      (condition-case err
+          (xref--insert-xrefs
+           (xref--analyze (funcall xref--fetcher)))
+        (user-error
+         (insert
+          (propertize
+           (error-message-string err)
+           'face 'error))))
+      (goto-char (point-min)))))
+
 (defun xref--show-defs-buffer (xrefs alist)
   (cond
    ((not (cdr xrefs))
@@ -811,9 +836,9 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
 
 (defvar xref--read-pattern-history nil)
 
-(defun xref--show-xrefs (xrefs display-action)
+(defun xref--show-xrefs (fetcher display-action)
   (xref--push-markers)
-  (funcall xref-show-xrefs-function xrefs
+  (funcall xref-show-xrefs-function fetcher
            `((window . ,(selected-window))
              (display-action . ,display-action))))
 
@@ -860,12 +885,20 @@ Return an alist of the form ((FILENAME . (XREF ...)) 
...)."
 ;;; Commands
 
 (defun xref--find-xrefs (input kind arg display-action)
-  (let ((xrefs (funcall (intern (format "xref-backend-%s" kind))
-                        (xref-find-backend)
-                        arg)))
-    (unless xrefs
-      (xref--not-found-error kind input))
-    (xref--show-xrefs xrefs display-action)))
+  (let* ((orig-buffer (current-buffer))
+         (orig-position (point))
+         (backend (xref-find-backend))
+         (method (intern (format "xref-backend-%s" kind)))
+         (fetcher (lambda ()
+                    (save-excursion
+                      (when (buffer-live-p orig-buffer)
+                        (set-buffer orig-buffer)
+                        (ignore-errors (goto-char orig-position)))
+                      (let ((xrefs (funcall method backend arg)))
+                        (unless xrefs
+                          (xref--not-found-error kind input))
+                        xrefs)))))
+    (xref--show-xrefs fetcher display-action)))
 
 (defun xref--find-definitions (id display-action)
   (let ((xrefs (funcall #'xref-backend-definitions