Add state structure

As we expand with new features and get tree-sitter working, we're
going to have more to keep track of than can reasonably be done with
individual arguments. Guile's modified srfi-9 lets us do this in a
nice functional style.

This also subtly tweaks the behavior of character insertion so it's
actually correct.

scripts/sloth.in

@@ -45,7 +45,7 @@
   "(Listof String) -> Int
 program entrypoint; handle commandline args and call appropriate procedures"
   (define options (getopt-config-auto args %configuration))
-  (start-loop #:file (option-ref options '(file) #f)))
+  (start-loop (option-ref options '(file) #f)))
 
 ;;; Local Variables:
 ;;; mode: scheme

sloth/editor.scm

@@ -3,66 +3,99 @@
   #:use-module (ncurses curses)
   #:use-module (ts)
   #:use-module (ice-9 textual-ports)
+  #:use-module (srfi srfi-9 gnu)
   #:export (start-loop))
 
-(define modes '(normal-mode insert-mode))
+(define-immutable-record-type <sloth-state>
+  (make-sloth-state win mode)
+  sloth-state?
+  (win  sloth-state-win)
+  (mode sloth-state-mode set-sloth-state-mode))
 
-(define* (start-loop #:key (win (init-win))
+(define* (start-loop #:optional (file #f))
-                           (file #f))
+  (define state (make-sloth-state (init-win) 'normal-mode))
-  (if file (find-file win file))
+  (if file
-  (core-loop win))
+      (core-loop (find-file state file))
+      (core-loop state)))
 
-(define* (core-loop win #:optional (mode 'normal-mode))
+(define (core-loop state)
-  (define process-result
+  (define win (sloth-state-win state))
+  (define mode (sloth-state-mode state))
+  (define new-state
     (case mode
-      ((normal-mode) (normal-mode-process-input win (getch win)))
+      ((normal-mode) (normal-mode-process-input state (getch win)))
-      ((insert-mode) (insert-mode-process-input win (getch win)))))
+      ((insert-mode) (insert-mode-process-input state (getch win)))))
-  (if (memq process-result modes)
+  (core-loop new-state))
-      (core-loop win process-result)
-      (core-loop win mode)))
 
-(define (insert-mode-process-input win key)
+(define (insert-mode-process-input state key)
-  (define y (getcury win))
+  (define y (getcury (sloth-state-win state)))
-  (define x (getcurx win))
+  (define x (getcurx (sloth-state-win state)))
   (cond
    ((eqv? key KEY_BACKSPACE)
-    (delch win #:y y #:x (- x 1)))
+    (backward-delete-char state))
    ((eqv? key KEY_DC)
-    (delch win))
+    (delete-char state))
    ((eqv? key KEY_LEFT)
-    (move win y (- x 1)))
+    (move-cursor state y (- x 1)))
    ((eqv? key KEY_RIGHT)
-    (move win y (+ x 1)))
+    (move-cursor state y (+ x 1)))
    ((eqv? key KEY_UP)
-    (move win (- y 1) x))
+    (move-cursor state (- y 1) x))
    ((eqv? key KEY_DOWN)
-    (move win (+ y 1) x))
+    (move-cursor state (+ y 1) x))
-   ((eqv? key #\esc) 'normal-mode)
+   ((eqv? key #\esc)
-   (else (insch win (normal key) #:y y #:x (+ x 1)))))
+    (set-sloth-state-mode state 'normal-mode))
+   (else (insert-char state key))))
 
-(define (normal-mode-process-input win key)
+(define (normal-mode-process-input state key)
+  (define win (sloth-state-win state))
   (define y (getcury win))
   (define x (getcurx win))
   (cond
    ((or (eqv? key KEY_LEFT)
 		(eqv? key #\h))
-    (move win y (- x 1)))
+    (move-cursor state y (- x 1)))
    ((or (eqv? key KEY_RIGHT)
 		(eqv? key #\l))
-    (move win y (+ x 1)))
+    (move-cursor state y (+ x 1)))
    ((or (eqv? key KEY_UP)
 		(eqv? key #\k))
-    (move win (- y 1) x))
+    (move-cursor state (- y 1) x))
    ((or (eqv? key KEY_DOWN)
 		(eqv? key #\j))
-    (move win (+ y 1) x))
+    (move-cursor state (+ y 1) x))
-   ((eqv? key #\i) 'insert-mode)
+   ((eqv? key #\i) (set-sloth-state-mode state 'insert-mode))
    ((eqv? key #\q)
     (endwin)
-    (quit))))
+    (quit))
+   (else state)))
 
-(define (find-file win file)
+(define (find-file state file)
+  (define win (sloth-state-win state))
   (when (file-exists? file)
-    (addstr win (call-with-input-file file get-string-all))
+    (addstr win (call-with-inputn-file file get-string-all))
     (refresh win)
-    (move win 0 0)))
+    (move win 0 0))
+  state)
+
+;; 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)
+  (delch (sloth-state-win state) #:y y #:x (- x 1))
+  state)
+
+(define (delete-char state)
+  (delch (sloth-state-win state))
+  state)
+
+(define (move-cursor state y x)
+  (move (sloth-state-win state) y x)
+  state)
+
+(define (insert-char state char)
+  (define x (getcurx (sloth-state-win state)))
+  (define y (getcury (sloth-state-win state)))
+  (insch (sloth-state-win state) (normal char))
+  (move (sloth-state-win state) y (+ x 1))
+  state)