improve colorer

beautiful-racket-demo/jsonic-demo-2/colorer.rkt

@@ -1,42 +1,48 @@
 #lang br
 (require brag/support syntax-color/racket-lexer racket/contract)
 
-(define in-racket-expr? #f)
+(define jsonic-lexer
-
-(define (color-jsonic port)
-  (define jsonic-lexer
   (lexer
    [(eof) (values lexeme 'eof #f #f #f)]
-     ["@$" (begin
+   [(:or "@$" "$@")
-             (set! in-racket-expr? #t)
+    (values lexeme 'parenthesis
-             (values lexeme 'parenthesis '|(|
+            (if (equal? lexeme "@$") '|(| '|)|)
-                     (pos lexeme-start) (pos lexeme-end)))]
+            (pos lexeme-start) (pos lexeme-end))]
-     ["$@" (begin
-             (set! in-racket-expr? #f)
-             (values lexeme 'parenthesis '|)|
-                     (pos lexeme-start) (pos lexeme-end)))]
    [(from/to "//" "\n")
     (values lexeme 'comment #f
             (pos lexeme-start) (pos lexeme-end))]
    [any-char
     (values lexeme 'string #f
             (pos lexeme-start) (pos lexeme-end))]))
-  (if (and in-racket-expr?
+
-           (not (equal? (peek-string 2 0 port) "$@")))
+(define (color-jsonic port offset racket-coloring-mode?)
-      (racket-lexer port)
+  (cond
-      (jsonic-lexer port)))
+    [(or (not racket-coloring-mode?)
+         (equal? (peek-string 2 0 port) "$@"))
+     (define-values (str cat paren start end)
+       (jsonic-lexer port))
+     (define switch-to-racket-mode (equal? str "@$"))
+     (values str cat paren start end 0 switch-to-racket-mode)]
+    [else
+     (define-values (str cat paren start end)
+       (racket-lexer port))
+     (values str cat paren start end 0 #t)]))
+
 (provide
  (contract-out
   [color-jsonic
-   (input-port? . -> . (values
+   (input-port? exact-nonnegative-integer? boolean?
+                . -> . (values
                         (or/c string? eof-object?)
                         symbol?
                         (or/c symbol? #f)
                         (or/c exact-positive-integer? #f)
-                        (or/c exact-positive-integer? #f)))]))
+                        (or/c exact-positive-integer? #f)
+                        exact-nonnegative-integer?
+                        boolean?))]))
 
 (module+ test
   (require rackunit)
   (check-equal? (values->list
-                 (color-jsonic (open-input-string "x")))
+                 (color-jsonic (open-input-string "x") 0 #f))
-                (list "x" 'string #f 1 2)))
+                (list "x" 'string #f 1 2 0 #f)))