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

made the preferences dialog nagging be less onerous when the preference saving happens

Browse Source 
svn: r7455
This commit is contained in:
Robby Findler 2007-10-08 19:16:11 +00:00
parent 7bcba19409
commit 0c1b099a0c
1 changed files with 27 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/framework/private/preferences.ss
View File

@ -42,23 +42,30 @@ the state transitions / contracts are:
[prefix frame: framework:frame^]) [prefix frame: framework:frame^])
(export framework:preferences^) (export framework:preferences^)
(define successful-last-time? #t)
(define (put-preferences/gui ps vs) (define (put-preferences/gui ps vs)
(define failed? #f)
(define (fail-func path) (define (fail-func path)
(let ([mb-ans (cond
(message-box/custom [successful-last-time?
(string-constant error-saving-preferences-title) (let ([mb-ans
(format (string-constant prefs-file-locked) (message-box/custom
(path->string path)) (string-constant error-saving-preferences-title)
(string-constant try-again) (format (string-constant prefs-file-locked)
(string-constant cancel) (path->string path))
#f (string-constant try-again)
#f ;;parent (string-constant cancel)
'(default=2 caution))]) #f
(case mb-ans #f ;;parent
[(2 #f) (void)] '(default=1 caution))])
[(1) (case mb-ans
(put-preferences ps vs second-fail-func)]))) [(2 #f) (void)]
[(1)
(put-preferences ps vs second-fail-func)]))]
[else
(set! failed? #t)]))
(define (second-fail-func path) (define (second-fail-func path)
(set! failed? #t)
(message-box (message-box
(string-constant error-saving-preferences-title) (string-constant error-saving-preferences-title)
(format (string-constant prefs-file-still-locked) (format (string-constant prefs-file-still-locked)
@ -71,10 +78,12 @@ the state transitions / contracts are:
(string-constant drscheme) (string-constant drscheme)
(format (string-constant error-saving-preferences) (format (string-constant error-saving-preferences)
(exn-message x)))))) (exn-message x))))))
(put-preferences (begin0
ps (put-preferences
vs ps
fail-func))) vs
fail-func)
(set! successful-last-time? (not failed?)))))
;; ppanel-tree = ;; ppanel-tree =
;; (union (make-ppanel-leaf string (union #f panel) (panel -> panel)) ;; (union (make-ppanel-leaf string (union #f panel) (panel -> panel))