[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/xref-find-extra dcac0669873: Xref: add xref-find-extra command
From: |
João Távora |
Subject: |
feature/xref-find-extra dcac0669873: Xref: add xref-find-extra command |
Date: |
Sat, 4 Nov 2023 20:00:17 -0400 (EDT) |
branch: feature/xref-find-extra
commit dcac06698734d5d4380c572cb50012a7b628adc2
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: João Távora <joaotavora@gmail.com>
Xref: add xref-find-extra command
* lisp/progmodes/elisp-mode.el (xref-backend-extra-kinds):
Implement for elisp backend.
* lisp/progmodes/xref.el (xref-backend-extra-kinds)
(xref-backend-extra-defs): New generic functions.
(xref-prompt-for-identifier): Tweak.
(xref--create-fetcher): Rework.
(xref-find-extra): New command.
---
lisp/progmodes/elisp-mode.el | 60 ++++++++++++++++++++++++++++++++++++++++++++
lisp/progmodes/xref.el | 50 +++++++++++++++++++++++++++++++++---
2 files changed, 106 insertions(+), 4 deletions(-)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ff90a744ea3..9beb26c128b 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1212,6 +1212,66 @@ namespace but with lower confidence."
xrefs))
+(cl-defmethod xref-backend-extra-kinds ((_backend (eql 'elisp)) identifier)
+ ;; The file name is not known when `symbol' is defined via interactive eval.
+ (let ((symbol (intern-soft identifier))
+ kinds)
+ ;; alphabetical by result type symbol
+
+ ;; FIXME: advised function; list of advice functions
+ ;; FIXME: aliased variable
+
+ ;; Coding system symbols do not appear in ‘load-history’,
+ ;; so we can’t get a location for them.
+ (when (and (symbolp symbol)
+ (symbol-function symbol)
+ (symbolp (symbol-function symbol)))
+ (push "defalias" kinds))
+
+ (when (facep symbol)
+ (push "face" kinds))
+
+ (when (fboundp symbol)
+ (let ((file (find-lisp-object-file-name symbol (symbol-function symbol)))
+ doc)
+ (when file
+ (cond
+ ((eq file 'C-source)
+ (push "function" kinds))
+ ((and (setq doc (documentation symbol t))
+ ;; This doc string is defined in cl-macs.el cl-defstruct
+ (string-match "Constructor for objects of type `\\(.*\\)'"
doc))
+ (push "constructor" kinds))
+ ((cl--generic symbol)
+ (push "generic" kinds))
+ (t
+ (push "function" kinds))))))
+ (when (boundp symbol)
+ (push "variable" kinds))
+ (when (featurep symbol)
+ (push "feature" kinds))
+ (nreverse kinds)))
+
+(cl-defmethod xref-backend-extra-defs ((_backend (eql 'elisp)) identifier kind)
+ (require 'find-func)
+ (let ((sym (intern-soft identifier)))
+ (when sym
+ (let* ((defs (elisp--xref-find-definitions sym))
+ (expected-kind
+ (assoc-default kind
+ '(("defalias" . defalias)
+ ("face" . defface)
+ ("function" . nil)
+ ("variable" . defvar)
+ ("constructor" . define-type)
+ ("generic" . generic)))))
+ (cl-loop for d in defs
+ for def-kind = (xref-elisp-location-type (xref-item-location
d))
+ when (if (eq expected-kind 'generic)
+ (memq def-kind '(cl-defgeneric cl-defmethod))
+ (eq def-kind expected-kind))
+ collect d)))))
+
(declare-function xref-apropos-regexp "xref" (pattern))
(cl-defmethod xref-backend-apropos ((_backend (eql 'elisp)) pattern)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 81618428bf3..e1e3862256c 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -314,6 +314,17 @@ recognize and then delegate the work to an external
process."
"Return t if case is not significant in identifier completion."
completion-ignore-case)
+(cl-defgeneric xref-backend-extra-kinds (_backend _identifier)
+ "Return the other definition types BACKEND could show for IDENTIFIER."
+ (user-error "Extra definitions not supported by the backend"))
+
+(cl-defgeneric xref-backend-extra-defs (_backend _identifier _kind)
+ "Find definitions of extra KIND for IDENTIFIER.
+
+The result must be a list of xref objects. Refer to
+`xref-backend-definitions' for other details."
+ nil)
+
;;; misc utilities
(defun xref--alistify (list key)
@@ -364,7 +375,8 @@ otherwise unused.")
(defcustom xref-prompt-for-identifier '(not xref-find-definitions
xref-find-definitions-other-window
- xref-find-definitions-other-frame)
+ xref-find-definitions-other-frame
+ xref-find-extra)
"If non-nil, prompt for the identifier to find.
When t, always prompt for the identifier name.
@@ -1569,11 +1581,11 @@ The meanings of both arguments are the same as
documented in
(xref--create-fetcher id 'definitions id)
display-action))
-(defun xref--create-fetcher (input kind arg)
+(defun xref--create-fetcher (input kind &rest args)
"Return an xref list fetcher function.
It revisits the saved position and delegates the finding logic to
-the xref backend method indicated by KIND and passes ARG to it."
+the xref backend method indicated by KIND and passes ARGS to it."
(let* ((orig-buffer (current-buffer))
(orig-position (point))
(backend (xref-find-backend))
@@ -1589,7 +1601,7 @@ the xref backend method indicated by KIND and passes ARG
to it."
(when (buffer-live-p orig-buffer)
(set-buffer orig-buffer)
(ignore-errors (goto-char orig-position)))
- (let ((xrefs (funcall method backend arg)))
+ (let ((xrefs (apply method backend args)))
(unless xrefs
(xref--not-found-error kind input))
xrefs)))))
@@ -1624,6 +1636,35 @@ Use \\[xref-go-back] to return back to where you invoked
this command."
(interactive (list (xref--read-identifier "Find definitions of: ")))
(xref--find-definitions identifier 'frame))
+;;;###autoload
+(defun xref-find-extra (identifier)
+ "Find some specific kind of definition of the identifier at point.
+With prefix argument or when there's no identifier at point,
+prompt for the identifier.
+
+If only one location is found, display it in the selected window.
+Otherwise, display the list of the possible definitions in a
+buffer where the user can select from the list.
+
+Use \\[xref-go-back] to return back to where you invoked this command."
+ (interactive (list
+ ;; XXX: Choose kind of "extra" first? That would fail
+ ;; to take advantage of the symbol-at-point, though.
+ (xref--read-identifier "Find definitions of: ")))
+ (let* ((kinds (xref-backend-extra-kinds (xref-find-backend) identifier))
+ ;; FIXME: We should probably skip asking when there's just
+ ;; one available kind, but let's keep completing-read while
+ ;; collecting the initial feedback about the interface.
+ (kind ;; (if (cdr kinds)
+ (completing-read "Definition kind: " kinds nil t nil nil (car kinds))
+ ;; (car kinds)
+ ;; )
+ ))
+ (unless kind (user-error "No supported kinds"))
+ (xref--show-defs
+ (xref--create-fetcher identifier 'extra-defs identifier kind)
+ nil)))
+
;;;###autoload
(defun xref-find-references (identifier)
"Find references to the identifier at point.
@@ -1724,6 +1765,7 @@ output of this command when the backend is etags."
;;;###autoload (define-key esc-map [?\C-,] #'xref-go-forward)
;;;###autoload (define-key esc-map "?" #'xref-find-references)
;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
+;;;###autoload (define-key esc-map "'" #'xref-find-extra)
;;;###autoload (define-key ctl-x-4-map "."
#'xref-find-definitions-other-window)
;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)