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

re-arranged exit callbacks to fix bugs

Browse Source 
original commit: 698d9f5722deb10dcff6299cbc8c9e8e63eb0ae3
This commit is contained in:
Robby Findler 1997-05-19 16:54:32 +00:00
parent aed196dd52
commit 5854cf6ec5
1 changed files with 14 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/mred/exit.ss
View File

@ -34,28 +34,27 @@
[else (loop (cdr cb-list))]))))) [else (loop (cdr cb-list))])))))
(define -exit (define -exit
(let ([exiting? #f]) (let*-values ([(exiting?) #f]
[(w capW)
(if (eq? wx:platform 'macintosh)
(values "quit" "Quit")
(values "exit" "Exit"))]
[(message)
(string-append "Are you sure you want to "
w
"?")])
(lambda () (lambda ()
(unless exiting? (unless exiting?
(dynamic-wind (dynamic-wind
(lambda () (set! exiting? #t)) (lambda () (set! exiting? #t))
(lambda () (lambda ()
(let/ec k (let/ec k
(when (and (mred:preferences:get-preference 'mred:verify-exit) (when (mred:preferences:get-preference 'mred:verify-exit)
(not (let ([w (if (eq? wx:platform 'macintosh) (unless (mred:gui-utils:get-choice
"quit" message capW "Cancel")
"exit")] (k #f)))
[capW (if (eq? wx:platform 'macintosh)
"Quit"
"Exit")])
(mred:gui-utils:get-choice
(string-append "Are you sure you want to " w "?")
capW "Cancel"))))
(k #f))
(run-exit-callbacks) (run-exit-callbacks)
(if (null? exit-callbacks) (if (null? exit-callbacks)
(exit) (exit)
#f))) #f)))
(lambda () (set! exiting? #f)))))))) (lambda () (set! exiting? #f))))))))