suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make the 'name field of color scheme be more forgiving

Browse Source 
and improve the example in the docs to be more fool-proof
for copy/paste

original commit: 8311b620b4aa2ce7ce566174efb258e704ee8463
This commit is contained in:
Robby Findler 2013-09-08 11:04:46 -05:00
parent b6500eee00
commit 47922f0da3
2 changed files with 29 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
pkgs/gui-pkgs/gui-lib/framework/main.rkt
View File

@ -29,7 +29,7 @@
framework/private/decorated-editor-snip))
(require (for-doc racket/base scribble/manual framework/private/mapdesc
setup/getinfo racket/pretty))
setup/getinfo racket/pretty string-constants))
(provide-signature-elements
(prefix application: framework:application-class^)
@ -1887,7 +1887,8 @@
color scheme. Each hash table should have keys that specify
details of the color scheme, as follows:
@itemlist[@item{@racket['name]: must be either a string or a symbol;
if it is a symbol, it is passed to @racket[dynamic-string-constant]
if it is a symbol and @racket[string-constant?],
it is passed to @racket[dynamic-string-constant]
to get the name; otherwise it is used as the name directly.
If absent, the name of the directory containing the @filepath{info.rkt}
file is used as the name.}
@ -1920,8 +1921,29 @@
(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"))
(parameterize ([pretty-print-columns 60])
(codeblock (pretty-format (info 'framework:color-schemes)))))})
(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))))})
(proc-doc/names
color-prefs:set-current-color-scheme

4
pkgs/gui-pkgs/gui-lib/framework/private/color-prefs.rkt
View File

@ -646,7 +646,9 @@
(define mapping (hash-ref one-scheme 'colors '()))
(define example (hash-ref one-scheme 'example default-example))
(register-color-scheme (if (symbol? name)
(dynamic-string-constant name)
(if (string-constant? name)
(dynamic-string-constant name)
(symbol->string name))
name)
white-on-black-base?
mapping