diff --git a/brag/brag/private/colorer.rkt b/brag/brag/private/colorer.rkt index 2889485..ed3a0a9 100644 --- a/brag/brag/private/colorer.rkt +++ b/brag/brag/private/colorer.rkt @@ -5,27 +5,30 @@ (define brag-syntax-lexer (lexer-srcloc [(eof) (return-without-srcloc eof)] - [whitespace (return-without-srcloc (brag-syntax-lexer input-port))] + ;; need to lex whitespace to keep srclocs accurate + ;; (for DrRacket selections etc) + [whitespace (token 'WHITE lexeme)] [(:or (from/to "'" "'") (from/to "\"" "\"")) (token 'LIT lexeme)] [(:or (char-set "()[]|+*:") hide-char splice-char) (token 'MISC lexeme)] [(:seq (:or "#" ";") (complement (:seq (:* any-char) NL (:* any-char))) (:or NL "")) (token 'COMMENT lexeme)] [id (token 'ID lexeme)] [any-char (token 'OTHER lexeme)])) - -(define (color-brag port) +(define default-backup 10) +(define (color-brag port [backup default-backup] [in-string? #f]) (define srcloc-tok (brag-syntax-lexer port)) (if (eof-object? srcloc-tok) - (values srcloc-tok 'eof #f #f #f) + (values srcloc-tok 'eof #f #f #f 0 #f) (match-let* ([(srcloc-token (token-struct type val _ _ _ _ _) (srcloc _ _ _ posn span)) srcloc-tok] [(cons start end) (cons posn (+ posn span))] [(cons _ cat) (or (assq type '((ID . symbol) (LIT . string) (MISC . parenthesis) + (WHITE . whitespace) (COMMENT . comment))) (cons 'OTHER 'no-color))]) - (values val cat #f start end)))) + (values val cat #f start end backup #f)))) (module+ test (require rackunit) @@ -37,11 +40,11 @@ (open-input-string str))]) annotation)) - (check-equal? (apply-colorer "foo") '(("foo" symbol #f 1 4))) - (check-equal? (apply-colorer "'str'") '(("'str'" string #f 1 6))) - (check-equal? (apply-colorer "(foo)+") '(("(" parenthesis #f 1 2) - ("foo" symbol #f 2 5) - (")" parenthesis #f 5 6) - ("+" parenthesis #f 6 7))) - (check-equal? (apply-colorer "; rem") '(("; rem" comment #f 1 6))) - (check-equal? (apply-colorer "◊") '(("◊" no-color #f 1 4)))) + (check-equal? (apply-colorer "foo") `(("foo" symbol #f 1 4 ,default-backup #f))) + (check-equal? (apply-colorer "'str'") `(("'str'" string #f 1 6 ,default-backup #f))) + (check-equal? (apply-colorer "(foo)+") `(("(" parenthesis #f 1 2 ,default-backup #f) + ("foo" symbol #f 2 5 ,default-backup #f) + (")" parenthesis #f 5 6 ,default-backup #f) + ("+" parenthesis #f 6 7 ,default-backup #f))) + (check-equal? (apply-colorer "; rem") `(("; rem" comment #f 1 6 ,default-backup #f))) + (check-equal? (apply-colorer "◊") `(("◊" no-color #f 1 4 ,default-backup #f))))