diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index 775889e8..879b41a1 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -1310,6 +1310,17 @@ "Installs the ``Scheme'' preferences panel in the ``Syntax Coloring''" "section.") + (editor:set-standard-style-list-delta + (string? (is-a?/c style-delta%) . -> . void?) + (name delta) + "Finds (or creates) the style named by \\var{name} in" + "the result of " + "@flink editor:get-standard-style-list" + "and sets its delta to \\var{delta}." + "" + "If the style named by \\var{name} is already in" + "the style list, it must be a delta style.") + (editor:set-standard-style-list-pref-callbacks (-> any) () diff --git a/collects/framework/private/color-prefs.ss b/collects/framework/private/color-prefs.ss index 63bdcfe7..496e7829 100644 --- a/collects/framework/private/color-prefs.ss +++ b/collects/framework/private/color-prefs.ss @@ -33,6 +33,7 @@ ;; build-color-selection-panel : (is-a?/c area-container<%>) symbol string string -> void ;; constructs a panel containg controls to configure the preferences panel. + ;; BUG: style changes don't update the check boxes. (define (build-color-selection-panel parent pref-sym style-name example-text) (define hp (new horizontal-panel% (parent parent) (style '(border)))) (define delta (preferences:get pref-sym)) @@ -111,9 +112,9 @@ (preferences:add-callback pref-sym (lambda (sym v) - (set-slatex-style style-name v) + (editor:set-standard-style-list-delta style-name v) #t)) - (set-slatex-style style-name delta) + (editor:set-standard-style-list-delta style-name delta) (send c set-editor e) (send e insert example-text) @@ -182,17 +183,6 @@ (lambda (x) (is-a? x style-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)] - [style (send style-list find-named-style name)]) - (if style - (send style set-delta delta) - (send style-list new-named-style name - (send style-list find-or-create-style - (send style-list find-named-style "Standard") - delta))))) - (define (make-style-delta color bold? underline? italic?) (let ((sd (make-object style-delta%))) (send sd set-delta-foreground color) @@ -326,8 +316,9 @@ 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))))) + (editor:set-standard-style-list-delta + (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 diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index d425388b..0eafe630 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -371,6 +371,17 @@ (unless (member (preferences:get 'framework:standard-style-list:font-name) (get-face-list 'mono)) (preferences:set 'framework:standard-style-list:font-name (get-family-builtin-face 'modern)))) + ;; set-standard-style-list-delta : string (is-a?/c style-delta<%>) -> void + (define (set-standard-style-list-delta name delta) + (let* ([style-list (editor:get-standard-style-list)] + [style (send style-list find-named-style name)]) + (if style + (send style set-delta delta) + (send style-list new-named-style name + (send style-list find-or-create-style + (send style-list find-named-style "Standard") + delta))))) + (define -keymap<%> (interface (basic<%>) get-keymaps)) (define keymap-mixin (mixin (basic<%>) (-keymap<%>) diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index a5099b95..b194fd99 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -270,7 +270,8 @@ backup-autosave-mixin)) (define-signature framework:editor-fun^ (get-standard-style-list - set-standard-style-list-pref-callbacks)) + set-standard-style-list-pref-callbacks + set-standard-style-list-delta)) (define-signature framework:editor^ ((open framework:editor-class^) (open framework:editor-fun^)))