SystemOrganization addCategory: #'OmniBrowser-Announcements'! SystemOrganization addCategory: #'OmniBrowser-Commands'! SystemOrganization addCategory: #'OmniBrowser-Filters'! SystemOrganization addCategory: #'OmniBrowser-Kernel'! SystemOrganization addCategory: #'OmniBrowser-Nodes'! SystemOrganization addCategory: #'OmniBrowser-Notifications'! SystemOrganization addCategory: #'OmniBrowser-Panels'! SystemOrganization addCategory: #'OmniBrowser-Utilities'! Notification subclass: #OBAnnouncerRequest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! Notification subclass: #OBInteractionRequest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBInteractionRequest commentStamp: 'cwp 12/7/2004 00:13' prior: 0! OBInteractionRequest is an abstract superclass for notifications that request some interaction with the user. It's useful for catching such notifications in an exception handler, while allowing other notifications to operate normally.! OBInteractionRequest subclass: #OBBrowseRequest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBBrowseRequest commentStamp: 'cwp 12/7/2004 00:10' prior: 0! This notification is raised whenever a browser needs to be opened. The default action is to open a SystemWindow in Morphic, but it can be caught in situations where that's not appropriate. The OB test suite uses this extensively. ! !OBBrowseRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 10/17/2004 18:45'! signal: aBrowser ^ (self new browser: aBrowser) signal! ! !OBBrowseRequest methodsFor: 'accessing' stamp: 'cwp 10/17/2004 18:45'! browser ^ browser! ! !OBBrowseRequest methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! browser: aBrowser browser := aBrowser! ! !OBBrowseRequest methodsFor: 'dispatching' stamp: 'cwp 5/25/2007 22:51'! handleWith: anObject ^ anObject handleBrowseRequest: self! ! !OBBrowseRequest methodsFor: 'testing' stamp: 'cwp 10/17/2004 19:32'! isBrowseRequest ^ true! ! OBInteractionRequest subclass: #OBChoiceRequest instanceVariableNames: 'prompt labels values lines' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBChoiceRequest commentStamp: 'cwp 3/5/2004 12:26' prior: 0! This notification is used to ask the user for to choose from a list of alternatives. Its defaultAction is to open a PopUpMenu. Test cases an intercept the notification and respond programmatically. prompt - A string describing the choice the user is asked to make. labels - A list of strings describing the alternatives. values - When the user chooses an alternative, the corresponding item from this list is returned! !OBChoiceRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 7/9/2006 00:07'! labels: anArray ^ self prompt: nil labels: anArray values: anArray lines: #()! ! !OBChoiceRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 7/9/2006 00:08'! labels: labelArray lines: lineArray ^ self prompt: nil labels: labelArray values: labelArray lines: lineArray! ! !OBChoiceRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 7/9/2006 00:06'! prompt: aString labels: labelArray values: valueArray ^ self prompt: aString labels: labelArray values: valueArray lines: #()! ! !OBChoiceRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 7/9/2006 00:05'! prompt: aString labels: labelArray values: valueArray lines: lineArray ^ (self new setPrompt: aString labels: labelArray values: valueArray lines: lineArray) signal! ! !OBChoiceRequest methodsFor: 'dispatching' stamp: 'cwp 6/1/2007 16:38'! handleWith: anObject ^ anObject handleChoiceRequest: self! ! !OBChoiceRequest methodsFor: 'accessing' stamp: 'cwp 7/8/2006 23:45'! labels ^ labels! ! !OBChoiceRequest methodsFor: 'accessing' stamp: 'cwp 7/9/2006 00:11'! lines ^ lines! ! !OBChoiceRequest methodsFor: 'accessing' stamp: 'cwp 7/8/2006 23:45'! prompt ^ prompt! ! !OBChoiceRequest methodsFor: 'signaling' stamp: 'lr 7/3/2009 22:27'! select: aString | index | index := labels indexOf: aString. self resume: (values at: index ifAbsent: [ nil ])! ! !OBChoiceRequest methodsFor: 'initializing' stamp: 'lr 7/3/2009 22:27'! setPrompt: aString labels: labelArray values: valueArray lines: lineArray prompt := aString. labels := labelArray. values := valueArray. lines := lineArray! ! !OBChoiceRequest methodsFor: 'accessing' stamp: 'cwp 7/8/2006 23:45'! values ^ values! ! OBChoiceRequest subclass: #OBMultipleChoiceRequest instanceVariableNames: 'selection' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBMultipleChoiceRequest methodsFor: 'dispatching' stamp: 'lr 4/5/2008 09:27'! handleWith: anObject ^ anObject handleMultipleChoiceRequest: self! ! !OBMultipleChoiceRequest methodsFor: 'accessing' stamp: 'lr 4/29/2010 09:34'! label: anObject ^ ((selection includes: anObject) ifTrue: [ '' ] ifFalse: [ '' ]) , (labels at: (values indexOf: anObject ifAbsent: [ ^ nil ])) asString! ! !OBMultipleChoiceRequest methodsFor: 'accessing' stamp: 'lr 4/5/2008 10:30'! selection ^ selection! ! !OBMultipleChoiceRequest methodsFor: 'initializing' stamp: 'lr 4/5/2008 10:35'! setPrompt: aString labels: labelArray values: valueArray lines: lineArray super setPrompt: aString labels: labelArray values: valueArray lines: lineArray. selection := IdentitySet withAll: valueArray! ! !OBMultipleChoiceRequest methodsFor: 'accessing' stamp: 'lr 4/5/2008 10:31'! toggle: anObject (selection includes: anObject) ifTrue: [ selection remove: anObject ] ifFalse: [ selection add: anObject ]! ! OBInteractionRequest subclass: #OBCloseRequest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBCloseRequest class methodsFor: 'exceptionInstantiator' stamp: 'avi 12/5/2007 13:17'! signal: aBrowser ^ (self new browser: aBrowser) signal! ! !OBCloseRequest methodsFor: 'accessing' stamp: 'avi 12/5/2007 13:17'! browser ^ browser! ! !OBCloseRequest methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! browser: aBrowser browser := aBrowser! ! !OBCloseRequest methodsFor: 'dispatching' stamp: 'avi 12/5/2007 13:17'! handleWith: anObject ^ anObject handleCloseRequest: self! ! OBInteractionRequest subclass: #OBCompletionRequest instanceVariableNames: 'prompt default assisted searchBlock labelBlock iconBlock' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:20'! assisted ^ assisted! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:02'! assisted: aBoolean "A boolean indicating that the typing of the user is assisted by not constrained." assisted := aBoolean! ! !OBCompletionRequest methodsFor: 'configuration' stamp: 'lr 9/24/2010 21:41'! collection: aCollection self collection: aCollection caseSensitive: false! ! !OBCompletionRequest methodsFor: 'configuration' stamp: 'lr 9/24/2010 21:41'! collection: aCollection caseSensitive: aBoolean "Configure this completion dialog with aCollection and match the elements case sensitive if aBoolean is true. Display the complete list if the filter is empty." self searchBlock: [ :value | value isEmpty ifTrue: [ aCollection ] ifFalse: [ aCollection select: [ :each | (self labelFor: each) includesSubstring: value caseSensitive: aBoolean ] ] ]! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:04'! default ^ default! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:05'! default: aString "The default string initially used for filtering." default := aString! ! !OBCompletionRequest methodsFor: 'dispatching' stamp: 'lr 9/22/2010 10:21'! handleWith: anObject ^ anObject handleCompletionRequest: self! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 10:11'! iconBlock ^ iconBlock! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:18'! iconBlock: aOneArgumentBlock "A one argument block answering the icon symbol for a given element." iconBlock := aOneArgumentBlock! ! !OBCompletionRequest methodsFor: 'querying' stamp: 'lr 9/22/2010 20:27'! iconFor: anObject ^ iconBlock value: anObject! ! !OBCompletionRequest methodsFor: 'initialization' stamp: 'lr 9/22/2010 20:21'! initialize super initialize. prompt := 'Completion Request'. default := String new. assisted := false. searchBlock := [ :value | #() ]. labelBlock := [ :value | value asString ]. iconBlock := [ :value | nil ]! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 10:11'! labelBlock ^ labelBlock! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:18'! labelBlock: aOneArgumentBlock "A one argument block answering the string for a given element." labelBlock := aOneArgumentBlock! ! !OBCompletionRequest methodsFor: 'querying' stamp: 'lr 9/22/2010 20:06'! labelFor: anObject ^ labelBlock value: anObject! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 10:27'! prompt ^ prompt! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:19'! prompt: aString "A string with the title for this request." prompt := aString! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:18'! searchBlock ^ searchBlock! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:19'! searchBlock: aOneArgumentBlock "A one argument block returning the elements for the given filter." searchBlock := aOneArgumentBlock! ! !OBCompletionRequest methodsFor: 'querying' stamp: 'lr 9/22/2010 20:07'! valuesFor: anObject ^ searchBlock value: anObject! ! OBInteractionRequest subclass: #OBConfirmationRequest instanceVariableNames: 'prompt confirm cancel' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBConfirmationRequest commentStamp: 'cwp 3/5/2004 12:30' prior: 0! This notification is used to ask the user to confirm some kind potentially dangerous operation. Its default action is to open a PopUpMenu. iVars: prompt - a string describing the situation the user is asked to confirm confirm - a string describing the action that will be taken if the user confirms cancel - a string describing the action that will be taken if the user does not confirm! !OBConfirmationRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 2/28/2004 12:09'! newPrompt: prompt confirm: confirm cancel: cancel ^ self new setPrompt: prompt confirm: confirm cancel: cancel! ! !OBConfirmationRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 2/28/2004 12:13'! prompt: prompt ^ self prompt: prompt confirm: 'Ok'! ! !OBConfirmationRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 2/28/2004 12:12'! prompt: prompt confirm: confirm ^ self prompt: prompt confirm: confirm cancel: 'Cancel'! ! !OBConfirmationRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 2/28/2004 12:02'! prompt: prompt confirm: confirm cancel: cancel ^ (self newPrompt: prompt confirm: confirm cancel: cancel) signal! ! !OBConfirmationRequest methodsFor: 'responding' stamp: 'cwp 6/1/2007 16:58'! cancel ^ self resume: false! ! !OBConfirmationRequest methodsFor: 'accessing' stamp: 'cwp 6/1/2007 16:46'! cancelChoice ^ cancel! ! !OBConfirmationRequest methodsFor: 'dispatching' stamp: 'cwp 6/1/2007 16:40'! handleWith: anObject ^ anObject handleConfirmationRequest: self! ! !OBConfirmationRequest methodsFor: 'responding' stamp: 'cwp 2/28/2004 12:11'! ok self resume: true! ! !OBConfirmationRequest methodsFor: 'accessing' stamp: 'cwp 6/1/2007 16:46'! okChoice ^ confirm! ! !OBConfirmationRequest methodsFor: 'accessing' stamp: 'cwp 6/1/2007 16:44'! prompt ^ prompt! ! !OBConfirmationRequest methodsFor: 'initalizing' stamp: 'lr 7/3/2009 22:27'! setPrompt: promptString confirm: confirmString cancel: cancelString prompt := promptString. confirm := confirmString. cancel := cancelString! ! OBInteractionRequest subclass: #OBInformRequest instanceVariableNames: 'message' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBInformRequest class methodsFor: 'exceptionInstantiator' stamp: 'dc 7/22/2007 20:31'! message: aString ^ (self new message: aString; yourself) signal! ! !OBInformRequest methodsFor: 'dispatching' stamp: 'dc 7/22/2007 20:26'! handleWith: anObject ^ anObject handleInformRequest: self! ! !OBInformRequest methodsFor: 'accessing' stamp: 'dc 7/22/2007 20:28'! message ^ message! ! !OBInformRequest methodsFor: 'accessing' stamp: 'dc 7/22/2007 20:28'! message: aString message := aString! ! !OBInteractionRequest methodsFor: 'exceptionDescription' stamp: 'cwp 6/1/2007 16:42'! defaultAction ^ self handleWith: OBPlatform current! ! !OBInteractionRequest methodsFor: 'dispatching' stamp: 'dc 7/22/2007 20:27'! handleWith: anObject self subclassResponsibility ! ! !OBInteractionRequest methodsFor: 'testing' stamp: 'cwp 10/17/2004 19:31'! isBrowseRequest ^ false! ! OBInteractionRequest subclass: #OBMultiLineTextRequest instanceVariableNames: 'prompt template' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBMultiLineTextRequest class methodsFor: 'exceptionInstantiator' stamp: 'dkh 12/19/2007 09:11'! prompt: aString ^ self prompt: aString template: ''! ! !OBMultiLineTextRequest class methodsFor: 'exceptionInstantiator' stamp: 'dkh 12/19/2007 09:11'! prompt: promptString template: templateString ^ (self new prompt: promptString; template: templateString) signal! ! !OBMultiLineTextRequest methodsFor: 'dispatching' stamp: 'dkh 12/19/2007 09:12'! handleWith: anObject ^ anObject handleMultiLineTextRequest: self! ! !OBMultiLineTextRequest methodsFor: 'accessing' stamp: 'dkh 12/19/2007 09:11'! prompt ^ prompt! ! !OBMultiLineTextRequest methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! prompt: aString prompt := aString! ! !OBMultiLineTextRequest methodsFor: 'accessing' stamp: 'dkh 12/19/2007 09:11'! template ^ template! ! !OBMultiLineTextRequest methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! template: aString template := aString! ! OBInteractionRequest subclass: #OBTextRequest instanceVariableNames: 'prompt template' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBTextRequest commentStamp: 'cwp 3/5/2004 12:35' prior: 0! This notification is used to ask the user to supply a short piece of text. Its defaultAction is to open a FillInTheBlank. iVars: prompt - a string describing the text the user is asked to supply template - a default reply ! !OBTextRequest class methodsFor: 'exceptionInstantiator' stamp: 'dc 7/23/2007 16:51'! prompt: aString ^ self prompt: aString template: ''! ! !OBTextRequest class methodsFor: 'exceptionInstantiator' stamp: 'cwp 2/5/2004 20:31'! prompt: promptString template: templateString ^ (self new prompt: promptString; template: templateString) signal! ! !OBTextRequest methodsFor: 'dispatching' stamp: 'cwp 6/1/2007 16:40'! handleWith: anObject ^ anObject handleTextRequest: self! ! !OBTextRequest methodsFor: 'accessing' stamp: 'cwp 2/2/2004 21:24'! prompt ^ prompt! ! !OBTextRequest methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! prompt: aString prompt := aString! ! !OBTextRequest methodsFor: 'accessing' stamp: 'cwp 2/2/2004 21:00'! template ^ template! ! !OBTextRequest methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! template: aString template := aString! ! OBInteractionRequest subclass: #OBWaitRequest instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBWaitRequest commentStamp: 'lr 5/14/2008 15:32' prior: 0! This notification is used to tell the user to wait while some longer action is performed. The default action is to show a hourglass instead of the normal cursor. iVars: block - the code to execute! !OBWaitRequest class methodsFor: 'instance-creation' stamp: 'lr 5/14/2008 15:47'! block: aBlock ^ self new block: aBlock; signal! ! !OBWaitRequest methodsFor: 'accessing' stamp: 'lr 5/14/2008 15:41'! block ^ block! ! !OBWaitRequest methodsFor: 'accessing' stamp: 'lr 5/14/2008 15:41'! block: aBlock block := aBlock! ! !OBWaitRequest methodsFor: 'dispatching' stamp: 'lr 5/14/2008 15:41'! handleWith: anObject ^ anObject handleWaitRequest: self! ! !Behavior methodsFor: '*omnibrowser-converting' stamp: 'cwp 4/17/2006 12:16'! asAnnouncement ^ self new! ! !MessageSend methodsFor: '*omnibrowser-evaluating' stamp: 'cwp 6/24/2006 18:19'! valueWithPossibleArgs: anArray ^ receiver perform: selector withArguments: (self collectArguments: anArray)! ! Object subclass: #OBAnnouncement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! OBAnnouncement subclass: #OBAboutToChange instanceVariableNames: 'veto' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBAboutToChange methodsFor: 'vetos' stamp: 'cwp 4/17/2006 22:18'! isVetoed ^ veto notNil! ! !OBAboutToChange methodsFor: 'vetos' stamp: 'lr 7/3/2009 22:27'! veto veto := true! ! OBAnnouncement subclass: #OBAboutToChangeSilently instanceVariableNames: 'veto' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBAboutToChangeSilently methodsFor: 'vetos' stamp: 'cwp 3/3/2007 22:28'! isVetoed ^ veto notNil! ! !OBAboutToChangeSilently methodsFor: 'vetos' stamp: 'lr 7/3/2009 22:27'! veto veto := true! ! OBAnnouncement subclass: #OBChildrenChanged instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBChildrenChanged class methodsFor: 'instance creation' stamp: 'cwp 6/5/2006 00:49'! node: aNode ^ self new node: aNode! ! !OBChildrenChanged methodsFor: 'accessing' stamp: 'cwp 6/5/2006 00:49'! node ^ node! ! !OBChildrenChanged methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! node: aNode node := aNode! ! OBAnnouncement subclass: #OBCommandScan instanceVariableNames: 'factories' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBCommandScan methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:52'! addCommandsOn: aNode for: aRequestor to: aSet | cmd | factories do: [ :ea | cmd := ea on: aNode for: aRequestor. (cmd wantsMenu and: [ cmd isActive ]) ifTrue: [ aSet add: cmd ] ]! ! !OBCommandScan methodsFor: 'accessing' stamp: 'cwp 11/2/2006 00:35'! addFactory: aCommandFactory factories add: aCommandFactory! ! !OBCommandScan methodsFor: 'user interface' stamp: 'lr 3/4/2009 08:32'! clusterCommands: aCollection | groups root name cluster | groups := IdentityDictionary new. root := OBCommandCluster new. aCollection do: [ :command | name := command cluster. cluster := name isNil ifTrue: [ root ] ifFalse: [ groups at: name ifAbsentPut: [ command createCluster ] ]. cluster addCommand: command ]. groups values do: [ :ea | root addCommand: ea ]. ^ root! ! !OBCommandScan methodsFor: 'accessing' stamp: 'cwp 11/2/2006 00:30'! commandsOn: aNode for: aRequestor ^ factories collect: [:ea | ea on: aNode for: aRequestor]! ! !OBCommandScan methodsFor: 'initialize-release' stamp: 'lr 7/3/2009 22:27'! initialize factories := OrderedCollection new! ! !OBCommandScan methodsFor: 'user interface' stamp: 'lr 7/3/2009 22:27'! populateMenu: aMenu withNodes: aCollection forRequestor: aRequestor | commands cluster | commands := IdentitySet new. aCollection do: [ :node | self addCommandsOn: node for: aRequestor to: commands ]. cluster := self clusterCommands: commands. cluster populateMenu: aMenu! ! !OBCommandScan methodsFor: 'user interface' stamp: 'lr 9/22/2010 13:49'! processKeystroke: aCharacter withNode: aNode for: aRequestor ((self commandsOn: aNode for: aRequestor) select: [ :each | each keystroke = aCharacter ]) do: [ :each | (each isActive and: [ each isEnabled ]) ifTrue: [ each execute. ^ true ] ]. ^ false! ! OBCommandScan subclass: #OBNodeCommandScan instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! OBCommandScan subclass: #OBTextCommandScan instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! OBAnnouncement subclass: #OBDefinitionChanged instanceVariableNames: 'definition node' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBDefinitionChanged class methodsFor: 'instance creation' stamp: 'cwp 6/4/2006 11:28'! definition: aDefinition ^ self new definition: aDefinition; yourself! ! !OBDefinitionChanged class methodsFor: 'instance creation' stamp: 'cwp 6/4/2006 11:27'! node: aNode definition: aDefinition ^ self new node: aNode; definition: aDefinition; yourself! ! !OBDefinitionChanged methodsFor: 'accessing' stamp: 'cwp 6/4/2006 11:25'! definition ^ definition! ! !OBDefinitionChanged methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! definition: aDefinition definition := aDefinition! ! !OBDefinitionChanged methodsFor: 'accessing' stamp: 'cwp 6/5/2006 00:47'! node ^ node! ! !OBDefinitionChanged methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! node: aNode node := aNode! ! OBAnnouncement subclass: #OBNodeChanged instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBNodeChanged class methodsFor: 'instance creation' stamp: 'cwp 6/4/2006 11:17'! node: aNode ^ self new node: aNode! ! !OBNodeChanged methodsFor: 'accessing' stamp: 'cwp 6/4/2006 11:17'! node ^ node! ! !OBNodeChanged methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! node: aNode node := aNode! ! OBAnnouncement subclass: #OBNodeCreated instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBNodeCreated class methodsFor: 'instance creation' stamp: 'cwp 6/4/2006 01:09'! node: aNode ^ self new node: aNode! ! !OBNodeCreated methodsFor: 'accessing' stamp: 'cwp 6/4/2006 00:53'! node ^ node! ! !OBNodeCreated methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! node: aNode node := aNode! ! OBAnnouncement subclass: #OBNodeDeleted instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBNodeDeleted class methodsFor: 'instance creation' stamp: 'cwp 6/4/2006 11:56'! node: aNode ^ self new node: aNode! ! !OBNodeDeleted methodsFor: 'accessing' stamp: 'cwp 6/4/2006 11:56'! node ^ node! ! !OBNodeDeleted methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! node: aNode node := aNode! ! OBAnnouncement subclass: #OBRefreshRequired instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! OBAnnouncement subclass: #OBSelectingNode instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBSelectingNode class methodsFor: 'instance creation' stamp: 'cwp 6/4/2006 13:58'! node: aNode ^ self new node: aNode! ! !OBSelectingNode methodsFor: 'accessing' stamp: 'cwp 6/4/2006 13:58'! node ^ node! ! !OBSelectingNode methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! node: aNode node := aNode! ! OBAnnouncement subclass: #OBSelectionChanged instanceVariableNames: 'node column' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBSelectionChanged class methodsFor: 'instance creation' stamp: 'cwp 4/19/2006 00:51'! column: aColumn ^ self new column: aColumn! ! !OBSelectionChanged class methodsFor: 'instance creation' stamp: 'cwp 4/19/2006 00:31'! node: aNode ^ self new node: aNode! ! !OBSelectionChanged methodsFor: 'accessing' stamp: 'cwp 4/19/2006 00:53'! column ^ column! ! !OBSelectionChanged methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! column: aColumn column := aColumn! ! !OBSelectionChanged methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:32'! node ^ column isNil ifTrue: [ node ] ifFalse: [ column selectedNode ]! ! !OBSelectionChanged methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! node: aNode node := aNode! ! Object subclass: #OBAnnouncer instanceVariableNames: 'subscriptions' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBAnnouncer class methodsFor: 'instance creation' stamp: 'cwp 6/4/2006 00:55'! current ^ OBAnnouncerRequest signal! ! !OBAnnouncer class methodsFor: 'instance creation' stamp: 'cwp 4/17/2006 11:50'! new ^ self basicNew initialize! ! !OBAnnouncer methodsFor: 'subscription' stamp: 'EL 12/8/2008 11:01'! announce: anObject | ann | ann := anObject asAnnouncement. subscriptions keysAndValuesDo: [:class :action | (ann isKindOf: class) ifTrue: [action valueWithArguments: (Array with: ann)]]. ^ ann! ! !OBAnnouncer methodsFor: 'initialize-release' stamp: 'lr 7/3/2009 22:27'! initialize subscriptions := IdentityDictionary new! ! !OBAnnouncer methodsFor: 'subscription' stamp: 'lr 7/3/2009 22:27'! observe: aClass do: aValuable | actions | actions := subscriptions at: aClass ifAbsent: [ ActionSequence new ]. subscriptions at: aClass put: (actions copyWith: aValuable)! ! !OBAnnouncer methodsFor: 'subscription' stamp: 'cwp 6/3/2006 23:31'! observe: aClass send: aSelector to: anObject self observe: aClass do: (MessageSend receiver: anObject selector: aSelector)! ! !OBAnnouncer methodsFor: 'accessing' stamp: 'lr 4/3/2010 17:50'! subscriptions ^ subscriptions! ! !OBAnnouncer methodsFor: 'subscription' stamp: 'cwp 6/10/2006 00:40'! unsubscribe: anObject subscriptions keysAndValuesDo: [:class :actions | subscriptions at: class put: (actions reject: [:ea | ea receiver == anObject])]. subscriptions keysAndValuesRemove: [:key :value | value isEmpty]! ! Object subclass: #OBAutoSelection instanceVariableNames: 'fan metaNode' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBAutoSelection commentStamp: 'dr 1/28/2009 14:52' prior: 0! A auto selection holds a strategy that returns the node to auto select in columns. An auto selection strategy is stored in the metanode representing the respective column. ! !OBAutoSelection class methodsFor: 'instance creation' stamp: 'dr 1/28/2009 15:33'! on: aMetaNode ^self new metaNode: aMetaNode; yourself! ! !OBAutoSelection methodsFor: 'selecting' stamp: 'dr 1/28/2009 14:49'! autoSelection ^fan children detect: [:ea | ea metaNode == metaNode] ifNone: [nil]! ! !OBAutoSelection methodsFor: 'accessing' stamp: 'dr 1/28/2009 15:33'! fan: aFan fan := aFan.! ! !OBAutoSelection methodsFor: 'accessing' stamp: 'dr 1/28/2009 15:43'! metaNode ^metaNode! ! !OBAutoSelection methodsFor: 'accessing' stamp: 'dr 1/28/2009 15:33'! metaNode: aMetaNode metaNode := aMetaNode! ! Object subclass: #OBBrowser instanceVariableNames: 'panels announcer cmdFactories' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBBrowser commentStamp: 'cwp 1/7/2005 23:17' prior: 0! OBBrowser is the core of OmniBrower. It's the root object for each browser and the model for the SystemWindows which display them. Its main responsibily is managing panels, particularly passing update messages between them. On the class side, OBBrowser provides some default settings for creating and opening browsers. Subclasses can override these settings to acheive customized behavior. iVars: panels - A collection of objects which manage submorphs of the browser's SystemWindow. cVars: MetaGraphs - A dictionary matching names to metagraphs! !OBBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:38'! buttonPanel ^ CodeHolder optionalButtons ifTrue: [ OBFixedButtonPanel new ]! ! !OBBrowser class methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:10'! defaultMetaNode self subclassResponsibility! ! !OBBrowser class methodsFor: 'configuration' stamp: 'cwp 12/6/2004 23:20'! defaultRootNode self subclassResponsibility! ! !OBBrowser class methodsFor: 'configuration' stamp: 'cwp 8/31/2004 11:10'! definitionPanel ^ OBDefinitionPanel new! ! !OBBrowser class methodsFor: 'configuration' stamp: 'cwp 8/31/2004 11:01'! maxPanes ^ self paneCount! ! !OBBrowser class methodsFor: 'instance creation' stamp: 'cwp 12/5/2004 18:12'! metaNode: metaNode node: rootNode ^ self metaNode: metaNode root: rootNode selection: nil panels: self panels! ! !OBBrowser class methodsFor: 'instance creation' stamp: 'avi 9/17/2005 01:16'! metaNode: metaNode root: rootNode selection: selectedNode ^ self metaNode: metaNode root: rootNode selection: selectedNode panels: self panels! ! !OBBrowser class methodsFor: 'instance creation' stamp: 'lr 8/15/2010 15:40'! metaNode: metaNode root: rootNode selection: selectedNode panels: panels | browser | browser := self basicNew initialize. panels do: [ :each | each isNil ifFalse: [ browser addPanel: each ] ]. browser setMetaNode: metaNode node: rootNode. selectedNode isNil ifFalse: [ browser jumpTo: selectedNode ]. ^ browser! ! !OBBrowser class methodsFor: 'configuration' stamp: 'cwp 8/31/2004 11:00'! minPanes ^ self paneCount! ! !OBBrowser class methodsFor: 'configuration' stamp: 'cwp 12/5/2004 16:55'! navigationPanel ^ OBColumnPanel minPanes: self minPanes maxPanes: self maxPanes! ! !OBBrowser class methodsFor: 'instance creation' stamp: 'avi 9/16/2005 23:25'! new ^ self metaNode: self defaultMetaNode root: self defaultRootNode selection: nil panels: self panels! ! !OBBrowser class methodsFor: 'opening' stamp: 'cwp 12/6/2004 23:22'! open ^ self new open! ! !OBBrowser class methodsFor: 'opening' stamp: 'cwp 1/22/2007 23:21'! openRoot: aNode ^ (self root: aNode) open! ! !OBBrowser class methodsFor: 'opening' stamp: 'cwp 12/5/2004 17:03'! openRoot: rootNode selection: selectedNode ^ (self root: rootNode selection: selectedNode) open! ! !OBBrowser class methodsFor: 'configuration' stamp: 'cwp 8/31/2004 11:01'! paneCount ^ 4! ! !OBBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:40'! panels ^ Array with: self navigationPanel with: self buttonPanel with: self definitionPanel! ! !OBBrowser class methodsFor: 'instance creation' stamp: 'cwp 12/5/2004 15:26'! root: aNode ^ self root: aNode selection: nil! ! !OBBrowser class methodsFor: 'instance creation' stamp: 'avi 9/16/2005 23:25'! root: rootNode selection: selectedNode ^ self metaNode: self defaultMetaNode root: rootNode selection: selectedNode panels: self panels! ! !OBBrowser class methodsFor: 'instance creation' stamp: 'cwp 12/6/2004 22:04'! selection: selectedNode ^ self root: self defaultRootNode selection: selectedNode! ! !OBBrowser class methodsFor: 'configuration' stamp: 'cwp 8/31/2004 11:32'! title ^ 'OmniBrowser'! ! !OBBrowser class methodsFor: 'configuration' stamp: 'cwp 8/31/2004 13:02'! titleForRoot: aNode ^ self title! ! !OBBrowser methodsFor: 'accessing' stamp: 'cwp 6/4/2006 00:36'! addPanel: aPanel panels add: aPanel. aPanel browser: self. ! ! !OBBrowser methodsFor: 'updating' stamp: 'cwp 10/4/2006 10:06'! announce: anObject ^ self announcer announce: anObject! ! !OBBrowser methodsFor: 'accessing' stamp: 'cwp 4/17/2006 15:42'! announcer ^ announcer! ! !OBBrowser methodsFor: 'accessing' stamp: 'lr 9/24/2010 19:25'! browser ^ self! ! !OBBrowser methodsFor: 'building' stamp: 'cwp 12/9/2007 10:37'! buildGroup: aCollection on: aBuilder ^aBuilder verticalGroupWith: [aCollection do: [:ea | ea buildOn: aBuilder]]! ! !OBBrowser methodsFor: 'building' stamp: 'cwp 7/25/2007 20:50'! buildOn: aBuilder | group | ^aBuilder window: self with: [group := OrderedCollection with: panels first. panels allButFirst do: [:panel | group last vResizing = #spaceFill ifTrue: [self buildGroup: group on: aBuilder. group := OrderedCollection new]. group add: panel]. self buildGroup: group on: aBuilder]! ! !OBBrowser methodsFor: 'opening' stamp: 'avi 12/5/2007 13:19'! close ^ OBCloseRequest signal: self! ! !OBBrowser methodsFor: 'accessing' stamp: 'cwp 3/11/2007 18:29'! cmdFactories ^ cmdFactories! ! !OBBrowser methodsFor: 'initializing' stamp: 'lr 7/3/2009 22:27'! commandSelectors | all obsolete commands | all := self class allSelectors. obsolete := Set new. all do: [ :ea | (ea beginsWith: 'obsolete') ifTrue: [ obsolete add: (self perform: ea) ] ]. commands := all select: [ :ea | ea beginsWith: 'cmd' ]. ^ commands reject: [ :ea | obsolete includes: ea ]! ! !OBBrowser methodsFor: 'accessing' stamp: 'cwp 11/20/2004 21:00'! currentNode ^self navigationPanel currentNode! ! !OBBrowser methodsFor: 'accessing' stamp: 'cwp 11/20/2004 21:00'! currentOrRootNode ^self navigationPanel currentOrRootNode! ! !OBBrowser methodsFor: 'building' stamp: 'dr 11/28/2008 14:20'! defaultBackgroundColor ^ Color gray veryMuchLighter! ! !OBBrowser methodsFor: 'accessing' stamp: 'cwp 8/31/2004 13:04'! defaultLabel ^ self class titleForRoot: self root! ! !OBBrowser methodsFor: 'accessing' stamp: 'lr 1/16/2010 23:23'! definitionPanel ^ panels detect: [ :each | each isDefinition ] ifNone: [ self error: 'No navigation panel configured' ]! ! !OBBrowser methodsFor: 'updating' stamp: 'cwp 6/9/2006 23:29'! dontTranscribe self announcer unsubscribe: self. self subscribe.! ! !OBBrowser methodsFor: 'building' stamp: 'lr 3/5/2010 09:22'! initialExtent ^ RealEstateAgent standardWindowExtent! ! !OBBrowser methodsFor: 'initializing' stamp: 'lr 8/19/2009 22:42'! initialize panels := OrderedCollection new. announcer := OBAnnouncer new. cmdFactories := #()! ! !OBBrowser methodsFor: 'initializing' stamp: 'lr 3/14/2010 10:07'! initializeCommands cmdFactories := Array streamContents: [ :stream | self commandSelectors do: [ :selector | | result | result := self perform: selector. result isNil ifFalse: [ result isCollection ifTrue: [ stream nextPutAll: result ] ifFalse: [ stream nextPut: result ] ] ] ]! ! !OBBrowser methodsFor: 'navigating' stamp: 'cwp 11/20/2004 21:00'! jumpTo: aNode self navigationPanel jumpTo: aNode! ! !OBBrowser methodsFor: 'navigating' stamp: 'cwp 11/20/2004 21:00'! jumpToRoot ^self navigationPanel jumpToRoot! ! !OBBrowser methodsFor: 'callbacks' stamp: 'lr 8/19/2009 22:52'! labelString ^ self defaultLabel! ! !OBBrowser methodsFor: 'accessing' stamp: 'lr 1/16/2010 23:23'! navigationPanel ^ panels detect: [ :each | each isNavigation] ifNone: [ self error: 'No navigation panel configured' ]! ! !OBBrowser methodsFor: 'callbacks' stamp: 'cwp 4/17/2006 19:52'! okToChange ^ (self announcer announce: OBAboutToChange) isVetoed not! ! !OBBrowser methodsFor: 'opening' stamp: 'cwp 10/17/2004 21:31'! open ^ OBBrowseRequest signal: self! ! !OBBrowser methodsFor: 'accessing' stamp: 'cwp 9/17/2004 00:53'! panels ^ panels! ! !OBBrowser methodsFor: 'updating' stamp: 'cwp 4/24/2006 15:10'! relabel: ann self changed: #relabel. ! ! !OBBrowser methodsFor: 'navigating' stamp: 'cwp 9/17/2005 17:48'! root ^self navigationPanel root! ! !OBBrowser methodsFor: 'updating' stamp: 'cwp 11/2/2006 00:35'! scanNodeCommands: ann (cmdFactories select: [:ea | ea takesNodes]) do: [:ea | ann addFactory: ea]! ! !OBBrowser methodsFor: 'updating' stamp: 'cwp 11/2/2006 00:35'! scanTextCommands: ann (cmdFactories select: [:ea | ea takesText]) do: [:ea | ann addFactory: ea]! ! !OBBrowser methodsFor: 'accessing' stamp: 'dvf 9/5/2005 17:30'! selectionPath ^self navigationPanel selectionPath! ! !OBBrowser methodsFor: 'initializing' stamp: 'lr 8/19/2009 22:42'! setMetaNode: aMetaNode node: aNode self navigationPanel setMetaNode: aMetaNode node: aNode. self initializeCommands; subscribe! ! !OBBrowser methodsFor: 'updating' stamp: 'cwp 6/4/2006 18:50'! signalRefresh self announcer announce: OBRefreshRequired! ! !OBBrowser methodsFor: 'updating' stamp: 'cwp 11/1/2006 23:46'! subscribe (self announcer) observe: OBSelectionChanged send: #relabel: to: self; observe: OBNodeCommandScan send: #scanNodeCommands: to: self; observe: OBTextCommandScan send: #scanTextCommands: to: self! ! !OBBrowser methodsFor: 'updating' stamp: 'cwp 6/6/2006 00:26'! transcribe self announcer observe: OBAnnouncement do: [:ann | Transcript cr; show: ann].! ! Object subclass: #OBBuilder instanceVariableNames: 'current' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBBuilder class methodsFor: 'building' stamp: 'cwp 8/26/2009 23:25'! build: aModel ^ self new build: aModel! ! !OBBuilder methodsFor: 'building' stamp: 'cwp 8/26/2009 23:25'! build: aModel ^ aModel buildOn: self! ! !OBBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:55'! button: aModel with: aBlock self subclassResponsibility! ! !OBBuilder methodsFor: 'accessing' stamp: 'lr 3/13/2010 18:47'! current: anObject do: aBlock | saved | saved := current. current := anObject. aBlock ensure: [ current := saved ]. ^ anObject! ! !OBBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:52'! fixedButtonBar: aPanel with: aBlock self subclassResponsibility! ! !OBBuilder methodsFor: 'building' stamp: 'dr 11/12/2008 10:13'! horizontalGroupWith: aBlock self subclassResponsibility ! ! !OBBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:47'! pane: aColumn with: aBlock self subclassResponsibility! ! !OBBuilder methodsFor: 'building' stamp: 'dr 11/12/2008 10:13'! radioButtonBar: aPanel with: aBlock self subclassResponsibility ! ! !OBBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:46'! scroller: aPanel with: aBlock self subclassResponsibility! ! !OBBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:48'! textarea: aPanel with: aBlock self subclassResponsibility! ! !OBBuilder methodsFor: 'building' stamp: 'dr 11/12/2008 10:13'! textfield: aModel with: aBlock self subclassResponsibility ! ! !OBBuilder methodsFor: 'building' stamp: 'cwp 12/9/2007 10:39'! verticalGroupWith: aBlock self subclassResponsibility! ! !OBBuilder methodsFor: 'building' stamp: 'dr 11/12/2008 10:13'! window: aBrowser with: aBlock self subclassResponsibility ! ! Object subclass: #OBColumn instanceVariableNames: 'panel switch listHolder' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBColumn commentStamp: 'cwp 1/7/2005 23:19' prior: 0! An OBColumn manages a list of nodes, which it displays in a PluggableListMorph in the pane scroller at the top of the browser. All instances of OBColumn belong to an OBColumnPanel. It's main responsibility is keeping its list - and those of its neighbours - up to date. Each column has a MetaNode, which provides the list contents. It uses a filter to meditate between its self and the MetaNode. iVars: panel - the panel which owns the column filter - the filter which manages the column's MetaNode. parent - the node selected in the column to the left of this column children - the nodes which make up this column's list selection - the index of the node selected by the user! !OBColumn class methodsFor: 'instance creation' stamp: 'cwp 9/18/2005 13:26'! inPanel: aBrowser ^ self new setPanel: aBrowser! ! !OBColumn class methodsFor: 'instance creation' stamp: 'dr 12/18/2008 15:24'! inPanel: aPanel metaNode: aMetaNode node: aNode ^ self new setPanel: aPanel metaNode: aMetaNode node: aNode! ! !OBColumn methodsFor: 'commands' stamp: 'cwp 9/30/2007 21:39'! addCommandsToMenu: aMenu | scan nodes | scan := self announce: OBNodeCommandScan. nodes := self hasSelection ifTrue: [{self parent. self selectedNode}] ifFalse: [{self parent}]. scan populateMenu: aMenu withNodes: nodes forRequestor: self ! ! !OBColumn methodsFor: 'updating' stamp: 'cwp 10/13/2006 09:05'! announce: anAnnouncement ^ self browser announce: anAnnouncement! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 4/17/2006 15:52'! announcer ^ panel announcer! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 11/16/2004 21:49'! basicNext ^panel columnAfter: self! ! !OBColumn methodsFor: 'accessing' stamp: 'dr 9/17/2008 10:54'! basicParent: aNode self listHolder parent: aNode. self switchFilter: self listHolder switchFilter! ! !OBColumn methodsFor: 'accessing' stamp: 'dr 6/26/2008 16:03'! browser ^ panel browser! ! !OBColumn methodsFor: 'building' stamp: 'cwp 7/25/2007 23:47'! buildOn: aBuilder ^aBuilder pane: self with: [switch buildOn: aBuilder]! ! !OBColumn methodsFor: 'callbacks' stamp: 'dr 10/21/2008 22:50'! canDrop: passenger on: node ^node notNil and: [node wantsDroppedNode: passenger]! ! !OBColumn methodsFor: 'accessing' stamp: 'dr 9/18/2008 10:03'! children ^ self listHolder children! ! !OBColumn methodsFor: 'updating' stamp: 'cwp 6/9/2006 22:35'! childrenChanged: announcement (self parent = announcement node) ifTrue: [self refresh]! ! !OBColumn methodsFor: 'updating' stamp: 'jk 3/23/2008 11:04'! clear self switchFilter: nil. self listHolder clearAll. self changed: #list. self changed: #selection! ! !OBColumn methodsFor: 'selecting' stamp: 'jk 3/22/2008 21:04'! clearSelection self listHolder clearSelection! ! !OBColumn methodsFor: 'callbacks' stamp: 'lr 4/3/2009 14:28'! clickIconAt: anInteger self listHolder clickIconAt: anInteger! ! !OBColumn methodsFor: 'updating' stamp: 'dr 9/24/2008 10:42'! createNext | nextMetaNode created | nextMetaNode := self nextMetaNode. created := panel columnClass inPanel: panel metaNode: nextMetaNode node: self selectedNode. panel pushColumn: created. ^created! ! !OBColumn methodsFor: 'printing' stamp: 'avi 3/6/2004 16:23'! descriptor self isEmpty ifTrue: [^ 'empty']. self hasSelection ifTrue: [^ self selectedNode name]. ^ ''! ! !OBColumn methodsFor: 'callbacks' stamp: 'lr 4/3/2009 13:33'! doubleClick self listHolder doubleClick! ! !OBColumn methodsFor: 'callbacks' stamp: 'dr 11/18/2008 20:09'! drop: passenger on: target ^ [target acceptDroppedNode: passenger] on: OBAnnouncerRequest do: [:notification | notification resume: self announcer]! ! !OBColumn methodsFor: 'selecting' stamp: 'lr 5/28/2010 21:47'! fan: aFan selection: index | node | self listHolder fan: aFan selection: index. (node := self selectedNode) isNil ifFalse: [ self listHolder noteChild: node ]. self switchFilter: self listHolder switchFilter. switch refresh. self changed: #list! ! !OBColumn methodsFor: 'testing' stamp: 'jk 4/6/2008 18:43'! hasSelection ^ self listHolder hasSelection! ! !OBColumn methodsFor: 'callbacks' stamp: 'jk 3/23/2008 11:11'! iconAt: index ^ self listHolder iconAt: index! ! !OBColumn methodsFor: 'testing' stamp: 'dr 9/19/2008 16:53'! includesNode: aNode ^ self listHolder includesNode: aNode! ! !OBColumn methodsFor: 'accessing' stamp: 'jk 3/23/2008 10:55'! isEmpty ^ self listHolder isEmpty! ! !OBColumn methodsFor: 'testing' stamp: 'cwp 10/9/2006 15:41'! isSelected: aNode ^ self selectedNode == aNode! ! !OBColumn methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:32'! jumpTo: cNode cNode isNil ifTrue: [ self clearSelection. self changed: #list. panel clearAfter: self ] ifFalse: [ self listHolder noteChild: cNode. self selectSilently: cNode. panel selectionChangedIn: self. switch currentNode: cNode. self changed: #list ]! ! !OBColumn methodsFor: 'callbacks' stamp: 'lr 9/22/2010 14:16'! keystroke: aCharacter from: aMorph | scan nodes | scan := self announcer announce: OBNodeCommandScan. nodes := panel columns collect: [ :each | each parent ]. nodes := (nodes copyWith: self selectedNode) select: [ :each | each notNil ]. nodes reverseDo: [ :each | (scan processKeystroke: aCharacter withNode: each for: self) ifTrue: [ ^ self ] ]! ! !OBColumn methodsFor: 'callbacks' stamp: 'dr 9/11/2008 14:57'! list ^ self listHolder list! ! !OBColumn methodsFor: 'callbacks' stamp: 'dr 11/20/2008 15:10'! listAt: index ^ self listHolder displayStringForChildAt: index ! ! !OBColumn methodsFor: 'updating' stamp: 'dr 9/29/2008 16:34'! listChanged self refreshAndSignal: true! ! !OBColumn methodsFor: 'list' stamp: 'dr 9/12/2008 10:40'! listHolder ^ listHolder ifNil: [ listHolder := OBList column: self ]! ! !OBColumn methodsFor: 'callbacks' stamp: 'dr 10/20/2008 14:57'! listSize ^ self listHolder listSize! ! !OBColumn methodsFor: 'callbacks' stamp: 'cwp 3/13/2007 00:51'! menu: aMenu self isEmpty ifFalse: [self addCommandsToMenu: aMenu]. ^aMenu! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 5/6/2007 23:19'! metaNode ^ self parent metaNode! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 2/12/2004 20:50'! next ^ self basicNext ifNil: [(self hasSelection and: [self shouldBeLast not]) ifTrue: [self createNext]] ! ! !OBColumn methodsFor: 'column' stamp: 'jk 3/28/2008 12:51'! nextColumnForDefaultNavigationWithFan: anOBFan selection: aSmallInteger | column | column := self next. column fan: anOBFan selection: aSmallInteger. ^ column! ! !OBColumn methodsFor: 'column' stamp: 'dr 9/17/2008 12:10'! nextColumnWithFan: aFan selection: anInteger ^ aFan columnAfter: self selection: anInteger! ! !OBColumn methodsFor: 'nodes' stamp: 'cwp 3/3/2004 00:11'! nextMetaNode ^ self selectedNode metaNode! ! !OBColumn methodsFor: 'updating' stamp: 'djr 11/9/2008 14:16'! nodeChanged: ann (self listHolder includesNode: ann node) ifTrue: [self changed: #list]! ! !OBColumn methodsFor: 'updating' stamp: 'lr 2/12/2009 10:32'! nodeDeleted: announcement "This gets called if an action causes the currently selected node to be deleted." self selectedNode = announcement node ifFalse: [ ^ self ]. self listHolder refresh. self changed: #list. self selection: 0! ! !OBColumn methodsFor: 'commands' stamp: 'dr 9/22/2008 11:14'! nodeForItem: aString ^ self listHolder nodeForItem: aString ! ! !OBColumn methodsFor: 'callbacks' stamp: 'dr 12/3/2008 15:57'! okToChange ^ (self announcer announce: OBAboutToChange) isVetoed not! ! !OBColumn methodsFor: 'accessing' stamp: 'jk 3/23/2008 11:15'! parent ^ self listHolder parent! ! !OBColumn methodsFor: 'accessing' stamp: 'jk 3/23/2008 10:54'! parent: aNode | cNode | self basicParent: aNode. cNode := self listHolder autoSelection. self jumpTo: cNode! ! !OBColumn methodsFor: 'accessing' stamp: 'dr 10/21/2008 09:09'! previous ^panel columnBefore: self! ! !OBColumn methodsFor: 'printing' stamp: 'cwp 2/11/2004 23:31'! printOn: aStream super printOn: aStream. aStream nextPut: $(. aStream nextPutAll: self descriptor. aStream nextPut: $)! ! !OBColumn methodsFor: 'updating' stamp: 'cwp 6/9/2006 23:08'! refresh self refreshAndSignal: false! ! !OBColumn methodsFor: 'updating' stamp: 'dr 9/22/2008 11:27'! refresh: ann self refreshAndSignal: false ! ! !OBColumn methodsFor: 'updating' stamp: 'EL 12/15/2008 09:44'! refreshAndSignal: aBoolean | shouldSignal | shouldSignal := aBoolean. self isEmpty ifTrue: [^self]. self listHolder refresh ifTrue: [self selectSilently: self selectedNode. self hasSelection ifFalse: [shouldSignal := true]]. shouldSignal ifTrue: [self signalSelectionChanged]. self changed: #list! ! !OBColumn methodsFor: 'selecting' stamp: 'lr 5/28/2010 21:47'! select: aNode self listHolder children keysAndValuesDo: [ :i :child | child = aNode ifTrue: [ ^ self selection: i ] ]. self selection: nil! ! !OBColumn methodsFor: 'selecting' stamp: 'jk 3/23/2008 11:07'! selectSilently: aNode self listHolder selectSilently: aNode! ! !OBColumn methodsFor: 'selecting' stamp: 'jk 3/23/2008 11:18'! selectedNode ^ self listHolder selectedNode! ! !OBColumn methodsFor: 'callbacks' stamp: 'jk 3/22/2008 21:05'! selection ^ self listHolder selection! ! !OBColumn methodsFor: 'callbacks' stamp: 'dr 10/20/2008 14:58'! selection: anInteger self listHolder selection: anInteger. self signalSelectionChanged. self changed: #selection. switch currentNode: self selectedNode ! ! !OBColumn methodsFor: 'updating' stamp: 'dr 3/1/2008 17:17'! selectionChanged: ann! ! !OBColumn methodsFor: 'initializing' stamp: 'lr 7/3/2009 22:27'! setPanel: aPanel panel := aPanel. switch := OBSwitch inColumn: self. self subscribe. self listHolder clearAll! ! !OBColumn methodsFor: 'initializing' stamp: 'lr 7/3/2009 22:27'! setPanel: aPanel metaNode: aMetanode node: aNode switch := OBSwitch inColumn: self. panel := aPanel. aNode metaNode: aMetanode. self basicParent: aNode. self clearSelection. self subscribe! ! !OBColumn methodsFor: 'testing' stamp: 'avi 3/6/2004 16:27'! shouldBeLast ^ self hasSelection not or: [self nextMetaNode hasChildren not]! ! !OBColumn methodsFor: 'updating' stamp: 'cwp 6/5/2006 23:31'! signalSelectionChanged self announcer announce: (OBSelectionChanged column: self)! ! !OBColumn methodsFor: 'updating' stamp: 'cwp 6/10/2006 00:18'! subscribe self announcer observe: OBRefreshRequired send: #refresh: to: self; observe: OBNodeChanged send: #nodeChanged: to: self; observe: OBNodeDeleted send: #nodeDeleted: to: self; observe: OBChildrenChanged send: #childrenChanged: to: self; observe: OBSelectionChanged send: #selectionChanged: to: self.! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 5/17/2007 23:25'! switch ^ switch! ! !OBColumn methodsFor: 'accessing' stamp: 'lr 4/7/2010 08:08'! switchFilter: aFilter switch filter = aFilter ifTrue:[ ^ self ]. switch filter: aFilter. self changed: #switch! ! !OBColumn methodsFor: 'testing' stamp: 'cwp 5/17/2007 23:24'! wantsButton ^ switch isActive! ! Object subclass: #OBCommand instanceVariableNames: 'target requestor' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBCommand class methodsFor: 'instance creation' stamp: 'cwp 10/14/2006 23:29'! on: target for: requestor ^ self new setTarget: target requestor: requestor! ! !OBCommand class methodsFor: 'testing' stamp: 'cwp 10/15/2006 00:58'! takesNodes ^ true! ! !OBCommand class methodsFor: 'testing' stamp: 'cwp 10/15/2006 00:58'! takesText ^ false! ! !OBCommand methodsFor: 'user interface' stamp: 'cwp 6/8/2007 20:45'! addItemToMenu: aMenu self isActive ifTrue: [aMenu add: self labelWithKeystroke target: self selector: #execute enabled: self isEnabled icon: self icon]! ! !OBCommand methodsFor: 'accessing' stamp: 'lr 4/25/2007 09:27'! buttonLabel ^ self label! ! !OBCommand methodsFor: 'accessing' stamp: 'cwp 9/30/2007 18:59'! cluster ^ nil! ! !OBCommand methodsFor: 'accessing' stamp: 'cwp 9/30/2007 20:18'! createCluster ^ OBCommandCluster label: self cluster! ! !OBCommand methodsFor: 'execution' stamp: 'cwp 10/15/2006 14:12'! execute ! ! !OBCommand methodsFor: 'accessing' stamp: 'cwp 10/6/2006 21:44'! group ^ #general! ! !OBCommand methodsFor: 'accessing' stamp: 'cwp 10/6/2006 18:45'! icon ^ nil! ! !OBCommand methodsFor: 'testing' stamp: 'cwp 10/15/2006 22:05'! isActive ^ false! ! !OBCommand methodsFor: 'testing' stamp: 'cwp 10/15/2006 19:31'! isEnabled ^ true! ! !OBCommand methodsFor: 'accessing' stamp: 'cwp 9/27/2006 22:53'! keystroke ^ nil ! ! !OBCommand methodsFor: 'accessing' stamp: 'cwp 9/27/2006 22:53'! label self subclassResponsibility ! ! !OBCommand methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:32'! labelWithKeystroke ^ self keystroke isNil ifTrue: [ self label ] ifFalse: [ self label , ' (' , self keystroke asString , ')' ]! ! !OBCommand methodsFor: 'accessing' stamp: 'dc 8/3/2007 12:50'! longDescription "Override this and return a string or a text for the fly-by-help (tooltip)" ^ nil! ! !OBCommand methodsFor: 'accessing' stamp: 'lr 9/24/2010 21:46'! longLabel ^ self cluster isNil ifTrue: [ self label ] ifFalse: [ self cluster , ' > ' , self label ]! ! !OBCommand methodsFor: 'accessing' stamp: 'cwp 10/14/2006 23:39'! on: anObject for: aRequestor ^ self class on: anObject for: aRequestor! ! !OBCommand methodsFor: 'user interface' stamp: 'dc 1/3/2008 10:11'! order ^ self label! ! !OBCommand methodsFor: 'user interface' stamp: 'cwp 10/15/2006 12:37'! perform: aSelector orSendTo: anObject self perform: aSelector! ! !OBCommand methodsFor: 'user interface' stamp: 'cwp 10/9/2006 13:49'! select: aNode with: anAnnouncer (anAnnouncer announce: OBAboutToChange) isVetoed ifFalse: [anAnnouncer announce: (OBSelectingNode node: aNode)]! ! !OBCommand methodsFor: 'initialize-release' stamp: 'lr 7/3/2009 22:27'! setTarget: anObject requestor: aRequestor target := anObject. requestor := aRequestor! ! !OBCommand methodsFor: 'testing' stamp: 'lr 2/7/2010 12:50'! takesNodes ^ self class takesNodes! ! !OBCommand methodsFor: 'testing' stamp: 'lr 2/7/2010 12:50'! takesText ^ self class takesText! ! !OBCommand methodsFor: 'testing' stamp: 'cwp 9/27/2006 22:53'! wantsButton "Put this here for compatibility. Eventually this will be obsolete" ^ false ! ! !OBCommand methodsFor: 'testing' stamp: 'lr 8/8/2010 10:47'! wantsMenu "Put this here for compatibility. Eventually this will be obsolete" ^ true ! ! OBCommand subclass: #OBPluggableCommand instanceVariableNames: 'action active enabled label keystroke icon buttonLabel' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBPluggableCommand class methodsFor: 'instance creation' stamp: 'cwp 6/18/2006 18:53'! action: aValuable ^ self new action: aValuable! ! !OBPluggableCommand class methodsFor: 'instance creation' stamp: 'cwp 10/15/2006 13:50'! action: aValuable active: aValuable2 ^ self new action: aValuable; active: aValuable2; yourself! ! !OBPluggableCommand class methodsFor: 'instance creation' stamp: 'cwp 6/24/2006 15:43'! new ^ self basicNew initialize! ! !OBPluggableCommand class methodsFor: 'testing' stamp: 'cwp 10/15/2006 00:57'! takesNodes ^ true! ! !OBPluggableCommand class methodsFor: 'testing' stamp: 'cwp 10/15/2006 00:58'! takesText ^ false! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'dc 4/28/2007 11:36'! action: aValuable action := aValuable! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'dc 4/28/2007 11:36'! active: aValuable active := aValuable! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 10/15/2006 13:41'! buttonLabel ^ buttonLabel! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! buttonLabel: aString buttonLabel := aString! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! enabled: aBlock enabled := aBlock! ! !OBPluggableCommand methodsFor: 'execute' stamp: 'dkh 5/31/2007 13:53'! execute ^ action valueWithPossibleArgs: (Array with: target with: requestor)! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 10/6/2006 21:46'! group ^ #general! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 10/15/2006 13:37'! icon ^ icon! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! icon: anIcon icon := anIcon! ! !OBPluggableCommand methodsFor: 'initialize-release' stamp: 'lr 7/3/2009 22:27'! initialize action := [ ]. active := [ true ]. enabled := [ true ]. label := 'a command'! ! !OBPluggableCommand methodsFor: 'testing' stamp: 'dkh 5/31/2007 13:53'! isActive ^ active valueWithPossibleArgs: (Array with: target with: requestor)! ! !OBPluggableCommand methodsFor: 'testing' stamp: 'dkh 5/31/2007 13:53'! isEnabled ^ enabled valueWithPossibleArgs: (Array with: target with: requestor)! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 6/24/2006 19:04'! keystroke ^ keystroke! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! keystroke: aCharacter keystroke := aCharacter! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 6/24/2006 19:04'! label ^ label! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! label: aString label := aString! ! !OBPluggableCommand methodsFor: 'morphic' stamp: 'lr 3/4/2009 08:32'! labelWithKeystroke ^ keystroke isNil ifTrue: [ label ] ifFalse: [ label , ' (' , keystroke asString , ')' ]! ! !OBPluggableCommand methodsFor: 'converting' stamp: 'lr 7/3/2009 22:27'! on: aNode for: aRequestor | inst | inst := self copy. inst setTarget: aNode requestor: aRequestor. ^ inst! ! !OBPluggableCommand methodsFor: 'testing' stamp: 'cwp 6/25/2006 00:43'! useLineAfter ^ false! ! !OBPluggableCommand methodsFor: 'testing' stamp: 'cwp 6/24/2006 19:46'! wantsButton ^ self buttonLabel notNil! ! Object subclass: #OBCommandCluster instanceVariableNames: 'commands label' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBCommandCluster class methodsFor: 'instance creation' stamp: 'cwp 9/30/2007 20:24'! label: aString ^ self new setLabel: aString! ! !OBCommandCluster methodsFor: 'accessing' stamp: 'cwp 9/30/2007 20:19'! addCommand: aCommand commands add: aCommand! ! !OBCommandCluster methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! addItemToMenu: aMenu | submenu | submenu := aMenu addSubmenu: label enabled: self isEnabled. self populateMenu: submenu! ! !OBCommandCluster methodsFor: 'accessing' stamp: 'cwp 9/30/2007 20:40'! group ^ #zclusters! ! !OBCommandCluster methodsFor: 'accessing' stamp: 'lr 4/8/2010 11:07'! groupedCommands | groups | groups := commands groupBy: [:svc | svc group] having: [:group | group isEmpty not]. groups := groups collect: [:ea | ea asArray sort: [:a :b | a order <= b order]]. ^ groups asArray sort: [:a :b | a anyOne group <= b anyOne group]! ! !OBCommandCluster methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! initialize commands := IdentitySet new! ! !OBCommandCluster methodsFor: 'accessing' stamp: 'cwp 9/30/2007 21:54'! isEnabled ^ commands anySatisfy: [:ea | ea isEnabled]! ! !OBCommandCluster methodsFor: 'accessing' stamp: 'cwp 9/30/2007 20:16'! label ^ label! ! !OBCommandCluster methodsFor: 'accessing' stamp: 'lr 4/8/2010 11:07'! order ^ self label! ! !OBCommandCluster methodsFor: 'accessing' stamp: 'cwp 9/30/2007 21:01'! populateMenu: aMenu self groupedCommands do: [:group | group do: [:cmd | cmd addItemToMenu: aMenu]] separatedBy: [aMenu addLine]! ! !OBCommandCluster methodsFor: 'initialize-release' stamp: 'lr 7/3/2009 22:27'! setLabel: aSymbol label := aSymbol! ! Object subclass: #OBDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Utilities'! !OBDefinition commentStamp: 'cwp 1/7/2005 23:38' prior: 0! The responsibility of a definition is to express a node's composition textually and respond to changes in the text by updating the node it represents. For example,a file browser might use a file definition to allow editing of a files contents.! !OBDefinition methodsFor: 'callbacks' stamp: 'cwp 3/22/2004 20:51'! accept: aText notifying: aController ^ self text: aText! ! !OBDefinition methodsFor: 'updating' stamp: 'cwp 7/25/2006 18:26'! asAnnouncement ^ OBDefinitionChanged definition: self! ! !OBDefinition methodsFor: 'callbacks' stamp: 'cwp 3/23/2004 00:08'! doItContext ^ nil! ! !OBDefinition methodsFor: 'callbacks' stamp: 'lr 3/4/2009 08:31'! doItReceiver | class | class := self selectedClass. ^ class isNil ifFalse: [ class theNonMetaClass ] ifTrue: [ FakeClassPool new ]! ! !OBDefinition methodsFor: 'callbacks' stamp: 'cwp 12/26/2007 23:00'! selectedClass ^ nil! ! !OBDefinition methodsFor: 'callbacks' stamp: 'cwp 3/23/2004 22:16'! selection ^ 1 to: 0! ! !OBDefinition methodsFor: 'updating' stamp: 'cwp 6/4/2006 18:53'! signalChange OBAnnouncer current announce: (OBDefinitionChanged definition: self)! ! !OBDefinition methodsFor: 'callbacks' stamp: 'cwp 3/22/2004 20:52'! text ^ ''! ! !OBDefinition methodsFor: 'callbacks' stamp: 'cwp 3/22/2004 20:52'! text: aText ^ false! ! !OBDefinition methodsFor: 'callbacks' stamp: 'cwp 3/23/2004 22:16'! textSelection ^ self selection! ! OBDefinition subclass: #OBTextDefinition instanceVariableNames: 'text' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Utilities'! !OBTextDefinition class methodsFor: 'instance creation' stamp: 'dc 3/13/2008 21:49'! text: aText ^ self new setText: aText; yourself! ! !OBTextDefinition methodsFor: 'initialize-release' stamp: 'dc 3/13/2008 21:51'! setText: aText text := aText ! ! !OBTextDefinition methodsFor: 'accessing' stamp: 'dc 3/13/2008 21:51'! text ^ text! ! Object subclass: #OBFan instanceVariableNames: 'parent children' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBFan class methodsFor: 'instance creation' stamp: 'cwp 8/16/2007 12:02'! parent: aNode ^ self new setParent: aNode! ! !OBFan methodsFor: 'accessing' stamp: 'cwp 8/20/2007 00:27'! allChildren ^ parent metaNode allChildrenForNode: parent.! ! !OBFan methodsFor: 'selecting' stamp: 'lr 2/12/2009 10:32'! ancestorOf: aNode from: aCollection in: aBlock aCollection keysAndValuesDo: [ :index :node | (node isAncestorOf: aNode using: node metaNode ancestrySelector) ifTrue: [ aBlock value: index. ^ node ] ]. ^ nil! ! !OBFan methodsFor: 'selecting' stamp: 'cwp 8/20/2007 15:59'! ancestorOf: aNode in: aBlock | ancestor | ancestor := self ancestorOf: aNode from: children in: aBlock. ancestor ifNil: [ancestor := parent childAncestorOf: aNode indexIn: aBlock. self refresh]. ancestor ifNil: [aBlock value: 0]. ^ancestor! ! !OBFan methodsFor: 'accessing' stamp: 'lr 3/4/2009 09:33'! autoSelection | auto | auto := parent. auto isNil ifFalse: [ auto := auto metaNode autoSelect ]. ^ auto isNil ifFalse: [ auto fan: self. auto autoSelection ]! ! !OBFan methodsFor: 'accessing' stamp: 'dr 9/17/2008 12:13'! childAt: index ^ self children at: index ifAbsent: [nil]! ! !OBFan methodsFor: 'accessing' stamp: 'lr 5/28/2010 21:25'! children ^ children ifNil: [ #() ]! ! !OBFan methodsFor: 'accessing' stamp: 'jk 4/7/2008 10:29'! childrenAt: index ^ self children! ! !OBFan methodsFor: 'column' stamp: 'lr 3/4/2009 09:23'! columnAfter: aColumn selection: anInteger | node | node := self childAt: anInteger. ^ node isNil ifFalse: [node columnAfter: aColumn withFan: self selection: anInteger]! ! !OBFan methodsFor: 'selecting' stamp: 'jk 3/23/2008 11:13'! displayStringForChild: aNode ^ self parent displayStringForChild: aNode! ! !OBFan methodsFor: 'selecting' stamp: 'jk 3/23/2008 11:14'! displayStringForChildAt: index ^ self displayStringForChild: (self children at: index ifAbsent: [^''])! ! !OBFan methodsFor: 'accessing' stamp: 'dr 9/17/2008 11:21'! iconAt: index ^ (self children at: index ifAbsent: [^nil]) icon! ! !OBFan methodsFor: 'testing' stamp: 'jk 3/26/2008 12:27'! includesNode: aNode ^ self children includes: aNode! ! !OBFan methodsFor: 'selecting' stamp: 'cwp 8/16/2007 21:50'! indexOf: aNode | index | index := children indexOf: aNode. index = 0 ifTrue: [index := self children indexOf: (self children detect: [:ea | ea name = aNode name] ifNone: [nil])]. ^index! ! !OBFan methodsFor: 'testing' stamp: 'jk 3/23/2008 10:55'! isEmpty ^ self parent isNil! ! !OBFan methodsFor: 'selecting' stamp: 'jk 3/23/2008 11:12'! list ^ self children collect: [ :e | self displayStringForChild: e ]! ! !OBFan methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:32'! listSize ^ self children isNil ifTrue: [ 0 ] ifFalse: [ self children size ]! ! !OBFan methodsFor: 'accessing' stamp: 'jk 3/23/2008 11:08'! nodeAt: index ^ self children at: index ifAbsent: []! ! !OBFan methodsFor: 'accessing' stamp: 'dr 9/17/2008 12:05'! nodeForItem: aString ^ self children detect: [ :child | (self parent displayStringForChild: child) = aString ] ifNone: [ aString ]! ! !OBFan methodsFor: 'selecting' stamp: 'jk 3/23/2008 11:28'! noteChild: aNode self parent noteChild: aNode! ! !OBFan methodsFor: 'accessing' stamp: 'cwp 8/16/2007 11:56'! parent ^ parent! ! !OBFan methodsFor: 'accessing' stamp: 'jk 4/7/2008 10:25'! parentAt: index ^ self parent! ! !OBFan methodsFor: 'printing' stamp: 'jk 4/2/2008 12:44'! printOn: aStream aStream nextPutAll: 'Fan<'. self parent name printOn: aStream. aStream nextPutAll: ', '. self children size printOn: aStream. aStream nextPut: $>! ! !OBFan methodsFor: 'accessing' stamp: 'lr 5/28/2010 20:48'! refresh | oldChildren | oldChildren := children. children := parent childNodes. ^ children ~= oldChildren! ! !OBFan methodsFor: 'initialize-release' stamp: 'lr 5/28/2010 20:48'! setDefaultParent: aNode self setParent: aNode children: aNode childNodes. ! ! !OBFan methodsFor: 'initialize-release' stamp: 'dr 9/15/2008 16:21'! setParent: aNode self setParent: aNode children: aNode childNodes. ! ! !OBFan methodsFor: 'initialize-release' stamp: 'dr 9/17/2008 10:55'! setParent: aNode children: aCollection parent := aNode. children := aCollection.! ! !OBFan methodsFor: 'accessing' stamp: 'cwp 8/16/2007 21:37'! switchFilter ^ parent metaNode switchFilter! ! Object subclass: #OBFilter instanceVariableNames: 'metaNode' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Filters'! !OBFilter commentStamp: 'cwp 3/4/2004 21:53' prior: 0! A browser's metagraph defines the way in which the user may traverse the graph of objects which make up the browser's domain. But it's not always desirable to have all the nodes made available by the metagraph to be visible in the browser. An filter provides a strategy for filtering out some of the nodes from the display. OBFilter provides a "null" filter - one that does no filtering at all - and serves as a superclass for other filters. ! !OBFilter methodsFor: 'user interface' stamp: 'cwp 10/24/2006 10:18'! buildOn: aBuilder ! ! !OBFilter methodsFor: 'filtering' stamp: 'lr 4/3/2009 14:48'! clickIconColumn: aColumn forNode: aNode ^ false! ! !OBFilter methodsFor: 'filtering' stamp: 'cwp 5/20/2007 01:56'! displayString: aString forNode: aNode ^ aString! ! !OBFilter methodsFor: 'filtering' stamp: 'cwp 5/20/2007 20:05'! displayString: aString forParent: pNode child: cNode ^ aString! ! !OBFilter methodsFor: 'filtering' stamp: 'cwp 5/6/2007 01:53'! edgesFrom: aCollection forNode: aNode ^ aCollection! ! !OBFilter methodsFor: 'filtering' stamp: 'cwp 7/23/2007 01:08'! icon: aSymbol forNode: aNode ^ aSymbol! ! !OBFilter methodsFor: 'callbacks' stamp: 'dr 3/23/2009 15:39'! longDescriptionsForNode: aNode ^#()! ! !OBFilter methodsFor: 'accessing' stamp: 'cwp 2/11/2004 23:48'! metaNode ^ metaNode! ! !OBFilter methodsFor: 'filtering' stamp: 'cwp 5/6/2007 01:53'! nodesFrom: aCollection forNode: aNode ^ aCollection! ! !OBFilter methodsFor: 'filtering' stamp: 'cwp 5/8/2007 00:10'! noteParent: pNode child: cNode! ! !OBFilter methodsFor: 'initalizing' stamp: 'lr 7/3/2009 22:27'! setMetaNode: aMetaNode metaNode := aMetaNode! ! !OBFilter methodsFor: 'testing' stamp: 'cwp 2/9/2004 21:06'! wantsButton ^ false! ! !OBFilter methodsFor: 'testing' stamp: 'cwp 5/17/2007 23:07'! wantsSwitch ^ false! ! OBFilter subclass: #OBModalFilter instanceVariableNames: 'selection' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Filters'! !OBModalFilter commentStamp: 'cwp 1/7/2005 23:39' prior: 0! OBModalFilter is used to implement the 'instance/?/class' buttons in a standard class browser. In functional terms it filters the nodes of a column according to the edge of the metagraph that they correspond to. OBModalFilter displays an OBRadioButtonBar in its column's pane, with one button per edge. Only nodes from the currently selected edge are allowed in the column. iVars: selection - the currently selected edge! !OBModalFilter methodsFor: 'callbacks' stamp: 'cwp 5/17/2007 22:57'! activate ! ! !OBModalFilter methodsFor: 'filtering' stamp: 'dr 9/15/2008 15:17'! edgesFrom: aCollection forNode: aNode ^ Array with: (aCollection at: self selection)! ! !OBModalFilter methodsFor: 'callbacks' stamp: 'lr 5/28/2010 20:50'! list ^ metaNode edges collect: [:edge | edge label]! ! !OBModalFilter methodsFor: 'callbacks' stamp: 'cwp 7/14/2007 10:32'! listForNode: aNode ^ self list! ! !OBModalFilter methodsFor: 'filtering' stamp: 'lr 5/28/2010 20:50'! noteParent: pNode child: cNode pNode metaNode edges keysAndValuesDo: [ :index :edge | cNode metaNode = edge metaNode ifTrue: [ selection := index ] ]! ! !OBModalFilter methodsFor: 'callbacks' stamp: 'lr 7/3/2009 22:27'! selection ^ selection ifNil: [ selection := 1 ]! ! !OBModalFilter methodsFor: 'callbacks' stamp: 'dr 10/19/2008 10:47'! selection: anInteger selection := anInteger. self changed: #selection. ! ! !OBModalFilter methodsFor: 'queries' stamp: 'cwp 2/9/2004 21:08'! wantsButton ^ true! ! !OBModalFilter methodsFor: 'testing' stamp: 'cwp 5/17/2007 23:07'! wantsSwitch ^ true! ! OBFilter subclass: #OBPluggableFilter instanceVariableNames: 'edges nodeDisplay nodes note icon parentDisplay' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Filters'! !OBPluggableFilter methodsFor: 'filtering' stamp: 'lr 3/4/2009 08:32'! displayString: aString forNode: aNode ^ nodeDisplay isNil ifTrue: [ super displayString: aString forNode: aNode ] ifFalse: [ nodeDisplay value: aString value: aNode ]! ! !OBPluggableFilter methodsFor: 'filtering' stamp: 'lr 3/4/2009 08:32'! displayString: aString forParent: pNode child: cNode ^ parentDisplay isNil ifTrue: [ super displayString: aString forParent: pNode child: cNode ] ifFalse: [ parentDisplay value: aString value: pNode value: cNode ]! ! !OBPluggableFilter methodsFor: 'accessing' stamp: 'cwp 7/23/2007 01:02'! edges: anObject edges := anObject! ! !OBPluggableFilter methodsFor: 'filtering' stamp: 'lr 3/4/2009 08:32'! edgesFrom: aCollection forNode: aNode ^ edges isNil ifTrue: [ super edgesFrom: aCollection forNode: aNode ] ifFalse: [ edges value: aCollection value: aNode ]! ! !OBPluggableFilter methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! icon: aBlock icon := aBlock! ! !OBPluggableFilter methodsFor: 'filtering' stamp: 'lr 3/4/2009 08:32'! icon: aSymbol forNode: aNode ^ icon isNil ifTrue: [ super icon: aSymbol forNode: aNode ] ifFalse: [ icon value: aSymbol value: aNode ]! ! !OBPluggableFilter methodsFor: 'accessing' stamp: 'cwp 7/23/2007 00:41'! nodeDisplay: anObject nodeDisplay := anObject! ! !OBPluggableFilter methodsFor: 'accessing' stamp: 'cwp 7/23/2007 00:41'! nodes: anObject nodes := anObject! ! !OBPluggableFilter methodsFor: 'filtering' stamp: 'lr 3/4/2009 08:32'! nodesFrom: aCollection forNode: aNode ^ nodes isNil ifTrue: [ super nodesFrom: aCollection forNode: aNode ] ifFalse: [ nodes value: aCollection value: aNode ]! ! !OBPluggableFilter methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! note: aBlock note := aBlock! ! !OBPluggableFilter methodsFor: 'filtering' stamp: 'lr 3/4/2009 08:32'! noteParent: pNode child: cNode ^ note isNil ifTrue: [ super noteParent: pNode child: cNode ] ifFalse: [ note value: pNode value: cNode ]! ! !OBPluggableFilter methodsFor: 'accessing' stamp: 'lr 3/13/2010 17:22'! parentDisplay: anObject parentDisplay := anObject! ! OBFilter subclass: #OBRescueFilter instanceVariableNames: 'cache rescued' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Filters'! !OBRescueFilter methodsFor: 'filtering' stamp: 'lr 11/2/2009 08:07'! cache: aCollection for: aNode | cached missing inclusionSet | cached := cache at: aNode ifAbsent: [ ^ self initCache: aCollection for: aNode ]. cache at: aNode put: aCollection. missing := rescued at: aNode ifAbsent: [ Set new ]. inclusionSet := aCollection asSet. missing removeAllSuchThat: [ :ea | inclusionSet includes: ea ]. cached do: [ :ea | (inclusionSet includes: ea) ifFalse: [ missing add: ea ] ]. missing isEmpty ifFalse: [ rescued at: aNode put: missing ]. ^ missing asArray! ! !OBRescueFilter methodsFor: 'filtering' stamp: 'cwp 7/17/2007 02:20'! displayString: aString forParent: pNode child: cNode ^ ((rescued at: pNode ifAbsent: [#()]) includes: cNode) ifTrue: [aString asText addAttribute: TextEmphasis struckOut] ifFalse: [aString]! ! !OBRescueFilter methodsFor: 'filtering' stamp: 'cwp 7/19/2007 01:06'! initCache: aCollection for: aNode cache at: aNode put: aCollection. ^ #()! ! !OBRescueFilter methodsFor: 'private' stamp: 'lr 7/3/2009 22:27'! initialize cache := Dictionary new. rescued := Dictionary new! ! !OBRescueFilter methodsFor: 'filtering' stamp: 'cwp 7/17/2007 01:58'! nodesFrom: aCollection forNode: aNode ^ aCollection, (self cache: aCollection for: aNode)! ! Object subclass: #OBList instanceVariableNames: 'column selection fan' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBList class methodsFor: 'instance creation' stamp: 'dr 9/12/2008 10:40'! column: aFan ^self new column: aFan! ! !OBList class methodsFor: 'instance creation' stamp: 'dr 9/12/2008 10:34'! fan: aFan ^self new fan: aFan! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/22/2008 22:25'! autoSelection ^ self fan autoSelection! ! !OBList methodsFor: 'nodes' stamp: 'jk 4/7/2008 10:30'! children ^ self fan childrenAt: self selection! ! !OBList methodsFor: 'selecting' stamp: 'jk 3/23/2008 10:45'! clearAll self clearFan. self clearSelection! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/22/2008 22:39'! clearFan self fan: nil! ! !OBList methodsFor: 'selecting' stamp: 'lr 5/28/2010 21:40'! clearSelection selection := 0! ! !OBList methodsFor: 'nodes' stamp: 'lr 4/3/2009 14:49'! clickIconAt: anInteger | node | node := self fan nodeAt: anInteger. node isNil ifFalse: [ node metaNode clickIconColumn: column forNode: node ]! ! !OBList methodsFor: 'accessing' stamp: 'dr 9/12/2008 10:40'! column: aColumn column := aColumn! ! !OBList methodsFor: 'selecting' stamp: 'lr 5/28/2010 21:37'! defaultSelection ^ 1! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/23/2008 11:14'! displayStringForChild: aNode ^ self fan displayStringForChild: aNode! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/23/2008 11:13'! displayStringForChildAt: index ^ self fan displayStringForChildAt: index! ! !OBList methodsFor: 'nodes' stamp: 'lr 3/14/2010 09:55'! doubleClick (self selectedNode notNil and: [ self selectedNode metaNode doubleClickSelector notNil ]) ifTrue: [ self selectedNode perform: self selectedNode metaNode doubleClickSelector withEnoughArguments: (Array with: column) ]! ! !OBList methodsFor: 'accessing' stamp: 'lr 8/19/2009 22:21'! fan ^ fan ifNil: [ fan := OBFan new ] ! ! !OBList methodsFor: 'accessing' stamp: 'dr 9/17/2008 10:24'! fan: anObject fan := anObject! ! !OBList methodsFor: 'selecting' stamp: 'dr 12/15/2008 18:48'! fan: aFan selection: index self fan: aFan. self selection: index! ! !OBList methodsFor: 'testing' stamp: 'lr 5/28/2010 21:40'! hasSelection ^ selection > 0! ! !OBList methodsFor: 'accessing' stamp: 'jk 3/23/2008 10:19'! iconAt: index ^ self fan iconAt: index! ! !OBList methodsFor: 'nodes' stamp: 'dr 11/12/2008 10:14'! includes: aNode ^ self fan includes: aNode ! ! !OBList methodsFor: 'nodes - testing' stamp: 'jk 3/22/2008 22:17'! includesNode: aNode ^ self fan includesNode: aNode! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/23/2008 10:17'! indexOf: aNode ^ self fan indexOf: aNode! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/22/2008 22:25'! isEmpty ^ self fan isEmpty! ! !OBList methodsFor: 'nodes' stamp: 'dr 9/12/2008 10:42'! list ^self fan list! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/22/2008 22:40'! listSize ^ self fan listSize! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/22/2008 22:18'! nodeForItem: aString ^ self fan nodeForItem: aString! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/22/2008 22:23'! noteChild: aNode self fan noteChild: aNode! ! !OBList methodsFor: 'nodes' stamp: 'jk 4/7/2008 10:26'! parent ^ self fan parentAt: self selection! ! !OBList methodsFor: 'nodes' stamp: 'lr 3/4/2009 08:31'! parent: aNode aNode isNil ifFalse: [ self fan setDefaultParent: aNode ]! ! !OBList methodsFor: 'nodes - testing' stamp: 'lr 7/18/2010 15:16'! refresh | node result | node := self selectedNode. result := self fan refresh. result ifTrue: [ self select: node ]. ^ result! ! !OBList methodsFor: 'selecting' stamp: 'jk 3/23/2008 11:03'! select: aNode self selection: (self fan indexOf: aNode)! ! !OBList methodsFor: 'selecting' stamp: 'jk 3/23/2008 11:07'! selectSilently: aNode self selection: (self fan indexOf: aNode)! ! !OBList methodsFor: 'nodes' stamp: 'jk 4/4/2008 08:57'! selectedNode ^ self fan nodeAt: self selection! ! !OBList methodsFor: 'selecting' stamp: 'lr 5/28/2010 21:37'! selection ^ selection ifNil: [ selection := self defaultSelection ]! ! !OBList methodsFor: 'selecting' stamp: 'lr 5/28/2010 21:38'! selection: anInteger selection := anInteger! ! !OBList methodsFor: 'nodes' stamp: 'jk 3/22/2008 22:24'! switchFilter ^ self fan switchFilter! ! Object subclass: #OBMetaEdge instanceVariableNames: 'label selector metaNode' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBMetaEdge commentStamp: 'cwp 1/7/2005 23:20' prior: 0! An OBMetaEdge is an edge in the browser's metagraph. It represents a message sent to a node to obtain further nodes. It is refered to by the "parent" metanode, and refers to the "child" metanode. iVars: label - a string describing the metaNode, for filters which allow the user to choose which edges to follow selector - when a node is selected by the user, this message will be sent to it to obtain its children metaNode - a MetaNode corresponding to the nodes answered by the above message ! !OBMetaEdge class methodsFor: 'instance creation' stamp: 'cwp 2/7/2004 22:35'! label: aString selector: aSelector metaNode: aMetaNode ^ self new setLabel: aString selector: aSelector metaNode: aMetaNode! ! !OBMetaEdge class methodsFor: 'instance creation' stamp: 'cwp 5/4/2007 22:53'! selector: aSymbol ^ self selector: aSymbol metaNode: nil! ! !OBMetaEdge class methodsFor: 'instance creation' stamp: 'cwp 2/9/2004 22:32'! selector: aSelector metaNode: aMetaNode ^ self new setLabel: aSelector asString selector: aSelector metaNode: aMetaNode! ! !OBMetaEdge methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! -> aNode metaNode := aNode! ! !OBMetaEdge methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! / aString label := aString! ! !OBMetaEdge methodsFor: 'accessing' stamp: 'cwp 2/7/2004 22:40'! label ^ label! ! !OBMetaEdge methodsFor: 'accessing' stamp: 'cwp 2/7/2004 22:40'! metaNode ^ metaNode! ! !OBMetaEdge methodsFor: 'accessing' stamp: 'cwp 3/3/2004 00:12'! nodesForParent: aNode ^ (aNode perform: selector) do: [:ea | ea metaNode: metaNode] ! ! !OBMetaEdge methodsFor: 'printing' stamp: 'lr 11/13/2008 13:38'! printOn: aStream aStream nextPutAll: selector printString; nextPutAll: '->'. metaNode shortPrintOn: aStream! ! !OBMetaEdge methodsFor: 'accessing' stamp: 'cwp 2/7/2004 22:40'! selector ^ selector! ! !OBMetaEdge methodsFor: 'initializing' stamp: 'lr 7/3/2009 22:27'! setLabel: aString selector: aSelector metaNode: aMetaNode label := aString. selector := aSelector. metaNode := aMetaNode! ! Object subclass: #OBMetaNode instanceVariableNames: 'name filters edges autoSelect ancestrySelector displaySelector doubleClickSelector' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBMetaNode commentStamp: 'cwp 1/7/2005 23:23' prior: 0! A MetaNode represents a hypothetical node in the browser's domain graph. iVars: filterClass - the class used to filter this hypothetical node's children columnClass - the class of column used to display this node's children edges - messages that could be sent to the node to obtain children actors - providers of functionality for manipulating the node displaySelector - the message used to retreive a nodes display name! !OBMetaNode class methodsFor: 'instance creation' stamp: 'cwp 3/6/2004 21:06'! named: aString ^ self new name: aString! ! !OBMetaNode class methodsFor: 'instance creation' stamp: 'cwp 3/3/2004 23:08'! new ^ self basicNew initialize! ! !OBMetaNode methodsFor: 'children' stamp: 'cwp 5/4/2007 22:54'! - aSelector ^ edges add: (OBMetaEdge selector: aSelector). ! ! !OBMetaNode methodsFor: 'accessing' stamp: 'cwp 5/18/2007 00:20'! addFilter: aFilter aFilter setMetaNode: self. filters add: aFilter! ! !OBMetaNode methodsFor: 'nodes' stamp: 'cwp 5/7/2007 23:01'! allChildrenForNode: aNode ^ edges gather: [:edge | edge nodesForParent: aNode]! ! !OBMetaNode methodsFor: 'accessing' stamp: 'cwp 5/11/2007 00:40'! ancestrySelector ^ ancestrySelector ifNil: [#isDescendantOf:]! ! !OBMetaNode methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! ancestrySelector: anObject ancestrySelector := anObject! ! !OBMetaNode methodsFor: 'accessing' stamp: 'dr 1/28/2009 15:39'! autoSelect ^ autoSelect! ! !OBMetaNode methodsFor: 'accessing' stamp: 'dr 1/28/2009 15:11'! autoSelect: anAutoSelection autoSelect := anAutoSelection! ! !OBMetaNode methodsFor: 'children' stamp: 'cwp 2/9/2004 20:28'! childAt: aSelector labeled: aString put: aMetaNode edges add: (OBMetaEdge label: aString selector: aSelector metaNode: aMetaNode)! ! !OBMetaNode methodsFor: 'children' stamp: 'jk 4/2/2008 12:18'! childAt: aSelector put: aMetaNode ^ edges add: (OBMetaEdge selector: aSelector metaNode: aMetaNode)! ! !OBMetaNode methodsFor: 'nodes' stamp: 'lr 2/12/2009 10:32'! childOf: parent ancestorOf: descendant indexIn: aBlock (self childsPerEdgeFor: parent) do: [ :childsPerEdge | childsPerEdge keysAndValuesDo: [ :index :node | (node isAncestorOf: descendant using: node metaNode ancestrySelector) ifTrue: [ filters do: [ :f | f noteParent: parent child: node ]. aBlock value: index. ^ node ] ] ]. ^ nil! ! !OBMetaNode methodsFor: 'children' stamp: 'cwp 2/7/2004 22:44'! children ^ edges collect: [:edge | edge metaNode]! ! !OBMetaNode methodsFor: 'nodes' stamp: 'dr 3/5/2008 14:11'! childrenForNode: aNode | chosenEdges | chosenEdges := self edgesForNode: aNode. ^ chosenEdges gather: [:edge | filters inject: (edge nodesForParent: aNode) into: [:list :filter | filter nodesFrom: list forNode: aNode]].! ! !OBMetaNode methodsFor: 'children' stamp: 'dc 12/15/2007 16:08'! childsPerEdgeFor: aNode "collects all childs and returns an array with one list of childs per edge. all filters are applied to the child lists." ^ edges collect: [:edge | filters inject: (edge nodesForParent: aNode) into: [:list :filter | filter nodesFrom: list forNode: aNode]].! ! !OBMetaNode methodsFor: 'filtering' stamp: 'lr 4/3/2009 14:49'! clickIconColumn: aColumn forNode: aNode filters do: [ :each | (each clickIconColumn: aColumn forNode: aNode) ifTrue: [ ^ self ] ]! ! !OBMetaNode methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! displaySelector ^ displaySelector ifNil: [ displaySelector := #name ]! ! !OBMetaNode methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! displaySelector: aSelector displaySelector := aSelector! ! !OBMetaNode methodsFor: 'filtering' stamp: 'cwp 5/20/2007 01:51'! displayStringForNode: aNode ^ filters inject: (aNode perform: self displaySelector) into: [:string :filter | filter displayString: string forNode: aNode]! ! !OBMetaNode methodsFor: 'filtering' stamp: 'cwp 5/20/2007 20:05'! displayStringForParent: pNode child: cNode ^ filters inject: cNode displayString into: [:string :filter | filter displayString: string forParent: pNode child: cNode]! ! !OBMetaNode methodsFor: 'accessing' stamp: 'lr 4/3/2009 13:36'! doubleClickSelector ^ doubleClickSelector! ! !OBMetaNode methodsFor: 'accessing' stamp: 'lr 4/3/2009 13:36'! doubleClickSelector: aSymbol doubleClickSelector := aSymbol! ! !OBMetaNode methodsFor: 'accessing' stamp: 'dr 5/14/2008 15:16'! edges ^edges! ! !OBMetaNode methodsFor: 'accessing' stamp: 'lr 5/28/2010 18:18'! edgesForNode: aNode ^ filters inject: edges into: [ :list :filter | filter edgesFrom: list forNode: aNode ]! ! !OBMetaNode methodsFor: 'accessing' stamp: 'lr 5/21/2007 13:24'! filters ^ filters! ! !OBMetaNode methodsFor: 'children' stamp: 'cwp 2/7/2004 22:38'! hasChildren ^ edges isEmpty not! ! !OBMetaNode methodsFor: 'filtering' stamp: 'dr 6/27/2008 14:53'! iconForNode: aNode ^ filters inject: nil into: [:icon :filter | filter icon: icon forNode: aNode]! ! !OBMetaNode methodsFor: 'initializing' stamp: 'lr 7/3/2009 22:27'! initialize filters := OrderedCollection new. edges := OrderedCollection new! ! !OBMetaNode methodsFor: 'filtering' stamp: 'cwp 2/9/2004 21:00'! metaNode ^ self! ! !OBMetaNode methodsFor: 'accessing' stamp: 'cwp 3/6/2004 21:54'! name ^ name ifNil: ['MetaNode']! ! !OBMetaNode methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! name: aString name := aString! ! !OBMetaNode methodsFor: 'nodes' stamp: 'cwp 3/3/2004 00:22'! nodesForParent: aNode ^ edges gather: [:edge | edge nodesForParent: aNode]! ! !OBMetaNode methodsFor: 'nodes' stamp: 'cwp 5/8/2007 00:14'! noteParent: pNode child: cNode filters do: [:ea | ea noteParent: pNode child: cNode]! ! !OBMetaNode methodsFor: 'printing' stamp: 'lr 2/12/2009 10:32'! printOn: aStream aStream nextPutAll: self name; nextPut: Character cr. edges do: [ :e | e printOn: aStream. aStream nextPut: Character cr ]! ! !OBMetaNode methodsFor: 'printing' stamp: 'dvf 8/16/2005 10:01'! shortPrintOn: aStream aStream nextPutAll: self name.! ! !OBMetaNode methodsFor: 'filtering' stamp: 'EL 12/13/2008 11:51'! switchFilter ^ filters detect: [:ea | ea wantsSwitch] ifNone: [nil]! ! Object subclass: #OBNode instanceVariableNames: 'metaNode' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBNode commentStamp: 'cwp 3/4/2004 22:20' prior: 0! A node is a wrapper for an object in the browser's domain graph. OBNode is an abstract superclass for concrete nodes which might appear in the browser. iVars: metaNode - the MetaNode which produced this node! OBNode subclass: #OBCollectionNode instanceVariableNames: 'name collection' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Nodes'! !OBCollectionNode commentStamp: 'cwp 1/7/2005 23:31' prior: 0! OBCollectionNode is a trivial wrapper for a collection of nodes. It is typically used as an artificial root node for metagraphs that have no natural root.! !OBCollectionNode class methodsFor: 'instance creation' stamp: 'cwp 3/15/2004 23:17'! on: aCollection ^ self new setCollection: aCollection! ! !OBCollectionNode class methodsFor: 'instance creation' stamp: 'cwp 12/24/2007 02:48'! on: aCollection named: aString ^ (self on: aCollection) name: aString; yourself! ! !OBCollectionNode methodsFor: 'navigating' stamp: 'lr 7/3/2009 22:27'! addChild: aNode (collection includes: aNode) ifFalse: [ collection := collection copyWith: aNode ]! ! !OBCollectionNode methodsFor: 'navigating' stamp: 'cwp 3/15/2004 23:19'! children ^ collection! ! !OBCollectionNode methodsFor: 'ancestry' stamp: 'dr 9/18/2008 10:09'! isAncestorOf: aNode ^ collection anySatisfy: [:ea | ea = aNode or: [ea isAncestorOf: aNode]]! ! !OBCollectionNode methodsFor: 'displaying' stamp: 'cwp 12/24/2007 02:34'! name ^ name ifNil: [collection species name]! ! !OBCollectionNode methodsFor: 'displaying' stamp: 'lr 7/3/2009 22:27'! name: aString name := aString! ! !OBCollectionNode methodsFor: 'navigating' stamp: 'lr 7/3/2009 22:27'! removeChild: aNode (collection includes: aNode) ifTrue: [ collection := collection copyWithout: aNode ]! ! !OBCollectionNode methodsFor: 'initalizing' stamp: 'lr 7/3/2009 22:27'! setCollection: aCollection collection := aCollection! ! !OBNode methodsFor: 'comparing' stamp: 'cwp 1/31/2004 14:57'! = other ^ self class = other class and: [self name = other name]! ! !OBNode methodsFor: 'public' stamp: 'cwp 2/29/2004 13:49'! accept: aText notifying: aController ^ self text: aText! ! !OBNode methodsFor: 'ancestry' stamp: 'cwp 3/3/2004 00:44'! ancestrySelector ^ #isDescendantOf: ! ! !OBNode methodsFor: 'updating' stamp: 'lr 3/4/2009 09:34'! announce: anObject | announcer | ^ (announcer := OBAnnouncer current) isNil ifFalse: [ announcer announce: anObject ]! ! !OBNode methodsFor: 'updating' stamp: 'cwp 3/13/2007 00:18'! announceChangedWith: anObject anObject announce: (OBNodeChanged node: self)! ! !OBNode methodsFor: 'updating' stamp: 'cwp 3/13/2007 00:21'! announceDeletionWith: anObject anObject announce: (OBNodeDeleted node: self) ! ! !OBNode methodsFor: 'updating' stamp: 'cwp 3/13/2007 00:34'! announceSelectionWith: anObject (anObject announce: OBAboutToChange) isVetoed ifFalse: [anObject announce: (OBSelectingNode node: self)]! ! !OBNode methodsFor: 'converting' stamp: 'cwp 8/18/2007 18:09'! asFan ^ OBFan parent: self! ! !OBNode methodsFor: 'public' stamp: 'cwp 8/20/2007 15:46'! childAncestorOf: aNode indexIn: aBlock ^ self metaNode childOf: self ancestorOf: aNode indexIn: aBlock! ! !OBNode methodsFor: 'public' stamp: 'dr 9/15/2008 11:46'! childNodes ^ metaNode childrenForNode: self! ! !OBNode methodsFor: 'navigation' stamp: 'lr 5/28/2010 21:29'! columnAfter: aColumn withFan: aFan selection: aSmallInteger ^ aColumn nextColumnForDefaultNavigationWithFan: aFan selection: aSmallInteger! ! !OBNode methodsFor: 'public' stamp: 'cwp 3/22/2004 20:48'! definition ^ self! ! !OBNode methodsFor: 'updating' stamp: 'cwp 6/4/2006 01:06'! demandSelection ^ OBAnnouncer current announce: (OBNodeCreated node: self)! ! !OBNode methodsFor: 'displaying' stamp: 'cwp 5/20/2007 01:57'! displayString ^ metaNode displayStringForNode: self! ! !OBNode methodsFor: 'displaying' stamp: 'cwp 5/20/2007 20:02'! displayStringForChild: aNode ^ metaNode displayStringForParent: self child: aNode! ! !OBNode methodsFor: 'comparing' stamp: 'cwp 1/31/2004 14:57'! hash ^ self name hash! ! !OBNode methodsFor: 'displaying' stamp: 'cwp 7/23/2007 01:45'! icon ^ metaNode iconForNode: self! ! !OBNode methodsFor: 'ancestry' stamp: 'cwp 5/11/2007 00:18'! isAncestorOf: aNode ^ self isAncestorOf: aNode using: self ancestrySelector! ! !OBNode methodsFor: 'ancestry' stamp: 'cwp 5/11/2007 00:53'! isAncestorOf: aNode using: aSelector ^ aNode perform: aSelector with: self! ! !OBNode methodsFor: 'ancestry' stamp: 'cwp 3/3/2004 00:44'! isDescendantOf: aNode ^ false! ! !OBNode methodsFor: 'accessing' stamp: 'cwp 3/3/2004 23:24'! metaNode ^ metaNode! ! !OBNode methodsFor: 'accessing' stamp: 'dr 9/17/2008 13:49'! metaNode: aMetaNode metaNode := aMetaNode! ! !OBNode methodsFor: 'public' stamp: 'cwp 12/10/2003 22:27'! name self subclassResponsibility! ! !OBNode methodsFor: 'public' stamp: 'cwp 5/18/2007 20:33'! noteChild: aNode metaNode noteParent: self child: aNode! ! !OBNode methodsFor: 'utility' stamp: 'lr 7/3/2009 22:27'! referenceForMethod: selector ofClass: className | classIsMeta symbol | classIsMeta := className endsWith: ' class'. symbol := classIsMeta ifTrue: [ (className allButLast: 6) asSymbol ] ifFalse: [ className ]. ^ MethodReference new setClassSymbol: symbol classIsMeta: classIsMeta methodSymbol: selector stringVersion: symbol , '>>' , selector! ! !OBNode methodsFor: 'updating' stamp: 'cwp 6/4/2006 12:15'! signalChanged self announce: (OBNodeChanged node: self)! ! !OBNode methodsFor: 'updating' stamp: 'cwp 6/4/2006 12:15'! signalChildrenChanged self announce: (OBChildrenChanged node: self)! ! !OBNode methodsFor: 'updating' stamp: 'cwp 6/4/2006 12:15'! signalDeletion self announce: (OBNodeDeleted node: self) ! ! !OBNode methodsFor: 'updating' stamp: 'cwp 6/4/2006 13:59'! signalSelection (self announce: OBAboutToChange) isVetoed ifFalse: [self announce: (OBSelectingNode node: self)]! ! !OBNode methodsFor: 'public' stamp: 'cwp 12/7/2003 19:27'! text ^ ''! ! !OBNode methodsFor: 'public' stamp: 'cwp 3/14/2004 14:09'! text: aText ^ false! ! !OBNode methodsFor: 'public' stamp: 'cwp 2/29/2004 18:30'! textSelection ^ 1 to: 0! ! !OBNode methodsFor: 'displaying' stamp: 'cwp 8/28/2004 00:14'! title ^ nil! ! Object subclass: #OBPanel instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Panels'! !OBPanel commentStamp: 'cwp 1/7/2005 23:23' prior: 0! A panel is an object that manages part of the browser's window. It provides a protocol for receiving notifications when the current domain node changes, and reacts to these changes.! OBPanel subclass: #OBColumnPanel instanceVariableNames: 'root current columns minPanes maxPanes' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Panels'! !OBColumnPanel commentStamp: 'cwp 12/6/2004 23:50' prior: 0! OBColumnPanel handles navigation around the nodes of the object graph. It maintains a list of columns, which track the user's path through the node tree. As nodes are selected, additional columns are added to the list, which appear as panes on the right of the panel. iVars: columns - A collection of OBColumns, each of which manages a single pane in the scroller. minPanes - The minimum number of panes that should ever be visible. maxPanes - The maximum number of panes that should ever be visible. ! !OBColumnPanel class methodsFor: 'instance creation' stamp: 'dr 11/17/2008 16:30'! minPanes: min maxPanes: max ^ self basicNew setMinPanes: min maxPanes: max! ! !OBColumnPanel class methodsFor: 'instance creation' stamp: 'dr 11/17/2008 16:30'! new ^ self minPanes: 1 maxPanes: 1 ! ! !OBColumnPanel methodsFor: 'building' stamp: 'cwp 7/25/2007 23:46'! buildOn: aBuilder ^aBuilder scroller: self with: [columns do: [:ea | ea buildOn: aBuilder]]! ! !OBColumnPanel methodsFor: 'accessing columns' stamp: 'lr 3/21/2009 20:02'! clearAfter: aColumn | start | aColumn isNil ifTrue: [ ^ self ]. start := (columns indexOf: aColumn) + 1. start to: columns size do: [ :i | (columns at: i) clear ]! ! !OBColumnPanel methodsFor: 'accessing columns' stamp: 'cwp 2/28/2006 18:12'! columnAfter: aColumn ^ [self columns after: aColumn] on: Error do: [:err | nil] ! ! !OBColumnPanel methodsFor: 'accessing columns' stamp: 'cwp 2/28/2006 19:07'! columnBefore: aColumn ^ self columnBefore: aColumn ifAbsent: [nil] ! ! !OBColumnPanel methodsFor: 'accessing columns' stamp: 'dr 11/12/2008 16:24'! columnBefore: aColumn ifAbsent: aBlock ^ [self columns before: aColumn] on: Error do: [:err | aBlock value] ! ! !OBColumnPanel methodsFor: 'constructing' stamp: 'dr 9/24/2008 10:42'! columnClass ^OBColumn! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'cwp 11/16/2004 21:46'! columns ^columns! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'cwp 11/16/2004 21:46'! columns: anObject columns := anObject! ! !OBColumnPanel methodsFor: 'accessing columns' stamp: 'cwp 11/16/2004 22:22'! currentColumn ^self columns reversed detect: [:ea | ea hasSelection] ifNone: []! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'cwp 7/19/2007 00:55'! currentNode ^ current! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'dr 11/4/2008 19:59'! currentOrRootNode ^ current ifNil: [root] ! ! !OBColumnPanel methodsFor: 'callbacks' stamp: 'cwp 11/26/2004 21:55'! defaultBackgroundColor ^ browser defaultBackgroundColor! ! !OBColumnPanel methodsFor: 'accessing columns' stamp: 'cwp 11/16/2004 23:01'! emptyColumn ^ OBColumn inPanel: self! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'dr 11/4/2008 19:59'! hasSelection ^ false ! ! !OBColumnPanel methodsFor: 'navigating' stamp: 'dr 11/10/2008 16:11'! hopTo: aNode | column | column := self columns last. [ column refreshAndSignal: false; includesNode: aNode ] whileFalse: [ column := self columnBefore: column ifAbsent: [ ^ self jumpTo: aNode ] ]. column select: aNode.! ! !OBColumnPanel methodsFor: 'testing' stamp: 'dr 11/4/2008 19:58'! isNavigation ^ true ! ! !OBColumnPanel methodsFor: 'navigating' stamp: 'dr 10/24/2008 15:03'! jumpTo: aNode | column | self selectAncestorsOf: aNode. column := self columns reversed detect: [:ea | ea selectedNode = aNode] ifNone: [^ self]. self clearAfter: column next. self announcer announce: (OBSelectionChanged column: column)! ! !OBColumnPanel methodsFor: 'navigating' stamp: 'cwp 11/16/2004 23:34'! jumpToRoot ^ self columns first selection: 0! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'lr 8/19/2009 22:26'! labelString | node | self columns reverseDo: [ :each | node := each selectedNode. (node notNil and: [ node title notNil ]) ifTrue: [ ^ node title ] ]. ^ nil! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'cwp 11/16/2004 23:29'! maxPanes ^maxPanes! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'cwp 11/16/2004 22:54'! minPanes ^ minPanes! ! !OBColumnPanel methodsFor: 'updating' stamp: 'lr 2/12/2009 10:32'! nodeDeleted: ann ann node = self root ifFalse: [ ^ self ]. current := nil. self columns first clear. self announcer announce: (OBSelectionChanged column: self)! ! !OBColumnPanel methodsFor: 'updating' stamp: 'cwp 11/23/2004 00:52'! okToReclaimPane columns size > minPanes ifFalse: [^ false]. ^ columns last isEmpty or: [(columns at: columns size - 1) shouldBeLast]. ! ! !OBColumnPanel methodsFor: 'accessing columns' stamp: 'cwp 6/4/2006 00:39'! popColumn self announcer unsubscribe: self columns removeLast. ! ! !OBColumnPanel methodsFor: 'accessing columns' stamp: 'dr 9/24/2008 11:12'! pushColumn: aColumn self columns addLast: aColumn. self changed: #columns. ! ! !OBColumnPanel methodsFor: 'updating' stamp: 'cwp 5/28/2007 01:35'! reclaimPanes | old | old := columns size. [self okToReclaimPane] whileTrue: [self popColumn]. columns size = old ifFalse: [self changed: #columns]! ! !OBColumnPanel methodsFor: 'navigating' stamp: 'dr 11/4/2008 19:59'! root ^root! ! !OBColumnPanel methodsFor: 'navigating' stamp: 'lr 3/4/2009 08:31'! selectAncestorsOf: aNode | subtree | subtree := OBSubtree from: root to: aNode. subtree isNil ifFalse: [ self selectSubtree: subtree ]! ! !OBColumnPanel methodsFor: 'updating' stamp: 'dr 10/21/2008 09:52'! selectNode: announcement ^ self hopTo: announcement node! ! !OBColumnPanel methodsFor: 'navigating' stamp: 'cwp 8/19/2007 23:05'! selectSubtree: aSubtree aSubtree selectInColumns: columns! ! !OBColumnPanel methodsFor: 'accessing columns' stamp: 'lr 3/4/2009 09:29'! selected: aColumn | next | (next := aColumn next) isNil ifFalse: [ next parent: aColumn selectedNode ]! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'cwp 3/11/2007 21:08'! selectedNode ^ self currentNode! ! !OBColumnPanel methodsFor: 'updating' stamp: 'dr 9/18/2008 10:53'! selectionChanged: ann current := ann column selectedNode. self selectionChangedIn: ann column! ! !OBColumnPanel methodsFor: 'updating' stamp: 'cwp 7/19/2007 00:13'! selectionChangedIn: aColumn aColumn hasSelection ifTrue: [self selected: aColumn] ifFalse: [self clearAfter: aColumn]. self reclaimPanes. ! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'lr 11/13/2008 13:38'! selectionPath ^ ((self columns collect: [ :e | e parent ]) select: [ :e | e notNil ]) allButFirst! ! !OBColumnPanel methodsFor: 'initializing' stamp: 'lr 7/3/2009 22:27'! setMetaNode: aMetaNode node: aNode root := aNode. root metaNode: aMetaNode. self pushColumn: (OBColumn inPanel: self metaNode: aMetaNode node: root). minPanes - self columns size timesRepeat: [ self pushColumn: self emptyColumn ]! ! !OBColumnPanel methodsFor: 'initializing' stamp: 'lr 7/3/2009 22:27'! setMinPanes: min maxPanes: max columns := OrderedCollection new. minPanes := min. maxPanes := max! ! !OBColumnPanel methodsFor: 'callbacks' stamp: 'cwp 11/18/2004 00:00'! sizing ^ (columns size max: minPanes) min: maxPanes! ! !OBColumnPanel methodsFor: 'updating' stamp: 'cwp 6/5/2006 01:32'! subscribe self announcer observe: OBSelectingNode send: #selectNode: to: self; observe: OBSelectionChanged send: #selectionChanged: to: self; observe: OBNodeCreated send: #selectNode: to: self; observe: OBNodeDeleted send: #nodeDeleted: to: self.! ! !OBColumnPanel methodsFor: 'building' stamp: 'cwp 3/18/2007 20:36'! vResizing ^ #spaceFill! ! OBPanel subclass: #OBFixedButtonPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Panels'! !OBFixedButtonPanel commentStamp: 'cwp 1/7/2005 23:35' prior: 0! OBFixedButtonPanel displays a horizontal row of buttons. In contrast to OBVarButtonPanel, the buttons do not change as nodes are selected in the navigation panel; instead they are enabled and disabled according to whether the actions they represent are applicable to the selected node.! !OBFixedButtonPanel class methodsFor: 'instance creation' stamp: 'cwp 2/28/2006 10:41'! new ^ self basicNew initialize! ! !OBFixedButtonPanel methodsFor: 'building' stamp: 'cwp 7/25/2007 23:52'! buildOn: aBuilder ^aBuilder fixedButtonBar: self with: []! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'dr 1/30/2009 17:29'! color ^browser defaultBackgroundColor ! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'lr 6/4/2010 14:53'! commands | commands buttons grouped groups | self currentOrRootNode ifNil: [ ^ #() ]. commands := (self announce: OBNodeCommandScan) commandsOn: self currentNode for: self. buttons := commands select: [ :ea | ea wantsButton ]. groups := (buttons collect: [ :ea | ea group ]) asSet asSortedCollection: [ :a :b | a > b ]. grouped := groups collect: [ :ea | (buttons select: [ :b | b group = ea ]) asSortedCollection: [ :a :b | a order <= b order ] ]. ^ grouped gather: [ :ea | ea ]! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'lr 3/13/2010 12:54'! currentNode ^ browser currentNode ! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'lr 3/13/2010 17:04'! currentOrRootNode ^ browser currentOrRootNode! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'lr 3/13/2010 17:05'! isSelected: aNode ^ aNode notNil! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'cwp 3/11/2007 21:14'! selectionChanged: ann self changed: #commands! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'avi 12/4/2007 10:48'! subscribe self announcer observe: OBSelectionChanged send: #selectionChanged: to: self. self announcer observe: OBNodeChanged send: #selectionChanged: to: self. ! ! !OBFixedButtonPanel methodsFor: 'building' stamp: 'cwp 3/18/2007 22:16'! vResizing ^ #rigid! ! !OBPanel class methodsFor: 'instance creation' stamp: 'cwp 8/31/2004 10:46'! inBrowser: aBrowser ^ self new browser: aBrowser! ! !OBPanel methodsFor: 'updating' stamp: 'cwp 10/13/2006 09:29'! announce: aClass ^ self browser announce: aClass! ! !OBPanel methodsFor: 'accessing' stamp: 'cwp 4/17/2006 15:52'! announcer ^ browser announcer! ! !OBPanel methodsFor: 'accessing' stamp: 'cwp 11/16/2004 21:58'! browser ^ browser! ! !OBPanel methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! browser: aBrowser browser := aBrowser. self subscribe! ! !OBPanel methodsFor: 'accessing' stamp: 'dr 2/18/2008 15:28'! definitionPanel ^nil! ! !OBPanel methodsFor: 'testing' stamp: 'dr 5/24/2007 12:20'! isDefinition ^false! ! !OBPanel methodsFor: 'testing' stamp: 'cwp 11/20/2004 21:09'! isNavigation ^ false! ! !OBPanel methodsFor: 'updating' stamp: 'cwp 4/17/2006 19:36'! subscribe! ! OBPanel subclass: #OBTextPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Panels'! OBTextPanel subclass: #OBDefinitionPanel instanceVariableNames: 'definition selection' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Panels'! !OBDefinitionPanel commentStamp: 'cwp 1/7/2005 23:35' prior: 0! OBDefinition serves as the model for the text pane of a typical browser. It's main responsibility is to act as a relay between a PluggableTextMorph and a Definition supplied by the currently selected node. iVars: browser - The browser of which this panel is a part. ! !OBDefinitionPanel methodsFor: 'updating' stamp: 'lr 7/31/2010 19:42'! aboutToChange: anAnnouncement | ok | self canDiscardEdits ifTrue: [ ^ self ]. ok := OBConfirmationRequest prompt: 'Changes have not been saved. Is it ok to discard those changes?' confirm: 'Discard' cancel: 'Cancel'. (ok isNil not and: [ ok ]) ifTrue: [ self changed: #clearUserEdits ] ifFalse: [ anAnnouncement veto ]! ! !OBDefinitionPanel methodsFor: 'updating' stamp: 'cwp 3/3/2007 23:11'! aboutToChangeSilently: ann self canDiscardEdits ifFalse: [ann veto]! ! !OBDefinitionPanel methodsFor: 'callbacks' stamp: 'cwp 6/4/2006 00:41'! accept: aText notifying: aController ^ self withDefinitionDo: [:def | [def accept: aText notifying: aController] on: OBAnnouncerRequest do: [:notification | notification resume: self announcer]] ifNil: [true]! ! !OBDefinitionPanel methodsFor: 'building' stamp: 'cwp 7/25/2007 23:48'! buildOn: aBuilder ^aBuilder textarea: self with: []! ! !OBDefinitionPanel methodsFor: 'accessing' stamp: 'lr 4/3/2010 17:36'! definition: aDefinition self browser announcer announce: (OBDefinitionChanged definition: aDefinition)! ! !OBDefinitionPanel methodsFor: 'updating' stamp: 'lr 4/3/2010 17:41'! definitionChanged: ann definition := ann definition. selection := nil. self changed: #text! ! !OBDefinitionPanel methodsFor: 'accessing' stamp: 'dr 2/18/2008 15:28'! definitionPanel ^self! ! !OBDefinitionPanel methodsFor: 'callbacks' stamp: 'cwp 3/23/2004 00:23'! doItContext ^ self withDefinitionDo: [:def | (def respondsTo: #doItContext) ifTrue: [def doItContext]] ifNil: [nil]! ! !OBDefinitionPanel methodsFor: 'callbacks' stamp: 'cwp 3/23/2004 00:23'! doItReceiver ^ self withDefinitionDo: [:def | (def respondsTo: #doItReceiver) ifTrue: [def doItReceiver]] ifNil: [nil]! ! !OBDefinitionPanel methodsFor: 'accessing' stamp: 'cwp 4/19/2007 21:56'! environment ^ self selectedClass environment! ! !OBDefinitionPanel methodsFor: 'accessing' stamp: 'lr 3/4/2009 09:29'! getDefinition | node | ^ (node := browser currentNode) isNil ifFalse: [ node definition ]! ! !OBDefinitionPanel methodsFor: 'testing' stamp: 'dr 7/10/2008 14:40'! isDefinition ^true! ! !OBDefinitionPanel methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:31'! node: aNode self definition: (aNode isNil ifFalse: [ aNode definition ])! ! !OBDefinitionPanel methodsFor: 'updating' stamp: 'dr 11/4/2008 19:47'! nodeChanged: ann self node: ann node! ! !OBDefinitionPanel methodsFor: 'updating' stamp: 'lr 4/3/2010 18:12'! refresh: announcement | newDefinition canDiscardEdits | definition ifNil: [ ^ self ]. newDefinition := self getDefinition ifNil: [ definition ]. newDefinition text = definition text ifTrue: [ ^ self ]. canDiscardEdits := self canDiscardEdits. self definition: newDefinition. canDiscardEdits ifFalse: [ self changed: #codeChangedElsewhere ]! ! !OBDefinitionPanel methodsFor: 'callbacks' stamp: 'dr 11/4/2008 19:53'! selectedClass ^ self withDefinitionDo: [:def | (def respondsTo: #selectedClass) ifTrue: [def selectedClass]] ifNil: [nil] ! ! !OBDefinitionPanel methodsFor: 'callbacks' stamp: 'lr 2/9/2008 11:17'! selection ^ selection ifNil: [ selection := self withDefinitionDo: [ :def | def textSelection ] ifNil: [ 1 to: 0 ] ]! ! !OBDefinitionPanel methodsFor: 'callbacks' stamp: 'lr 2/9/2008 11:17'! selection: anInterval selection := anInterval. self changed: #selection! ! !OBDefinitionPanel methodsFor: 'updating' stamp: 'dr 11/19/2008 16:10'! selectionChanged: ann self node: ann column selectedNode! ! !OBDefinitionPanel methodsFor: 'updating' stamp: 'cwp 12/11/2007 17:52'! subscribe self announcer observe: OBAboutToChange send: #aboutToChange: to: self; observe: OBAboutToChangeSilently send: #aboutToChangeSilently: to: self; observe: OBSelectionChanged send: #selectionChanged: to: self; observe: OBNodeChanged send: #nodeChanged: to: self; observe: OBRefreshRequired send: #refresh: to: self; observe: OBDefinitionChanged send: #definitionChanged: to: self.! ! !OBDefinitionPanel methodsFor: 'callbacks' stamp: 'dr 11/19/2008 16:21'! text ^ self withDefinitionDo: [:def | def text] ifNil: ['']! ! !OBDefinitionPanel methodsFor: 'accessing' stamp: 'dc 6/1/2007 12:10'! vResizing ^ #spaceFill! ! !OBDefinitionPanel methodsFor: 'accessing' stamp: 'cwp 3/22/2004 20:41'! withDefinitionDo: workBlock ifNil: nilBlock definition ifNil: [ ^ nilBlock value]. ^ workBlock value: definition! ! !OBTextPanel methodsFor: 'user interface' stamp: 'lr 7/6/2010 22:24'! addEditingItems: aCollection toMenu: aMenu aCollection do: [ :each | each = #- ifFalse: [ aMenu add: each first action: each second ] ifTrue: [ aMenu addLine ] ]! ! !OBTextPanel methodsFor: 'user interface' stamp: 'lr 7/6/2010 22:34'! addTextCommandsToMenu: aMenu selection: aTextSelection aMenu addLine. (self announce: OBTextCommandScan) populateMenu: aMenu withNodes: (Array with: aTextSelection) forRequestor: self! ! !OBTextPanel methodsFor: 'callbacks' stamp: 'lr 7/6/2010 22:24'! menu: aMenu shifted: aBoolean selection: aTextSelection aBoolean ifTrue: [ self addEditingItems: self shiftedYellowButtonMenu toMenu: aMenu ] ifFalse: [ self addEditingItems: self yellowButtonMenu toMenu: aMenu. self addTextCommandsToMenu: aMenu selection: aTextSelection ]. ^ aMenu ! ! !OBTextPanel methodsFor: 'callbacks' stamp: 'lr 7/3/2009 22:27'! perform: aSelector orSendTo: anObject | receiver | receiver := (self respondsTo: aSelector) ifTrue: [ self ] ifFalse: [ anObject ]. receiver perform: aSelector! ! !OBTextPanel methodsFor: 'user interface' stamp: 'lr 8/8/2010 10:17'! shiftedYellowButtonMenu ^ Array streamContents: [ :stream | stream nextPut: (Array with: 'Browse it (b)' translated with: #browseIt); nextPut: (Array with: 'Senders of it (n)' translated with: #sendersOfIt); nextPut: (Array with: 'Implementors of it (m)' translated with: #implementorsOfIt); nextPut: (Array with: 'References to it (N)' translated with: #referencesToIt); nextPut: #-; nextPut: (Array with: 'Selectors containing it (W)' translated with: #methodNamesContainingIt); nextPut: (Array with: 'Method strings with it (E)' translated with: #methodStringsContainingit); nextPut: (Array with: 'Method source with it' translated with: #methodSourceContainingIt); nextPut: (Array with: 'Class names containing it' translated with: #classNamesContainingIt); nextPut: (Array with: 'Class comments with it' translated with: #classCommentsContainingIt); nextPut: (Array with: 'Change sets with it' translated with: #browseChangeSetsWithSelector) ]! ! !OBTextPanel methodsFor: 'user interface' stamp: 'lr 8/8/2010 10:17'! yellowButtonMenu ^ Array streamContents: [ :stream | stream nextPut: (Array with: 'Do it (d)' translated with: #doIt); nextPut: (Array with: 'Print it (p)' translated with: #printIt); nextPut: (Array with: 'Inspect it (i)' translated with: #inspectIt); nextPut: (Array with: 'Explore it (I)' translated with: #exploreIt); nextPut: (Array with: 'Debug it (D)' translated with: #debugIt); nextPut: (Array with: 'Profile it' translated with: #tallyIt); nextPut: (Array with: 'Watch it' translated with: #watchIt); nextPut: #-; nextPut: (Array with: 'Find... (f)' translated with: #find); nextPut: (Array with: 'Find again (g)' translated with: #findAgain); nextPut: (Array with: 'Extended search...' translated with: #shiftedTextPaneMenuRequest); nextPut: #-; nextPut: (Array with: 'Do again (j)' translated with: #again); nextPut: (Array with: 'Undo (z)' translated with: #undo); nextPut: #-; nextPut: (Array with: 'Copy (c)' translated with: #copySelection); nextPut: (Array with: 'Cut (x)' translated with: #cut); nextPut: (Array with: 'Paste (v)' translated with: #paste); nextPut: (Array with: 'Paste...' translated with: #pasteRecent); nextPut: #-; nextPut: (Array with: 'Accept (s)' translated with: #accept); nextPut: (Array with: 'Cancel (l)' translated with: #cancel) ]! ! Object subclass: #OBPlatform instanceVariableNames: '' classVariableNames: 'Current' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBPlatform class methodsFor: 'instance creation' stamp: 'cwp 6/1/2007 16:08'! current ^ Current ifNil: [self default]! ! !OBPlatform class methodsFor: 'instance creation' stamp: 'lr 7/3/2009 22:27'! current: aPlatform Current := aPlatform! ! !OBPlatform class methodsFor: 'instance creation' stamp: 'cwp 8/26/2009 21:54'! default self subclassResponsibility ! ! !OBPlatform methodsFor: 'building' stamp: 'cwp 8/26/2009 22:11'! build: anObject ^ self builder build: anObject! ! !OBPlatform methodsFor: 'building' stamp: 'cwp 8/26/2009 22:11'! builder self subclassResponsibility! ! Object subclass: #OBSubtree instanceVariableNames: 'state' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBSubtree class methodsFor: 'instance creation' stamp: 'cwp 8/19/2007 13:15'! from: root to: leaf ^ self new initializeWithRoot: root leaf: leaf! ! !OBSubtree methodsFor: 'public' stamp: 'dr 12/5/2008 15:59'! childOf: current ancestorOf: leaf indexOn: stream | fan | fan := current asFan. stream nextPut: fan. ^fan ancestorOf: leaf in: [:index | stream nextPut: index] ! ! !OBSubtree methodsFor: 'initialization' stamp: 'lr 3/4/2009 08:31'! initializeWithRoot: root leaf: leaf | current | state := Array streamContents: [ :stream | current := self childOf: root ancestorOf: leaf indexOn: stream. [ current isNil or: [ current = leaf ] ] whileFalse: [ current := self childOf: current ancestorOf: leaf indexOn: stream ]. current isNil ifFalse: [ current metaNode hasChildren ifTrue: [ stream nextPut: current asFan; nextPut: 0 ] ] ]. ^ current isNil ifFalse: [ self ]! ! !OBSubtree methodsFor: 'printing' stamp: 'jk 4/2/2008 12:48'! printOn: aStream aStream nextPutAll: 'Subtree< '. self state readStream do: [ :e | e printOn: aStream. aStream nextPut: Character space]. aStream nextPut: $>! ! !OBSubtree methodsFor: 'public' stamp: 'lr 3/21/2009 20:02'! selectInColumns: aCollection | column stream col | column := aCollection first. stream := state readStream. stream atEnd ifFalse: [ column fan: stream next selection: stream next ]. [ stream atEnd ] whileFalse: [ column := (col := column nextColumnWithFan: stream next selection: stream next) isNil ifTrue: [ column next ] ifFalse: [ col ] ]! ! !OBSubtree methodsFor: 'accessing' stamp: 'dr 12/5/2008 15:57'! state ^ state ! ! Object subclass: #OBSwitch instanceVariableNames: 'column filter' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Utilities'! !OBSwitch class methodsFor: 'instance creation' stamp: 'cwp 5/17/2007 23:47'! inColumn: aColumn ^ self basicNew setColumn: aColumn filter: nil.! ! !OBSwitch methodsFor: 'building' stamp: 'dr 10/21/2008 13:34'! buildOn: aBuilder ^aBuilder radioButtonBar: self with: []! ! !OBSwitch methodsFor: 'updating' stamp: 'cwp 7/14/2007 10:18'! currentNode: aNode self changed: #list! ! !OBSwitch methodsFor: 'accessing' stamp: 'cwp 5/18/2007 00:06'! filter ^ filter! ! !OBSwitch methodsFor: 'public' stamp: 'lr 3/21/2009 20:02'! filter: aFilter filter := aFilter. filter isNil ifTrue: [ ^ self ]. filter activate. self changed: #list! ! !OBSwitch methodsFor: 'testing' stamp: 'cwp 5/17/2007 21:41'! isActive ^ filter notNil! ! !OBSwitch methodsFor: 'testing' stamp: 'dr 7/19/2007 15:17'! isEnabled: aButtonModel ^true! ! !OBSwitch methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:31'! list ^ filter isNil ifFalse: [ filter listForNode: column selectedNode ] ifTrue: [ #() ]! ! !OBSwitch methodsFor: 'accessing' stamp: 'dkh 3/21/2009 13:49'! longDescriptions ^ filter ifNotNil: [filter longDescriptionsForNode: column selectedNode] ifNil: [#()]! ! !OBSwitch methodsFor: 'accessing' stamp: 'lr 12/3/2009 19:03'! okToChange ^ column okToChange! ! !OBSwitch methodsFor: 'public' stamp: 'cwp 5/18/2007 21:45'! refresh self changed: #selection! ! !OBSwitch methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:31'! selection ^ filter isNil ifFalse: [ filter selection ] ifTrue: [ 0 ]! ! !OBSwitch methodsFor: 'accessing' stamp: 'lr 3/21/2009 20:02'! selection: anInteger filter isNil ifTrue: [ ^ self ]. filter selection: anInteger. self changed: #selection. column listChanged! ! !OBSwitch methodsFor: 'initialize-release' stamp: 'lr 7/3/2009 22:27'! setColumn: aColumn filter: aFilter column := aColumn. filter := aFilter! ! Object subclass: #OBTextSelection instanceVariableNames: 'selection text' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Utilities'! !OBTextSelection class methodsFor: 'instance creation' stamp: 'cwp 10/13/2006 16:52'! on: anOBPluggableTextMorph ^ self new! ! !OBTextSelection class methodsFor: 'instance creation' stamp: 'cwp 10/14/2006 20:10'! on: anInterval inText: aString ^ self new setSelection: anInterval inText: aString! ! !OBTextSelection class methodsFor: 'instance creation' stamp: 'cwp 10/14/2006 20:59'! onAllOf: aString ^ self on: (1 to: aString size) inText: aString! ! !OBTextSelection methodsFor: 'accessing' stamp: 'cwp 10/14/2006 20:15'! fullText ^ text! ! !OBTextSelection methodsFor: 'accessing' stamp: 'cwp 10/14/2006 20:44'! hasSelector ^ self selector notNil! ! !OBTextSelection methodsFor: 'accessing' stamp: 'lr 12/11/2009 14:04'! selection ^ selection! ! !OBTextSelection methodsFor: 'accessing' stamp: 'cwp 10/14/2006 21:31'! selector ^ self text asString findSelector! ! !OBTextSelection methodsFor: 'accessing' stamp: 'dr 9/1/2008 10:23'! setSelection: anInterval inText: aString selection := anInterval. text := aString ! ! !OBTextSelection methodsFor: 'accessing' stamp: 'cwp 10/14/2006 20:14'! text ^ text atAll: selection! ! !Object methodsFor: '*omnibrowser-converting' stamp: 'cwp 4/17/2006 12:16'! asAnnouncement ^ self! !