Extremely rudimentary tree navigation

Needs some error checking, and we want to only consider named nodes so
we're navigating the abstract tree rather than the tree of all tokens.
This commit is contained in:
Skylar Hill 2023-11-04 19:11:48 -05:00
parent eff0f10911
commit 00f4935d3b
1 changed files with 56 additions and 6 deletions

View File

@ -7,13 +7,15 @@
#:export (start-loop))
(define-immutable-record-type <sloth-state>
(make-sloth-state win mode)
(make-sloth-state win mode tree point-node)
sloth-state?
(win sloth-state-win)
(mode sloth-state-mode set-sloth-state-mode))
(mode sloth-state-mode set-sloth-state-mode)
(tree sloth-state-tree set-sloth-state-tree)
(point-node sloth-state-point-node set-sloth-state-point-node))
(define* (start-loop #:optional (file #f))
(define state (make-sloth-state (init-win) 'normal-mode))
(define state (make-sloth-state (init-win) 'normal-mode #f #f))
(if file
(core-loop (find-file state file))
(core-loop state)))
@ -64,7 +66,11 @@
((or (eqv? key KEY_DOWN)
(eqv? key #\j))
(move-cursor state (+ y 1) x))
((eqv? key #\i) (set-sloth-state-mode state 'insert-mode))
((eqv? key #\n) (next-node state))
((eqv? key #\d) (down-node state))
((eqv? key #\p) (prev-node state))
((eqv? key #\u) (up-node state))
((eqv? key #\i) (set-sloth-state-mode state 'insert-mode))
((eqv? key #\q)
(endwin)
(quit))
@ -72,16 +78,29 @@
(define (find-file state file)
(define win (sloth-state-win state))
(define contents "")
(when (file-exists? file)
(addstr win (call-with-inputn-file file get-string-all))
(set! contents
(call-with-input-file file get-string-all))
(addstr win contents)
(refresh win)
(move win 0 0))
state)
(define scheme-lang (get-ts-language-from-file "libtree-sitter-scheme"
"tree_sitter_scheme"))
(define scheme-parser (ts-parser-new #:language scheme-lang))
(define tree (ts-parser-parse-string scheme-parser
#f
contents))
(set-fields state
((sloth-state-tree) tree)
((sloth-state-point-node) (ts-tree-root-node tree))))
;; These are stubs for now, but they'll get more complex
;; as we add features and more processing is needed on updates
(define (backward-delete-char state)
(define x (getcurx (sloth-state-win state)))
(define y (getcury (sloth-state-win state)))
(delch (sloth-state-win state) #:y y #:x (- x 1))
state)
@ -99,3 +118,34 @@
(insch (sloth-state-win state) (normal char))
(move (sloth-state-win state) y (+ x 1))
state)
(define (next-node state)
(define target (ts-node-next-sibling
(sloth-state-point-node state)))
(define point (ts-node-start-point target))
(move (sloth-state-win state)
(car point) (cdr point))
(set-sloth-state-point-node state target))
(define (prev-node state)
(define target (ts-node-prev-sibling
(sloth-state-point-node state)
#f))
(define point (ts-node-start-point target))
(move (sloth-state-win state)
(car point) (cdr point))
(set-sloth-state-point-node state target))
(define (down-node state)
(define target (ts-node-child (sloth-state-point-node state) 0))
(define point (ts-node-start-point target))
(move (sloth-state-win state)
(car point) (cdr point))
(set-sloth-state-point-node state target))
(define (up-node state)
(define target (ts-node-parent (sloth-state-point-node state)))
(define point (ts-node-start-point target))
(move (sloth-state-win state)
(car point) (cdr point))
(set-sloth-state-point-node state target))