The Trunk: ToolBuilder-Kernel-fbs.59.mcz

Frank Shearar uploaded a new version of ToolBuilder-Kernel to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Kernel-fbs.59.mcz

==================== Summary ====================

Name: ToolBuilder-Kernel-fbs.59
Author: fbs
Time: 7 December 2013, 7:46:48.769 pm
UUID: d951bc00-3095-734e-9459-04cbb38b5f8d
Ancestors: ToolBuilder-Kernel-fbs.58

* Pull the unit tests out into ToolBuilderTests, a new package. This breaks the ToolBuilder -> SUnit dependency.
* Move the "choose a class from some pattern" logic from Utilities to UIManager. It looks introspective, but it's inherently based on user input, and about finding something for the user.

=============== Diff against ToolBuilder-Kernel-fbs.58 ===============

Item was removed:
- TestCase subclass: #PluggableMenuItemSpecTests
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'ToolBuilder-Kernel'!

Item was removed:
- ----- Method: PluggableMenuItemSpecTests>>testBeCheckableMakesItemCheckable (in category 'as yet unclassified') -----
- testBeCheckableMakesItemCheckable
- | itemSpec |
- itemSpec := PluggableMenuItemSpec new.
- itemSpec beCheckable.
- self assert: itemSpec isCheckable description: 'Item not checkable'.!

Item was removed:
- ----- Method: PluggableMenuItemSpecTests>>testByDefaultNotCheckable (in category 'as yet unclassified') -----
- testByDefaultNotCheckable
- | itemSpec |
- itemSpec := PluggableMenuItemSpec new.
- self deny: itemSpec isCheckable.!

Item was removed:
- ----- Method: PluggableMenuItemSpecTests>>testNoMarkerMakesItemChecked (in category 'as yet unclassified') -----
- testNoMarkerMakesItemChecked
- | itemSpec |
- itemSpec := PluggableMenuItemSpec new.
- itemSpec label: '<no>no'.
- itemSpec analyzeLabel.
- self assert: itemSpec isCheckable description: 'item not checkable'.
- self deny: itemSpec checked description: 'item checked'.!

Item was removed:
- ----- Method: PluggableMenuItemSpecTests>>testOffMarkerMakesItemChecked (in category 'as yet unclassified') -----
- testOffMarkerMakesItemChecked
- | itemSpec |
- itemSpec := PluggableMenuItemSpec new.
- itemSpec label: '<off>off'.
- itemSpec analyzeLabel.
- self assert: itemSpec isCheckable description: 'item not checkable'.
- self deny: itemSpec checked description: 'item checked'.!

Item was removed:
- ----- Method: PluggableMenuItemSpecTests>>testOnMarkerMakesItemChecked (in category 'as yet unclassified') -----
- testOnMarkerMakesItemChecked
- | itemSpec |
- itemSpec := PluggableMenuItemSpec new.
- itemSpec label: '<on>on'.
- itemSpec analyzeLabel.
- self assert: itemSpec isCheckable description: 'item not checkable'.
- self assert: itemSpec isCheckable description: 'item not checked'.!

Item was removed:
- ----- Method: PluggableMenuItemSpecTests>>testYesMarkerMakesItemChecked (in category 'as yet unclassified') -----
- testYesMarkerMakesItemChecked
- | itemSpec |
- itemSpec := PluggableMenuItemSpec new.
- itemSpec label: '<yes>on'.
- itemSpec analyzeLabel.
- self assert: itemSpec isCheckable description: 'item not checkable'.
- self assert: itemSpec isCheckable description: 'item not checked'.!

Item was removed:
- 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.!

Item was removed:
- ----- Method: ToolBuilderTests class>>isAbstract (in category 'testing') -----
- isAbstract
- ^self == ToolBuilderTests!

Item was removed:
- ----- Method: ToolBuilderTests>>acceptWidgetText (in category 'support') -----
- acceptWidgetText
- "accept text in widget"
- ^ self subclassResponsibility!

Item was removed:
- ----- 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)!

