From bfd3690eca02d5fa86e297e31a0764db50618c3c Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Tue, 24 Jan 2017 00:03:38 -0500
Subject: [PATCH] start basic colorer

---
 beautiful-racket-demo/basic-demo/colorer.rkt  | 48 +++++++++++++++++++
 beautiful-racket-demo/basic-demo/main.rkt     | 16 ++++++-
 .../basic-demo/tokenizer.rkt                  |  8 ++--
 3 files changed, 66 insertions(+), 6 deletions(-)
 create mode 100644 beautiful-racket-demo/basic-demo/colorer.rkt

diff --git a/beautiful-racket-demo/basic-demo/colorer.rkt b/beautiful-racket-demo/basic-demo/colorer.rkt
new file mode 100644
index 0000000..d490ced
--- /dev/null
+++ b/beautiful-racket-demo/basic-demo/colorer.rkt
@@ -0,0 +1,48 @@
+#lang br
+(require brag/support syntax-color/racket-lexer racket/contract
+         basic-demo/tokenizer sugar/coerce)
+
+;(values lexeme 'parenthesis '|(| (pos lexeme-start) (pos lexeme-end))
+
+(define (color-basic ip)
+  (define postok ((tokenize ip)))
+  (define tok-or-str (position-token-token postok))
+  (define type (if (string? tok-or-str)
+                   'string
+                   (token-struct-type tok-or-str)))
+  (define val (if (string? tok-or-str)
+                  tok-or-str
+                  (->string (or (token-struct-val tok-or-str) ""))))
+  (values val
+          (caseq type
+                 [(WHITE) 'white-space]
+                 [(COMMENT) 'comment]
+                 [(NUMBER) 'constant]
+                 [(STRING) 'string]
+                 [else 'no-color])
+          #f
+          (position-offset (position-token-start-pos postok))
+          (position-offset (position-token-end-pos postok))))
+  
+
+(provide
+ (contract-out
+  [color-basic
+   (input-port? . -> . (values
+                        (or/c string? eof-object?)
+                        symbol?
+                        (or/c symbol? #f)
+                        (or/c exact-positive-integer? #f)
+                        (or/c exact-positive-integer? #f)))]))
+
+(module+ main
+  (define p (open-input-string #<<HERE
+
+10 rem foo
+20 rem foo
+30 let x = 42
+HERE
+                               ))
+  (color-basic p)
+  (color-basic p)
+  (color-basic p))
\ No newline at end of file
diff --git a/beautiful-racket-demo/basic-demo/main.rkt b/beautiful-racket-demo/basic-demo/main.rkt
index c6ee74a..4736a06 100644
--- a/beautiful-racket-demo/basic-demo/main.rkt
+++ b/beautiful-racket-demo/basic-demo/main.rkt
@@ -1,7 +1,7 @@
 #lang br/quicklang
 (require "parser.rkt" "tokenizer.rkt")
 
-(module+ reader (provide read-syntax))
+(module+ reader (provide read-syntax get-info))
 
 (define (read-syntax path port)
   (define-values (line col pos) (port-next-location port))
@@ -11,4 +11,16 @@
   (define parse-tree (parse path (tokenize port+newline)))
   (strip-bindings
    #`(module basic-mod basic-demo/expander
-       #,parse-tree)))
\ No newline at end of file
+       #,parse-tree)))
+
+(define (get-info port mod line col pos)
+    (define (handle-query key default)
+      (case key
+        [(color-lexer)
+         (dynamic-require 'basic-demo/colorer 'color-basic)]
+        #;[(drracket:indentation)
+         (dynamic-require 'basic-demo/indenter 'indent-jsonic)]
+        #;[(drracket:toolbar-buttons)
+         (dynamic-require 'basic-demo/buttons 'button-list)]
+        [else default]))
+    handle-query)
\ No newline at end of file
diff --git a/beautiful-racket-demo/basic-demo/tokenizer.rkt b/beautiful-racket-demo/basic-demo/tokenizer.rkt
index 8180966..98e9c8c 100644
--- a/beautiful-racket-demo/basic-demo/tokenizer.rkt
+++ b/beautiful-racket-demo/basic-demo/tokenizer.rkt
@@ -13,10 +13,10 @@
   (define (next-token)
     (define get-token
       (lexer-src-pos
-       [(eof) eof]
-       [whitespace (next-token)]
-       [(from/to "/*" "*/") (next-token)]
-       [(:: positive-number (:+ whitespace) (from/to (uc+lc "rem") "\n")) (next-token)]
+       [(eof) (token 'EOF)]
+       [whitespace (token 'WHITE lexeme #:skip? #t)]
+       [(from/to "/*" "*/") (token 'COMMENT lexeme #:skip? #t)]
+       [(:: positive-number (:+ whitespace) (from/to (uc+lc "rem") "\n")) (token 'COMMENT lexeme #:skip? #t)]
        [(:or (uc+lc "print" "for" "to" "step" "if"
                    "goto" "input" "let" "next"
                    "return" "clear" "list" "run"