(xref-show-definitions-completing-read): Add 'minibuffer-action'

diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 720266bee69febd643575b8c187b0220ed33e1c1..eacb2ea8f5cfd114b187215edbc695a17180eb74 100644 (file)
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1505,54 +1505,61 @@ When there is more than one definition, let the user choose
 between them by typing in the minibuffer with completion."
   (let* ((xrefs (funcall fetcher))
          (xref-alist (xref--analyze xrefs))
-         xref-alist-with-line-info
-         xref
-         (group-prefix-length
-          ;; FIXME: Groups are not always file names, but they often
-          ;; are.  At least this shouldn't make the other kinds of
-          ;; groups look worse.
-          (let ((common-prefix (try-completion "" xref-alist)))
-            (if (> (length common-prefix) 0)
-                (length (file-name-directory common-prefix))
-              0))))
-
-    (cl-loop for ((group . xrefs) . more1) on xref-alist
-             do
-             (cl-loop for (xref . more2) on xrefs do
-                      (let* ((summary (xref-item-summary xref))
-                             (location (xref-item-location xref))
-                             (line (xref-location-line location))
-                             (line-fmt
-                              (if line
-                                  (format #("%d:" 0 2 (face xref-line-number))
-                                          line)
-                                ""))
-                             (group-prefix
-                              (substring group group-prefix-length))
-                             (group-fmt
-                              (propertize group-prefix
-                                          'face 'xref-file-header
-                                          'xref--group group-prefix))
-                             (candidate
-                              (format "%s:%s%s" group-fmt line-fmt summary)))
-                        (push (cons candidate xref) xref-alist-with-line-info))))
-
-    (setq xref (if (not (cdr xrefs))
-                   (car xrefs)
-                 (let* ((collection (reverse xref-alist-with-line-info))
-                        (ctable
-                         (completion-table-with-metadata
-                          collection
-                          `((category . xref-location)
-                            (group-function . ,#'xref--completing-read-group))))
-                        (def (caar collection)))
-                   (cdr (assoc (completing-read "Choose definition: "
-                                                ctable nil t
-                                                nil nil
-                                                def)
-                               collection)))))
-
-    (xref-pop-to-location xref (assoc-default 'display-action alist))))
+         xref-alist-with-line-info)
+
+    (pcase-dolist (`(,group . ,xrefs) xref-alist)
+      (dolist (xref xrefs)
+        (let* ((summary (xref-item-summary xref))
+               (location (xref-item-location xref))
+               (line (xref-location-line location))
+               (line-fmt
+                (if line
+                    (format #("%d:" 0 2 (face xref-line-number))
+                            line)
+                  ""))
+               (group-fmt
+                (propertize group
+                            'face 'xref-file-header
+                            'xref--group group))
+               (candidate
+                (format "%s:%s%s" group-fmt line-fmt summary)))
+          (push (cons candidate xref) xref-alist-with-line-info))))
+
+    (xref-pop-to-location
+     (if (not (cdr xrefs))
+         (car xrefs)
+       (let* ((collection (reverse xref-alist-with-line-info))
+              (ctable
+               (completion-table-with-metadata
+                collection
+                `((category . xref-location)
+                  (group-function . ,#'xref--completing-read-group))))
+              (def (caar collection)))
+         (cdr (assoc
+               (minibuffer-with-setup-hook
+                   (lambda ()
+                     (setq minibuffer-action
+                           (cons
+                            (lambda (str)
+                              (let* ((item (cdr (assoc str collection)))
+                                     (marker (save-excursion
+                                               (xref-location-marker
+                                                (xref-item-location item))))
+                                     (buf (marker-buffer marker))
+                                     (win (display-buffer buf)))
+                                (with-current-buffer buf
+                                  (xref--goto-char marker)
+                                  (when (windowp win)
+                                    (set-window-point win (point))
+                                    (let ((xref-current-item item))
+                                      (xref-pulse-momentarily))))))
+                            "show")))
+                 (completing-read "Choose definition: "
+                                  ctable nil t
+                                  nil nil
+                                  def))
+               collection))))
+     (assoc-default 'display-action alist))))
 
 ;; TODO: Can delete this alias before Emacs 28's release.
 (define-obsolete-function-alias