(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 "class.ss")
           (lib "list.ss")
           (lib "unit.ss")
           "no-brainer-sig.ss"
           "private/no-brainer-vc.ss"
           "private/no-brainer.ss"
	   (lib "my-macros.ss" "stepper" "private"))
  

  (provide tool@)
  
  (define-unit tool@ 
    (import drscheme:tool^)
    (export drscheme:tool-exports^)
    
    (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-compound-unit/infer froogy@
          (import drs-window^ expander^)
          (export no-brainer^)
          (link no-brainer@ no-brainer-vc@))
        
        (define (start-analysis program-expander drs-window)
          (define-values/invoke-unit/infer froogy@)
          (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)))