
(module get-extend mzscheme
  (require (lib "unitsig.ss")
	   (lib "class.ss")
           "drsig.ss"
	   (lib "mred.ss" "mred")
           (lib "etc.ss"))
  
  (provide get-extend@)
  
  (define get-extend@
    (unit/sig drscheme:get/extend^

      (import [drscheme:unit : drscheme:unit^]
	      [drscheme:frame : drscheme:frame^]
	      [drscheme:rep : drscheme:rep^]
              [drscheme:debug : drscheme:debug^])
      
      (define make-extender
        (λ (get-base% name)
          (let ([extensions (λ (x) x)]
                [built-yet? #f]
                [built #f]
                [verify
                 (λ (f)
                   (λ (%)
                     (let ([new% (f %)])
                       (if (and (class? new%)
                                (subclass? new% %))
                           new%
                           (error 'extend-% "expected output of extension to create a subclass of its input, got: ~a"
                                  new%)))))])
            (values
             (rec add-extender
               (case-lambda
                [(extension) (add-extender extension #t)]
                [(extension before?)
                 (when built-yet?
                   (error 'extender "cannot build a new extension of ~a after initialization"
                          name))
                 (set! extensions 
                       (if before?
                           (compose (verify extension) extensions)
                           (compose extensions (verify extension))))]))
             (λ ()
               (unless built-yet?
                 (set! built-yet? #t)
                 (set! built (extensions (get-base%))))
               built)))))
      
      (define (get-base-tab%)
        (drscheme:debug:test-coverage-tab-mixin
         (drscheme:debug:profile-tab-mixin
          drscheme:unit:tab%)))
      
      (define-values (extend-tab get-tab) (make-extender get-base-tab% 'tab%))

      (define (get-base-interactions-canvas%)
        drscheme:unit:interactions-canvas%)
      
      (define-values (extend-interactions-canvas get-interactions-canvas)
        (make-extender get-base-interactions-canvas% 'interactions-canvas%))

      (define (get-base-definitions-canvas%)
        drscheme:unit:definitions-canvas%)
      
      (define-values (extend-definitions-canvas get-definitions-canvas)
        (make-extender get-base-definitions-canvas% 'definitions-canvas%))  
      
      (define (get-base-unit-frame%) 
        (drscheme:debug:profile-unit-frame-mixin
         drscheme:unit:frame%))

      (define-values (extend-unit-frame get-unit-frame)
        (make-extender get-base-unit-frame% 'drscheme:unit:frame))
      
      (define (get-base-interactions-text%)
        (drscheme:debug:test-coverage-interactions-text-mixin
         drscheme:rep:text%))

      (define-values (extend-interactions-text get-interactions-text)
        (make-extender get-base-interactions-text% 'interactions-text%))

      (define (get-base-definitions-text%)
        (drscheme:debug:test-coverage-definitions-text-mixin
         (drscheme:debug:profile-definitions-text-mixin
          (drscheme:unit:get-definitions-text%))))

      (define-values (extend-definitions-text get-definitions-text)
        (make-extender get-base-definitions-text% 'definitions-text%)))))
