Squeak-dev December 2013

squeak-dev@lists.squeakfoundation.org

45 participants
325 discussions

The Trunk: Morphic-fbs.702.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

Frank Shearar uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-fbs.702.mcz ==================== Summary ==================== Name: Morphic-fbs.702 Author: fbs Time: 7 December 2013, 7:48:47.11 pm UUID: 8e43ff45-8dd5-eb4b-a5d2-164bf53afe71 Ancestors: Morphic-fbs.701 Update to the new find-a-class-or-trait-from-a-pattern API. =============== Diff against Morphic-fbs.701 =============== Item was changed: ----- Method: SearchBarMorph>>smartSearch: (in category 'search') ----- smartSearch: evt "Take the user input and perform an appropriate search" | input newContents | input := self contents asString ifEmpty:[^self]. (Smalltalk bindingOf: input) ifNotNil:[:assoc| | global | "It's a global or a class" global := assoc value. ^ToolSet browse: (global isBehavior ifTrue:[global] ifFalse:[global class]) selector: nil. ]. (SystemNavigation new allImplementorsOf: input asSymbol) ifNotEmpty:[:list| ^SystemNavigation new browseMessageList: list name: 'Implementors of ' , input ]. input first isUppercase ifTrue:[ + (UIManager default classFromPattern: input withCaption: '') ifNotNil:[:aClass| - (Utilities classFromPattern: input withCaption: '') ifNotNil:[:aClass| ^ToolSet browse: aClass selector: nil. ]. ] ifFalse:[ ^ToolSet default browseMessageNames: input ]. newContents := input, ' -- not found.'. self newContents: newContents; selectFrom: input size+1 to: newContents size. evt hand newKeyboardFocus: self! Item was changed: ----- Method: TextEditor>>browseClassFromIt (in category 'menu messages') ----- browseClassFromIt "Launch a hierarchy browser for the class indicated by the current selection. If multiple classes matching the selection exist, let the user choose among them." | aClass | self lineSelectAndEmptyCheck: [ ^ self ]. + aClass := UIManager default - aClass := Utilities classFromPattern: self selection string withBlanksTrimmed withCaption: 'choose a class to browse...'. aClass ifNil: [ ^ morph flash ]. SystemNavigation default spawnHierarchyForClass: aClass selector: nil!

1 0

The Trunk: TraitsTests-fbs.13.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

Frank Shearar uploaded a new version of TraitsTests to project The Trunk: http://source.squeak.org/trunk/TraitsTests-fbs.13.mcz ==================== Summary ==================== Name: TraitsTests-fbs.13 Author: fbs Time: 7 December 2013, 7:47:51.02 pm UUID: 0429146f-6767-4a4f-8fce-37571625920a Ancestors: TraitsTests-fbs.12 Update to the new find-a-class-or-trait-from-a-pattern API. =============== Diff against TraitsTests-fbs.12 =============== Item was changed: ----- Method: TraitTest>>testTraitFromPattern (in category 'testing') ----- testTraitFromPattern | newTrait | newTrait := self createTraitNamed: #TTraitTestBaseTrait uses: {}. + self assert: (UIManager default classFromPattern: 'TTraitTestBaseT' withCaption: '') = newTrait.! - self assert: (Utilities classFromPattern: 'TTraitTestBaseT' withCaption: '') = newTrait.!

1 0

The Trunk: 45Deprecated-fbs.21.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

Frank Shearar uploaded a new version of 45Deprecated to project The Trunk: http://source.squeak.org/trunk/45Deprecated-fbs.21.mcz ==================== Summary ==================== Name: 45Deprecated-fbs.21 Author: fbs Time: 7 December 2013, 7:49:28.068 pm UUID: cef61221-6ede-1c40-af8d-e66377832eb2 Ancestors: 45Deprecated-fbs.20 Deprecate the old find-a-class-or-trait-from-a-pattern API. =============== Diff against 45Deprecated-fbs.20 =============== Item was added: + ----- Method: Utilities class>>classFromPattern:withCaption: (in category '*45Deprecated') ----- + classFromPattern: pattern withCaption: aCaption + self deprecated: 'Use UIManager >> #classFromPattern:withCaption:'. + ^ UIManager default classFromPattern: pattern withCaption: aCaption.! Item was added: + ----- Method: Utilities class>>classOrTraitFrom:pattern:label: (in category '*45Deprecated') ----- + classOrTraitFrom: environment pattern: pattern label: label + self deprecated: 'Use UIManager >> #classOrTraitFrom:pattern:label:'. + ^ UIManager default classOrTraitFrom: environment pattern: pattern label: label.!

1 0

The Trunk: ToolBuilder-Kernel-fbs.59.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

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!

1 0

The Trunk: ToolBuilderTests-fbs.1.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

Frank Shearar uploaded a new version of ToolBuilderTests to project The Trunk: http://source.squeak.org/trunk/ToolBuilderTests-fbs.1.mcz ==================== Summary ==================== Name: ToolBuilderTests-fbs.1 Author: fbs Time: 7 December 2013, 7:47:14.931 pm UUID: f75a55b6-ea0a-4b43-bf08-dfcf82dc99fb Ancestors: ToolBuilder SUnit tests. ==================== Snapshot ==================== SystemOrganization addCategory: #ToolBuilderTests! TestCase subclass: #PluggableMenuItemSpecTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilderTests'! ----- Method: PluggableMenuItemSpecTests>>testBeCheckableMakesItemCheckable (in category 'as yet unclassified') ----- testBeCheckableMakesItemCheckable | itemSpec | itemSpec := PluggableMenuItemSpec new. itemSpec beCheckable. self assert: itemSpec isCheckable description: 'Item not checkable'.! ----- Method: PluggableMenuItemSpecTests>>testByDefaultNotCheckable (in category 'as yet unclassified') ----- testByDefaultNotCheckable | itemSpec | itemSpec := PluggableMenuItemSpec new. self deny: itemSpec isCheckable.! ----- 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'.! ----- 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'.! ----- 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'.! ----- 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'.! TestCase subclass: #ToolBuilderTests instanceVariableNames: 'builder widget queries' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilderTests'! !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>>expectedButtonSideEffects (in category 'support') ----- expectedButtonSideEffects "side effect queries we expect to see on buttons" ^#()! ----- 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>>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.! ----- 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."!

1 0

The Trunk: MorphicExtras-nice.130.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

Nicolas Cellier uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-nice.130.mcz ==================== Summary ==================== Name: MorphicExtras-nice.130 Author: nice Time: 7 December 2013, 3:18:35 pm UUID: f1cfb1fa-c101-4329-b528-963fb90eef45 Ancestors: MorphicExtras-fbs.129 Some initialization performed once in last century is depending on UpdateStream. =============== Diff against MorphicExtras-fbs.129 =============== Item was changed: ----- Method: PaintBoxMorph>>loadColorChooser (in category 'initialization') ----- loadColorChooser "Load Forms for ColorMemoryMorph." | doc closedForm openForm | + doc := UpdateStreamDownloader default objectStrmFromUpdates: 'colorPalClosed.obj'. - doc := Utilities objectStrmFromUpdates: 'colorPalClosed.obj'. closedForm := doc fileInObjectAndCode mapColor: Color transparent to: Color black. + doc := UpdateStreamDownloader default objectStrmFromUpdates: 'colorPalOpen.obj'. - doc := Utilities objectStrmFromUpdates: 'colorPalOpen.obj'. openForm := doc fileInObjectAndCode mapColor: Color transparent to: Color black. colorMemoryThin image: closedForm. colorMemoryThin position: self position + (0@140). colorMemory delete. "delete old one" colorMemory := PaintBoxColorPicker new image: openForm. !

1 0

The Trunk: 45Deprecated-fbs.20.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

Frank Shearar uploaded a new version of 45Deprecated to project The Trunk: http://source.squeak.org/trunk/45Deprecated-fbs.20.mcz ==================== Summary ==================== Name: 45Deprecated-fbs.20 Author: fbs Time: 7 December 2013, 11:15:27.303 am UUID: 9d031163-3281-cc45-9b5e-77f292ad6521 Ancestors: 45Deprecated-nice.19 Deprecate the SocketStream >> #finger: example. =============== Diff against 45Deprecated-nice.19 =============== Item was added: + ----- Method: SocketStream class>>finger: (in category '*45Deprecated-example') ----- + finger: userName + self error: 'Use SocketStream >> #finger:at:'.!

1 0

The Trunk: Network-fbs.148.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

Frank Shearar uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-fbs.148.mcz ==================== Summary ==================== Name: Network-fbs.148 Author: fbs Time: 7 December 2013, 11:12:27.888 am UUID: bb90dde5-60a7-cd44-84b3-29594cac71ee Ancestors: Network-fbs.147 Finally, formally deprecate the example. =============== Diff against Network-fbs.147 =============== Item was removed: - ----- Method: SocketStream class>>finger: (in category 'example') ----- - finger: userName - self error: 'Use SocketStream >> #finger:at:'.!

1 0

The Trunk: Network-fbs.147.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

Frank Shearar uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-fbs.147.mcz ==================== Summary ==================== Name: Network-fbs.147 Author: fbs Time: 7 December 2013, 11:11:12.759 am UUID: 63ed267a-8225-3049-980c-47cf93c60881 Ancestors: Network-fbs.146 Actually, (a) point any possible user of the old example to the new example, and (b) update the comment in the new example. =============== Diff against Network-fbs.146 =============== Item was added: + ----- Method: SocketStream class>>finger: (in category 'example') ----- + finger: userName + self error: 'Use SocketStream >> #finger:at:'.! Item was changed: ----- Method: SocketStream class>>finger:at: (in category 'example') ----- finger: userName at: aHostnameOrAddressString + "SocketStream finger: 'stp' at: 'example.com'" - "SocketStream finger: 'stp'" | s | s := SocketStream openConnectionToHost: aHostnameOrAddressString port: 79. "finger port number" Transcript show: '---------- Connecting ----------'; cr. s sendCommand: userName. Transcript show: s getLine. s close. Transcript show: '---------- Connection Closed ----------'; cr; endEntry. !

1 0

The Trunk: Network-fbs.146.mcz
by commits＠source.squeak.org 07 Dec '13

07 Dec '13

Frank Shearar uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-fbs.146.mcz ==================== Summary ==================== Name: Network-fbs.146 Author: fbs Time: 7 December 2013, 11:08:28.045 am UUID: c7c2b09f-06f1-ef46-8371-a171d2c426a1 Ancestors: Network-nice.145 While #finger: is a nice example of how to use SocketStream, it causes a dependency on ToolBuilder. #finger:at: removes this dependency by requiring the user to explicitly provide an address (rather than #finger:'s prompting of the user). This lets us keep a nice example that does _not_ require user input. There are no senders of #finger: in the base image. =============== Diff against Network-nice.145 =============== Item was removed: - ----- Method: SocketStream class>>finger: (in category 'example') ----- - finger: userName - "SocketStream finger: 'stp'" - - | addr s | - addr := NetNameResolver promptUserForHostAddress. - s := SocketStream openConnectionToHost: addr port: 79. "finger port number" - Transcript show: '---------- Connecting ----------'; cr. - s sendCommand: userName. - Transcript show: s getLine. - s close. - Transcript show: '---------- Connection Closed ----------'; cr; endEntry. - ! Item was added: + ----- Method: SocketStream class>>finger:at: (in category 'example') ----- + finger: userName at: aHostnameOrAddressString + "SocketStream finger: 'stp'" + + | s | + s := SocketStream openConnectionToHost: aHostnameOrAddressString port: 79. "finger port number" + Transcript show: '---------- Connecting ----------'; cr. + s sendCommand: userName. + Transcript show: s getLine. + s close. + Transcript show: '---------- Connection Closed ----------'; cr; endEntry. + !

1 0

← Newer
1
...
25
26
27
28
29
30
31
32
33
Older →

Jump to page: