diff --git a/collects/sirmail/folderr.ss b/collects/sirmail/folderr.ss index 6ed6796755..c0c3aa05d0 100644 --- a/collects/sirmail/folderr.ss +++ b/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@ diff --git a/collects/sirmail/readr.ss b/collects/sirmail/readr.ss index a5afef2881..28d48cb60f 100644 --- a/collects/sirmail/readr.ss +++ b/collects/sirmail/readr.ss @@ -73,29 +73,15 @@ (define got-started? #f) (define (show-error x) - (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)) - (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))))) + (show-error-message-box x main-frame) + (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) diff --git a/collects/sirmail/sendr.ss b/collects/sirmail/sendr.ss index d03a70bd15..b649842c04 100644 --- a/collects/sirmail/sendr.ss +++ b/collects/sirmail/sendr.ss @@ -49,12 +49,7 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (show-error x main-frame) - (message-box "Error" - (if (exn? x) - (exn-message x) - (format "Strange exception: ~s" x)) - main-frame - '(ok stop))) + (show-error-message-box x main-frame)) (define FRAME-WIDTH 560) (define FRAME-HEIGHT 600) diff --git a/collects/sirmail/sirmails.ss b/collects/sirmail/sirmails.ss index ef78a58fd0..7ff7e298d4 100644 --- a/collects/sirmail/sirmails.ss +++ b/collects/sirmail/sirmails.ss @@ -31,6 +31,8 @@ find string->regexp + show-error-message-box + as-background make-fixed-width diff --git a/collects/sirmail/utilr.ss b/collects/sirmail/utilr.ss index 531d9c9cbf..9e0729d000 100644 --- a/collects/sirmail/utilr.ss +++ b/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)]