...

original commit: c69513305c00f0dbeb6b3d5764b81bc50d8905ea

collects/framework/exit.ss

@@ -30,32 +30,29 @@
   
   (define exiting? #f)
 
-  (define (can-exit?) (andmap (lambda (cb) (cb)) can?-callbacks))
+  (define (can-exit?) (and (andmap (lambda (cb) (cb)) can?-callbacks)
+			   (user-oks-exit)))
   (define (on-exit) (for-each (lambda (cb) (cb)) on-callbacks))
 
+  (define (user-oks-exit)
+    (if (preferences:get 'framework:verify-exit)
+	(let*-values ([(w capw)
+		       (if (eq? (system-type) 'windows)
+			   (values "exit" "Exit")
+			   (values "quit" "Quit"))]
+		      [(message)
+		       (string-append "Are you sure you want to "
+				      w
+				      "?")]
+		      [(user-says) (gui-utils:get-choice message capw "Cancel")])
+	  user-says)
+	#t))
+
   (define -exit
-    (opt-lambda ([just-ran-callbacks? #f])
+    (opt-lambda ()
       (unless exiting?
-	(dynamic-wind
+	(set! exiting? #t)
-	 (lambda () (set! exiting? #t))
+	(when (can-exit?)
-	 (lambda ()
+	  (on-exit)
-	   (if (and (can-exit?)
+	  (exit))
-		    (let*-values ([(w capw)
+	(set! exiting? #f)))))
-				   (if (eq? (system-type) 'windows)
-				       (values "exit" "Exit")
-				       (values "quit" "Quit"))]
-				  [(message)
-				   (string-append "Are you sure you want to "
-						  w
-						  "?")])
-		      (printf "showing dialog~n")
-		      (if (preferences:get 'framework:verify-exit)
-			  (if (gui-utils:get-choice message capw "Cancel")
-			      #f
-			      #t)
-			  #t)))
-	       (begin
-		 (on-exit)
-		 (printf "~a~n" '(exit)))
-	       #f))
-	 (lambda () (set! exiting? #f)))))))

collects/framework/frameworks.ss

@@ -59,6 +59,7 @@
   (insert-on-callback
    insert-can?-callback
    can-exit?
+   on-exit
    exit))
 
 (define-signature framework:gui-utils^

collects/framework/main.ss

@@ -166,7 +166,6 @@
   (let ([at-most-one
 	 (let ([skip? #f])
 	   (lambda (answer thunk)
-	     (printf "at most one: skip? ~a~n" skip?)
 	     (if skip?
 		 answer
 		 (begin
@@ -178,29 +177,23 @@
 
 	  ;; empty test
 	  (lambda ()
-	    (printf "empty test~n")
+	    (if (preferences:get 'framework:exit-when-no-frames)
-	    (begin0
+		(at-most-one #t
-	     (if (preferences:get 'framework:exit-when-no-frames)
+			     (lambda ()
-		 (at-most-one #t
+			       (exit:can-exit?)))
-			      (lambda ()
+		#t))
-				(printf "empty test.1~n")
-				(exit:can-exit?)))
-		 #t)
-	     (printf "empty test done~n")))
 	  
 	  ;; empty close down
 	  (lambda () 
-	    (printf "empty close down~n")
 	    (if (preferences:get 'framework:exit-when-no-frames)
 		(at-most-one (void) 
 			     (lambda ()
-			       (printf "empty close down.1~n")
+			       (exit:on-exit)
-			       (exit:exit)))
+			       (exit)))
 		(void))))
     
     (exit:insert-can?-callback
      (lambda ()
-       (printf "exit callback~n")
        (at-most-one
 	#t
 	(lambda ()
@@ -214,7 +207,6 @@
 			 "Saving Prefs"
 			 (format "Error saving preferences: ~a"
 				 (exn-message exn))))])
-       (printf "saving preferences~n")
        (preferences:save))))
   
   ;(wx:application-file-handler edit-file) ;; how to handle drag and drop?