From f86e16a7440fcc08b32f4df2af58470fc1f54d20 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 9 Sep 2013 17:02:38 -0500
Subject: [PATCH] some improvements to color schemes

- better overview docs (now in the drracket manual)
- something inside the drracket gui to get the list of the
  available style names and to send you to the new docs

original commit: da4bb5991f760fff53cd5e1792e6ee1d1fb2a961
---
 pkgs/gui-pkgs/gui-lib/framework/main.rkt      | 52 +++++++------------
 .../gui-lib/framework/private/color-prefs.rkt |  8 ++-
 .../gui-lib/framework/private/sig.rkt         |  3 +-
 3 files changed, 26 insertions(+), 37 deletions(-)

diff --git a/pkgs/gui-pkgs/gui-lib/framework/main.rkt b/pkgs/gui-pkgs/gui-lib/framework/main.rkt
index f5d48dee..ddf5a327 100644
--- a/pkgs/gui-pkgs/gui-lib/framework/main.rkt
+++ b/pkgs/gui-pkgs/gui-lib/framework/main.rkt
@@ -4,6 +4,7 @@
          racket/unit
          racket/class
          racket/gui/base
+         racket/set
          mred/mred-unit
          framework/framework-unit
          framework/private/sig
@@ -1871,10 +1872,15 @@
     If @racket[style] is provided, a new style is registered; if not a color is
     registered.})
  
- (proc-doc
+ (proc-doc/names
   color-prefs:add-color-scheme-preferences-panel
-  (-> void?)
-  @{Adds a panel for choosing a color-scheme to the preferences dialog.})
+  (->* () (#:extras (-> (is-a?/c panel%) any)) void?)
+  (() ((extras void)))
+  @{Adds a panel for choosing a color-scheme to the preferences dialog.
+    
+    The @racket[extras] argument is called after the color schemes have been added
+    to the preferences panel. It is passed the panel containing the color schemes
+    and can add items to it.})
  
  (proc-doc
   color-prefs:register-info-based-color-schemes
@@ -1913,37 +1919,7 @@
     is called, it logs the active set of color names and style names to the @tt{color-scheme}
     logger at the info level. So, for example, starting up DrRacket like this:
     @tt{racket -W info@"@"color-scheme -l drracket} will print out the styles used in your
-    version of DrRacket.
-    
-    As an example, this is the specification of the @racket["Modern"] style:
-    @(let ()
-       (define pth (collection-file-path "info.rkt" "drracket"))
-       (define-values (base name dir?) (split-path pth))
-       (define info (get-info/full base))
-       (unless info (error 'framework/main.rkt "could not find example for modern color scheme"))
-       (define key 'framework:color-schemes)
-       (define datum (info key))
-       (define name-as-string-datum
-         (let loop ([datum datum])
-           (cond
-             [(list? datum)
-              (for/list ([datum (in-list datum)])
-                (loop datum))]
-             [(hash? datum)
-              (for/hash ([(k v) (in-hash datum)])
-                (if (and (equal? k 'name) (string-constant? v))
-                    (values k (dynamic-string-constant v))
-                    (values k (loop v))))]
-             [else datum])))
-       (define sp (open-output-string))
-       (parameterize ([pretty-print-columns 60]
-                      [current-output-port sp])
-         (pretty-write
-          `(define ,key 
-             ',name-as-string-datum)))
-       (codeblock 
-        (string-append "#lang info\n"
-                       (get-output-string sp))))})
+    version of DrRacket.})
  
  (proc-doc/names
   color-prefs:set-current-color-scheme
@@ -2020,6 +1996,14 @@
     
     If @racket[weak?] is @racket[#t], the @racket[fn] argument is held
     onto weakly; otherwise it is held onto strongly.})
+ 
+ (proc-doc
+  color-prefs:get-color-scheme-names
+  (-> (values set? set?))
+  @{Returns two sets; the first is the known color scheme names that are just colors
+    and the second is the known color scheme names that are styles.
+    
+    These are all of the names that have been passed to @racket[color-prefs:add-color-scheme-entry].})
  )
 
 
diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/color-prefs.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/color-prefs.rkt
index 8514712c..7a89ee0c 100644
--- a/pkgs/gui-pkgs/gui-lib/framework/private/color-prefs.rkt
+++ b/pkgs/gui-pkgs/gui-lib/framework/private/color-prefs.rkt
@@ -622,6 +622,8 @@
 (define known-color-names (set))
 (define known-style-names (set))
 
+(define (get-color-scheme-names) (values known-color-names known-style-names))
+
 (define-logger color-scheme)
 
 (define (register-info-based-color-schemes)
@@ -972,7 +974,7 @@
        (editor:set-standard-style-list-delta style-name sd)))
     (editor:set-standard-style-list-delta style-name (lookup-in-color-scheme name))))
 
-(define (add-color-scheme-preferences-panel)
+(define (add-color-scheme-preferences-panel #:extras [extras void])
   (preferences:add-panel
    (list (string-constant preferences-colors)
          (string-constant color-schemes))
@@ -1011,7 +1013,9 @@
                            (color-scheme-name color-scheme)))])))
      (define wid (apply max (map (λ (x) (send x get-width)) buttons)))
      (for ([b (in-list buttons)])
-       (send b min-width wid)))))
+       (send b min-width wid))
+     (extras vp)
+     (void))))
 
 (define (color-scheme->style-list color-scheme)
   (define style-list (new style-list%))
diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/sig.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/sig.rkt
index bb88214d..c948b8ec 100644
--- a/pkgs/gui-pkgs/gui-lib/framework/private/sig.rkt
+++ b/pkgs/gui-pkgs/gui-lib/framework/private/sig.rkt
@@ -440,7 +440,8 @@
      set-in-color-scheme
      register-color-scheme-entry-change-callback
      add-color-scheme-entry
-     register-info-based-color-schemes))
+     register-info-based-color-schemes
+     get-color-scheme-names))
   
   (define-signature racket-class^
     (text<%>