add preference layers
This commit is contained in:
Robby Findler
parent
13be85d623
commit
ae01dc64e3
|
|
@ -21,14 +21,17 @@ the state transitions / contracts are:
|
|||
set-un/marshall(true, false, true) -> (true, true, true)
|
||||
.. otherwise error
|
||||
|
||||
for all syms:
|
||||
prefs-snapshot(_, _, _) -> (_, _, false)
|
||||
for all syms:
|
||||
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
|
||||
(define preferences (make-hasheq))
|
||||
|
||||
;; the current values of the preferences
|
||||
;; 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 (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)
|
||||
(not (hash-has-key? preferences pref)))
|
||||
(define (preferences:new-layer prev)
|
||||
(preferences:layer (make-hasheq) (make-hasheq) (make-hasheq) (make-hasheq) prev))
|
||||
(define preferences:current-layer (make-parameter (preferences:new-layer #f)))
|
||||
|
||||
(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)
|
||||
(let* (;; try to read the preference from the preferences file
|
||||
[v (read-pref-from-file p)]
|
||||
[v (if (eq? v none)
|
||||
;; no value read, take the default value
|
||||
(default-value (hash-ref defaults p))
|
||||
;; found a saved value, unmarshall it
|
||||
(unmarshall-pref p v))])
|
||||
;; set the value for future reference and return it
|
||||
(hash-set! preferences p v)
|
||||
v)]
|
||||
[(not (preferences:default-set? p))
|
||||
(raise-unknown-preference-error
|
||||
'preferences:get
|
||||
"tried to get a preference but no default set for ~e"
|
||||
p)]))
|
||||
[(eq? v none)
|
||||
(define defaults (preferences:layer-defaults pref-state))
|
||||
;; try to read the preference from the preferences file
|
||||
(define marshalled-v (read-pref-from-file (hash-ref defaults p) p))
|
||||
(define default-info (hash-ref defaults p))
|
||||
(define the-default-value (default-value default-info))
|
||||
(define v (if (eq? marshalled-v none)
|
||||
;; no value read, take the default value
|
||||
the-default-value
|
||||
;; found a saved value, unmarshall it
|
||||
(unmarshall-pref pref-state p marshalled-v
|
||||
(default-checker default-info)
|
||||
the-default-value)))
|
||||
;; set the value in the preferences table for easier reference
|
||||
;; and so we know it has been read from the disk
|
||||
;; (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)
|
||||
(let ([defaults (hash-ref defaults p)])
|
||||
(let loop ([syms (cons p (default-aliases defaults))]
|
||||
[rewriters (cons values (default-rewrite-aliases defaults))])
|
||||
(cond
|
||||
[(null? syms) none]
|
||||
[else
|
||||
(let/ec k
|
||||
((car rewriters)
|
||||
((preferences:low-level-get-preference)
|
||||
(add-pref-prefix (car syms))
|
||||
(lambda () (k (loop (cdr syms) (cdr rewriters)))))))]))))
|
||||
(define (read-pref-from-file defaults p)
|
||||
(let loop ([syms (cons p (default-aliases defaults))]
|
||||
[rewriters (cons values (default-rewrite-aliases defaults))])
|
||||
(cond
|
||||
[(null? syms) none]
|
||||
[else
|
||||
(let/ec k
|
||||
((car rewriters)
|
||||
((preferences:low-level-get-preference)
|
||||
(add-pref-prefix (car syms))
|
||||
(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
|
||||
(λ (p value)
|
||||
(cond
|
||||
[(preferences:default-set? p)
|
||||
(define default (hash-ref defaults p))
|
||||
(define checker? (default-checker default))
|
||||
(unless (checker? value)
|
||||
(error 'preferences:set
|
||||
(string-append
|
||||
"new value doesn't satisfy preferences:set-default predicate\n"
|
||||
" pref sym: ~v\n"
|
||||
" given: ~e\n"
|
||||
" predicate: ~e")
|
||||
p value checker?))
|
||||
(check-callbacks p value)
|
||||
(hash-set! preferences p value)]
|
||||
[(not (preferences:default-set? p))
|
||||
(raise-unknown-preference-error
|
||||
'preferences:set
|
||||
(string-append
|
||||
"cannot set preference before setting default"
|
||||
" pref sym: ~e\n"
|
||||
" given: ~e")
|
||||
p
|
||||
value)]))
|
||||
ps values)
|
||||
(for ([p (in-list ps)]
|
||||
[value (in-list values)])
|
||||
(define pref-state (find-layer p))
|
||||
(cond
|
||||
[pref-state
|
||||
(define default (hash-ref (preferences:layer-defaults pref-state) p))
|
||||
(define checker? (default-checker default))
|
||||
(unless (checker? value)
|
||||
(error 'preferences:set
|
||||
(string-append
|
||||
"new value doesn't satisfy preferences:set-default predicate\n"
|
||||
" pref symbol: ~e\n"
|
||||
" given: ~e\n"
|
||||
" predicate: ~e")
|
||||
p value checker?))
|
||||
(check-callbacks pref-state p value)
|
||||
(hash-set! (preferences:layer-preferences pref-state) p value)]
|
||||
[else
|
||||
(raise-unknown-preference-error
|
||||
'preferences:set
|
||||
(string-append
|
||||
"cannot set preference before setting default"
|
||||
" pref symbol: ~e\n"
|
||||
" given: ~e")
|
||||
p
|
||||
value)]))
|
||||
((preferences:low-level-put-preferences)
|
||||
(map add-pref-prefix ps)
|
||||
(map (λ (p value) (marshall-pref p value))
|
||||
ps
|
||||
values))
|
||||
(for/list ([p (in-list ps)]
|
||||
[value (in-list 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
|
||||
(lambda (p callback [weak? #f])
|
||||
(let ([new-cb (make-pref-callback (if weak?
|
||||
(impersonator-ephemeron callback)
|
||||
callback))])
|
||||
(hash-set! callbacks
|
||||
p
|
||||
(append
|
||||
(hash-ref callbacks p '())
|
||||
(list new-cb)))
|
||||
(λ ()
|
||||
(hash-set!
|
||||
callbacks
|
||||
p
|
||||
(let loop ([callbacks (hash-ref callbacks p '())])
|
||||
(cond
|
||||
[(null? callbacks) '()]
|
||||
[else
|
||||
(let ([callback (car callbacks)])
|
||||
(cond
|
||||
[(eq? callback new-cb)
|
||||
(loop (cdr callbacks))]
|
||||
[else
|
||||
(cons (car callbacks) (loop (cdr callbacks)))]))])))))))
|
||||
(define (preferences:add-callback p callback [weak? #f])
|
||||
(define pref-state (or (find-layer p) (preferences:current-layer)))
|
||||
(define callbacks (preferences:layer-callbacks pref-state))
|
||||
(define new-cb
|
||||
(make-pref-callback (if weak?
|
||||
(impersonator-ephemeron callback)
|
||||
callback)))
|
||||
(hash-set! callbacks
|
||||
p
|
||||
(append
|
||||
(hash-ref callbacks p '())
|
||||
(list new-cb)))
|
||||
(λ ()
|
||||
(hash-set!
|
||||
callbacks
|
||||
p
|
||||
(let loop ([callbacks (hash-ref callbacks p '())])
|
||||
(cond
|
||||
[(null? callbacks) '()]
|
||||
[else
|
||||
(let ([callback (car callbacks)])
|
||||
(cond
|
||||
[(eq? callback new-cb)
|
||||
(loop (cdr callbacks))]
|
||||
[else
|
||||
(cons (car callbacks) (loop (cdr callbacks)))]))])))))
|
||||
|
||||
;; check-callbacks : sym val -> void
|
||||
(define (check-callbacks p value)
|
||||
;; check-callbacks : pref-state sym val -> void
|
||||
(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)
|
||||
(not (pref-un/marshall-set? p))
|
||||
(pref-can-init? p))
|
||||
(hash-set! marshall-unmarshall p (make-un/marshall marshall unmarshall))]
|
||||
[(not (preferences:default-set? p))
|
||||
[pref-state
|
||||
(define marshall-unmarshall (preferences:layer-marshall-unmarshall pref-state))
|
||||
(define pref-un/marshall-set? (hash-ref marshall-unmarshall p #f))
|
||||
(define pref-can-init? (not (hash-has-key? (preferences:layer-preferences pref-state) 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"
|
||||
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)))))
|
||||
"must call preferences:set-default for ~s before calling set-un/marshall for ~s"
|
||||
p p)]))
|
||||
|
||||
;; 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)])
|
||||
(cond
|
||||
[(and (not (preferences:default-set? p))
|
||||
(pref-can-init? p))
|
||||
(define default-okay? (checker default-value))
|
||||
(unless default-okay?
|
||||
(error 'set-default
|
||||
(string-append
|
||||
"checker doesn't match default\n"
|
||||
" default: ~e\n"
|
||||
" pref sym: ~e\n"
|
||||
" checker: ~e")
|
||||
p default-value checker))
|
||||
|
||||
(unless (= (length aliases) (length rewrite-aliases))
|
||||
(error 'preferences:set-default
|
||||
"expected equal length lists for the #:aliases and #:rewrite-aliases arguments, got ~e and ~e"
|
||||
aliases rewrite-aliases))
|
||||
(hash-set! defaults p (make-default default-value checker aliases rewrite-aliases))]
|
||||
[(not (pref-can-init? p))
|
||||
(error 'preferences:set-default
|
||||
"tried to call set-default for preference ~e but it cannot be configured any more"
|
||||
p)]
|
||||
[(preferences:default-set? p)
|
||||
(error 'preferences:set-default
|
||||
"preferences default already set for ~e" p)]
|
||||
[(not (pref-can-init? p))
|
||||
(error 'preferences:set-default
|
||||
"can no longer set the default for ~e" p)]))
|
||||
#:rewrite-aliases [rewrite-aliases (map (λ (x) values) aliases)])
|
||||
(define pref-state (or (find-layer p) (preferences:current-layer)))
|
||||
(define defaults (preferences:layer-defaults pref-state))
|
||||
(when (hash-has-key? defaults p)
|
||||
(error 'preferences:set-default
|
||||
(string-append
|
||||
"preferences default already set\n"
|
||||
" pref symbol: ~e\n"
|
||||
" default: ~e\n"
|
||||
" checker: ~e")
|
||||
p default-value checker))
|
||||
(unless (checker default-value)
|
||||
(error 'preferences:set-default
|
||||
(string-append
|
||||
"checker doesn't match default\n"
|
||||
" pref symbol: ~e\n"
|
||||
" default: ~e\n"
|
||||
" checker: ~e")
|
||||
p default-value checker))
|
||||
(unless (= (length aliases) (length rewrite-aliases))
|
||||
(error 'preferences:set-default
|
||||
(string-append
|
||||
"expected equal length lists for the #:aliases"
|
||||
" and #:rewrite-aliases arguments, got ~e and ~e")
|
||||
aliases rewrite-aliases))
|
||||
(hash-set! defaults p (make-default default-value checker aliases rewrite-aliases)))
|
||||
|
||||
;; marshall-pref : symbol any -> (list symbol printable)
|
||||
(define (marshall-pref p value)
|
||||
(define pref-state (find-layer p))
|
||||
(let/ec k
|
||||
(let* ([marshaller
|
||||
(un/marshall-marshall
|
||||
(hash-ref marshall-unmarshall p (λ () (k value))))])
|
||||
(marshaller value))))
|
||||
(define marshaller
|
||||
(un/marshall-marshall
|
||||
(hash-ref (preferences:layer-marshall-unmarshall pref-state)
|
||||
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)
|
||||
(let* ([un/marshall (hash-ref marshall-unmarshall p #f)]
|
||||
[result (if un/marshall
|
||||
((un/marshall-unmarshall un/marshall) data)
|
||||
data)]
|
||||
[default (hash-ref defaults p)])
|
||||
(if ((default-checker default) result)
|
||||
result
|
||||
(default-value default))))
|
||||
(define (unmarshall-pref pref-state p data the-checker the-default-value)
|
||||
(define marshall-unmarshall (preferences:layer-marshall-unmarshall pref-state))
|
||||
(define un/marshall (hash-ref marshall-unmarshall p #f))
|
||||
(define result
|
||||
(if un/marshall
|
||||
((un/marshall-unmarshall un/marshall) data)
|
||||
data))
|
||||
(if (the-checker result)
|
||||
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)))]
|
||||
[default (hash-ref defaults p)]
|
||||
[marsh (un/marshall-marshall un/marshaller)]
|
||||
[unmarsh (un/marshall-unmarshall un/marshaller)]
|
||||
[marshalled (marsh value)]
|
||||
[copy (unmarsh marshalled)])
|
||||
(if ((default-checker default) copy)
|
||||
copy
|
||||
value))))
|
||||
|
||||
(define pref-state (find-layer p))
|
||||
(define marshall-unmarshall (preferences:layer-marshall-unmarshall pref-state))
|
||||
(define un/marshaller (hash-ref marshall-unmarshall p (λ () (k value))))
|
||||
(define default (hash-ref (preferences:layer-defaults pref-state) p))
|
||||
(define marsh (un/marshall-marshall un/marshaller))
|
||||
(define unmarsh (un/marshall-unmarshall un/marshaller))
|
||||
(define marshalled (marsh value))
|
||||
(define copy (unmarsh marshalled))
|
||||
(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
|
||||
(hash-map defaults
|
||||
(λ (k v) (cons k (copy-pref-value k (preferences:get k)))))))
|
||||
(make-preferences:snapshot
|
||||
(let loop ([prefs-state (preferences:current-layer)]
|
||||
[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
|
||||
before the preferences file is written, with @racket[#t], and once after it is written, with
|
||||
@racket[#f]. Registration returns a key for use with @racket[preferences:unregister-save-callback].
|
||||
Caveats:
|
||||
@itemize{@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.}}})
|
||||
|
||||
@{Registers @racket[callback] to run twice for each call
|
||||
to @racket[preferences:set]---once before the preferences
|
||||
file is written, with @racket[#t], and once after it is
|
||||
written, with @racket[#f]. Registration returns a key for
|
||||
use with @racket[preferences:unregister-save-callback].
|
||||
Caveats: @itemize{
|
||||
@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"]})
|
||||
)
|
||||
|
|
|
|||
|
|
@ -30,4 +30,4 @@
|
|||
|
||||
(define pkg-authors '(mflatt robby))
|
||||
|
||||
(define version "1.29")
|
||||
(define version "1.30")
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user