Type hierarchy

Author: yyoncho

lsp-java.el

@@ -1566,6 +1566,68 @@ current symbol."
 
 
 
+(defconst lsp-java--hierarchy-sub 0)
+(defconst lsp-java--hierarchy-super 1)
+(defconst lsp-java--hierarchy-both 2)
+
+(defun lsp-java--type-hierarchy-render-nodes (nodes direction load-direction)
+  (-map (-lambda ((it &as &TypeHierarchyItem :name :kind :uri :selection-range (&Range :start)))
+          (list :label (concat name
+                               (cond
+                                ((eq lsp-java--hierarchy-sub direction) (propertize " ↓" 'face 'shadow))
+                                ((eq lsp-java--hierarchy-super direction) (propertize " ↑" 'face 'shadow))))
+                :key name
+                :icon (lsp-treemacs-symbol-kind->icon kind)
+                :children-async (-partial #'lsp-java--type-hierarchy-render it load-direction)
+                :ret-action #'lsp-treemacs-go-to
+                :position start
+                :uri uri
+                :actions `(["Go to" lsp-treemacs-go-to])))
+        nodes))
+
+(lsp-defun lsp-java--type-hierarchy-render ((item &as &TypeHierarchyItem :uri :range (&Range :start)) direction _ callback)
+  (lsp-request-async
+   "workspace/executeCommand"
+   (list :command "java.navigate.resolveTypeHierarchy"
+         :arguments (vector (lsp--json-serialize item)
+                            (number-to-string direction)
+                            "1"))
+   (-lambda ((&TypeHierarchyItem :children? :parents?))
+     (funcall callback (nconc (lsp-java--type-hierarchy-render-nodes
+                               children? lsp-java--hierarchy-sub direction)
+                              (lsp-java--type-hierarchy-render-nodes
+                               parents? lsp-java--hierarchy-super direction))))))
+
+(defun lsp-java-type-hierarchy (direction)
+  "Show the type hierarchy for the symbol at point.
+With prefix 0 show sub-types.
+With prefix 1 show super-types.
+With prefix 2 show both."
+  (interactive "P")
+  (setq direction (or direction lsp-java--hierarchy-both))
+  (let ((workspaces (lsp-workspaces))
+        (result
+         (lsp-workspace-command-execute
+          "java.navigate.openTypeHierarchy"
+          (vector (lsp--json-serialize (lsp--text-document-position-params))
+                  (number-to-string direction)
+                  "0"))))
+    (if result
+        (pop-to-buffer
+         (lsp-treemacs-render
+          (lsp-java--type-hierarchy-render-nodes (vector result) nil direction)
+          (concat (cond
+                   ((eq lsp-java--hierarchy-sub direction) "Sub")
+                   ((eq lsp-java--hierarchy-super direction) "Super")
+                   ((eq lsp-java--hierarchy-both direction) "Sub/Super"))
+                  " Type Hierarchy")
+          nil
+          "*lsp-java-type-hierarchy*"
+          nil
+          t))
+      (user-error "No class under point."))
+    (setq lsp--buffer-workspaces workspaces)))
+
 (provide 'lsp-java)
 ;;; lsp-java.el ends here