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

fixed bugs

Browse Source 
original commit: 24e15835722a9d7beee085e296b49fee68ce0b9a
This commit is contained in:
Robby Findler 1996-07-26 04:36:26 +00:00
parent 8cc5378874
commit d0eec5a994
2 changed files with 18 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/mred/edit.ss
View File

@ -29,16 +29,6 @@
[auto-save-out-of-date? #t]
[auto-save-error? #f])
(public
[locked? #f]
[lock
(lambda (v)
(set! locked? v)
(super-lock v))]
[on-focus
(lambda (in?)
'(send (ivar (get-frame) save-icon) show (and in? (modified?)))
'(send (ivar (get-frame) lock-icon) show (and in? locked?))
(super-on-focus in?))]
[get-file (lambda (d) (let ([v (mred:finder:get-file d)])
(if v
v

28
collects/mred/prefs.ss
View File

@ -80,14 +80,17 @@
(define set-preference
(lambda (p value)
(let/ec k
(let ([pref (hash-table-get preferences p
(lambda ()
(let ([pref (make-pref value null)])
(k (hash-table-put! preferences p pref)))))])
(set-pref-value! pref value)
(for-each (lambda (x) (x p value)) (pref-callbacks pref))))))
(let ([pref (hash-table-get preferences p (lambda () #f))])
(cond
[(pref? pref)
(set-pref-value! pref value)
(for-each (lambda (x) (x p value)) (pref-callbacks pref))]
[(or (marshalled? pref)
(not pref))
(hash-table-put! preferences p (make-pref value null))]
[else
(error 'prefs.ss "robby error.0: ~a" pref)]))))
(define set-preference-default
(lambda (p value)
(hash-table-get preferences p
@ -144,8 +147,13 @@
(cond
[(and (pref? ht-pref) unmarshall-struct)
(set-preference p ((un/marshall-unmarshall unmarshall-struct) marshalled))]
;; in this case, assume that no marshalling/unmarshalling
;; is going to take place with the pref, since an unmarshalled
;; pref was already there.
[(pref? ht-pref)
(hash-table-put! preferences p (make-marshalled marshalled))]
(set-preference p marshalled)]
[(marshalled? ht-pref) (set-marshalled-data! ht-pref marshalled)]
[(and (not ht-pref) unmarshall-struct)
(set-preference p ((un/marshall-unmarshall unmarshall-struct) marshalled))]
@ -193,7 +201,7 @@
"Use platform-specific file dialogs?" (eq? (get-preference 'mred:file-dialogs) 'common))
(make-check (lambda (_ command)
(set-preference 'mred:status-line (send command checked?)))
"Display status Information?" (get-preference 'mred:status-line))
"Show Clock?" (get-preference 'mred:status-line))
(make-check (lambda (_ command)
(set-preference 'mred:verify-exit (send command checked?)))
"Verify exit?" (get-preference 'mred:verify-exit))