Commit daaffe94 authored by Fangrui Song's avatar Fangrui Song

$cquery/callHierarchy*

parent 1efd9a33
......@@ -29,17 +29,17 @@
;; Customization
;; ---------------------------------------------------------------------
(defface cquery-call-tree-node-normal-face
(defface cquery-call-hierarchy-node-normal-face
nil
"."
:group 'cquery)
(defface cquery-call-tree-node-base-face
(defface cquery-call-hierarchy-node-base-face
'((t (:foreground "orange red")))
"."
:group 'cquery)
(defface cquery-call-tree-node-derived-face
(defface cquery-call-hierarchy-node-derived-face
'((t (:foreground "orange")))
"."
:group 'cquery)
......@@ -49,76 +49,84 @@
;; Tree node
;; ---------------------------------------------------------------------
(cl-defstruct cquery-call-tree-node
(cl-defstruct cquery-call-hierarchy-node
id
name
usr
call-type)
(defun cquery-call-tree--read-node (data &optional parent)
(defun cquery-call-hierarchy--read-node (data &optional parent)
"Construct a call tree node from hashmap DATA and give it the parent PARENT"
(let* ((location (gethash "location" data))
(filename (string-remove-prefix lsp--uri-file-prefix (gethash "uri" location))))
(-let* ((location (gethash "location" data))
(filename (string-remove-prefix lsp--uri-file-prefix (gethash "uri" location)))
((&hash "id" id "name" name "callType" call-type) data))
(make-cquery-tree-node
:location (cons filename (gethash "start" (gethash "range" location)))
:has-children (gethash "hasCallers" data)
:has-children (< 0 (gethash "numChildren" data))
:parent parent
:expanded nil
:children nil
:data (make-cquery-call-tree-node
:name (gethash "name" data)
:usr (gethash "usr" data)
:call-type (gethash "callType" data)))))
:data (make-cquery-call-hierarchy-node
:id id
:name name
:call-type call-type))))
(defun cquery-call-tree--request-children (node)
(defun cquery-call-hierarchy--request-children (callee node)
"."
(let ((usr (cquery-call-tree-node-usr (cquery-tree-node-data node))))
(when (string-match-p "^[0-9]+$" usr) ;; usr is no-usr for constructors
(--map (cquery-call-tree--read-node it node)
(lsp--send-request
(lsp--make-request "$cquery/callTreeExpand"
`(:usr ,usr))))
)))
(defun cquery-call-tree--request-init ()
(let ((id (cquery-call-hierarchy-node-id (cquery-tree-node-data node))))
(--map (cquery-call-hierarchy--read-node it node)
(gethash "children"
(lsp--send-request
(lsp--make-request "$cquery/callHierarchyExpand"
`(:id ,id
:callee ,callee
:callType 3
:detailedName t)))))))
(defun cquery-call-hierarchy--request-init (callee)
"."
(cquery--cquery-buffer-check)
(lsp--send-request
(lsp--make-request "$cquery/callTreeInitial"
`(:textDocument (:uri ,(concat lsp--uri-file-prefix buffer-file-name))
:position ,(lsp--cur-position)))))
(defun cquery-call-tree--make-string (node depth)
(list
(lsp--send-request
(lsp--make-request "$cquery/callHierarchyInitial"
`(:textDocument (:uri ,(concat lsp--uri-file-prefix buffer-file-name))
:position ,(lsp--cur-position)
:callee ,callee
:callType 3
:detailedName t)))))
(defun cquery-call-hierarchy--make-string (node depth)
"Propertize the name of NODE with the correct properties"
(let ((data (cquery-tree-node-data node)))
(if (= depth 0)
(cquery-call-tree-node-name data)
(cquery-call-hierarchy-node-name data)
(concat
(propertize (cquery-call-tree-node-name data)
'face (pcase (cquery-call-tree-node-call-type data)
('0 'cquery-call-tree-node-normal-face)
('1 'cquery-call-tree-node-base-face)
('2 'cquery-call-tree-node-derived-face)))
(propertize (cquery-call-hierarchy-node-name data)
'face (pcase (cquery-call-hierarchy-node-call-type data)
('0 'cquery-call-hierarchy-node-normal-face)
('1 'cquery-call-hierarchy-node-base-face)
('2 'cquery-call-hierarchy-node-derived-face)))
(propertize (format " (%s:%s)"
(file-name-nondirectory (car (cquery-tree-node-location node)))
(gethash "line" (cdr (cquery-tree-node-location node))))
'face 'cquery-call-tree-mode-line-face)))))
'face 'cquery-call-hierarchy-mode-line-face)))))
(defun cquery-call-tree ()
(interactive)
(defun cquery-call-hierarchy (callee)
(interactive "P")
(cquery--cquery-buffer-check)
(setq callee (if callee t :json-false))
(cquery-tree--open
(make-cquery-tree-client
:name "call hierarchy"
:mode-line-format (format " %s %s %s %s"
(propertize "Caller types:" 'face 'cquery-tree-mode-line-face)
(propertize "Normal" 'face 'cquery-call-tree-node-normal-face)
(propertize "Base" 'face 'cquery-call-tree-node-base-face)
(propertize "Derived" 'face 'cquery-call-tree-node-derived-face))
(propertize "Normal" 'face 'cquery-call-hierarchy-node-normal-face)
(propertize "Base" 'face 'cquery-call-hierarchy-node-base-face)
(propertize "Derived" 'face 'cquery-call-hierarchy-node-derived-face))
:top-line-f (lambda () (propertize "Callers of" 'face '(:height 1.0 :inherit cquery-tree-mode-line-face)))
:make-string-f 'cquery-call-tree--make-string
:read-node-f 'cquery-call-tree--read-node
:request-children-f 'cquery-call-tree--request-children
:request-init-f 'cquery-call-tree--request-init)))
:make-string-f 'cquery-call-hierarchy--make-string
:read-node-f 'cquery-call-hierarchy--read-node
:request-children-f (apply-partially #'cquery-call-hierarchy--request-children callee)
:request-init-f (lambda () (cquery-call-hierarchy--request-init callee)))))
(provide 'cquery-call-tree)
;;; cquery-call-tree.el ends here
(provide 'cquery-call-hierarchy)
;;; cquery-call-hierarchy.el ends here
......@@ -33,7 +33,6 @@
(cl-defstruct cquery-inheritance-hierarchy-node
id
kind
name)
(defun cquery-inheritance-hierarchy--read-node (data &optional parent)
......@@ -92,11 +91,10 @@
(propertize "Bases" 'face 'cquery-inheritance-hierarchy-base-face)
(cquery--render-string name))))
(defun cquery-inheritance-hierarchy (&optional derived)
(interactive)
(defun cquery-inheritance-hierarchy (derived)
(interactive "P")
(cquery--cquery-buffer-check)
(when (null derived)
(setq derived :json-false))
(setq callee (if callee t :json-false))
(cquery-tree--open
(make-cquery-tree-client
:name "inheritance hierarchy"
......
......@@ -39,9 +39,9 @@
(require 'cquery-semantic-highlighting)
(require 'cquery-codelens)
(require 'cquery-tree)
(require 'cquery-call-tree)
(require 'cquery-member-hierarchy)
(require 'cquery-call-hierarchy)
(require 'cquery-inheritance-hierarchy)
(require 'cquery-member-hierarchy)
;; ---------------------------------------------------------------------
;; Customization
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment