improve the prefs dialog

Author: rfindler

gui-lib/framework/private/color-prefs.rkt

@@ -1263,8 +1263,8 @@
          (define check-box
            (new check-box%
                 [label (if (color-scheme-white-on-black-base? color-scheme)
-                           "Dark Mode Color Scheme"
-                           "Light Mode Color Scheme")]
+                           (string-constant dark-mode-color-scheme)
+                           (string-constant light-mode-color-scheme))]
                 [parent bp]
                 [value (equal?
                         (preferences:get (if (color-scheme-white-on-black-base? color-scheme)
@@ -1285,16 +1285,64 @@
                   (equal? val (color-scheme-name color-scheme)))))
          (update-colors #f)
          msg))
+     (define bottom-hp
+       (new horizontal-panel%
+            [parent vp]
+            [stretchable-height #f]))
      (define revert-button%
        (new button%
-            [label "Revert Colors to Color Scheme’s Default Colors"]
-            [parent vp]
+            [label (string-constant revert-colors-to-color-scheme-defaults)]
+            [parent bottom-hp]
             [callback
              (λ (x y)
                (revert-to-color-scheme-defaults
                 (get-current-color-scheme
                  #:wob?
                  (white-on-black-panel-scheme?))))]))
+     (define white-on-black-mode-choice
+       (case (system-type)
+         [(windows)
+          (new choice%
+               [parent bottom-hp]
+               [label (string-constant color-mode)]
+               [choices (list (string-constant light-mode)
+                              (string-constant dark-mode))]
+               [selection (if (preferences:get 'framework:white-on-black-mode?) 1 0)]
+               [callback
+                (λ (_1 _2)
+                  (preferences:set 'framework:white-on-black-mode?
+                                   (match (send white-on-black-mode-choice get-selection)
+                                     [0 #f]
+                                     [1 #t])))])
+          (preferences:add-callback
+           'framework:white-on-black-mode?
+           (λ (_1 val)
+             (send white-on-black-mode-choice
+                   set-selection
+                   (if val 1 0))))]
+         [else
+          (new choice%
+               [parent bottom-hp]
+               [label (string-constant color-mode)]
+               [choices (list (string-constant use-os-dark-mode-selection)
+                              (string-constant always-light-mode)
+                              (string-constant always-dark-mode))]
+               [callback
+                (λ (_1 _2)
+                  (preferences:set 'framework:white-on-black-mode?
+                                   (match (send white-on-black-mode-choice get-selection)
+                                     [0 'platform]
+                                     [1 #f]
+                                     [2 #t])))])
+          (preferences:add-callback
+           'framework:white-on-black-mode?
+           (λ (_1 val)
+             (send white-on-black-mode-choice
+                   set-selection
+                   (match val
+                     ['platform 0]
+                     [#t 2]
+                     [#f 1]))))]))
      (define wid (apply max (map (λ (x) (send x get-width)) buttons)))
      (for ([b (in-list buttons)])
        (send b min-width wid))

gui-lib/framework/private/main.rkt

@@ -630,3 +630,20 @@
      (color-prefs:change-colors-to-match-color-scheme
       (or (color-prefs:lookup-color-scheme val)
           (color-prefs:built-in-wob-color-scheme))))))
+
+(preferences:add-callback
+ 'framework:white-on-black-mode?
+ (λ (sym val)
+   (define wob?
+     (match val
+       ['platform (white-on-black-panel-scheme?)]
+       [#t #t]
+       [#f #f]))
+   (define pref-name (if wob? 'framework:color-scheme-wob 'framework:color-scheme))
+   (define pref-val (preferences:get pref-name))
+   (define found-color-scheme (color-prefs:lookup-color-scheme pref-val))
+   (color-prefs:change-colors-to-match-color-scheme
+    (or found-color-scheme
+        (if wob?
+            (color-prefs:built-in-wob-color-scheme)
+            (color-prefs:built-in-color-scheme))))))

gui-lib/info.rkt

@@ -13,7 +13,7 @@
                "pict-lib"
                "scheme-lib"
                ["scribble-lib" #:version "1.36"]
-               ["string-constants-lib" #:version "1.41"]
+               ["string-constants-lib" #:version "1.55"]
                "option-contract-lib"
                "2d-lib"
                "compatibility-lib"