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

added in ability to disallow changes to the preferences

Browse Source 
via the callbacks

original commit: 8f91d9a2f510d2e0ac378c3642cd9ec7eb4c8f19
This commit is contained in:
Robby Findler 1996-08-28 21:45:44 +00:00
parent 06986d6750
commit 83c53b0369
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/mred/prefs.ss
View File

@ -48,7 +48,7 @@
(lambda () (lambda ()
(set-pref-callbacks! pref (mzlib:function:remove callback (pref-callbacks pref) eq?))))] (set-pref-callbacks! pref (mzlib:function:remove callback (pref-callbacks pref) eq?))))]
[(pref? ans) [(pref? ans)
(set-pref-callbacks! ans (cons callback (pref-callbacks ans))) (set-pref-callbacks! ans (append (pref-callbacks ans) (list callback)))
(lambda () (lambda ()
(set-pref-callbacks! ans (mzlib:function:remove callback (pref-callbacks ans) eq?)))] (set-pref-callbacks! ans (mzlib:function:remove callback (pref-callbacks ans) eq?)))]
[(not ans) (raise (mred:exn:make-exn:unknown-preference [(not ans) (raise (mred:exn:make-exn:unknown-preference
@ -83,8 +83,8 @@
(let ([pref (hash-table-get preferences p (lambda () #f))]) (let ([pref (hash-table-get preferences p (lambda () #f))])
(cond (cond
[(pref? pref) [(pref? pref)
(set-pref-value! pref value) (when (andmap (lambda (x) (x p value)) (pref-callbacks pref))
(for-each (lambda (x) (x p value)) (pref-callbacks pref))] (set-pref-value! pref value))]
[(or (marshalled? pref) [(or (marshalled? pref)
(not pref)) (not pref))
(hash-table-put! preferences p (make-pref value null))] (hash-table-put! preferences p (make-pref value null))]
@ -206,6 +206,9 @@
(make-check (lambda (_ command) (make-check (lambda (_ command)
(set-preference 'mred:verify-exit (send command checked?))) (set-preference 'mred:verify-exit (send command checked?)))
"Verify exit?" (get-preference 'mred:verify-exit)) "Verify exit?" (get-preference 'mred:verify-exit))
(make-check (lambda (_ command)
(set-preference 'mred:verify-change-format (send command checked?)))
"Ask before changing save format?" (get-preference 'mred:verify-change-format))
main))))) main)))))
(define make-run-once (define make-run-once