(module no-brainer-tool mzscheme
  (require (lib "contract.ss")
           (lib "tool.ss" "drscheme")
           (lib "mred.ss" "mred")  
           (prefix frame: (lib "framework.ss" "framework"))
           (lib "bitmap-label.ss" "mrlib")
           (lib "unitsig.ss")
           (lib "class.ss")
           (lib "list.ss")
           "no-brainer-sig.ss"
           "private/no-brainer-vc.ss"
           "private/no-brainer.ss"
	   (lib "my-macros.ss" "stepper" "private"))

  (provide tool@)
  
  (define tool@
    (unit/sig drscheme:tool-exports^
      (import drscheme:tool^)

      (define (phase1) (void))
      (define (phase2) (void))
      
      (define debugger-initial-width 500)
      (define debugger-initial-height 500)
      
      (define debugger-bitmap
        (bitmap-label-maker
         "No Brain"
         (build-path (collection-path "icons") "foot.bmp")))

      (define (debugger-unit-frame-mixin super%)
        (class* super% ()

          (inherit get-button-panel get-interactions-text get-definitions-text)

          (super-instantiate ())

          (define program-expander
            (contract
             (-> (-> (union eof-object? syntax? (cons/c string? any/c)) (-> any) any) ; iter
                 void?)
             (lambda (iter)
               (let* ([lang-settings 
                       (frame:preferences:get
                        (drscheme:language-configuration:get-settings-preferences-symbol))])
                 (drscheme:eval:expand-program
                  (drscheme:language:make-text/pos (get-definitions-text) 
                                                   0
                                                   (send (get-definitions-text)
                                                         last-position)) 
                  lang-settings
                  #t
                  ; set current-directory and current-load-relative-directory before expansion
                  (lambda ()
                    (let* ([tmp-b (box #f)]
                           [fn (send (get-definitions-text) get-filename tmp-b)])
                      (unless (unbox tmp-b)
                        (when fn
                          (let-values ([(base name dir?) (split-path fn)])
                            (current-directory base)
                            (current-load-relative-directory base))))))
                  void ; kill
                  iter)))
             'program-expander
             'caller))
          
          (define debugger-button 
            (make-object button%
              (debugger-bitmap this)
              (get-button-panel)
              (lambda (button evt)
                (start-analysis program-expander this))))
          
          (define (start-analysis program-expander drs-window)
            (define-values/invoke-unit/sig (go)
             (compound-unit/sig 
               (import [EXPANDER : (program-expander)]
                       [DRS-WINDOW : (drs-window)])
               (link [CHECKER : no-brainer^ (no-brainer@ VIEW-CONTROLLER EXPANDER)]
                     [VIEW-CONTROLLER : no-brainer-vc^ (no-brainer-vc@ DRS-WINDOW)])
               (export (var (CHECKER go))))
             #f
             (program-expander)
             (drs-window))
            (go))

          (define/augment (enable-evaluation)
            (send debugger-button enable #t)
            (inner (void) enable-evaluation))

          (define/augment (disable-evaluation)
            (send debugger-button enable #f)
            (inner (void) disable-evaluation))

          (send (get-button-panel) change-children
                (lx (cons debugger-button (remq debugger-button _))))))

      (drscheme:get/extend:extend-unit-frame debugger-unit-frame-mixin))))