(module driver mzscheme

  (require (lib "class.ss")
           (lib "class-events.ss" "mzlib" "private")
           (lib "mred.ss" "mred")
           (lib "plt-match.ss")
           "gui/trace-display.ss"
           "model/buffer.ss"
           "model/view.ss"
           )

  (provide with-trace-window
           install-trace-window
           sequence-trace-handler
           current-sequence-trace-buffer)

  (define current-sequence-trace-buffer (make-parameter #f))

  (define (sequence-trace-handler . args)
    (let* ([buffer (current-sequence-trace-buffer)])
      (and buffer
           (match args
             [(list 'new class object fields)
              (buffer-add! buffer (list 'new object fields))]
             [(list 'inspect object)
              (buffer-add! buffer (list 'inspect object))]
             [(list 'get object field)
              (buffer-add! buffer (list 'get object field))]
             [(list 'set object field value)
              (buffer-add! buffer (list 'set object field value))]
             [(list 'call object method args)
              (buffer-add! buffer (list 'call object method args))
              (lambda returned-values
                (buffer-add! buffer (list 'return returned-values)))]))))

  (define (display-buffer buffer)
    (parameterize ([current-eventspace (make-eventspace)])

      (define view (make-view buffer (lambda any #t)))
      (define frame (new frame% [label "Sequence Trace"]))
      (define gui (new trace-display% [parent frame] [view view]))

      (send frame show #t)))

  (define (install-trace-window)
    (let* ([buffer (make-buffer)])
      (display-buffer buffer)
      (current-sequence-trace-buffer buffer)
      (current-class-event-handler sequence-trace-handler)))

  (define (with-trace-window/proc thunk)
    (let* ([buffer (make-buffer)])
      (display-buffer buffer)
      (parameterize ([current-class-event-handler sequence-trace-handler]
                     [current-sequence-trace-buffer buffer])
        (thunk))))

  (define-syntax (with-trace-window stx)
    (syntax-case stx ()
      [(form . body)
       (syntax/loc stx
         (with-trace-window/proc (lambda () . body)))]))

  )