From 3f3ac48d60f5fd8a2f7dbb46079e781d348e88ff Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 14 May 2008 23:25:19 +0000
Subject: [PATCH] PR 9388

svn: r9840

original commit: a2c4f5851b36f2e7bee1e9542c1b3ed2f4b72e4f
---
 collects/framework/private/color-prefs.ss | 12 ++++-------
 collects/framework/private/main.ss        |  5 +++++
 collects/framework/private/scheme.ss      | 25 ++++++++++++++---------
 collects/framework/private/sig.ss         |  4 +++-
 4 files changed, 27 insertions(+), 19 deletions(-)

diff --git a/collects/framework/private/color-prefs.ss b/collects/framework/private/color-prefs.ss
index aa81fd58..decde769 100644
--- a/collects/framework/private/color-prefs.ss
+++ b/collects/framework/private/color-prefs.ss
@@ -331,11 +331,11 @@
            (new button%
                 [label (string-constant white-on-black-color-scheme)]
                 [parent hp]
-                [callback (λ (x y) (white-on-black))])
+                [callback (λ (x y) (preferences:set 'framework:white-on-black? #t))])
            (new button%
                 [label (string-constant black-on-white-color-scheme)]
                 [parent hp]
-                [callback (λ (x y) (black-on-white))]))))))
+                [callback (λ (x y) (preferences:set 'framework:white-on-black? #f))]))))))
   
   
   (define (build-text-foreground-selection-panel parent pref-sym style-name example-text)
@@ -488,12 +488,8 @@
                   "did not find color ~s in the-color-database"
                   c))]))
   
-  (define (black-on-white)
-    (preferences:set 'framework:white-on-black? #f)
-    (do-colorization cadr))
-  (define (white-on-black)
-    (preferences:set 'framework:white-on-black? #t)
-    (do-colorization caddr))
+  (define (black-on-white) (do-colorization cadr))
+  (define (white-on-black) (do-colorization caddr))
   (define (do-colorization sel)
     (for-each (λ (l) 
                 (let* ([p (car l)]
diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss
index b4f061ff..2dfbe3e8 100644
--- a/collects/framework/private/main.ss
+++ b/collects/framework/private/main.ss
@@ -51,6 +51,11 @@
                            (λ (x) (and (list? x) (andmap string? x))))
   
   (preferences:set-default 'framework:white-on-black? #f boolean?)
+  (preferences:add-callback 'framework:white-on-black? 
+                            (λ (p v)
+                              (if v
+                                  (color-prefs:white-on-black)
+                                  (color-prefs:black-on-white))))
   
   (preferences:set-default 'framework:case-sensitive-search?
                            #f
diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss
index 61efff1e..81ecc3a3 100644
--- a/collects/framework/private/scheme.ss
+++ b/collects/framework/private/scheme.ss
@@ -252,16 +252,21 @@
       (send text end-edit-sequence))))
 
 
-
-;;                                                             
-;                                   ;                    ;    
-;                                   ;                    ;    
-;;;    ;;;   ; ;;    ;;;  ;;; ;    ;;;          ;;;;;   ;;;  ;;; ;;; ;;;;; 
-;   ;  ;   ;  ;;  ;  ;   ;  ; ; ;  ;   ;    ;     ;     ;   ;   ; ;    ;    
-;;;   ;      ;   ;  ;;;;;  ; ; ;  ;;;;;          ;     ;;;;;    ;     ;    
-;  ;      ;   ;  ;      ; ; ;  ;              ;     ;       ; ;    ;    
-;   ;  ;   ;  ;   ;  ;   ;  ; ; ;  ;   ;          ;   ; ;   ;  ;   ;   ;   ;
-;;;    ;;;  ;;; ;;;  ;;;  ;; ; ;;  ;;;     ;      ;;;   ;;;  ;;   ;;   ;;; 
+;                                            
+;                                            
+;                                            
+;               ;  ;;;;                      
+;              ;;  ;;;;                      
+;    ;;;;    ;;;;; ;;;; ;;;    ;;;   ;;; ;;; 
+;   ;;;;;;  ;;;;;; ;;;;;;;;;  ;;;;;  ;;;;;;; 
+;  ;;;;;;;;  ;;;;  ;;;; ;;;; ;;;; ;; ;;;; ;; 
+;  ;;;; ;;;  ;;;;  ;;;; ;;;; ;;;;;;; ;;;;    
+;  ;;;;;;;;  ;;;;; ;;;; ;;;; ;;;;;   ;;;;    
+;   ;;;;;;   ;;;;; ;;;; ;;;;  ;;;;;; ;;;;    
+;    ;;;;     ;;;; ;;;; ;;;;   ;;;;  ;;;;    
+;                                            
+;                                            
+;                                            
 
 
 (define color-prefs-table
diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss
index a7d79771..c816d210 100644
--- a/collects/framework/private/sig.ss
+++ b/collects/framework/private/sig.ss
@@ -376,7 +376,9 @@
      add-background-preferences-panel
      marshall-style-delta
      unmarshall-style-delta
-     set-default/color-scheme))  
+     set-default/color-scheme
+     white-on-black
+     black-on-white))
   
   (define-signature scheme-class^
     (text<%>