;; drscheme-ui-tool
(module drscheme-ui-tool mzscheme
  (require (planet "version-case.ss" ("dyoo" "version-case.plt" 1 4))
           (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@)
  
  ;; CONSTANTS
  
  (define BACKTRACE-NO-MESSAGE "No message.")
  (define UI-MODULE-SPEC
    `(,(#%info-lookup 'distribution-method)
       "plt/gui/drscheme-ui.ss"
       ,(#%info-lookup 'distribution-package-spec)))
  
  ;; / 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 (close-eventspace/async f)
    (let ([es (current-eventspace)])
      (lambda args
        (parameterize ((current-eventspace es))
          (queue-callback (lambda () (apply f args)))))))
  
  (define tool@
    (unit
      (import drscheme:tool^)
      (export drscheme:tool-exports^)
      
      ;; Try loading now, to provoke error at tool load time
      ;; rather than execution time; if error occurs at tool
      ;; load time, DrScheme unloads the tool.
      (dynamic-require UI-MODULE-SPEC #f)
      
      ;; 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/async
         (lambda (exn)
           (drscheme:debug:show-backtrace-window
            (or (exn-message exn) BACKTRACE-NO-MESSAGE)
            (version-case
             ((version< (version) "3.99.0.10")
              (let ([tracekey (drscheme:debug:get-cm-key)])
                (if (exn? exn) 
                    (continuation-mark-set->list 
                     (exn-continuation-marks exn)
                     tracekey)
                    null)))
             (else exn))))))
      
      ;; show-source : value number number -> void
      (define show-source
        (close-eventspace/async
         (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/private (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))
      
      ))
  
  )