[elpa] externals/ggtags 2f538aa 7/9: Add xref support

[Stefan Monnier]

branch: externals/ggtags
commit 2f538aa15c60ad8365b7240579f67a90f600c1d1
Author: Nathaniel Nicandro <nathanielnicandro@gmail.com>
Commit: Leo Liu <sdl.web@gmail.com>

    Add xref support
---
 ggtags.el | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 93 insertions(+)

diff --git a/ggtags.el b/ggtags.el
index b7fcf4a..8830679 100644
--- a/ggtags.el
+++ b/ggtags.el
@@ -2201,6 +2201,7 @@ to nil disables displaying this information.")
   (if ggtags-mode
       (progn
         (add-hook 'after-save-hook 'ggtags-after-save-function nil t)
+        (add-hook 'xref-backend-functions 'ggtags--xref-backend nil t)
         ;; Append to serve as a fallback method.
         (add-hook 'completion-at-point-functions
                   #'ggtags-completion-at-point t t)
@@ -2216,6 +2217,7 @@ to nil disables displaying this information.")
                 (append mode-line-buffer-identification
                         '(ggtags-mode-line-project-name)))))
     (remove-hook 'after-save-hook 'ggtags-after-save-function t)
+    (remove-hook 'xref-backend-functions 'ggtags--xref-backend t)
     (remove-hook 'completion-at-point-functions #'ggtags-completion-at-point t)
     (remove-function (local 'eldoc-documentation-function) 
'ggtags-eldoc-function)
     (setq mode-line-buffer-identification
@@ -2358,6 +2360,97 @@ Function `ggtags-eldoc-function' disabled for eldoc in 
current buffer: %S" err))
     (setq he-expand-list (cdr he-expand-list))
     t))
 
+;;; Xref
+
+(defconst ggtags--xref-limit 1000)
+
+(defclass ggtags-xref-location (xref-file-location)
+  ((project-root :type string :initarg :project-root)))
+
+(cl-defmethod xref-location-group ((l ggtags-xref-location))
+  (with-slots (file project-root) l
+    (file-relative-name file project-root)))
+
+(defun ggtags--xref-backend ()
+  (and (ggtags-find-project)
+       (let ((tag (ggtags-tag-at-point)))
+         ;; Try to use this backend if there is no tag at
+         ;; point, since we may still want to when asking
+         ;; the user for a tag.
+         (or (null tag)
+             (test-completion tag ggtags-completion-table)))
+       'ggtags))
+
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql ggtags)))
+  (ggtags-tag-at-point))
+
+(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql 
ggtags)))
+  ggtags-completion-table)
+
+(defun ggtags--xref-collect-tags (tag root colored)
+  "Collect xrefs for TAG from Global output in the `current-buffer'.
+Return the list of xrefs for TAG. Global output is assumed to
+have grep format.
+
+ROOT is the project root directory to associate with the xrefs.
+
+If COLORED is non-nil, convert ANSI color codes to font lock text
+properties in the summary text of each xref."
+  (cl-loop
+   with re = (cadr (assq 'grep ggtags-global-error-regexp-alist-alist))
+   while (re-search-forward re nil t)
+   for summary = (buffer-substring (1+ (match-end 2)) (line-end-position))
+   for file = (expand-file-name (match-string 1))
+   for line = (string-to-number (match-string 2))
+   for column = (string-match-p tag summary)
+   if colored do (setq summary (ansi-color-apply summary)) end
+   ;; Sometimes there are false positives, depending on the
+   ;; parser used so only collect lines that actually
+   ;; contain TAG.
+   and when column
+   collect (xref-make
+            summary
+            (make-instance
+             'ggtags-xref-location
+             :file file
+             :line line
+             :column column
+             :project-root root))))
+
+(defun ggtags--xref-find-tags (tag cmd)
+  "Find xrefs of TAG using Global CMD.
+CMD has the same meaning as in `ggtags-global-build-command'.
+Return the list of xrefs for TAG."
+  (let* ((ggtags-global-output-format 'grep)
+         (project (ggtags-find-project))
+         (xrefs nil)
+         (collect
+          (lambda (_status)
+            (goto-char (point-min))
+            (setq xrefs (ggtags--xref-collect-tags
+                         tag
+                         (ggtags-project-root project)
+                         (and ggtags-global-use-color
+                              (ggtags-project-has-color project))))
+            (kill-buffer (current-buffer)))))
+    (ggtags-with-current-project
+      (ggtags-global-output
+       (get-buffer-create " *ggtags-xref*")
+       (append
+        (split-string (ggtags-global-build-command cmd))
+        (list "--" (shell-quote-argument tag)))
+       collect ggtags--xref-limit 'sync)
+      xrefs)))
+
+(cl-defmethod xref-backend-definitions ((_backend (eql ggtags)) tag)
+  (ggtags--xref-find-tags tag 'definition))
+
+(cl-defmethod xref-backend-references ((_backend (eql ggtags)) tag)
+  (ggtags--xref-find-tags tag 'reference))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql ggtags)) tag)
+  (ggtags--xref-find-tags tag 'grep))
+
 (defun ggtags-reload (&optional force)
   (interactive "P")
   (unload-feature 'ggtags force)