638 - quick spike: syntax highlighting in repl

Backspace kinda works. Parens are colored in three rotating colors which
helps with balancing. Comments and strings are colored.

But it's hard to handle backspace in all situations. Like if you
backspace over a quote you have to either quit the string-slurping
routine you're in, or return to string slurping mode. Similarly for
comments; *there* you don't even have a end delimiter to let you know
you're back in a comment. You have to keep track of what came before.

I experimented with a library but it interacts poorly with the charterm
library I'm already using. Ended up with a gross inefficient approach
instead.

3 files changed, 208 insertions, 4 deletions

diff --git a/color-repl.mu b/color-repl.mu
new file mode 100644
index 00000000..51ba263a
--- /dev/null
+++ b/color-repl.mu
@@ -0,0 +1,146 @@
+; a simple line editor for reading lisp s-expressions
+
+(function read-sexp [
+  (default-space:space-address <- new space:literal 30:literal)
+  (result:buffer-address <- init-buffer 30:literal)
+  (open-parens:integer <- copy 0:literal)
+  { begin
+    (c:character <- $wait-for-key-from-host)
+    ; handle backspace
+    ; todo: backspace into comment or string
+    { begin
+      (backspace?:boolean <- equal c:character ((#\backspace literal)))
+      (break-unless backspace?:boolean)
+      ($print-key-to-host c:character)
+      (len:integer-address <- get-address result:buffer-address/deref length:offset)
+      ; but only if we need to
+      { begin
+        (zero?:boolean <- lesser-or-equal len:integer-address/deref 0:literal)
+        (break-if zero?:boolean)
+        (len:integer-address/deref <- subtract len:integer-address/deref 1:literal)
+      }
+      (loop 2:blocks)
+    }
+    (result:buffer-address <- append result:buffer-address c:character)
+    ; parse comment
+    { begin
+      (comment?:boolean <- equal c:character ((#\; literal)))
+      (break-unless comment?:boolean)
+      ($print-key-to-host c:character 4:literal/fg/blue)
+      (skip-comment)
+      ; comment slurps newline, so check if we should return
+      (end-sexp?:boolean <- lesser-or-equal open-parens:integer 0:literal)
+      (break-if end-sexp?:boolean 2:blocks)
+      (loop 2:blocks)
+    }
+    ; parse string
+    { begin
+      (string-started?:boolean <- equal c:character ((#\" literal)))  ; for vim: "
+      (break-unless string-started?:boolean)
+      ($print-key-to-host c:character 6:literal/fg/cyan)
+      (slurp-string result:buffer-address)
+      (loop 2:blocks)
+    }
+    ; balance parens
+    { begin
+      (open-paren?:boolean <- equal c:character ((#\( literal)))
+      (break-unless open-paren?:boolean)
+      (_ color-code:integer <- divide-with-remainder open-parens:integer 3:literal)
+      (color-code:integer <- add color-code:integer 1:literal)
+      ($print-key-to-host c:character color-code:integer)
+      (open-parens:integer <- add open-parens:integer 1:literal)
+      (loop 2:blocks)
+    }
+    { begin
+      (close-paren?:boolean <- equal c:character ((#\) literal)))
+      (break-unless close-paren?:boolean)
+      (open-parens:integer <- subtract open-parens:integer 1:literal)
+      (_ color-code:integer <- divide-with-remainder open-parens:integer 3:literal)
+      (color-code:integer <- add color-code:integer 1:literal)
+      ($print-key-to-host c:character color-code:integer)
+      (loop 2:blocks)
+    }
+    { begin
+      (newline?:boolean <- equal c:character ((#\newline literal)))
+      (break-unless newline?:boolean)
+      ($print-key-to-host c:character)
+      (end-sexp?:boolean <- lesser-or-equal open-parens:integer 0:literal)
+      (break-if end-sexp?:boolean 2:blocks)
+      (loop 2:blocks)
+    }
+    ($print-key-to-host c:character)
+    ; todo: error on space outside parens, like python
+    ; []
+    ; don't return if there's no non-whitespace in result
+    (loop)
+  }
+  (s:string-address <- get result:buffer-address/deref data:offset)
+  (reply s:string-address)
+])
+
+(function skip-comment [
+  (default-space:space-address <- new space:literal 30:literal)
+  { begin
+    (c:character <- $wait-for-key-from-host)
+    ($print-key-to-host c:character 4:literal/fg/blue)
+    ; handle backspace
+    ; todo: how to exit comment?
+    { begin
+      (backspace?:boolean <- equal c:character ((#\backspace literal)))
+      (break-unless backspace?:boolean)
+      (len:integer-address <- get-address result:buffer-address/deref length:offset)
+      ; but only if we need to
+      { begin
+        (zero?:boolean <- lesser-or-equal len:integer-address/deref 0:literal)
+        (break-if zero?:boolean)
+        (len:integer-address/deref <- subtract len:integer-address/deref 1:literal)
+      }
+      (loop 2:blocks)
+    }
+    (newline?:boolean <- equal c:character ((#\newline literal)))
+    (break-if newline?:boolean)
+    (loop)
+  }
+])
+
+(function slurp-string [
+  (default-space:space-address <- new space:literal 30:literal)
+  (result:buffer-address <- next-input)
+  { begin
+    (c:character <- $wait-for-key-from-host)
+    ($print-key-to-host c:character 6:literal/fg/cyan)
+    ; handle backspace
+    ; todo: how to exit string?
+    { begin
+      (backspace?:boolean <- equal c:character ((#\backspace literal)))
+      (break-unless backspace?:boolean)
+      (len:integer-address <- get-address result:buffer-address/deref length:offset)
+      ; but only if we need to
+      { begin
+        (zero?:boolean <- lesser-or-equal len:integer-address/deref 0:literal)
+        (break-if zero?:boolean)
+        (len:integer-address/deref <- subtract len:integer-address/deref 1:literal)
+      }
+      (loop 2:blocks)
+    }
+    (result:buffer-address <- append result:buffer-address c:character)
+    (end-quote?:boolean <- equal c:character ((#\" literal)))  ; for vim: "
+    (break-if end-quote?:boolean)
+    (loop)
+  }
+])
+
+(function main [
+  (default-space:space-address <- new space:literal 30:literal)
+  (cursor-mode)
+  { begin
+    (print-primitive-to-host (("anarki> " literal)))
+    (s:string-address <- read-sexp)
+    (retro-mode)  ; print errors cleanly
+    (t:string-address <- $eval s:string-address)
+    (cursor-mode)
+    (print-string nil:literal/terminal t:string-address)
+    (print-character nil:literal/terminal ((#\newline literal)))
+    (loop)
+  }
+])
diff --git a/mu.arc b/mu.arc
index 14d23f95..5de3f75d 100644
--- a/mu.arc
+++ b/mu.arc
@@ -462,7 +462,13 @@
 
 ($:require "charterm/main.rkt")
 ($:require graphics/graphics)
+;? ($:require "terminal-color/terminal-color/main.rkt") ;? 1
 (= Viewport nil)
+; http://rosettacode.org/wiki/Terminal_control/Coloured_text#Racket
+($:define (tput . xs) (system (apply ~a 'tput " " (add-between xs " "))) (void))
+($:define (foreground color) (tput 'setaf color))
+($:define (background color) (tput 'setab color))
+($:define (reset) (tput 'sgr0))
 
 ; run instructions from 'routine*' for 'time-slice'
 (def run-for-time-slice (time-slice)
@@ -769,10 +775,48 @@
                 $quit
                   (quit)
                 $wait-for-key-from-host
-                  (if ($.current-charterm)
-                        ($.charterm-read-key)
-                      ($.graphics-open?)
-                        ($.get-key-press Viewport))
+                  (when ($.current-charterm)
+                    (ret result ($.charterm-read-key)
+                      (case result
+                        ; charterm exceptions
+                        return
+                          (= result #\newline)
+                        backspace
+                          (= result #\backspace)
+                        )))
+                $print-key-to-host
+                  (do1 nil
+;?                        (write (m arg.0))  (pr " => ")  (prn (type (m arg.0)))
+                       (if (no ($.current-charterm))
+                         (pr (m arg.0))
+                         (caselet x (m arg.0)
+                           ; todo: test these exceptions
+                           #\newline
+                             ($.charterm-newline)
+                           #\backspace
+                             ; backspace doesn't clear after moving the cursor
+                             (do ($.charterm-display #\backspace)
+                                 ($.charterm-display #\space)
+                                 ($.charterm-display #\backspace))
+                           ctrl-c
+                             (do ($.close-charterm)
+                                 (die "interrupted"))
+                           ;else
+                             (if (len> arg 2)
+                                   (do
+                                     ($.foreground (m arg.1))
+                                     ($.background (m arg.2))
+                                     (pr x)
+                                     ($.reset))
+                                 (len> arg 1)
+                                   (do
+                                     ($.foreground (m arg.1))
+                                     (pr x)
+                                     ($.reset))
+;?                                    (print-with-fg x (m arg.1)) ;? 1
+                                 :else
+                                   ($.charterm-display x))))
+                       )
                 $eval
                   (new-string:repr:eval:read:to-arc-string (m arg.0))
 
diff --git a/x.rkt b/x.rkt
new file mode 100644
index 00000000..ef5ad28b
--- /dev/null
+++ b/x.rkt
@@ -0,0 +1,14 @@
+(require "charterm/main.rkt")
+(require "terminal-color/terminal-color/main.rkt")
+(open-charterm)
+(charterm-clear-screen)
+(charterm-cursor 5 5)
+(displayln-color "Hello" #:fg 'green)  ; works
+(charterm-cursor 25 5)
+(displayln-color " Hello" #:fg 'green)  ; works
+;? ;? (charterm-cursor 1 6) ;? 2
+;? ;? (display-color "Hello" #:fg 'green)  ; err: cursor moves to start of line ;? 1
+;? (charterm-newline)  ; doesn't work after display; somehow runs before it ;? 1
+;? ;? (charterm-clear-line) ;? 3
+;? (displayln-color "World" #:fg 'green) ;? 1
+(close-charterm)