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

added a guard against recursive calls to exit

Browse Source 
original commit: 04791041223649bcbbd1acadd82df376341fa745
This commit is contained in:
Robby Findler 1996-11-12 17:02:29 +00:00
parent bd2b320134
commit c03c506456
1 changed files with 24 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/mred/exit.ss
View File

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