From: Dmitry Gutov Date: Sun, 5 Nov 2023 00:03:00 +0000 (+0000) Subject: Xref: add xref-find-extra command X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=dcac06698734d5d4380c572cb50012a7b628adc2;p=emacs.git 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. --- 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)