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-Platform'! SystemOrganization addCategory: #'OmniBrowser-Utilities'! SystemOrganization addCategory: #'OmniBrowser-Obsolete'! !Character methodsFor: '*omnibrowser-converting' stamp: 'lr 5/20/2011 19:20'! asKeystroke ^ OBKeystroke key: self asLowercase shift: self isUppercase control: false option: false command: true! ! !Behavior methodsFor: '*omnibrowser-converting' stamp: 'cwp 4/17/2006 12:16'! asAnnouncement ^ self new! ! !UndefinedObject methodsFor: '*omnibrowser-converting' stamp: 'lr 4/25/2011 10:54'! asKeystroke ^ self! ! 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: #OBBuilderRequest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBBuilderRequest methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 12:45'! defaultAction ^ self resume: OBInterface current builder! ! !OBBuilderRequest methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 14:47'! handleWith: anObject ^ anObject handleBuilderRequest: self! ! 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: 'lr 10/20/2011 18:46'! 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 class methodsFor: 'utilities' stamp: 'lr 4/8/2011 19:39'! subsequence: testString matches: aString caseSensitive: aBoolean "Checks if a testString is a subsequence of aString. The matching parts do not necessarily need to be consecutive, for example 'egli' matches 'renggli'." | index | index := 0. testString do: [ :char | index := aString findString: (String with: char) startingAt: index + 1 caseSensitive: aBoolean. index = 0 ifTrue: [ ^ false ] ]. ^ true! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 9/22/2010 20:20'! assisted ^ assisted! ! !OBCompletionRequest methodsFor: 'accessing' stamp: 'lr 10/10/2010 18:17'! assisted: aBoolean "A boolean indicating that the typing of the user is assisted but 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 4/8/2011 19:39'! 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 class subsequence: value matches: (self labelFor: each) 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 11/3/2011 12:52'! defaultAction ^ self handleWith: OBInterface default! ! !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: #OBInterfaceRequest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Notifications'! !OBInterfaceRequest methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 12:46'! defaultAction self resume: OBInterface default! ! !OBInterfaceRequest methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 12:29'! handleWith: aHandler ^ aHandler handleInterfaceRequest: self! ! 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! ! 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 12/4/2011 15:45'! processKeystroke: aKeystroke withNode: aNode for: aRequestor ^ self processKeystroke: aKeystroke withNode: aNode for: aRequestor in: nil! ! !OBCommandScan methodsFor: 'user interface' stamp: 'lr 12/4/2011 15:46'! processKeystroke: aKeystroke withNode: aNode for: aRequestor in: aView ((self commandsOn: aNode for: aRequestor) select: [ :each | each keystroke asKeystroke = aKeystroke ]) do: [ :each | (each isActive and: [ each isEnabled ]) ifTrue: [ aView notNil ifTrue: [ each perform: #execute orSendTo: aView ] ifFalse: [ 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: #OBNoSelectedNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! 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: #OBNodeSelection instanceVariableNames: 'node column' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! OBNodeSelection subclass: #OBNodeDeselected instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! OBNodeSelection subclass: #OBNodeSelected instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Announcements'! !OBNodeSelection class methodsFor: 'instance creation' stamp: 'cwp 11/10/2011 16:30'! column: aColumn node: aNode ^ self basicNew initializeWithColumn: aColumn node: aNode! ! !OBNodeSelection methodsFor: 'accessing' stamp: 'cwp 11/10/2011 16:10'! column ^ column! ! !OBNodeSelection methodsFor: 'initialize-release' stamp: 'cwp 11/10/2011 16:12'! initializeWithColumn: aColumn node: aNode self initialize. column := aColumn. node := aNode! ! !OBNodeSelection methodsFor: 'accessing' stamp: 'cwp 11/11/2011 18:42'! node ^ node ifNil: [column selectedNode]! ! 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! ! Object subclass: #OBAnnouncer instanceVariableNames: 'subscriptions queue' 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: 'announcing' stamp: 'cwp 12/2/2011 11:36'! announce [queue isEmpty] whileFalse: [queue removeFirst value]. ! ! !OBAnnouncer methodsFor: 'announcing' stamp: 'cwp 12/2/2011 11:49'! announce: anObject | ann | ann := anObject asAnnouncement. subscriptions keysAndValuesDo: [:class :actions | (ann isKindOf: class) ifTrue: [actions do: [:ea | queue add: [ea value: ann]]]]. self announce. ^ ann! ! !OBAnnouncer methodsFor: 'initialize-release' stamp: 'cwp 12/2/2011 11:22'! initialize subscriptions := IdentityDictionary new. queue := OrderedCollection new.! ! !OBAnnouncer methodsFor: 'subscription' stamp: 'cwp 12/2/2011 11:44'! on: aClass do: aValuable | actions | actions := subscriptions at: aClass ifAbsent: [Array new]. subscriptions at: aClass put: (actions copyWith: aValuable)! ! !OBAnnouncer methodsFor: 'subscription' stamp: 'lr 4/18/2011 22:28'! on: aClass send: aSelector to: anObject self on: 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-Obsolete'! !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: 'cwp 11/9/2011 00:46'! on: aMetaNode ^ self basicNew initializeWithMetanode: aMetaNode! ! !OBAutoSelection methodsFor: 'initialize-release' stamp: 'cwp 11/9/2011 00:38'! initializeWithMetanode: aMetanode self initialize. metaNode := aMetanode! ! !OBAutoSelection methodsFor: 'accessing' stamp: 'dr 1/28/2009 15:43'! metaNode ^metaNode! ! !OBAutoSelection methodsFor: 'selecting' stamp: 'cwp 11/9/2011 00:39'! selectFromNodes: aCollection ^ aCollection detect: [:ea | ea metaNode == metaNode] ifNone: [nil]! ! Object subclass: #OBBrowser instanceVariableNames: 'panels announcer commandFactories' 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: 'cwp 11/23/2011 21:21'! buttonPanel ^ OBPlatform current 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: 'visiting' stamp: 'lr 11/17/2011 21:14'! acceptVisitor: aVisitor ^ aVisitor visitBrowser: self! ! !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: 'accessing' stamp: 'cwp 11/23/2011 21:20'! buttonFactories "Find the commands factories assigned to buttons by the receiver. These are all commands returned by methods annotated with ; excluding the factories returned from methods annotated with ." | factories | factories := Dictionary new. (Pragma allNamed: #button: from: self class to: OBBrowser) do: [:pragma | (self perform: pragma selector) ifNotNil: [:f | factories at: f put: (pragma argumentAt: 1)]]. (Pragma allNamed: #obsolete from: self class to: OBBrowser) do: [:pragma | self command: pragma do: [:f | factories removeKey: f ifAbsent: []]]. ^ factories! ! !OBBrowser methodsFor: 'commands-text' stamp: 'lr 12/10/2010 09:50'! clipboardTextCommands ^ Array with: OBCutTextCommand with: OBCopyTextCommand with: OBPasteTextCommand! ! !OBBrowser methodsFor: 'opening' stamp: 'avi 12/5/2007 13:19'! close ^ OBCloseRequest signal: self! ! !OBBrowser methodsFor: 'private' stamp: 'lr 10/29/2010 10:24'! command: aPragma do: aBlock | factories | factories := self perform: aPragma selector. factories isNil ifTrue: [ ^ self ]. factories isCollection ifTrue: [ factories do: aBlock ] ifFalse: [ aBlock value: factories ]! ! !OBBrowser methodsFor: 'accessing' stamp: 'lr 10/29/2010 11:08'! commandFactories ^ commandFactories! ! !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: 'commands-text' stamp: 'lr 12/10/2010 09:50'! editorTextCommands ^ Array with: OBAcceptTextCommand with: OBCancelTextCommand! ! !OBBrowser methodsFor: 'building' stamp: 'lr 3/5/2010 09:22'! initialExtent ^ RealEstateAgent standardWindowExtent! ! !OBBrowser methodsFor: 'initializing' stamp: 'lr 10/29/2010 09:50'! initialize panels := OrderedCollection new. announcer := OBAnnouncer new. commandFactories := #()! ! !OBBrowser methodsFor: 'initializing' stamp: 'lr 10/29/2010 10:28'! initializeCommands "Initialize the command factories of the receiver. These are all commands returned by methods annotated with ; excluding the factories returned from methods annotated with ." commandFactories := Set new. (Pragma allNamed: #command from: self class to: OBBrowser) do: [ :pragma | self command: pragma do: [ :factory | commandFactories add: factory ] ]. (Pragma allNamed: #obsolete from: self class to: OBBrowser) do: [ :pragma | self command: pragma do: [ :factory | commandFactories remove: factory ] ]! ! !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: 'lr 10/29/2010 11:54'! scanNodeCommands: anAnnouncement commandFactories do: [ :each | each takesNodes ifTrue: [ anAnnouncement addFactory: each ] ]! ! !OBBrowser methodsFor: 'updating' stamp: 'lr 10/29/2010 11:54'! scanTextCommands: anAnnouncement commandFactories do: [ :each | each takesText ifTrue: [ anAnnouncement addFactory: each ] ]! ! !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: 'commands-text' stamp: 'lr 8/27/2011 10:00'! smalltalkTextCommands ^ Array with: OBDoItTextCommand with: OBPrintItTextCommand with: OBInspectItTextCommand with: OBExploreItTextCommand with: OBDebugItTextCommand! ! !OBBrowser methodsFor: 'updating' stamp: 'cwp 11/10/2011 15:42'! subscribe self announcer on: OBNodeSelected send: #relabel: to: self; on: OBNodeCommandScan send: #scanNodeCommands: to: self; on: OBTextCommandScan send: #scanTextCommands: to: self! ! !OBBrowser methodsFor: 'updating' stamp: 'lr 12/3/2010 10:33'! transcribe self announcer on: OBAnnouncement do: [ :ann | Transcript cr; show: ann ]! ! !OBBrowser methodsFor: 'commands-text' stamp: 'lr 12/10/2010 09:50'! undoRedoCommands ^ Array with: OBUndoTextCommand with: OBRedoTextCommand! ! Object subclass: #OBButton instanceVariableNames: 'label action enabled pressed color' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Utilities'! !OBButton class methodsFor: 'as yet unclassified' stamp: 'cwp 11/5/2011 12:39'! label: aValuable ^ self basicNew initializeWithLabel: aValuable! ! !OBButton methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:37'! acceptVisitor: aVisitor ^ aVisitor visitButton: self! ! !OBButton methodsFor: 'initialize-release' stamp: 'cwp 11/5/2011 13:06'! action: aValuable action := aValuable. self changed: #action.! ! !OBButton methodsFor: 'callbacks' stamp: 'cwp 11/5/2011 12:56'! color ^ color value! ! !OBButton methodsFor: 'initialize-release' stamp: 'cwp 11/5/2011 13:02'! color: aValuable color := aValuable. self changed: #color! ! !OBButton methodsFor: 'initialize-release' stamp: 'cwp 11/5/2011 13:06'! enabled: aValuable enabled := aValuable. self changed: #isEnabled.! ! !OBButton methodsFor: 'callbacks' stamp: 'cwp 11/5/2011 12:46'! execute action value! ! !OBButton methodsFor: 'initialize-release' stamp: 'cwp 11/6/2011 23:00'! initializeWithLabel: aValuable self initialize. label := aValuable. pressed := false. enabled := true. ! ! !OBButton methodsFor: 'callbacks' stamp: 'cwp 11/5/2011 12:51'! isEnabled ^ enabled value! ! !OBButton methodsFor: 'callbacks' stamp: 'cwp 11/5/2011 12:52'! isPressed ^ pressed value! ! !OBButton methodsFor: 'callbacks' stamp: 'cwp 11/5/2011 12:40'! label ^ label value! ! !OBButton methodsFor: 'initialize-release' stamp: 'cwp 11/5/2011 13:07'! pressed: aValuable pressed := aValuable. self changed: #isPressed! ! Object subclass: #OBButtonBar instanceVariableNames: 'buttons' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Utilities'! !OBButtonBar methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:38'! acceptVisitor: aVisitor ^ aVisitor visitButtonBar: self! ! !OBButtonBar methodsFor: 'accessing' stamp: 'cwp 11/5/2011 22:20'! buttons ^ buttons! ! !OBButtonBar methodsFor: 'accessing' stamp: 'cwp 11/6/2011 23:05'! buttons: anArray buttons := anArray. self changed: #widgets! ! !OBButtonBar methodsFor: 'initialize-release' stamp: 'cwp 11/5/2011 22:27'! initialize buttons := Array new.! ! !OBButtonBar methodsFor: 'accessing' stamp: 'cwp 11/6/2011 22:01'! labels ^ buttons collect: [:ea | ea label]! ! !OBButtonBar methodsFor: 'updating' stamp: 'cwp 11/17/2011 00:29'! refreshEnabled buttons do: [:ea | ea changed: #isEnabled]! ! !OBButtonBar methodsFor: 'updating' stamp: 'cwp 11/6/2011 23:03'! refreshPressed buttons do: [:ea | ea changed: #isPressed]! ! !OBButtonBar methodsFor: 'callbacks' stamp: 'cwp 12/9/2011 14:42'! widgets ^ OBBuilder current widgetsForButtonBar: self! ! Object subclass: #OBColumn instanceVariableNames: 'panel switch list' 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: 'visiting' stamp: 'lr 11/17/2011 21:14'! acceptVisitor: aVisitor ^ aVisitor visitColumn: 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 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: 'delegating' stamp: 'cwp 11/9/2011 00:27'! children ^ list children! ! !OBColumn methodsFor: 'updating' stamp: 'cwp 11/10/2011 16:37'! clear self switchFilter: nil. list clearAll. ! ! !OBColumn methodsFor: 'column' 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: 'cwp 11/10/2011 23:23'! descriptor self isEmpty ifTrue: [ ^ 'empty' ]. list hasSelection ifTrue: [ ^ self selectedNode name ]. ^ ''! ! !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: 'cwp 12/12/2011 16:25'! fan: aFan selection: index list fan: aFan selection: index. self switchFilter: list switchFilter. ! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 11/9/2011 00:27'! hasSelection ^ list hasSelection! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 11/9/2011 00:27'! iconAt: index ^ list iconAt: index! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 11/9/2011 00:27'! includesNode: aNode ^ list includesNode: aNode! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 11/9/2011 00:27'! isEmpty ^ list isEmpty! ! !OBColumn methodsFor: 'testing' stamp: 'cwp 10/9/2006 15:41'! isSelected: aNode ^ self selectedNode == aNode! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 11/9/2011 22:43'! list ^ list! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 5/6/2007 23:19'! metaNode ^ self parent metaNode! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 11/10/2011 23:11'! next ^ self basicNext ifNil: [ (list 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: 'accessing' stamp: 'cwp 3/3/2004 00:11'! nextMetaNode ^ self selectedNode metaNode! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 11/9/2011 00:27'! nodeForItem: aString ^ list nodeForItem: aString! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 11/12/2011 21:06'! panel ^ panel! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 11/9/2011 00:27'! parent ^ list parent! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 11/10/2011 22:51'! parent: aNode list parent: aNode. self switchFilter: list switchFilter! ! !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 11/10/2011 22:43'! refresh list refresh! ! !OBColumn methodsFor: 'selecting' stamp: 'cwp 11/10/2011 23:27'! select: aNode list children keysAndValuesDo: [:i :child | child = aNode ifTrue: [^ self selection: i]]. self selection: nil! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 11/9/2011 00:27'! selectSilently: aNode list selectSilently: aNode! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 12/12/2011 17:02'! selectedNode ^ list selectedNode ifNil: [list parent ifNotNil: [:parent | parent nullChild]]! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 11/9/2011 00:27'! selection ^ list selection! ! !OBColumn methodsFor: 'delegating' stamp: 'cwp 11/9/2011 16:47'! selection: anInteger list selection: anInteger. ! ! !OBColumn methodsFor: 'initialize-release' stamp: 'cwp 11/9/2011 00:27'! setPanel: aPanel panel := aPanel. switch := OBSwitch inColumn: self. list := OBList column: self. self subscribe. list clearAll! ! !OBColumn methodsFor: 'initialize-release' stamp: 'cwp 11/10/2011 23:00'! setPanel: aPanel metaNode: aMetanode node: aNode switch := OBSwitch inColumn: self. panel := aPanel. list := OBList column: self. aNode metaNode: aMetanode. self parent: aNode. list clearSelection. self subscribe! ! !OBColumn methodsFor: 'testing' stamp: 'cwp 11/10/2011 23:11'! shouldBeLast ^ list hasSelection not or: [ self nextMetaNode hasChildren not ]! ! !OBColumn methodsFor: 'initialize-release' stamp: 'cwp 11/10/2011 12:40'! subscribe list subscribe. switch subscribe! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 5/17/2007 23:25'! switch ^ switch! ! !OBColumn methodsFor: 'accessing' stamp: 'cwp 11/5/2011 15:34'! switchFilter: aFilter switch filter = aFilter ifTrue:[ ^ self ]. switch filter: aFilter. self changed: #widgets! ! !OBColumn methodsFor: 'callbacks' stamp: 'cwp 12/9/2011 14:41'! widgets ^ OBBuilder current widgetsForColumn: self! ! 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: 'lr 4/25/2011 11:07'! addItemToMenu: aMenu self isActive ifTrue: [ aMenu add: self label target: self selector: #execute enabled: self isEnabled icon: self icon keystroke: self keystroke ]! ! !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: '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: 'lr 11/25/2010 23:45'! select: aNode with: anAnnouncer aNode announceSelectionWith: anAnnouncer! ! !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: 'lr 8/8/2010 10:47'! wantsMenu "Put this here for compatibility. Eventually this will be obsolete" ^ true ! ! OBCommand subclass: #OBViewCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! OBViewCommand subclass: #OBAcceptTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBAcceptTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesNodes ^ false! ! !OBAcceptTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesText ^ true! ! !OBAcceptTextCommand methodsFor: 'execution' stamp: 'lr 12/10/2010 09:10'! execute target accept! ! !OBAcceptTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 10:39'! group ^ #zip! ! !OBAcceptTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:51'! icon ^ #okIcon! ! !OBAcceptTextCommand methodsFor: 'testing' stamp: 'lr 12/10/2010 09:21'! isActive ^ true! ! !OBAcceptTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 10:30'! keystroke ^ $s! ! !OBAcceptTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:09'! label ^ 'Accept'! ! OBViewCommand subclass: #OBCancelTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBCancelTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesNodes ^ false! ! !OBCancelTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesText ^ true! ! !OBCancelTextCommand methodsFor: 'execution' stamp: 'lr 12/10/2010 09:11'! execute target cancel! ! !OBCancelTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 10:39'! group ^ #zip! ! !OBCancelTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:51'! icon ^ #cancelIcon! ! !OBCancelTextCommand methodsFor: 'testing' stamp: 'lr 12/10/2010 09:22'! isActive ^ true! ! !OBCancelTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:11'! keystroke ^ $l! ! !OBCancelTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:11'! label ^ 'Cancel'! ! OBViewCommand subclass: #OBCopyTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBCopyTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesNodes ^ false! ! !OBCopyTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesText ^ true! ! !OBCopyTextCommand methodsFor: 'execution' stamp: 'lr 12/10/2010 10:40'! execute target copySelection! ! !OBCopyTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 10:37'! group ^ #clipboard! ! !OBCopyTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:51'! icon ^ #copyIcon! ! !OBCopyTextCommand methodsFor: 'testing' stamp: 'lr 12/10/2010 09:22'! isActive ^ true! ! !OBCopyTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:11'! keystroke ^ $c! ! !OBCopyTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:11'! label ^ 'Copy'! ! !OBCopyTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:29'! order ^ '2'! ! OBViewCommand subclass: #OBCutTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBCutTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesNodes ^ false! ! !OBCutTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesText ^ true! ! !OBCutTextCommand methodsFor: 'execution' stamp: 'lr 3/6/2011 15:03'! execute target cut! ! !OBCutTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:27'! group ^ #clipboard! ! !OBCutTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:51'! icon ^ #cutIcon! ! !OBCutTextCommand methodsFor: 'testing' stamp: 'lr 12/10/2010 09:22'! isActive ^ true! ! !OBCutTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:12'! keystroke ^ $x! ! !OBCutTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:12'! label ^ 'Cut'! ! !OBCutTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:29'! order ^ '1'! ! OBViewCommand subclass: #OBDebugItTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBDebugItTextCommand class methodsFor: 'testing' stamp: 'lr 8/27/2011 10:02'! takesNodes ^ false! ! !OBDebugItTextCommand class methodsFor: 'testing' stamp: 'lr 8/27/2011 10:02'! takesText ^ true! ! !OBDebugItTextCommand methodsFor: 'execution' stamp: 'lr 8/27/2011 09:58'! execute target debugIt! ! !OBDebugItTextCommand methodsFor: 'accessing' stamp: 'lr 8/27/2011 09:58'! group ^ #smalltalk! ! !OBDebugItTextCommand methodsFor: 'accessing' stamp: 'lr 8/27/2011 09:58'! icon ^ #debugIcon! ! !OBDebugItTextCommand methodsFor: 'testing' stamp: 'lr 8/27/2011 09:58'! isActive ^ true! ! !OBDebugItTextCommand methodsFor: 'accessing' stamp: 'lr 8/27/2011 09:58'! keystroke ^ $D! ! !OBDebugItTextCommand methodsFor: 'accessing' stamp: 'lr 8/27/2011 09:58'! label ^ 'Debug it'! ! !OBDebugItTextCommand methodsFor: 'accessing' stamp: 'lr 8/27/2011 10:00'! order ^ '5'! ! OBViewCommand subclass: #OBDoItTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBDoItTextCommand class methodsFor: 'testing' stamp: 'lr 3/6/2011 14:55'! takesNodes ^ false! ! !OBDoItTextCommand class methodsFor: 'testing' stamp: 'lr 3/6/2011 14:55'! takesText ^ true! ! !OBDoItTextCommand methodsFor: 'execution' stamp: 'lr 3/6/2011 15:13'! execute target doIt! ! !OBDoItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:55'! group ^ #smalltalk! ! !OBDoItTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:51'! icon ^ #doItIcon! ! !OBDoItTextCommand methodsFor: 'testing' stamp: 'lr 3/6/2011 14:55'! isActive ^ true! ! !OBDoItTextCommand methodsFor: 'accessing' stamp: 'lr 3/17/2011 21:38'! keystroke ^ $d! ! !OBDoItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:55'! label ^ 'Do it'! ! !OBDoItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:54'! order ^ '1'! ! OBViewCommand subclass: #OBExploreItTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBExploreItTextCommand class methodsFor: 'testing' stamp: 'lr 3/6/2011 15:08'! takesNodes ^ false! ! !OBExploreItTextCommand class methodsFor: 'testing' stamp: 'lr 3/6/2011 15:08'! takesText ^ true! ! !OBExploreItTextCommand methodsFor: 'execution' stamp: 'lr 3/6/2011 15:13'! execute target exploreIt! ! !OBExploreItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 15:05'! group ^ #smalltalk! ! !OBExploreItTextCommand methodsFor: 'testing' stamp: 'lr 3/6/2011 15:05'! isActive ^ true! ! !OBExploreItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 15:05'! keystroke ^ $I! ! !OBExploreItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 15:05'! label ^ 'Explore it'! ! !OBExploreItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 15:05'! order ^ '4'! ! OBViewCommand subclass: #OBInspectItTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBInspectItTextCommand class methodsFor: 'testing' stamp: 'lr 3/6/2011 14:55'! takesNodes ^ false! ! !OBInspectItTextCommand class methodsFor: 'testing' stamp: 'lr 3/6/2011 14:55'! takesText ^ true! ! !OBInspectItTextCommand methodsFor: 'execution' stamp: 'lr 3/6/2011 15:13'! execute target inspectIt! ! !OBInspectItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:56'! group ^ #smalltalk! ! !OBInspectItTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:52'! icon ^ #inspectItIcon! ! !OBInspectItTextCommand methodsFor: 'testing' stamp: 'lr 3/6/2011 14:55'! isActive ^ true! ! !OBInspectItTextCommand methodsFor: 'accessing' stamp: 'lr 3/17/2011 21:38'! keystroke ^ $i! ! !OBInspectItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:56'! label ^ 'Inspect it'! ! !OBInspectItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:56'! order ^ '3'! ! OBViewCommand subclass: #OBPasteTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBPasteTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesNodes ^ false! ! !OBPasteTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesText ^ true! ! !OBPasteTextCommand methodsFor: 'execution' stamp: 'lr 12/10/2010 09:14'! execute target paste! ! !OBPasteTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:27'! group ^ #clipboard! ! !OBPasteTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:52'! icon ^ #pasteIcon! ! !OBPasteTextCommand methodsFor: 'testing' stamp: 'lr 12/10/2010 09:22'! isActive ^ true! ! !OBPasteTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:14'! keystroke ^ $v! ! !OBPasteTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:14'! label ^ 'Paste'! ! !OBPasteTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:29'! order ^ '3'! ! OBViewCommand subclass: #OBPrintItTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBPrintItTextCommand class methodsFor: 'testing' stamp: 'lr 3/6/2011 14:55'! takesNodes ^ false! ! !OBPrintItTextCommand class methodsFor: 'testing' stamp: 'lr 3/6/2011 14:55'! takesText ^ true! ! !OBPrintItTextCommand methodsFor: 'execution' stamp: 'lr 3/6/2011 15:13'! execute target printIt! ! !OBPrintItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:56'! group ^ #smalltalk! ! !OBPrintItTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:52'! icon ^ #printIcon! ! !OBPrintItTextCommand methodsFor: 'testing' stamp: 'lr 3/6/2011 14:55'! isActive ^ true! ! !OBPrintItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:56'! keystroke ^ $p! ! !OBPrintItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:56'! label ^ 'Print it'! ! !OBPrintItTextCommand methodsFor: 'accessing' stamp: 'lr 3/6/2011 14:56'! order ^ '2'! ! OBViewCommand subclass: #OBRedoTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBRedoTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesNodes ^ false! ! !OBRedoTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesText ^ true! ! !OBRedoTextCommand methodsFor: 'execution' stamp: 'lr 12/4/2011 13:04'! execute target again! ! !OBRedoTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 10:38'! group ^ #adapting! ! !OBRedoTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:52'! icon ^ #redoIcon! ! !OBRedoTextCommand methodsFor: 'testing' stamp: 'lr 12/10/2010 09:22'! isActive ^ true! ! !OBRedoTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:20'! keystroke ^ $Z! ! !OBRedoTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:20'! label ^ 'Redo'! ! OBViewCommand subclass: #OBUndoTextCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Commands'! !OBUndoTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesNodes ^ false! ! !OBUndoTextCommand class methodsFor: 'testing' stamp: 'lr 12/10/2010 09:25'! takesText ^ true! ! !OBUndoTextCommand methodsFor: 'execution' stamp: 'lr 12/10/2010 09:20'! execute target undo! ! !OBUndoTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 10:38'! group ^ #adapting! ! !OBUndoTextCommand methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:52'! icon ^ #undoIcon! ! !OBUndoTextCommand methodsFor: 'testing' stamp: 'lr 12/10/2010 09:22'! isActive ^ true! ! !OBUndoTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:20'! keystroke ^ $z! ! !OBUndoTextCommand methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:20'! label ^ 'Undo'! ! !OBViewCommand methodsFor: 'as yet unclassified' stamp: 'cwp 11/8/2011 15:27'! perform: aSelector orSendTo: aWidget target := aWidget. self execute! ! 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-Utilities'! !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: '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: 'cwp 11/8/2011 23:55'! children: aCollection children := aCollection! ! !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: 'cwp 11/8/2011 23:55'! parent: aNode parent := aNode! ! !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 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: '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: #OBIcon instanceVariableNames: 'width height bytes' classVariableNames: 'Icons' poolDictionaries: '' category: 'OmniBrowser-Platform'! !OBIcon class methodsFor: 'as yet unclassified' stamp: 'cwp 12/8/2011 12:26'! generate "Here's the code to convert the old icons based on ColorForm storeStrings to ARGB byte arrays." | class inst | class := Smalltalk at: #OBMorphicIcons. inst := class new. class selectors do: [:selector || bytes form source | form := inst perform: selector. bytes := ByteArray streamContents: [:out | 0 to: form width - 1 do: [:x | 0 to: form height - 1 do: [:y || color | color := form colorAt: x@y. out nextPut: (color alpha * 255) rounded. out nextPut: (color red * 255) rounded. out nextPut: (color green * 255) rounded. out nextPut: (color blue * 255) rounded]]]. source := String streamContents: [:out | out nextPutAll: selector; crtab; nextPutAll: 'width := '; print: form width; nextPut: $.; crtab; nextPutAll: 'height := '; print: form height; nextPut: $.; crtab; nextPutAll: 'bytes := '; print: bytes]. OBIcon compile: source] ! ! !OBIcon class methodsFor: 'as yet unclassified' stamp: 'cwp 12/8/2011 10:57'! named: aSymbol ^ (self canUnderstand: aSymbol) ifTrue: [self basicNew perform: aSymbol]! ! !OBIcon methodsFor: 'base' stamp: 'cwp 12/8/2011 12:30'! blank width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: 'base' stamp: 'cwp 12/8/2011 12:26'! blankMenu width := 16. height := 1. bytes := #[255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255]! ! Object subclass: #OBInterface instanceVariableNames: '' classVariableNames: 'Default' poolDictionaries: '' category: 'OmniBrowser-Platform'! !OBInterface class methodsFor: 'accessing' stamp: 'cwp 12/9/2011 12:30'! current ^ OBInterfaceRequest signal! ! !OBInterface class methodsFor: 'as yet unclassified' stamp: 'cwp 11/3/2011 12:09'! default ^ Default! ! !OBInterface class methodsFor: 'as yet unclassified' stamp: 'cwp 11/3/2011 12:09'! default: anInterface Default := anInterface! ! !OBInterface methodsFor: 'as yet unclassified' stamp: 'cwp 12/8/2011 23:41'! builder self subclassResponsibility! ! !OBInterface methodsFor: 'as yet unclassified' stamp: 'cwp 12/8/2011 23:09'! handleInteractionDuring: aBlock aBlock on: OBInteractionRequest do: [:request | request resume: (request handleWith: self)]! ! !OBInterface methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 12:30'! handleInterfaceRequest: aRequest aRequest resume: self! ! !OBInterface methodsFor: 'as yet unclassified' stamp: 'cwp 12/6/2011 14:18'! iconNamed: aSymbol ^ nil! ! Object subclass: #OBKeystroke instanceVariableNames: 'key shift control option command' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Utilities'! !OBKeystroke class methodsFor: 'instance creation' stamp: 'lr 5/20/2011 19:19'! key: aCharacter shift: aShiftBoolean control: aControlBoolean option: anOptionBoolean command: aCommandBoolean ^ self basicNew initalizeKey: aCharacter shift: aShiftBoolean control: aControlBoolean option: anOptionBoolean command: aCommandBoolean! ! !OBKeystroke methodsFor: 'comparing' stamp: 'lr 5/20/2011 19:22'! = anObject self == anObject ifTrue: [ ^ true ]. self class = anObject class ifFalse: [ ^ false ]. ^ self key = anObject key and: [ self isShift = anObject isShift and: [ self isControl = anObject isControl and: [ self isOption = anObject isOption and: [ self isCommand = anObject isCommand ] ] ] ]! ! !OBKeystroke methodsFor: 'converting' stamp: 'lr 4/25/2011 10:35'! asKeystroke ^ self! ! !OBKeystroke methodsFor: 'comparing' stamp: 'lr 5/20/2011 19:22'! hash "Answer an integer value that is related to the identity of the receiver." ^ self key hash bitXor: (self isShift hash bitXor: (self isControl hash bitXor: (self isOption hash bitXor: self isCommand hash)))! ! !OBKeystroke methodsFor: 'initialization' stamp: 'lr 5/20/2011 19:19'! initalizeKey: aCharacter shift: aShiftBoolean control: aControlBoolean option: anOptionBoolean command: aCommandBoolean key := aCharacter. shift := aShiftBoolean. control := aControlBoolean. option := anOptionBoolean. command := aCommandBoolean! ! !OBKeystroke methodsFor: 'testing' stamp: 'lr 4/25/2011 10:29'! isCommand "Answer true if the command key was pressed for this event." ^ command! ! !OBKeystroke methodsFor: 'testing' stamp: 'lr 4/25/2011 10:29'! isControl "Answer true if the conrol key was pressed for this event." ^ control! ! !OBKeystroke methodsFor: 'testing' stamp: 'lr 5/20/2011 19:16'! isOption "Answer true if the option key was pressed for this event." ^ option! ! !OBKeystroke methodsFor: 'testing' stamp: 'lr 4/25/2011 10:29'! isShift "Answer true if the shift key was pressed for this event." ^ shift! ! !OBKeystroke methodsFor: 'accessing' stamp: 'lr 4/25/2011 10:43'! key "Answer the character that was pressed for this keystroke." ^ key! ! !OBKeystroke methodsFor: 'printing' stamp: 'lr 5/20/2011 19:21'! printOn: aStream self isShift ifTrue: [ aStream nextPutAll: 'shift+' ]. self isControl ifTrue: [ aStream nextPutAll: 'ctrl+' ]. self isOption ifTrue: [ aStream nextPutAll: 'opt+' ]. self isCommand ifTrue: [ aStream nextPutAll: 'cmd+' ]. aStream nextPut: self key! ! Object subclass: #OBList instanceVariableNames: 'column parent children selection' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Kernel'! !OBList class methodsFor: 'instance creation' stamp: 'cwp 11/9/2011 00:53'! column: aColumn ^ self basicNew initializeWithColumn: aColumn! ! !OBList methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:15'! acceptVisitor: aVisitor ^ aVisitor visitList: self! ! !OBList methodsFor: 'nodes' stamp: 'cwp 11/9/2011 16:49'! addCommandsToMenu: aMenu | scan nodes | scan := column announce: OBNodeCommandScan. nodes := self hasSelection ifTrue: [{self parent. self selectedNode}] ifFalse: [{self parent}]. scan populateMenu: aMenu withNodes: nodes forRequestor: self ! ! !OBList methodsFor: 'announcements' stamp: 'cwp 11/9/2011 22:52'! announce: anAnnouncement ^ column announce: anAnnouncement ! ! !OBList methodsFor: 'announcements' stamp: 'cwp 11/11/2011 20:35'! announceNodeDeselected: aNode aNode ifNil: [^ self]. self announce: (OBNodeDeselected column: column node: aNode)! ! !OBList methodsFor: 'announcements' stamp: 'cwp 11/10/2011 16:29'! announceNodeSelected: aNode self announce: (OBNodeSelected column: column node: aNode)! ! !OBList methodsFor: 'announcements' stamp: 'cwp 11/10/2011 12:39'! announcer ^ column announcer! ! !OBList methodsFor: 'accessing' stamp: 'cwp 11/10/2011 12:44'! browser ^ column browser! ! !OBList methodsFor: 'selecting' stamp: 'cwp 11/11/2011 21:25'! changeSelection: anInteger | oldSelectedNode | oldSelectedNode := self selectedNode. selection := anInteger. selection = 0 ifTrue: [ self announceNodeDeselected: oldSelectedNode ] ifFalse: [ self announceNodeSelected: self selectedNode ]. self changed: #selection! ! !OBList methodsFor: 'accessing' stamp: 'cwp 11/9/2011 00:23'! children ^ children ifNil: [#()]! ! !OBList methodsFor: 'announcements' stamp: 'cwp 11/10/2011 15:29'! childrenChanged: ann parent = ann node ifTrue: [self refresh]! ! !OBList methodsFor: 'selecting' stamp: 'cwp 11/10/2011 16:37'! clearAll parent := nil. children := nil. self clearSelection. self changed: #list.! ! !OBList methodsFor: 'selecting' stamp: 'cwp 11/10/2011 16:38'! clearSelection selection := 0. self changed: #selection! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/9/2011 00:10'! clickIconAt: anInteger | node | node := self children at: anInteger ifAbsent: [^ self]. node metaNode clickIconColumn: column forNode: node! ! !OBList methodsFor: 'selecting' stamp: 'lr 5/28/2010 21:37'! defaultSelection ^ 1! ! !OBList methodsFor: 'nodes' stamp: 'cwp 11/9/2011 00:08'! displayStringForChild: aNode ^ self parent displayStringForChild: aNode! ! !OBList methodsFor: 'nodes' stamp: 'cwp 11/9/2011 00:08'! displayStringForChildAt: index ^ self displayStringForChild: (self children at: index ifAbsent: [^ ''])! ! !OBList methodsFor: 'callbacks' 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: 'selecting' stamp: 'cwp 12/12/2011 16:22'! fan: aFan selection: index parent := aFan parent. children := aFan children. self selection: index. self selectedNode ifNotNil: [:node | parent noteChild: node]! ! !OBList methodsFor: 'testing' stamp: 'lr 5/28/2010 21:40'! hasSelection ^ selection > 0! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 12/12/2011 14:23'! iconAt: index | node | node := self children at: index ifAbsent: [ ^ nil ]. ^ OBInterface current iconNamed: node icon! ! !OBList methodsFor: 'testing' stamp: 'cwp 11/9/2011 00:00'! includesNode: aNode ^ self children includes: aNode! ! !OBList methodsFor: 'nodes' stamp: 'cwp 11/8/2011 23:51'! indexOf: aNode | index | index := self children indexOf: aNode. index = 0 ifTrue: [index := self children indexOf: (self children detect: [:ea | ea name = aNode name] ifNone: [nil])]. ^ index! ! !OBList methodsFor: 'initialize-release' stamp: 'cwp 11/9/2011 16:13'! initializeWithColumn: aColumn self initialize. column := aColumn. selection := self defaultSelection.! ! !OBList methodsFor: 'testing' stamp: 'cwp 11/9/2011 00:14'! isEmpty ^ parent isNil! ! !OBList methodsFor: 'testing' stamp: 'cwp 11/9/2011 22:45'! isSelected: aNode ^ self selectedNode = aNode! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/12/2011 21:05'! keystroke: aCharacter | scan col done node | scan := self announcer announce: OBNodeCommandScan. col := column. [col isNil] whileFalse: [node := col selectedNode. node ifNotNil: [done := scan processKeystroke: aCharacter asKeystroke withNode: node for: self. done ifTrue: [^ self]]. col := col previous]. scan processKeystroke: aCharacter asKeystroke withNode: column panel root for: self.! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/10/2011 17:53'! keystrokePreview: anEvent anEvent keyValue = 28 ifTrue: [^ self leftArrow]. anEvent keyValue = 29 ifTrue: [^ self rightArrow]. ^ false! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/10/2011 17:51'! leftArrow "Clear any selection in this list, and make the parent the current selection" self selection: 0. ^ true! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/8/2011 23:59'! list ^ self children collect: [ :ea | self parent displayStringForChild: ea ]! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/10/2011 13:59'! listAt: anInteger ^ self parent displayStringForChild: (children at: anInteger)! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/9/2011 00:58'! listSize ^ self children size! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/9/2011 16:49'! menu: aMenu self isEmpty ifFalse: [self addCommandsToMenu: aMenu]. ^aMenu! ! !OBList methodsFor: 'announcements' stamp: 'cwp 11/10/2011 15:33'! nodeChanged: ann (self children includes: ann node) ifTrue: [self refresh]! ! !OBList methodsFor: 'announcements' stamp: 'cwp 11/10/2011 16:18'! nodeDeleted: ann | oldSelectedNode previous | oldSelectedNode := self selectedNode. (self children includes: ann node) ifTrue: [self refresh]. oldSelectedNode = ann node ifTrue: [previous := column previous. previous ifNotNil: [self announceNodeDeselected: oldSelectedNode]]! ! !OBList methodsFor: 'nodes' stamp: 'cwp 11/8/2011 23:58'! nodeForItem: aString ^ self children detect: [ :child | (self parent displayStringForChild: child) = aString ] ifNone: [ aString ]! ! !OBList methodsFor: 'nodes' stamp: 'cwp 11/8/2011 23:57'! noteChild: aNode self parent noteChild: aNode! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/10/2011 21:40'! okToChange ^ (self announce: OBAboutToChange) isVetoed not! ! !OBList methodsFor: 'accessing' stamp: 'cwp 11/9/2011 00:21'! parent ^ parent! ! !OBList methodsFor: 'accessing' stamp: 'cwp 12/13/2011 01:14'! parent: aNode selection := 0. parent := aNode. children := parent ifNotNil: [parent childNodes]. self changed: #list.! ! !OBList methodsFor: 'nodes' stamp: 'cwp 12/3/2011 22:45'! refresh | node oldChildren | self isEmpty ifFalse: [node := self selectedNode. oldChildren := self children. children := self parent childNodes. children = oldChildren ifFalse: [selection := self indexOf: node. selection = 0 ifTrue: [ self announceNodeDeselected: node ] ifFalse: [ self announceNodeSelected: self selectedNode ]. self changed: #list ] ]! ! !OBList methodsFor: 'announcements' stamp: 'lr 12/4/2011 13:12'! refreshRequired: ann self refresh! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/10/2011 17:53'! rightArrow "If we have no selection, create one; if not, select the first item in the list to the right." self selection = 0 ifTrue: [self selection: self defaultSelection] ifFalse: [column next ifNotNil: [:col | col list selection: 1]]. ^ true! ! !OBList methodsFor: 'selecting' stamp: 'cwp 11/8/2011 23:52'! select: aNode self selection: (self indexOf: aNode)! ! !OBList methodsFor: 'selecting' stamp: 'cwp 11/9/2011 16:58'! selectSilently: aNode selection := self indexOf: aNode.! ! !OBList methodsFor: 'nodes' stamp: 'cwp 11/8/2011 23:47'! selectedNode ^ self selection = 0 ifFalse: [self children at: self selection]! ! !OBList methodsFor: 'callbacks' stamp: 'lr 5/28/2010 21:37'! selection ^ selection ifNil: [ selection := self defaultSelection ]! ! !OBList methodsFor: 'callbacks' stamp: 'cwp 11/11/2011 21:25'! selection: anInteger selection = anInteger ifFalse: [self changeSelection: anInteger ]! ! !OBList methodsFor: 'announcements' stamp: 'cwp 11/10/2011 17:10'! subscribe self announcer on: OBRefreshRequired send: #refreshRequired: to: self; on: OBNodeChanged send: #nodeChanged: to: self; on: OBNodeDeleted send: #nodeDeleted: to: self; on: OBChildrenChanged send: #childrenChanged: to: self.! ! !OBList methodsFor: 'nodes' stamp: 'cwp 11/10/2011 14:06'! switchFilter ^ parent ifNotNil: [parent metaNode 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: 'accessing' stamp: 'cwp 12/12/2011 16:56'! nullChildForParent: aNode ^ (aNode perform: selector) 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 nullEdge 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: '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: 'children' stamp: 'cwp 12/12/2011 16:51'! nullChildAt: aSelector put: aMetanode nullEdge := OBMetaEdge selector: aSelector metaNode: aMetanode! ! !OBMetaNode methodsFor: 'nodes' stamp: 'cwp 12/12/2011 16:55'! nullChildForParent: aNode ^ nullEdge ifNotNil: [nullEdge nullChildForParent: aNode]! ! !OBMetaNode methodsFor: 'accessing' stamp: 'cwp 12/12/2011 16:48'! nullEdge ^ nullEdge! ! !OBMetaNode methodsFor: 'accessing' stamp: 'cwp 12/12/2011 16:48'! nullEdge: anObject nullEdge := anObject! ! !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 11/25/2010 23:56'! announce: anObject "Announce anObject using the current announcer." ^ OBAnnouncer current announce: anObject! ! !OBNode methodsFor: 'updating' stamp: 'lr 11/25/2010 23:28'! announceChangedWith: anAnnouncer anAnnouncer announce: (OBNodeChanged node: self)! ! !OBNode methodsFor: 'updating' stamp: 'lr 11/25/2010 23:28'! announceChildrenChangedWith: anAnnouncer anAnnouncer announce: (OBChildrenChanged node: self)! ! !OBNode methodsFor: 'updating' stamp: 'lr 11/25/2010 23:29'! announceCreationWith: anAnnouncer anAnnouncer announce: (OBNodeCreated node: self)! ! !OBNode methodsFor: 'updating' stamp: 'lr 11/25/2010 23:29'! announceDeletionWith: anAnnouncer anAnnouncer announce: (OBNodeDeleted node: self) ! ! !OBNode methodsFor: 'updating' stamp: 'lr 11/25/2010 23:29'! announceSelectionWith: anAnnouncer (anAnnouncer announce: OBAboutToChange) isVetoed ifFalse: [ anAnnouncer 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: '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: 'lr 5/9/2011 19:32'! metaNode: aMetaNode "Make sure that no accidental changes of the meta node happens." (metaNode notNil and: [ aMetaNode notNil and: [ metaNode printString ~= aMetaNode printString ] ]) ifTrue: [ self error: 'Unable to change meta-node of ' , self printString ]. 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: 'public' stamp: 'cwp 12/12/2011 17:02'! nullChild ^ metaNode nullChildForParent: self! ! !OBNode methodsFor: 'copying' stamp: 'lr 5/9/2011 19:27'! postCopy super postCopy. metaNode := nil! ! !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: 'lr 11/25/2010 23:32'! signalCreation self announce: (OBNodeCreated node: self) ! ! !OBNode methodsFor: 'updating' stamp: 'cwp 6/4/2006 12:15'! signalDeletion self announce: (OBNodeDeleted node: self) ! ! !OBNode methodsFor: 'updating' stamp: 'lr 11/25/2010 23:38'! signalSelection "Select the receiving node unless somebody vetoes the change." (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: 'visiting' stamp: 'lr 11/17/2011 21:19'! acceptVisitor: aVisitor ^ aVisitor visitColumnPanel: self! ! !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: 'updating' stamp: 'cwp 11/10/2011 22:51'! handleSelectionIn: aColumn | column node | node := aColumn selectedNode. column := aColumn next. [column isNil] whileFalse: [column parent: node. node := column selectedNode. column := column next]. ! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'dr 11/4/2008 19:59'! hasSelection ^ false ! ! !OBColumnPanel methodsFor: 'navigating' stamp: 'cwp 11/10/2011 22:46'! hopTo: aNode | column | column := self columns last. [column refresh; 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: 'cwp 11/10/2011 16:15'! jumpTo: aNode | column | self selectAncestorsOf: aNode. column := self columns reversed detect: [:ea | ea selectedNode = aNode] ifNone: [^ self]. self clearAfter: column next. self announcer announce: (OBNodeSelected column: column node: aNode)! ! !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: 'announcements' stamp: 'cwp 11/10/2011 13:42'! nodeCreated: announcement ^ self hopTo: announcement node! ! !OBColumnPanel methodsFor: 'announcements' stamp: 'cwp 11/10/2011 16:23'! nodeDeleted: ann ann node = self root ifFalse: [ ^ self ]. current := nil. self selectionChangedIn: self columns first! ! !OBColumnPanel methodsFor: 'announcements' stamp: 'cwp 12/14/2011 22:27'! nodeDeselected: ann | previous | previous := self columnBefore: ann column. previous ifNil: [self handleSelectionIn: ann column. self announce: OBNoSelectedNode] ifNotNil: [current := previous selectedNode. self announce: (OBNodeSelected column: previous node: current)]. ! ! !OBColumnPanel methodsFor: 'announcements' stamp: 'cwp 11/10/2011 15:59'! nodeSelected: ann current := ann column selectedNode. self selectionChangedIn: ann column! ! !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: 'cwp 11/7/2011 18:01'! pushColumn: aColumn self columns addLast: aColumn. self changed: #widgets. ! ! !OBColumnPanel methodsFor: 'updating' stamp: 'cwp 11/7/2011 18:03'! reclaimPanes | old | old := columns size. [self okToReclaimPane] whileTrue: [self popColumn]. columns size = old ifFalse: [self changed: #widgets]! ! !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: 'navigating' stamp: 'cwp 8/19/2007 23:05'! selectSubtree: aSubtree aSubtree selectInColumns: columns! ! !OBColumnPanel methodsFor: 'accessing' stamp: 'cwp 3/11/2007 21:08'! selectedNode ^ self currentNode! ! !OBColumnPanel methodsFor: 'announcements' stamp: 'cwp 11/14/2011 00:54'! selectingNode: ann self jumpTo: ann node! ! !OBColumnPanel methodsFor: 'updating' stamp: 'cwp 11/10/2011 13:44'! selectionChangedIn: aColumn aColumn hasSelection ifTrue: [self handleSelectionIn: 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: 'announcements' stamp: 'cwp 11/14/2011 00:53'! subscribe self announcer on: OBSelectingNode send: #selectingNode: to: self; on: OBNodeSelected send: #nodeSelected: to: self; on: OBNodeDeselected send: #nodeDeselected: to: self; on: OBNodeCreated send: #nodeCreated: to: self; on: OBNodeDeleted send: #nodeDeleted: to: self.! ! !OBColumnPanel methodsFor: 'building' stamp: 'cwp 3/18/2007 20:36'! vResizing ^ #spaceFill! ! !OBColumnPanel methodsFor: 'callbacks' stamp: 'cwp 12/9/2011 12:44'! widgets ^ OBBuilder current widgetsForColumnPanel: self! ! OBPanel subclass: #OBFixedButtonPanel instanceVariableNames: 'factories buttons commands' 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 methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:20'! acceptVisitor: aVisitor ^ aVisitor visitFixedButtonPanel: self! ! !OBFixedButtonPanel methodsFor: 'initialize-release' stamp: 'cwp 11/23/2011 22:58'! browser: aBrowser | aDictionary buttons | super browser: aBrowser. aDictionary := browser buttonFactories. factories := self sortFactories: aDictionary keys. buttons := Array new: factories size. factories withIndexDo: [:ea :index || button | button := OBButton label: (aDictionary at: ea). button action: [self executeAt: index]; enabled: [self isEnabledAt: index]. buttons at: index put: button]. self buttons: buttons! ! !OBFixedButtonPanel methodsFor: 'building' stamp: 'cwp 7/25/2007 23:52'! buildOn: aBuilder ^aBuilder fixedButtonBar: self with: []! ! !OBFixedButtonPanel methodsFor: 'accessing' stamp: 'cwp 11/23/2011 23:51'! buttons ^ buttons! ! !OBFixedButtonPanel methodsFor: 'accessing' stamp: 'cwp 11/23/2011 23:51'! buttons: anArray buttons := anArray! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'dr 1/30/2009 17:29'! color ^browser defaultBackgroundColor ! ! !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: 'cwp 11/23/2011 22:42'! executeAt: index (commands at: index) execute! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'cwp 11/23/2011 22:51'! isEnabledAt: index | cmd | ^ commands ifNil: [false] ifNotNil: [cmd := commands at: index. cmd isActive and: [cmd isEnabled]]! ! !OBFixedButtonPanel methodsFor: 'callbacks' stamp: 'lr 3/13/2010 17:05'! isSelected: aNode ^ aNode notNil! ! !OBFixedButtonPanel methodsFor: 'announcements' stamp: 'cwp 11/23/2011 22:58'! nodeSelected: ann commands := factories collect: [ :ea | ea on: ann node for: self ]. self buttons do: [ :ea | ea changed: #isEnabled ]! ! !OBFixedButtonPanel methodsFor: 'initialize-release' stamp: 'cwp 11/23/2011 21:31'! sortFactories: aSet | grouped groups cmds map | map := Dictionary new. aSet do: [:ea | map at: (ea on: nil for: self) put: ea]. cmds := map keys. groups := (cmds collect: [ :ea | ea group ]) asSet asSortedCollection: [ :a :b | a > b ]. grouped := groups collect: [ :ea | (cmds select: [ :b | b group = ea ]) asSortedCollection: [ :a :b | a order <= b order ] ]. ^ Array streamContents: [:out | grouped do: [:group | group do: [:cmd | out nextPut: (map at: cmd)]]]! ! !OBFixedButtonPanel methodsFor: 'announcements' stamp: 'cwp 11/17/2011 00:43'! subscribe self announcer on: OBNodeSelected send: #nodeSelected: 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: 'visiting' stamp: 'lr 11/17/2011 21:16'! acceptVisitor: aVisitor ^ aVisitor visitPanel: self! ! !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: 'testing' stamp: 'cwp 11/3/2011 16:02'! isVerticallyElastic ^ self vResizing = #spaceFill! ! !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 11/26/2010 00:04'! 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: 'visiting' stamp: 'lr 11/17/2011 21:24'! acceptVisitor: aVisitor ^ aVisitor visitDefinitionPanel: self! ! !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: 'cwp 12/9/2011 22:15'! definitionChanged: ann definition := ann definition. selection := nil. Transcript cr; show: 'text changed'. 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: '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: 'updating' stamp: 'cwp 12/14/2011 22:21'! noSelectedNode: ann self node: nil! ! !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: 'cwp 11/10/2011 15:59'! nodeSelected: ann self node: ann column selectedNode! ! !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: 'cwp 12/14/2011 22:28'! subscribe self announcer on: OBAboutToChange send: #aboutToChange: to: self; on: OBAboutToChangeSilently send: #aboutToChangeSilently: to: self; on: OBNodeSelected send: #nodeSelected: to: self; on: OBNodeChanged send: #nodeChanged: to: self; on: OBNoSelectedNode send: #noSelectedNode: to: self; on: OBRefreshRequired send: #refresh: to: self; on: 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: 'visiting' stamp: 'lr 11/17/2011 21:24'! acceptVisitor: aVisitor ^ aVisitor visitTextPanel: self! ! !OBTextPanel methodsFor: 'callbacks' stamp: 'lr 12/4/2011 13:27'! keystroke: anEvent selection: anInterval in: aView | sel com | sel := OBTextSelection on: anInterval inText: self text. ^ (self announcer announce: OBTextCommandScan) processKeystroke: anEvent asKeystroke withNode: sel for: self in: aView! ! !OBTextPanel methodsFor: 'callbacks' stamp: 'cwp 11/20/2011 23:21'! menu: aMenu shifted: aBoolean selection: anInterval | sel | sel := OBTextSelection on: anInterval inText: self text. (self announce: OBTextCommandScan) populateMenu: aMenu withNodes: (Array with: sel) forRequestor: self. ^ aMenu! ! Object subclass: #OBPlatform instanceVariableNames: '' classVariableNames: 'Current' poolDictionaries: '' category: 'OmniBrowser-Platform'! !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 ! ! Object subclass: #OBSubtree instanceVariableNames: 'state' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Utilities'! !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 bar' 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: 'visiting' stamp: 'lr 11/17/2011 21:38'! acceptVisitor: aVisitor ^ aVisitor visitSwitch: self! ! !OBSwitch methodsFor: 'accessing' stamp: 'cwp 11/21/2011 11:04'! bar ^ bar! ! !OBSwitch methodsFor: 'building' stamp: 'dr 10/21/2008 13:34'! buildOn: aBuilder ^aBuilder radioButtonBar: self with: []! ! !OBSwitch methodsFor: 'updating' stamp: 'cwp 11/6/2011 21:55'! buttons ^ self buttonsWithLabels: self labels.! ! !OBSwitch methodsFor: 'updating' stamp: 'cwp 11/6/2011 21:54'! buttonsWithLabels: labels | buttons | buttons := Array new: labels size. labels withIndexDo: [:label :index || b | b := (OBButton label: label) action: [self selection: index]; pressed: [self selection = index]. buttons at: index put: b]. ^ buttons! ! !OBSwitch methodsFor: 'updating' stamp: 'cwp 11/9/2011 10:27'! currentNode: aNode self refresh. ! ! !OBSwitch methodsFor: 'accessing' stamp: 'cwp 5/18/2007 00:06'! filter ^ filter! ! !OBSwitch methodsFor: 'public' stamp: 'cwp 11/9/2011 10:27'! filter: aFilter filter := aFilter. filter isNil ifTrue: [ ^ self ]. filter activate. self refresh. ! ! !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: 'cwp 11/6/2011 22:05'! labels ^ filter isNil ifFalse: [ (filter listForNode: column selectedNode) asArray ] ifTrue: [ #() ]! ! !OBSwitch methodsFor: 'accessing' stamp: 'cwp 11/7/2011 00:36'! list ^ self labels! ! !OBSwitch methodsFor: 'accessing' stamp: 'dkh 3/21/2009 13:49'! longDescriptions ^ filter ifNotNil: [filter longDescriptionsForNode: column selectedNode] ifNil: [#()]! ! !OBSwitch methodsFor: 'updating' stamp: 'cwp 11/10/2011 15:59'! nodeSelected: ann column == ann column ifTrue: [ self currentNode: ann node ]! ! !OBSwitch methodsFor: 'accessing' stamp: 'lr 12/3/2009 19:03'! okToChange ^ column okToChange! ! !OBSwitch methodsFor: 'updating' stamp: 'cwp 11/9/2011 10:27'! refresh (bar labels = self labels asArray) ifFalse: [bar buttons: self buttons]. "This is only needed for OBBuilder-based browsers" self changed: #list.! ! !OBSwitch methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:31'! selection ^ filter isNil ifFalse: [ filter selection ] ifTrue: [ 0 ]! ! !OBSwitch methodsFor: 'accessing' stamp: 'cwp 11/10/2011 22:48'! selection: anInteger filter isNil ifTrue: [ ^ self ]. filter selection: anInteger. bar refreshPressed. column refresh. "This is only needed for OBBuilder-based browsers" self changed: #selection. ! ! !OBSwitch methodsFor: 'initialize-release' stamp: 'cwp 11/9/2011 16:45'! setColumn: aColumn filter: aFilter column := aColumn. filter := aFilter. bar := OBButtonBar new. ! ! !OBSwitch methodsFor: 'initialize-release' stamp: 'cwp 11/10/2011 16:01'! subscribe column announcer on: OBNodeSelected send: #nodeSelected: to: self! ! 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: 'querying' stamp: 'cwp 10/14/2006 20:15'! fullText ^ text! ! !OBTextSelection methodsFor: 'testing' stamp: 'lr 12/10/2010 09:32'! hasSelection ^ self selection notEmpty! ! !OBTextSelection methodsFor: 'testing' stamp: 'cwp 10/14/2006 20:44'! hasSelector ^ self selector notNil! ! !OBTextSelection methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:41'! selection "Answer the selection interval of the receiver." ^ selection! ! !OBTextSelection methodsFor: 'accessing' stamp: 'lr 12/10/2010 09:41'! selection: anInterval "Update the selection interval of the receiver." selection := anInterval! ! !OBTextSelection methodsFor: 'querying' stamp: 'cwp 10/14/2006 21:31'! selector ^ self text asString findSelector! ! !OBTextSelection methodsFor: 'initialization' stamp: 'dr 9/1/2008 10:23'! setSelection: anInterval inText: aString selection := anInterval. text := aString ! ! !OBTextSelection methodsFor: 'querying' stamp: 'cwp 10/14/2006 20:14'! text ^ text atAll: selection! ! Object subclass: #OBVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Platform'! OBVisitor subclass: #OBBuilder instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OmniBrowser-Platform'! !OBBuilder class methodsFor: 'building' stamp: 'cwp 12/9/2011 12:52'! build: aModel ^ self new build: aModel! ! !OBBuilder class methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 12:44'! current ^ OBBuilderRequest signal! ! !OBBuilder methodsFor: 'building' stamp: 'cwp 12/9/2011 12:53'! build: anObject ^ [anObject acceptVisitor: self] on: OBBuilderRequest do: [:req | req resume: self]. ! ! !OBBuilder methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 00:01'! widgetsForColumn: aColumn self subclassResponsibility! ! !OBBuilder methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2011 00:00'! widgetsForColumnPanel: aPanel self subclassResponsibility! ! !OBVisitor methodsFor: 'public' stamp: 'lr 11/17/2011 21:17'! visit: aModel ^ aModel acceptVisitor: self! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:17'! visitBrowser: aBrowser ^ self subclassResponsibility! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:35'! visitButton: aButton ^ self subclassResponsibility! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:35'! visitButtonBar: aButtonBar ^ self subclassResponsibility! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:17'! visitColumn: aColumn ^ self subclassResponsibility! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:18'! visitColumnPanel: aColumnPanel ^ self visitPanel: aColumnPanel! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:22'! visitDefinitionPanel: aDefinitionPanel ^ self visitTextPanel: aDefinitionPanel! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:20'! visitFixedButtonPanel: aFixedButtonPanel ^ self visitPanel: aFixedButtonPanel! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:17'! visitList: aColumn ^ self subclassResponsibility! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:17'! visitPanel: aColumn ^ self subclassResponsibility! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:35'! visitSwitch: aSwitch ^ self subclassResponsibility! ! !OBVisitor methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:22'! visitTextPanel: aTextPanel ^ self visitPanel: aTextPanel! ! !Object methodsFor: '*omnibrowser-converting' stamp: 'cwp 4/17/2006 12:16'! asAnnouncement ^ self! ! !KeyboardEvent methodsFor: '*omnibrowser-converting' stamp: 'lr 5/20/2011 19:20'! asKeystroke ^ OBKeystroke key: self keyCharacter shift: self shiftPressed control: self controlKeyPressed option: (buttons anyMask: 32) command: self commandKeyPressed! !