From 31220fc2db12978900d83cc55c99d1ebf4af2343 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 7 Feb 2017 23:13:33 -0800 Subject: [PATCH] add `apply-colorer` --- brag/brag/support.rkt | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/brag/brag/support.rkt b/brag/brag/support.rkt index bb52cd0..e956e8f 100755 --- a/brag/brag/support.rkt +++ b/brag/brag/support.rkt @@ -73,16 +73,28 @@ in)) (define token-producer (tokenize input-port)) (for/list ([token (in-producer token-producer (λ(tok) - (eq? eof (cond - ;; position-tokens are produced by lexer-src-pos, - [(position-token? tok) - (position-token-token tok)] - ;; and srcloc-tokens by lexer-srcloc - [(srcloc-token? tok) - (srcloc-token-token tok)] - [else tok]))))]) + (define val (cond + ;; position-tokens are produced by lexer-src-pos, + [(position-token? tok) + (position-token-token tok)] + ;; and srcloc-tokens by lexer-srcloc + [(srcloc-token? tok) + (srcloc-token-token tok)] + [else tok])) + (or (eof-object? val) (void? val))))]) token)) +(provide apply-colorer) +(define (apply-colorer colorer port-or-string) + (define p (if (string? port-or-string) + (open-input-string port-or-string) + port-or-string)) + (let loop ([acc null]) + (define-values (lex cat shape start end) (colorer p)) + (if (or (eq? 'eof cat) (eof-object? lex)) + (reverse acc) + (loop (cons (list lex cat shape start end) acc))))) + (provide trim-ends) (define (trim-ends left lexeme right) (string-trim (string-trim lexeme left #:right? #f) right #:left? #f))