..

original commit: ddab93566904b59557bc505e49eef34ab5867239

collects/framework/framework.ss

@@ -249,6 +249,27 @@
     (-> void?)
     ()
     "Hides the preferences dialog.")
+   (preferences:add-on-close-dialog-callback
+    ((-> void?) . -> . void?)
+    (cb)
+    "Registers \\var{cb}. Next time the"
+    "user clicks the OK button the preferences"
+    "dialog, all of the \\var{cb} functions"
+    "are called. If any of them return \\scm{\\#f},"
+    "the dialog is not closed."
+    ""
+    "See also"
+    "@flink preferences:add-on-close-dialog-callback")
+   (preferences:add-can-close-dialog-callback
+    ((-> boolean?) . -> . void?)
+    (cb)
+    "Registers \\var{cb}. Next time the"
+    "user clicks the OK button the preferences"
+    "dialog, all of the \\var{cb} functions"
+    "are called, assuming that each of the callbacks"
+    "passed to"
+    "@flink preferences:add-on-close-dialog-callback"
+    "succeed.")
 
    (autosave:register
     ((and/f (is-a?/c autosave:autosavable<%>)

collects/framework/private/preferences.ss

@@ -669,18 +669,28 @@
           (when preferences-dialog
             (send preferences-dialog added-pane))))
       
-      (define hide-dialog
-        (lambda ()
-          (when preferences-dialog
-            (send preferences-dialog show #f))))
+      (define (hide-dialog)
+	(when preferences-dialog
+	  (send preferences-dialog show #f)))
       
-      (define show-dialog
-        (lambda ()
-          (save)
-          (if preferences-dialog
-              (send preferences-dialog show #t)
-              (set! preferences-dialog
-                    (make-preferences-dialog)))))
+      (define (show-dialog)
+	(save)
+	(if preferences-dialog
+	    (send preferences-dialog show #t)
+	    (set! preferences-dialog
+		  (make-preferences-dialog))))
+
+      (define (add-can-close-dialog-callback cb)
+	(set! can-close-dialog-callbacks
+	      (cons cb can-close-dialog-callbacks)))
+
+      (define (add-on-close-dialog-callback cb)
+	(set! on-close-dialog-callbacks
+	      (cons cb on-close-dialog-callbacks)))
+
+      (define on-close-dialog-callbacks null)
+
+      (define can-close-dialog-callbacks null)
       
       (define make-preferences-dialog
         (lambda ()
@@ -747,8 +757,13 @@
                                                 single-panel
                                                 bottom-panel)))))]
                    [ok-callback (lambda args
-                                  (save)
-                                  (hide-dialog))]
+				  (when (andmap (lambda (f) (f))
+						can-close-dialog-callbacks)
+				    (for-each
+				     (lambda (f) (f))
+				     on-close-dialog-callbacks)
+				    (save)
+				    (hide-dialog)))]
                    [cancel-callback (lambda (_1 _2)
                                       (hide-dialog)
                                       (install-stashed-preferences stashed-prefs))])

collects/framework/private/sig.ss

@@ -184,6 +184,9 @@
      add-to-warnings-checkbox-panel
      add-to-scheme-checkbox-panel
      
+     add-on-close-dialog-callback
+     add-can-close-dialog-callback
+
      show-dialog
      hide-dialog))
   (define-signature framework:preferences^