tvl-depot/users/Profpatsch/emacs-tree-sitter-move/tree-sitter-move.el
Profpatsch 9da760fba4 feat(emacs-tree-sitter-move): Add tree-sitter-move-reset
Resets the cursor to the named node under the cursor.
`-right` does not do it anymore, so it’s possible to navigate on
higher levels of the tree instead of always resetting to a leaf.

Change-Id: Id330854c72ea24da0cc8611f30f5617e0f127c1b
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2259
Reviewed-by: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
2021-01-01 22:39:28 +00:00

114 lines
4 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-get-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-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. Returns nil if there
is no such node until the root"
(when-let ((has-siblings-p
(lambda (parent-node)
(> (tsc-count-named-children parent-node)
1)))
(cur node)
(parent (tsc-get-parent node)))
(while (not (funcall has-siblings-p parent))
(setq cur parent)
(setq parent (tsc-get-parent cur)))
cur))
(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-named-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-reset ()
(interactive)
(tree-sitter-move--set-cursor-to-node-at-point))
(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--move-if-possible
(lambda (cur)
(when-let ((with-siblings
(tsc-get-first-named-node-with-siblings-up cur)))
(tsc-get-next-named-sibling with-siblings)))))
(defun tree-sitter-move--move-if-possible (dir-fn)
(let ((next (funcall dir-fn 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)))