add preference layers

gui-lib/framework/preferences.rkt

@@ -21,14 +21,17 @@ the state transitions / contracts are:
   set-un/marshall(true, false, true) -> (true, true, true)
   .. otherwise error
 
-  for all syms: 
+  for all syms:
-   prefs-snapshot(_, _, _) -> (_, _, false) 
+   prefs-snapshot(_, _, _) -> (_, _, false)
 
 |#
 
 (require scribble/srcdoc
          racket/contract/base racket/file)
-(require/doc racket/base scribble/manual (for-label racket/serialize))
+(require/doc racket/base
+             scribble/manual
+             scribble/example
+             (for-label racket/serialize))
 
 (define-struct (exn:unknown-preference exn) ())
 
@@ -42,23 +45,31 @@ the state transitions / contracts are:
 (define (add-pref-prefix p) (string->symbol (format "plt:framework-pref:~a" p)))
 
 ;; preferences : hash-table[sym -o> any]
-;; the current values of the preferences
+;;   the current values of the preferences
-(define preferences (make-hasheq))
-
 ;; marshall-unmarshall : sym -o> un/marshall
-(define marshall-unmarshall (make-hasheq))
-
 ;; callbacks : sym -o> (listof (sym TST -> boolean))
-(define callbacks (make-hasheq))
-
 ;; defaults : hash-table[sym -o> default]
-(define defaults (make-hasheq))
+(struct preferences:layer (preferences marshall-unmarshall callbacks defaults prev))
 
