|
|
|
@ -14,21 +14,20 @@
|
|
|
|
[id (token 'ID lexeme)]
|
|
|
|
[id (token 'ID lexeme)]
|
|
|
|
[any-char (token 'OTHER lexeme)]))
|
|
|
|
[any-char (token 'OTHER lexeme)]))
|
|
|
|
|
|
|
|
|
|
|
|
(define default-backup 10)
|
|
|
|
(define (color-brag port)
|
|
|
|
(define (color-brag port [backup default-backup] [in-string? #f])
|
|
|
|
|
|
|
|
(define srcloc-tok (brag-syntax-lexer port))
|
|
|
|
(define srcloc-tok (brag-syntax-lexer port))
|
|
|
|
(if (eof-object? srcloc-tok)
|
|
|
|
(cond
|
|
|
|
(values srcloc-tok 'eof #f #f #f 0 #f)
|
|
|
|
[(eof-object? srcloc-tok) (values srcloc-tok 'eof #f #f #f)]
|
|
|
|
(match-let* ([(srcloc-token (token-struct type val _ _ _ _ _) (srcloc _ _ _ posn span)) srcloc-tok]
|
|
|
|
[else
|
|
|
|
[(cons start end) (cons posn (+ posn span))]
|
|
|
|
(match-define (srcloc-token (token-struct type val _ _ _ _ _) (srcloc _ _ _ posn span)) srcloc-tok)
|
|
|
|
[(cons _ cat) (or (assq type
|
|
|
|
(match-define (list start end) (list posn (+ posn span)))
|
|
|
|
'((ID . symbol)
|
|
|
|
(values val (case type
|
|
|
|
(LIT . string)
|
|
|
|
[(ID) 'symbol]
|
|
|
|
(MISC . parenthesis)
|
|
|
|
[(LIT) 'string]
|
|
|
|
(WHITE . whitespace)
|
|
|
|
[(MISC) 'parenthesis]
|
|
|
|
(COMMENT . comment)))
|
|
|
|
[(WHITE) 'whitespace]
|
|
|
|
(cons 'OTHER 'no-color))])
|
|
|
|
[(COMMENT) 'comment]
|
|
|
|
(values val cat #f start end backup #f))))
|
|
|
|
[else 'no-color]) #f start end)]))
|
|
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
(module+ test
|
|
|
|
(require rackunit)
|
|
|
|
(require rackunit)
|
|
|
|
@ -40,11 +39,11 @@
|
|
|
|
(open-input-string str))])
|
|
|
|
(open-input-string str))])
|
|
|
|
annotation))
|
|
|
|
annotation))
|
|
|
|
|
|
|
|
|
|
|
|
(check-equal? (apply-colorer "foo") `(("foo" symbol #f 1 4 ,default-backup #f)))
|
|
|
|
(check-equal? (apply-colorer "foo") `(("foo" symbol #f 1 4)))
|
|
|
|
(check-equal? (apply-colorer "'str'") `(("'str'" string #f 1 6 ,default-backup #f)))
|
|
|
|
(check-equal? (apply-colorer "'str'") `(("'str'" string #f 1 6)))
|
|
|
|
(check-equal? (apply-colorer "(foo)+") `(("(" parenthesis #f 1 2 ,default-backup #f)
|
|
|
|
(check-equal? (apply-colorer "(foo)+") `(("(" parenthesis #f 1 2)
|
|
|
|
("foo" symbol #f 2 5 ,default-backup #f)
|
|
|
|
("foo" symbol #f 2 5)
|
|
|
|
(")" parenthesis #f 5 6 ,default-backup #f)
|
|
|
|
(")" parenthesis #f 5 6)
|
|
|
|
("+" parenthesis #f 6 7 ,default-backup #f)))
|
|
|
|
("+" parenthesis #f 6 7)))
|
|
|
|
(check-equal? (apply-colorer "; rem") `(("; rem" comment #f 1 6 ,default-backup #f)))
|
|
|
|
(check-equal? (apply-colorer "; rem") `(("; rem" comment #f 1 6)))
|
|
|
|
(check-equal? (apply-colorer "◊") `(("◊" no-color #f 1 4 ,default-backup #f))))
|
|
|
|
(check-equal? (apply-colorer "◊") `(("◊" no-color #f 1 4))))
|
|
|
|
|
