added an explicit registration for the toolbar switchable-buttons

svn: r9882

collects/drscheme/private/unit.ss

@@ -1172,7 +1172,8 @@ module browser threading seems wrong.
         ensure-rep-hidden
         ensure-defs-shown
         
-        get-language-menu))
+        get-language-menu
+        register-toolbar-button))
     
     (define frame-mixin
       (mixin (drscheme:frame:<%> frame:searchable-text<%> frame:delegate<%> frame:open-here<%>)
@@ -1392,16 +1393,26 @@ module browser threading seems wrong.
                 (send top-panel change-children (λ (x) (cons name-panel (remq name-panel x)))))
             (end-container-sequence)))
         
+        (define toolbar-buttons '())
+        (define/public (register-toolbar-button b)
+          (set! toolbar-buttons (cons b toolbar-buttons))
+          (orient))
+        
         (define/private (orient)
           (let ([vertical? (or (toolbar-is-left?) (toolbar-is-right?))])
-            (let loop ([obj button-panel])
+            (for-each
-              (cond
+             (λ (obj) (send obj set-label-visible (not vertical?)))
-                [(is-a? obj area-container<%>)
+             toolbar-buttons))
-                 (for-each loop (send obj get-children))]
+          
-                [(is-a? obj switchable-button%)
+          (let loop ([obj button-panel])
-                 (send obj set-label-visible (not vertical?))]
+            (cond
-                [else (void)]))
+              [(is-a? obj area-container<%>)
-            (send save-button set-label-visible (not vertical?))))
+               (for-each loop (send obj get-children))]
+              [(is-a? obj switchable-button%)
+               (unless (memq obj toolbar-buttons)
+                 (error 'register-toolbar-button "found a switchable-button% that is not registered, label ~s"
+                        (send obj get-label)))]
+              [else (void)])))
         
         (field [remove-show-status-line-callback
                 (preferences:add-callback
@@ -3365,6 +3376,7 @@ module browser threading seems wrong.
                                       (send definitions-canvas focus)))]
                    [bitmap save-bitmap]
                    [label (string-constant save-button-label)]))
+        (register-toolbar-button save-button)
         
         (set! name-message (new drs-name-message% [parent name-panel]))
         (send name-message stretchable-width #t)
@@ -3372,24 +3384,10 @@ module browser threading seems wrong.
         [define teachpack-items null]
         [define break-button (void)]
         [define execute-button (void)]
-        [define button-panel 
+        [define button-panel (new horizontal-panel% [parent top-panel] [spacing 2])]
-          (new (class horizontal-panel%
+        (define/public (get-execute-button) execute-button)
-                 
+        (define/public (get-break-button) break-button)
-                 ;; do this so that new buttons that show up are put in the right mode
+        (define/public (get-button-panel) button-panel)
-                 (define/override (change-children lst)
-                   (let ([ans (super change-children lst)])
-                     (orient)
-                     ans))
-                 (define/override (add-child c)
-                   (super add-child c)
-                   (orient))
-                 (define/override (after-new-child c)
-                   (super after-new-child c)
-                   (orient))
-                 (super-new [parent top-panel] [spacing 2])))]
-        [define/public get-execute-button (λ () execute-button)]
-        [define/public get-break-button (λ () break-button)]
-        [define/public get-button-panel (λ () button-panel)]
         
         (inherit get-info-panel)
         (define running-canvas
@@ -3406,6 +3404,7 @@ module browser threading seems wrong.
                    [callback (λ (x) (execute-callback))]
                    [bitmap execute-bitmap]
                    [label (string-constant execute-button-label)]))
+        (register-toolbar-button execute-button)
         
         (set! break-button
               (new switchable-button%
@@ -3413,7 +3412,8 @@ module browser threading seems wrong.
                    [callback (λ (x) (send current-tab break-callback))]
                    [bitmap break-bitmap]
                    [label (string-constant break-button-label)]))
-        
+        (register-toolbar-button break-button)
+
         (send button-panel stretchable-height #f)
         (send button-panel stretchable-width #f) 
         

collects/drscheme/syncheck.ss

@@ -1228,6 +1228,8 @@ If the namespace does not, they are colored the unbound color.
                (bitmap syncheck-bitmap)
                (parent check-syntax-button-parent-panel)
                (callback (λ (button) (syncheck:button-callback)))))
