From 43779948d064453942dc97cacd3e8a4be8048f19 Mon Sep 17 00:00:00 2001
From: Visuwesh <visuweshm@gmail.com>
Date: Sat, 25 Jun 2022 19:32:49 +0530
Subject: [PATCH] Add imenu xref backend

* imenu.el (imenu--in-alist): Add new optional argument.
(imenu-xref-backend): New xref backend.
(imenu-xref-identifier-function, imenu-xref--following-backends): Add.
(imenu-xref--make-summary, imenu-xref--make-location)
(imenu-xref--flatten): Add helper functions.
(xref-backend-identifier-at-point, xref-backend-definitions)
(xref-backend-identifier-completion-ignore-case)
(xref-backend-identifier-completion-table): Add 'imenu' method.

(bug#28407)
---
 lisp/imenu.el | 101 +++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 96 insertions(+), 5 deletions(-)

diff --git a/lisp/imenu.el b/lisp/imenu.el
index 4393c6ed6c..9820de54e3 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -52,6 +52,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'xref)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -473,8 +474,10 @@ imenu--create-keymap
                         (if cmd (funcall cmd item) item))))))
               alist)))
 
-(defun imenu--in-alist (str alist)
-  "Check whether the string STR is contained in multi-level ALIST."
+(defun imenu--in-alist (str alist &optional all)
+  "Check whether the string STR is contained in multi-level ALIST.
+If the optional argument ALL is non-nil, then return all matches
+of STR in ALIST."
   (let (elt head tail res)
     (setq res nil)
     (while alist
@@ -491,12 +494,18 @@ imenu--in-alist
       ;; We are only interested in the bottom-level elements, so we need to
       ;; recurse if TAIL is a nested ALIST.
       (cond ((imenu--subalist-p elt)
-	     (if (setq res (imenu--in-alist str tail))
-		 (setq alist nil)))
+             (let ((r (imenu--in-alist str tail all)))
+               (if all
+                   (setq res (append res (if (listp (cdr r)) r (list r))))
+                 (setq res r)
+                 (when r
+                   (setq alist nil)))))
 	    ((if imenu-name-lookup-function
                  (funcall imenu-name-lookup-function str head)
                (string= str head))
-	     (setq alist nil res elt))))
+             (if all
+                 (push elt res)
+               (setq alist nil res elt)))))
     res))
 
 ;;;###autoload
@@ -550,6 +559,88 @@ imenu-default-create-index-function
 	(t
          (imenu-unavailable-error "This buffer cannot use `imenu-default-create-index-function'"))))
 
+;;;
+;;; Xref backend
+;;;
+
+(defvar-local imenu-xref-identifier-function nil
+  "Function to fetch the identifier for xref.")
+
+;;;###autoload
+(defun imenu-xref-backend ()
+  (unless imenu--index-alist
+    (imenu--make-index-alist))
+  (and imenu--index-alist 'imenu))
+
+(defun imenu-xref--following-backends ()
+  "Return the xref backends following the imenu one."
+  (let (backends)
+    (dolist (b (cdr (memq 'imenu-xref-backend xref-backend-functions)))
+      (when-let ((backend (and (functionp b) (funcall b))))
+        (push backend backends)))
+    (setq backends (nreverse backends))
+    backends))
+
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'imenu)))
+  (or (and imenu-xref-identifier-function
+           (funcall imenu-xref-identifier-function))
+      (thing-at-point 'symbol)))
+
+(defun imenu-xref--make-summary (marker)
+  (with-current-buffer (marker-buffer marker)
+    (save-excursion
+      (goto-char marker)
+      (back-to-indentation)
+      (buffer-substring (point) (point-at-eol)))))
+
+(defun imenu-xref--make-location (item)
+  (xref-make (imenu-xref--make-summary (cdr item))
+             (xref-make-buffer-location (marker-buffer (cdr item))
+                                        (marker-position (cdr item)))))
+
+(cl-defmethod xref-backend-definitions ((_backend (eql 'imenu)) identifier)
+  (if-let ((pos (string-search imenu-level-separator identifier)))
+      ;; We only care about the exact match here so ALL is nil.
+      (let ((alist (imenu--in-alist (substring identifier 0 pos) imenu--index-alist)))
+        (while (and (listp alist) (listp (cdr alist)))
+          (setq identifier (substring identifier (1+ pos))
+                pos (string-search imenu-level-separator identifier)
+                alist (imenu--in-alist (substring identifier 0 pos) imenu--index-alist)))
+        (list (imenu-xref--make-location alist)))
+    (let ((res (imenu--in-alist identifier imenu--index-alist t))
+          defs)
+      (dolist (item res)
+        (push (imenu-xref--make-location item) defs))
+      (unless defs
+        (dolist (b (imenu-xref--following-backends))
+          (ignore-errors
+            ;; FIXME: This does not catch duplicates!
+            (setq defs (append defs (xref-backend-definitions b identifier))))))
+      defs)))
+
+(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql 'imenu)))
+  imenu-case-fold-search)
+
+(defun imenu-xref--flatten (alist &optional prefix)
+  (let (res)
+    (dolist (item alist)
+      (if (imenu--subalist-p item)
+          (setq res (append res (imenu-xref--flatten
+                                 (cdr item)
+                                 (concat prefix (when prefix imenu-level-separator) (car item)))))
+        (push (cons (concat prefix (when prefix imenu-level-separator) (car item))
+                    (cdr item))
+              res)))
+    res))
+
+(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql 'imenu)))
+  (let ((collection (imenu-xref--flatten imenu--index-alist)))
+    (apply #'completion-table-merge
+           (append (list (lambda (string pred action)
+                           (complete-with-action action collection string pred)))
+                   (mapcar #'xref-backend-identifier-completion-table
+                           (imenu-xref--following-backends))))))
+
 ;;;
 ;;; Generic index gathering function.
 ;;;
-- 
2.35.1