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.
This commit is contained in:
João Távora
parent
f806b9cba6
commit
1ef9de69b3
3 changed files with 235 additions and 8 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
;;;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue