bug#68958: [PATCH] Support bookmarking Xref results buffers

[Eshel Yaron via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 572 bytes --]

Tags: patch

Hello Dmitry, All,

This patch adds support for bookmarking "*xref*" buffers and restoring
them later, even across Emacs sessions.

To make this happen, we need to propagate some more information to the
"*xref*" buffer (and any other Xref fronted).  We do this, without
breaking compatibility, by setting a new variable from inside the xrefs
fetcher function.  The frontend can examine this variable to learn all
about the source of the fetched xrefs after invoking the fetcher.
Namely, the "*xref*" buffer uses this information to create bookmarks.

WDYT?



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Support-bookmarking-Xref-results-buffers.patch --]
[-- Type: text/patch, Size: 15350 bytes --]

From 62f76297ec240df8101ab47fa4a89fa584b7f05c Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Tue, 6 Feb 2024 20:33:53 +0100
Subject: [PATCH] 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 new feature and Xref generic functions.
---
 doc/emacs/maintaining.texi |   4 +
 etc/NEWS                   |  12 +++
 lisp/progmodes/xref.el     | 166 +++++++++++++++++++++++++++++++++----
 3 files changed, 165 insertions(+), 17 deletions(-)

diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index d3e06fa697b..dd3fb3c2dd2 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -2466,6 +2466,10 @@ Xref Commands
 @kbd{C-n}, and @kbd{C-p} are available for moving around the buffer
 without displaying the references.
 
+You can also bookmark the @file{*xref*} buffer with @kbd{C-x r m} and
+restore it from the same state later by jumping to that bookmark with
+@kbd{C-x r b}.  @xref{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..a33a0e9855b 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
 
 ---
@@ -1664,6 +1669,13 @@ styles to skip eager fontification of completion candidates, which
 improves performance.  Such a Lisp program can then use the
 'completion-lazy-hilit' function to fontify candidates just in time.
 
+** New Xref generic functions for recording and restoring context.
+Xref backends can now implement the generic function
+'xref-backend-context' to change how Xref records the context used for
+fetching cross-references when bookmarking Xref results for later use.
+In addition, the new generic function 'xref-backend-restore' lets
+backends change how Xref then restores this context.
+
 ** Functions and variables to transpose sexps
 
 +++
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))
+
 \f
 ;;; 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