plt/gui/controller.ss
(module controller mzscheme
  (require (lib "class.ss")
           "interfaces.ss"
           "../base.ss")

  (provide controller%)
  
  (define controller%
    (class* object% (controller<%>)
      (init-field model-case%
                  model-suite%
                  view%
                  display-window
                  test)

      (define root-model #f)
      (define view #f)

      (define/public (get-root-model) root-model)
      (define/public (get-view) view)

      (define/public (run)
        (send view run root-model))

      (define/public (run-model model)
        (send model run))

      (define/public (clear-model model)
        (send model clear))

      (define/public (select-model model)
        (send view set-selection model))

      ;; create : -> void
      (define/private (create)
        (set! root-model (create-model test))
        (set! view (new view% 
                        (root-model root-model)
                        (controller this)
                        (parent display-window))))

      ;; create-model : test -> model<%>
      (define/private (create-model test)
        (cond [(schemeunit-test-case? test)
               (new model-case% (controller this) (test test))]
              [(schemeunit-test-suite? test)
               (let ([children
                      (map (lambda (c) (create-model c))
                           (schemeunit-test-suite-tests test))])
                 (new model-suite%
                      (controller this)
                      (test test)
                      (children children)))]))

      ;; on-model-status-change : model<%> boolean -> void
      ;; The big-change? flag indicates whether the given model actually changed
      ;; status.
      (define/public (on-model-status-change model)
        (send (get-view) queue-for-update model)
        (let [(parent (send model get-parent))]
          (when parent (send parent on-child-status-change model))))

      (define/public (on-view-selection-change view model)
        (send (get-view) set-selection model))

      (super-new)
      (create)
      ))
  )