From 021a65020fd24fc9fd10e3193e4d6e6e5611f5fd Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 1 Aug 2009 02:31:51 +0000 Subject: [PATCH] fix thaw-colorer, as reflected in restoring coloring in an edtor after test-coverage coloring svn: r15651 --- collects/framework/private/color.ss | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/collects/framework/private/color.ss b/collects/framework/private/color.ss index 4fb414cd7c..78ae79b813 100644 --- a/collects/framework/private/color.ss +++ b/collects/framework/private/color.ss @@ -559,19 +559,21 @@ added get-regions (else (begin-edit-sequence #f #f) (finish-now) - (for-each - (lambda (ls) - (let ([tokens (lexer-state-tokens ls)] - [start-pos (lexer-state-start-pos ls)]) - (send tokens for-each - (λ (start len type) - (when (and should-color? (should-color-type? type)) - (let ((color (send (get-style-list) find-named-style - (token-sym->style type))) - (sp (+ start-pos start)) - (ep (+ start-pos (+ start len)))) - (change-style color sp ep #f))))))) - lexer-states) + (when should-color? + (for-each + (lambda (ls) + (let ([tokens (lexer-state-tokens ls)] + [start-pos (lexer-state-start-pos ls)]) + (send tokens for-each + (λ (start len data) + (let ([type (data-type data)]) + (when (should-color-type? type) + (let ((color (send (get-style-list) find-named-style + (token-sym->style type))) + (sp (+ start-pos start)) + (ep (+ start-pos (+ start len)))) + (change-style color sp ep #f)))))))) + lexer-states)) (end-edit-sequence))))))))