fix up calls to get-current-color-scheme and documentation of the functions that call it

Author: rfindler

gui-lib/framework/main.rkt

@@ -2343,19 +2343,18 @@ for code that supports @tech{color scheme}s.
   (-> symbol? void?)
   (name)
   @{
-Updates the colors in DrRacket's GUI to the colors in
-the @tech{color scheme} named @racket[name],
-if @racket[name] names one of the color schemes and
-the named color scheme matches the dark/light mode that the GUI is in.
-Otherwise, sets the color scheme to either the
-light or dark mode default color scheme, depending
-on the user's preference for the current mode.
+Set's the user's preferred @tech{color scheme} to
+the one whose name is @racket[name].
+Also, updates the colors in DrRacket's GUI to the colors in
+that color scheme if the named color scheme matches the
+dark/light mode that the GUI is in.
 })
 
- (proc-doc
+ (proc-doc/names
   color-prefs:get-current-color-scheme-name
-  (-> symbol?)
-  @{Returns the current @tech{color scheme}'s name.})
+  (->* () (#:wob? boolean?) symbol?)
+  (() ((wob? (white-on-black-color-scheme?))))
+  @{Returns the name of either the user's preferred dark mode or light mode @tech{color scheme}.})
 
  (proc-doc/names
   color-prefs:known-color-scheme-name?
@@ -2400,14 +2399,15 @@ of color scheme named @racket[name], if it has one.
             passed as the first argument to @racket[color-prefs:add-color-scheme-entry]
             and the @racket[#:style] argument must have also been omitted or be @racket[#f].})
 
- (proc-doc 
+ (proc-doc
   color-prefs:lookup-in-color-scheme
   (->i ([name color-prefs:known-color-scheme-name?])
-       ()
+       (#:wob? [wob boolean?])
        [result (name)
                (if (color-prefs:color-scheme-style-name? name)
                    (is-a?/c style-delta%)
                    (is-a?/c color%))])
+  ((white-on-black-color-scheme?))
   @{Returns the current style delta or color associated with @racket[name].})
 
  (proc-doc

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

@@ -944,11 +944,11 @@
         1.0)))
 
 ;; returns the user's preferred color, wrt to the current color scheme
-(define (lookup-in-color-scheme color-name)
+(define (lookup-in-color-scheme color-name #:wob? [wob? (white-on-black-color-scheme?)])
   (lookup-in-color-scheme/given-mapping 
    color-name
    (preferences:get (color-scheme-entry-name->pref-name color-name))
-   (get-current-color-scheme)))
+   (get-current-color-scheme #:wob? wob?)))
 
 (define (lookup-in-given-color-scheme color-name color-scheme)
   (lookup-in-color-scheme/given-mapping 
@@ -980,7 +980,7 @@
 ;; set-color : symbol (or/c string? (is-a?/c color%) (is-a?/c style-delta%)) -> void
 (define (set-in-color-scheme color-name clr/sd)
   (define table (preferences:get (color-scheme-entry-name->pref-name color-name)))
-  (define current-color-scheme (get-current-color-scheme))
+  (define current-color-scheme (get-current-color-scheme #:wob? (white-on-black-color-scheme?)))
   (define scheme-name (color-scheme-name current-color-scheme))
   (define new-table
     (cond
@@ -1011,7 +1011,7 @@
        (= (send c1 blue) (send c2 blue))
        (= (send c1 alpha) (send c2 alpha))))
 
-(define (get-current-color-scheme #:wob? [wob? #f])
+(define (get-current-color-scheme #:wob? wob?)
   ;; if pref is not recognized as an existing color scheme name,
   ;; return one of the two original color schemes so that
   ;; if some color scheme goes away, we have some
@@ -1025,7 +1025,7 @@
     [wob? (built-in-wob-color-scheme)]
     [else (built-in-color-scheme)]))
 
-(define (get-current-color-scheme-name #:wob? [wob? #f])
+(define (get-current-color-scheme-name #:wob? [wob? (white-on-black-color-scheme?)])
   (color-scheme-name (get-current-color-scheme #:wob? wob?)))
 
 ;; string -> (or/c #f color-scheme?)
@@ -1107,7 +1107,8 @@
          (fn (lookup-in-color-scheme/given-mapping
               color
               ht
-              (get-current-color-scheme)))))))
+              (get-current-color-scheme
+               #:wob? (white-on-black-color-scheme?))))))))
   (void))
 
 ;; we remove elements of the list when the function isn't reachable anymore
@@ -1315,13 +1316,7 @@
                   (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))))]
+                                     [1 #t])))])]
          [else
           (new choice%
                [parent bottom-hp]
@@ -1335,16 +1330,25 @@
                                    (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]))))]))
+                                     [2 #t])))])]))
+     (case (system-type)
+       [(windows)
+        (preferences:add-callback
+         'framework:white-on-black-mode?
+         (λ (_1 val)
+           (send white-on-black-mode-choice
+                 set-selection
+                 (if val 1 0))))]
+       [else
+        (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))