...

original commit: c69513305c00f0dbeb6b3d5764b81bc50d8905ea

collects/framework/exit.ss

@@ -30,16 +30,12 @@
   
   (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 -exit
+  (define (user-oks-exit)
-    (opt-lambda ([just-ran-callbacks? #f])
+    (if (preferences:get 'framework:verify-exit)
-      (unless exiting?
-	(dynamic-wind
-	 (lambda () (set! exiting? #t))
-	 (lambda ()
-	   (if (and (can-exit?)
 	(let*-values ([(w capw)
 		       (if (eq? (system-type) 'windows)
 			   (values "exit" "Exit")
@@ -47,15 +43,16 @@
 		      [(message)
 		       (string-append "Are you sure you want to "
 				      w
-						  "?")])
+				      "?")]
-		      (printf "showing dialog~n")
+		      [(user-says) (gui-utils:get-choice message capw "Cancel")])
-		      (if (preferences:get 'framework:verify-exit)
+	  user-says)
-			  (if (gui-utils:get-choice message capw "Cancel")
+	#t))
-			      #f
+
-			      #t)
+  (define -exit
-			  #t)))
+    (opt-lambda ()
-	       (begin
+      (unless exiting?
+	(set! exiting? #t)
+	(when (can-exit?)
 	  (on-exit)
-		 (printf "~a~n" '(exit)))
+	  (exit))
-	       #f))
+	(set! exiting? #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")
-	    (begin0
 	    (if (preferences:get 'framework:exit-when-no-frames)
 		(at-most-one #t
 			     (lambda ()
-				(printf "empty test.1~n")
 			       (exit:can-exit?)))
-		 #t)
+		#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?