elisp-mode.el: Improve xref-backend-references impl.

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 9efcdac242c54cc8247a42d0ffec52bf7da16d7d..8a99d58781d6e53e5b459de270be1e3839455168 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -30,6 +30,7 @@
 
 (require 'cl-generic)
 (require 'lisp-mode)
+(require 'project)
 (eval-when-compile (require 'cl-lib))
 (eval-when-compile (require 'subr-x))
 
@@ -436,7 +437,7 @@ happens in interactive invocations."
 (defun elisp--annotate-symbol-with-help-echo (type beg end def)
   (put-text-property
    beg end 'help-echo
-   (cl-case type
+   (case type
      (variable      (cond ((equal beg def) "Local variable definition")
                           (def             "Local variable")
                           (t (elisp--help-echo beg end 'variable-documentation "Special variable"))))
@@ -486,7 +487,7 @@ happens in interactive invocations."
   (elisp--annotate-symbol-with-help-echo type sym (+ sym len) def)
   (let ((face (cond
                ((null id)
-                (cl-case type
+                (case type
                   (variable      'elisp-free-variable)
                   (face          'elisp-face)
                   (function      'elisp-function-call)
@@ -819,14 +820,14 @@ in `completion-at-point-functions' (which see)."
   (with-syntax-table emacs-lisp-mode-syntax-table
     (when-let ((pos (point))
                (scope-assume-func-p t)
-               (predicate (cl-case (save-excursion
-                                     (goto-char pos)
-                                     (beginning-of-defun)
-                                     (catch 'sym-type
-                                       (scope (lambda (type beg len &rest _)
-                                                (when (<= beg pos (+ beg len))
-                                                  (throw 'sym-type type))))
-                                       nil))
+               (predicate (case (save-excursion
+                                  (goto-char pos)
+                                  (beginning-of-defun)
+                                  (catch 'sym-type
+                                    (scope (lambda (type beg len &rest _)
+                                             (when (<= beg pos (+ beg len))
+                                               (throw 'sym-type type))))
+                                    nil))
                             ((variable constant) (let ((local-vars (elisp-local-variables)))
                                                    (lambda (sym) (or (elisp--shorthand-aware-boundp sym)
                                                                      (memq sym local-vars)))))
@@ -1089,11 +1090,11 @@ confidence."
 (defun elisp--xref-infer-namespace-1 (pos)
   (save-excursion
     (beginning-of-defun-raw)
-    (cl-case (catch 'sym-type
-               (scope (lambda (type beg len &rest _)
-                        (when (<= beg pos (+ beg len))
-                          (throw 'sym-type type))))
-               nil)
+    (case (catch 'sym-type
+            (scope (lambda (type beg len &rest _)
+                     (when (<= beg pos (+ beg len))
+                       (throw 'sym-type type))))
+            nil)
       ((defface face) 'face)
       ((feature) 'feature)
       ((widget-type) 'widget-type)
@@ -1151,26 +1152,58 @@ confidence."
      (pcase-lambda (`(,beg ,len ,id)) (when (equal id cur) (cons beg len)))
      all)))
 
-(cl-defmethod xref-backend-references :around ((backend (eql 'elisp)) identifier)
+(cl-defmethod xref-backend-references :around ((_backend (eql 'elisp)) identifier)
   (let* ((pos (get-text-property 0 'pos identifier))
-         (all (elisp-local-references pos)))
-    (if all
-        (let (res)
-          (pcase-dolist (`(,sym . ,len) all)
-            (let* ((beg-end (save-excursion
-                              (goto-char sym)
-                              (cons (pos-bol) (pos-eol))))
-                   (beg (car beg-end))
-                   (end (cdr beg-end))
-                   (line (buffer-substring-no-properties beg end))
-                   (cur (- sym beg)))
-              (add-face-text-property cur (+ len cur)
-                                      'xref-match t line)
-              (push (xref-make line (xref-make-buffer-location
-                                     (current-buffer) sym))
-                    res)))
+         (enable-local-variables nil))
+    (or (elisp-make-xrefs (elisp-local-references pos))
+        (let (res
+              (types
+               (case (elisp--xref-infer-namespace-1 pos)
+                 (face '(defface face))
+                 (feature '(feature))
+                 (widget-type '(widget-type))
+                 (condition '(condition))
+                 (variable '(defvar variable constant))
+                 (function '(defun function macro special-form top-level major-mode)))))
+          (dolist-with-progress-reporter
+              (file
+               (seq-filter
+                (lambda (file) (string= (file-name-extension file) "el"))
+                (project-files (project-current))))
+              "Scanning for references"
+            (with-current-buffer (find-file-noselect file)
+              (let (all)
+                (save-excursion
+                  (goto-char (point-min))
+                  (condition-case e
+                      (while t
+                        (scope
+                         (lambda (type beg len &rest _)
+                           (and (or (null types) (memq type types))
+                                (string= identifier (buffer-substring-no-properties beg (+ beg len)))
+                                (push (cons beg len) all)))))
+                    (end-of-file
+                     (setq res (nconc (elisp-make-xrefs all) res)))
+                    (error (message "Encountered error while scanning %s: %S" file e) nil))))))
           res)
-      (cl-call-next-method backend identifier))))
+        ;; (cl-call-next-method backend identifier)
+        )))
+
+(defun elisp-make-xrefs (all)
+  (let (res)
+    (pcase-dolist (`(,sym . ,len) all)
+      (let* ((beg-end (save-excursion
+                        (goto-char sym)
+                        (cons (pos-bol) (pos-eol))))
+             (beg (car beg-end))
+             (end (cdr beg-end))
+             (line (buffer-substring-no-properties beg end))
+             (cur (- sym beg)))
+        (add-face-text-property cur (+ len cur) 'xref-match t line)
+        (push (xref-make line (xref-make-buffer-location
+                               (current-buffer) sym))
+              res)))
+    res))
 
 (defun elisp--xref-filter-definitions (definitions namespace symbol)
   (if (eq namespace 'any)
@@ -2617,7 +2650,7 @@ of TARGET."
     (condition-case nil
         (while t
           (scope (lambda (type beg len &rest _)
-                   (cl-case type
+                   (case type
                      ((defun)
                       (push (cons (buffer-substring-no-properties beg (+ beg len)) beg)
                             (alist-get "Function" index nil nil #'string=)))