..

original commit: a2d3b09e8838025abc5635c489ff66481ef8aa0a

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)
      ()

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

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

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^)))