From f9d6aa5d1827b8c5af40c59b9490a154a9c21148 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Tue, 7 Feb 2017 23:13:48 -0800
Subject: [PATCH] add basic colorer

---
 .../basic-demo-2/colorer.rkt                  | 22 +++++++++++++++++++
 beautiful-racket-demo/basic-demo-2/lexer.rkt  |  4 ++--
 beautiful-racket-demo/basic-demo-2/main.rkt   | 12 ++++++++--
 3 files changed, 34 insertions(+), 4 deletions(-)
 create mode 100644 beautiful-racket-demo/basic-demo-2/colorer.rkt

diff --git a/beautiful-racket-demo/basic-demo-2/colorer.rkt b/beautiful-racket-demo/basic-demo-2/colorer.rkt
new file mode 100644
index 0000000..a317a63
--- /dev/null
+++ b/beautiful-racket-demo/basic-demo-2/colorer.rkt
@@ -0,0 +1,22 @@
+#lang br
+(require "lexer.rkt" brag/support)
+(provide color-basic)
+
+(define (color-basic port)
+  (define srcloc-tok (basic-lexer port))
+  (match srcloc-tok
+    [(? eof-object?) (values srcloc-tok 'eof #f #f #f)]
+    [else ; reverse-engineer with `match-define`
+     (match-define (srcloc-token (token-struct type val _ _ _ _ _)
+                                 (srcloc _ _ _ pos span)) srcloc-tok)
+     (define (color cat [paren #f])
+       (values (or val "") cat paren pos (+ pos span)))
+     (match type
+       ['STRING (color 'string)]
+       ['REM (color 'comment)]
+       [else (match val
+               [(? number?) (color 'constant)]
+               [(? symbol?) (color 'symbol)]
+               ["(" (color 'parenthesis '|(|)]
+               [")" (color 'parenthesis '|)|)]
+               [else (color 'no-color)])])]))
\ No newline at end of file
diff --git a/beautiful-racket-demo/basic-demo-2/lexer.rkt b/beautiful-racket-demo/basic-demo-2/lexer.rkt
index 141e8eb..04eb928 100644
--- a/beautiful-racket-demo/basic-demo-2/lexer.rkt
+++ b/beautiful-racket-demo/basic-demo-2/lexer.rkt
@@ -10,7 +10,7 @@
    [whitespace (token lexeme #:skip? #t)]
    [(from/stop-before "rem" "\n") (token 'REM lexeme)]
    [(:or "print" "goto" "end" "+" ":" "gosub" "return" "let" "=" "-" "for" "to" "step" "next"
-         "if" "then" "else" "and" "or" "<" ">" "*" "/" "(" ")" "^" "!" "%" "input" ";" "def") lexeme]
+         "if" "then" "else" "and" "or" "<" ">" "*" "/" "(" ")" "^" "!" "%" "input" ";" "def") (token lexeme lexeme)]
    [(:seq (:+ alphabetic) (:* (:or alphabetic numeric "$"))) (token 'ID (string->symbol lexeme))]
    [digits (token 'INTEGER (string->number lexeme))]
    [(:or (:seq (:? digits) "." digits)
@@ -21,4 +21,4 @@
            (substring lexeme
                       1 (sub1 (string-length lexeme))))]))
 
-(provide basic-lexer)
+(provide basic-lexer)
\ No newline at end of file
diff --git a/beautiful-racket-demo/basic-demo-2/main.rkt b/beautiful-racket-demo/basic-demo-2/main.rkt
index 454a573..d48546f 100644
--- a/beautiful-racket-demo/basic-demo-2/main.rkt
+++ b/beautiful-racket-demo/basic-demo-2/main.rkt
@@ -1,11 +1,19 @@
 #lang br/quicklang
 (require "parser.rkt" "tokenizer.rkt")
 
+(module+ reader
+  (provide read-syntax get-info))
+
 (define (read-syntax path port)
   (define parse-tree (parse path (make-tokenizer port path)))
   (strip-bindings
    #`(module basic-mod basic-demo-2/expander
        #,parse-tree)))
 
-(module+ reader
-  (provide read-syntax))
+(define (get-info port mod line col pos)
+    (define (handle-query key default)
+      (case key
+        [(color-lexer)
+         (dynamic-require 'basic-demo-2/colorer 'color-basic)]
+        [else default]))
+    handle-query)
\ No newline at end of file