[Pkg] Squeak3.10bc: ToolBuilder-Kernel-kph.19.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Sat Dec 13 04:53:19 UTC 2008
A new version of ToolBuilder-Kernel was added to project Squeak3.10bc:
http://www.squeaksource.com/310bc/ToolBuilder-Kernel-kph.19.mcz
==================== Summary ====================
Name: ToolBuilder-Kernel-kph.19
Author: kph
Time: 13 December 2008, 4:53:17 am
UUID: 15b1e833-3558-478b-90be-f39d4f241c25
Ancestors: ToolBuilder-Kernel-rej.18
Saved from SystemVersion
==================== Snapshot ====================
SystemOrganization addCategory: #'ToolBuilder-Kernel'!
TestCase subclass: #ToolBuilderTests
instanceVariableNames: 'builder widget queries'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!ToolBuilderTests commentStamp: 'ar 2/11/2005 15:01' prior: 0!
Some tests to make sure ToolBuilder does what it says.!
----- Method: ToolBuilderTests class>>isAbstract (in category 'testing') -----
isAbstract
^self == ToolBuilderTests!
----- Method: ToolBuilderTests>>acceptWidgetText (in category 'support') -----
acceptWidgetText
"accept text in widget"
^ self subclassResponsibility!
----- Method: ToolBuilderTests>>assertItemFiresWith: (in category 'tests-menus') -----
assertItemFiresWith: aBlock
| spec |
spec := builder pluggableMenuSpec new.
spec model: self.
aBlock value: spec.
widget := builder build: spec.
queries := IdentitySet new.
self fireMenuItemWidget.
self assert: (queries includes: #fireMenuAction)!
----- Method: ToolBuilderTests>>buttonWidgetEnabled (in category 'support') -----
buttonWidgetEnabled
"Answer whether the current widget (a button) is currently enabled"
^ widget getModelState!
----- Method: ToolBuilderTests>>changeListWidget (in category 'support') -----
changeListWidget
"Change the list widget's selection index"
self subclassResponsibility!
----- Method: ToolBuilderTests>>fireButton (in category 'tests-button') -----
fireButton
queries add: #fireButton.!
----- Method: ToolBuilderTests>>fireButtonWidget (in category 'support') -----
fireButtonWidget
"Fire the widget, e.g., perform what is needed for the guy to trigger its action"
self subclassResponsibility!
----- Method: ToolBuilderTests>>fireMenuAction (in category 'tests-menus') -----
fireMenuAction
queries add: #fireMenuAction!
----- Method: ToolBuilderTests>>fireMenuItemWidget (in category 'tests-menus') -----
fireMenuItemWidget
self subclassResponsibility!
----- Method: ToolBuilderTests>>getChildren (in category 'tests-panel') -----
getChildren
queries add: #getChildren.
^#()!
----- Method: ToolBuilderTests>>getChildrenOf: (in category 'tests-trees') -----
getChildrenOf: item
queries add: #getChildrenOf.
^(1 to: 9) asArray!
----- Method: ToolBuilderTests>>getColor (in category 'tests-text') -----
getColor
queries add: #getColor.
^Color tan!
----- Method: ToolBuilderTests>>getEnabled (in category 'tests-button') -----
getEnabled
queries add: #getEnabled.
^true!
----- Method: ToolBuilderTests>>getHelpOf: (in category 'tests-trees') -----
getHelpOf: item
^'help'!
----- Method: ToolBuilderTests>>getIconOf: (in category 'tests-trees') -----
getIconOf: item
queries add: #getIconOf.
^nil!
----- Method: ToolBuilderTests>>getLabel (in category 'tests-button') -----
getLabel
queries add: #getLabel.
^'TestLabel'!
----- Method: ToolBuilderTests>>getLabelOf: (in category 'tests-trees') -----
getLabelOf: item
queries add: #getLabelOf.
^item asString!
----- Method: ToolBuilderTests>>getList (in category 'tests-lists') -----
getList
queries add: #getList.
^(1 to: 100) collect:[:i| i printString].!
----- Method: ToolBuilderTests>>getListIndex (in category 'tests-lists') -----
getListIndex
queries add: #getListIndex.
^13!
----- Method: ToolBuilderTests>>getListSelection (in category 'tests-lists') -----
getListSelection
queries add: #getListSelection.
^'55'!
----- Method: ToolBuilderTests>>getMenu: (in category 'tests-lists') -----
getMenu: aMenu
queries add: #getMenu.
^aMenu!
----- Method: ToolBuilderTests>>getRoots (in category 'tests-trees') -----
getRoots
queries add: #getRoots.
^(1 to: 9) asArray!
----- Method: ToolBuilderTests>>getState (in category 'tests-button') -----
getState
queries add: #getState.
^true!
----- Method: ToolBuilderTests>>getText (in category 'tests-text') -----
getText
queries add: #getText.
^Text new!
----- Method: ToolBuilderTests>>getTextSelection (in category 'tests-text') -----
getTextSelection
queries add: #getTextSelection.
^(1 to: 0)!
----- Method: ToolBuilderTests>>getTreeSelectionPath (in category 'tests-trees') -----
getTreeSelectionPath
queries add: #getTreeSelectionPath.
^{2. 4. 3}!
----- Method: ToolBuilderTests>>hasChildren: (in category 'tests-trees') -----
hasChildren: item
queries add: #hasChildren.
^true!
----- Method: ToolBuilderTests>>keyPress: (in category 'tests-lists') -----
keyPress: key
queries add: #keyPress.!
----- Method: ToolBuilderTests>>makeButton (in category 'tests-button') -----
makeButton
| spec |
spec := self makeButtonSpec.
widget := builder build: spec.
^widget!
----- Method: ToolBuilderTests>>makeButtonSpec (in category 'tests-button') -----
makeButtonSpec
| spec |
spec := builder pluggableButtonSpec new.
spec name: #button.
spec model: self.
spec label: #getLabel.
spec color: #getColor.
spec state: #getState.
spec enabled: #getEnabled.
^spec!
----- Method: ToolBuilderTests>>makeInputField (in category 'tests-input') -----
makeInputField
| spec |
spec := self makeInputFieldSpec.
widget := builder build: spec.!
----- Method: ToolBuilderTests>>makeInputFieldSpec (in category 'tests-input') -----
makeInputFieldSpec
| spec |
spec := builder pluggableInputFieldSpec new.
spec name: #input.
spec model: self.
spec getText: #getText.
spec selection: #getTextSelection.
spec color: #getColor.
"<-- the following cannot be tested very well -->"
spec setText: #setText:.
spec menu: #getMenu:.
^spec!
----- Method: ToolBuilderTests>>makeItemList (in category 'tests-lists') -----
makeItemList
| spec |
spec := self makeItemListSpec.
widget := builder build: spec.!
----- Method: ToolBuilderTests>>makeItemListSpec (in category 'tests-lists') -----
makeItemListSpec
| spec |
spec := builder pluggableListSpec new.
spec name: #list.
spec model: self.
spec list: #getList.
spec getSelected: #getListSelection.
"<-- the following cannot be tested very well -->"
spec setSelected: #setListSelection:.
spec menu: #getMenu:.
spec keyPress: #keyPress:.
^spec!
----- Method: ToolBuilderTests>>makeList (in category 'tests-lists') -----
makeList
| spec |
spec := self makeListSpec.
widget := builder build: spec.!
----- Method: ToolBuilderTests>>makeListSpec (in category 'tests-lists') -----
makeListSpec
| spec |
spec := builder pluggableListSpec new.
spec name: #list.
spec model: self.
spec list: #getList.
spec getIndex: #getListIndex.
"<-- the following cannot be tested very well -->"
spec setIndex: #setListIndex:.
spec menu: #getMenu:.
spec keyPress: #keyPress:.
^spec!
----- Method: ToolBuilderTests>>makePanel (in category 'tests-panel') -----
makePanel
| spec |
spec := self makePanelSpec.
widget := builder build: spec.!
----- Method: ToolBuilderTests>>makePanelSpec (in category 'tests-panel') -----
makePanelSpec
| spec |
spec := builder pluggablePanelSpec new.
spec name: #panel.
spec model: self.
spec children: #getChildren.
^spec!
----- Method: ToolBuilderTests>>makeText (in category 'tests-text') -----
makeText
| spec |
spec := self makeTextSpec.
widget := builder build: spec.!
----- Method: ToolBuilderTests>>makeTextSpec (in category 'tests-text') -----
makeTextSpec
| spec |
spec := builder pluggableTextSpec new.
spec name: #text.
spec model: self.
spec getText: #getText.
spec selection: #getTextSelection.
spec color: #getColor.
"<-- the following cannot be tested very well -->"
spec setText: #setText:.
spec menu: #getMenu:.
^spec!
----- Method: ToolBuilderTests>>makeTree (in category 'tests-trees') -----
makeTree
| spec |
spec := self makeTreeSpec.
widget := builder build: spec.!
----- Method: ToolBuilderTests>>makeTreeSpec (in category 'tests-trees') -----
makeTreeSpec
| spec |
spec := builder pluggableTreeSpec new.
spec name: #tree.
spec model: self.
spec roots: #getRoots.
"<-- the following cannot be tested very well -->"
spec getSelectedPath: #getTreeSelectionPath.
spec getChildren: #getChildrenOf:.
spec hasChildren: #hasChildren:.
spec label: #getLabelOf:.
spec icon: #getIconOf:.
spec help: #getHelpOf:.
spec setSelected: #setTreeSelection:.
spec menu: #getMenu:.
spec keyPress: #keyPress:.
^spec!
----- Method: ToolBuilderTests>>makeWindow (in category 'tests-window') -----
makeWindow
| spec |
spec := self makeWindowSpec.
widget := builder build: spec.!
----- Method: ToolBuilderTests>>makeWindowSpec (in category 'tests-window') -----
makeWindowSpec
| spec |
spec := builder pluggableWindowSpec new.
spec name: #window.
spec model: self.
spec children: #getChildren.
spec label: #getLabel.
spec closeAction: #noteWindowClosed.
^spec!
----- Method: ToolBuilderTests>>noteWindowClosed (in category 'tests-window') -----
noteWindowClosed
queries add: #noteWindowClosed.!
----- Method: ToolBuilderTests>>openWindow (in category 'tests-window') -----
openWindow
| spec |
spec := self makeWindowSpec.
widget := builder open: spec.!
----- Method: ToolBuilderTests>>returnFalse (in category 'support') -----
returnFalse
^false!
----- Method: ToolBuilderTests>>returnTrue (in category 'support') -----
returnTrue
^true!
----- Method: ToolBuilderTests>>setListIndex: (in category 'tests-lists') -----
setListIndex: index
queries add: #setListIndex.!
----- Method: ToolBuilderTests>>setListSelection: (in category 'tests-lists') -----
setListSelection: newIndex
queries add: #setListSelection.!
----- Method: ToolBuilderTests>>setText: (in category 'tests-text') -----
setText: newText
queries add: #setText.
^false!
----- Method: ToolBuilderTests>>setTreeSelection: (in category 'tests-trees') -----
setTreeSelection: node
queries add: #setTreeSelection.!
----- Method: ToolBuilderTests>>setUp (in category 'support') -----
setUp
queries := IdentitySet new.!
----- Method: ToolBuilderTests>>shutDown (in category 'support') -----
shutDown
self myDependents: nil!
----- Method: ToolBuilderTests>>testAddTargetSelectorArgumentList (in category 'tests-menus') -----
testAddTargetSelectorArgumentList
self assertItemFiresWith:
[:spec | spec
add: 'Menu Item'
target: self
selector: #fireMenuAction
argumentList: #()]!
----- Method: ToolBuilderTests>>testButtonFiresBlock (in category 'tests-button') -----
testButtonFiresBlock
| spec |
spec := builder pluggableButtonSpec new.
spec model: self.
spec action: [self fireButton].
widget := builder build: spec.
queries := IdentitySet new.
self fireButtonWidget.
self assert: (queries includes: #fireButton).!
----- Method: ToolBuilderTests>>testButtonFiresMessage (in category 'tests-button') -----
testButtonFiresMessage
| spec |
spec := builder pluggableButtonSpec new.
spec model: self.
spec action: (MessageSend receiver: self selector: #fireButton arguments: #()).
widget := builder build: spec.
queries := IdentitySet new.
self fireButtonWidget.
self assert: (queries includes: #fireButton).!
----- Method: ToolBuilderTests>>testButtonFiresSymbol (in category 'tests-button') -----
testButtonFiresSymbol
| spec |
spec := builder pluggableButtonSpec new.
spec model: self.
spec action: #fireButton.
widget := builder build: spec.
queries := IdentitySet new.
self fireButtonWidget.
self assert: (queries includes: #fireButton).!
----- Method: ToolBuilderTests>>testButtonInitiallyDisabled (in category 'tests-button') -----
testButtonInitiallyDisabled
| spec |
spec := builder pluggableButtonSpec new.
spec model: self.
spec label: #getLabel.
spec color: #getColor.
spec state: #getState.
spec enabled: #returnFalse.
widget := builder build: spec.
self deny: (self buttonWidgetEnabled)!
----- Method: ToolBuilderTests>>testButtonInitiallyDisabledSelector (in category 'tests-button') -----
testButtonInitiallyDisabledSelector
| spec |
spec := builder pluggableButtonSpec new.
spec model: self.
spec label: #getLabel.
spec color: #getColor.
spec state: #getState.
spec enabled: #returnFalse.
widget := builder build: spec.
self deny: (self buttonWidgetEnabled)!
----- Method: ToolBuilderTests>>testButtonInitiallyEnabled (in category 'tests-button') -----
testButtonInitiallyEnabled
| spec |
spec := builder pluggableButtonSpec new.
spec model: self.
spec label: #getLabel.
spec color: #getColor.
spec state: #getState.
spec enabled: #returnTrue.
widget := builder build: spec.
self assert: (self buttonWidgetEnabled)!
----- Method: ToolBuilderTests>>testButtonInitiallyEnabledSelector (in category 'tests-button') -----
testButtonInitiallyEnabledSelector
| spec |
spec := builder pluggableButtonSpec new.
spec model: self.
spec label: #getLabel.
spec color: #getColor.
spec state: #getState.
spec enabled: #returnTrue.
widget := builder build: spec.
self assert: (self buttonWidgetEnabled)!
----- Method: ToolBuilderTests>>testButtonWidgetID (in category 'tests-button') -----
testButtonWidgetID
self makeButton.
self assert: (builder widgetAt: #button) == widget.!
----- Method: ToolBuilderTests>>testGetButtonColor (in category 'tests-button') -----
testGetButtonColor
self makeButton.
queries := IdentitySet new.
self changed: #getColor.
self assert: (queries includes: #getColor).
self assert: self widgetColor = self getColor.!
----- Method: ToolBuilderTests>>testGetButtonEnabled (in category 'tests-button') -----
testGetButtonEnabled
self makeButton.
queries := IdentitySet new.
self changed: #getEnabled.
self assert: (queries includes: #getEnabled).!
----- Method: ToolBuilderTests>>testGetButtonLabel (in category 'tests-button') -----
testGetButtonLabel
self makeButton.
queries := IdentitySet new.
self changed: #getLabel.
self assert: (queries includes: #getLabel).!
----- Method: ToolBuilderTests>>testGetButtonSideEffectFree (in category 'tests-button') -----
testGetButtonSideEffectFree
self makeButton.
queries := IdentitySet new.
self changed: #testSignalWithNoDiscernableEffect.
self assert: queries isEmpty.!
----- Method: ToolBuilderTests>>testGetButtonState (in category 'tests-button') -----
testGetButtonState
self makeButton.
queries := IdentitySet new.
self changed: #getState.
self assert: (queries includes: #getState).!
----- Method: ToolBuilderTests>>testGetInputFieldColor (in category 'tests-input') -----
testGetInputFieldColor
self makeInputField.
queries := IdentitySet new.
self changed: #getColor.
self assert: (queries includes: #getColor).
self assert: self widgetColor = self getColor.!
----- Method: ToolBuilderTests>>testGetInputFieldSelection (in category 'tests-input') -----
testGetInputFieldSelection
self makeInputField.
queries := IdentitySet new.
self changed: #getTextSelection.
self assert: (queries includes: #getTextSelection).!
----- Method: ToolBuilderTests>>testGetInputFieldSideEffectFree (in category 'tests-input') -----
testGetInputFieldSideEffectFree
self makeInputField.
queries := IdentitySet new.
self changed: #testSignalWithNoDiscernableEffect.
self assert: queries isEmpty.!
----- Method: ToolBuilderTests>>testGetInputFieldText (in category 'tests-input') -----
testGetInputFieldText
self makeInputField.
queries := IdentitySet new.
self changed: #getText.
self assert: (queries includes: #getText).!
----- Method: ToolBuilderTests>>testGetItemListSideEffectFree (in category 'tests-lists') -----
testGetItemListSideEffectFree
self makeItemList.
queries := IdentitySet new.
self changed: #testSignalWithNoDiscernableEffect.
self assert: queries isEmpty.!
----- Method: ToolBuilderTests>>testGetList (in category 'tests-lists') -----
testGetList
self makeList.
queries := IdentitySet new.
self changed: #getList.
self assert: (queries includes: #getList).!
----- Method: ToolBuilderTests>>testGetListIndex (in category 'tests-lists') -----
testGetListIndex
self makeList.
queries := IdentitySet new.
self changed: #getListIndex.
self assert: (queries includes: #getListIndex).!
----- Method: ToolBuilderTests>>testGetListSelection (in category 'tests-lists') -----
testGetListSelection
self makeItemList.
queries := IdentitySet new.
self changed: #getListSelection.
self assert: (queries includes: #getListSelection).!
----- Method: ToolBuilderTests>>testGetListSideEffectFree (in category 'tests-lists') -----
testGetListSideEffectFree
self makeList.
queries := IdentitySet new.
self changed: #testSignalWithNoDiscernableEffect.
self assert: queries isEmpty.!
----- Method: ToolBuilderTests>>testGetPanelChildren (in category 'tests-panel') -----
testGetPanelChildren
self makePanel.
queries := IdentitySet new.
self changed: #getChildren.
self assert: (queries includes: #getChildren).!
----- Method: ToolBuilderTests>>testGetPanelSideEffectFree (in category 'tests-panel') -----
testGetPanelSideEffectFree
self makePanel.
queries := IdentitySet new.
self changed: #testSignalWithNoDiscernableEffect.
self assert: queries isEmpty.!
----- Method: ToolBuilderTests>>testGetText (in category 'tests-text') -----
testGetText
self makeText.
queries := IdentitySet new.
self changed: #getText.
self assert: (queries includes: #getText).!
----- Method: ToolBuilderTests>>testGetTextColor (in category 'tests-text') -----
testGetTextColor
self makeText.
queries := IdentitySet new.
self changed: #getColor.
self assert: (queries includes: #getColor).
self assert: self widgetColor = self getColor.!
----- Method: ToolBuilderTests>>testGetTextSelection (in category 'tests-text') -----
testGetTextSelection
self makeText.
queries := IdentitySet new.
self changed: #getTextSelection.
self assert: (queries includes: #getTextSelection).!
----- Method: ToolBuilderTests>>testGetTextSideEffectFree (in category 'tests-text') -----
testGetTextSideEffectFree
self makeText.
queries := IdentitySet new.
self changed: #testSignalWithNoDiscernableEffect.
self assert: queries isEmpty.!
----- Method: ToolBuilderTests>>testGetWindowChildren (in category 'tests-window') -----
testGetWindowChildren
self makeWindow.
queries := IdentitySet new.
self changed: #getChildren.
self assert: (queries includes: #getChildren).!
----- Method: ToolBuilderTests>>testGetWindowLabel (in category 'tests-window') -----
testGetWindowLabel
self makeWindow.
queries := IdentitySet new.
self changed: #getLabel.
self assert: (queries includes: #getLabel).!
----- Method: ToolBuilderTests>>testGetWindowSideEffectFree (in category 'tests-window') -----
testGetWindowSideEffectFree
self makeWindow.
queries := IdentitySet new.
self changed: #testSignalWithNoDiscernableEffect.
self assert: queries isEmpty.!
----- Method: ToolBuilderTests>>testInputWidgetID (in category 'tests-input') -----
testInputWidgetID
self makeInputField.
self assert: (builder widgetAt: #input) == widget.!
----- Method: ToolBuilderTests>>testItemListWidgetID (in category 'tests-lists') -----
testItemListWidgetID
self makeItemList.
self assert: (builder widgetAt: #list) == widget.!
----- Method: ToolBuilderTests>>testListWidgetID (in category 'tests-lists') -----
testListWidgetID
self makeList.
self assert: (builder widgetAt: #list) == widget.!
----- Method: ToolBuilderTests>>testPanelWidgetID (in category 'tests-panel') -----
testPanelWidgetID
self makePanel.
self assert: (builder widgetAt: #panel) == widget.!
----- Method: ToolBuilderTests>>testSetInputField (in category 'tests-input') -----
testSetInputField
self makeInputField.
queries := IdentitySet new.
self acceptWidgetText.
self assert: (queries includes: #setText).!
----- Method: ToolBuilderTests>>testSetListIndex (in category 'tests-lists') -----
testSetListIndex
self makeList.
queries := IdentitySet new.
self changeListWidget.
self assert: (queries includes: #setListIndex).!
----- Method: ToolBuilderTests>>testSetListSelection (in category 'tests-lists') -----
testSetListSelection
self makeItemList.
queries := IdentitySet new.
self changeListWidget.
self assert: (queries includes: #setListSelection).!
----- Method: ToolBuilderTests>>testSetText (in category 'tests-text') -----
testSetText
self makeText.
queries := IdentitySet new.
self acceptWidgetText.
self assert: (queries includes: #setText).!
----- Method: ToolBuilderTests>>testTextWidgetID (in category 'tests-text') -----
testTextWidgetID
self makeText.
self assert: (builder widgetAt: #text) == widget!
----- Method: ToolBuilderTests>>testTreeExpandPath (in category 'tests-trees') -----
testTreeExpandPath
"@@@@: REMOVE THIS - it's a hack (changed: #openPath)"
self makeTree.
queries := IdentitySet new.
self changed: {#openPath. '4'. '2'. '3'}.
self waitTick.
self assert: (queries includes: #getChildrenOf).
self assert: (queries includes: #setTreeSelection).
self assert: (queries includes: #getLabelOf).
!
----- Method: ToolBuilderTests>>testTreeExpandPathFirst (in category 'tests-trees') -----
testTreeExpandPathFirst
"@@@@: REMOVE THIS - it's a hack (changed: #openPath)"
self makeTree.
queries := IdentitySet new.
self changed: {#openPath. '1'. '2'. '2'}.
self waitTick.
self assert: (queries includes: #getChildrenOf).
self assert: (queries includes: #setTreeSelection).
self assert: (queries includes: #getLabelOf).
!
----- Method: ToolBuilderTests>>testTreeGetSelectionPath (in category 'tests-trees') -----
testTreeGetSelectionPath
self makeTree.
queries := IdentitySet new.
self changed: #getTreeSelectionPath.
self waitTick.
self assert: (queries includes: #getTreeSelectionPath).
self assert: (queries includes: #getChildrenOf).
self assert: (queries includes: #setTreeSelection).
!
----- Method: ToolBuilderTests>>testTreeRoots (in category 'tests-trees') -----
testTreeRoots
self makeTree.
queries := IdentitySet new.
self changed: #getRoots.
self assert: (queries includes: #getRoots).!
----- Method: ToolBuilderTests>>testTreeWidgetID (in category 'tests-trees') -----
testTreeWidgetID
self makeTree.
self assert: (builder widgetAt: #tree) == widget.!
----- Method: ToolBuilderTests>>testWindowCloseAction (in category 'tests-window') -----
testWindowCloseAction
self openWindow.
builder close: widget.
self assert: (queries includes: #noteWindowClosed).!
----- Method: ToolBuilderTests>>testWindowID (in category 'tests-window') -----
testWindowID
self makeWindow.
self assert: (builder widgetAt: #window) == widget.!
----- Method: ToolBuilderTests>>waitTick (in category 'support') -----
waitTick
^nil!
----- Method: ToolBuilderTests>>widgetColor (in category 'support') -----
widgetColor
"Answer color from widget"
self subclassResponsibility
"NOTE: You can bail out if you don't know how to get the color from the widget:
^self getColor
will work."!
Object subclass: #ToolBuilder
instanceVariableNames: 'parent'
classVariableNames: 'Default'
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!ToolBuilder commentStamp: '<historical>' prior: 0!
I am a tool builder, that is an object which knows how to create concrete widgets from abstract specifications. Those specifications are used by tools which want to be able to function in diverse user interface paradigms, such as MVC, Morphic, Tweak, wxWidgets etc.
The following five specs must be supported by all implementations:
* PluggableButton
* PluggableList
* PluggableText
* PluggablePanel
* PluggableWindow
The following specs are optional:
* PluggableTree: If not supported, the tool builder must answer nil when asked for a pluggableTreeSpec. Substitution will require client support so clients must be aware that some tool builders may not support trees (MVC for example, or Seaside). See examples in FileListPlus or TestRunnerPlus.
* PluggableMultiSelectionList: If multi-selection lists are not supported, tool builder will silently support regular single selection lists.
* PluggableInputField: Intended as a HINT for the builder that this widget will be used as a single line input field. Unless explicitly supported it will be automatically substituted by PluggableText.
* PluggableActionButton: Intended as a HINT for the builder that this widget will be used as push (action) button. Unless explicitly supported it will be automatically substituted by PluggableButton.
* PluggableRadioButton: Intended as a HINT for the builder that this widget will be used as radio button. Unless explicitly supported it will be automatically substituted by PluggableButton.
* PluggableCheckBox: Intended as a HINT for the builder that this widget will be used as check box. Unless explicitly supported it will be automatically substituted by PluggableButton.
!
----- Method: ToolBuilder class>>build: (in category 'instance creation') -----
build: aClass
^self default build: aClass!
----- Method: ToolBuilder class>>default (in category 'accessing') -----
default
"Answer the default tool builder"
| builderClass |
^Default ifNil:[
"Note: The way the following is phrased ensures that you can always make 'more specific' builders merely by subclassing a tool builder and implementing a more specific way of reacting to #isActiveBuilder. For example, a BobsUIToolBuilder can subclass MorphicToolBuilder and (if enabled, say Preferences useBobsUITools) will be considered before the parent (generic MorphicToolBuilder)."
builderClass := self allSubclasses
detect:[:any| any isActiveBuilder and:[
any subclasses noneSatisfy:[:sub| sub isActiveBuilder]]] ifNone:[nil].
builderClass ifNotNil:[builderClass new]]!
----- Method: ToolBuilder class>>default: (in category 'accessing') -----
default: aToolBuilder
"Set a new default tool builder"
Default := aToolBuilder.!
----- Method: ToolBuilder class>>isActiveBuilder (in category 'accessing') -----
isActiveBuilder
"Answer whether I am the currently active builder"
^false!
----- Method: ToolBuilder class>>open: (in category 'instance creation') -----
open: aClass
^self default open: aClass!
----- Method: ToolBuilder class>>open:label: (in category 'instance creation') -----
open: aClass label: aString
^self default open: aClass label: aString!
----- Method: ToolBuilder>>build: (in category 'building') -----
build: anObject
"Build the given object using this tool builder"
^anObject buildWith: self!
----- Method: ToolBuilder>>buildAll:in: (in category 'building') -----
buildAll: aList in: newParent
"Build the given set of widgets in the new parent"
| prior |
aList ifNil:[^self].
prior := parent.
parent := newParent.
aList do:[:each| each buildWith: self].
parent := prior.
!
----- Method: ToolBuilder>>buildPluggableActionButton: (in category 'widgets optional') -----
buildPluggableActionButton: spec
^self buildPluggableButton: spec!
----- Method: ToolBuilder>>buildPluggableButton: (in category 'widgets required') -----
buildPluggableButton: aSpec
^self subclassResponsibility!
----- Method: ToolBuilder>>buildPluggableCheckBox: (in category 'widgets optional') -----
buildPluggableCheckBox: spec
^self buildPluggableButton: spec!
----- Method: ToolBuilder>>buildPluggableInputField: (in category 'widgets optional') -----
buildPluggableInputField: aSpec
^self buildPluggableText: aSpec!
----- Method: ToolBuilder>>buildPluggableList: (in category 'widgets required') -----
buildPluggableList: aSpec
^self subclassResponsibility!
----- Method: ToolBuilder>>buildPluggableMultiSelectionList: (in category 'widgets optional') -----
buildPluggableMultiSelectionList: aSpec
^self buildPluggableList: aSpec!
----- Method: ToolBuilder>>buildPluggablePanel: (in category 'widgets required') -----
buildPluggablePanel: aSpec
^self subclassResponsibility!
----- Method: ToolBuilder>>buildPluggableRadioButton: (in category 'widgets optional') -----
buildPluggableRadioButton: spec
^self buildPluggableButton: spec!
----- Method: ToolBuilder>>buildPluggableText: (in category 'widgets required') -----
buildPluggableText: aSpec
^self subclassResponsibility!
----- Method: ToolBuilder>>buildPluggableTree: (in category 'widgets required') -----
buildPluggableTree: aSpec
^self subclassResponsibility!
----- Method: ToolBuilder>>buildPluggableWindow: (in category 'widgets required') -----
buildPluggableWindow: aSpec
^self subclassResponsibility!
----- Method: ToolBuilder>>close: (in category 'opening') -----
close: aWidget
"Close a previously opened widget"
^self subclassResponsibility!
----- Method: ToolBuilder>>initialize (in category 'initialize') -----
initialize
!
----- Method: ToolBuilder>>open: (in category 'opening') -----
open: anObject
"Build and open the object. Answer the widget opened."
^self subclassResponsibility!
----- Method: ToolBuilder>>open:label: (in category 'opening') -----
open: anObject label: aString
"Build an open the object, labeling it appropriately. Answer the widget opened."
^self subclassResponsibility!
----- Method: ToolBuilder>>parent (in category 'accessing') -----
parent
^parent!
----- Method: ToolBuilder>>parent: (in category 'accessing') -----
parent: aWidget
parent := aWidget!
----- Method: ToolBuilder>>pluggableActionButtonSpec (in category 'defaults') -----
pluggableActionButtonSpec
^PluggableActionButtonSpec!
----- Method: ToolBuilder>>pluggableButtonSpec (in category 'defaults') -----
pluggableButtonSpec
^PluggableButtonSpec!
----- Method: ToolBuilder>>pluggableCheckBoxSpec (in category 'defaults') -----
pluggableCheckBoxSpec
^PluggableCheckBoxSpec!
----- Method: ToolBuilder>>pluggableInputFieldSpec (in category 'defaults') -----
pluggableInputFieldSpec
^PluggableInputFieldSpec!
----- Method: ToolBuilder>>pluggableListSpec (in category 'defaults') -----
pluggableListSpec
^PluggableListSpec!
----- Method: ToolBuilder>>pluggableMenuSpec (in category 'defaults') -----
pluggableMenuSpec
^ PluggableMenuSpec!
----- Method: ToolBuilder>>pluggableMultiSelectionListSpec (in category 'defaults') -----
pluggableMultiSelectionListSpec
^PluggableMultiSelectionListSpec!
----- Method: ToolBuilder>>pluggablePanelSpec (in category 'defaults') -----
pluggablePanelSpec
^PluggablePanelSpec!
----- Method: ToolBuilder>>pluggableRadioButtonSpec (in category 'defaults') -----
pluggableRadioButtonSpec
^PluggableRadioButtonSpec!
----- Method: ToolBuilder>>pluggableTextSpec (in category 'defaults') -----
pluggableTextSpec
^PluggableTextSpec!
----- Method: ToolBuilder>>pluggableTreeSpec (in category 'defaults') -----
pluggableTreeSpec
^PluggableTreeSpec!
----- Method: ToolBuilder>>pluggableWindowSpec (in category 'defaults') -----
pluggableWindowSpec
^PluggableWindowSpec!
----- Method: ToolBuilder>>runModal: (in category 'opening') -----
runModal: aWidget
"Run the (previously opened) widget modally, e.g.,
do not return control to the sender before the user has responded."
^self subclassResponsibility!
----- Method: ToolBuilder>>widgetAt: (in category 'accessing') -----
widgetAt: widgetID
"Answer the widget with the given ID"
^self widgetAt: widgetID ifAbsent:[nil]!
----- Method: ToolBuilder>>widgetAt:ifAbsent: (in category 'accessing') -----
widgetAt: widgetID ifAbsent: aBlock
"Answer the widget with the given ID"
^aBlock value!
Object subclass: #ToolBuilderSpec
instanceVariableNames: 'name'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!ToolBuilderSpec commentStamp: 'ar 2/11/2005 14:59' prior: 0!
I am an abstract widget specification. I can be rendered using many different UI frameworks.!
ToolBuilderSpec subclass: #PluggableMenuItemSpec
instanceVariableNames: 'label action checked enabled separator subMenu help'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
----- Method: PluggableMenuItemSpec>>action (in category 'accessing') -----
action
"Answer the action associated with the receiver"
^action!
----- Method: PluggableMenuItemSpec>>action: (in category 'accessing') -----
action: aMessageSend
"Answer the action associated with the receiver"
action := aMessageSend!
----- Method: PluggableMenuItemSpec>>buildWith: (in category 'building') -----
buildWith: builder
^ builder buildPluggableMenuItem: self!
----- Method: PluggableMenuItemSpec>>checked (in category 'accessing') -----
checked
"Answer whether the receiver is checked"
^checked ifNil:[false]!
----- Method: PluggableMenuItemSpec>>checked: (in category 'accessing') -----
checked: aBool
"Indicate whether the receiver is checked"
checked := aBool.!
----- Method: PluggableMenuItemSpec>>enabled (in category 'accessing') -----
enabled
"Answer whether the receiver is enabled"
^enabled ifNil:[true]!
----- Method: PluggableMenuItemSpec>>enabled: (in category 'accessing') -----
enabled: aBool
"Indicate whether the receiver is enabled"
enabled := aBool!
----- Method: PluggableMenuItemSpec>>help (in category 'accessing') -----
help
"Answer the help text associated with the receiver"
^help!
----- Method: PluggableMenuItemSpec>>help: (in category 'accessing') -----
help: aString
"Answer the help text associated with the receiver"
help := aString.!
----- Method: PluggableMenuItemSpec>>label (in category 'accessing') -----
label
"Answer the receiver's label"
^label!
----- Method: PluggableMenuItemSpec>>label: (in category 'accessing') -----
label: aString
"Set the receiver's label"
label := aString!
----- Method: PluggableMenuItemSpec>>separator (in category 'accessing') -----
separator
"Answer whether the receiver should be followed by a separator"
^separator ifNil:[false]!
----- Method: PluggableMenuItemSpec>>separator: (in category 'accessing') -----
separator: aBool
"Indicate whether the receiver should be followed by a separator"
separator := aBool.!
----- Method: PluggableMenuItemSpec>>subMenu (in category 'accessing') -----
subMenu
"Answer the receiver's subMenu"
^subMenu!
----- Method: PluggableMenuItemSpec>>subMenu: (in category 'accessing') -----
subMenu: aMenuSpec
"Answer the receiver's subMenu"
subMenu := aMenuSpec!
ToolBuilderSpec subclass: #PluggableMenuSpec
instanceVariableNames: 'label model items'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
----- Method: PluggableMenuSpec class>>withModel: (in category 'as yet unclassified') -----
withModel: aModel
^ self new model: aModel!
----- Method: PluggableMenuSpec>>add:action: (in category 'construction') -----
add: aString action: aMessageSend
| item |
item := self addMenuItem.
item label: aString.
item action: aMessageSend.
^item!
----- Method: PluggableMenuSpec>>add:target:selector:argumentList: (in category 'construction') -----
add: aString target: anObject selector: aSelector argumentList: anArray
^self add: aString action: (MessageSend
receiver: anObject
selector: aSelector
arguments: anArray).!
----- Method: PluggableMenuSpec>>addMenuItem (in category 'construction') -----
addMenuItem
| item |
item := self newMenuItem.
self items add: item.
^item!
----- Method: PluggableMenuSpec>>addSeparator (in category 'construction') -----
addSeparator
self items isEmpty ifTrue:[^nil].
self items last separator: true.!
----- Method: PluggableMenuSpec>>buildWith: (in category 'construction') -----
buildWith: builder
^ builder buildPluggableMenu: self!
----- Method: PluggableMenuSpec>>items (in category 'accessing') -----
items
^ items ifNil: [items := OrderedCollection new]!
----- Method: PluggableMenuSpec>>label (in category 'accessing') -----
label
^label!
----- Method: PluggableMenuSpec>>label: (in category 'accessing') -----
label: aString
label := aString.!
----- Method: PluggableMenuSpec>>model (in category 'accessing') -----
model
^ model!
----- Method: PluggableMenuSpec>>model: (in category 'accessing') -----
model: anObject
model := anObject!
----- Method: PluggableMenuSpec>>newMenuItem (in category 'construction') -----
newMenuItem
^PluggableMenuItemSpec new!
ToolBuilderSpec subclass: #PluggableWidgetSpec
instanceVariableNames: 'model frame'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableWidgetSpec commentStamp: 'ar 2/9/2005 18:40' prior: 0!
The abstract superclass for all widgets.
Instance variables:
model <Object> The object the various requests should be directed to.
frame <Rectangle> The associated layout frame for this object (if any).
!
PluggableWidgetSpec subclass: #PluggableButtonSpec
instanceVariableNames: 'action label state enabled color help'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableButtonSpec commentStamp: 'ar 2/11/2005 21:57' prior: 0!
A button, both for firing as well as used in radio-button style (e.g., carrying a selection).
Instance variables:
action <Symbol> The action to perform when the button is fired.
label <Symbol|String> The selector for retrieving the button's label or label directly.
state <Symbol> The selector for retrieving the button's selection state.
enabled <Symbo> The selector for retrieving the button's enabled state.
color <Symbo> The selector for retrieving the button color.
help <String> The balloon help for the button.!
PluggableButtonSpec subclass: #PluggableActionButtonSpec
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableActionButtonSpec commentStamp: 'ar 2/12/2005 23:12' prior: 0!
PluggableActionButtonSpec is intentded as a HINT for the builder that this widget will be used as push (action) button. Unless explicitly supported it will be automatically substituted by PluggableButton.!
----- Method: PluggableActionButtonSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableActionButton: self!
----- Method: PluggableButtonSpec>>action (in category 'accessing') -----
action
"Answer the action to be performed by the receiver"
^action!
----- Method: PluggableButtonSpec>>action: (in category 'accessing') -----
action: aSymbol
"Indicate the action to be performed by the receiver"
action := aSymbol!
----- Method: PluggableButtonSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableButton: self!
----- Method: PluggableButtonSpec>>color (in category 'accessing') -----
color
"Answer the selector for retrieving the button's color"
^color!
----- Method: PluggableButtonSpec>>color: (in category 'accessing') -----
color: aSymbol
"Indicate the selector for retrieving the button's color"
color := aSymbol!
----- Method: PluggableButtonSpec>>enabled (in category 'accessing') -----
enabled
"Answer the selector for retrieving the button's enablement"
^enabled ifNil:[true]!
----- Method: PluggableButtonSpec>>enabled: (in category 'accessing') -----
enabled: aSymbol
"Indicate the selector for retrieving the button's enablement"
enabled := aSymbol!
----- Method: PluggableButtonSpec>>help (in category 'accessing') -----
help
"Answer the help text for this button"
^help!
----- Method: PluggableButtonSpec>>help: (in category 'accessing') -----
help: aString
"Indicate the help text for this button"
help := aString.!
----- Method: PluggableButtonSpec>>label (in category 'accessing') -----
label
"Answer the label (or the selector for retrieving the label)"
^label!
----- Method: PluggableButtonSpec>>label: (in category 'accessing') -----
label: aSymbol
"Indicate the selector for retrieving the label"
label := aSymbol.!
----- Method: PluggableButtonSpec>>state (in category 'accessing') -----
state
"Answer the selector for retrieving the button's state"
^state!
----- Method: PluggableButtonSpec>>state: (in category 'accessing') -----
state: aSymbol
"Indicate the selector for retrieving the button's state"
state := aSymbol.!
PluggableButtonSpec subclass: #PluggableCheckBoxSpec
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableCheckBoxSpec commentStamp: 'ar 2/12/2005 23:13' prior: 0!
PluggableCheckBox is intended as a HINT for the builder that this widget will be used as check box. Unless explicitly supported it will be automatically substituted by PluggableButton.!
----- Method: PluggableCheckBoxSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableCheckBox: self!
PluggableButtonSpec subclass: #PluggableRadioButtonSpec
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableRadioButtonSpec commentStamp: 'ar 2/12/2005 23:14' prior: 0!
PluggableRadioButton is intended as a HINT for the builder that this widget will be used as radio button. Unless explicitly supported it will be automatically substituted by PluggableButton.!
----- Method: PluggableRadioButtonSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableRadioButton: self!
PluggableWidgetSpec subclass: #PluggableCompositeSpec
instanceVariableNames: 'children layout'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableCompositeSpec commentStamp: 'ar 2/11/2005 21:58' prior: 0!
A composite user interface element.
Instance variables:
children <Symbol|Collection> Symbol to retrieve children or children directly
layout <Symbol> The layout for this composite.
!
----- Method: PluggableCompositeSpec>>children (in category 'accessing') -----
children
"Answer the selector to retrieve this panel's children"
^children!
----- Method: PluggableCompositeSpec>>children: (in category 'accessing') -----
children: aSymbol
"Indicate the selector to retrieve this panel's children"
children := aSymbol!
----- Method: PluggableCompositeSpec>>layout (in category 'accessing') -----
layout
"Answer the symbol indicating the layout of the composite:
#proportional (default): Use frames as appropriate.
#horizontal: Arrange the elements horizontally
#vertical: Arrange the elements vertically.
"
^layout ifNil:[#proportional]!
----- Method: PluggableCompositeSpec>>layout: (in category 'accessing') -----
layout: aSymbol
"Answer the symbol indicating the layout of the composite:
#proportional (default): Use frames as appropriate.
#horizontal: Arrange the elements horizontally
#vertical: Arrange the elements vertically.
"
layout := aSymbol!
PluggableCompositeSpec subclass: #PluggablePanelSpec
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggablePanelSpec commentStamp: 'ar 2/11/2005 15:01' prior: 0!
A panel with a (possibly changing) set of child elements. Expects to see change/update notifications when the childrens change.!
----- Method: PluggablePanelSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggablePanel: self.!
PluggableCompositeSpec subclass: #PluggableWindowSpec
instanceVariableNames: 'label extent closeAction'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableWindowSpec commentStamp: '<historical>' prior: 0!
A common window. Expects to see change/update notifications when the label should change.
Instance variables:
label <String|Symbol> The selector under which to retrieve the label or the label directly
extent <Point> The (initial) extent of the window.
closeAction <Symbol> The action to perform when the window is closed.!
----- Method: PluggableWindowSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableWindow: self.!
----- Method: PluggableWindowSpec>>closeAction (in category 'accessing') -----
closeAction
"Answer the receiver's closeAction"
^closeAction!
----- Method: PluggableWindowSpec>>closeAction: (in category 'accessing') -----
closeAction: aSymbol
"Answer the receiver's closeAction"
closeAction := aSymbol.!
----- Method: PluggableWindowSpec>>extent (in category 'accessing') -----
extent
"Answer the window's (initial) extent"
^extent!
----- Method: PluggableWindowSpec>>extent: (in category 'accessing') -----
extent: aPoint
"Indicate the window's (initial) extent"
extent := aPoint!
----- Method: PluggableWindowSpec>>label (in category 'accessing') -----
label
"Answer the selector for retrieving the window's label"
^label!
----- Method: PluggableWindowSpec>>label: (in category 'accessing') -----
label: aString
"Indicate the selector for retrieving the window's label"
label := aString!
PluggableWidgetSpec subclass: #PluggableListSpec
instanceVariableNames: 'list getIndex setIndex getSelected setSelected menu keyPress autoDeselect dragItem dropItem dropAccept'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableListSpec commentStamp: 'ar 7/15/2005 11:54' prior: 0!
A single selection list element.
Instance variables:
list <Symbol> The selector to retrieve the list elements.
getIndex <Symbol> The selector to retrieve the list selection index.
setIndex <Symbol> The selector to set the list selection index.
getSelected <Symbol> The selector to retrieve the list selection.
setSelected <Symbol> The selector to set the list selection.
menu <Symbol> The selector to offer (to retrieve?) the context menu.
keyPress <Symbol> The selector to invoke for handling keyboard shortcuts.
autoDeselect <Boolean> Whether the list should allow automatic deselection or not.
dragItem <Symbol> Selector to initiate a drag action on an item
dropItem <Symbol> Selector to initiate a drop action of an item
dropAccept <Symbol> Selector to determine whether a drop would be accepted!
----- Method: PluggableListSpec>>autoDeselect (in category 'accessing') -----
autoDeselect
"Answer whether this tree can be automatically deselected"
^autoDeselect ifNil:[true]!
----- Method: PluggableListSpec>>autoDeselect: (in category 'accessing') -----
autoDeselect: aBool
"Indicate whether this tree can be automatically deselected"
autoDeselect := aBool!
----- Method: PluggableListSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableList: self!
----- Method: PluggableListSpec>>dragItem (in category 'accessing') -----
dragItem
"Answer the selector for dragging an item"
^dragItem!
----- Method: PluggableListSpec>>dragItem: (in category 'accessing') -----
dragItem: aSymbol
"Set the selector for dragging an item"
dragItem := aSymbol!
----- Method: PluggableListSpec>>dropAccept (in category 'accessing') -----
dropAccept
"Answer the selector to determine whether a drop would be accepted"
^dropAccept!
----- Method: PluggableListSpec>>dropAccept: (in category 'accessing') -----
dropAccept: aSymbol
"Answer the selector to determine whether a drop would be accepted"
dropAccept := aSymbol.!
----- Method: PluggableListSpec>>dropItem (in category 'accessing') -----
dropItem
"Answer the selector for dropping an item"
^dropItem!
----- Method: PluggableListSpec>>dropItem: (in category 'accessing') -----
dropItem: aSymbol
"Set the selector for dropping an item"
dropItem := aSymbol!
----- Method: PluggableListSpec>>getIndex (in category 'accessing') -----
getIndex
"Answer the selector for retrieving the list's selection index"
^getIndex!
----- Method: PluggableListSpec>>getIndex: (in category 'accessing') -----
getIndex: aSymbol
"Indicate the selector for retrieving the list's selection index"
getIndex := aSymbol!
----- Method: PluggableListSpec>>getSelected (in category 'accessing') -----
getSelected
"Answer the selector for retrieving the list selection"
^getSelected!
----- Method: PluggableListSpec>>getSelected: (in category 'accessing') -----
getSelected: aSymbol
"Indicate the selector for retrieving the list selection"
getSelected := aSymbol!
----- Method: PluggableListSpec>>keyPress (in category 'accessing') -----
keyPress
"Answer the selector for invoking the list's keyPress handler"
^keyPress!
----- Method: PluggableListSpec>>keyPress: (in category 'accessing') -----
keyPress: aSymbol
"Indicate the selector for invoking the list's keyPress handler"
keyPress := aSymbol!
----- Method: PluggableListSpec>>list (in category 'accessing') -----
list
"Answer the selector for retrieving the list contents"
^list!
----- Method: PluggableListSpec>>list: (in category 'accessing') -----
list: aSymbol
"Indicate the selector for retrieving the list contents"
list := aSymbol.!
----- Method: PluggableListSpec>>menu (in category 'accessing') -----
menu
"Answer the selector for retrieving the list's menu"
^menu!
----- Method: PluggableListSpec>>menu: (in category 'accessing') -----
menu: aSymbol
"Indicate the selector for retrieving the list's menu"
menu := aSymbol!
----- Method: PluggableListSpec>>setIndex (in category 'accessing') -----
setIndex
"Answer the selector for setting the list's selection index"
^setIndex!
----- Method: PluggableListSpec>>setIndex: (in category 'accessing') -----
setIndex: aSymbol
"Answer the selector for setting the list's selection index"
setIndex := aSymbol!
----- Method: PluggableListSpec>>setSelected (in category 'accessing') -----
setSelected
"Answer the selector for setting the list selection"
^setSelected!
----- Method: PluggableListSpec>>setSelected: (in category 'accessing') -----
setSelected: aSymbol
"Indicate the selector for setting the list selection"
setSelected := aSymbol!
PluggableListSpec subclass: #PluggableMultiSelectionListSpec
instanceVariableNames: 'getSelectionList setSelectionList'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableMultiSelectionListSpec commentStamp: 'ar 2/12/2005 13:31' prior: 0!
PluggableMultiSelectionListSpec specifies a list with multiple selection behavior.
Instance variables:
getSelectionList <Symbol> The message to retrieve the multiple selections.
setSelectionList <Symbol> The message to indicate multiple selections.!
----- Method: PluggableMultiSelectionListSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableMultiSelectionList: self!
----- Method: PluggableMultiSelectionListSpec>>getSelectionList (in category 'accessing') -----
getSelectionList
"Answer the message to retrieve the multiple selections"
^getSelectionList!
----- Method: PluggableMultiSelectionListSpec>>getSelectionList: (in category 'accessing') -----
getSelectionList: aSymbol
"Indicate the message to retrieve the multiple selections"
getSelectionList := aSymbol!
----- Method: PluggableMultiSelectionListSpec>>setSelectionList (in category 'accessing') -----
setSelectionList
"Answer the message to indicate multiple selections"
^setSelectionList!
----- Method: PluggableMultiSelectionListSpec>>setSelectionList: (in category 'accessing') -----
setSelectionList: aSymbol
"Indicate the message to indicate multiple selections"
setSelectionList := aSymbol!
PluggableWidgetSpec subclass: #PluggableTextSpec
instanceVariableNames: 'getText setText selection menu color'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableTextSpec commentStamp: 'ar 2/11/2005 21:58' prior: 0!
A text editor.
Instance variables:
getText <Symbol> The selector to retrieve the text.
setText <Symbol> The selector to set the text.
selection <Symbol> The selector to retrieve the text selection.
menu <Symbol> The selector to offer (to retrieve?) the context menu.
color <Symbol> The selector to retrieve the background color.
!
PluggableTextSpec subclass: #PluggableInputFieldSpec
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableInputFieldSpec commentStamp: 'ar 2/12/2005 23:13' prior: 0!
PluggableInputField is intended as a HINT for the builder that this widget will be used as a single line input field. Unless explicitly supported it will be automatically substituted by PluggableText.!
----- Method: PluggableInputFieldSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableInputField: self!
----- Method: PluggableTextSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableText: self!
----- Method: PluggableTextSpec>>color (in category 'accessing') -----
color
"Answer the selector for retrieving the background color"
^color!
----- Method: PluggableTextSpec>>color: (in category 'accessing') -----
color: aSymbol
"Indicate the selector for retrieving the background color"
color := aSymbol.!
----- Method: PluggableTextSpec>>getText (in category 'accessing') -----
getText
"Answer the selector for retrieving the text"
^getText!
----- Method: PluggableTextSpec>>getText: (in category 'accessing') -----
getText: aSymbol
"Answer the selector for retrieving the text"
getText := aSymbol!
----- Method: PluggableTextSpec>>menu (in category 'accessing') -----
menu
"Answer the selector for retrieving the text's menu"
^menu!
----- Method: PluggableTextSpec>>menu: (in category 'accessing') -----
menu: aSymbol
"Indicate the selector for retrieving the text's menu"
menu := aSymbol!
----- Method: PluggableTextSpec>>selection (in category 'accessing') -----
selection
"Answer the selector for retrieving the text selection"
^selection!
----- Method: PluggableTextSpec>>selection: (in category 'accessing') -----
selection: aSymbol
"Indicate the selector for retrieving the text selection"
selection := aSymbol!
----- Method: PluggableTextSpec>>setText (in category 'accessing') -----
setText
"Answer the selector for setting the text"
^setText!
----- Method: PluggableTextSpec>>setText: (in category 'accessing') -----
setText: aSymbol
"Answer the selector for setting the text"
setText := aSymbol!
PluggableWidgetSpec subclass: #PluggableTreeSpec
instanceVariableNames: 'roots getSelectedPath setSelected getChildren hasChildren label icon help menu keyPress wantsDrop dropItem dropAccept autoDeselect'
classVariableNames: ''
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!PluggableTreeSpec commentStamp: 'ar 2/12/2005 16:40' prior: 0!
A pluggable tree widget. PluggableTrees are slightly different from lists in such that they ALWAYS store the actual objects and use the label selector to query for the label of the item. PluggableTrees also behave somewhat differently in such that they do not have a "getSelected" message but only a getSelectedPath message. The difference is that getSelectedPath is used to indicate by the model that the tree should select the appropriate path. This allows disambiguation of items. Because of this, implementations of PluggableTrees must always set their internal selection directly, e.g., rather than sending the model a setSelected message and wait for an update of the #getSelected the implementation must set the selection before sending the #setSelected message. If a client doesn't want this, it can always just signal a change of getSelectedPath to revert to whatever is needed.
Instance variables:
roots <Symbol> The message to retrieve the roots of the tree.
getSelectedPath <Symbol> The message to retrieve the selected path in the tree.
setSelected <Symbol> The message to set the selected item in the tree.
getChildren <Symbol> The message to retrieve the children of an item
hasChildren <Symbol> The message to query for children of an item
label <Symbol> The message to query for the label of an item.
icon <Symbol> The message to query for the icon of an item.
help <Symbol> The message to query for the help of an item.
menu <Symbol> The message to query for the tree's menu
keyPress <Symbol> The message to process a keystroke.
wantsDrop <Symbol> The message to query whether a drop might be accepted.
dropItem <Symbol> The message to drop an item.
autoDeselect <Boolean> Whether the tree should allow automatic deselection or not.!
----- Method: PluggableTreeSpec>>autoDeselect (in category 'accessing') -----
autoDeselect
"Answer whether this tree can be automatically deselected"
^autoDeselect ifNil:[true]!
----- Method: PluggableTreeSpec>>autoDeselect: (in category 'accessing') -----
autoDeselect: aBool
"Indicate whether this tree can be automatically deselected"
autoDeselect := aBool!
----- Method: PluggableTreeSpec>>buildWith: (in category 'building') -----
buildWith: builder
^builder buildPluggableTree: self!
----- Method: PluggableTreeSpec>>dropAccept (in category 'accessing') -----
dropAccept
"Answer the selector for querying the receiver about accepting drops"
^dropAccept!
----- Method: PluggableTreeSpec>>dropAccept: (in category 'accessing') -----
dropAccept: aSymbol
"Set the selector for querying the receiver about accepting drops"
dropAccept := aSymbol!
----- Method: PluggableTreeSpec>>dropItem (in category 'accessing') -----
dropItem
"Answer the selector for invoking the tree's dragDrop handler"
^dropItem!
----- Method: PluggableTreeSpec>>dropItem: (in category 'accessing') -----
dropItem: aSymbol
"Indicate the selector for invoking the tree's dragDrop handler"
dropItem := aSymbol!
----- Method: PluggableTreeSpec>>getChildren (in category 'accessing') -----
getChildren
"Answer the message to get the children of this tree"
^getChildren!
----- Method: PluggableTreeSpec>>getChildren: (in category 'accessing') -----
getChildren: aSymbol
"Indicate the message to retrieve the children of this tree"
getChildren := aSymbol!
----- Method: PluggableTreeSpec>>getSelectedPath (in category 'accessing') -----
getSelectedPath
"Answer the message to retrieve the selection of this tree"
^getSelectedPath!
----- Method: PluggableTreeSpec>>getSelectedPath: (in category 'accessing') -----
getSelectedPath: aSymbol
"Indicate the message to retrieve the selection of this tree"
getSelectedPath := aSymbol!
----- Method: PluggableTreeSpec>>hasChildren (in category 'accessing') -----
hasChildren
"Answer the message to get the existence of children in this tree"
^hasChildren!
----- Method: PluggableTreeSpec>>hasChildren: (in category 'accessing') -----
hasChildren: aSymbol
"Indicate the message to retrieve the existence children in this tree"
hasChildren := aSymbol!
----- Method: PluggableTreeSpec>>help (in category 'accessing') -----
help
"Answer the message to get the help texts of this tree"
^help!
----- Method: PluggableTreeSpec>>help: (in category 'accessing') -----
help: aSymbol
"Indicate the message to retrieve the help texts of this tree"
help := aSymbol!
----- Method: PluggableTreeSpec>>icon (in category 'accessing') -----
icon
"Answer the message to get the icons of this tree"
^icon!
----- Method: PluggableTreeSpec>>icon: (in category 'accessing') -----
icon: aSymbol
"Indicate the message to retrieve the icon of this tree"
icon := aSymbol!
----- Method: PluggableTreeSpec>>keyPress (in category 'accessing') -----
keyPress
"Answer the selector for invoking the tree's keyPress handler"
^keyPress!
----- Method: PluggableTreeSpec>>keyPress: (in category 'accessing') -----
keyPress: aSymbol
"Indicate the selector for invoking the tree's keyPress handler"
keyPress := aSymbol!
----- Method: PluggableTreeSpec>>label (in category 'accessing') -----
label
"Answer the message to get the labels of this tree"
^label!
----- Method: PluggableTreeSpec>>label: (in category 'accessing') -----
label: aSymbol
"Indicate the message to retrieve the labels of this tree"
label := aSymbol!
----- Method: PluggableTreeSpec>>menu (in category 'accessing') -----
menu
"Answer the message to get the menus of this tree"
^menu!
----- Method: PluggableTreeSpec>>menu: (in category 'accessing') -----
menu: aSymbol
"Indicate the message to retrieve the menus of this tree"
menu := aSymbol!
----- Method: PluggableTreeSpec>>roots (in category 'accessing') -----
roots
"Answer the message to retrieve the roots of this tree"
^roots!
----- Method: PluggableTreeSpec>>roots: (in category 'accessing') -----
roots: aSymbol
"Indicate the message to retrieve the roots of this tree"
roots := aSymbol!
----- Method: PluggableTreeSpec>>setSelected (in category 'accessing') -----
setSelected
"Answer the message to set the selection of this tree"
^setSelected!
----- Method: PluggableTreeSpec>>setSelected: (in category 'accessing') -----
setSelected: aSymbol
"Indicate the message to set the selection of this tree"
setSelected := aSymbol!
----- Method: PluggableTreeSpec>>wantsDrop (in category 'accessing') -----
wantsDrop
"Answer the selector for invoking the tree's wantsDrop handler"
^wantsDrop!
----- Method: PluggableTreeSpec>>wantsDrop: (in category 'accessing') -----
wantsDrop: aSymbol
"Indicate the selector for invoking the tree's wantsDrop handler"
wantsDrop := aSymbol!
----- Method: PluggableWidgetSpec>>frame (in category 'accessing') -----
frame
"Answer the receiver's layout frame"
^frame!
----- Method: PluggableWidgetSpec>>frame: (in category 'accessing') -----
frame: aRectangle
"Indicate the receiver's layout frame"
frame := aRectangle!
----- Method: PluggableWidgetSpec>>model (in category 'accessing') -----
model
"Answer the model for which this widget should be built"
^model!
----- Method: PluggableWidgetSpec>>model: (in category 'accessing') -----
model: aModel
"Indicate the model for which this widget should be built"
model := aModel.!
----- Method: ToolBuilderSpec>>buildWith: (in category 'building') -----
buildWith: aBuilder
^self subclassResponsibility!
----- Method: ToolBuilderSpec>>name (in category 'accessing') -----
name
^ name!
----- Method: ToolBuilderSpec>>name: (in category 'accessing') -----
name: anObject
name := anObject!
Object subclass: #UIManager
instanceVariableNames: ''
classVariableNames: 'Default'
poolDictionaries: ''
category: 'ToolBuilder-Kernel'!
!UIManager commentStamp: 'ar 12/27/2004 08:39' prior: 0!
UIManager is a dispatcher for various UI requests.!
----- Method: UIManager class>>default (in category 'class initialization') -----
default
| mgrClass |
^Default ifNil:[
"Note: The way the following is phrased ensures that you can always make 'more specific' managers merely by subclassing a tool builder and implementing a more specific way of reacting to #isActiveManager. For example, a BobsUIManager can subclass MorphicUIManager and (if enabled, say Preferences useBobsUI) will be considered before the parent (generic MorphicUIManager)."
mgrClass := self allSubclasses
detect:[:any| any isActiveManager and:[
any subclasses noneSatisfy:[:sub| sub isActiveManager]]] ifNone:[nil].
mgrClass ifNotNil:[mgrClass new]
].!
----- Method: UIManager class>>default: (in category 'class initialization') -----
default: aUIManager
Default := aUIManager!
----- Method: UIManager class>>isActiveManager (in category 'class initialization') -----
isActiveManager
"Answer whether I should act as the active ui manager"
^false!
----- Method: UIManager>>chooseDirectory (in category 'ui requests') -----
chooseDirectory
"Let the user choose a directory"
^self chooseDirectoryFrom: FileDirectory default!
----- Method: UIManager>>chooseDirectory: (in category 'ui requests') -----
chooseDirectory: label
"Let the user choose a directory"
^self chooseDirectory: label from: FileDirectory default!
----- Method: UIManager>>chooseDirectory:from: (in category 'ui requests') -----
chooseDirectory: label from: dir
"Let the user choose a directory"
^self subclassResponsibility!
----- Method: UIManager>>chooseDirectoryFrom: (in category 'ui requests') -----
chooseDirectoryFrom: dir
"Let the user choose a directory"
^self chooseDirectory: nil from: dir!
----- Method: UIManager>>chooseFileMatching: (in category 'ui requests') -----
chooseFileMatching: patterns
"Let the user choose a file matching the given patterns"
^self chooseFileMatching: patterns label: nil!
----- Method: UIManager>>chooseFileMatching:label: (in category 'ui requests') -----
chooseFileMatching: patterns label: labelString
"Let the user choose a file matching the given patterns"
^self subclassResponsibility!
----- Method: UIManager>>chooseFrom: (in category 'ui requests') -----
chooseFrom: aList
"Choose an item from the given list. Answer the index of the selected item."
^self chooseFrom: aList lines: #()!
----- Method: UIManager>>chooseFrom:lines: (in category 'ui requests') -----
chooseFrom: aList lines: linesArray
"Choose an item from the given list. Answer the index of the selected item."
^self chooseFrom: aList lines: linesArray title: ''!
----- Method: UIManager>>chooseFrom:lines:title: (in category 'ui requests') -----
chooseFrom: aList lines: linesArray title: aString
"Choose an item from the given list. Answer the index of the selected item."
^self subclassResponsibility!
----- Method: UIManager>>chooseFrom:title: (in category 'ui requests') -----
chooseFrom: aList title: aString
"Choose an item from the given list. Answer the index of the selected item."
^self chooseFrom: aList lines: #() title: aString!
----- Method: UIManager>>chooseFrom:values: (in category 'ui requests') -----
chooseFrom: labelList values: valueList
"Choose an item from the given list. Answer the selected item."
^self chooseFrom: labelList values: valueList lines: #()!
----- Method: UIManager>>chooseFrom:values:lines: (in category 'ui requests') -----
chooseFrom: labelList values: valueList lines: linesArray
"Choose an item from the given list. Answer the selected item."
^self chooseFrom: labelList values: valueList lines: linesArray title: ''!
----- Method: UIManager>>chooseFrom:values:lines:title: (in category 'ui requests') -----
chooseFrom: labelList values: valueList lines: linesArray title: aString
"Choose an item from the given list. Answer the selected item."
^self subclassResponsibility!
----- Method: UIManager>>chooseFrom:values:title: (in category 'ui requests') -----
chooseFrom: labelList values: valueList title: aString
"Choose an item from the given list. Answer the selected item."
^self chooseFrom: labelList values: valueList lines: #() title: aString!
----- Method: UIManager>>confirm: (in category 'ui requests') -----
confirm: queryString
"Put up a yes/no menu with caption queryString. Answer true if the
response is yes, false if no. This is a modal question--the user must
respond yes or no."
^self subclassResponsibility!
----- Method: UIManager>>confirm:orCancel: (in category 'ui requests') -----
confirm: aString orCancel: cancelBlock
"Put up a yes/no/cancel menu with caption aString. Answer true if
the response is yes, false if no. If cancel is chosen, evaluate
cancelBlock. This is a modal question--the user must respond yes or no."
^self subclassResponsibility!
----- Method: UIManager>>displayProgress:at:from:to:during: (in category 'ui requests') -----
displayProgress: titleString at: aPoint from: minVal to: maxVal during: workBlock
"Display titleString as a caption over a progress bar while workBlock is evaluated."
^self subclassResponsibility!
----- Method: UIManager>>edit: (in category 'ui requests') -----
edit: aText
"Open an editor on the given string/text"
^self edit: aText label: nil!
----- Method: UIManager>>edit:label: (in category 'ui requests') -----
edit: aText label: labelString
"Open an editor on the given string/text"
^self edit: aText label: labelString accept: nil!
----- Method: UIManager>>edit:label:accept: (in category 'ui requests') -----
edit: aText label: labelString accept: anAction
"Open an editor on the given string/text"
^self subclassResponsibility!
----- Method: UIManager>>inform: (in category 'ui requests') -----
inform: aString
"Display a message for the user to read and then dismiss"
^self subclassResponsibility!
----- Method: UIManager>>informUser:during: (in category 'ui requests') -----
informUser: aString during: aBlock
"Display a message above (or below if insufficient room) the cursor
during execution of the given block.
UIManager default informUser: 'Just a sec!!' during: [(Delay forSeconds: 1) wait].
"
^self informUserDuring:[:bar| bar value: aString. aBlock value].!
----- Method: UIManager>>informUserDuring: (in category 'ui requests') -----
informUserDuring: aBlock
"Display a message above (or below if insufficient room) the cursor
during execution of the given block.
UIManager default informUserDuring:[:bar|
#(one two three) do:[:info|
bar value: info.
(Delay forSeconds: 1) wait]]"
^self subclassResponsibility!
----- Method: UIManager>>multiLineRequest:centerAt:initialAnswer:answerHeight: (in category 'ui requests') -----
multiLineRequest: queryString centerAt: aPoint initialAnswer: defaultAnswer answerHeight: answerHeight
"Create a multi-line instance of me whose question is queryString with
the given initial answer. Invoke it centered at the given point, and
answer the string the user accepts. Answer nil if the user cancels. An
empty string returned means that the ussr cleared the editing area and
then hit 'accept'. Because multiple lines are invited, we ask that the user
use the ENTER key, or (in morphic anyway) hit the 'accept' button, to
submit; that way, the return key can be typed to move to the next line."
^self subclassResponsibility!
----- Method: UIManager>>request: (in category 'ui requests') -----
request: queryString
"Create an instance of me whose question is queryString. Invoke it
centered at the cursor, and answer the string the user accepts. Answer
the empty string if the user cancels."
^self request: queryString initialAnswer: ''!
----- Method: UIManager>>request:initialAnswer: (in category 'ui requests') -----
request: queryString initialAnswer: defaultAnswer
"Create an instance of me whose question is queryString with the given
initial answer. Invoke it centered at the given point, and answer the
string the user accepts. Answer the empty string if the user cancels."
^self subclassResponsibility!
----- Method: UIManager>>requestPassword: (in category 'ui requests') -----
requestPassword: queryString
"Create an instance of me whose question is queryString. Invoke it centered
at the cursor, and answer the string the user accepts. Answer the empty
string if the user cancels."
^self subclassResponsibility!
More information about the Packages
mailing list