-;; these four functions determine the state of a preference
+(define (preferences:new-layer prev)
-(define (pref-un/marshall-set? pref) (hash-has-key? marshall-unmarshall pref))
+  (preferences:layer (make-hasheq) (make-hasheq) (make-hasheq) (make-hasheq) prev))
-(define (preferences:default-set? pref) (hash-has-key? defaults pref))
+(define preferences:current-layer (make-parameter (preferences:new-layer #f)))
-(define (pref-can-init? pref)
+
-  (not (hash-has-key? preferences pref)))
+(define (find-layer pref)
+  (let loop ([pref-state (preferences:current-layer)])
+    (and pref-state
+         (cond
+           [(hash-has-key? (preferences:layer-defaults pref-state) pref)
+            pref-state]
+           [(hash-has-key? (preferences:layer-callbacks pref-state) pref)
+            pref-state]
+           [else
+            (loop (preferences:layer-prev pref-state))]))))
+
+(define (preferences:default-set? pref)
+  (define layer (find-layer pref))
+  (and layer
+       (hash-has-key? (preferences:layer-defaults layer) pref)))
 
 ;; type un/marshall = (make-un/marshall (any -> prinable) (printable -> any))
 (define-struct un/marshall (marshall unmarshall))
@@ -80,45 +91,53 @@ the state transitions / contracts are:
 ;; return the current value of the preference `p'
 ;; exported
 (define (preferences:get p)
+  (define pref-state (find-layer p))
+  (when (or (not pref-state)
+            (not (hash-has-key? (preferences:layer-defaults pref-state) p)))
+    (raise-unknown-preference-error
+     'preferences:get
+     "tried to get a preference but no default set for ~e"
+     p))
+  (define preferences (preferences:layer-preferences pref-state))
   (define v (hash-ref preferences p none))
   (cond
-    ;; if this is found, we can just return it immediately
-    [(not (eq? v none))
-     v]
     ;; first time reading this, check the file & unmarshall value, if
     ;; it's not there, use the default
-    [(preferences:default-set? p)
+    [(eq? v none)
-     (let* (;; try to read the preference from the preferences file
+     (define defaults (preferences:layer-defaults pref-state))
-            [v (read-pref-from-file p)]
+     ;; try to read the preference from the preferences file
-            [v (if (eq? v none)
+     (define marshalled-v (read-pref-from-file (hash-ref defaults p) p))
-                 ;; no value read, take the default value
+     (define default-info (hash-ref defaults p))
-                 (default-value (hash-ref defaults p))
+     (define the-default-value (default-value default-info))
-                 ;; found a saved value, unmarshall it
+     (define v (if (eq? marshalled-v none)
-                 (unmarshall-pref p v))])
+                   ;; no value read, take the default value
-       ;; set the value for future reference and return it
+                   the-default-value
-       (hash-set! preferences p v)
+                   ;; found a saved value, unmarshall it
-       v)]
+                   (unmarshall-pref pref-state p marshalled-v
-    [(not (preferences:default-set? p))
+                                    (default-checker default-info)
-     (raise-unknown-preference-error
+                                    the-default-value)))
-      'preferences:get
+     ;; set the value in the preferences table for easier reference
-      "tried to get a preference but no default set for ~e"
+     ;; and so we know it has been read from the disk
-      p)]))
+     ;; (and thus setting the marshaller after this is no good)
+     (hash-set! preferences p v)
+     v]
+    ;; oth. it is found, so we can just return it
+    [else v]))
 
 ;; read-pref-from-file : symbol -> (or/c any none)
 ;; reads the preference saved in the low-level preferences
 ;; file, first checking 'p' and then checking the aliases (in order)
-(define (read-pref-from-file p)
+(define (read-pref-from-file defaults p)
-  (let ([defaults (hash-ref defaults p)])
+  (let loop ([syms (cons p (default-aliases defaults))]
-    (let loop ([syms (cons p (default-aliases defaults))]
+             [rewriters (cons values (default-rewrite-aliases defaults))])
-               [rewriters (cons values (default-rewrite-aliases defaults))])
+    (cond
-      (cond
+      [(null? syms) none]
-        [(null? syms) none]
+      [else
-        [else
+       (let/ec k
-         (let/ec k
+         ((car rewriters)
-           ((car rewriters)
+          ((preferences:low-level-get-preference)
-            ((preferences:low-level-get-preference)
+           (add-pref-prefix (car syms))
-             (add-pref-prefix (car syms))
+           (lambda () (k (loop (cdr syms) (cdr rewriters)))))))])))
-             (lambda () (k (loop (cdr syms) (cdr rewriters)))))))]))))
 
 ;; set : symbol any -> void
 ;; updates the preference
@@ -130,40 +149,40 @@ the state transitions / contracts are:
 ;; exported
 (define (multi-set ps values)
   (dynamic-wind
-   (λ () 
+   (λ ()
      (call-pref-save-callbacks #t))
    (λ ()
-     (for-each
+     (for ([p (in-list ps)]
-      (λ (p value)
+           [value (in-list values)])
-        (cond
+       (define pref-state (find-layer p))
-          [(preferences:default-set? p)
+       (cond
-           (define default (hash-ref defaults p))
+         [pref-state
-           (define checker? (default-checker default))
+          (define default (hash-ref (preferences:layer-defaults pref-state) p))
-           (unless (checker? value)
+          (define checker? (default-checker default))
-             (error 'preferences:set
+          (unless (checker? value)
-                    (string-append
+            (error 'preferences:set
-                     "new value doesn't satisfy preferences:set-default predicate\n"
+                   (string-append
-                     "  pref sym: ~v\n"
+                    "new value doesn't satisfy preferences:set-default predicate\n"
-                     "  given: ~e\n"
+                    "  pref symbol: ~e\n"
-                     "  predicate: ~e")
+                    "  given: ~e\n"
-                     p value checker?))
+                    "  predicate: ~e")
-             (check-callbacks p value)
+                   p value checker?))
-             (hash-set! preferences p value)]
+          (check-callbacks pref-state p value)
-          [(not (preferences:default-set? p))
+          (hash-set! (preferences:layer-preferences pref-state) p value)]
-           (raise-unknown-preference-error
+         [else
-            'preferences:set
+          (raise-unknown-preference-error
-            (string-append
+           'preferences:set
-             "cannot set preference before setting default"
+           (string-append
-             "  pref sym: ~e\n"
+            "cannot set preference before setting default"
-             "  given: ~e")
+            "  pref symbol: ~e\n"
-            p
+            "  given: ~e")
-            value)]))
+           p
-      ps values)
+           value)]))
      ((preferences:low-level-put-preferences)
       (map add-pref-prefix ps)
-      (map (λ (p value) (marshall-pref p value))
+      (for/list ([p (in-list ps)]
-           ps
+                 [value (in-list values)])
-           values))
+        (marshall-pref p value)))
      (void))
    (λ ()
      (call-pref-save-callbacks #f))))
@@ -201,38 +220,41 @@ the state transitions / contracts are:
           (current-continuation-marks))))
 
 ;; add-callback : sym (-> void) -> void
-(define preferences:add-callback 
+(define (preferences:add-callback p callback [weak? #f])
-  (lambda (p callback [weak? #f])
+  (define pref-state (or (find-layer p) (preferences:current-layer)))
-    (let ([new-cb (make-pref-callback (if weak?
+  (define callbacks (preferences:layer-callbacks pref-state))
-                                          (impersonator-ephemeron callback)
+  (define new-cb
-                                          callback))])
+    (make-pref-callback (if weak?
-      (hash-set! callbacks
+                            (impersonator-ephemeron callback)
-                 p 
+                            callback)))
-                 (append 
+  (hash-set! callbacks
-                  (hash-ref callbacks p '())
+             p
-                  (list new-cb)))
+             (append
-      (λ ()
+              (hash-ref callbacks p '())
-        (hash-set!
+              (list new-cb)))
-         callbacks
+  (λ ()
-         p
+    (hash-set!
-         (let loop ([callbacks (hash-ref callbacks p '())])
+     callbacks
-           (cond
+     p
-             [(null? callbacks) '()]
+     (let loop ([callbacks (hash-ref callbacks p '())])
-             [else 
+       (cond
-              (let ([callback (car callbacks)])
+         [(null? callbacks) '()]
-                (cond
+         [else
-                  [(eq? callback new-cb)
+          (let ([callback (car callbacks)])
-                   (loop (cdr callbacks))]
+            (cond
-                  [else
+              [(eq? callback new-cb)
-                   (cons (car callbacks) (loop (cdr callbacks)))]))])))))))
+               (loop (cdr callbacks))]
+              [else
+               (cons (car callbacks) (loop (cdr callbacks)))]))])))))
 
-;; check-callbacks : sym val -> void
+;; check-callbacks : pref-state sym val -> void
-(define (check-callbacks p value)
+(define (check-callbacks pref-state p value)
+  (define callbacks (preferences:layer-callbacks pref-state))
   (define new-callbacks
     (let loop ([callbacks (hash-ref callbacks p '())])
       (cond
         [(null? callbacks) null]
-        [else 
+        [else
          (define callback (car callbacks))
          (define cb (pref-callback-cb callback))
          (cond
@@ -252,106 +274,137 @@ the state transitions / contracts are:
       (hash-set! callbacks p new-callbacks)))
 
 (define (preferences:set-un/marshall p marshall unmarshall)
+  (define pref-state (find-layer p))
   (cond
-    [(and (preferences:default-set? p)
+    [pref-state
-          (not (pref-un/marshall-set? p))
+     (define marshall-unmarshall (preferences:layer-marshall-unmarshall pref-state))
-          (pref-can-init? p))
+     (define pref-un/marshall-set? (hash-ref marshall-unmarshall p #f))
-     (hash-set! marshall-unmarshall p (make-un/marshall marshall unmarshall))]
+     (define pref-can-init? (not (hash-has-key? (preferences:layer-preferences pref-state) p)))
-    [(not (preferences:default-set? p))
+     (cond
+       [(and (not pref-un/marshall-set?) pref-can-init?)
+        (hash-set! marshall-unmarshall p (make-un/marshall marshall unmarshall))]
+       [pref-un/marshall-set?
+        (error 'preferences:set-un/marshall
+               "already set un/marshall for ~e"
+               p)]
+       [(not pref-can-init?)
+        (error 'preferences:set-un/marshall "the preference ~e cannot be configured any more" p)])]
+    [else
      (error 'preferences:set-un/marshall
-            "must call set-default for ~s before calling set-un/marshall for ~s"
+            "must call preferences:set-default for ~s before calling set-un/marshall for ~s"
-            p p)]
+            p p)]))
-    [(pref-un/marshall-set? p)
-     (error 'preferences:set-un/marshall
-            "already set un/marshall for ~e" 
-            p)]
-    [(not (pref-can-init? p))
-     (error 'preferences:set-un/marshall "the preference ~e cannot be configured any more" p)]))
-
-(define (preferences:restore-defaults)
-  (hash-for-each
-   defaults
-   (λ (p def) (preferences:set p (default-value def)))))
 
 ;; set-default : (sym TST (TST -> boolean) -> void
-(define (preferences:set-default p default-value checker 
+(define (preferences:set-default p default-value checker
                                  #:aliases [aliases '()]
-                                 #:rewrite-aliases [rewrite-aliases (map (lambda (x) values) aliases)])
+                                 #:rewrite-aliases [rewrite-aliases (map (λ (x) values) aliases)])
-  (cond
+  (define pref-state (or (find-layer p) (preferences:current-layer)))
-    [(and (not (preferences:default-set? p))
+  (define defaults (preferences:layer-defaults pref-state))
-          (pref-can-init? p))
+  (when (hash-has-key? defaults p)
-     (define default-okay? (checker default-value))
+    (error 'preferences:set-default
-     (unless default-okay?
+           (string-append
-       (error 'set-default 
+            "preferences default already set\n"
-              (string-append
+            "  pref symbol: ~e\n"
-               "checker doesn't match default\n"
+            "  default: ~e\n"
-               "  default: ~e\n"
+            "  checker: ~e")
-               "  pref sym: ~e\n"
+           p default-value checker))
-               "  checker: ~e")
+  (unless (checker default-value)
-              p default-value checker))
+    (error 'preferences:set-default
-
+           (string-append
-     (unless (= (length aliases) (length rewrite-aliases))
+            "checker doesn't match default\n"
-       (error 'preferences:set-default 
+            "  pref symbol: ~e\n"
-	      "expected equal length lists for the #:aliases and #:rewrite-aliases arguments, got ~e and ~e"
+            "  default: ~e\n"
-	      aliases rewrite-aliases))
+            "  checker: ~e")
-     (hash-set! defaults p (make-default default-value checker aliases rewrite-aliases))]
+           p default-value checker))
-    [(not (pref-can-init? p))
+  (unless (= (length aliases) (length rewrite-aliases))
-     (error 'preferences:set-default
+    (error 'preferences:set-default
-            "tried to call set-default for preference ~e but it cannot be configured any more"
+           (string-append
-            p)]
+            "expected equal length lists for the #:aliases"
-    [(preferences:default-set? p)
+            " and #:rewrite-aliases arguments, got ~e and ~e")
-     (error 'preferences:set-default
+           aliases rewrite-aliases))
-            "preferences default already set for ~e" p)]
+  (hash-set! defaults p (make-default default-value checker aliases rewrite-aliases)))
-    [(not (pref-can-init? p))
-     (error 'preferences:set-default
-            "can no longer set the default for ~e" p)]))
 
 ;; marshall-pref : symbol any -> (list symbol printable)
 (define (marshall-pref p value)
+  (define pref-state (find-layer p))
   (let/ec k
-    (let* ([marshaller
+    (define marshaller
-            (un/marshall-marshall
+      (un/marshall-marshall
-             (hash-ref marshall-unmarshall p (λ () (k value))))])
+       (hash-ref (preferences:layer-marshall-unmarshall pref-state)
-      (marshaller value))))
+                 p
+                 (λ () (k value)))))
+    (marshaller value)))
 
-;; unmarshall-pref : symbol marshalled -> any
+;; unmarshall-pref : pref-state symbol marshalled (any -> bool) any -> any
 ;; unmarshalls a preference read from the disk
-(define (unmarshall-pref p data)
+(define (unmarshall-pref pref-state p data the-checker the-default-value)
-  (let* ([un/marshall (hash-ref marshall-unmarshall p #f)]
+  (define marshall-unmarshall (preferences:layer-marshall-unmarshall pref-state))
-         [result (if un/marshall
+  (define un/marshall (hash-ref marshall-unmarshall p #f))
-                     ((un/marshall-unmarshall un/marshall) data)
+  (define result
-                     data)]
+    (if un/marshall
-         [default (hash-ref defaults p)])
+        ((un/marshall-unmarshall un/marshall) data)
-    (if ((default-checker default) result)
+        data))
-        result
+  (if (the-checker result)
-        (default-value default))))
+      result
+      the-default-value))
 
 ;; copy-pref-value : sym any -> any
 ;; uses the marshalling code to copy a preference. If there
 ;; is not marshaller set, then no copying happens.
 (define (copy-pref-value p value)
   (let/ec k
-    (let* ([un/marshaller (hash-ref marshall-unmarshall p (λ () (k value)))]
+    (define pref-state (find-layer p))
-           [default (hash-ref defaults p)]
+    (define marshall-unmarshall (preferences:layer-marshall-unmarshall pref-state))
-           [marsh (un/marshall-marshall un/marshaller)]
+    (define un/marshaller (hash-ref marshall-unmarshall p (λ () (k value))))
-           [unmarsh (un/marshall-unmarshall un/marshaller)]
+    (define default (hash-ref (preferences:layer-defaults pref-state) p))
-           [marshalled (marsh value)]
+    (define marsh (un/marshall-marshall un/marshaller))
-           [copy (unmarsh marshalled)])
+    (define unmarsh (un/marshall-unmarshall un/marshaller))
-      (if ((default-checker default) copy)
+    (define marshalled (marsh value))
-          copy
+    (define copy (unmarsh marshalled))
-          value))))
+    (if ((default-checker default) copy)
-  
+        copy
+        value)))
+
+(define (preferences:restore-defaults)
+  (let loop ([prefs-state (preferences:current-layer)])
+    (when prefs-state
+      (for ([(p def) (in-hash (preferences:layer-defaults prefs-state))])
+        (preferences:set p (default-value def)))
+      (loop (preferences:layer-prev prefs-state)))))
+
 (define-struct preferences:snapshot (x))
 (define (preferences:get-prefs-snapshot)
-  (make-preferences:snapshot 
+  (make-preferences:snapshot
-   (hash-map defaults 
+   (let loop ([prefs-state (preferences:current-layer)]
-             (λ (k v) (cons k (copy-pref-value k (preferences:get k)))))))
+              [sofar '()])
+     (cond
+       [prefs-state
+        (loop (preferences:layer-prev prefs-state)
+              (for/fold ([sofar sofar])
+                        ([(k def) (in-hash (preferences:layer-defaults prefs-state))])
+                (cons (cons k (copy-pref-value (preferences:get k)))
+                      sofar)))]
+       [else sofar]))))
 
 (define (preferences:restore-prefs-snapshot snapshot)
   (multi-set (map car (preferences:snapshot-x snapshot))
              (map cdr (preferences:snapshot-x snapshot)))
   (void))
 
+(begin-for-doc
+  (define pref-layer-eval (make-base-eval))
+  (pref-layer-eval
+   '(begin
+      (require framework/preferences)
+      (let ([the-prefs-table (make-hash)])
+        (preferences:low-level-put-preferences
+         (λ (syms vals)
+           (for ([sym (in-list syms)]
+                 [val (in-list vals)])
+             (hash-set! the-prefs-table sym val))))
+        (preferences:low-level-get-preference
+         (λ (sym [fail void])
+           (hash-ref the-prefs-table sym fail)))))))
 
 (provide/doc
  (proc-doc/names
@@ -359,7 +412,7 @@ the state transitions / contracts are:
   (symbol? . -> . any/c)
   (symbol)
   @{See also @racket[preferences:set-default].
-        
+
         @racket[preferences:get] returns the value for the preference
         @racket[symbol]. It raises an exception matching
         @racket[exn:unknown-preference?]
@@ -372,12 +425,12 @@ the state transitions / contracts are:
   @{Sets the preference
     @racket[symbol] to @racket[value]. It should be called when the
     user requests a change to a preference.
-    
+
-    @racket[preferences:set] immediately writes the preference value to disk.    
+    @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
-    
+
     See also @racket[preferences:set-default].})
 
  (proc-doc/names
@@ -389,10 +442,10 @@ the state transitions / contracts are:
     applied to one argument updates the preference named @racket[pref].
 
     @history[#:added "1.18"]{}})
- 
+
  (proc-doc/names
   preferences:add-callback
-  (->* (symbol? (-> symbol? any/c any)) 
+  (->* (symbol? (-> symbol? any/c any))
        (boolean?)
        (-> void?))
   ((p f)
@@ -401,19 +454,23 @@ the state transitions / contracts are:
     preference and its value, when the preference changes.
     @racket[preferences:add-callback] returns a thunk, which when
     invoked, removes the callback from this preference.
-    
+
     If @racket[weak?] is true, the preferences system will only hold on to
     the callback
     @tech[#:key "weak references"
           #:doc '(lib "scribblings/reference/reference.scrbl")]{weakly}.
-    
+
     The callbacks will be called in the order in which they were added.
-    
+
     If you are adding a callback for a preference that requires
     marshalling and unmarshalling, you must set the marshalling and
     unmarshalling functions by calling
     @racket[preferences:set-un/marshall] before adding a callback.
-    
+
+    The result thunk removes the callback from the same @tech{preferences layer}
+    that @racket[p] was in when @racket[preferences:add-callback] was
+    originally called.
+
     This function raises an exception matching
     @racket[exn:unknown-preference?]
     if the preference default has not been set via
@@ -429,16 +486,16 @@ the state transitions / contracts are:
   @{This function must be called every time your application starts up, before
     any call to @racket[preferences:get] or @racket[preferences:set]
     (for any given preference).
-    
+
     If you use @racket[preferences:set-un/marshall],
     you must call this function before calling it.
-    
+
     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
     called to determine if a preference read in from a file is a valid
     preference. If @racket[test] returns @racket[#t], then the preference is
@@ -446,7 +503,7 @@ the state transitions / contracts are:
     used.
 
     The @racket[aliases] and @racket[rewrite-aliases] arguments aids
-    in renaming preferences. If @racket[aliases] is present, it is 
+    in renaming preferences. If @racket[aliases] is present, it is
     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
@@ -455,7 +512,7 @@ the state transitions / contracts are:
     @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?
   (-> symbol? boolean?)
@@ -477,107 +534,113 @@ the state transitions / contracts are:
     into its internal representation. If @racket[preferences:set-un/marshall]
     is never called for a particular preference, the values of that
     preference are assumed to be printable.
-    
+
     If the unmarshalling function returns a value that does not meet the
     guard passed to @racket[preferences:set-default]
     for this preference, the default value is used.
-    
+
     The @racket[marshall] function might be called with any value returned
-    from @racket[read] and it must not raise an error 
+    from @racket[read] and it must not raise an error
     (although it can return arbitrary results if it gets bad input). This might
     happen when the preferences file becomes corrupted, or is edited
     by hand.
-    
+
     @racket[preferences:set-un/marshall] must be called before calling
     @racket[preferences:get],@racket[preferences:set].
 
     See also @racket[serialize] and @racket[deserialize].
    })
- 
+
  (proc-doc/names
   preferences:restore-defaults
   (-> void?)
   ()
   @{@racket[(preferences:restore-defaults)] restores the users' configuration
     to the default preferences.})
- 
+
  (proc-doc/names
   preferences:register-save-callback
   (-> (-> boolean? any) symbol?)
   (callback)
-  @{Registers @racket[callback] to run twice for each call to @racket[preferences:set]---once 
+  @{Registers @racket[callback] to run twice for each call
-              before the preferences file is written, with @racket[#t], and once after it is written, with
+ to @racket[preferences:set]---once before the preferences
-              @racket[#f]. Registration returns a key for use with @racket[preferences:unregister-save-callback]. 
+ file is written, with @racket[#t], and once after it is
-              Caveats:
+ written, with @racket[#f]. Registration returns a key for
-              @itemize{@item{The callback occurs on whichever thread happened to call @racket[preferences:set].}
+ use with @racket[preferences:unregister-save-callback].
-                       @item{Pre- and post-write notifications are not necessarily paired; unregistration
+ Caveats: @itemize{
-                             may cancel the post-write notification before it occurs.}}})
+  @item{The callback occurs on whichever
- 
+   thread happened to call @racket[preferences:set].
+  }
+  @item{
+   Pre- and post-write notifications are not necessarily
+   paired; unregistration may cancel the post-write
+   notification before it occurs.}}})
+
  (proc-doc/names
   preferences:unregister-save-callback
   (-> symbol? void?)
   (key)
   @{Unregisters the save callback associated with @racket[key].})
- 
+
  (proc-doc/names
-  exn:make-unknown-preference 
+  exn:make-unknown-preference
   (string? continuation-mark-set? . -> . exn:unknown-preference?)
   (message continuation-marks)
   @{Creates an unknown preference exception.})
- 
+
  (proc-doc/names
-  exn:unknown-preference? 
+  exn:unknown-preference?
   (any/c . -> . boolean?)
   (exn)
   @{Determines if a value is an unknown preference exn.})
- 
+
  (thing-doc
   exn:struct:unknown-preference
   struct-type?
   @{The struct type for the unknown preference exn.})
 
- 
+
  (parameter-doc
   preferences:low-level-put-preferences
-  (parameter/c ((listof symbol?) (listof any/c) . -> . any))
+  (parameter/c (-> (listof symbol?) (listof any/c) any))
   put-preferences
   @{This parameter's value is called to save preference the preferences file.
     Its interface should be just like mzlib's @racket[put-preferences].
-    
+
     The default value calls @racket[put-preferences] and, if there is an error,
     then starts using a hash-table to save the preferences instead.
     See also @racket[]})
- 
+
  (parameter-doc
   preferences:low-level-get-preference
   (parameter/c (->* (symbol?) [(-> any)] any))
   get-preference
   @{This parameter's value is called to get a preference from the preferences
     file. Its interface should be just like @racket[get-preference].
-    
+
     The default value calls @racket[get-preferences] and, if there is an error,
     then starts using a hash-table to save the preferences instead.})
-  
+
  (proc-doc/names
-  preferences:snapshot? 
+  preferences:snapshot?
   (-> any/c boolean?)
   (arg)
   @{Determines if its argument is a preferences snapshot.
-    
+
     See also @racket[preferences:get-prefs-snapshot] and
     @racket[preferences:restore-prefs-snapshot].})
  (proc-doc/names
-  preferences:restore-prefs-snapshot 
+  preferences:restore-prefs-snapshot
   (-> preferences:snapshot? void?)
   (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].})
- 
+
  (proc-doc/names
-  preferences:get-prefs-snapshot 
+  preferences:get-prefs-snapshot
   (-> preferences:snapshot?)
   ()
   @{Caches all of the current values of the known preferences and returns them.
@@ -586,4 +649,64 @@ the state transitions / contracts are:
     copied by passing it through the marshalling and unmarshalling process.
     Other values are not copied, but references to them are instead saved.
 
-    See also @racket[preferences:restore-prefs-snapshot].}))
+    See also @racket[preferences:restore-prefs-snapshot].})
+
+ (proc-doc/names
+  preferences:new-layer
+  (-> (or/c #f preferences:layer?) preferences:layer?)
+  (previous-preferences-layer)
+  @{Creates a @tech{preferences layer} that extends @racket[previous-preferences-layer].
+
+  @history[#:added "1.30"]})
+
+ (proc-doc/names
+  preferences:layer?
+  (-> any/c boolean?)
+  (v)
+  @{Determines if @racket[v] is a @deftech{preferences layer}.
+
+  A preferences layer gives a form of scoping to preferences. When
+  a new preference is first registered with this library (via a call to
+  @racket[preferences:set-default] or @racket[preferences:add-callback])
+  it is put into the layer in @racket[preferences:current-layer]
+  (and not into any of that layer's previous layers).
+  When @racket[preferences:get], @racket[preferences:set],
+  @racket[preferences:set-un/marshall] are called, they consult and
+  manipulate only the layer where the preference was first installed.
+  Accordingly, preference layers give a way to discard some set of
+  calls to @racket[preference:set-default] and other preference configuration
+  and to start over with a new set. Note that this affects only the configuration
+  of the preferences for the library; the values are all stored centrally
+  (see @racket[preferences:low-level-put-preferences]) and are unaffected
+  by the layers.
+
+  @examples[#:eval pref-layer-eval
+
+            (define original-layer (preferences:current-layer))
+
+            (define layer2 (preferences:new-layer original-layer))
+            (parameterize ([preferences:current-layer layer2])
+              (code:comment "initialize 'a-pref in layer2")
+              (preferences:set-default 'a-pref 5 real?)
+              (preferences:set 'a-pref 6)
+              (preferences:get 'a-pref))
+
+            (define layer3 (preferences:new-layer original-layer))
+            (parameterize ([preferences:current-layer layer3])
+              (code:comment "initialize 'a-pref again, this time in layer3")
+              (code:comment "without the new layer in place, this would be an error")
+              (preferences:set-default 'a-pref 5 real?)
+              (code:comment "the actual value of the preference remains")
+              (code:comment "from the previous call to preferences:set")
+              (preferences:get 'a-pref))]
+
+  @history[#:added "1.30"]
+  })
+
+ (parameter-doc
+  preferences:current-layer
+  (parameter/c preferences:layer?)
+  preferences-layer
+  @{Determines the current @tech{preferences layer}.
+   @history[#:added "1.30"]})
+ )

gui-lib/info.rkt

@@ -30,4 +30,4 @@
 
 (define pkg-authors '(mflatt robby))
 
-(define version "1.29")
+(define version "1.30")

gui-test/framework/tests/prefs.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 (require framework/preferences
          racket/format
-         rackunit)
+         rackunit
+         racket/contract)
 
 ;(define ((check-equal? x) y) (equal? x y))
 (define pref-sym 'plt:not-a-real-preference)
@@ -34,6 +35,12 @@
           (preferences:get pref-sym))
    'new-pref)
 
+  (check-true (preferences:default-set? pref-sym))
+  (check-false (preferences:default-set? 'unknown-preference))
+  (check-false (begin
+                 (preferences:add-callback 'pref-with-only-callback-set void)
+                 (preferences:default-set? 'pref-with-only-callback-set)))
+
   (check-equal?
    (begin (preferences:set-default marshalling-pref-sym (lambda () 'the-answer) procedure?)
           (preferences:set-un/marshall marshalling-pref-sym
@@ -44,12 +51,24 @@
    'the-answer)
 
   (check-equal? ((preferences:get marshalling-pref-sym)) 2)
-  
+
   ;; make sure the preference actually got "written out"
   (check-equal? (hash-ref the-prefs-table
                           (string->symbol (~a "plt:framework-pref:" pref-sym)))
                 'new-pref)
 
+  (let ()
+    (preferences:set-default 'unmarshalling-enumerate-test '() (listof exact-nonnegative-integer?))
+    (preferences:set-un/marshall 'unmarshalling-enumerate-test
+                                 (λ (lon) (~s lon))
+                                 (λ (s) (read (open-input-string s))))
+
+    ;; simulate a value having been saved from some prior run of the preferences library
+    (hash-set! the-prefs-table 'plt:framework-pref:unmarshalling-enumerate-test
+               (~s '(1 2 3 4 5)))
+
+    (check-equal? (preferences:get 'unmarshalling-enumerate-test) '(1 2 3 4 5)))
+
   (check-equal?
    (let ([x 1])
      (preferences:set-default default-test-sym 'default symbol?)
@@ -60,6 +79,16 @@
      x)
    2)
 
+  (check-equal?
+   (let ([x 1])
+     (define remove-it (preferences:add-callback 'callback-before-delete (λ (a b) (set! x (+ x 1)))))
+     (preferences:set-default 'callback-before-delete 'default symbol?)
+     (preferences:set 'callback-before-delete 'xyz)
+     (remove-it)
+     (preferences:set 'callback-before-delete 'pdq)
+     x)
+   2)
+
   (check-equal?
    (let ([x 1])
      (define f (λ (a b) (set! x (+ x 1))))
@@ -100,4 +129,16 @@
      (remove-it)
      (preferences:set default-test-sym 'pdq)
      x)
-   1))
+   1)
+
+  (let ()
+    (hash-set! the-prefs-table
+               'plt:framework-pref:preferences-aliases-test:1
+               "1")
+    (preferences:set-default 'preferences-aliases-test
+                             0
+                             exact-nonnegative-integer?
+                             #:aliases '(preferences-aliases-test:1)
+                             #:rewrite-aliases (list (λ (v) (read (open-input-string v)))))
+    (check-equal? (preferences:get 'preferences-aliases-test) 1)))
+