Item was removed:
- ----- Method: ToolBuilderTests>>buttonWidgetEnabled (in category 'support') -----
- buttonWidgetEnabled
- "Answer whether the current widget (a button) is currently enabled"
-
- ^ widget getModelState!

Item was removed:
- ----- Method: ToolBuilderTests>>changeListWidget (in category 'support') -----
- changeListWidget
- "Change the list widget's selection index"
- self subclassResponsibility!

Item was removed:
- ----- Method: ToolBuilderTests>>expectedButtonSideEffects (in category 'support') -----
- expectedButtonSideEffects
- "side effect queries we expect to see on buttons"
- ^#()!

Item was removed:
- ----- Method: ToolBuilderTests>>fireButton (in category 'tests-button') -----
- fireButton
- queries add: #fireButton.!

Item was removed:
- ----- 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!

Item was removed:
- ----- Method: ToolBuilderTests>>fireMenuAction (in category 'tests-menus') -----
- fireMenuAction
- queries add: #fireMenuAction!

Item was removed:
- ----- Method: ToolBuilderTests>>fireMenuItemWidget (in category 'tests-menus') -----
- fireMenuItemWidget
- self subclassResponsibility!

Item was removed:
- ----- Method: ToolBuilderTests>>getChildren (in category 'tests-panel') -----
- getChildren
- queries add: #getChildren.
- ^#()!

Item was removed:
- ----- Method: ToolBuilderTests>>getChildrenOf: (in category 'tests-trees') -----
- getChildrenOf: item
- queries add: #getChildrenOf.
- ^(1 to: 9) asArray!

Item was removed:
- ----- Method: ToolBuilderTests>>getColor (in category 'tests-text') -----
- getColor
- queries add: #getColor.
- ^Color tan!

Item was removed:
- ----- Method: ToolBuilderTests>>getEnabled (in category 'tests-button') -----
- getEnabled
- queries add: #getEnabled.
- ^true!

Item was removed:
- ----- Method: ToolBuilderTests>>getHelpOf: (in category 'tests-trees') -----
- getHelpOf: item
- ^'help'!

Item was removed:
- ----- Method: ToolBuilderTests>>getIconOf: (in category 'tests-trees') -----
- getIconOf: item
- queries add: #getIconOf.
- ^nil!

Item was removed:
- ----- Method: ToolBuilderTests>>getLabel (in category 'tests-button') -----
- getLabel
- queries add: #getLabel.
- ^'TestLabel'!

Item was removed:
- ----- Method: ToolBuilderTests>>getLabelOf: (in category 'tests-trees') -----
- getLabelOf: item
- queries add: #getLabelOf.
- ^item asString!

Item was removed:
- ----- Method: ToolBuilderTests>>getList (in category 'tests-lists') -----
- getList
- queries add: #getList.
- ^(1 to: 100) collect:[:i| i printString].!

Item was removed:
- ----- Method: ToolBuilderTests>>getListIndex (in category 'tests-lists') -----
- getListIndex
- queries add: #getListIndex.
- ^13!

Item was removed:
- ----- Method: ToolBuilderTests>>getListSelection (in category 'tests-lists') -----
- getListSelection
- queries add: #getListSelection.
- ^'55'!

Item was removed:
- ----- Method: ToolBuilderTests>>getMenu: (in category 'tests-lists') -----
- getMenu: aMenu
- queries add: #getMenu.
- ^aMenu!

Item was removed:
- ----- Method: ToolBuilderTests>>getRoots (in category 'tests-trees') -----
- getRoots
- queries add: #getRoots.
- ^(1 to: 9) asArray!

Item was removed:
- ----- Method: ToolBuilderTests>>getState (in category 'tests-button') -----
- getState
- queries add: #getState.
- ^true!

Item was removed:
- ----- Method: ToolBuilderTests>>getText (in category 'tests-text') -----
- getText
- queries add: #getText.
- ^Text new!

