From 51b748c4dd97cb60e7328b6510e8dd55da4a75ce Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Tue, 6 Feb 2024 20:33:53 +0100 Subject: [PATCH v2] Support bookmarking Xref results buffers * lisp/progmodes/xref.el (bookmark-make-record-default) (bookmark-make-record, bookmark-prop-get) (bookmark-handle-bookmark, bookmark-get-rear-context-string) (bookmark-get-front-context-string): Declare functions. (xref-backend-context, xref-backend-restore): New generic functions. (xref--backend, xref--identifier, xref--kind) (xref--original-buffer, xref--original-point): New local variables. (xref--show-common-initialize): Set them in Xref results buffer. (xref-default-bookmark-name-format): New user option. (xref-bookmark-make-record, xref-bookmark-jump): New functions. (xref--xref-buffer-mode): Set 'bookmark-make-record-function'. (xref-fetcher-alist): New variable. (xref--show-xref-buffer, xref-show-definitions-buffer) (xref-show-definitions-buffer-at-bottom): Use it. (xref--read-identifier): Improve error message. (xref-make-fetcher): Extract from... (xref--create-fetcher): ...here. * doc/emacs/maintaining.texi (Xref Commands): Document new feature. * etc/NEWS: Announce it. (Bug#68958) --- doc/emacs/maintaining.texi | 3 + etc/NEWS | 5 ++ lisp/progmodes/xref.el | 166 +++++++++++++++++++++++++++++++++---- 3 files changed, 157 insertions(+), 17 deletions(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index d3e06fa697b..4cd02851594 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2466,6 +2466,9 @@ Xref Commands @kbd{C-n}, and @kbd{C-p} are available for moving around the buffer without displaying the references. +You can bookmark and restore your place in @file{*xref*} buffers, see +@ref{Bookmarks}. + @node Identifier Search @subsubsection Searching and Replacing with Identifiers @cindex search and replace in multiple source files diff --git a/etc/NEWS b/etc/NEWS index f980d612a57..500433ff955 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -437,6 +437,11 @@ This mode now emits 'wheel-up/down/right/left' events instead of It uses the 'mouse-wheel-up/down/left/right-event' variables to decide which button maps to which wheel event (if any). +** Xref + ++++ +*** You can now bookmark (and later restore) "*xref*" buffers. + ** Info --- diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 717b837a2e5..249e018eb56 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -314,6 +314,21 @@ xref-backend-identifier-completion-ignore-case "Return t if case is not significant in identifier completion." completion-ignore-case) +(declare-function bookmark-make-record "bookmark") +(declare-function bookmark-make-record-default "bookmark") +(declare-function bookmark-prop-get "bookmark") +(declare-function bookmark-handle-bookmark "bookmark") +(declare-function bookmark-get-rear-context-string "bookmark") +(declare-function bookmark-get-front-context-string "bookmark") + +(cl-defgeneric xref-backend-context (_backend _identifier _kind) + "Return BACKEND-specific context for finding references to IDENTIFIER." + (bookmark-make-record)) + +(cl-defgeneric xref-backend-restore (_backend context) + "Restore BACKEND-specific CONTEXT." + (bookmark-handle-bookmark context)) + ;;; misc utilities (defun xref--alistify (list key) @@ -671,6 +686,23 @@ xref--original-window (defvar-local xref--fetcher nil "The original function to call to fetch the list of xrefs.") +(defvar-local xref--backend nil + "The backend that produced the xrefs that the current buffer is showing.") + +(defvar-local xref--identifier nil + "The identifier for which the current buffer is showing xrefs.") + +(defvar-local xref--kind nil + "The kind of xrefs the current buffer is showing.") + +(defvar-local xref--original-buffer nil + "Buffer in which the Xref command that created this buffer was called.") + +(defvar-local xref--original-point nil + "Position in which the Xref command that created this buffer was called. + +See also `xref--original-buffer'.") + (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' @@ -997,6 +1029,63 @@ xref--xref-buffer-mode-map (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) map)) +(defcustom xref-default-bookmark-name-format "%i %k" + "Format of the default bookmark name for Xref buffer bookmarks. + +The default bookmark name is the value of this option (a string), with +\"%i\" sequences substituted for the identifier that the Xref buffer is +showing information about, \"%k\" substituted with the kind of +information shown (\"references\", \"definitions\", etc.), and \"%b\" +substituted for the name of the backend that produced the information." + :type 'string + :version "30.1") + +(defun xref-bookmark-make-record () + "Return a bookmark record for bookmarking the current Xref buffer. + +This function is used as the value of `bookmark-make-record-function' in +Xref buffers." + (unless xref--backend + (user-error "Cannot bookmark due to unknown Xref backend")) + `(,(format-spec xref-default-bookmark-name-format + `((?i . ,xref--identifier) + (?k . ,xref--kind) + (?b . ,xref--backend))) + ,@(bookmark-make-record-default t) + (backend . ,xref--backend) + (context . ,(when (buffer-live-p xref--original-buffer) + (with-current-buffer xref--original-buffer + (save-excursion + (ignore-errors (goto-char xref--original-point)) + (xref-backend-context xref--backend + xref--identifier + xref--kind))))) + (identifier . ,xref--identifier) + (kind . ,xref--kind) + (handler . xref-bookmark-jump))) + +(defun xref-bookmark-jump (bookmark) + "Jump to Xref buffer bookmark BOOKMARK." + (let* ((backend (bookmark-prop-get bookmark 'backend)) + (context (bookmark-prop-get bookmark 'context)) + (identifier (bookmark-prop-get bookmark 'identifier)) + (kind (bookmark-prop-get bookmark 'kind)) + (fetcher (save-current-buffer + (xref-backend-restore backend context) + (xref-make-fetcher backend identifier kind identifier + (current-buffer) (point)))) + (xref-auto-jump-to-first-xref nil)) + (set-buffer (xref--show-xref-buffer fetcher nil)) + (let ((forward-str (bookmark-get-front-context-string bookmark)) + (behind-str (bookmark-get-rear-context-string bookmark))) + (when (and forward-str (search-forward forward-str (point-max) t)) + (goto-char (match-beginning 0))) + (when (and behind-str (search-backward behind-str (point-min) t)) + (goto-char (match-end 0))) + nil))) + +(put 'xref-bookmark-jump 'bookmark-handler-type "Xref") + (declare-function outline-search-text-property "outline" (property &optional value bound move backward looking-at)) @@ -1017,7 +1106,8 @@ xref--xref-buffer-mode (lambda (&optional bound move backward looking-at) (outline-search-text-property 'xref-group nil bound move backward looking-at))) - (setq-local outline-level (lambda () 1))) + (setq-local outline-level (lambda () 1)) + (setq-local bookmark-make-record-function #'xref-bookmark-make-record)) (defvar xref--transient-buffer-mode-map (let ((map (make-sparse-keymap))) @@ -1235,11 +1325,29 @@ xref--ensure-default-directory 0 nil (lambda () (with-current-buffer buffer (setq default-directory dd))))) +(defvar xref-fetcher-alist nil + "Alist with information about the last used Xref fetcher function. + +Fetcher functions which Xref passes to `xref-show-xrefs-function' set +this variable to an alist with the following key-value pairs: + +- (backend . BACKEND) where BACKEND is the Xref backend that the + fetcher invokes. +- (identifier . ID) where ID is the identifier for which the fetcher + fetches references. +- (kind . KIND) where KIND is the kind of references that the fetcher + fetches. +- (original-buffer . BUF) where BUF is the buffer in which the Xref + command that created the fetcher was invoked. +- (original-point . POS) where POS is the buffer position in which the + Xref command that created the fetcher was invoked.") + (defun xref--show-xref-buffer (fetcher alist) (cl-assert (functionp fetcher)) (let* ((xrefs (or (assoc-default 'fetched-xrefs alist) + (setq xref-fetcher-alist nil) (funcall fetcher))) (xref-alist (xref--analyze xrefs)) (dd default-directory) @@ -1247,7 +1355,7 @@ xref--show-xref-buffer (with-current-buffer (get-buffer-create xref-buffer-name) (xref--ensure-default-directory dd (current-buffer)) (xref--xref-buffer-mode) - (xref--show-common-initialize xref-alist fetcher alist) + (xref--show-common-initialize xref-alist fetcher (append xref-fetcher-alist alist)) (setq xref-num-matches-found (length xrefs)) (setq mode-line-process (list xref-mode-line-matches)) (pop-to-buffer (current-buffer)) @@ -1272,7 +1380,12 @@ xref--show-common-initialize (add-hook 'post-command-hook 'xref--apply-truncation nil t) (goto-char (point-min)) (setq xref--original-window (assoc-default 'window alist) - xref--original-window-intent (assoc-default 'display-action alist)) + xref--original-window-intent (assoc-default 'display-action alist) + xref--original-buffer (assoc-default 'original-buffer alist) + xref--original-point (assoc-default 'original-point alist) + xref--backend (assoc-default 'backend alist) + xref--identifier (assoc-default 'identifier alist) + xref--kind (assoc-default 'kind alist)) (setq xref--fetcher fetcher))) (defun xref-revert-buffer () @@ -1310,6 +1423,7 @@ xref-show-definitions-buffer "Show the definitions list in a regular window. When only one definition found, jump to it right away instead." + (setq xref-fetcher-alist nil) (let ((xrefs (funcall fetcher)) buf) (cond @@ -1333,6 +1447,7 @@ xref-show-definitions-buffer-at-bottom When there is more than one definition, split the selected window and show the list in a small window at the bottom. And use a local keymap that binds `RET' to `xref-quit-and-goto-xref'." + (setq xref-fetcher-alist nil) (let* ((xrefs (funcall fetcher)) (dd default-directory) ;; XXX: Make percentage customizable maybe? @@ -1353,7 +1468,7 @@ xref-show-definitions-buffer-at-bottom (with-current-buffer (get-buffer-create xref-buffer-name) (xref--ensure-default-directory dd (current-buffer)) (xref--transient-buffer-mode) - (xref--show-common-initialize xref-alist fetcher alist) + (xref--show-common-initialize xref-alist fetcher (append xref-fetcher-alist alist)) (pop-to-buffer (current-buffer) `(display-buffer-in-direction . ((direction . below) (window-height . ,size-fun)))) @@ -1552,7 +1667,7 @@ xref--read-identifier nil nil nil 'xref--read-identifier-history def t))) (if (equal id "") - (or def (user-error "There is no default identifier")) + (or def (user-error "No default identifier")) id))) (t def)))) @@ -1569,16 +1684,23 @@ xref--find-definitions (xref--create-fetcher id 'definitions id) display-action)) -(defun xref--create-fetcher (input kind arg) - "Return an xref list fetcher function. +(defun xref-make-fetcher (backend input kind identifier buffer point) + "Return fetcher function for xrefs of kind KIND for IDENTIFIER using BACKEND. -It revisits the saved position and delegates the finding logic to -the xref backend method indicated by KIND and passes ARG to it." - (let* ((orig-buffer (current-buffer)) - (orig-position (point)) - (backend (xref-find-backend)) - (method (intern (format "xref-backend-%s" kind)))) +INPUT is the user input for the Xref operation, usually it is the same +as IDENTIFIER, but the two may differ when KIND is `apropos'. BUFFER +and POINT are the buffer and specific position in which the xref +operation was invoked. + +The fetcher function returns a list of xrefs, and sets +`xref-fetcher-alist', which see." + (let ((method (intern (format "xref-backend-%s" kind)))) (lambda () + (setq xref-fetcher-alist (list (cons 'original-buffer buffer) + (cons 'original-point point) + (cons 'backend backend) + (cons 'identifier identifier) + (cons 'kind kind))) (save-excursion ;; Xref methods are generally allowed to depend on the text ;; around point, not just on their explicit arguments. @@ -1586,14 +1708,24 @@ xref--create-fetcher ;; There is only so much we can do, however, to recreate that ;; context, given that the user is free to change the buffer ;; contents freely in the meantime. - (when (buffer-live-p orig-buffer) - (set-buffer orig-buffer) - (ignore-errors (goto-char orig-position))) - (let ((xrefs (funcall method backend arg))) + (when (buffer-live-p buffer) + (set-buffer buffer) + (ignore-errors (goto-char point))) + (let ((xrefs (funcall method backend identifier))) (unless xrefs (xref--not-found-error kind input)) xrefs))))) +(defun xref--create-fetcher (input kind arg) + "Return an xref list fetcher function. + +It revisits the saved position and delegates the finding logic to +the xref backend method indicated by KIND and passes ARG to it." + (xref-make-fetcher (xref-find-backend) + input kind arg + (current-buffer) + (copy-marker (point)))) + (defun xref--not-found-error (kind input) (user-error "No %s found for: %s" (symbol-name kind) input)) -- 2.42.0