[squeak-dev] The Trunk: ToolBuilder-Kernel-fbs.59.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Dec 7 19:50:16 UTC 2013


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!



More information about the Squeak-dev mailing list