(module drscheme-ui-tool mzscheme
(require (lib "class.ss")
(lib "mred.ss" "mred")
(lib "framework.ss" "framework")
(lib "tool.ss" "drscheme")
(lib "unit.ss"))
(require (prefix drlink: "drscheme-ui.ss")
"../../info.ss")
(provide tool@)
(define BACKTRACE-NO-MESSAGE "No message.")
(define UI-MODULE-SPEC
`(,(#%info-lookup 'distribution-method)
"drscheme-ui.ss"
,(#%info-lookup 'distribution-package-spec)
"plt" "gui"))
(define (close/eventspace f)
(let ([es (current-eventspace)])
(lambda args
(parameterize [(current-eventspace es)]
(apply f args)))))
(define tool@
(unit
(import drscheme:tool^)
(export drscheme:tool-exports^)
(define has-backtrace?
(close/eventspace
(lambda (exn)
(and (exn? exn)
(pair? (continuation-mark-set->list
(exn-continuation-marks exn)
(drscheme:debug:get-cm-key)))))))
(define show-backtrace
(close/eventspace
(lambda (exn)
(let* [(tracekey (drscheme:debug:get-cm-key))
(cms (if (exn? exn)
(continuation-mark-set->list
(exn-continuation-marks exn)
tracekey)
null))]
(drscheme:debug:show-backtrace-window
(or (exn-message exn) BACKTRACE-NO-MESSAGE)
cms)))))
(define show-source
(close/eventspace
(lambda (src pos span)
(drscheme:debug:open-and-highlight-in-file
(make-srcloc src #f #f pos span)))))
(drlink:initialize has-backtrace?
show-backtrace
show-source)
(define interactions-text-mixin
(mixin ((class->interface drscheme:rep:text%)) ()
(define (setup-helper-module)
(let ((drscheme-ns (current-namespace))
(user-ns (send this get-user-namespace)))
(parameterize ((current-namespace user-ns))
((dynamic-require UI-MODULE-SPEC 'initialize)
has-backtrace?
show-backtrace
show-source))))
(define/override (reset-console)
(super reset-console)
(setup-helper-module))
(super-instantiate ())))
(drscheme:get/extend:extend-interactions-text interactions-text-mixin)
(define (phase1) (void))
(define (phase2) (void))
))
)