SystemOrganization addCategory: #'OB-Fake-Tests'! SystemOrganization addCategory: #'OB-Fake-Widgets'! OBBuilderTest subclass: #OBFakeBuilderTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Tests'! !OBFakeBuilderTest methodsFor: 'support' stamp: 'cwp 7/8/2007 01:21'! builderClass ^ OBFakeBuilder! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test01BrowserCreatesWindow | widget | widget := self buildWindow. self assert: (widget isKindOf: OBFakeWindow). self assert: widget model == model! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 7/8/2007 01:22'! test02BrowserAddsPanels | widget | widget := self buildWindow. self assert: widget children size = 2. self assert: (widget children first isKindOf: OBFakeScroller). self assert: (widget children second isKindOf: OBFakeText)! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 7/8/2007 01:22'! test03ColumnPanelAddsColumns | widget | widget := self buildNavigationPanel. self assert: widget children size = 4. widget children do: [:ea | self assert: (ea isKindOf: OBFakePane)]! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 7/8/2007 01:39'! test04ColumnAddsList | pane | pane := self build: self columnWithFilter. self assert: (pane isKindOf: OBFakePane). self assert: (pane children first isKindOf: OBFakeList)! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 7/9/2007 23:26'! test05ColumnAddsButton | pane | pane := self build: self columnWithFilter. self assert: (pane isKindOf: OBFakePane). self assert: (pane children second isKindOf: OBFakeRadioButtonBar)! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test07ButtonModelCanBeBuiltAlone | widget | widget := self build: self button. self assert: (widget isKindOf: OBFakeButton)! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test09HasLabel | widget | widget := self buildWindow. self assert: widget label = 'OmniBrowser'! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 7/9/2007 23:26'! tests08SwitchCanBeBuiltAlone | widget | widget := self build: self switch. self assert: (widget isKindOf: OBFakeRadioButtonBar)! ! OBBuilder subclass: #OBFakeBuilder instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeBuilder methodsFor: 'accessing' stamp: 'lr 11/7/2009 18:32'! addChild: anObject current := anObject! ! !OBFakeBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:55'! button: aModel with: aBlock ^self current: (OBFakeButton model: aModel) do: aBlock! ! !OBFakeBuilder methodsFor: 'accessing' stamp: 'cwp 7/8/2007 00:55'! current: aWidget do: aBlock current addChild: aWidget. ^ super current: aWidget do: aBlock! ! !OBFakeBuilder methodsFor: 'building' stamp: 'dr 3/6/2008 15:27'! enrichedTextarea: aPanel with: aBlock ^self current: (OBFakeText model: aPanel) do: aBlock! ! !OBFakeBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:52'! fixedButtonBar: aPanel with: aBlock ! ! !OBFakeBuilder methodsFor: 'initialize-release' stamp: 'lr 11/7/2009 18:32'! initialize current := self! ! !OBFakeBuilder methodsFor: 'building' stamp: 'cwp 6/2/2009 01:05'! pane: aColumn with: aBlock ^self current: (OBFakePane model: aColumn) do: [self current: (OBFakeList model: aColumn) do: []. aBlock value]! ! !OBFakeBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:53'! radioButtonBar: aSwitch with: aBlock ^self current: (OBFakeRadioButtonBar model: aSwitch) do: aBlock! ! !OBFakeBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:46'! scroller: aPanel with: aBlock ^self current: (OBFakeScroller model: aPanel) do: aBlock! ! !OBFakeBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:48'! textarea: aPanel with: aBlock ^self current: (OBFakeText model: aPanel) do: aBlock! ! !OBFakeBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:57'! textfield: aPanel with: aBlock ^self current: (OBFakeText model: aPanel) do: aBlock! ! !OBFakeBuilder methodsFor: 'building' stamp: 'cwp 6/2/2009 01:05'! topNavigationPanel: aPanel with: aBlock ^ aBlock value! ! !OBFakeBuilder methodsFor: 'building' stamp: 'lr 1/7/2008 11:20'! verticalGroupWith: aBlock ^aBlock value! ! !OBFakeBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 20:50'! window: aBrowser with: aBlock ^self current: (OBFakeWindow model: aBrowser label: aBrowser defaultLabel) do: aBlock! ! Object subclass: #OBFakeMenu instanceVariableNames: 'target items' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeMenu methodsFor: 'emulating' stamp: 'cwp 7/8/2007 02:19'! add: aString target: anObject selector: aSymbol enabled: aBoolean icon: icon items add: (OBFakeMenuItem label: aString target: anObject selector: aSymbol enabled: aBoolean icon: icon)! ! !OBFakeMenu methodsFor: 'emulating' stamp: 'cwp 7/8/2007 02:21'! addLine ! ! !OBFakeMenu methodsFor: 'emulating' stamp: 'cwp 10/8/2007 01:55'! addSubmenu: aString enabled: aBoolean | submenu | submenu := self class new. items add: (OBFakeMenuItem label: aString enabled: aBoolean submenu: submenu). ^submenu! ! !OBFakeMenu methodsFor: 'emulating' stamp: 'lr 11/7/2009 18:32'! defaultTarget: anObject target := anObject! ! !OBFakeMenu methodsFor: 'initialize-release' stamp: 'lr 11/7/2009 18:32'! initialize items := OrderedCollection new! ! !OBFakeMenu methodsFor: 'emulating' stamp: 'cwp 7/8/2007 02:19'! itemWithWording: aString ^ items detect: [:ea | ea label = aString] ifNone: [nil]! ! !OBFakeMenu methodsFor: 'accessing' stamp: 'cwp 7/8/2007 02:07'! items ^ items! ! Object subclass: #OBFakeMenuItem instanceVariableNames: 'enabled icon label selector target submenu' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeMenuItem class methodsFor: 'instance creation' stamp: 'cwp 10/8/2007 01:56'! label: aString enabled: aBoolean submenu: aMenu ^(self new) label: aString; isEnabled: aBoolean; submenu: aMenu; yourself! ! !OBFakeMenuItem class methodsFor: 'instance creation' stamp: 'cwp 7/8/2007 02:19'! label: aString target: anObject selector: aSymbol enabled: aBoolean icon: icon ^ self new label: aString; target: anObject; selector: aSymbol; isEnabled: aBoolean; icon: icon; yourself! ! !OBFakeMenuItem methodsFor: 'simulating' stamp: 'cwp 7/8/2007 21:27'! click (enabled and: [selector notNil]) ifTrue: [target perform: selector]! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 7/8/2007 21:18'! icon ^icon! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 7/8/2007 21:18'! icon: anObject icon := anObject! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 7/8/2007 21:18'! isEnabled ^ enabled! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'lr 11/7/2009 18:32'! isEnabled: aBoolean enabled := aBoolean! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 7/8/2007 21:18'! label ^label! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 7/8/2007 21:18'! label: anObject label := anObject! ! !OBFakeMenuItem methodsFor: 'printing' stamp: 'cwp 7/8/2007 20:52'! printOn: aStream aStream nextPutAll: 'Item'; nextPut: $<; print: label; nextPut: $>.! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 7/8/2007 21:18'! selector ^selector! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 7/8/2007 21:18'! selector: anObject selector := anObject! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 9/30/2007 17:49'! submenu ^submenu! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 9/30/2007 17:49'! submenu: anObject submenu := anObject! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 7/8/2007 21:18'! target ^ target! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'lr 11/7/2009 18:32'! target: anObject target := anObject! ! Object subclass: #OBFakeWidget instanceVariableNames: 'model children' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! OBFakeWidget subclass: #OBFakeButton instanceVariableNames: 'label bar isOn' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeButton class methodsFor: 'as yet unclassified' stamp: 'cwp 7/9/2007 23:47'! label: aString bar: aButtonBar ^ self new setLabel: aString bar: aButtonBar! ! !OBFakeButton methodsFor: 'simulating' stamp: 'cwp 7/9/2007 23:50'! click bar select: self! ! !OBFakeButton methodsFor: 'selection' stamp: 'lr 11/7/2009 18:32'! deselect isOn := false! ! !OBFakeButton methodsFor: 'examining' stamp: 'cwp 7/10/2007 00:30'! isOn ^ isOn! ! !OBFakeButton methodsFor: 'examining' stamp: 'cwp 7/9/2007 23:48'! label ^ label! ! !OBFakeButton methodsFor: 'printing' stamp: 'cwp 7/9/2007 23:55'! printDebugIdOn: aStream aStream print: label! ! !OBFakeButton methodsFor: 'selection' stamp: 'lr 11/7/2009 18:32'! select isOn := true! ! !OBFakeButton methodsFor: 'initalize-release' stamp: 'lr 11/7/2009 18:32'! setLabel: aString bar: aButtonBar label := aString. bar := aButtonBar! ! OBFakeWidget subclass: #OBFakeList instanceVariableNames: 'list selectionIndex' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeList methodsFor: 'simulating' stamp: 'cwp 7/10/2007 00:17'! basicUpdate self updateList. self updateSelectionIndex! ! !OBFakeList methodsFor: 'examining' stamp: 'cwp 7/13/2007 21:21'! canDrop: aNode on: aString ^ model canDrop: aNode on: (model nodeForItem: aString) ! ! !OBFakeList methodsFor: 'simulating' stamp: 'cwp 7/8/2007 01:51'! changeModelSelection: anInteger model selection: anInteger! ! !OBFakeList methodsFor: 'simulating' stamp: 'dr 3/6/2008 15:25'! doubleClickSelector: aSymbol! ! !OBFakeList methodsFor: 'examining' stamp: 'cwp 7/13/2007 22:44'! drop: aNode on: aString ^ model drop: aNode on: (model nodeForItem: aString) ! ! !OBFakeList methodsFor: 'examining' stamp: 'cwp 7/8/2007 01:41'! getListDelicately ^ list ifNil: [Array new]! ! !OBFakeList methodsFor: 'examining' stamp: 'lr 11/7/2009 18:32'! getListObtrusively ^ list := model list! ! !OBFakeList methodsFor: 'examining' stamp: 'lr 11/7/2009 18:32'! getMenu: shiftKeyState | menu | menu := OBFakeMenu new defaultTarget: model. model menu: menu. ^ menu! ! !OBFakeList methodsFor: 'examining' stamp: 'cwp 7/8/2007 02:00'! selection selectionIndex = 0 ifTrue: [^ nil]. list ifNotNil: [^ list at: selectionIndex]. ^ model listAt: selectionIndex! ! !OBFakeList methodsFor: 'emulating' stamp: 'cwp 7/10/2007 00:17'! update: aSelector aSelector = #list ifTrue: [^ self updateList]. aSelector = #selection ifTrue: [^ self updateSelectionIndex]! ! !OBFakeList methodsFor: 'private' stamp: 'lr 11/7/2009 18:32'! updateList list := model list. selectionIndex := model selection! ! !OBFakeList methodsFor: 'private' stamp: 'lr 11/7/2009 18:32'! updateSelectionIndex selectionIndex := model selection! ! OBFakeWidget subclass: #OBFakePane instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakePane methodsFor: 'as yet unclassified' stamp: 'cwp 7/10/2007 00:07'! addSwitch children add: (OBFakeBuilder build: model switch)! ! !OBFakePane methodsFor: 'as yet unclassified' stamp: 'cwp 7/10/2007 00:06'! hasSwitch ^ children size > 1! ! !OBFakePane methodsFor: 'as yet unclassified' stamp: 'dr 3/6/2008 15:25'! list ^children first! ! !OBFakePane methodsFor: 'as yet unclassified' stamp: 'cwp 7/10/2007 00:09'! removeSwitch children removeLast! ! !OBFakePane methodsFor: 'as yet unclassified' stamp: 'cwp 7/10/2007 00:03'! update: aSymbol aSymbol = #switch ifTrue: [self updateSwitch]! ! !OBFakePane methodsFor: 'as yet unclassified' stamp: 'cwp 7/10/2007 00:06'! updateSwitch self hasSwitch ifTrue: [model wantsButton ifFalse: [self removeSwitch]] ifFalse: [model wantsButton ifTrue: [self addSwitch]]! ! OBFakeWidget subclass: #OBFakeRadioButtonBar instanceVariableNames: 'buttons selection' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeRadioButtonBar methodsFor: 'as yet unclassified' stamp: 'cwp 7/9/2007 23:28'! basicUpdate self updateList. self updateSelection.! ! !OBFakeRadioButtonBar methodsFor: 'as yet unclassified' stamp: 'cwp 7/9/2007 23:51'! buttonAt: index do: aBlock aBlock value: (children at: index ifAbsent: [^ self])! ! !OBFakeRadioButtonBar methodsFor: 'as yet unclassified' stamp: 'cwp 7/10/2007 00:00'! select: aButton model selection: (children indexOf: aButton)! ! !OBFakeRadioButtonBar methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'! selectIndex: index self buttonAt: selection do: [ :button | button deselect ]. selection := index. self buttonAt: selection do: [ :button | button select ]! ! !OBFakeRadioButtonBar methodsFor: 'as yet unclassified' stamp: 'cwp 7/9/2007 23:28'! update: aSymbol aSymbol == #list ifTrue: [self updateList]. aSymbol == #selection ifTrue: [self updateSelection].! ! !OBFakeRadioButtonBar methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'! updateList children := model list collect: [ :ea | OBFakeButton label: ea bar: self ]. selection := model selection! ! !OBFakeRadioButtonBar methodsFor: 'as yet unclassified' stamp: 'cwp 7/9/2007 23:57'! updateSelection self selectIndex: model selection! ! OBFakeWidget subclass: #OBFakeScroller instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeScroller methodsFor: 'as yet unclassified' stamp: 'cwp 7/10/2007 00:21'! update: aSymbol aSymbol = #sizing ifTrue: [^ self updateSizing]. aSymbol = #columns ifTrue: [^ self updatePanes].! ! !OBFakeScroller methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'! updatePanes | builder | builder := OBFakeBuilder new. children := model columns collect: [ :ea | ea buildOn: builder ]! ! OBFakeWidget subclass: #OBFakeText instanceVariableNames: 'text selection hasUnacceptedEdits hasEditingConflicts' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeText methodsFor: 'simulating' stamp: 'lr 11/7/2009 18:32'! accept model accept: text notifying: self. hasUnacceptedEdits := false. hasEditingConflicts := false! ! !OBFakeText methodsFor: 'emulating' stamp: 'lr 11/7/2009 18:32'! basicUpdate text := model text. self getSelection. hasUnacceptedEdits := false. hasEditingConflicts := false! ! !OBFakeText methodsFor: 'emulating' stamp: 'cwp 7/8/2007 22:50'! canDiscardEdits ^ hasUnacceptedEdits not! ! !OBFakeText methodsFor: 'simulating' stamp: 'lr 11/7/2009 18:32'! getSelection ^ selection := model selection! ! !OBFakeText methodsFor: 'examining' stamp: 'cwp 7/9/2007 00:54'! hasEditingConflicts ^ hasEditingConflicts! ! !OBFakeText methodsFor: 'emulating' stamp: 'cwp 7/9/2007 00:41'! selectionInterval ^ selection! ! !OBFakeText methodsFor: 'examining' stamp: 'cwp 7/8/2007 01:47'! text ^ text! ! !OBFakeText methodsFor: 'simulating' stamp: 'lr 11/7/2009 18:32'! text: aString text := aString. hasUnacceptedEdits := true! ! !OBFakeText methodsFor: 'examining' stamp: 'lr 11/7/2009 18:32'! update: aSymbol aSymbol = #text ifTrue: [ self basicUpdate ]. aSymbol = #selection ifTrue: [ self getSelection ]. aSymbol = #codeChangedElsewhere ifTrue: [ hasEditingConflicts := true ]! ! !OBFakeWidget class methodsFor: 'as yet unclassified' stamp: 'cwp 7/7/2007 23:54'! model: anObject ^ self new model: anObject! ! !OBFakeWidget methodsFor: 'accessing' stamp: 'cwp 7/8/2007 00:50'! addChild: aWidget children add: aWidget! ! !OBFakeWidget methodsFor: 'simulating' stamp: 'cwp 7/8/2007 01:46'! basicUpdate! ! !OBFakeWidget methodsFor: 'accessing' stamp: 'cwp 7/8/2007 00:51'! children ^ children! ! !OBFakeWidget methodsFor: 'accessing' stamp: 'cwp 7/9/2007 23:16'! findDeeplyA: aClass self withAllChildrenDo: [:ea | (ea isMemberOf: aClass) ifTrue: [^ ea]]. ^ nil! ! !OBFakeWidget methodsFor: 'initialize-release' stamp: 'lr 11/7/2009 18:32'! initialize children := OrderedCollection new! ! !OBFakeWidget methodsFor: 'accessing' stamp: 'cwp 7/7/2007 23:57'! model ^ model! ! !OBFakeWidget methodsFor: 'accessing' stamp: 'lr 11/7/2009 18:32'! model: aModel model ifNotNil: [ model removeDependent: self ]. model := aModel. model addDependent: self! ! !OBFakeWidget methodsFor: 'printing' stamp: 'cwp 7/10/2007 00:11'! printDebugIdOn: aStream aStream print: self identityHash! ! !OBFakeWidget methodsFor: 'printing' stamp: 'cwp 7/9/2007 23:54'! printOn: aStream aStream nextPutAll: (self class name allButFirst: 2); nextPut: $<. self printDebugIdOn: aStream. aStream nextPut: $>.! ! !OBFakeWidget methodsFor: 'simulating' stamp: 'cb 8/7/2007 12:28'! setBalloonText: stringOrText self setBalloonText: stringOrText maxLineLength: 20. ! ! !OBFakeWidget methodsFor: 'simulating' stamp: 'cb 8/7/2007 12:27'! setBalloonText: stringOrText maxLineLength: aLength "as a Fake widget is a morph, it should accep a balloon message"! ! !OBFakeWidget methodsFor: 'simulating' stamp: 'cwp 7/8/2007 01:46'! update self basicUpdate. children do: [:ea | ea update] ! ! !OBFakeWidget methodsFor: 'accessing' stamp: 'cwp 7/8/2007 01:38'! withAllChildrenDo: aBlock aBlock value: self. children do: [:ea | ea withAllChildrenDo: aBlock]! ! OBFakeWidget subclass: #OBFakeWindow instanceVariableNames: 'label' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeWindow class methodsFor: 'as yet unclassified' stamp: 'cwp 7/8/2007 23:22'! model: anObject label: aString ^ (super model: anObject) label: aString! ! !OBFakeWindow methodsFor: 'simulating' stamp: 'lr 11/7/2009 18:32'! close model okToChange ifTrue: [ ^ self ]. model windowIsClosing; release. model := nil! ! !OBFakeWindow methodsFor: 'examining' stamp: 'cwp 7/8/2007 22:59'! label ^ label! ! !OBFakeWindow methodsFor: 'accessing' stamp: 'lr 11/7/2009 18:32'! label: aString label := aString! ! !OBFakeWindow methodsFor: 'printing' stamp: 'cwp 7/9/2007 23:57'! printDebugIdOn: aStream aStream print: label! ! !OBFakeWindow methodsFor: 'emulating' stamp: 'lr 11/7/2009 18:32'! update: aSymbol aSymbol = #relabel ifTrue: [ model ifNotNil: [ label := model labelString ] ]! ! TestCase subclass: #OBFakeMenuTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Tests'! !OBFakeMenuTest methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'! testAddItem | menu | menu := OBFakeMenu new. menu add: 'test item' target: self selector: #clickTestItem enabled: true icon: #blank. self deny: (menu itemWithWording: 'test item') isNil! ! !OBFakeMenuTest methodsFor: 'as yet unclassified' stamp: 'lr 11/7/2009 18:32'! testAddSubmenu | menu submenu | menu := OBFakeMenu new. submenu := menu addSubmenu: 'test item' enabled: true. self assert: menu class == submenu class! !