From 1ef9de69b3c3d8254ab58bf455137a4439dce516 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 7 Feb 2025 11:08:29 +0000 Subject: [PATCH] Eglot: add support for call and type hierarchies * lisp/progmodes/eglot.el (eglot--lsp-interface-alist): Add new interfaces. (eglot-client-capabilities): Advertise support for callHierarchy and typeHierarchy. (eglot-ignored-server-capabilities): Add new providers. (eglot--goto): New helper. (eglot-menu): Add new menu items. (eglot-handle-request window/showDocument): Use eglot--goto. (button, tree-widget): Require them. (eglot--hierarchy-item): New button type. (eglot--hierarchy-interactive, eglot--hierarchy-children) (eglot--hierarchy-label, eglot--hierarchy-1, eglot--hierarchy-2): New internal functions. (eglot--define-hierarchy-command): New macro. (eglot-show-type-hierarchy, eglot-show-call-hierarchy) (eglot-hierarchy-center-on-node): New commands. (eglot--hierarchy-roots, eglot--hierarchy-specs): New local variables. (eglot-hierarchy-label-map): New keymap. (eglot-hierarchy-mode): New major mode. * doc/misc/eglot.texi (Eglot Commands, Eglot Features): Describe new feature. * etc/EGLOT-NEWS (Changes in upcoming Eglot): Mention new feature. --- doc/misc/eglot.texi | 15 +++ etc/EGLOT-NEWS | 7 ++ lisp/progmodes/eglot.el | 221 ++++++++++++++++++++++++++++++++++++++-- 3 files changed, 235 insertions(+), 8 deletions(-) diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 722766843ec..333e369e440 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -452,6 +452,11 @@ be it the type of a variable, or the name of a formal parameter in a function call. @xref{Eglot Commands} and the @code{eglot-inlay-hints-mode} minor mode. +@item +Display of function call and type hierarchies via the +@code{eglot-show-call-hierarchy} and @code{eglot-show-type-hierarchy} +commands (@pxref{Eglot Commands}). + @item Code reformatting via the @code{eglot-format} and related commands (@pxref{Eglot Commands}). Automatic reformatting of source code is also @@ -738,6 +743,16 @@ instead of indicating problems. For example, a C++ language server can serve hints about positional parameter names in function calls and a variable's automatically deduced type. Inlay hints help the user not have to remember these things by heart. + +@cindex type hierarchy +@item M-x eglot-show-type-hierarchy +Pop up a special buffer showing a interactive tree which represents a +hierarchy of subtypes and supertypes for the symbol at point. + +@cindex call hierarchy +@item M-x eglot-call-type-hierarchy +Pop up a special buffer showing a interactive tree which represents a +hierarchy of callers and callee for the symbol at point. @end ftable The following Eglot commands are used less commonly, mostly for diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 02355e25f93..20a2e694426 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,13 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes in upcoming Eglot +** Support for call and type hierarchies + +The new commands 'eglot-show-type-hierarchy' and +'eglot-show-call-hierarchy', when invoked on a symbol, pop up a special +buffer showing an interactive tree which represents a hierarchy of sub- +and super-types or callers and callees for that symbol. + ** New 'eglot-advertise-cancellation' variable Tweaking this variable may help some LSP servers avoid doing costly but diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 7b1c174c4d7..502effd098d 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -566,7 +566,9 @@ under cursor." (const :tag "Decorate color references" :colorProvider) (const :tag "Fold regions of buffer" :foldingRangeProvider) (const :tag "Execute custom commands" :executeCommandProvider) - (const :tag "Inlay hints" :inlayHintProvider))) + (const :tag "Inlay hints" :inlayHintProvider) + (const :tag "Type hierarchies" :typeHierarchyProvider) + (const :tag "Call hierarchies" :callHierarchyProvider))) (defcustom eglot-advertise-cancellation nil "If non-nil, Eglot attemps to inform server of cancelled requests. @@ -717,7 +719,13 @@ This can be useful when using docker to run a language server.") (WorkspaceSymbol (:name :kind) (:containerName :location :data)) (InlayHint (:position :label) (:kind :textEdits :tooltip :paddingLeft :paddingRight :data)) - (InlayHintLabelPart (:value) (:tooltip :location :command))) + (InlayHintLabelPart (:value) (:tooltip :location :command)) + ;; HACK! 'HierarchyItem' doesn't exist, only `CallHierarchyItem' + ;; and `TypeHierarchyItem'. But they're the same, so no bother. + (HierarchyItem (:name :kind) + (:tags :detail :uri :range :selectionRange :data)) + (CallHierarchyIncomingCall (:from :fromRanges) ()) + (CallHierarchyOutgoingCall (:to :fromRanges) ())) "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces. INTERFACE-NAME is a symbol designated by the spec as @@ -1066,6 +1074,8 @@ object." :rangeFormatting `(:dynamicRegistration :json-false) :rename `(:dynamicRegistration :json-false) :inlayHint `(:dynamicRegistration :json-false) + :callHierarchy `(:dynamicRegistration :json-false) + :typeHierarchy `(:dynamicRegistration :json-false) :publishDiagnostics (list :relatedInformation :json-false ;; TODO: We can support :codeDescription after ;; adding an appropriate UI to @@ -1782,6 +1792,15 @@ in project `%s'." (let ((warning-minimum-level :error)) (display-warning 'eglot (apply #'eglot--format format args) :warning))) +(defun eglot--goto (range) + "Goto and momentarily highlight RANGE in current buffer." + (pcase-let ((`(,beg . ,end) (eglot-range-region range))) + ;; FIXME: it is very naughty to use someone else's `--' + ;; function, but `xref--goto-char' happens to have + ;; exactly the semantics we want vis-a-vis widening. + (xref--goto-char beg) + (pulse-momentary-highlight-region beg end 'highlight))) + (defalias 'eglot--bol (if (fboundp 'pos-bol) #'pos-bol (lambda (&optional n) (let ((inhibit-field-text-motion t)) @@ -2285,6 +2304,9 @@ If it is activated, also signal textDocument/didOpen." :visible (eglot-server-capable :codeActionProvider)] ["Quickfix" eglot-code-action-quickfix :visible (eglot-server-capable :codeActionProvider)] + "--" + ["Show type hierarchy" eglot-show-type-hierarchy] + ["Show call hierarchy" eglot-show-call-hierarchy] "--")) (easy-menu-define eglot-server-menu nil "Manage server communication" @@ -2699,12 +2721,7 @@ THINGS are either registrations or unregisterations (sic)." (select-frame-set-input-focus (selected-frame))) ((display-buffer (current-buffer)))) (when selection - (pcase-let ((`(,beg . ,end) (eglot-range-region selection))) - ;; FIXME: it is very naughty to use someone else's `--' - ;; function, but `xref--goto-char' happens to have - ;; exactly the semantics we want vis-a-vis widening. - (xref--goto-char beg) - (pulse-momentary-highlight-region beg end 'highlight))))))) + (eglot--goto selection)))))) (t (setq success :json-false))) `(:success ,success))) @@ -4369,6 +4386,194 @@ If NOERROR, return predicate, else erroring function." (jit-lock-unregister #'eglot--update-hints) (remove-overlays nil nil 'eglot--inlay-hint t)))) + +;;; Call and type hierarchies +(require 'button) +(require 'tree-widget) + +(define-button-type 'eglot--hierarchy-item + 'follow-link t + 'face 'font-lock-function-name-face) + +(defun eglot--hierarchy-interactive (specs) + (let ((ans + (completing-read "[eglot] Direction (default both)?" + (cons "both" (mapcar #'cl-fourth specs)) + nil t nil nil "both"))) + (list + (cond ((equal ans "both") t) + (t (cl-third (cl-find ans specs :key #'cl-fourth :test #'equal))))))) + +(defmacro eglot--define-hierarchy-command + (name kind feature preparer specs) + `(defun ,name (direction) + ,(concat + "Show " kind " hierarchy for symbol at point.\n" + "DIRECTION can be:\n" + (cl-loop for (_ _ d e) in specs + concat (format " - `%s' for %s;\n" d e)) + "or t, the default, to consider both.\n" + "Interactively with a prefix argument, prompt for DIRECTION.") + (interactive (if current-prefix-arg + (eglot--hierarchy-interactive ',specs) + (list t))) + (let* ((specs ',specs) + (specs (if (eq t direction) specs + (list + (cl-find direction specs :key #'cl-third))))) + (eglot--hierarchy-1 + (format "*EGLOT %s hierarchy for %s*" + ,kind + (eglot-project-nickname (eglot--current-server-or-lose))) + ,feature ,preparer specs)))) + +(eglot--define-hierarchy-command + eglot-show-type-hierarchy + "type" + :typeHierarchyProvider + :textDocument/prepareTypeHierarchy + ((:typeHierarchy/supertypes " ↑ " derived "supertypes" "derives from") + (:typeHierarchy/subtypes " ↓ " base "subtypes" "base of"))) + +(eglot--define-hierarchy-command + eglot-show-call-hierarchy + "call" + :callHierarchyProvider + :textDocument/prepareCallHierarchy + ((:callHierarchy/incomingCalls " ← " incoming "incoming calls" "called by" + :from :fromRanges) + (:callHierarchy/outgoingCalls " → " base "outgoing calls" "calls" + :to :fromRanges))) + +(defvar-local eglot--hierarchy-roots nil) +(defvar-local eglot--hierarchy-specs nil) + +(defun eglot--hierarchy-children (node) + (cl-flet ((get-them (method node) + (eglot--dbind ((HierarchyItem) name) node + (let* ((sym (intern (format "eglot--%s" method))) + (plist (text-properties-at 0 name)) + (probe (cl-getf plist sym :none))) + (cond ((eq probe :none) + (let ((v (ignore-errors (jsonrpc-request + (eglot--current-server-or-lose) method + `(:item ,node))))) + (put-text-property 0 1 sym v name) + v)) + (t probe)))))) + (cl-loop + with specs = eglot--hierarchy-specs + for (method bullet _ _ hint key ranges) in specs + for resp = (get-them method node) + for items = + (cl-loop for r across resp + for item = (if key (plist-get r key) r) + collect item + do (eglot--dbind ((HierarchyItem) name) item + (put-text-property 0 1 'eglot--hierarchy-method + method name) + (put-text-property 0 1 'eglot--hierarchy-bullet + (propertize bullet + 'help-echo hint) + name) + (when ranges + (put-text-property 0 1 'eglot--hierarchy-call-sites + (plist-get r ranges) + name)))) + append items))) + +(defvar eglot-hierarchy-label-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map button-map) + (define-key map [mouse-3] (eglot--mouse-call + #'eglot-hierarchy-center-on-node)) + map) + "Keymap active in labels Eglot hierarchy buffers.") + +(defun eglot--hierarchy-label (node) + (eglot--dbind ((HierarchyItem) name uri _detail ((:range item-range))) node + (with-temp-buffer + (insert (propertize + (or (get-text-property + 0 'eglot--hierarchy-bullet name) + " ∘ ") + 'face 'shadow)) + (insert-text-button + name + :type 'eglot--hierarchy-item + 'eglot--hierarchy-node node + 'help-echo "mouse-1, RET: goto definition, mouse-3: center on node" + 'keymap eglot-hierarchy-label-map + 'action + (lambda (_btn) + (pop-to-buffer (find-file-noselect (eglot-uri-to-path uri))) + (eglot--goto + (or + (elt + (get-text-property 0 'eglot--hierarchy-call-sites name) + 0) + item-range)))) + (buffer-string)))) + +(defun eglot--hierarchy-1 (name provider preparer specs) + (eglot-server-capable-or-lose provider) + (let* ((server (eglot-current-server)) + (roots (jsonrpc-request + server + preparer + (eglot--TextDocumentPositionParams)))) + (with-current-buffer (get-buffer-create name) + (eglot-hierarchy-mode) + (setq-local + eglot--hierarchy-roots roots + eglot--hierarchy-specs specs + eglot--cached-server server + buffer-read-only t + revert-buffer-function + (lambda (&rest _ignore) + ;; flush cache, would defeat purpose of a revert + (mapc (lambda (r) + (eglot--dbind ((HierarchyItem) name) r + (set-text-properties 0 1 nil name))) + eglot--hierarchy-roots) + (eglot--hierarchy-2))) + (eglot--hierarchy-2)))) + +(defun eglot--hierarchy-2 () + (cl-labels ((expander-for (node) + (lambda (_widget) + (mapcar + #'convert + (eglot--hierarchy-children node)))) + (convert (node) + (let ((w (widget-convert + 'tree-widget + :tag (eglot--hierarchy-label node) + :expander (expander-for node)))) + (widget-put w :empty-icon + (widget-get w :leaf-icon)) + w))) + (let ((inhibit-read-only t)) + (erase-buffer) + (mapc (lambda (r) + (widget-create (convert r))) + eglot--hierarchy-roots) + (goto-char (point-min)))) + (pop-to-buffer (current-buffer))) + +(define-derived-mode eglot-hierarchy-mode special-mode + "Eglot special" "Eglot mode for viewing hierarchies. +\\{eglot-hierarchy-mode-map}" + :interactive nil) + +(defun eglot-hierarchy-center-on-node () + "Refresh hierarchy, centering on node at point." + (interactive) + (setq-local eglot--hierarchy-roots + (list (get-text-property (point) + 'eglot--hierarchy-node))) + (eglot--hierarchy-2)) + ;;; Hacks ;;;