diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index 108bcad45a..7ba5a042ae 100644 --- a/collects/drscheme/private/unit.ss +++ b/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]) - (cond - [(is-a? obj area-container<%>) - (for-each loop (send obj get-children))] - [(is-a? obj switchable-button%) - (send obj set-label-visible (not vertical?))] - [else (void)])) - (send save-button set-label-visible (not vertical?)))) + (for-each + (λ (obj) (send obj set-label-visible (not vertical?))) + toolbar-buttons)) + + (let loop ([obj button-panel]) + (cond + [(is-a? obj area-container<%>) + (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 - (new (class horizontal-panel% - - ;; do this so that new buttons that show up are put in the right mode - (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)] + [define button-panel (new horizontal-panel% [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) diff --git a/collects/drscheme/syncheck.ss b/collects/drscheme/syncheck.ss index 41d43458b6..7bf4b48088 100644 --- a/collects/drscheme/syncheck.ss +++ b/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) diff --git a/collects/gui-debugger/debug-tool.ss b/collects/gui-debugger/debug-tool.ss index 03b20155cc..c22eba44a0 100644 --- a/collects/gui-debugger/debug-tool.ss +++ b/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)] diff --git a/collects/macro-debugger/tool.ss b/collects/macro-debugger/tool.ss index 62746eca22..fa3824222f 100644 --- a/collects/macro-debugger/tool.ss +++ b/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)) diff --git a/collects/scribblings/tools/unit.scrbl b/collects/scribblings/tools/unit.scrbl index a841864086..55f1455016 100644 --- a/collects/scribblings/tools/unit.scrbl +++ b/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