added an explicit registration for the toolbar switchable-buttons
svn: r9882
This commit is contained in:
parent
8f8451dc4f
commit
a8fd2e018c
|
@ -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?))])
|
||||
(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%)
|
||||
(send obj set-label-visible (not vertical?))]
|
||||
[else (void)]))
|
||||
(send save-button set-label-visible (not vertical?))))
|
||||
(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,6 +3412,7 @@ 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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -1264,6 +1264,8 @@
|
|||
(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% ()
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user