view.rkt (2154B)
1 #lang racket/base 2 (require racket/class 3 racket/gui/base 4 framework 5 racket/class/iop 6 "interfaces.rkt" 7 "frame.rkt" 8 "prefs.rkt") 9 (provide macro-stepper-director% 10 macro-stepper-frame%) 11 12 (define macro-stepper-director% 13 (class* object% (director<%>) 14 (field [stepper-frames (make-hasheq)]) 15 16 ;; Flags is a subset(list) of '(no-obsolete no-new-traces) 17 18 (define/private (add-stepper! s flags) 19 (hash-set! stepper-frames s flags)) 20 (define/public (remove-stepper! s) 21 (hash-remove! stepper-frames s)) 22 23 (define/public (add-obsoleted-warning) 24 (for ([(stepper-frame flags) (in-hash stepper-frames)]) 25 (unless (memq 'no-obsolete flags) 26 (send/i stepper-frame stepper-frame<%> add-obsoleted-warning)))) 27 (define/public (add-trace events) 28 (for ([(stepper-frame flags) (in-hash stepper-frames)]) 29 (unless (memq 'no-new-traces flags) 30 (send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%> 31 add-trace events)))) 32 (define/public (add-deriv deriv) 33 (for ([(stepper-frame flags) (in-hash stepper-frames)]) 34 (unless (memq 'no-new-traces flags) 35 (send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%> 36 add-deriv deriv)))) 37 38 ;; PRE: current thread = current eventspace's handler thread 39 (define/public (new-stepper [flags '()]) 40 (unless (eq? (current-thread) 41 (eventspace-handler-thread (current-eventspace))) 42 (error 'macro-stepper-director 43 "new-stepper method called from wrong thread")) 44 (define stepper-frame (new-stepper-frame)) 45 (define stepper (send/i stepper-frame stepper-frame<%> get-widget)) 46 (send stepper-frame show #t) 47 (add-stepper! stepper-frame flags) 48 stepper) 49 50 (define/public (new-stepper-frame) 51 (new macro-stepper-frame% 52 (config (new macro-stepper-config/prefs%)) 53 (director this))) 54 55 (super-new))) 56 57 (define macro-stepper-frame% 58 (macro-stepper-frame-mixin 59 (frame:standard-menus-mixin 60 (frame:basic-mixin frame%))))