Item was removed:
- ----- Method: ToolBuilderTests>>getTextSelection (in category 'tests-text') -----
- getTextSelection
- queries add: #getTextSelection.
- ^(1 to: 0)!

Item was removed:
- ----- Method: ToolBuilderTests>>getTreeSelectionPath (in category 'tests-trees') -----
- getTreeSelectionPath
- queries add: #getTreeSelectionPath.
- ^{2. 4. 3}!

Item was removed:
- ----- Method: ToolBuilderTests>>hasChildren: (in category 'tests-trees') -----
- hasChildren: item
- queries add: #hasChildren.
- ^true!

Item was removed:
- ----- Method: ToolBuilderTests>>keyPress: (in category 'tests-lists') -----
- keyPress: key
- queries add: #keyPress.!

Item was removed:
- ----- Method: ToolBuilderTests>>makeButton (in category 'tests-button') -----
- makeButton
- | spec |
- spec := self makeButtonSpec.
- widget := builder build: spec.
- ^widget!

Item was removed:
- ----- 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!

Item was removed:
- ----- Method: ToolBuilderTests>>makeInputField (in category 'tests-input') -----
- makeInputField
- | spec |
- spec := self makeInputFieldSpec.
- widget := builder build: spec.!

Item was removed:
- ----- 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!

Item was removed:
- ----- Method: ToolBuilderTests>>makeItemList (in category 'tests-lists') -----
- makeItemList
- | spec |
- spec := self makeItemListSpec.
- widget := builder build: spec.!

Item was removed:
- ----- 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!

Item was removed:
- ----- Method: ToolBuilderTests>>makeList (in category 'tests-lists') -----
- makeList
- | spec |
- spec := self makeListSpec.
- widget := builder build: spec.!

Item was removed:
- ----- 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!

Item was removed:
- ----- Method: ToolBuilderTests>>makePanel (in category 'tests-panel') -----
- makePanel
- | spec |
- spec := self makePanelSpec.
- widget := builder build: spec.!

Item was removed:
- ----- Method: ToolBuilderTests>>makePanelSpec (in category 'tests-panel') -----
- makePanelSpec
- | spec |
- spec := builder pluggablePanelSpec new.
- spec name: #panel.
- spec model: self.
- spec children: #getChildren.
- ^spec!

Item was removed:
- ----- Method: ToolBuilderTests>>makeText (in category 'tests-text') -----
- makeText
- | spec |
- spec := self makeTextSpec.
- widget := builder build: spec.!

Item was removed:
- ----- 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!

Item was removed:
- ----- Method: ToolBuilderTests>>makeTree (in category 'tests-trees') -----
- makeTree
- | spec |
- spec := self makeTreeSpec.
- widget := builder build: spec.!

Item was removed:
- ----- 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!

Item was removed:
- ----- Method: ToolBuilderTests>>makeWindow (in category 'tests-window') -----
- makeWindow
- | spec |
- spec := self makeWindowSpec.
- widget := builder build: spec.!

Item was removed:
- ----- 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!

Item was removed:
- ----- Method: ToolBuilderTests>>noteWindowClosed (in category 'tests-window') -----
- noteWindowClosed
- queries add: #noteWindowClosed.!

Item was removed:
- ----- Method: ToolBuilderTests>>openWindow (in category 'tests-window') -----
- openWindow
- | spec |
- spec := self makeWindowSpec.
- widget := builder open: spec.!

Item was removed:
- ----- Method: ToolBuilderTests>>returnFalse (in category 'support') -----
- returnFalse
- ^false!

Item was removed:
- ----- Method: ToolBuilderTests>>returnTrue (in category 'support') -----
- returnTrue
- ^true!

Item was removed:
- ----- Method: ToolBuilderTests>>setListIndex: (in category 'tests-lists') -----
- setListIndex: index
- queries add: #setListIndex.!

Item was removed:
- ----- Method: ToolBuilderTests>>setListSelection: (in category 'tests-lists') -----
- setListSelection: newIndex
- queries add: #setListSelection.!

