95 lines
2.7 KiB
Scheme
95 lines
2.7 KiB
Scheme
|
|
#lang scheme/base
|
|
(require scheme/class
|
|
scheme/pretty
|
|
scheme/gui
|
|
framework/framework
|
|
"interfaces.ss"
|
|
"frame.ss"
|
|
"prefs.ss"
|
|
"../model/trace.ss")
|
|
(provide macro-stepper-director%
|
|
macro-stepper-frame%
|
|
go)
|
|
|
|
(define macro-stepper-director%
|
|
(class object%
|
|
(define stepper-frames (make-hasheq))
|
|
|
|
;; Flags is a subset(list) of '(no-obsolete no-new-traces)
|
|
|
|
(define/private (add-stepper! s flags)
|
|
(hash-set! stepper-frames s flags))
|
|
(define/public (remove-stepper! s)
|
|
(hash-remove! stepper-frames s))
|
|
|
|
(define/public (add-obsoleted-warning)
|
|
(hash-for-each stepper-frames
|
|
(lambda (stepper-frame flags)
|
|
(unless (memq 'no-obsolete flags)
|
|
(send stepper-frame add-obsoleted-warning)))))
|
|
(define/public (add-trace events)
|
|
(hash-for-each stepper-frames
|
|
(lambda (stepper-frame flags)
|
|
(unless (memq 'no-new-traces flags)
|
|
(send (send stepper-frame get-widget)
|
|
add-trace events)))))
|
|
(define/public (add-deriv deriv)
|
|
(hash-for-each stepper-frames
|
|
(lambda (stepper-frame flags)
|
|
(unless (memq 'no-new-traces flags)
|
|
(send (send stepper-frame get-widget)
|
|
add-deriv deriv)))))
|
|
|
|
(define/public (new-stepper [flags '()])
|
|
(define stepper-frame (new-stepper-frame))
|
|
(define stepper (send stepper-frame get-widget))
|
|
(send stepper-frame show #t)
|
|
(add-stepper! stepper-frame flags)
|
|
stepper)
|
|
|
|
(define/public (new-stepper-frame)
|
|
(new macro-stepper-frame%
|
|
(config (new macro-stepper-config/prefs%))
|
|
(director this)))
|
|
|
|
(super-new)))
|
|
|
|
(define macro-stepper-frame%
|
|
(macro-stepper-frame-mixin
|
|
(frame:standard-menus-mixin
|
|
(frame:basic-mixin frame%))))
|
|
|
|
;; Main entry points
|
|
|
|
(define (go stx)
|
|
(define director (new macro-stepper-director%))
|
|
(define stepper (send director new-stepper))
|
|
(send director add-deriv (trace stx))
|
|
(void))
|
|
|
|
#|
|
|
(define (make-macro-stepper)
|
|
(let ([f (new macro-stepper-frame%
|
|
(config (new macro-stepper-config/prefs%)))])
|
|
(send f show #t)
|
|
(send f get-widget)))
|
|
|
|
(define (go stx)
|
|
(let ([stepper (make-macro-stepper)])
|
|
(send stepper add-deriv (trace stx))
|
|
stepper))
|
|
|
|
(define (go/deriv deriv)
|
|
(let* ([f (new macro-stepper-frame%)]
|
|
[w (send f get-widget)])
|
|
(send w add-deriv deriv)
|
|
(send f show #t)
|
|
w))
|
|
|
|
(define (go/trace events)
|
|
(let* ([w (make-macro-stepper)])
|
|
(send w add-trace events)
|
|
w))
|
|
|#
|