improve colorer

pull/10/head
Matthew Butterick 8 years ago
parent ee35d0d287
commit 5a90f14d0c

@ -1,42 +1,48 @@
#lang br #lang br
(require brag/support syntax-color/racket-lexer racket/contract) (require brag/support syntax-color/racket-lexer racket/contract)
(define in-racket-expr? #f)
(define (color-jsonic port)
(define jsonic-lexer (define jsonic-lexer
(lexer (lexer
[(eof) (values lexeme 'eof #f #f #f)] [(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") [(from/to "//" "\n")
(values lexeme 'comment #f (values lexeme 'comment #f
(pos lexeme-start) (pos lexeme-end))] (pos lexeme-start) (pos lexeme-end))]
[any-char [any-char
(values lexeme 'string #f (values lexeme 'string #f
(pos lexeme-start) (pos lexeme-end))])) (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 (provide
(contract-out (contract-out
[color-jsonic [color-jsonic
(input-port? . -> . (values (input-port? exact-nonnegative-integer? boolean?
. -> . (values
(or/c string? eof-object?) (or/c string? eof-object?)
symbol? symbol?
(or/c symbol? #f) (or/c symbol? #f)
(or/c exact-positive-integer? #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 (module+ test
(require rackunit) (require rackunit)
(check-equal? (values->list (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)))

Loading…
Cancel
Save