start basic colorer

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))

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))
@@ -12,3 +12,15 @@
   (strip-bindings
    #`(module basic-mod basic-demo/expander
        #,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)

beautiful-racket-demo/basic-demo/tokenizer.rkt

@@ -13,10 +13,10 @@
   (define (next-token)
     (define get-token
       (lexer-src-pos
-       [(eof) eof]
+       [(eof) (token 'EOF)]
-       [whitespace (next-token)]
+       [whitespace (token 'WHITE lexeme #:skip? #t)]
-       [(from/to "/*" "*/") (next-token)]
+       [(from/to "/*" "*/") (token 'COMMENT lexeme #:skip? #t)]
-       [(:: positive-number (:+ whitespace) (from/to (uc+lc "rem") "\n")) (next-token)]
+       [(:: 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"