[Emacs-diffs] master fed6a0d 2/2: Implement xref-find-references in etags and elisp-mode

[Dmitry Gutov]

branch: master
commit fed6a0d6b1c11e45ee49549954ad306df89873ad
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Implement xref-find-references in etags and elisp-mode
    
    * lisp/progmodes/elisp-mode.el (elisp--xref-find-references): New function.
    (elisp-xref-find): Use it.
    
    * lisp/progmodes/etags.el (etags-xref-find): Use `xref-collect-references'.
    
    * lisp/progmodes/xref.el (xref-collect-references):
    (xref--collect-reference): New functions.
---
 lisp/progmodes/elisp-mode.el |   21 +++++++++++++++++++
 lisp/progmodes/etags.el      |    4 +++
 lisp/progmodes/xref.el       |   46 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 71 insertions(+), 0 deletions(-)

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index f289068..ef477d6 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -587,6 +587,8 @@ It can be quoted, or be inside a quoted form."
       (let ((sym (intern-soft id)))
         (when sym
           (elisp--xref-find-definitions sym))))
+    (`references
+     (elisp--xref-find-references id))
     (`apropos
      (elisp--xref-find-apropos id))))
 
@@ -635,6 +637,25 @@ It can be quoted, or be inside a quoted form."
              lst))))
       lst)))
 
+(defun elisp--xref-find-references (symbol)
+  (let* ((dirs (sort
+                (mapcar
+                 (lambda (dir)
+                   (file-name-as-directory (expand-file-name dir)))
+                 (cons package-user-dir load-path))
+                #'string<))
+         (ref dirs))
+    ;; Delete subdirectories from the list.
+    (while (cdr ref)
+      (if (string-prefix-p (car ref) (cadr ref))
+          (setcdr ref (cddr ref))
+        (setq ref (cdr ref))))
+    (mapcan
+     (lambda (dir)
+       (and (file-exists-p dir)
+            (xref-collect-references symbol dir)))
+     dirs)))
+
 (defun elisp--xref-find-apropos (regexp)
   (apply #'nconc
          (let (lst)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index b4ce8b1..9a57d8a 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2082,6 +2082,10 @@ for \\[find-tag] (which see)."
 (defun etags-xref-find (action id)
   (pcase action
     (`definitions (etags--xref-find-definitions id))
+    (`references (mapcan
+                  (lambda (file)
+                    (xref-collect-references id (file-name-directory file)))
+                  tags-table-list))
     (`apropos (etags--xref-find-definitions id t))))
 
 (defun etags--xref-find-definitions (pattern &optional regexp?)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index fc27c26..ea705fc 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -674,6 +674,52 @@ and just use etags."
     (setq-local xref-identifier-completion-table-function
                 (cdr xref-etags-mode--saved))))
 
+(declare-function semantic-symref-find-references-by-name "semantic/symref")
+(declare-function semantic-find-file-noselect "semantic/fw")
+
+(defun xref-collect-references (name dir)
+  "Collect mentions of NAME inside DIR.
+Uses the Semantic Symbol Reference API, see
+`semantic-symref-find-references-by-name' for details on which
+tools are used, and when."
+  (require 'semantic/symref)
+  (defvar semantic-symref-tool)
+  (cl-assert (directory-name-p dir))
+  (let* ((default-directory dir)
+         (semantic-symref-tool 'detect)
+         (res (semantic-symref-find-references-by-name name 'subdirs))
+         (hits (and res (oref res :hit-lines)))
+         (orig-buffers (buffer-list))
+         xrefs)
+    (unwind-protect
+        (setq xrefs
+              (mapcar (lambda (hit) (xref--collect-reference hit name))
+                      hits))
+      (mapc #'kill-buffer
+            (cl-set-difference (buffer-list) orig-buffers)))
+    (delq nil xrefs)))
+
+(defun xref--collect-reference (hit name)
+  (pcase-let* ((`(,line . ,file) hit)
+               (buf (or (find-buffer-visiting file)
+                        (semantic-find-file-noselect file))))
+    (with-current-buffer buf
+      (save-excursion
+        (goto-char (point-min))
+        (forward-line (1- line))
+        (when (re-search-forward (format "\\_<%s\\_>"
+                                         (regexp-quote name))
+                                 (line-end-position) t)
+          (goto-char (match-beginning 0))
+          (xref-make (format
+                      "%d: %s"
+                      line
+                      (buffer-substring
+                       (line-beginning-position)
+                       (line-end-position)))
+                     (xref-make-file-location file line
+                                              (current-column))))))))
+
 
 (provide 'xref)