blob: 37aafefb0e6efb28730c0b2eb034162a6366b4f4 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
;; this is not an actual cursor, just a node.
;; It’s not super efficient, but cursors can’t be *set* to an arbitrary
;; subnode, because they can’t access the parent otherwise.
;; We’d need a way to reset the cursor and walk down to the node?!
(defvar-local tree-sitter-move--cursor nil
"the buffer-local cursor used for movement")
(defvar-local tree-sitter-move--debug-overlay nil
"an overlay used to visually display the region currently marked by the cursor")
;;;;; TODO: should everything use named nodes? Only some things?
;;;;; maybe there should be a pair of functions for everything?
;;;;; For now restrict to named nodes.
(defun tree-sitter-move--setup ()
;; TODO
(progn
(tree-sitter-mode t)
(setq tree-sitter-move--cursor (tsc-root-node tree-sitter-tree))
(add-variable-watcher
'tree-sitter-move--cursor
#'tree-sitter-move--debug-overlay-update)))
(defun tree-sitter-move--debug-overlay-update (sym newval &rest _args)
"variable-watcher to update the debug overlay when the cursor changes"
(let ((start (tsc-node-start-position newval))
(end (tsc-node-end-position newval)))
(symbol-macrolet ((o tree-sitter-move--debug-overlay))
(if o
(move-overlay o start end)
(setq o (make-overlay start end))
(overlay-put o 'face 'highlight)
))))
(defun tree-sitter-move--debug-overlay-teardown ()
"Turn of the overlay visibility and delete the overlay object"
(when tree-sitter-move--debug-overlay
(delete-overlay tree-sitter-move--debug-overlay)
(setq tree-sitter-move--debug-overlay nil)))
(defun tree-sitter-move--teardown ()
(setq tree-sitter-move--cursor nil)
(tree-sitter-move--debug-overlay-teardown)
(tree-sitter-mode nil))
;; Get the syntax node the cursor is on.
(defun tsc-node-named-node-at-point ()
(let ((p (point)))
(tsc-get-named-descendant-for-position-range
(tsc-root-node tree-sitter-tree) p p)))
(defun tsc-get-node-at-point ()
(let ((p (point)))
(tsc-get-descendant-for-position-range
(tsc-root-node tree-sitter-tree) p p)))
(defun tsc-get-first-named-node-with-siblings-up (node)
"Returns the first 'upwards' node that has siblings. That includes the current
node, so if the given node has siblings, it is returned."
(let ((has-siblings-p
(lambda (n)
(> (tsc-count-named-children (tsc-get-parent n))
1)))
(res node))
(while (not (funcall has-siblings-p res))
;; TODO tsc-get-parent is called twice, nicer somehow?
(setq res (tsc-get-parent res)))
res))
(defun tree-sitter-move--set-cursor-to-node (node)
(setq tree-sitter-move--cursor node))
(defun tree-sitter-move--set-cursor-to-node-at-point ()
(tree-sitter-move--set-cursor-to-node (tsc-get-node-at-point)))
(defun tree-sitter-move--move-point-to-node (node)
(set-window-point
(selected-window)
(tsc-node-start-position node)))
;; interactive commands (“do what I expect” section)
(defun tree-sitter-move-right ()
"Moves to the next sibling. If the current node does not have siblings, go
upwards until something has siblings and then move right."
(interactive)
(tree-sitter-move--set-cursor-to-node-at-point)
(let ((next (tsc-get-next-named-sibling
(tsc-get-first-named-node-with-siblings-up tree-sitter-move--cursor))))
(when next
(tree-sitter-move--set-cursor-to-node next)
(tree-sitter-move--move-point-to-node next))))
; mostly stolen from tree-sitter-mode
;;;###autoload
(define-minor-mode tree-sitter-move-mode
"Minor mode to do cursor movements via tree-sitter"
:init-value nil
:lighter " tree-sitter-move"
(if tree-sitter-move-mode
(tree-sitter--error-protect
(progn
(tree-sitter-move--setup))
(setq tree-sitter-move-mode nil)
(tree-sitter-move--teardown))
(lambda ())
(tree-sitter-move--teardown)))
|