diff options
author | Kartik K. Agaram <vc@akkartik.com> | 2015-01-27 01:21:29 -0800 |
---|---|---|
committer | Kartik K. Agaram <vc@akkartik.com> | 2015-01-27 01:21:29 -0800 |
commit | e5756fbef85f4ab29370da16ef533c770e0dabc2 (patch) | |
tree | c0c7fe1ed6a5b05ec7fd25d0db058ad1b32c21a9 | |
parent | 465007f11e5ccfede71e0afda44510eb1eae0ec7 (diff) | |
download | mu-e5756fbef85f4ab29370da16ef533c770e0dabc2.tar.gz |
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.
-rw-r--r-- | color-repl.mu | 146 | ||||
-rw-r--r-- | mu.arc | 52 | ||||
-rw-r--r-- | x.rkt | 14 |
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) |