57 lines
2.2 KiB
Scheme
57 lines
2.2 KiB
Scheme
|
|
(module init mzscheme
|
|
(require (lib "string-constant.ss" "string-constants")
|
|
(lib "unitsig.ss")
|
|
"drsig.ss"
|
|
(lib "list.ss")
|
|
(lib "mred.ss" "mred"))
|
|
|
|
(provide init@)
|
|
|
|
(define init@
|
|
(unit/sig drscheme:init^
|
|
(import)
|
|
|
|
(define original-output-port (current-output-port))
|
|
(define original-error-port (current-error-port))
|
|
|
|
(define primitive-eval (current-eval))
|
|
(define primitive-load (current-load))
|
|
|
|
(define system-custodian (current-custodian))
|
|
(define system-eventspace (current-eventspace))
|
|
(define system-thread (current-thread))
|
|
(define system-namespace (current-namespace))
|
|
(define first-dir (current-directory))
|
|
|
|
(define original-error-display-handler (error-display-handler))
|
|
|
|
(define error-display-handler-message-box-title
|
|
(make-parameter (string-constant drscheme-internal-error)))
|
|
|
|
;; override error-display-handler to duplicate the error
|
|
;; message in both the standard place (as defined by the
|
|
;; current error-display-handler) and in a message box
|
|
;; identifying the error as a drscheme internal error.
|
|
(error-display-handler
|
|
(λ (msg exn)
|
|
|
|
;; this may raise an exception if the port is gone.
|
|
(with-handlers ([exn:fail? (λ (x) (void))])
|
|
(original-error-display-handler msg exn))
|
|
|
|
(let ([title (error-display-handler-message-box-title)])
|
|
(let ([text (let ([p (open-output-string)])
|
|
(parameterize ([current-error-port p]
|
|
[current-output-port p])
|
|
(original-error-display-handler msg exn))
|
|
(get-output-string p))])
|
|
|
|
(if (eq? (current-eventspace) system-eventspace)
|
|
(message-box title text #f '(stop ok))
|
|
(parameterize ([current-eventspace system-eventspace]
|
|
[current-custodian system-custodian])
|
|
(queue-callback
|
|
(λ ()
|
|
(message-box title text #f '(stop ok)))))))))))))
|