improve colorer
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…
Reference in New Issue