From b2dd2f5c15a3d0b708f644ed419b7a7453959e46 Mon Sep 17 00:00:00 2001 From: Scott Owens Date: Fri, 5 Dec 2003 10:33:51 +0000 Subject: [PATCH] *** empty log message *** original commit: 8448b16fa2c4483a9317b6183e5b9b62880d204a --- collects/framework/private/color-prefs.ss | 31 +++++++++++---------- collects/framework/private/main.ss | 5 ++-- collects/framework/private/scheme.ss | 33 ++++++++++++++--------- 3 files changed, 41 insertions(+), 28 deletions(-) diff --git a/collects/framework/private/color-prefs.ss b/collects/framework/private/color-prefs.ss index 99189792..88e03749 100644 --- a/collects/framework/private/color-prefs.ss +++ b/collects/framework/private/color-prefs.ss @@ -24,7 +24,7 @@ (define sym (get-full-pref-name tab-name symbol)) (define delta (preferences:get sym)) - (define style-name (symbol->string sym)) + (define style-name (get-full-style-name tab-name symbol)) (define c (make-object editor-canvas% this #f (list 'hide-hscroll @@ -44,9 +44,9 @@ (super-instantiate ())))) (preferences:add-callback sym (lambda (sym v) - (set-slatex-style sym v) + (set-slatex-style style-name v) #t)) - (set-slatex-style sym delta) + (set-slatex-style style-name delta) (define (make-check name on off) (let* ([c (lambda (check command) (if (send check get-value) @@ -167,10 +167,9 @@ (lambda (x) (is-a? x style-delta%)))) - ; a symbol naming the style and a delta to set it to - (define (set-slatex-style sym delta) + ; a string naming the style and a delta to set it to + (define (set-slatex-style name delta) (let* ([style-list (editor:get-standard-style-list)] - [name (symbol->string sym)] [style (send style-list find-named-style name)]) (if style (send style set-delta delta) @@ -228,9 +227,7 @@ (define (add-staged tab-name symbols/defaults) (let* ((tab-name-symbol (string->symbol tab-name)) (active-pref (get-full-pref-name tab-name "active")) - (current (hash-table-get prefs-table tab-name-symbol (lambda () #f))) - (syms (map (lambda (s/d) (get-full-pref-name tab-name (car s/d))) - symbols/defaults))) + (current (hash-table-get prefs-table tab-name-symbol (lambda () #f)))) (when (eq? 'too-late current) (error 'color-prefs:add-staged "cannot be invoked after the preferences have already been created for this tab.")) @@ -239,11 +236,17 @@ (preferences:add-callback active-pref (lambda (_ on?) (do-active-pref-callbacks tab-name on?)))) - (for-each set-default syms (map cadr symbols/defaults)) - (for-each (lambda (s) - (preferences:set-un/marshall s marshall-style unmarshall-style)) - syms) - (for-each set-slatex-style syms (map preferences:get syms)) + (for-each (lambda (s/d) + (set-default (get-full-pref-name tab-name (car s/d)) (cadr s/d))) + symbols/defaults) + (for-each (lambda (s/d) + (preferences:set-un/marshall (get-full-pref-name tab-name (car s/d)) + marshall-style unmarshall-style)) + symbols/defaults) + (for-each (lambda (s/d) + (set-slatex-style (get-full-style-name tab-name (car s/d)) + (preferences:get (get-full-pref-name tab-name (car s/d))))) + symbols/defaults) (hash-table-put! prefs-table tab-name-symbol (append (if current current null) symbols/defaults)) diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss index dc52b64c..10e5a793 100644 --- a/collects/framework/private/main.ss +++ b/collects/framework/private/main.ss @@ -17,7 +17,8 @@ [group : framework:group^] [handler : framework:handler^] [editor : framework:editor^] - [color-prefs : framework:color-prefs^]) + [color-prefs : framework:color-prefs^] + [scheme : framework:scheme^]) (application-preferences-handler (lambda () (preferences:show-dialog))) @@ -216,5 +217,5 @@ (preferences:set 'framework:file-dialogs 'std) (preferences:set 'framework:exit-when-no-frames #t) - + (scheme:add-coloring-preferences-panel) (void)))) diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss index 2370f010..7cd5ce2b 100644 --- a/collects/framework/private/scheme.ss +++ b/collects/framework/private/scheme.ss @@ -257,21 +257,30 @@ ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ;;; ;;; ;;; ;;; ;; ; ;; ;;; ; ;;; ;;; ;; ;; ;;; - + ;; This adds the preferences that scheme:text% needs for coloring ;; It returns a thunk that, when invoked will setup the panel in the ;; preferences dialog. - (define add-coloring-preferences-panel - (color-prefs:add-staged - "Scheme" - `((symbol ,(color-prefs:make-style-delta "navy" #f #f #f)) - (keyword ,(color-prefs:make-style-delta "navy" #f #f #f)) - (comment ,(color-prefs:make-style-delta (make-object color% 0 105 255) #f #f #f)) - (string ,(color-prefs:make-style-delta "ForestGreen" #f #f #f)) - (constant ,(color-prefs:make-style-delta (make-object color% 51 135 39) #f #f #f)) - (parenthesis ,(color-prefs:make-style-delta "brown" #f #f #f)) - (error ,(color-prefs:make-style-delta "red" #f #f #f)) - (other ,(color-prefs:make-style-delta "black" #f #f #f))))) + ;; It uses the set! trick because it needs to not call add-staged + ;; until the preferences has been turned on in main.ss + (define add-coloring-pref-state #f) + (define (add-coloring-preferences-panel) + (cond + (add-coloring-pref-state + (add-coloring-pref-state)) + (else + (set! add-coloring-pref-state + (color-prefs:add-staged + "Scheme" + `((symbol ,(color-prefs:make-style-delta "navy" #f #f #f)) + (keyword ,(color-prefs:make-style-delta "navy" #f #f #f)) + (comment ,(color-prefs:make-style-delta (make-object color% 0 105 255) #f #f #f)) + (string ,(color-prefs:make-style-delta "ForestGreen" #f #f #f)) + (constant ,(color-prefs:make-style-delta (make-object color% 51 135 39) #f #f #f)) + (parenthesis ,(color-prefs:make-style-delta "brown" #f #f #f)) + (error ,(color-prefs:make-style-delta "red" #f #f #f)) + (other ,(color-prefs:make-style-delta "black" #f #f #f)))))))) + ;; for check syntax (to be moved elsewhere) (color-prefs:add-staged