Item was removed:
- ----- Method: ToolBuilderTests>>setText: (in category 'tests-text') -----
- setText: newText
- queries add: #setText.
- ^false!

Item was removed:
- ----- Method: ToolBuilderTests>>setTreeSelection: (in category 'tests-trees') -----
- setTreeSelection: node
- queries add: #setTreeSelection.!

Item was removed:
- ----- Method: ToolBuilderTests>>setUp (in category 'support') -----
- setUp
- queries := IdentitySet new.!

Item was removed:
- ----- Method: ToolBuilderTests>>shutDown (in category 'support') -----
- shutDown
- self myDependents: nil!

Item was removed:
- ----- Method: ToolBuilderTests>>testAddTargetSelectorArgumentList (in category 'tests-menus') -----
- testAddTargetSelectorArgumentList
- self assertItemFiresWith:
- [:spec | spec
- add: 'Menu Item'
- target: self
- selector: #fireMenuAction
- argumentList: #()]!

Item was removed:
- ----- 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).!

Item was removed:
- ----- 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).!

Item was removed:
- ----- 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).!

Item was removed:
- ----- 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)!

Item was removed:
- ----- 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)!

Item was removed:
- ----- 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)!

Item was removed:
- ----- 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)!

Item was removed:
- ----- Method: ToolBuilderTests>>testButtonWidgetID (in category 'tests-button') -----
- testButtonWidgetID
- self makeButton.
- self assert: (builder widgetAt: #button) == widget.!

Item was removed:
- ----- 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.!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetButtonEnabled (in category 'tests-button') -----
- testGetButtonEnabled
- self makeButton.
- queries := IdentitySet new.
- self changed: #getEnabled.
- self assert: (queries includes: #getEnabled).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetButtonLabel (in category 'tests-button') -----
- testGetButtonLabel
- self makeButton.
- queries := IdentitySet new.
- self changed: #getLabel.
- self assert: (queries includes: #getLabel).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetButtonSideEffects (in category 'tests-button') -----
- testGetButtonSideEffects
- self makeButton.
- queries := IdentitySet new.
- self changed: #testSignalWithNoDiscernableEffect.
- self expectedButtonSideEffects do:[:sym|
- self assert: (queries includes: sym).
- queries remove: sym.
- ].
- self assert: queries isEmpty.!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetButtonState (in category 'tests-button') -----
- testGetButtonState
- self makeButton.
- queries := IdentitySet new.
- self changed: #getState.
- self assert: (queries includes: #getState).!

Item was removed:
- ----- 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.!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetInputFieldSelection (in category 'tests-input') -----
- testGetInputFieldSelection
- self makeInputField.
- queries := IdentitySet new.
- self changed: #getTextSelection.
- self assert: (queries includes: #getTextSelection).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetInputFieldSideEffectFree (in category 'tests-input') -----
- testGetInputFieldSideEffectFree
- self makeInputField.
- queries := IdentitySet new.
- self changed: #testSignalWithNoDiscernableEffect.
- self assert: queries isEmpty.!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetInputFieldText (in category 'tests-input') -----
- testGetInputFieldText
- self makeInputField.
- queries := IdentitySet new.
- self changed: #getText.
- self assert: (queries includes: #getText).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetItemListSideEffectFree (in category 'tests-lists') -----
- testGetItemListSideEffectFree
- self makeItemList.
- queries := IdentitySet new.
- self changed: #testSignalWithNoDiscernableEffect.
- self assert: queries isEmpty.!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetList (in category 'tests-lists') -----
- testGetList
- self makeList.
- queries := IdentitySet new.
- self changed: #getList.
- self assert: (queries includes: #getList).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetListIndex (in category 'tests-lists') -----
- testGetListIndex
- self makeList.
- queries := IdentitySet new.
- self changed: #getListIndex.
- self assert: (queries includes: #getListIndex).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetListSelection (in category 'tests-lists') -----
- testGetListSelection
- self makeItemList.
- queries := IdentitySet new.
- self changed: #getListSelection.
- self assert: (queries includes: #getListSelection).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetListSideEffectFree (in category 'tests-lists') -----
- testGetListSideEffectFree
- self makeList.
- queries := IdentitySet new.
- self changed: #testSignalWithNoDiscernableEffect.
- self assert: queries isEmpty.!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetPanelChildren (in category 'tests-panel') -----
- testGetPanelChildren
- self makePanel.
- queries := IdentitySet new.
- self changed: #getChildren.
- self assert: (queries includes: #getChildren).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetPanelSideEffectFree (in category 'tests-panel') -----
- testGetPanelSideEffectFree
- self makePanel.
- queries := IdentitySet new.
- self changed: #testSignalWithNoDiscernableEffect.
- self assert: queries isEmpty.!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetText (in category 'tests-text') -----
- testGetText
- self makeText.
- queries := IdentitySet new.
- self changed: #getText.
- self assert: (queries includes: #getText).!

Item was removed:
- ----- 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.!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetTextSelection (in category 'tests-text') -----
- testGetTextSelection
- self makeText.
- queries := IdentitySet new.
- self changed: #getTextSelection.
- self assert: (queries includes: #getTextSelection).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetTextSideEffectFree (in category 'tests-text') -----
- testGetTextSideEffectFree
- self makeText.
- queries := IdentitySet new.
- self changed: #testSignalWithNoDiscernableEffect.
- self assert: queries isEmpty.!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetWindowChildren (in category 'tests-window') -----
- testGetWindowChildren
- self makeWindow.
- queries := IdentitySet new.
- self changed: #getChildren.
- self assert: (queries includes: #getChildren).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetWindowLabel (in category 'tests-window') -----
- testGetWindowLabel
- self makeWindow.
- queries := IdentitySet new.
- self changed: #getLabel.
- self assert: (queries includes: #getLabel).!

Item was removed:
- ----- Method: ToolBuilderTests>>testGetWindowSideEffectFree (in category 'tests-window') -----
- testGetWindowSideEffectFree
- self makeWindow.
- queries := IdentitySet new.
- self changed: #testSignalWithNoDiscernableEffect.
- self assert: queries isEmpty.!

Item was removed:
- ----- Method: ToolBuilderTests>>testInputWidgetID (in category 'tests-input') -----
- testInputWidgetID
- self makeInputField.
- self assert: (builder widgetAt: #input) == widget.!

Item was removed:
- ----- Method: ToolBuilderTests>>testItemListWidgetID (in category 'tests-lists') -----
- testItemListWidgetID
- self makeItemList.
- self assert: (builder widgetAt: #list) == widget.!

Item was removed:
- ----- Method: ToolBuilderTests>>testListWidgetID (in category 'tests-lists') -----
- testListWidgetID
- self makeList.
- self assert: (builder widgetAt: #list) == widget.!

Item was removed:
- ----- Method: ToolBuilderTests>>testPanelWidgetID (in category 'tests-panel') -----
- testPanelWidgetID
- self makePanel.
- self assert: (builder widgetAt: #panel) == widget.!

Item was removed:
- ----- Method: ToolBuilderTests>>testSetInputField (in category 'tests-input') -----
- testSetInputField
- self makeInputField.
- queries := IdentitySet new.
- self acceptWidgetText.
- self assert: (queries includes: #setText).!

Item was removed:
- ----- Method: ToolBuilderTests>>testSetListIndex (in category 'tests-lists') -----
- testSetListIndex
- self makeList.
- queries := IdentitySet new.
- self changeListWidget.
- self assert: (queries includes: #setListIndex).!

Item was removed:
- ----- Method: ToolBuilderTests>>testSetListSelection (in category 'tests-lists') -----
- testSetListSelection
- self makeItemList.
- queries := IdentitySet new.
- self changeListWidget.
- self assert: (queries includes: #setListSelection).!

Item was removed:
- ----- Method: ToolBuilderTests>>testSetText (in category 'tests-text') -----
- testSetText
- self makeText.
- queries := IdentitySet new.
- self acceptWidgetText.
- self assert: (queries includes: #setText).!

Item was removed:
- ----- Method: ToolBuilderTests>>testTextWidgetID (in category 'tests-text') -----
- testTextWidgetID
- self makeText.
- self assert: (builder widgetAt: #text) == widget!

Item was removed:
- ----- 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).
- !

Item was removed:
- ----- 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).
- !

Item was removed:
- ----- 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).
- !

Item was removed:
- ----- Method: ToolBuilderTests>>testTreeRoots (in category 'tests-trees') -----
- testTreeRoots
- self makeTree.
- queries := IdentitySet new.
- self changed: #getRoots.
- self assert: (queries includes: #getRoots).!

Item was removed:
- ----- Method: ToolBuilderTests>>testTreeWidgetID (in category 'tests-trees') -----
- testTreeWidgetID
- self makeTree.
- self assert: (builder widgetAt: #tree) == widget.!

Item was removed:
- ----- Method: ToolBuilderTests>>testWindowCloseAction (in category 'tests-window') -----
- testWindowCloseAction
- self openWindow.
- builder close: widget.
- self assert: (queries includes: #noteWindowClosed).!

Item was removed:
- ----- Method: ToolBuilderTests>>testWindowID (in category 'tests-window') -----
- testWindowID
- self makeWindow.
- self assert: (builder widgetAt: #window) == widget.!

Item was removed:
- ----- Method: ToolBuilderTests>>waitTick (in category 'support') -----
- waitTick
- ^nil!

Item was removed:
- ----- 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."!

Item was changed:
  ----- Method: UIManager>>chooseClassOrTrait:from: (in category 'ui requests') -----
  chooseClassOrTrait: label from: environment
  "Let the user choose a Class or Trait."
 
  | pattern |
  pattern := self request: label.
+ ^ self classOrTraitFrom: environment pattern: pattern label: label
- ^Utilities classOrTraitFrom: environment pattern: pattern label: label
  !

Item was added:
+ ----- Method: UIManager>>classFromPattern:withCaption: (in category 'system introspecting') -----
+ classFromPattern: pattern withCaption: aCaption
+ "If there is a class or trait whose name exactly given by pattern, return it.
+ If there is only one class or trait in the system whose name matches pattern, return it.
+ Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
+ This method ignores separator characters in the pattern"
+
+ ^self classOrTraitFrom: Smalltalk environment pattern: pattern label: aCaption
+ "
+ self classFromPattern: 'CharRecog' withCaption: ''
+ self classFromPattern: 'rRecog' withCaption: ''
+ self classFromPattern: 'znak' withCaption: ''
+ self classFromPattern: 'orph' withCaption: ''
+ self classFromPattern: 'TCompil' withCaption: ''
+ "
+ !

Item was added:
+ ----- Method: UIManager>>classOrTraitFrom:pattern:label: (in category 'system introspecting') -----
+ classOrTraitFrom: environment pattern: pattern label: label
+ "If there is a class or trait whose name exactly given by pattern, return it.
+ If there is only one class or trait in the given environment whose name matches pattern, return it.
+ Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
+ This method ignores separator characters in the pattern"
+
+ | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
+ toMatch := pattern copyWithoutAll: Character separators.
+ toMatch ifEmpty: [ ^nil ].
+ "If there's a class or trait named as pattern, then return it."
+ Symbol hasInterned: pattern ifTrue: [ :symbol |
+ environment at: symbol ifPresent: [ :maybeClassOrTrait |
+ ((maybeClassOrTrait isKindOf: Class) or: [
+ maybeClassOrTrait isTrait ])
+ ifTrue: [ ^maybeClassOrTrait ] ] ].
+ "No exact match, look for potential matches."
+ toMatch := pattern asLowercase copyWithout: $..
+ potentialNames := (environment classAndTraitNames) asOrderedCollection.
+ names := pattern last = $. "This is some old hack, using String>>#match: may be better."
+ ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
+ ifFalse: [
+ potentialNames select: [ :each |
+ each includesSubstring: toMatch caseSensitive: false ] ].
+ exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
+ lines := OrderedCollection new.
+ exactMatch ifNotNil: [ lines add: 1 ].
+ "Also try some fuzzy matching."
+ reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
+ potentialNames includes: each ].
+ reducedIdentifiers ifNotEmpty: [
+ names addAll: reducedIdentifiers.
+ lines add: 1 + names size + reducedIdentifiers size ].
+ "Let the user select if there's more than one possible match. This may give surprising results."
+ selectedIndex := names size = 1
+ ifTrue: [ 1 ]
+ ifFalse: [
+ exactMatch ifNotNil: [ names addFirst: exactMatch ].
+ self chooseFrom: names lines: lines title: label ].
+ selectedIndex = 0 ifTrue: [ ^nil ].
+ ^environment at: (names at: selectedIndex) asSymbol!

Item was removed:
- ----- Method: Utilities class>>classFromPattern:withCaption: (in category '*ToolBuilder-Kernel') -----
- classFromPattern: pattern withCaption: aCaption
- "If there is a class or trait whose name exactly given by pattern, return it.
- If there is only one class or trait in the system whose name matches pattern, return it.
- Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
- This method ignores separator characters in the pattern"
-
- ^self classOrTraitFrom: Smalltalk environment pattern: pattern label: aCaption
- "
- self classFromPattern: 'CharRecog' withCaption: ''
- self classFromPattern: 'rRecog' withCaption: ''
- self classFromPattern: 'znak' withCaption: ''
- self classFromPattern: 'orph' withCaption: ''
- self classFromPattern: 'TCompil' withCaption: ''
- "
- !

Item was removed:
- ----- Method: Utilities class>>classOrTraitFrom:pattern:label: (in category '*ToolBuilder-Kernel') -----
- classOrTraitFrom: environment pattern: pattern label: label
- "If there is a class or trait whose name exactly given by pattern, return it.
- If there is only one class or trait in the given environment whose name matches pattern, return it.
- Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen.
- This method ignores separator characters in the pattern"
-
- | toMatch potentialNames names exactMatch lines reducedIdentifiers selectedIndex |
- toMatch := pattern copyWithoutAll: Character separators.
- toMatch ifEmpty: [ ^nil ].
- "If there's a class or trait named as pattern, then return it."
- Symbol hasInterned: pattern ifTrue: [ :symbol |
- environment at: symbol ifPresent: [ :maybeClassOrTrait |
- ((maybeClassOrTrait isKindOf: Class) or: [
- maybeClassOrTrait isTrait ])
- ifTrue: [ ^maybeClassOrTrait ] ] ].
- "No exact match, look for potential matches."
- toMatch := pattern asLowercase copyWithout: $..
- potentialNames := (environment classAndTraitNames) asOrderedCollection.
- names := pattern last = $. "This is some old hack, using String>>#match: may be better."
- ifTrue: [ potentialNames select: [ :each | each asLowercase = toMatch ] ]
- ifFalse: [
- potentialNames select: [ :each |
- each includesSubstring: toMatch caseSensitive: false ] ].
- exactMatch := names detect: [ :each | each asLowercase = toMatch ] ifNone: [ nil ].
- lines := OrderedCollection new.
- exactMatch ifNotNil: [ lines add: 1 ].
- "Also try some fuzzy matching."
- reducedIdentifiers := pattern suggestedTypeNames select: [ :each |
- potentialNames includes: each ].
- reducedIdentifiers ifNotEmpty: [
- names addAll: reducedIdentifiers.
- lines add: 1 + names size + reducedIdentifiers size ].
- "Let the user select if there's more than one possible match. This may give surprising results."
- selectedIndex := names size = 1
- ifTrue: [ 1 ]
- ifFalse: [
- exactMatch ifNotNil: [ names addFirst: exactMatch ].
- UIManager default chooseFrom: names lines: lines title: label ].
- selectedIndex = 0 ifTrue: [ ^nil ].
- ^environment at: (names at: selectedIndex) asSymbol!