tvl-depot/users/Profpatsch/emacs-tree-sitter-move/tree-sitter-move.el
Profpatsch 806c281b34 feat(users/Profpatsch): moving around via the tree-sitter parse tree
Has a little setup to get the cursor position and map it onto a tree
sitter node. The current node is saved in a cursor variable, and a
highlight overlay marks the range of the current node in the buffer.

Change-Id: I0af56115f928732e993fbefe978a246ca7c757ee
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2258
Reviewed-by: lukegb <lukegb@tvl.fyi>
Reviewed-by: tazjin <mail@tazj.in>
Reviewed-by: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
2021-01-01 19:03:30 +00:00

108 lines
3.8 KiB
EmacsLisp
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;; this is not an actual cursor, just a node.
;; Its not super efficient, but cursors cant be *set* to an arbitrary
;; subnode, because they cant access the parent otherwise.
;; Wed 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)))