From 3894596b2ac81fd4e984f37e27483979301154bd Mon Sep 17 00:00:00 2001
From: Scott Owens <sowens@cs.utah.edu>
Date: Mon, 1 Dec 2003 05:22:50 +0000
Subject: [PATCH] *** empty log message ***

original commit: 288ad2a7269bcd815f0784e34471a9ba121f3987
---
 collects/framework/private/color-prefs.ss |  3 ++-
 collects/framework/private/color.ss       | 15 +++++++++++----
 collects/framework/private/main.ss        | 13 +++++++------
 collects/framework/private/scheme.ss      |  2 +-
 4 files changed, 21 insertions(+), 12 deletions(-)

diff --git a/collects/framework/private/color-prefs.ss b/collects/framework/private/color-prefs.ss
index 25c745c5..ca2fdd04 100644
--- a/collects/framework/private/color-prefs.ss
+++ b/collects/framework/private/color-prefs.ss
@@ -1,6 +1,7 @@
 (module color-prefs mzscheme
   (require (lib "class.ss")
            (lib "unitsig.ss")
+           (lib "etc.ss")
            (lib "mred.ss" "mred")
            (lib "string-constant.ss" "string-constants")
            "sig.ss")
@@ -225,7 +226,7 @@
                     syms)
           (for-each set-slatex-style syms (map preferences:get syms))
           (preferences:set-default active-pref #t (lambda (x) #t))
-          (preferences:add-panel `("Editing" "Colors" ,tab-name)
+          (preferences:add-panel `("Syntax Coloring" ,tab-name)
                                  (lambda (p)
                                    (let ((vp (new vertical-panel% (parent p))))
                                      (new color-selection-panel%
diff --git a/collects/framework/private/color.ss b/collects/framework/private/color.ss
index b483e80e..77b20df2 100644
--- a/collects/framework/private/color.ss
+++ b/collects/framework/private/color.ss
@@ -87,6 +87,9 @@
           (define remove-prefs-callback-thunk #f)
           (define prefix #f)
           
+          (define/public (coloring-active?)
+            should-color?)
+          
           ;; ---------------------- Multi-threading -------------------------------
           ;; A list of thunks that color the buffer
           (define colors null)
@@ -271,13 +274,15 @@
                       (preferences:add-callback
                        (string->symbol (format "syntax-coloring:~a:active" prefix))
                        (lambda (_ on?)
-                         (set! should-color? on?)
                          (cond
-                           (on?
+                           ((and (not should-color?) on?)
+                            (set! should-color? #t)
                             (reset-tokens)
                             (do-insert/delete start-pos 0))
-                           (else (change-style (send (get-style-list) find-named-style "Standard")
-                                               start-pos end-pos #f)))))))
+                           ((and should-color? (not on?))
+                            (set! should-color? #f)
+                            (change-style (send (get-style-list) find-named-style "Standard")
+                                          start-pos end-pos #f)))))))
               (unless background-thread
                 (break-enabled #f)
                 (set! background-thread (thread (lambda () (background-colorer-entry))))
@@ -417,6 +422,8 @@
               (set! remove-prefs-callback-thunk #f))
             (super-on-close))          
           
+          (rename (super-change-style change-style))
+          
           (super-instantiate ())))
       
       (define -text% (text-mixin text:keymap%))
diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss
index 411888e8..7a998383 100644
--- a/collects/framework/private/main.ss
+++ b/collects/framework/private/main.ss
@@ -219,13 +219,14 @@
       ;; This adds the preferences that scheme:text% needs for coloring
       (color-prefs:add
        "Scheme Color"
-       `((keyword ,(color-prefs:make-style-delta "Black" #f #f #f))
+       `((symbol ,(color-prefs:make-style-delta "navy" #f #f #f))
+         (keyword ,(color-prefs:make-style-delta (make-object color% 40 25 15) #f #f #f))
+         (unbound-variable ,(color-prefs:make-style-delta "red" #f #f #f))
+         (bound-variable ,(color-prefs:make-style-delta "navy" #f #f #f))
+         (constant ,(color-prefs:make-style-delta (make-object color% 51 135 39) #f #f #f))
          (string ,(color-prefs:make-style-delta "ForestGreen" #f #f #f))
-         (literal ,(color-prefs:make-style-delta "ForestGreen" #f #f #f))
          (comment ,(color-prefs:make-style-delta (make-object color% 0 105 255) #f #f #f))
-         (error ,(color-prefs:make-style-delta "Red" #f #f #f))
-         (identifier ,(color-prefs:make-style-delta "Navy" #f #f #f))
-         (other ,(color-prefs:make-style-delta "brown" #f #f #f))))
-
+         (error ,(color-prefs:make-style-delta "red" #f #f #f))
+         (base ,(color-prefs:make-style-delta "brown" #f #f #f))))
       
       (void))))
diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss
index fa61dc07..30e5f704 100644
--- a/collects/framework/private/scheme.ss
+++ b/collects/framework/private/scheme.ss
@@ -1044,7 +1044,7 @@
       (define (scheme-lexer-wrapper in)
         (let-values (((type lex start end) (scheme-lexer in)))
           (cond
-            ((and (eq? type 'identifier)
+            ((and (eq? type 'symbol)
                   (hash-table-get (preferences:get 'framework:tabify)
                                   (string->symbol lex)
                                   (lambda () #f)))