From 35fa233a939e31ac3b16ac14be9eea1ee87afd98 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 9 Apr 2007 16:26:23 +0000
Subject: [PATCH] more white-on-black colorscheme fixes

svn: r5906
---
 collects/drscheme/private/debug.ss | 23 ++++++++++++++++++-----
 collects/drscheme/private/drsig.ss |  2 ++
 collects/drscheme/private/rep.ss   |  3 +--
 collects/framework/gui-utils.ss    |  2 +-
 4 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/collects/drscheme/private/debug.ss b/collects/drscheme/private/debug.ss
index 049d8aaf95..fb9c558e7f 100644
--- a/collects/drscheme/private/debug.ss
+++ b/collects/drscheme/private/debug.ss
@@ -66,8 +66,14 @@ profile todo:
       (define error-delta (make-object style-delta% 'change-style 'italic))
       (send error-delta set-delta-foreground (make-object color% 255 0 0))
       
-      ;; error-color : (instanceof color%)
-      (define error-color (make-object color% "PINK"))
+      ;; get-error-color : -> (instanceof color%)
+      (define get-error-color
+        (let ([w-o-b (make-object color% 63 0 0)]
+              [b-o-w (make-object color% "PINK")])
+          (λ ()
+            (if (preferences:get 'framework:white-on-black?)
+                w-o-b
+                b-o-w))))
       
       (define clickable-image-snip%
         (class image-snip%
@@ -618,10 +624,17 @@ profile todo:
 	      (send context-text hide-caret #t)
 	      (send text insert "  ")
 	      (let ([snip (make-object editor-snip% context-text)])
+                (send snip use-style-background #t)
 		(send editor-canvas add-wide-snip snip)
-		(send text insert snip))
-	      (send text insert #\newline))
+                (let ([p (send text last-position)])
+                  (send text insert snip p p)
+                  (send text insert #\newline)
+                  (when (preferences:get 'framework:white-on-black?)
+                    (send text change-style white-on-black-style p (+ p 1))))))
 	    (close-text))))
+    
+    (define white-on-black-style (make-object style-delta%))
+    (define stupid-internal-define-syntax1 (send white-on-black-style set-delta-foreground "white"))
 
       ;; copy/highlight-text : text number number -> text
       ;; copies the range from `start' to `finish', including the entire paragraph at
@@ -643,7 +656,7 @@ profile todo:
                        (< (send from-text get-snip-position snip) para-end-pos))
               (send to-text insert (send snip copy))
               (loop (send snip next))))
-          (send to-text highlight-range (- from-start 1) from-end error-color #f #f 'high)
+          (send to-text highlight-range (- from-start 1) from-end (get-error-color) #f #f 'high)
           to-text))
       
       ;; get-filename : debug-source -> string
diff --git a/collects/drscheme/private/drsig.ss b/collects/drscheme/private/drsig.ss
index 520424a3ee..db71df6e40 100644
--- a/collects/drscheme/private/drsig.ss
+++ b/collects/drscheme/private/drsig.ss
@@ -59,6 +59,8 @@
      
      add-prefs-panel
      
+     get-error-color
+     
      show-error-and-highlight
      open-and-highlight-in-file
      show-backtrace-window
diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss
index a715b12fca..b0f215a5b6 100644
--- a/collects/drscheme/private/rep.ss
+++ b/collects/drscheme/private/rep.ss
@@ -495,7 +495,6 @@ TODO
          'drscheme:console-previous-exprs
          marshall unmarshall))
       
-      (define error-color (make-object color% "PINK"))
       (define color? ((get-display-depth) . > . 8))
             
       ;; instances of this interface provide a context for a rep:text%
@@ -754,7 +753,7 @@ TODO
                                      [start (- (srcloc-position loc) 1)]
                                      [span (srcloc-span loc)]
                                      [finish (+ start span)])
-                                (send file highlight-range start finish error-color #f #f 'high)))
+                                (send file highlight-range start finish (drscheme:debug:get-error-color) #f #f 'high)))
                             locs)])
                   
                   (when (and definitions-text error-arrows)
diff --git a/collects/framework/gui-utils.ss b/collects/framework/gui-utils.ss
index dd7a4076d3..ad18ad5e9b 100644
--- a/collects/framework/gui-utils.ss
+++ b/collects/framework/gui-utils.ss
@@ -138,7 +138,7 @@
   (define clickback-delta (make-object style-delta% 'change-underline #t))
   (define white-on-black-clickback-delta (make-object style-delta% 'change-underline #t))
   (send clickback-delta set-delta-foreground "BLUE")
-  (send white-on-black-clickback-delta set-delta-foreground "lightblue")
+  (send white-on-black-clickback-delta set-delta-foreground "deepskyblue")
   (define get-clickback-delta
     (opt-lambda ([white-on-black? #f])
       (if white-on-black?