plt/gui/drscheme-ui-tool.ss
;; drscheme-ui-tool
(module drscheme-ui-tool mzscheme
  
  (require (lib "class.ss")
           (lib "mred.ss" "mred")
           (lib "framework.ss" "framework")
           (lib "tool.ss" "drscheme")
           (lib "unitsig.ss"))
  (require (prefix drlink: "drscheme-ui.ss")
           "../../info.ss")
  (provide tool@)
  
  ;; CONSTANTS
  
  (define BACKTRACE-NO-MESSAGE "No message.")
  (define UI-MODULE-SPEC
    `(,(#%info-lookup 'distribution-method)
       "drscheme-ui.ss"
       ,(#%info-lookup 'distribution-package-spec)
       "plt" "gui"))
  
  ;; / CONSTANTS

  ;; close/eventspace : (a* -> b) -> (a* -> b)
  ;; Returns a procedure that executes the procedure in the
  ;; eventspace current when close/eventspace was executed.
  ;; Effectively, "close" the procedure in the current eventspace.
  (define (close/eventspace f)
    (let ([es (current-eventspace)])
      (lambda args
        (parameterize [(current-eventspace es)]
          (apply f args)))))
  
  (define tool@
    (unit/sig drscheme:tool-exports^
      (import drscheme:tool^)
      
      ;; has-backtrace : exn -> boolean
      (define has-backtrace?
        (close/eventspace
         (lambda (exn)
           (and (exn? exn)
                (pair? (continuation-mark-set->list
                        (exn-continuation-marks exn)
                        (drscheme:debug:get-cm-key)))))))
      
      ;; show-backtrace : exn -> void
      (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)))))
      
      ;; show-source : value number number -> void
      (define show-source
        (close/eventspace
         (lambda (src pos span)
           (drscheme:debug:open-and-highlight-in-file
            (make-srcloc src #f #f pos span)))))
         
      ;; Send them off to the drscheme-ui module.
      ;; We'll still have to attach this instantiation of drscheme-ui to
      ;; the user namespace.
      (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))
      
      ))
  
  )