+        (inherit register-toolbar-button)
+        (register-toolbar-button check-syntax-button)
         (define/public (syncheck:get-button) check-syntax-button)
         (send (get-button-panel) change-children
               (λ (l)

collects/gui-debugger/debug-tool.ss

@@ -1264,7 +1264,9 @@
                  (bitmap debug-bitmap)
                  (parent (make-object vertical-pane% (get-button-panel)))
                  (callback (λ (button) (set! debug? #t) (execute-callback)))))
-          
+          (inherit register-toolbar-button)
+          (register-toolbar-button debug-button)
+
           (define pause-button
             (instantiate button% ()
               [label (make-pause-label this)]

collects/macro-debugger/tool.ss

@@ -81,6 +81,8 @@
                (alternate-bitmap macro-debugger-up-bitmap)
                (parent macro-debug-panel)
                (callback (λ (button) (execute #t)))))
+        (inherit register-toolbar-button)
+        (register-toolbar-button macro-debug-button)
 
         (define/override (execute-callback)
           (execute #f))

collects/scribblings/tools/unit.scrbl

@@ -8,6 +8,7 @@
 This method is called when the break button is clicked and
 this tab is the active tab.
 }
+
 @methimpl{
 By default, breaks any evaluation that may be happening at
 this point.
@@ -17,6 +18,7 @@ this point.
 @methspec{
 This method is called to determine if it is okay to close this tab.
 }
+
 @methimpl{
 Calls the definitions text's and interactions text's
 @method[editor:basic<%> can-close?] method.
@@ -113,6 +115,7 @@ when this frame is active.
 This method is called when the tab is closed.
 
 }
+
 @methimpl{
 
 Calls the definitions text's
@@ -230,6 +233,7 @@ This method is called when the user clicks on the break
 button or chooses the break menu item.
 
 }
+
 @methimpl{
 
 Breaks the user's evaluation started by the Run button
@@ -266,6 +270,7 @@ This method is called when the user clicks on the Run
 button or chooses the Run menu item.
 
 }
+
 @methimpl{
 
 It calls 
@@ -390,6 +395,7 @@ returns a child of the super-classes's result and insert new
 children inbetween.
 
 }
+
 @methimpl{
 First case:
 
@@ -483,6 +489,7 @@ modified. Used in conjunction with
 @method[drscheme:unit:frame% change-to-file].
 
 }
+
 @methimpl{
 
 Returns @scheme[#t] if the buffer is empty, it has not been
@@ -596,11 +603,6 @@ Calls result of
 
 Returns the \scm|"Insert"| menu. 
 
-}
-@methimpl{
-
-
-
 }}
 
 @defmethod[(get-interactions-canvas)
@@ -642,6 +644,7 @@ Returns the list of tabs in this frame.
 Called after a new tab becomes the selected tab in the frame.
 
 }
+
 @methimpl{
 
 The @scheme[from-tab] argument is the previously selected tab, and the
@@ -668,13 +671,18 @@ Note that the capability must be registered separately, via
 @scheme[drscheme:language:register-capability].
 
 
-}}
+}
+
+@defmethod[(register-toolbar-button [tb (is-a?/c switchable-button%)]) void?]{
+Registers the toolbar button @scheme[tb]. This is required
+so that the toolbar buttons properly switch orientation when 
+the toolbar's position is moved.
+}
+}
 
 
 @defclass[drscheme:unit:definitions-text% (drscheme:rep:drs-bindings-keymap-mixin (drscheme:unit:program-editor-mixin (scheme:text-mixin text:info%))) (drscheme:unit:definitions-text<%>)]{
 
-
-
 @defconstructor[()]{
 Passes all arguments to @scheme[super-init].
 }
@@ -685,8 +693,6 @@ Passes all arguments to @scheme[super-init].
 
 Calls
 @method[drscheme:unit:frame% update-save-message].
-
-
 }
 
 @defmethod[#:mode override 
@@ -695,9 +701,6 @@ Calls
 
 Calls
 @method[drscheme:unit:frame% update-save-button].
-
-%%                                                                  %%                        drscheme:rep                              %%                                                                  
-
 }}
 
 
@@ -716,6 +719,7 @@ Called when the next settings changes. See also
 @method[drscheme:unit:definitions-text<%> get-next-settings].
 
 }
+
 @methimpl{
 
 
@@ -792,6 +796,7 @@ trigger a yellow warning message. The state is reset when
 the program is next Run.
 
 }
+
 @methimpl{
 
 Records @scheme[msg] and uses it the next time the user submits