colorer corrections

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))))