suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add preference layers

Browse Source
This commit is contained in:
Robby Findler 2017-01-22 21:28:20 -06:00
parent 13be85d623
commit ae01dc64e3
3 changed files with 394 additions and 230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

485
gui-lib/framework/preferences.rkt
View File

@ -28,7 +28,10 @@ the state transitions / contracts are:
(require scribble/srcdoc (require scribble/srcdoc
racket/contract/base racket/file) 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) ()) (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))) (define (add-pref-prefix p) (string->symbol (format "plt:framework-pref:~a" p)))
;; preferences : hash-table[sym -o> any] ;; 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 ;; marshall-unmarshall : sym -o> un/marshall
(define marshall-unmarshall (make-hasheq))
;; callbacks : sym -o> (listof (sym TST -> boolean)) ;; callbacks : sym -o> (listof (sym TST -> boolean))
(define callbacks (make-hasheq))
;; defaults : hash-table[sym -o> default] ;; 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)) ;; type un/marshall = (make-un/marshall (any -> prinable) (printable -> any))
(define-struct un/marshall (marshall unmarshall)) (define-struct un/marshall (marshall unmarshall))
@ -80,45 +91,53 @@ the state transitions / contracts are:
;; return the current value of the preference `p' ;; return the current value of the preference `p'
;; exported ;; exported
(define (preferences:get p) (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)) (define v (hash-ref preferences p none))
(cond (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 ;; first time reading this, check the file & unmarshall value, if
;; it's not there, use the default ;; 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) ;; read-pref-from-file : symbol -> (or/c any none)
;; reads the preference saved in the low-level preferences ;; reads the preference saved in the low-level preferences
;; file, first checking 'p' and then checking the aliases (in order) ;; 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 ;; set : symbol any -> void
;; updates the preference ;; updates the preference
@ -133,37 +152,37 @@ the state transitions / contracts are:
(λ () (λ ()
(call-pref-save-callbacks #t)) (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) ((preferences:low-level-put-preferences)
(map add-pref-prefix ps) (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)) (void))
(λ () (λ ()
(call-pref-save-callbacks #f)))) (call-pref-save-callbacks #f))))
@ -201,33 +220,36 @@ the state transitions / contracts are:
(current-continuation-marks)))) (current-continuation-marks))))
;; add-callback : sym (-> void) -> void ;; 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 (define new-callbacks
(let loop ([callbacks (hash-ref callbacks p '())]) (let loop ([callbacks (hash-ref callbacks p '())])
(cond (cond
@ -252,106 +274,137 @@ the state transitions / contracts are:
(hash-set! callbacks p new-callbacks))) (hash-set! callbacks p new-callbacks)))
(define (preferences:set-un/marshall p marshall unmarshall) (define (preferences:set-un/marshall p marshall unmarshall)
(define pref-state (find-layer p))
(cond (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 (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 ;; 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 '()] #: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) ;; marshall-pref : symbol any -> (list symbol printable)
(define (marshall-pref p value) (define (marshall-pref p value)
(define pref-state (find-layer p))
(let/ec k (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 ;; 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 ;; copy-pref-value : sym any -> any
;; uses the marshalling code to copy a preference. If there ;; uses the marshalling code to copy a preference. If there
;; is not marshaller set, then no copying happens. ;; is not marshaller set, then no copying happens.
(define (copy-pref-value p value) (define (copy-pref-value p value)
(let/ec k (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-struct preferences:snapshot (x))
(define (preferences:get-prefs-snapshot) (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) (define (preferences:restore-prefs-snapshot snapshot)
(multi-set (map car (preferences:snapshot-x snapshot)) (multi-set (map car (preferences:snapshot-x snapshot))
(map cdr (preferences:snapshot-x snapshot))) (map cdr (preferences:snapshot-x snapshot)))
(void)) (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 (provide/doc
(proc-doc/names (proc-doc/names
@ -414,6 +467,10 @@ the state transitions / contracts are:
unmarshalling functions by calling unmarshalling functions by calling
@racket[preferences:set-un/marshall] before adding a callback. @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 This function raises an exception matching
@racket[exn:unknown-preference?] @racket[exn:unknown-preference?]
if the preference default has not been set via if the preference default has not been set via
@ -505,13 +562,19 @@ the state transitions / contracts are:
preferences:register-save-callback preferences:register-save-callback
(-> (-> boolean? any) symbol?) (-> (-> boolean? any) symbol?)
(callback) (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 (proc-doc/names
preferences:unregister-save-callback preferences:unregister-save-callback
@ -539,7 +602,7 @@ the state transitions / contracts are:
(parameter-doc (parameter-doc
preferences:low-level-put-preferences preferences:low-level-put-preferences
(parameter/c ((listof symbol?) (listof any/c) . -> . any)) (parameter/c (-> (listof symbol?) (listof any/c) any))
put-preferences put-preferences
@{This parameter's value is called to save preference the preferences file. @{This parameter's value is called to save preference the preferences file.
Its interface should be just like mzlib's @racket[put-preferences]. Its interface should be just like mzlib's @racket[put-preferences].
@ -586,4 +649,64 @@ the state transitions / contracts are:
copied by passing it through the marshalling and unmarshalling process. copied by passing it through the marshalling and unmarshalling process.
Other values are not copied, but references to them are instead saved. 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"]})
)

2
gui-lib/info.rkt
View File

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

45
gui-test/framework/tests/prefs.rkt
View File

@ -1,7 +1,8 @@
#lang racket/base #lang racket/base
(require framework/preferences (require framework/preferences
racket/format racket/format
rackunit) rackunit
racket/contract)
;(define ((check-equal? x) y) (equal? x y)) ;(define ((check-equal? x) y) (equal? x y))
(define pref-sym 'plt:not-a-real-preference) (define pref-sym 'plt:not-a-real-preference)
@ -34,6 +35,12 @@
(preferences:get pref-sym)) (preferences:get pref-sym))
'new-pref) '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? (check-equal?
(begin (preferences:set-default marshalling-pref-sym (lambda () 'the-answer) procedure?) (begin (preferences:set-default marshalling-pref-sym (lambda () 'the-answer) procedure?)
(preferences:set-un/marshall marshalling-pref-sym (preferences:set-un/marshall marshalling-pref-sym
@ -50,6 +57,18 @@
(string->symbol (~a "plt:framework-pref:" pref-sym))) (string->symbol (~a "plt:framework-pref:" pref-sym)))
'new-pref) '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? (check-equal?
(let ([x 1]) (let ([x 1])
(preferences:set-default default-test-sym 'default symbol?) (preferences:set-default default-test-sym 'default symbol?)
@ -60,6 +79,16 @@
x) x)
2) 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? (check-equal?
(let ([x 1]) (let ([x 1])
(define f (λ (a b) (set! x (+ x 1)))) (define f (λ (a b) (set! x (+ x 1))))
@ -100,4 +129,16 @@
(remove-it) (remove-it)
(preferences:set default-test-sym 'pdq) (preferences:set default-test-sym 'pdq)
x) 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)))