61 lines
2.1 KiB
Racket
61 lines
2.1 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
racket/gui/base
|
|
framework
|
|
unstable/class-iop
|
|
"interfaces.rkt"
|
|
"frame.rkt"
|
|
"prefs.rkt")
|
|
(provide macro-stepper-director%
|
|
macro-stepper-frame%)
|
|
|
|
(define macro-stepper-director%
|
|
(class* object% (director<%>)
|
|
(field [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)
|
|
(for ([(stepper-frame flags) (in-hash stepper-frames)])
|
|
(unless (memq 'no-obsolete flags)
|
|
(send/i stepper-frame stepper-frame<%> add-obsoleted-warning))))
|
|
(define/public (add-trace events)
|
|
(for ([(stepper-frame flags) (in-hash stepper-frames)])
|
|
(unless (memq 'no-new-traces flags)
|
|
(send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%>
|
|
add-trace events))))
|
|
(define/public (add-deriv deriv)
|
|
(for ([(stepper-frame flags) (in-hash stepper-frames)])
|
|
(unless (memq 'no-new-traces flags)
|
|
(send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%>
|
|
add-deriv deriv))))
|
|
|
|
;; PRE: current thread = current eventspace's handler thread
|
|
(define/public (new-stepper [flags '()])
|
|
(unless (eq? (current-thread)
|
|
(eventspace-handler-thread (current-eventspace)))
|
|
(error 'macro-stepper-director
|
|
"new-stepper method called from wrong thread"))
|
|
(define stepper-frame (new-stepper-frame))
|
|
(define stepper (send/i stepper-frame 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%))))
|