diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt index 2ad5d20a6e..c0b82ed6df 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt @@ -3,6 +3,7 @@ (require string-constants racket/contract racket/class + racket/pretty drracket/private/drsig "frame-icon.rkt" mred @@ -13,7 +14,12 @@ racket/dict racket/set browser/external - setup/plt-installer) + setup/plt-installer + + scribble/tag + setup/xref + scribble/xref + net/url) (import [prefix drracket:app: drracket:app^] [prefix drracket:unit: drracket:unit^] @@ -33,7 +39,9 @@ (define (drr:set-default name val predicate) (preferences:set-default name val predicate - #:aliases (list (string->symbol (regexp-replace #rx"^drracket:" (symbol->string name) "drscheme:"))))) + #:aliases (list (string->symbol (regexp-replace #rx"^drracket:" + (symbol->string name) + "drscheme:"))))) (frame:current-icon todays-icon) @@ -76,10 +84,13 @@ (listof (listof symbol?))))) (preferences:set-default 'drracket:defs/ints-labels #t boolean?) -(drr:set-default 'drracket:language-dialog:hierlist-default #f (λ (x) (or (not x) (and (list? x) (andmap string? x))))) -(preferences:set-default 'drracket:language-dialog:teaching-hierlist-default #f (λ (x) (or (not x) (and (list? x) (andmap string? x))))) +(drr:set-default 'drracket:language-dialog:hierlist-default #f + (λ (x) (or (not x) (and (list? x) (andmap string? x))))) +(preferences:set-default 'drracket:language-dialog:teaching-hierlist-default #f + (λ (x) (or (not x) (and (list? x) (andmap string? x))))) -(drr:set-default 'drracket:create-executable-gui-type 'stand-alone (λ (x) (memq x '(launcher stand-alone distribution)))) +(drr:set-default 'drracket:create-executable-gui-type 'stand-alone + (λ (x) (memq x '(launcher stand-alone distribution)))) (drr:set-default 'drracket:create-executable-gui-base 'racket (λ (x) (memq x '(racket gracket)))) (drr:set-default 'drracket:logger-gui-tab-panel-level 0 (λ (x) (and (exact-integer? x) (<= 0 x 5)))) @@ -263,7 +274,50 @@ (drracket:font:setup-preferences) -(color-prefs:add-color-scheme-preferences-panel) +(color-prefs:add-color-scheme-preferences-panel + #:extras + (λ (parent) + (define hp (new horizontal-panel% + [alignment '(center center)] + [parent parent] + [stretchable-height #f])) + (new button% + [label (string-constant design-your-own-color-schemes)] + [callback + (λ args + + (define xref (load-collections-xref)) + (define-values (path tag) + (xref-tag->path+anchor + xref + (make-section-tag "color-scheme" + #:doc '(lib "scribblings/drracket/drracket.scrbl")))) + (define url (path->url path)) + (define url2 (if tag + (make-url (url-scheme url) + (url-user url) + (url-host url) + (url-port url) + (url-path-absolute? url) + (url-path url) + (url-query url) + tag) + url)) + (send-url (url->string url2)))] + [parent hp]) + (new button% + [label (string-constant style-and-color-names)] + [callback + (λ args + (define sp (open-output-string)) + (define-values (color-names style-names) (color-prefs:get-color-scheme-names)) + (fprintf sp "color names:\n") + (pretty-write (sort (set->list color-names) symbollist style-names) symbolstring datum))) + (unless example-key (set! example-key datum)) + datum] + [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)))) + +Each of the keys, e.g., @code[(format "~s" `',example-key)], maps to a color and possibly to +some style information. All keys accept colors (the vectors shown +above represent colors in r/g/b format), but only some accept style information. To +find out which are which and to get a complete list of the possible keys, click the button +labeled @onscreen[(regexp-replace #rx"&&" (string-constant style-and-color-names) "&")] +at the bottom of the +@onscreen[(string-constant color-schemes)] tab of the +@onscreen[(string-constant preferences-colors)] tab in the preferences dialog. +If one can accept style information, then you may include any of the symbols @racket['bold], +@racket['underline], or @racket['italic] in the list with the color. + +Full details on the specification of the info files can be found in the documentation +for the function @racket[color-prefs:register-info-based-color-schemes]. + +You may have to restart DrRacket (and, at least the first time after you add the @filepath{info.rkt} +file, re-run @tt{raco setup}) to see changes to your color scheme. + +Color schemes are not limited only to the colors that DrRacket already knows about. +If you are adding your own plugin to DrRacket, you can add new names that can be +mapped in the color scheme. See @racket[color-prefs:register-color-preference] for +more information. + @section[#:tag "create-exe"]{Creating Executables} DrRacket's @onscreen{Create Executable...} menu item lets you create diff --git a/pkgs/gui-pkgs/gui-lib/framework/main.rkt b/pkgs/gui-pkgs/gui-lib/framework/main.rkt index f5d48dee00..ddf5a327d7 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 8514712ccc..7a89ee0c9d 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 bb88214d56..c948b8ecd0 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<%> diff --git a/pkgs/string-constants/string-constants-lib/string-constants/private/english-string-constants.rkt b/pkgs/string-constants/string-constants-lib/string-constants/private/english-string-constants.rkt index 4c1bee3531..ee6e33af7d 100644 --- a/pkgs/string-constants/string-constants-lib/string-constants/private/english-string-constants.rkt +++ b/pkgs/string-constants/string-constants-lib/string-constants/private/english-string-constants.rkt @@ -558,6 +558,9 @@ please adhere to these guidelines: (classic-color-scheme "Classic") ;; formerly called 'black on white' (modern-color-scheme "Modern") ;; an attempt to be more color-blind friendly (white-on-black-color-scheme "White on Black") ;; clicking the buttons changes the color schemes to some defaults that've been set up. + ; drracket additions to the color scheme dialog; two buttons + (design-your-own-color-schemes "Design Your Own Color Schemes") ; pointer to (english-only) docs + (style-and-color-names "Style && Color Names") (add-spacing-between-lines "Add one pixel of extra space between lines")