From 00f4935d3bf9bf9ccbd628f98f7210bae9656e9d Mon Sep 17 00:00:00 2001
From: Skylar Hill <stellarskylark@posteo.net>
Date: Sat, 4 Nov 2023 19:11:48 -0500
Subject: [PATCH] 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.
---
 sloth/editor.scm | 62 +++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 56 insertions(+), 6 deletions(-)

diff --git a/sloth/editor.scm b/sloth/editor.scm
index 49e0c50..c36835a 100644
--- a/sloth/editor.scm
+++ b/sloth/editor.scm
@@ -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))