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
This commit is contained in:
Robby Findler 2013-09-09 17:02:38 -05:00
parent 745d56c49a
commit f86e16a744
3 changed files with 26 additions and 37 deletions

View File

@ -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].})
)

View File

@ -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%))

View File

@ -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<%>