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

added docs for the gui-utils and the textual preferences to the framework

Browse Source 
svn: r9503

original commit: d07eff8bceb5d1b07deb074d1e180f3f9ba713d7
This commit is contained in:
Robby Findler 2008-04-27 14:57:09 +00:00
parent 35f5253f8d
commit 45a7f4f451
33 changed files with 1021 additions and 1015 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1038
collects/framework/gui-utils.ss
View File

File diff suppressed because it is too large Load Diff

786
collects/framework/preferences.ss
View File

@ -1,4 +1,5 @@
#reader scribble/reader
#lang scheme/gui
#| #|
There are three attributes for each preference: There are three attributes for each preference:
@ -26,443 +27,438 @@ the state transitions / contracts are:
|# |#
(module preferences mzscheme (require scribble/srcdoc)
(require mzlib/file (require/doc scheme/base scribble/manual)
mzlib/etc
mzlib/contract)
(provide exn:struct:unknown-preference) (provide exn:struct:unknown-preference)
(define-struct (exn:unknown-preference exn) ()) (define-struct (exn:unknown-preference exn) ())
;; these two names are for consistency ;; these two names are for consistency
(define exn:make-unknown-preference make-exn:unknown-preference) (define exn:make-unknown-preference make-exn:unknown-preference)
(define exn:struct:unknown-preference struct:exn:unknown-preference) (define exn:struct:unknown-preference struct:exn:unknown-preference)
(define-syntax (provide/contract/docs stx) (define old-preferences-symbol 'plt:framework-prefs)
(syntax-case stx () (define old-preferences (make-hasheq))
[(_ (name contract docs ...) ...) (let ([old-prefs (get-preference old-preferences-symbol (λ () '()))])
(syntax (provide/contract (name contract) ...))])) (for-each
(λ (line) (hash-set! old-preferences (car line) (cadr line)))
old-prefs))
(define (add-pref-prefix p) (string->symbol (format "plt:framework-pref:~a" p)))
(define old-preferences-symbol 'plt:framework-prefs) ;; preferences : hash-table[sym -o> any]
(define old-preferences (make-hash-table)) ;; the current values of the preferences
(let ([old-prefs (get-preference old-preferences-symbol (λ () '()))]) (define preferences (make-hasheq))
(for-each
(λ (line) (hash-table-put! old-preferences (car line) (cadr line)))
old-prefs))
(define (add-pref-prefix p) (string->symbol (format "plt:framework-pref:~a" p))) ;; marshalled : hash-table[sym -o> any]
;; the values of the preferences, as read in from the disk
;; each symbol will only be mapped in one of the preferences
;; hash-table and this hash-table, but not both.
(define marshalled (make-hasheq))
;; preferences : hash-table[sym -o> any] ;; marshall-unmarshall : sym -o> un/marshall
;; the current values of the preferences (define marshall-unmarshall (make-hasheq))
(define preferences (make-hash-table))
;; marshalled : hash-table[sym -o> any] ;; callbacks : sym -o> (listof (sym TST -> boolean))
;; the values of the preferences, as read in from the disk (define callbacks (make-hasheq))
;; each symbol will only be mapped in one of the preferences
;; hash-table and this hash-table, but not both.
(define marshalled (make-hash-table))
;; marshall-unmarshall : sym -o> un/marshall ;; defaults : hash-table[sym -o> default]
(define marshall-unmarshall (make-hash-table)) (define defaults (make-hasheq))
;; callbacks : sym -o> (listof (sym TST -> boolean)) ;; these four functions determine the state of a preference
(define callbacks (make-hash-table)) (define (pref-un/marshall-set? pref) (hash-table-bound? marshall-unmarshall pref))
(define (pref-default-set? pref) (hash-table-bound? defaults pref))
(define (pref-can-init? pref)
(and (not snapshot-grabbed?)
(not (hash-table-bound? preferences pref))))
;; defaults : hash-table[sym -o> default] ;; type un/marshall = (make-un/marshall (any -> prinable) (printable -> any))
(define defaults (make-hash-table)) (define-struct un/marshall (marshall unmarshall))
;; these four functions determine the state of a preference ;; type pref = (make-pref any)
(define (pref-un/marshall-set? pref) (hash-table-bound? marshall-unmarshall pref)) (define-struct pref (value))
(define (pref-default-set? pref) (hash-table-bound? defaults pref))
(define (pref-can-init? pref)
(and (not snapshot-grabbed?)
(not (hash-table-bound? preferences pref))))
;; type un/marshall = (make-un/marshall (any -> prinable) (printable -> any)) ;; type default = (make-default any (any -> bool))
(define-struct un/marshall (marshall unmarshall)) (define-struct default (value checker))
;; type pref = (make-pref any) ;; pref-callback : (make-pref-callback (union (weak-box (sym tst -> void)) (sym tst -> void)))
(define-struct pref (value)) ;; this is used as a wrapped to deal with the problem that different procedures might be eq?.
(define-struct pref-callback (cb))
;; type default = (make-default any (any -> bool)) ;; get : symbol -> any
(define-struct default (value checker)) ;; return the current value of the preference `p'
;; exported
(define (preferences:get p)
(cond
[(pref-default-set? p)
;; pref-callback : (make-pref-callback (union (weak-box (sym tst -> void)) (sym tst -> void))) ;; unmarshall, if required
;; this is used as a wrapped to deal with the problem that different procedures might be eq?. (when (hash-table-bound? marshalled p)
(define-struct pref-callback (cb)) ;; if `preferences' is already bound, that means the unmarshalled value isn't useful.
;; get : symbol -> any
;; return the current value of the preference `p'
;; exported
(define (preferences:get p)
(cond
[(pref-default-set? p)
;; unmarshall, if required
(when (hash-table-bound? marshalled p)
;; if `preferences' is already bound, that means the unmarshalled value isn't useful.
(unless (hash-table-bound? preferences p)
(hash-table-put! preferences p (unmarshall-pref p (hash-table-get marshalled p))))
(hash-table-remove! marshalled p))
;; if there is no value in the preferences table, but there is one
;; in the old version preferences file, take that:
(unless (hash-table-bound? preferences p) (unless (hash-table-bound? preferences p)
(when (hash-table-bound? old-preferences p) (hash-set! preferences p (unmarshall-pref p (hash-ref marshalled p))))
(hash-table-put! preferences p (unmarshall-pref p (hash-table-get old-preferences p))))) (hash-remove! marshalled p))
;; clear the pref from the old table (just in case it was taking space -- we don't need it anymore) ;; if there is no value in the preferences table, but there is one
;; in the old version preferences file, take that:
(unless (hash-table-bound? preferences p)
(when (hash-table-bound? old-preferences p) (when (hash-table-bound? old-preferences p)
(hash-table-remove! old-preferences p)) (hash-set! preferences p (unmarshall-pref p (hash-ref old-preferences p)))))
;; if it still isn't set, take the default value ;; clear the pref from the old table (just in case it was taking space -- we don't need it anymore)
(unless (hash-table-bound? preferences p) (when (hash-table-bound? old-preferences p)
(hash-table-put! preferences p (default-value (hash-table-get defaults p)))) (hash-remove! old-preferences p))
(hash-table-get preferences p)] ;; if it still isn't set, take the default value
[(not (pref-default-set? p)) (unless (hash-table-bound? preferences p)
(raise-unknown-preference-error (hash-set! preferences p (default-value (hash-ref defaults p))))
'preferences:get
"tried to get a preference but no default set for ~e"
p)]))
;; set : symbol any -> void (hash-ref preferences p)]
;; updates the preference [(not (pref-default-set? p))
;; exported (raise-unknown-preference-error
(define (preferences:set p value) (multi-set (list p) (list value))) 'preferences:get
"tried to get a preference but no default set for ~e"
p)]))
;; set : symbol any -> void ;; set : symbol any -> void
;; updates the preference ;; updates the preference
;; exported ;; exported
(define (preferences:set p value) (multi-set (list p) (list value)))
(define (multi-set ps values) ;; set : symbol any -> void
(for-each ;; updates the preference
(λ (p value) ;; exported
(cond
[(pref-default-set? p)
(let ([default (hash-table-get defaults p)])
(unless ((default-checker default) value)
(error 'preferences:set
"tried to set preference ~e to ~e but it does not meet test from preferences:set-default"
p value))
(check-callbacks p value)
(hash-table-put! preferences p value)
(void))]
[(not (pref-default-set? p))
(raise-unknown-preference-error
'preferences:set "tried to set the preference ~e to ~e, but no default is set"
p
value)]))
ps values)
((preferences:low-level-put-preferences)
(map add-pref-prefix ps)
(map (λ (p value) (marshall-pref p value))
ps
values))
(void)) (define (multi-set ps values)
(for-each
(λ (p value)
(cond
[(pref-default-set? p)
(let ([default (hash-ref defaults p)])
(unless ((default-checker default) value)
(error 'preferences:set
"tried to set preference ~e to ~e but it does not meet test from preferences:set-default"
p value))
(check-callbacks p value)
(hash-set! preferences p value)
(void))]
[(not (pref-default-set? p))
(raise-unknown-preference-error
'preferences:set "tried to set the preference ~e to ~e, but no default is set"
p
value)]))
ps values)
((preferences:low-level-put-preferences)
(map add-pref-prefix ps)
(map (λ (p value) (marshall-pref p value))
ps
values))
(define preferences:low-level-put-preferences (make-parameter put-preferences)) (void))
(define (raise-unknown-preference-error sym fmt . args) (define preferences:low-level-put-preferences (make-parameter put-preferences))
(raise (exn:make-unknown-preference
(string-append (format "~a: " sym) (apply format fmt args))
(current-continuation-marks))))
;; unmarshall-pref : symbol marshalled -> any (define (raise-unknown-preference-error sym fmt . args)
;; unmarshalls a preference read from the disk (raise (exn:make-unknown-preference
(define (unmarshall-pref p data) (string-append (format "~a: " sym) (apply format fmt args))
(let* ([un/marshall (hash-table-get marshall-unmarshall p #f)] (current-continuation-marks))))
[result (if un/marshall
((un/marshall-unmarshall un/marshall) data)
data)]
[default (hash-table-get defaults p)])
(if ((default-checker default) result)
result
(default-value default))))
;; add-callback : sym (-> void) -> void ;; unmarshall-pref : symbol marshalled -> any
(define preferences:add-callback ;; unmarshalls a preference read from the disk
(opt-lambda (p callback [weak? #f]) (define (unmarshall-pref p data)
(let ([new-cb (make-pref-callback (if weak? (let* ([un/marshall (hash-ref marshall-unmarshall p #f)]
(make-weak-box callback) [result (if un/marshall
callback))]) ((un/marshall-unmarshall un/marshall) data)
(hash-table-put! callbacks data)]
p [default (hash-ref defaults p)])
(append (if ((default-checker default) result)
(hash-table-get callbacks p (λ () null)) result
(list new-cb))) (default-value default))))
(λ ()
(hash-table-put!
callbacks
p
(let loop ([callbacks (hash-table-get callbacks p (λ () null))])
(cond
[(null? callbacks) null]
[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 ;; add-callback : sym (-> void) -> void
(define (check-callbacks p value) (define preferences:add-callback
(let ([new-callbacks (lambda (p callback [weak? #f])
(let loop ([callbacks (hash-table-get callbacks p (λ () null))]) (let ([new-cb (make-pref-callback (if weak?
(cond (make-weak-box callback)
[(null? callbacks) null] callback))])
[else (hash-set! callbacks
(let* ([callback (car callbacks)] p
[cb (pref-callback-cb callback)]) (append
(cond (hash-ref callbacks p (λ () null))
[(weak-box? cb) (list new-cb)))
(let ([v (weak-box-value cb)]) (λ ()
(if v (hash-set!
(begin callbacks
(v p value) p
(cons callback (loop (cdr callbacks)))) (let loop ([callbacks (hash-ref callbacks p (λ () null))])
(loop (cdr callbacks))))] (cond
[else [(null? callbacks) null]
(cb p value) [else
(cons callback (loop (cdr callbacks)))]))]))]) (let ([callback (car callbacks)])
(if (null? new-callbacks) (cond
(hash-table-remove! callbacks p) [(eq? callback new-cb)
(hash-table-put! callbacks p new-callbacks)))) (loop (cdr callbacks))]
[else
(cons (car callbacks) (loop (cdr callbacks)))]))])))))))
(define (preferences:set-un/marshall p marshall unmarshall) ;; check-callbacks : sym val -> void
(cond (define (check-callbacks p value)
[(and (pref-default-set? p) (let ([new-callbacks
(not (pref-un/marshall-set? p)) (let loop ([callbacks (hash-ref callbacks p (λ () null))])
(pref-can-init? p)) (cond
(hash-table-put! marshall-unmarshall p (make-un/marshall marshall unmarshall))] [(null? callbacks) null]
[(not (pref-default-set? p)) [else
(error 'preferences:set-un/marshall (let* ([callback (car callbacks)]
"must call set-default for ~s before calling set-un/marshall for ~s" [cb (pref-callback-cb callback)])
p p)] (cond
[(pref-un/marshall-set? p) [(weak-box? cb)
(error 'preferences:set-un/marshall (let ([v (weak-box-value cb)])
"already set un/marshall for ~e" (if v
p)] (begin
[(not (pref-can-init? p)) (v p value)
(error 'preferences:set-un/marshall "the preference ~e cannot be configured any more" p)])) (cons callback (loop (cdr callbacks))))
(loop (cdr callbacks))))]
[else
(cb p value)
(cons callback (loop (cdr callbacks)))]))]))])
(if (null? new-callbacks)
(hash-remove! callbacks p)
(hash-set! callbacks p new-callbacks))))
(define (hash-table-bound? ht s) (define (preferences:set-un/marshall p marshall unmarshall)
(let/ec k (cond
(hash-table-get ht s (λ () (k #f))) [(and (pref-default-set? p)
#t)) (not (pref-un/marshall-set? p))
(pref-can-init? p))
(hash-set! marshall-unmarshall p (make-un/marshall marshall unmarshall))]
[(not (pref-default-set? p))
(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) (define (hash-table-bound? ht s)
(hash-table-for-each (let/ec k
defaults (hash-ref ht s (λ () (k #f)))
(λ (p def) (preferences:set p (default-value def))))) #t))
;; set-default : (sym TST (TST -> boolean) -> void (define (preferences:restore-defaults)
(define (preferences:set-default p default-value checker) (hash-for-each
(cond defaults
[(and (not (pref-default-set? p)) (λ (p def) (preferences:set p (default-value def)))))
(pref-can-init? p))
(let ([default-okay? (checker default-value)])
(unless default-okay?
(error 'set-default "~s: checker (~s) returns ~s for ~s, expected #t~n"
p checker default-okay? default-value))
(hash-table-put! defaults p (make-default default-value checker))
(let/ec k
(let ([m (get-preference (add-pref-prefix p) (λ () (k (void))))])
;; if there is no preference saved, we just don't do anything.
;; `get' notices this case.
(hash-table-put! marshalled p m))))]
[(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)]
[(pref-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)]))
;; marshall-pref : symbol any -> (list symbol printable) ;; set-default : (sym TST (TST -> boolean) -> void
(define (marshall-pref p value) (define (preferences:set-default p default-value checker)
(let/ec k (cond
(let* ([marshaller [(and (not (pref-default-set? p))
(un/marshall-marshall (pref-can-init? p))
(hash-table-get marshall-unmarshall p (λ () (k value))))]) (let ([default-okay? (checker default-value)])
(marshaller value)))) (unless default-okay?
(error 'set-default "~s: checker (~s) returns ~s for ~s, expected #t~n"
p checker default-okay? default-value))
(hash-set! defaults p (make-default default-value checker))
(let/ec k
(let ([m (get-preference (add-pref-prefix p) (λ () (k (void))))])
;; if there is no preference saved, we just don't do anything.
;; `get' notices this case.
(hash-set! marshalled p m))))]
[(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)]
[(pref-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)]))
(define-struct preferences:snapshot (x)) ;; marshall-pref : symbol any -> (list symbol printable)
(define snapshot-grabbed? #f) (define (marshall-pref p value)
(define (preferences:get-prefs-snapshot) (let/ec k
(set! snapshot-grabbed? #t) (let* ([marshaller
(make-preferences:snapshot (hash-table-map defaults (λ (k v) (cons k (preferences:get k)))))) (un/marshall-marshall
(hash-ref marshall-unmarshall p (λ () (k value))))])
(marshaller value))))
(define (preferences:restore-prefs-snapshot snapshot) (define-struct preferences:snapshot (x))
(multi-set (map car (preferences:snapshot-x snapshot)) (define snapshot-grabbed? #f)
(map cdr (preferences:snapshot-x snapshot))) (define (preferences:get-prefs-snapshot)
(void)) (set! snapshot-grabbed? #t)
(make-preferences:snapshot (hash-map defaults (λ (k v) (cons k (preferences:get k))))))
(define (preferences:restore-prefs-snapshot snapshot)
(multi-set (map car (preferences:snapshot-x snapshot))
(map cdr (preferences:snapshot-x snapshot)))
(void))
(provide/contract/docs (provide/doc
(preferences:snapshot? (proc-doc/names
(-> any/c boolean?) preferences:snapshot?
(arg) (-> any/c boolean?)
"Determines if its argument is a preferences snapshot." (arg)
"" @{Determines if its argument is a preferences snapshot.
"See also "
"@flink preferences:get-prefs-snapshot"
" and "
"@flink preferences:restore-prefs-snapshot %"
".")
(preferences:restore-prefs-snapshot
(-> preferences:snapshot? void?)
(snapshot)
"Restores the preferences saved in \\var{snapshot}."
""
"See also "
"@flink preferences:get-prefs-snapshot %"
".")
(preferences:get-prefs-snapshot See also
(-> preferences:snapshot?) @scheme[preferences:get-prefs-snapshot] and
() @scheme[preferences:restore-prefs-snapshot].})
"Caches all of the current values of the preferences and returns them." (proc-doc/names
"" preferences:restore-prefs-snapshot
"See also " (-> preferences:snapshot? void?)
"@flink preferences:restore-prefs-snapshot %" (snapshot)
".") @{Restores the preferences saved in @scheme[snapshot].
(exn:make-unknown-preference See also @scheme[preferences:get-prefs-snapshot].})
(string? continuation-mark-set? . -> . exn:unknown-preference?)
(message continuation-marks)
"Creates an unknown preference exception.")
(exn:unknown-preference?
(any/c . -> . boolean?)
(exn)
"Determines if a value is an unknown preference exn.")
(preferences:low-level-put-preferences (proc-doc/names
(parameter/c (-> (listof symbol?) (listof any/c) any)) preferences:get-prefs-snapshot
() (-> preferences:snapshot?)
"This is a parameter (see " ()
"\\Mzhyperref{parameters}{mz:parameters} for information about parameters)" @{Caches all of the current values of the preferences and returns them.
"which is called when a preference is saved. Its interface should "
"be just like mzlib's \\scheme|put-preference|.")
(preferences:get See also
(symbol? . -> . any/c) @scheme[preferences:restore-prefs-snapshot].})
(symbol)
"See also"
"@flink preferences:set-default %"
"."
""
"\\rawscm{preferences:get} returns the value for the preference"
"\\var{symbol}. It raises"
"\\scmindex{exn:unknown-preference}\\rawscm{exn:unknown-preference}"
"if the preference's default has not been set.")
(preferences:set
(symbol? any/c . -> . void?)
(symbol value)
"See also"
"@flink preferences:set-default %"
"."
""
"\\rawscm{preferences:set-preference} sets the preference"
"\\var{symbol} to \\var{value}. This should be called when the"
"users requests a change to a preference."
""
"This function immediately writes the preference value to disk."
""
"It raises"
"\\scmindex{exn:unknown-preference}\\rawscm{exn:unknown-preference}"
"if the preference's default has not been set.")
(preferences:add-callback
(opt-> (symbol?
;; important that this arg only has a flat contract
;; so that no wrapper is created, so that
;; the weak box stuff works ...
(λ (x) (and (procedure? x) (procedure-arity-includes? x 2))))
(boolean?)
(-> void?))
((p f)
((weak? #f)))
"This function adds a callback which is called with a symbol naming a"
"preference and it's value, when the preference changes."
"\\rawscm{preferences:add-callback} returns a thunk, which when"
"invoked, removes the callback from this preference."
""
"If \\var{weak?} is true, the preferences system will only hold on to"
"the callback 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"
"\\iscmprocedure{preferences:set-un/marshall} before adding a callback."
""
"This function raises"
"\\scmindex{exn:unknown-preference}\\rawscm{exn:unknown-preference}"
"if the preference has not been set.")
(preferences:set-default
(symbol? any/c (any/c . -> . any) . -> . void?)
(symbol value test)
"This function must be called every time your application starts up, before any call to"
"@flink preferences:get %"
", "
"@flink preferences:set"
"(for any given preference)."
""
"If you use"
"@flink preferences:set-un/marshall %"
", you must call this function before calling it."
""
"This sets the default value of the preference \\var{symbol} to"
"\\var{value}. If the user has chosen a different setting,"
"the user's setting"
"will take precedence over the default value."
""
"The last argument, \\var{test} is used as a safeguard. That function is"
"called to determine if a preference read in from a file is a valid"
"preference. If \\var{test} returns \\rawscm{\\#t}, then the preference is"
"treated as valid. If \\var{test} returns \\rawscm{\\#f} then the default is"
"used.")
(preferences:set-un/marshall
(symbol? (any/c . -> . printable/c) (printable/c . -> . any/c) . -> . void?)
(symbol marshall unmarshall)
"\\rawscm{preference:set-un/marshall} is used to specify marshalling and"
"unmarshalling functions for the preference"
"\\var{symbol}. \\var{marshall} will be called when the users saves their"
"preferences to turn the preference value for \\var{symbol} into a"
"printable value. \\var{unmarshall} will be called when the user's"
"preferences are read from the file to transform the printable value"
"into it's internal representation. If \\rawscm{preference: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 "
"@flink preferences:set-default"
"for this preference, the default value is used."
""
"The \\var{marshall} function might be called with any value returned"
"from \\scheme{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."
""
"\\rawscm{preference:set-un/marshall} must be called before calling"
"@flink preferences:get %"
", "
"@flink preferences:set %"
".")
(preferences:restore-defaults (proc-doc/names
(-> void?) exn:make-unknown-preference
() (string? continuation-mark-set? . -> . exn:unknown-preference?)
"\\rawscm{(preferences:restore-defaults)} restores the users's configuration to the" (message continuation-marks)
"default preferences."))) @{Creates an unknown preference exception.})
(proc-doc/names
exn:unknown-preference?
(any/c . -> . boolean?)
(exn)
@{Determines if a value is an unknown preference exn.})
(parameter-doc
preferences:low-level-put-preferences
(parameter/c (-> (listof symbol?) (listof any/c) any))
put-preference
@{This parameter's value
is called when to save preference the preferences. Its interface should
be just like mzlib's @scheme[put-preference].})
(proc-doc/names
preferences:get
(symbol? . -> . any/c)
(symbol)
@{See also @scheme[preferences:set-default].
@scheme[preferences:get] returns the value for the preference
@scheme[symbol]. It raises
@index['("exn:unknown-preference")]{@scheme[exn:unknown-preference]}
@scheme[exn:unknown-preference]
if the preference's default has not been set.})
(proc-doc/names
preferences:set
(symbol? any/c . -> . void?)
(symbol value)
@{See also @scheme[preferences:set-default].
@scheme[preferences:set-preference] sets the preference
@scheme[symbol] to @scheme[value]. This should be called when the
users requests a change to a preference.
This function immediately writes the preference value to disk.
It raises
@index['("exn:unknown-preference")]{@scheme[exn:unknown-preference]}
if the preference's default has not been set.})
(proc-doc/names
preferences:add-callback
(->* (symbol?
;; important that this arg only has a flat contract
;; so that no wrapper is created, so that
;; the weak box stuff works ...
(λ (x) (and (procedure? x) (procedure-arity-includes? x 2))))
(boolean?)
(-> void?))
((p f)
((weak? #f)))
@{This function adds a callback which is called with a symbol naming a
preference and it's value, when the preference changes.
@scheme[preferences:add-callback] returns a thunk, which when
invoked, removes the callback from this preference.
If @scheme[weak?] is true, the preferences system will only hold on to
the callback 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
@scheme[preferences:set-un/marshall] before adding a callback.
This function raises
@index['("exn:unknown-preference")]{@scheme[exn:unknown-preference]}
@scheme[exn:unknown-preference]
if the preference has not been set.})
(proc-doc/names
preferences:set-default
(symbol? any/c (any/c . -> . any) . -> . void?)
(symbol value test)
@{This function must be called every time your application starts up, before any call to
@scheme[preferences:get] or
@scheme[preferences:set]
(for any given preference).
If you use
@scheme[preferences:set-un/marshall],
you must call this function before calling it.
This sets the default value of the preference @scheme[symbol] to
@scheme[value]. If the user has chosen a different setting,
the user's setting
will take precedence over the default value.
The last argument, @scheme[test] is used as a safeguard. That function is
called to determine if a preference read in from a file is a valid
preference. If @scheme[test] returns @scheme[#t], then the preference is
treated as valid. If @scheme[test] returns @scheme[#f] then the default is
used.})
(proc-doc/names
preferences:set-un/marshall
(symbol? (any/c . -> . printable/c) (printable/c . -> . any/c) . -> . void?)
(symbol marshall unmarshall)
@{@scheme[preference:set-un/marshall] is used to specify marshalling and
unmarshalling functions for the preference
@scheme[symbol]. @scheme[marshall] will be called when the users saves their
preferences to turn the preference value for @scheme[symbol] into a
printable value. @scheme[unmarshall] will be called when the user's
preferences are read from the file to transform the printable value
into it's internal representation. If @scheme[preference: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
@scheme[preferences:set-default]
for this preference, the default value is used.
The @scheme[marshall] function might be called with any value returned
from @scheme[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.
@scheme[preference:set-un/marshall] must be called before calling
@scheme[preferences:get],
@scheme[preferences:set].})
(proc-doc/names
preferences:restore-defaults
(-> void?)
()
@{@scheme[(preferences:restore-defaults)]
restores the users's configuration to the
default preferences.}))

5
collects/framework/test.ss
View File

@ -4,11 +4,6 @@
(require scribble/srcdoc) (require scribble/srcdoc)
(require/doc scheme/base scribble/manual) (require/doc scheme/base scribble/manual)
(define-syntax (provide/contract/docs stx)
(syntax-case stx ()
[(_ (name contract docs ...) ...)
(syntax (provide/contract (name contract) ...))]))
(define (test:top-level-focus-window-has? pred) (define (test:top-level-focus-window-has? pred)
(let ([tlw (get-top-level-focus-window)]) (let ([tlw (get-top-level-focus-window)])
(and tlw (and tlw

0
collects/scribblings/framework/framework-application.scrbl → collects/scribblings/framework/application.scrbl
View File

0
collects/scribblings/framework/framework-autosave.scrbl → collects/scribblings/framework/autosave.scrbl
View File

0
collects/scribblings/framework/framework-canvas.scrbl → collects/scribblings/framework/canvas.scrbl
View File

0
collects/scribblings/framework/framework-color-model.scrbl → collects/scribblings/framework/color-model.scrbl
View File

0
collects/scribblings/framework/framework-color-prefs.scrbl → collects/scribblings/framework/color-prefs.scrbl
View File

0
collects/scribblings/framework/framework-color.scrbl → collects/scribblings/framework/color.scrbl
View File

0
collects/scribblings/framework/framework-comment-box.scrbl → collects/scribblings/framework/comment-box.scrbl
View File

0
collects/scribblings/framework/framework-editor.scrbl → collects/scribblings/framework/editor.scrbl
View File

0
collects/scribblings/framework/framework-exit.scrbl → collects/scribblings/framework/exit.scrbl
View File

0
collects/scribblings/framework/framework-finder.scrbl → collects/scribblings/framework/finder.scrbl
View File

0
collects/scribblings/framework/framework-frame.scrbl → collects/scribblings/framework/frame.scrbl
View File

65
collects/scribblings/framework/framework.scrbl
View File

@ -5,9 +5,13 @@
@title{@bold{Framework}: PLT GUI Application Framework} @title{@bold{Framework}: PLT GUI Application Framework}
The framework provides these libraries:
@itemize{ @itemize{
@item{Mode}
@item{``Cannot parse docs for handler:open-file''}
@item{Check indexing in preferences:get}
}
@itemize{
@item{@bold{Entire Framework} @item{@bold{Entire Framework}
@itemize{ @itemize{
@ -74,8 +78,7 @@ The precise set of exported names is:
@scheme[preferences:restore-defaults]. @scheme[preferences:restore-defaults].
}} }}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @bold{Thanks}
@section{Thanks}
Thanks to Shriram Krishnamurthi, Cormac Flanagan, Matthias Thanks to Shriram Krishnamurthi, Cormac Flanagan, Matthias
Felleisen, Ian Barland, Gann Bierner, Richard Cobbe, Dan Felleisen, Ian Barland, Gann Bierner, Richard Cobbe, Dan
@ -84,33 +87,33 @@ Johnathan Franklin, Mark Krentel, Corky Cartwright, Michael
Ernst, Kennis Koldewyn, Bruce Duba, and many others for Ernst, Kennis Koldewyn, Bruce Duba, and many others for
their feedback and help. their feedback and help.
@include-section["application.scrbl"]
@include-section["framework-application.scrbl"] @include-section["autosave.scrbl"]
@include-section["framework-autosave.scrbl"] @include-section["canvas.scrbl"]
@include-section["framework-canvas.scrbl"] @include-section["color-model.scrbl"]
@include-section["framework-color-model.scrbl"] @include-section["color-prefs.scrbl"]
@include-section["framework-color-prefs.scrbl"] @include-section["color.scrbl"]
@include-section["framework-color.scrbl"] @include-section["comment-box.scrbl"]
@include-section["framework-comment-box.scrbl"] @include-section["editor.scrbl"]
@include-section["framework-editor.scrbl"] @include-section["exit.scrbl"]
@include-section["framework-exit.scrbl"] @include-section["finder.scrbl"]
@include-section["framework-finder.scrbl"] @include-section["frame.scrbl"]
@include-section["framework-frame.scrbl"] @include-section["group.scrbl"]
@include-section["framework-group.scrbl"] @include-section["gui-utils.scrbl"]
@include-section["framework-handler.scrbl"] @include-section["handler.scrbl"]
@include-section["framework-icon.scrbl"] @include-section["icon.scrbl"]
@include-section["framework-keymap.scrbl"] @include-section["keymap.scrbl"]
@;include-section["framework-main.scrbl"] @include-section["menu.scrbl"]
@include-section["framework-menu.scrbl"] @include-section["mode.scrbl"]
@;include-section["framework-mode.scrbl"] @include-section["number-snip.scrbl"]
@include-section["framework-number-snip.scrbl"] @include-section["panel.scrbl"]
@include-section["framework-panel.scrbl"] @include-section["pasteboard.scrbl"]
@include-section["framework-pasteboard.scrbl"] @include-section["path-utils.scrbl"]
@include-section["framework-path-utils.scrbl"] @include-section["preferences.scrbl"]
@include-section["framework-preferences.scrbl"] @include-section["preferences-text.scrbl"]
@include-section["framework-scheme.scrbl"] @include-section["scheme.scrbl"]
@include-section["framework-text.scrbl"] @include-section["text.scrbl"]
@include-section["framework-test.scrbl"] @include-section["test.scrbl"]
@include-section["framework-version.scrbl"] @include-section["version.scrbl"]
@index-section[] @index-section[]

0
collects/scribblings/framework/framework-group.scrbl → collects/scribblings/framework/group.scrbl
View File

10
collects/scribblings/framework/gui-utils.scrbl Normal file
View File

@ -0,0 +1,10 @@
#lang scribble/doc
@(require scribble/manual scribble/extract)
@(require (for-label framework/framework))
@(require (for-label scheme/gui))
@title{GUI Utilities}
@(require framework/framework-docs)
@(defmodule framework/gui-utils)
@(include-extracted (lib "gui-utils.ss" "framework"))

0
collects/scribblings/framework/framework-handler.scrbl → collects/scribblings/framework/handler.scrbl
View File

0
collects/scribblings/framework/framework-icon.scrbl → collects/scribblings/framework/icon.scrbl
View File

0
collects/scribblings/framework/framework-keymap.scrbl → collects/scribblings/framework/keymap.scrbl
View File

0
collects/scribblings/framework/framework-main.scrbl → collects/scribblings/framework/main.scrbl
View File

0
collects/scribblings/framework/framework-menu.scrbl → collects/scribblings/framework/menu.scrbl
View File

0
collects/scribblings/framework/framework-mode.scrbl → collects/scribblings/framework/mode.scrbl
View File

0
collects/scribblings/framework/framework-number-snip.scrbl → collects/scribblings/framework/number-snip.scrbl
View File

0
collects/scribblings/framework/framework-panel.scrbl → collects/scribblings/framework/panel.scrbl
View File

0
collects/scribblings/framework/framework-pasteboard.scrbl → collects/scribblings/framework/pasteboard.scrbl
View File

0
collects/scribblings/framework/framework-path-utils.scrbl → collects/scribblings/framework/path-utils.scrbl
View File

10
collects/scribblings/framework/preferences-text.scrbl Normal file
View File

@ -0,0 +1,10 @@
#lang scribble/doc
@(require scribble/manual scribble/extract)
@(require (for-label framework/framework))
@(require (for-label scheme/gui))
@title{Preferences, Textual}
@(require framework/framework-docs)
@(defmodule framework/preferences)
@(include-extracted (lib "preferences.ss" "framework"))

0
collects/scribblings/framework/framework-preferences.scrbl → collects/scribblings/framework/preferences.scrbl
View File

0
collects/scribblings/framework/framework-scheme.scrbl → collects/scribblings/framework/scheme.scrbl
View File

0
collects/scribblings/framework/framework-test.scrbl → collects/scribblings/framework/test.scrbl
View File

0
collects/scribblings/framework/framework-text.scrbl → collects/scribblings/framework/text.scrbl
View File

0
collects/scribblings/framework/framework-version.scrbl → collects/scribblings/framework/version.scrbl
View File