From 62349fe82ad42d7d2a7fb19e40860ee5d6ebd017 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 24 May 2019 04:50:44 +0300 Subject: [PATCH] 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 f699b79432b..51749acb217 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 e44cee2133f..d494efa493a 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -351,7 +351,9 @@ requires quoting, e.g. `\\[quoted-insert]'." (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 b226a41929f..6a4906a2325 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 -- 2.39.2