move error-dialog code to utils

svn: r2802

collects/sirmail/folderr.ss

@@ -15,7 +15,7 @@
   
   (require (lib "hierlist-sig.ss" "hierlist"))
 
-  (require (lib "openssl.ss" "openssl"))
+  (require (lib "mzssl.ss" "openssl"))
   
   (provide folder@)
   (define folder@

collects/sirmail/readr.ss

@@ -73,29 +73,15 @@
       (define got-started? #f)
 
       (define (show-error x)
-	(let ([sp (open-output-string)])
+	(show-error-message-box x main-frame)
-	  ;; use error display handler in case
+	(when (not got-started?)
-	  ;; errortrace (or something else) is
+	  (when (eq? 'yes (confirm-box "Startup Error"
-	  ;; installed
+				       (string-append
-	  (parameterize ([current-output-port sp]
+					"Looks like you didn't even get started. "
-			 [current-error-port sp])
+					"Set preferences (so you're ready to try again)?")
-	    ((error-display-handler)
+				       #f
-	     (if (exn? x)
+				       '(app)))
-		 (exn-message x)
+	    (show-pref-dialog))))
-		 (format "uncaught exn: ~s" x))
-	     x))
-	  (message-box "Error" 
-		       (get-output-string sp)
-		       main-frame
-		       '(ok stop))
-	  (when (not got-started?)
-	    (when (eq? 'yes (confirm-box "Startup Error"
-					 (string-append
-					  "Looks like you didn't even get started. "
-					  "Set preferences (so you're ready to try again)?")
-					 #f
-					 '(app)))
-	      (show-pref-dialog)))))
 
       (initial-exception-handler
        (lambda (x)

collects/sirmail/sendr.ss

@@ -49,12 +49,7 @@
       ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
       (define (show-error x main-frame)
-	(message-box "Error" 
+	(show-error-message-box x main-frame))
-		     (if (exn? x)
-			 (exn-message x)
-			 (format "Strange exception: ~s" x))
-		     main-frame
-		     '(ok stop)))
         
       (define FRAME-WIDTH 560)
       (define FRAME-HEIGHT 600)

collects/sirmail/sirmails.ss

@@ -31,6 +31,8 @@
      find
      string->regexp
 
+     show-error-message-box
+
      as-background
 
      make-fixed-width

collects/sirmail/utilr.ss

@@ -96,6 +96,25 @@
 
       ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+      (define (show-error-message-box x main-frame)
+	(let ([sp (open-output-string)])
+	  ;; use error display handler in case
+	  ;; errortrace (or something else) is
+	  ;; installed
+	  (parameterize ([current-output-port sp]
+			 [current-error-port sp])
+	    ((error-display-handler)
+	     (if (exn? x)
+		 (exn-message x)
+		 (format "uncaught exn: ~s" x))
+	     x))
+	  (message-box "Error" 
+		       (get-output-string sp)
+		       main-frame
+		       '(ok stop))))
+
+      ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
       (define (break-really-hard? set-d!)
 	(let* ([d (make-object dialog% "Danger")]
 	       [p (make-object vertical-pane% d)]