refactored stepper tool to work with tabs instead of frames

collects/stepper/private/view-controller.rkt

@@ -28,10 +28,10 @@
 ;; the stored representation of a step
 (define-struct step (text kind posns) #:transparent)
 
-(define (go drracket-frame program-expander selection-start selection-end)
+(define (go drracket-tab program-expander selection-start selection-end)
   
   ;; get the language-level:
-  (define language-settings (definitions-text->settings (send drracket-frame get-definitions-text)))
+  (define language-settings (definitions-text->settings (send drracket-tab get-defs)))
   (define language-level (drracket:language-configuration:language-settings-language language-settings))
   (define simple-settings (drracket:language-configuration:language-settings-settings language-settings))
   
@@ -211,7 +211,7 @@
   
   ;; GUI ELEMENTS:
   (define s-frame
-    (make-object stepper-frame% drracket-frame))
+    (make-object stepper-frame% drracket-tab))
   (define button-panel
     (make-object horizontal-panel% (send s-frame get-area-container)))
   (define (add-button name fun)

collects/stepper/stepper-tool.rkt

@@ -78,7 +78,7 @@
   (class (drracket:frame:basics-mixin
           (frame:frame:standard-menus-mixin frame:frame:basic%))
     
-    (init-field drracket-frame)
+    (init-field drracket-tab)
     
     ;; PRINTING-PROC
     ;; I frankly don't think that printing (i.e., to a printer) works
@@ -113,7 +113,7 @@
     (define/augment (on-close)
       (when custodian
         (custodian-shutdown-all custodian))
-      (send drracket-frame on-stepper-close)
+      (send drracket-tab on-stepper-close)
       (inner (void) on-close))
     
     ;; WARNING BOXES:
@@ -154,18 +154,89 @@
 
   ;; stepper-unit-frame<%> : the interface that the extended drracket frame
   ;; fulfils
-  (define stepper-unit-frame<%>
+  (define stepper-tab<%>
     (interface ()
       get-stepper-frame
       on-stepper-close))
   
   ;; stepper-unit-frame-mixin : the mixin that is applied to the drracket
-  ;; frame to interact with a possible stepper window
+  ;; frame to interact with a possible stepper window. Specifically, this
+  ;; mixin needs to manage the creation and visibility of the stepper button.
   (define (stepper-unit-frame-mixin super%)
-    (class* super% (stepper-unit-frame<%>)
+    (class* super% ()
+      (inherit get-button-panel register-toolbar-button get-current-tab get-tabs)
       
-      (inherit get-button-panel register-toolbar-button get-interactions-text get-definitions-text)
+      (super-new)
       
+      ;; STEPPER BUTTON
+      
+      (define/public (get-stepper-button) stepper-button)
+      
+      (define stepper-button-parent-panel 
+        (new horizontal-panel%
+             [parent (get-button-panel)]
+             [stretchable-width #f]
+             [stretchable-height #f]))
+      
+      (define stepper-button
+        (new switchable-button% 
+             [parent stepper-button-parent-panel]
+             [label (string-constant stepper-button-label)]
+             [bitmap x:foot-img/horizontal]
+             [alternate-bitmap x:foot-img/vertical]
+             [callback (lambda (dont-care) (send (get-current-tab)
+                                                 stepper-button-callback))]))
+      
+      (register-toolbar-button stepper-button)
+      
+      (define (stepper-button-show)
+        (unless (send stepper-button is-shown?)
+          (send (send stepper-button get-parent)
+                add-child stepper-button)))
+      
+      (define (stepper-button-hide)
+        (when (send stepper-button is-shown?)
+          (send (send stepper-button get-parent)
+                delete-child stepper-button)))
+      
+      ;; when the window closes, notify all of the stepper frames.
+      (define/augment (on-close)
+        (for ([tab (in-list (get-tabs))])
+          (define possible-stepper-frame (send tab get-stepper-frame))
+          (when possible-stepper-frame
+            (send possible-stepper-frame original-program-gone)))        
+        (inner (void) on-close))
+      
+      ;; when we change tabs, show or hide the stepper button.
+      (define/augment (on-tab-change old new)
+        (show/hide-stepper-button)
+        (inner (void) on-tab-change old new))
+      
+      ;; add the stepper button to the button panel:
+      (send (get-button-panel) change-children 
+            (lambda (x) 
+              (cons stepper-button-parent-panel
+                    (remq stepper-button-parent-panel x))))
+      
+      ;; show or hide the stepper button depending
+      ;; on the language level
+      (define/public (show/hide-stepper-button)
+        (cond [(send (get-current-tab) current-lang-supports-stepper?)
+               (stepper-button-show)]
+              [else 
+               (stepper-button-hide)]))
+      
+      ;; hide stepper button if it's not supported for the initial language:
+      (show/hide-stepper-button)))
+  
+  ;; stepper-tab-mixin : the mixin that is applied to drracket tabs, to
+  ;; interact with a possible stepper window.
+  (define (stepper-tab-mixin super%)
+    (class* super% (stepper-tab<%>)
+      
+      (inherit get-ints get-defs get-frame)
+      
+      ;; a reference to a possible stepper frame.
       (define stepper-frame #f)
       (define/public (on-stepper-close)
         (set! stepper-frame #f))
@@ -177,14 +248,14 @@
       ;; definitions window one at a time and calls 'iter' on each one
       (define (program-expander init iter)
         (let* ([lang-settings
-                (send (get-definitions-text) get-next-settings)]
+                (send (get-defs) get-next-settings)]
                [lang (drracket:language-configuration:language-settings-language lang-settings)]
                [settings (drracket:language-configuration:language-settings-settings lang-settings)])
           (drracket:eval:expand-program
            (drracket:language:make-text/pos
-            (get-definitions-text)
+            (get-defs)
             0
-            (send (get-definitions-text) last-position))
+            (send (get-defs) last-position))
            lang-settings
            #f
            (lambda ()
@@ -202,109 +273,75 @@
            void ; kill
            iter)))
       
-      ;; STEPPER BUTTON
-      
-      (define/public (get-stepper-button) stepper-button)
-      
-      (define stepper-button-parent-panel 
-        (new horizontal-panel%
-             [parent (get-button-panel)]
-             [stretchable-width #f]
-             [stretchable-height #f]))
 
       ;; called from drracket-button.rkt, installed via the #lang htdp/bsl (& co) reader into drracket
       (define/public (stepper-button-callback)
-        (if stepper-frame
+        (cond 
-            (send stepper-frame show #t)
+          [stepper-frame (send stepper-frame show #t)]
+          [else (create-new-stepper)]))
+      
+      ;; open a new stepper window, start it running
+      (define (create-new-stepper)
         (let* ([language-level
-                    (extract-language-level (get-definitions-text))]
+                (extract-language-level (get-defs))]
                [language-level-name (language-level->name language-level)])
           (if (or (stepper-works-for? language-level)
                   (is-a? language-level drracket:module-language:module-language<%>))
               (set! stepper-frame
                     (go this 
                         program-expander 
-                            (+ 1 (send (get-definitions-text) get-start-position))
+                        (+ 1 (send (get-defs) get-start-position))
-                            (+ 1 (send (get-definitions-text) get-end-position))))
+                        (+ 1 (send (get-defs) get-end-position))))
               (message-box
                (string-constant stepper-name)
                (format (string-constant stepper-language-level-message)
-                           language-level-name))))))
+                       language-level-name)))))
       
-      (define stepper-button
+      (define/override (enable-evaluation)
-        (new switchable-button% 
+        (super enable-evaluation)
-             [parent stepper-button-parent-panel]
+        (send (send (get-frame) get-stepper-button) enable #t))
-             [label (string-constant stepper-button-label)]
-             [bitmap x:foot-img/horizontal]
-             [alternate-bitmap x:foot-img/vertical]
-             [callback (lambda (dont-care) (stepper-button-callback))]))
       
-      (register-toolbar-button stepper-button)
+      (define/override (disable-evaluation)
+        (super enable-evaluation)
+        (send (send (get-frame) get-stepper-button) enable #f))
       
-      (define/augment (enable-evaluation)
+      (define/public (current-lang-supports-stepper?)
-        (send stepper-button enable #t)
+        (stepper-works-for? (extract-language-level (get-defs))))
-        (inner (void) enable-evaluation))
       
-      (define/augment (disable-evaluation)
+      (define/public (notify-stepper-frame-of-change)
-        (send stepper-button enable #f)
+        (when stepper-frame
-        (inner (void) disable-evaluation))
+          (send stepper-frame original-program-changed)))
       
       (define/augment (on-close)
         (when stepper-frame
             (send stepper-frame original-program-gone))
         (inner (void) on-close))
 
-      (define/augment (on-tab-change old new)
+      ))
-        (check-current-language-for-stepper)
-        (inner (void) on-tab-change old new))
   
-      (define/public (check-current-language-for-stepper)
-        (if (stepper-works-for?
-             (extract-language-level (get-definitions-text)))
-            (unless (send stepper-button is-shown?)
-              (send (send stepper-button get-parent)
-                    add-child stepper-button))
-            (when (send stepper-button is-shown?)
-              (send (send stepper-button get-parent)
-                    delete-child stepper-button))))
   
-      ;; add the stepper button to the button panel:
-      (send (get-button-panel) change-children 
-            (lambda (x) 
-              (cons stepper-button-parent-panel
-                    (remq stepper-button-parent-panel x))))
-      
-      ;; hide stepper button if it's not supported for the initial language:
-      (check-current-language-for-stepper)))
   
   ;; stepper-definitions-text-mixin : a mixin for the definitions text that
   ;; alerts thet stepper when the definitions text is altered or destroyed
   (define (stepper-definitions-text-mixin %)
     (class %
       
-      (inherit get-top-level-window)
+      (inherit get-tab get-top-level-window)
-      (define/private (notify-stepper-frame-of-change)
-        (let ([win (get-top-level-window)])
-          ;; should only be #f when win is #f
-          (when (is-a? win stepper-unit-frame<%>)
-            (let ([stepper-window (send win get-stepper-frame)])
-              (when stepper-window
-                (send stepper-window original-program-changed))))))
       
       (define/augment (on-insert x y)
         (unless metadata-changing-now?
-          (notify-stepper-frame-of-change))
+          (send (get-tab) notify-stepper-frame-of-change))
         (inner (void) on-insert x y))
       
       (define/augment (on-delete x y)
         (unless metadata-changing-now?
-          (notify-stepper-frame-of-change))
+          (send (get-tab) notify-stepper-frame-of-change))
         (inner (void) on-delete x y))
       
       (define/augment (after-set-next-settings s)
         (let ([tlw (get-top-level-window)])
           (when tlw
-            (send tlw check-current-language-for-stepper)))
+            (send tlw show/hide-stepper-button)))
         (inner (void) after-set-next-settings s))
       
       (define metadata-changing-now? #f)
@@ -325,6 +362,7 @@
   ;; definitions text:
   (drracket:get/extend:extend-unit-frame stepper-unit-frame-mixin)
   (drracket:get/extend:extend-definitions-text stepper-definitions-text-mixin)
+  (drracket:get/extend:extend-tab stepper-tab-mixin)
   
   ;; COPIED FROM drracket/private/language.ss
 ;; simple-module-based-language-convert-value : TST STYLE boolean -> TST