SystemOrganization addCategory: #'OB-Fake-Tests'! SystemOrganization addCategory: #'OB-Fake-Browser'! SystemOrganization addCategory: #'OB-Fake-Interface'! SystemOrganization addCategory: #'OB-Fake-Widgets'! TestCase subclass: #OBFakeInteractionTest instanceVariableNames: 'interface' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Tests'! OBFakeInteractionTest subclass: #OBBrowserTest instanceVariableNames: 'model widget' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Tests'! !OBBrowserTest class methodsFor: 'testing' stamp: 'cwp 11/2/2006 00:13'! isAbstract ^ self name = #OBBrowserTest! ! !OBBrowserTest class methodsFor: 'accessing' stamp: 'lr 3/14/2010 09:09'! packageNamesUnderTest ^ #('OmniBrowser')! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 12/9/2011 13:55'! assertAListIncludes: anArrayOfStrings self listWidgets detect: [:m | | list | list := m getListDelicately collect: [:ea | ea asString withBlanksTrimmed]. list includesAllOf: anArrayOfStrings] ifNone: [self assert: false].! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 12/9/2011 13:55'! assertAListMatches: strings | list | self listWidgets detect: [:m | list := m getListDelicately. (list size = strings size) and: [list includesAllOf: strings]] ifNone: [self assert: false].! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 12/9/2011 15:55'! assertButtonSelected: aString | button | button := (self widgetsOfClass: OBFakeButton) detect: [:m | m label contents = aString] ifNone: [self signalFailure: 'No button labeled ', aString]. self assert: button isPressed! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertCurrentItemIs: expected | actual | actual := self currentItem withBlanksTrimmed. self assert: actual = expected! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertListAt: index contains: items | list | list := self listItemsAt: index. self assert: (list size = items size). self assert: (list includesAllOf: items).! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertListAt: index includes: items | list | list := (self listItemsAt: index) collect: [:ea | ea asString withBlanksTrimmed]. self assert: (list includesAllOf: items).! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertMenuContains: aString | item | item := self menuItemNamed: aString. self assert: item notNil! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 12/8/2011 23:15'! assertNoButtonsVisible | button | button := (widget findDeeplyA: OBFakePanel) findDeeplyA: OBFakeButton. self assert: button isNil.! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 12/9/2011 14:56'! assertSelectedTextIs: aString | text selection textWidget | textWidget := self textWidget. text := textWidget text. selection := textWidget selectionInterval. self assert: (text atAll: selection) asString = aString! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 12/9/2011 14:56'! assertTextIs: aString | actual | actual := self textWidget text. self assert: actual = aString.! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 12/9/2011 15:57'! assertTextIsSelected self assert: self textWidget selectionInterval last = self textWidget text size! ! !OBBrowserTest methodsFor: 'configuration' stamp: 'cwp 8/22/2007 23:14'! browserClass self subclassResponsibility! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'lr 9/24/2010 08:29'! browserInstance ^ self browserClass metaNode: self metagraph node: self node! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 12/9/2011 13:56'! clickButtonLabeled: aString | button | button := (self widgetsOfClass: OBFakeButton) detect: [:m | m label contents = aString] ifNone: [self signalFailure: 'No button labeled ', aString]. button click! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 9/14/2005 22:22'! currentItem ^ self currentList selection asString! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 12/9/2011 13:55'! currentList ^ self listWidgets reversed detect: [:list | list selection notNil] ifNone: [self signalFailure: 'No item is currently selected']! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 12/9/2011 13:55'! denyAListIncludes: anArrayOfStrings self listWidgets detect: [:m | m getListDelicately includesAllOf: anArrayOfStrings] ifNone: [^ self]. self assert: false.! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 12/9/2011 16:09'! deselect: aString | listWidget | listWidget := self findListContaining: aString. self assert: listWidget selection withBlanksTrimmed = aString. listWidget clickOn: aString! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! drag: nodeName | item list | item := StringMorph contents: nodeName asString. list := self findListContaining: nodeName. ^ list model dragPassengerFor: item inMorph: list! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! drag: passangerName to: targetName | passanger | passanger := self drag: passangerName. self drop: passanger on: targetName! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! drop: aPassenger on: targetName | list | list := self findListContaining: targetName. self assert: list notNil. self assert: (list canDrop: aPassenger on: targetName). list drop: aPassenger on: targetName.! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 12/9/2011 14:56'! editText: aString self textWidget text: aString! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 12/9/2011 13:55'! findListContaining: aString ^ self listWidgets detect: [:m | | list | list := m getListDelicately collect: [:ea | ea asString withBlanksTrimmed]. list includes: aString] ifNone: [nil]! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 12/9/2011 14:12'! forceLayout widget draw! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 12/9/2011 13:55'! listItemsAt: index ^ (self listWidgets at: index ifAbsent: [self signalFailure: 'List ', index asString, ' does not exist']) getListDelicately ! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 12/9/2011 13:56'! listWidgets ^ self widgetsOfClass: OBFakeList! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 12/9/2011 13:55'! menuItemNamed: aString | lists current | lists := self listWidgets. current := lists reversed detect: [:list | list selection notNil]. ^ (current getMenu: true) itemWithWording: aString. ! ! !OBBrowserTest methodsFor: 'running' stamp: 'avi 9/17/2005 01:39'! metagraph ^ self browserClass defaultMetaNode! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! mouseMoveEventIn: name | rect plm | plm := self findListContaining: name. rect := plm listMorph rectForRow: (plm getListDelicately indexOf: name). ^ MouseMoveEvent new setType: #mouseEnter startPoint: rect center + (rect width @ 0) endPoint: rect center trail: #() buttons: 4 hand: ActiveHand stamp: Time millisecondClockValue! ! !OBBrowserTest methodsFor: 'running' stamp: 'cwp 12/9/2011 13:47'! node ^ self browserClass defaultRootNode! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 12/9/2011 15:13'! select: aString "We don't use #getListDelicately because the user would have to scroll through the list to find the item we're selecting, thus triggering updates to the list." | listWidget | listWidget := self findListContaining: aString. self assert: listWidget notNil. listWidget clickOn: aString.! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! selectMenuItem: aString | item | item := self menuItemNamed: aString. item ifNil: [self signalFailure: 'Menu item ''', aString, ''' does not exist.']. item click! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 12/9/2011 16:06'! selectSequence: aCollection aCollection withIndexDo: [:item :index | (self listWidgets at: index) clickOn: item]! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 12/9/2011 14:56'! setText: aString | textMorph | textMorph := self textWidget. textMorph text: aString asText; accept. ! ! !OBBrowserTest methodsFor: 'running' stamp: 'cwp 12/9/2011 13:53'! setUp super setUp. model := self browserInstance open. widget := interface windows first. self forceLayout! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 12/9/2011 14:56'! textWidget ^ (self widgetsOfClass: OBFakeText) last! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 12/9/2011 13:56'! widgetsOfClass: aClass | found | found := OrderedCollection new. widget withAllChildrenDo: [:m | (m isMemberOf: aClass) ifTrue: [found add: m]]. ^found! ! OBBrowserTest subclass: #OBFakeBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Tests'! !OBFakeBrowserTest methodsFor: 'constants' stamp: 'cwp 3/12/2007 23:51'! browserClass ^ OBFakeBrowser! ! !OBFakeBrowserTest methodsFor: 'constants' stamp: 'cwp 12/5/2004 18:17'! paneCount ^ 4! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/9/2011 13:55'! testAcceptText self select: #a. self assertListAt: 1 contains: #(a b c). self assertListAt: 2 contains: #(aa ab ac). self assertTextIs: 'a'. self setText: 'x'. "This is a gratuitous refresh to make the test pass. It isn't necessary when the browser is actually open. It's a deficiency of the test environment..." self listWidgets do: [:ea | ea update: #list]. self assertListAt: 1 contains: #(x b c). self assertListAt: 2 contains: #(xa xb xc). self assertTextIs: 'x' ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 1/7/2004 08:27'! testAction self select: #a. self selectMenuItem: 'become z'. self assertListAt: 1 contains: #(z b c)! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'lr 3/14/2010 09:23'! testClose | notification | [ model close ] on: OBCloseRequest do: [ :ex | notification := ex ]. self deny: notification isNil. self assert: notification browser = model! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 2/28/2004 13:49'! testConfirmAbandon self select: #a. self assertListAt: 1 contains: #(a b c). self assertListAt: 2 contains: #(aa ab ac). self assertTextIs: 'a'. self editText: 'x'. [self select: #b] on: OBConfirmationRequest do: [:notification | notification cancel]. self assertCurrentItemIs: #a. self assertTextIs: 'x'. ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/8/2007 21:06'! testConfirmClose | notification | self select: #a. self assertListAt: 1 contains: #(#a #b #c). self assertListAt: 2 contains: #(#aa #ab #ac). self assertTextIs: 'a'. self editText: 'x'. [widget close] on: OBConfirmationRequest do: [:ex | notification := ex]. self deny: notification isNil! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/8/2007 23:01'! testCreateWindow self assert: (widget isKindOf: OBFakeWindow). self assert: widget label = 'OmniBrowser'! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'lr 1/16/2010 23:25'! testDefinitionPanel self assert: model definitionPanel isDefinition! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/9/2011 13:55'! testDeleteB self select: #b. self selectMenuItem: 'delete'. self assertListAt: 1 contains: #(a c). self assert: self listWidgets size = self paneCount. self assertTextIs: ''.! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 3/14/2004 17:20'! testDeleteRootNode self select: #a. self selectMenuItem: 'delete root'. self denyAListIncludes: #(a b c). self assertTextIs: ''! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/9/2011 15:29'! testDeselectA self select: #a. self deselect: #a. self assertListAt: 1 contains: #(a b c). self assertListAt: 2 contains: #(). self assert: self listWidgets size = self paneCount. self assertTextIs: ''.! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 11/3/2011 12:44'! testDragAndDrop "This will only pass if OB-Morphic is loaded." | node | self select: #a. node := self drag: #ab. self assert: (node isKindOf: OBFakeNode). self assert: node name = #ab. self drop: node on: #c. self assertListAt: 1 contains: #(a b c). self assertCurrentItemIs: #c. self assertTextIs: 'c'. self assertListAt: 2 contains: #(cb). ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/9/2011 13:55'! testInitialDisplay self assert: self listWidgets size = self paneCount. self assertListAt: 1 contains: #(a b c). self assertTextIs: ''. ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'lr 1/16/2010 23:26'! testNavigationPanel self assert: model navigationPanel isNavigation! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/9/2011 13:56'! testPanes | scroller | self assert: (self widgetsOfClass: OBFakeList) size = self paneCount. self assert: (self widgetsOfClass: OBFakeText) size = 1. scroller := (self widgetsOfClass: OBFakePanel) anyOne. self assert: scroller children size = model navigationPanel minPanes! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'lr 1/15/2010 09:47'! testRefreshDirty self select: #a. self editText: 'x'. [self selectMenuItem: 'create z'] on: OBConfirmationRequest do: [:request | request cancel]. model announcer announce: (OBRefreshRequired new). self assertListAt: 1 contains: #(a b c z). self assertCurrentItemIs: #a. self assertTextIs: 'x'. ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/7/2003 19:30'! testSelectA self select: #a. self assertListAt: 1 contains: #(a b c). self assertListAt: 2 contains: #(aa ab ac). self assertTextIs: 'a'! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/7/2003 19:30'! testSelectC self select: #c. self assertListAt: 1 contains: #(a b c). self assertListAt: 2 contains: #(). self assertTextIs: 'c'! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'dvf 9/5/2005 18:10'! testSelectionPath self select: #a. self select: #ab. self assert: ((model selectionPath collect: [:e | e item]) = (OrderedCollection with: 'a' with: 'b'))! ! OBFakeInteractionTest subclass: #OBFakeBuilderTest instanceVariableNames: 'browser window' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Tests'! !OBFakeBuilderTest methodsFor: 'support' stamp: 'cwp 12/9/2011 12:24'! buildWindow browser := OBFakeBrowser open. window := interface windows anyOne! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 13:34'! testBuildsColumns | columns | self buildWindow. columns := window getChildren: #(1). self assert: columns size = 4. columns do: [:ea | self assert: (ea isKindOf: OBFakePanel)]! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 13:34'! testBuildsFixedButtons | buttons | self buildWindow. buttons := window getChildren: #(2). self assert: buttons size = 2. buttons do: [:ea | self assert: (ea isKindOf: OBFakeButton)]! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 13:35'! testBuildsList | list | self buildWindow. list := window get: #(1 1 1). "first panel, first column, list" self assert: (list isKindOf: OBFakeList)! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 14:17'! testBuildsNoSwitch "The second column should not have a switch" | column | self buildWindow. column := window get: #(1 2 ). "first panel, second column" self assert: (column isKindOf: OBFakePanel). self assert: (column children size = 1) ! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 11:43'! testBuildsPanels self buildWindow. self assert: window children size = 3. self assert: (window children first isKindOf: OBFakePanel). self assert: (window children second isKindOf: OBFakePanel). self assert: (window children last isKindOf: OBFakeText)! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 14:17'! testBuildsSwitch "The first column should have a switch" | switch | self buildWindow. switch := window get: #(1 1 2). "first panel, first column, switch" self assert: (switch isKindOf: OBFakePanel).! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 13:38'! testBuildsSwitchButtons | buttons | self buildWindow. buttons := window getChildren: #(1 1 2). self assert: buttons size = 2. buttons do: [:ea | self assert: (ea isKindOf: OBFakeButton)]! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 11:42'! testBuildsWindow self buildWindow. self assert: (window isKindOf: OBFakeWindow). self assert: window model == browser! ! !OBFakeBuilderTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 14:14'! testUpdatesColumns | columns | self buildWindow. browser panels first columns second changed: #widgets. ! ! !OBFakeInteractionTest class methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 11:39'! isAbstract ^ self name = #OBFakeInteractionTest! ! !OBFakeInteractionTest methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 13:52'! runCase interface := OBFakeInterface new. interface handleInteractionDuring: [super runCase]. ! ! !OBFakeInteractionTest methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 13:52'! runCaseAsFailure: aSemaphore interface := OBFakeInterface new. interface handleInteractionDuring: [super runCaseAsFailure: aSemaphore]! ! TestCase subclass: #OBFakeMenuTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Tests'! !OBFakeMenuTest methodsFor: 'tests' stamp: 'lr 4/25/2011 11:10'! testAddItem | menu | menu := OBFakeMenu new. menu add: 'test item' target: self selector: #clickTestItem enabled: true icon: #blank keystroke: nil. self deny: (menu itemWithWording: 'test item') isNil! ! !OBFakeMenuTest methodsFor: 'tests' 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! ! OBInterface subclass: #OBFakeInterface instanceVariableNames: 'windows' classVariableNames: 'Icons' poolDictionaries: '' category: 'OB-Fake-Interface'! !OBFakeInterface class methodsFor: 'as yet unclassified' stamp: 'cwp 12/12/2011 14:21'! initialize Icons := IdentityDictionary new! ! !OBFakeInterface methodsFor: 'accessing' stamp: 'cwp 12/8/2011 23:47'! builder ^ OBFakeBuilder new! ! !OBFakeInterface methodsFor: 'interaction' stamp: 'cwp 12/9/2011 12:53'! handleBrowseRequest: aRequest windows add: (OBFakeBuilder build: aRequest browser). ^ aRequest browser! ! !OBFakeInterface methodsFor: 'interaction' stamp: 'cwp 12/9/2011 14:45'! handleBuilderRequest: aRequest aRequest resume: self builder! ! !OBFakeInterface methodsFor: 'as yet unclassified' stamp: 'cwp 12/12/2011 14:17'! iconNamed: aSymbol | icon | ^ Icons at: aSymbol ifAbsent: [icon := OBIcon named: aSymbol. icon ifNotNil: [Icons at: aSymbol put: icon]]! ! !OBFakeInterface methodsFor: 'initialize-release' stamp: 'cwp 12/8/2011 23:10'! initialize windows := OrderedCollection new! ! !OBFakeInterface methodsFor: 'accessing' stamp: 'cwp 12/8/2011 22:55'! windows ^ windows! ! OBNode subclass: #OBFake2Node instanceVariableNames: 'name children' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Browser'! !OBFake2Node class methodsFor: 'running' stamp: 'cwp 8/20/2009 08:11'! metagraph | root | root := OBMetaNode named: 'Fake2'. root childAt: #children put: root. ^ root! ! !OBFake2Node class methodsFor: 'instance creation' stamp: 'cwp 8/20/2009 08:11'! tree: anObject | children token | anObject isSymbol ifTrue: [token := anObject. children := #()] ifFalse: [token := anObject first. children := anObject second]. ^ self basicNew setName: token children: children! ! !OBFake2Node methodsFor: 'comparing' stamp: 'cwp 5/8/2007 23:50'! = aNode ^ self name = aNode name! ! !OBFake2Node methodsFor: 'accessing' stamp: 'cwp 5/8/2007 23:46'! children ^ children! ! !OBFake2Node methodsFor: 'comparing' stamp: 'cwp 5/8/2007 23:50'! hash ^ name hash! ! !OBFake2Node methodsFor: 'ancestry' stamp: 'cwp 5/14/2007 13:21'! isAncestorOf: aNode using: aSelector ^ self = aNode or: [children anySatisfy: [:ea | ea isAncestorOf: aNode]]! ! !OBFake2Node methodsFor: 'public' stamp: 'cwp 5/8/2007 23:46'! name ^ name! ! !OBFake2Node methodsFor: 'printing' stamp: 'cwp 5/8/2007 23:45'! printOn: aStream aStream nextPutAll: 'Fake2<'; nextPutAll: name; nextPut: $>! ! !OBFake2Node methodsFor: 'initialize-release' stamp: 'cwp 8/20/2009 08:11'! setName: aSymbol children: anArray name := aSymbol. children := anArray collect: [:ea | self class tree: ea]! ! OBNode subclass: #OBFakeDNUNode instanceVariableNames: 'name children' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Browser'! !OBFakeDNUNode class methodsFor: 'instance creation' stamp: 'jk 1/2/2008 15:44'! tree: anObject " Structure: #(nodeName ((edgeName children) (edgeName children) ...)). #(nodeName ((edgeName noChildren) ...)) means no children at edgeName (returns empty array)." ^ anObject isSymbol ifTrue: [self new setName: anObject] ifFalse: [self new setName: anObject first children: anObject second]. ! ! !OBFakeDNUNode methodsFor: 'comparing' stamp: 'jk 1/1/2008 22:56'! = aNode ^ self name = aNode name! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 21:31'! allChildren ^ self children gather: [:e | e]! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 20:12'! children ^ children ifNil: [children := Dictionary new]! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 20:15'! childrenAt: aSymbol ^ self children at: aSymbol ifAbsent: [nil]! ! !OBFakeDNUNode methodsFor: 'error handling' stamp: 'jk 1/1/2008 21:26'! doesNotUnderstand: aMessage ^ self children at: aMessage selector ifAbsent: [super doesNotUnderstand: aMessage]! ! !OBFakeDNUNode methodsFor: 'comparing' stamp: 'jk 1/1/2008 22:56'! hash ^ name hash! ! !OBFakeDNUNode methodsFor: 'ancestry' stamp: 'jk 1/1/2008 21:30'! isAncestorOf: aNode using: aSelector ^ self = aNode or: [self allChildren anySatisfy: [:ea | ea isAncestorOf: aNode]]! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 22:56'! name ^ name! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 20:27'! noChildren ^ #()! ! !OBFakeDNUNode methodsFor: 'printing' stamp: 'jk 1/1/2008 21:18'! printOn: aStream aStream nextPutAll: 'FakeDNU<'; nextPutAll: name; nextPut: $>! ! !OBFakeDNUNode methodsFor: 'initialize-release' stamp: 'jk 1/2/2008 15:43'! putChildren: anArray anArray do: [ :e | self children at: e first put: ((e allButFirst collect: [:ea | self class tree: ea]) reject: [ :node | node name = #noChildren]) ]! ! !OBFakeDNUNode methodsFor: 'initialize-release' stamp: 'jk 1/1/2008 21:00'! setName: aByteSymbol name := aByteSymbol! ! !OBFakeDNUNode methodsFor: 'initialize-release' stamp: 'jk 1/1/2008 20:51'! setName: aSymbol children: anArray name := aSymbol. self putChildren: anArray! ! OBNode subclass: #OBFakeNode instanceVariableNames: 'item parent children' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Browser'! !OBFakeNode class methodsFor: 'browsing' stamp: 'cwp 12/9/2011 11:47'! metagraph | fake | fake := OBMetaNode new. fake childAt: #children put: fake. fake childAt: #parents put: fake. fake addFilter: OBModalFilter new. ^ fake! ! !OBFakeNode class methodsFor: 'instance creation' stamp: 'cwp 12/15/2003 22:06'! parent: aFakeNode item: aString ^ self new parent: aFakeNode; item: aString! ! !OBFakeNode methodsFor: 'comparing' stamp: 'cwp 5/8/2007 23:27'! = other ^ self name = other name! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 8/20/2009 08:11'! adopt: aNode aNode parent removeChild: aNode. aNode parent: self. children := self children copyWith: aNode. ^ aNode! ! !OBFakeNode methodsFor: 'actions' stamp: 'cwp 8/20/2009 08:11'! beZ item := 'z'. ! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 7/17/2007 23:07'! childX ^ Array with: (OBFakeNode parent: self item: #x)! ! !OBFakeNode methodsFor: 'navigating' stamp: 'cwp 12/9/2011 11:55'! children ^ children ifNil: [children := (self item endsWith: 'c') ifTrue: [Array new] ifFalse: [#($a $b $c) collect: [:i | OBFakeNode parent: self item: i asString]]]! ! !OBFakeNode methodsFor: 'actions' stamp: 'cwp 3/13/2007 00:33'! createZ ^ self adopt: (OBFakeNode parent: self item: 'z')! ! !OBFakeNode methodsFor: 'actions' stamp: 'cwp 3/13/2007 00:20'! delete parent ifNotNil: [parent removeChild: self]. ! ! !OBFakeNode methodsFor: 'drag and drop' stamp: 'cwp 3/13/2007 00:43'! dropOnFakeNode: aNode aNode adopt: self. aNode signalSelection! ! !OBFakeNode methodsFor: 'drag and drop' stamp: 'cwp 3/2/2004 21:40'! dropSelector ^ #dropOnFakeNode:! ! !OBFakeNode methodsFor: 'comparing' stamp: 'cwp 5/8/2007 23:27'! hash ^ self name hash! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 8/20/2009 08:11'! isAncestorOf: aNode using: aSelector | current | current := aNode. [current isNil] whileFalse: [current = self ifTrue: [^ true]. current := current parent]. ^ false! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 8/20/2009 08:11'! item ^ item ifNil: [item := '']! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 8/20/2009 08:11'! item: aSymbol item := aSymbol! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 12/15/2003 22:05'! name ^ self parentName, self item ! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 7/17/2007 23:37'! noChildren ^ #()! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 2/25/2004 21:49'! parent ^ parent! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 8/20/2009 08:11'! parent: aFakeNode parent := aFakeNode! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 12/15/2003 22:04'! parentName ^ (parent ifNil: [''] ifNotNil: [parent name])! ! !OBFakeNode methodsFor: 'navigating' stamp: 'cwp 12/9/2011 11:56'! parents ^ parent ifNil: [#()] ifNotNil: [{parent}]! ! !OBFakeNode methodsFor: 'printing' stamp: 'cwp 5/8/2007 23:25'! printOn: aStream aStream nextPutAll: 'FakeNode<'; nextPutAll: self name; nextPut: $>! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 8/20/2009 08:11'! removeChild: aFakeNode children := self children copyWithout: aFakeNode! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 8/20/2009 08:11'! root | node | node := self parent. [node parent notNil] whileTrue: [node := node parent]. ^ node! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 12/15/2003 22:03'! text ^ self name! ! !OBFakeNode methodsFor: 'public' stamp: 'lr 11/25/2010 23:43'! text: aText self item: (aText asString allButFirst: self parentName size). self signalCreation. ^ true! ! OBBuilder subclass: #OBFakeBuilder instanceVariableNames: 'widget' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Interface'! !OBFakeBuilder methodsFor: 'widgets' stamp: 'cwp 12/9/2011 13:04'! buildWidgetsIn: aBlock | tmp | tmp := OBFakePanel new. self widget: tmp do: aBlock. ^ tmp children! ! !OBFakeBuilder methodsFor: 'private' stamp: 'cwp 12/9/2011 14:40'! createPanel: aColumn | panel | panel := OBFakePanel model: aColumn. widget addChild: panel. [panel update: #widgets] on: OBBuilderRequest do: [:req | req resume: self]! ! !OBFakeBuilder methodsFor: 'visiting' stamp: 'cwp 12/9/2011 12:54'! visitBrowser: aBrowser widget := OBFakeWindow model: aBrowser label: aBrowser labelString. aBrowser panels do: [:ea | ea acceptVisitor: self]. ^ widget! ! !OBFakeBuilder methodsFor: 'visiting' stamp: 'cwp 12/9/2011 12:21'! visitButton: aButton widget addChild: (OBFakeButton model: aButton).! ! !OBFakeBuilder methodsFor: 'visiting' stamp: 'cwp 12/9/2011 13:41'! visitButtonBar: aButtonBar | panel | panel := OBFakePanel model: aButtonBar. widget addChild: panel. self widget: panel do: [aButtonBar buttons do: [:ea | ea acceptVisitor: self]].! ! !OBFakeBuilder methodsFor: 'visiting' stamp: 'cwp 12/9/2011 14:39'! visitColumn: aColumn self createPanel: aColumn! ! !OBFakeBuilder methodsFor: 'visiting' stamp: 'cwp 12/9/2011 14:39'! visitColumnPanel: aColumnPanel self createPanel: aColumnPanel! ! !OBFakeBuilder methodsFor: 'visiting' stamp: 'cwp 12/9/2011 14:33'! visitDefinitionPanel: aPanel | text | text := OBFakeText model: aPanel. widget addChild: text.! ! !OBFakeBuilder methodsFor: 'visiting' stamp: 'cwp 12/9/2011 13:00'! visitFixedButtonPanel: aPanel | panel | panel := OBFakePanel model: aPanel. widget addChild: panel. self widget: panel do: [aPanel buttons do: [:ea | ea acceptVisitor: self]]! ! !OBFakeBuilder methodsFor: 'visiting' stamp: 'cwp 12/9/2011 13:10'! visitList: aList | list | list := OBFakeList model: aList. widget addChild: list! ! !OBFakeBuilder methodsFor: 'visiting' stamp: 'cwp 12/9/2011 14:18'! visitSwitch: aSwitch aSwitch isActive ifTrue: [aSwitch bar acceptVisitor: self]! ! !OBFakeBuilder methodsFor: 'private' stamp: 'cwp 12/9/2011 13:00'! widget: aWidget do: aBlock | oldWidget | oldWidget := widget. widget := aWidget. aBlock ensure: [widget := oldWidget]! ! !OBFakeBuilder methodsFor: 'widgets' stamp: 'cwp 12/9/2011 14:07'! widgetsForButtonBar: anOBButtonBar ^ #()! ! !OBFakeBuilder methodsFor: 'widgets' stamp: 'cwp 12/9/2011 14:43'! widgetsForColumn: aColumn ^ self buildWidgetsIn: [aColumn list acceptVisitor: self. aColumn switch acceptVisitor: self]! ! !OBFakeBuilder methodsFor: 'widgets' stamp: 'cwp 12/9/2011 13:04'! widgetsForColumnPanel: aPanel | count | count := (aPanel columns size max: aPanel minPanes) min: aPanel maxPanes. ^ self buildWidgetsIn: [(aPanel columns last: count) do: [:ea | ea acceptVisitor: self]]! ! OBBrowser subclass: #OBFakeBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Browser'! !OBFakeBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 11:53'! buttonPanel ^ OBFixedButtonPanel new! ! !OBFakeBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 11:52'! defaultMetaNode ^ OBFakeNode metagraph! ! !OBFakeBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 11:52'! defaultRootNode ^ OBFakeNode new! ! !OBFakeBrowser methodsFor: 'buttons' stamp: 'cwp 12/9/2011 11:50'! beZButton ^ OBPluggableCommand new label: 'Become Z'; active: [ :node :col | col isSelected: node ]; action: [ :node :col | node beZ. node announceChangedWith: col ]; yourself! ! !OBFakeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! beZCommand ^ OBPluggableCommand new label: 'become z'; active: [ :node :col | col isSelected: node ]; action: [ :node :col | node beZ. node announceChangedWith: col ]; yourself! ! !OBFakeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! createZCommand ^ OBPluggableCommand new label: 'create z'; action: [ :node :col | node createZ announceSelectionWith: col ]; active: [ :node :col | (col isSelected: node) not ]; yourself! ! !OBFakeBrowser methodsFor: 'buttons' stamp: 'cwp 12/9/2011 11:58'! deleteButton ^ OBPluggableCommand new label: 'delete'; action: [ :node :col | node delete. node announceDeletionWith: col ]; active: [ :node :col | col isSelected: node ]; yourself! ! !OBFakeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! deleteCommand ^ OBPluggableCommand new label: 'delete'; action: [ :node :col | node delete. node announceDeletionWith: col ]; active: [ :node :col | col isSelected: node ]; yourself! ! !OBFakeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! deleteRootCommand ^ OBPluggableCommand new label: 'delete root'; action: [ :node :col | node root announceDeletionWith: col ]; active: [ :node :col | col isSelected: node ]; yourself! ! OBBrowser subclass: #OBFakeCommandBrowser instanceVariableNames: 'action' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Browser'! !OBFakeCommandBrowser class methodsFor: 'defaults' stamp: 'cwp 10/4/2006 10:04'! defaultMetaNode ^ OBFakeNode metagraph! ! !OBFakeCommandBrowser class methodsFor: 'defaults' stamp: 'cwp 10/4/2006 10:04'! defaultRootNode ^ OBFakeNode new! ! !OBFakeCommandBrowser class methodsFor: 'instance creation' stamp: 'cwp 8/20/2009 08:11'! withAction: aBlock | browser | browser := self basicNew initialize. browser action: aBlock. self panels do: [:ea | browser addPanel: ea]. browser setMetaNode: self defaultMetaNode node: self defaultRootNode. ^ browser! ! !OBFakeCommandBrowser methodsFor: 'accessing' stamp: 'cwp 10/4/2006 09:59'! action ^ action! ! !OBFakeCommandBrowser methodsFor: 'accessing' stamp: 'cwp 8/20/2009 08:11'! action: aBlock action := aBlock! ! !OBFakeCommandBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 10:57'! obsoleteCmd ^ OBPluggableCommand! ! !OBFakeCommandBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! obsoleteCommand ^ OBPluggableCommand! ! !OBFakeCommandBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! pluggableCommand ^ OBPluggableCommand action: action! ! Object subclass: #OBFakeMenu instanceVariableNames: 'target items' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeMenu methodsFor: 'emulating' stamp: 'lr 4/25/2011 11:10'! add: aString target: anObject selector: aSymbol enabled: aBoolean icon: icon keystroke: aKeystroke items add: (OBFakeMenuItem label: aString target: anObject selector: aSymbol enabled: aBoolean icon: icon keystroke: aKeystroke)! ! !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 keystroke' 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: 'lr 4/25/2011 11:09'! label: aString target: anObject selector: aSymbol enabled: aBoolean icon: icon keystroke: aKeystroke ^ self new label: aString; target: anObject; selector: aSymbol; isEnabled: aBoolean; icon: icon; keystroke: aKeystroke; 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: 'simulating' stamp: 'cwp 11/3/2011 12:35'! keyText ^ keystroke printString! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'lr 4/25/2011 11:09'! keystroke ^ keystroke! ! !OBFakeMenuItem methodsFor: 'accessing' stamp: 'cwp 11/3/2011 12:35'! keystroke: aKeystroke keystroke := aKeystroke asKeystroke.! ! !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' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! OBFakeWidget subclass: #OBFakeButton instanceVariableNames: 'label enabled pressed color' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeButton methodsFor: 'simulating' stamp: 'cwp 12/9/2011 15:42'! click model execute! ! !OBFakeButton methodsFor: 'examining' stamp: 'cwp 12/9/2011 15:44'! color ^ color! ! !OBFakeButton methodsFor: 'simulating' stamp: 'cwp 12/9/2011 15:43'! draw label ifNil: [self updateLabel]. enabled ifNil: [self updateEnabled]. pressed ifNil: [self updatePressed]. color ifNil: [self updateColor]. ! ! !OBFakeButton methodsFor: 'examining' stamp: 'cwp 12/9/2011 15:45'! isEnabled ^ enabled! ! !OBFakeButton methodsFor: 'examining' stamp: 'cwp 12/9/2011 15:45'! isPressed ^ pressed! ! !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: 'emulating' stamp: 'cwp 12/9/2011 16:33'! update: aSymbol aSymbol = #isEnabled ifTrue: [self updateEnabled]. aSymbol = #isPressed ifTrue: [self updatePressed]. aSymbol = #color ifTrue: [self updateColor]. aSymbol = #label ifTrue: [self updateLabel]. self draw.! ! !OBFakeButton methodsFor: 'private' stamp: 'cwp 12/9/2011 15:46'! updateColor color := model color! ! !OBFakeButton methodsFor: 'private' stamp: 'cwp 12/9/2011 15:47'! updateEnabled enabled := model isEnabled! ! !OBFakeButton methodsFor: 'private' stamp: 'cwp 12/9/2011 15:45'! updateLabel label := model label! ! !OBFakeButton methodsFor: 'private' stamp: 'cwp 12/9/2011 15:47'! updatePressed pressed := model isPressed! ! OBFakeWidget subclass: #OBFakeCompositeWidget instanceVariableNames: 'children' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeCompositeWidget methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 16:47'! addChild: aWidget children add: aWidget! ! !OBFakeCompositeWidget methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 16:38'! children ^ children! ! !OBFakeCompositeWidget methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 16:47'! draw super draw. children do: [ :ea | ea draw ]! ! !OBFakeCompositeWidget methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 13:22'! findDeeplyA: aClass self withAllChildrenDo: [:ea | (ea isMemberOf: aClass) ifTrue: [^ ea]]. ^ nil! ! !OBFakeCompositeWidget methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 13:31'! get: indices ^ indices inject: self into: [:current :index | current children at: index]! ! !OBFakeCompositeWidget methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 13:33'! getChildren: indices ^ (self get: indices) children! ! !OBFakeCompositeWidget methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 16:44'! initialize children := OrderedCollection new! ! !OBFakeCompositeWidget methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 16:47'! withAllChildrenDo: aBlock aBlock value: self. children do: [ :ea | ea withAllChildrenDo: aBlock ]! ! OBFakeCompositeWidget subclass: #OBFakePanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakePanel methodsFor: 'updating' stamp: 'cwp 12/9/2011 15:25'! update: aSymbol aSymbol = #widgets ifTrue: [children := model widgets. self draw]. ! ! OBFakeCompositeWidget subclass: #OBFakeWindow instanceVariableNames: 'label' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeWindow class methodsFor: 'initialization' stamp: 'lr 2/7/2010 11:12'! model: anObject label: aString ^ (self 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 ] ]! ! OBFakeWidget subclass: #OBFakeList instanceVariableNames: 'list selectionIndex' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !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 12/9/2011 15:55'! clickOn: aString | index trimmed | model okToChange ifFalse: [^ self]. list ifNil: [self error: aString, ' is not in the list']. trimmed := list collect: [:ea | ea withBlanksTrimmed]. index := trimmed indexOf: aString ifAbsent: [self error: aString, ' is not in the list']. index = selectionIndex ifTrue: [index := 0]. model selection: index.! ! !OBFakeList methodsFor: 'simulating' stamp: 'cwp 12/9/2011 14:55'! draw list ifNil: [self updateList]. selectionIndex ifNil: [self updateSelectionIndex]! ! !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 12/9/2011 16:05'! items ^ list ifNil: [Array new]! ! !OBFakeList methodsFor: 'examining' stamp: 'cwp 12/9/2011 14:53'! selection selectionIndex = 0 ifTrue: [^ nil]. list ifNotNil: [^ list at: selectionIndex]. ^ nil! ! !OBFakeList methodsFor: 'emulating' stamp: 'cwp 12/9/2011 15:14'! update: aSelector aSelector = #list ifTrue: [self updateList]. aSelector = #selection ifTrue: [self updateSelectionIndex]. self draw.! ! !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: #OBFakeText instanceVariableNames: 'text selection hasUnacceptedEdits hasEditingConflicts' classVariableNames: '' poolDictionaries: '' category: 'OB-Fake-Widgets'! !OBFakeText methodsFor: 'simulating' stamp: 'cwp 12/9/2011 00:56'! accept model accept: text notifying: self. hasUnacceptedEdits := false. hasEditingConflicts := false! ! !OBFakeText methodsFor: 'emulating' stamp: 'cwp 7/8/2007 22:50'! canDiscardEdits ^ hasUnacceptedEdits not! ! !OBFakeText methodsFor: 'simulating' stamp: 'cwp 12/9/2011 15:01'! draw text ifNil: [self updateText]. selection ifNil: [self updateSelection]. ! ! !OBFakeText methodsFor: 'examining' stamp: 'cwp 7/9/2007 00:54'! hasEditingConflicts ^ hasEditingConflicts! ! !OBFakeText methodsFor: 'initialize-release' stamp: 'cwp 12/9/2011 14:06'! initializeWithModel: aModel super initializeWithModel: aModel. hasUnacceptedEdits := false. hasEditingConflicts := false.! ! !OBFakeText methodsFor: 'emulating' stamp: 'cwp 7/9/2007 00:41'! selectionInterval ^ selection! ! !OBFakeText methodsFor: 'examining' stamp: 'cwp 12/9/2011 16:17'! seletedText ^ text ifNotNil: [text copyFrom: selection first to: selection last]! ! !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: 'cwp 12/9/2011 16:26'! update: aSymbol aSymbol = #text ifTrue: [ self updateText. ]. aSymbol = #selection ifTrue: [ self updateText ]. aSymbol = #codeChangedElsewhere ifTrue: [ hasEditingConflicts := true ]. self draw! ! !OBFakeText methodsFor: 'simulating' stamp: 'cwp 12/9/2011 14:59'! updateSelection selection := model selection! ! !OBFakeText methodsFor: 'simulating' stamp: 'cwp 12/9/2011 15:01'! updateText text := model text. hasUnacceptedEdits := false. hasEditingConflicts := false! ! !OBFakeWidget class methodsFor: 'accessing' stamp: 'cwp 12/9/2011 14:06'! model: anObject ^ self basicNew initializeWithModel: anObject! ! !OBFakeWidget methodsFor: 'simulating' stamp: 'cwp 12/9/2011 14:11'! draw! ! !OBFakeWidget methodsFor: 'initialize-release' stamp: 'cwp 12/9/2011 14:07'! initializeWithModel: aModel self initialize. model := aModel. model addDependent: self! ! !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: 'cwp 12/9/2011 13:24'! setBalloonText: stringOrText self setBalloonText: stringOrText maxLineLength: 20. ! ! !OBFakeWidget methodsFor: 'simulating' stamp: 'cwp 12/9/2011 13:24'! setBalloonText: stringOrText maxLineLength: aLength "For compatibilty with Morphs"! ! !OBFakeWidget methodsFor: 'accessing' stamp: 'cwp 12/9/2011 14:01'! withAllChildrenDo: aBlock aBlock value: self! ! OBFakeInterface initialize!