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

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

@ -42,8 +42,12 @@ 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)
(cond
[successful-last-time?
(let ([mb-ans (let ([mb-ans
(message-box/custom (message-box/custom
(string-constant error-saving-preferences-title) (string-constant error-saving-preferences-title)
@ -53,12 +57,15 @@ the state transitions / contracts are:
(string-constant cancel) (string-constant cancel)
#f #f
#f ;;parent #f ;;parent
'(default=2 caution))]) '(default=1 caution))])
(case mb-ans (case mb-ans
[(2 #f) (void)] [(2 #f) (void)]
[(1) [(1)
(put-preferences ps vs second-fail-func)]))) (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))))))
(begin0
(put-preferences (put-preferences
ps ps
vs vs
fail-func))) 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))