mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-15 09:47:20 +00:00
Code Issues Releases Activity

Support tags-apropos-additional-actions in etags Xref backend

Browse Source 
* lisp/progmodes/etags.el (xref-etags-apropos-location):
New class.
(xref-location-marker): New method definition.
(xref-make-etags-apropos-location): New function.
(etags--xref-apropos-additional): New function.
(xref-backend-apropos): Use it here.
This commit is contained in:
Dmitry Gutov 2021-09-10 03:16:14 +03:00
parent ceb60225ba
commit b2c44706b6
2 changed files with 52 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
etc/NEWS
View File

@ -2382,6 +2382,9 @@ binding in 'xref--xref-buffer-mode-map'.
When non-nil, matches for identifiers in the file visited by the
current buffer will be shown first in the "*xref*" buffer.
*** The etags Xref backend now honors 'tags-apropos-additional-actions'.
You can customize it to augment the output of 'xref-find-apropos'.
** Battery
---

50
lisp/progmodes/etags.el
View File

@ -2096,7 +2096,10 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
definitions))
(cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
(etags--xref-find-definitions (xref-apropos-regexp pattern) t))
(let ((regexp (xref-apropos-regexp pattern)))
(nconc
(etags--xref-find-definitions regexp t)
(etags--xref-apropos-additional regexp))))
(defun etags--xref-find-definitions (pattern &optional regexp?)
;; This emulates the behavior of `find-tag-in-order' but instead of
@ -2131,6 +2134,32 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
(puthash mark-key t marks))))))))))
(nreverse xrefs)))
(defun etags--xref-apropos-additional (regexp)
(cl-mapcan
(lambda (oba)
(pcase-let* ((`(,group ,goto-fun ,symbs) oba)
(res nil)
(add-xref (lambda (sym)
(let ((sn (symbol-name sym)))
(when (string-match-p regexp sn)
(push
(xref-make
sn
(xref-make-etags-apropos-location
sym goto-fun group))
res))))))
(when (symbolp symbs)
(if (boundp symbs)
(setq symbs (symbol-value symbs))
(warn "symbol `%s' has no value" symbs)
(setq symbs nil))
(if (vectorp symbs)
(mapatoms add-xref symbs)
(dolist (sy symbs)
(funcall add-xref (car sy))))
(nreverse res))))
tags-apropos-additional-actions))
(defclass xref-etags-location (xref-location)
((tag-info :type list :initarg :tag-info)
(file :type string :initarg :file
@ -2155,6 +2184,25 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
(with-slots (tag-info) l
(nth 1 tag-info)))
(defclass xref-etags-apropos-location (xref-location)
((symbol :type symbol :initarg :symbol)
(goto-fun :type function :initarg :goto-fun)
(group :type string :initarg :group
:reader xref-location-group))
:documentation "Location of an additional apropos etags symbol.")
(defun xref-make-etags-apropos-location (symbol goto-fun group)
(make-instance 'xref-etags-apropos-location
:symbol symbol
:goto-fun goto-fun
:group group))
(cl-defmethod xref-location-marker ((l xref-etags-apropos-location))
(save-window-excursion
(with-slots (goto-fun symbol) l
(funcall goto-fun symbol)
(point-marker))))
(provide 'etags)