remove the restriction that new preferences can be registered only before a snapshot is grabbed

also improve the docs a little bit and some Rackety

gui-lib/framework/preferences.rkt

@@ -58,8 +58,7 @@ the state transitions / contracts are:
 (define (pref-un/marshall-set? pref) (hash-has-key? marshall-unmarshall pref))
 (define (preferences:default-set? pref) (hash-has-key? defaults pref))
 (define (pref-can-init? pref)
-  (and (not snapshot-grabbed?)
+  (not (hash-has-key? preferences pref)))
-       (not (hash-has-key? preferences pref))))
 
 ;; type un/marshall = (make-un/marshall (any -> prinable) (printable -> any))
 (define-struct un/marshall (marshall unmarshall))
@@ -343,9 +342,7 @@ the state transitions / contracts are:
           value))))
   
 (define-struct preferences:snapshot (x))
-(define snapshot-grabbed? #f)
 (define (preferences:get-prefs-snapshot)
-  (set! snapshot-grabbed? #t)
   (make-preferences:snapshot 
    (hash-map defaults 
              (λ (k v) (cons k (copy-pref-value k (preferences:get k)))))))
@@ -374,12 +371,12 @@ the state transitions / contracts are:
   (symbol value)
   @{Sets the preference
     @racket[symbol] to @racket[value]. It should be called when the
-    users requests a change to a preference.
+    user requests a change to a preference.
     
     @racket[preferences:set] immediately writes the preference value to disk.    
     It raises an exception matching
     @racket[exn:unknown-preference?]
-    if the preference's default has not been set.
+    if the preference's default has not been set
     
     See also @racket[preferences:set-default].})
 
@@ -419,7 +416,8 @@ the state transitions / contracts are:
     
     This function raises an exception matching
     @racket[exn:unknown-preference?]
-    if the preference has not been set.})
+    if the preference default has not been set via
+    @racket[preferences:set-default].})
  (proc-doc/names
   preferences:set-default
   (->* (symbol? any/c (any/c . -> . any))
@@ -437,6 +435,8 @@ the state transitions / contracts are:
     
     This sets the default value of the preference @racket[symbol] to
     @racket[value]. If the user has chosen a different setting,
+    (reflected via a call to @racket[preferences:set], possibly
+    in a different run of your program),
     the user's setting will take precedence over the default value.
     
     The @racket[test] argument is used as a safeguard. That function is
@@ -450,7 +450,11 @@ the state transitions / contracts are:
     expected to be a list of symbols that correspond to old versions
     of the preferences. It defaults to @racket['()]. If @racket[rewrite-aliases]
     is present, it is used to adjust the old values of the preferences
-    when they are present in the saved file.})
+    when they are present in the saved file.
+
+    @history[#:changed "1.23" @list{Allow @racket[preferences:set-default]
+               to be called even after a snapshot has been grabbed.}]
+ })
  
  (proc-doc/names
   preferences:default-set?
@@ -566,7 +570,9 @@ the state transitions / contracts are:
   preferences:restore-prefs-snapshot 
   (-> preferences:snapshot? void?)
   (snapshot)
-  @{Restores the preferences saved in @racket[snapshot].
+  @{Restores the preferences saved in @racket[snapshot], updating
+    all of the preferences values to the ones they had at the time
+    that @racket[preferences:get-prefs-snapshot] was called.
     
     See also @racket[preferences:get-prefs-snapshot].})
  
@@ -574,7 +580,7 @@ the state transitions / contracts are:
   preferences:get-prefs-snapshot 
   (-> preferences:snapshot?)
   ()
-  @{Caches all of the current values of the preferences and returns them.
+  @{Caches all of the current values of the known preferences and returns them.
     For any preference that has marshalling and unmarshalling set
     (see @racket[preferences:set-un/marshall]), the preference value is
     copied by passing it through the marshalling and unmarshalling process.

gui-lib/framework/private/preferences.rkt

@@ -502,52 +502,55 @@ the state transitions / contracts are:
                               'framework:line-spacing-add-gap?
                               (string-constant add-spacing-between-lines))
                    
-                   (let ([hp (new horizontal-panel% [parent editor-panel] [stretchable-height #f])]
+                   (add-number editor-panel
-                         [init-pref (preferences:get 'framework:column-guide-width)])
+                               'framework:column-guide-width
-                     (define on-cb
+                               (string-constant maximum-char-width-guide-pref-check-box)
-                       (new check-box% 
+                               (λ (n) (and (exact-integer? n) (>= n 2))))
-                            [parent hp]
-                            [label (string-constant maximum-char-width-guide-pref-check-box)]
-                            [value (car init-pref)]
-                            [callback
-                             (λ (x y)
-                               (update-pref)
-                               (update-tf-bkg)
-                               (send tf enable (send on-cb get-value)))]))
-                     (define tf 
-                       (new text-field%
-                            [label #f]
-                            [parent hp]
-                            [init-value (format "~a" (cadr init-pref))]
-                            [callback
-                             (λ (x y)
-                               (update-pref)
-                               (update-tf-bkg))]))
-                     (define (update-tf-bkg)
-                       (send tf set-field-background
-                             (send the-color-database find-color 
-                                   (cond
-                                     [(not (send on-cb get-value)) "gray"]
-                                     [(good-val? (string->number (send tf get-value)))
-                                      "white"]
-                                     [else
-                                      "yellow"]))))
-                     (define (good-val? n)
-                       (and (exact-integer? n)
-                            (>= n 2)))
-                     (define (update-pref)
-                       (define current (preferences:get 'framework:column-guide-width))
-                       (define candidate-num (string->number (send tf get-value)))
-                       (preferences:set 'framework:column-guide-width
-                                        (list (send on-cb get-value)
-                                              (if (good-val? candidate-num)
-                                                  candidate-num
-                                                  (cadr current)))))
-                     (update-tf-bkg))
                    
                    (editor-panel-procs editor-panel))))])
       (add-editor-checkbox-panel)))
 
+(define (add-number editor-panel pref-name label good-val?)
+  (define hp (new horizontal-panel% [parent editor-panel] [stretchable-height #f]))
+  (define init-pref (preferences:get pref-name))
+  (define on-cb
+    (new check-box% 
+         [parent hp]
+         [label label]
+         [value (car init-pref)]
+         [callback
+          (λ (x y)
+            (update-pref)
+            (update-tf-bkg)
+            (send tf enable (send on-cb get-value)))]))
+  (define tf 
+    (new text-field%
+         [label #f]
+         [parent hp]
+         [init-value (format "~a" (cadr init-pref))]
+         [callback
+          (λ (x y)
+            (update-pref)
+            (update-tf-bkg))]))
+  (define (update-tf-bkg)
+    (send tf set-field-background
+          (send the-color-database find-color 
+                (cond
+                  [(not (send on-cb get-value)) "gray"]
+                  [(good-val? (string->number (send tf get-value)))
+                   "white"]
+                  [else
+                   "yellow"]))))
+  (define (update-pref)
+    (define current (preferences:get pref-name))
+    (define candidate-num (string->number (send tf get-value)))
+    (preferences:set pref-name
+                     (list (send on-cb get-value)
+                           (if (good-val? candidate-num)
+                               candidate-num
+                               (cadr current)))))
+  (update-tf-bkg))
+
 (define (add-general-checkbox-panel) (add-general-checkbox-panel/real))
 (define (add-general-checkbox-panel/real)
   (set! add-general-checkbox-panel/real void)

gui-lib/info.rkt

@@ -12,7 +12,7 @@
                "pict-lib"
                "scheme-lib"
                "scribble-lib"
-               "string-constants-lib"
+               ["string-constants-lib" #:version "1.7"]
                "option-contract-lib"
                "2d-lib"
                "compatibility-lib"
@@ -30,4 +30,4 @@
 
 (define pkg-authors '(mflatt robby))
 
-(define version "1.22")
+(define version "1.23")