added an explicit registration for the toolbar switchable-buttons

svn: r9882
This commit is contained in:
Robby Findler 2008-05-18 22:59:02 +00:00
parent 8f8451dc4f
commit a8fd2e018c
5 changed files with 53 additions and 42 deletions

View File

@ -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)

View File

@ -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)

View File

@ -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)]

View File

@ -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))

View File

@ -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