SystemOrganization addCategory: #'OB-Standard-Announcements'! SystemOrganization addCategory: #'OB-Standard-Browsers'! SystemOrganization addCategory: #'OB-Standard-Commands'! SystemOrganization addCategory: #'OB-Standard-Definitions'! SystemOrganization addCategory: #'OB-Standard-Filters'! SystemOrganization addCategory: #'OB-Standard-Nodes'! SystemOrganization addCategory: #'OB-Standard-Panels'! SystemOrganization addCategory: #'OB-Standard-Utilities'! !String class methodsFor: '*ob-standard' stamp: 'lr 3/29/2009 14:20'! browserIcon ^ #string! ! !SystemOrganizer methodsFor: '*ob-standard-testing' stamp: 'cwp 9/18/2004 23:58'! isClassOrganizer ^ false! ! !Trait methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:28'! asClassSideNode ^ OBMetaclassNode on: self! ! !Trait methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:28'! asNode ^ OBClassNode on: self! ! !Trait methodsFor: '*ob-standard' stamp: 'dr 10/29/2008 15:40'! packageName ^''! ! OBBrowser subclass: #OBCodeBrowser instanceVariableNames: 'hasChanges' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBCodeBrowser commentStamp: 'cwp 1/7/2005 23:45' prior: 0! OBCodeBrowser is a superclass for all browsers which active code in the image. It provides methods for registering with the SystemChangeNotifier and updating it's display when it receives notification of system changes.! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 2/17/2009 20:38'! annotationPanel ^ Preferences annotationPanes ifTrue: [ OBAnnotationPanel new ]! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'cwp 5/20/2007 00:02'! buildMetagraphOn: root ^ self buildMetagraphOn: root class: #classes comment: #comments metaclass: #metaclasses! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'PDC 6/27/2007 08:21'! buildMetagraphOn: root class: classSel comment: commentSel metaclass: metaclassSel ^ (OBMetagraphBuilder on: root class: classSel comment: commentSel metaclass: metaclassSel) execute! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'avi 5/30/2007 22:09'! chasingBrowsers ^ Preferences chasingBrowsers! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 2/17/2009 20:39'! defaultBrowserClass ^ OBSystemBrowser! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'PDC 6/27/2007 23:02'! defaultRootNode ^nil! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 2/17/2009 20:40'! hierarchyBrowserClass ^ OBHierarchyBrowser! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'avi 5/30/2007 22:10'! initialize "OBCodeBrowser initialize" Preferences addPreference: #chasingBrowsers categories: #('browsing') default: true balloonHelp: 'Use recursive multi-column browsers for senders, implementors, etc.'! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'ms 5/8/2007 18:33'! mercuryPanel ^ Preferences mercuryPanel ifTrue:[OBMercuryPanel new] ifFalse:[nil]! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'cwp 12/15/2004 22:52'! optionalButtons ^ #('browse' 'variables' 'hierarchy' 'inheritance' 'senders' 'implementors' 'versions')! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 3/4/2009 08:23'! panels ^ (Array with: self mercuryPanel with: self navigationPanel with: self annotationPanel with: self optionalButtonPanel with: self definitionPanel) reject: [:ea | ea isNil]! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'dr 10/18/2008 10:35'! unload Preferences removePreference: #chasingBrowsers! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'cwp 1/8/2005 21:55'! addModelItemsToWindowMenu: aMenu Smalltalk at: #SystemBrowser ifPresent: [:class | class addRegistryMenuItemsTo: aMenu inAccountOf: OBSystemBrowserAdaptor new].! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'cwp 1/7/2005 23:47'! clearChanges hasChanges := false! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:17'! cmdAutoCategorizeCat ^OBCmdAutoCategorize! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:17'! cmdBrowse ^OBCmdBrowse! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:18'! cmdBrowseHierarchy ^OBCmdBrowseHierarchy! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'dr 7/2/2007 17:08'! cmdBrowseHierarchyImplementors ^OBCmdBrowseHierarchyImplementors! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'dr 7/2/2007 17:09'! cmdBrowseHierarchySenders ^OBCmdBrowseHierarchySenders! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:18'! cmdBrowseImplementors ^OBCmdBrowseImplementors! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:18'! cmdBrowseImplementorsOfIt ^OBCmdBrowseImplementorsOfIt! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:18'! cmdBrowseInheritance ^OBCmdBrowseInheritance! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:19'! cmdBrowseMethodVersions ^OBCmdBrowseMethodVersions! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'jk 5/18/2007 10:08'! cmdBrowseProtocol ^ OBCmdBrowseProtocol ! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 12/7/2006 22:17'! cmdBrowseReferences ^ OBCmdBrowseReferences! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:19'! cmdBrowseSenders ^OBCmdBrowseSenders! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:37'! cmdBrowseSendersOfIt ^OBCmdBrowseSendersOfIt! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:37'! cmdChaseVariables ^OBCmdChaseVariables! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'dr 12/16/2008 10:31'! cmdCompareToCurrent ^OBCmdCompareToCurrent! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/2/2006 21:46'! cmdCopyClass ^ OBCmdCopyClass! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'dc 1/16/2008 13:21'! cmdCreateCat ^Array with: OBCmdCreateClassCategory with: OBCmdCreateMethodCategory ! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:37'! cmdFileOut ^OBCmdFileOut! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 3/5/2009 20:38'! cmdFindClass ^ OBCmdFindClass! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'DM 5/23/2007 20:37'! cmdMethodsContainingIt ^ OBCmdBrowseMethodsWithIt! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'ms 6/26/2007 16:21'! cmdMultiView ^ OBCmdMultiView! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'dc 4/23/2007 14:34'! cmdNewClassTemplate ^ OBCmdNewClassTemplate ! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'dr 9/30/2008 11:30'! cmdRemoveCat ^OBCmdRemoveCat! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/3/2006 00:14'! cmdRemoveClass ^ OBCmdRemoveClass! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cb 7/18/2007 17:25'! cmdRemoveElement ^ OBCmdRemoveElement! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:38'! cmdRemoveEmptyCats ^OBCmdRemoveEmptyCats! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 12/9/2006 21:43'! cmdRemoveMethod ^ OBCmdRemoveMethod! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:39'! cmdRenameCat ^OBCmdRenameCat! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/2/2006 23:57'! cmdRenameClass ^ OBCmdRenameClass! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:39'! cmdReorgCats ^OBCmdReorgCats! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cb 7/19/2007 15:05'! cmdResetSearch ^ OBCmdResetSearch! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 11/1/2006 23:39'! cmdRevertMethod ^OBCmdRevertMethod! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'dc. 12/15/2007 15:26'! cmdSelectMethodCategory ^ OBCmdSelectMethodCategory ! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'cwp 12/7/2006 23:40'! cmdSubclassTemplate ^ OBCmdSubclassTemplate! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'dr 10/24/2008 18:57'! event: anEvent self noteChanges! ! !OBCodeBrowser methodsFor: 'morphic' stamp: ''! initialExtent hasChanges := false. self register. ^ super initialExtent! ! !OBCodeBrowser methodsFor: 'testing' stamp: 'cwp 4/18/2007 23:48'! isClassBrowser ^ false! ! !OBCodeBrowser methodsFor: 'testing' stamp: 'dr 2/7/2008 17:20'! isSearchBrowser ^ false! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'cwp 4/15/2007 23:07'! noteChanges hasChanges := true! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'dr 10/24/2008 16:06'! register SystemChangeNotifier uniqueInstance notify: self ofAllSystemChangesUsing: #event:.! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'dr 7/16/2008 15:19'! release "work-around for bug #7119" super release. self panels do: [:panel | panel release].! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'dr 10/24/2008 17:18'! stepAt: milliseconds in: aSystemWindow hasChanges ifTrue: [self signalRefresh]. self clearChanges! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'dr 10/24/2008 16:06'! unregister SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self. ! ! !OBCodeBrowser methodsFor: 'morphic' stamp: ''! wantsStepsIn: aSystemWindow ^ true! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'dr 11/20/2008 09:51'! windowIsClosing self unregister! ! OBCodeBrowser subclass: #OBHierarchyBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBHierarchyBrowser commentStamp: 'cwp 1/7/2005 23:50' prior: 0! OBHierarchyBrowser provides a three-pane browers that displays a class within it's surrounding hierarchy - both superclasses and subclasses! !OBHierarchyBrowser class methodsFor: 'configuration' stamp: 'lr 4/3/2009 14:00'! defaultMetaNode | rootClass | rootClass := OBMetaNode named: 'root'. self buildMetagraphOn: rootClass class: #classHierarchy comment: #commentHierarchy metaclass: #metaclassHierarchy. rootClass edges do: [ :each | each metaNode doubleClickSelector: #browseHierarchy ]. ^ rootClass! ! !OBHierarchyBrowser class methodsFor: 'instance creation' stamp: 'lr 3/6/2006 19:28'! onClass: aClass ^self root: aClass asNode selection: aClass asNode! ! !OBHierarchyBrowser class methodsFor: 'opening' stamp: 'cwp 12/15/2004 22:49'! openOnClass: aClass ^ (self onClass: aClass) open! ! !OBHierarchyBrowser class methodsFor: 'configuration' stamp: 'cwp 12/13/2004 00:37'! paneCount ^ 3! ! !OBHierarchyBrowser class methodsFor: 'configuration' stamp: 'cwp 12/13/2004 01:00'! titleForRoot: aNode ^ aNode name, ' Hierarchy'! ! !OBHierarchyBrowser methodsFor: 'as yet unclassified' stamp: 'dr 1/30/2009 17:23'! defaultBackgroundColor | color | color := Preferences browserWindowColor. ^ color == false ifTrue: [Color lightGreen] ifFalse: [color]! ! !OBHierarchyBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 12/13/2004 01:00'! defaultLabel ^ self root name, ' Hierarchy'! ! OBCodeBrowser subclass: #OBInheritanceBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBInheritanceBrowser commentStamp: 'cwp 1/7/2005 23:51' prior: 0! OBInheritanceBrowser shows the inheritance hierarchy of a method, both superclass implementations which it overrides, and subclass implementations which override it.! !OBInheritanceBrowser class methodsFor: 'configuration' stamp: 'cwp 5/14/2007 13:45'! defaultMetaNode | method root | method := OBMetaNode named: 'Method'. root := OBMetaNode named: 'Root'. root childAt: #children put: method. method displaySelector: #fullName; ancestrySelector: #isDescendantOfMethod:; childAt: #overrides put: method. ^ root! ! !OBInheritanceBrowser class methodsFor: 'configuration' stamp: ''! title ^ 'Inheritance'! ! !OBInheritanceBrowser class methodsFor: 'configuration' stamp: 'cwp 11/25/2004 22:05'! titleForRoot: aCollectionNode ^ 'Inheritance of ', aCollectionNode children first selector printString! ! !OBInheritanceBrowser methodsFor: 'morphic' stamp: 'avi 11/29/2004 21:52'! defaultBackgroundColor ^ Color lightGreen! ! OBCodeBrowser subclass: #OBListBrowser instanceVariableNames: 'labelPrefix label' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBListBrowser commentStamp: 'cwp 1/7/2005 23:53' prior: 0! OBListBrowsers are used to display simple lists of methods, such as senders or implementors.! OBListBrowser subclass: #OBImplementorsBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! OBImplementorsBrowser subclass: #OBHierarchyImplementorsBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBHierarchyImplementorsBrowser class methodsFor: 'configuration' stamp: 'dr 4/17/2007 16:54'! defaultMetaNode ^self implementorsNav: #hierarchyImplementors! ! !OBHierarchyImplementorsBrowser class methodsFor: 'configuration' stamp: 'dr 4/17/2007 16:53'! title ^'Hierarchy Implementors of'! ! !OBImplementorsBrowser class methodsFor: 'as yet unclassified' stamp: 'dr 7/2/2007 14:47'! defaultMetaNode ^self implementorsNav: #implementors.! ! !OBImplementorsBrowser class methodsFor: 'as yet unclassified' stamp: 'dr 10/21/2008 12:56'! implementorsNav: navSelector | selector message implementor | selector := OBMetaNode named: 'Selector'. message := OBMetaNode named: 'Message'. implementor := OBMetaNode named: 'Implementor'. selector childAt: navSelector put: implementor; addFilter: OBClassSortFilter new. implementor displaySelector: #fullNameWithProtocol. self chasingBrowsers ifTrue: [implementor childAt: #messages put: message. message childAt: navSelector put: implementor]. ^selector! ! !OBImplementorsBrowser class methodsFor: 'as yet unclassified' stamp: 'avi 9/17/2005 01:36'! title ^ 'Implementors of'! ! !OBListBrowser class methodsFor: 'opening' stamp: 'avi 9/17/2005 01:34'! browseRoot: aNode self browseRoot: aNode title: self title! ! !OBListBrowser class methodsFor: 'opening' stamp: 'dr 2/10/2009 16:23'! browseRoot: aNode label: aString (self metaNode: self defaultMetaNode root: aNode selection: nil) label: aString; open ! ! !OBListBrowser class methodsFor: 'opening' stamp: 'avi 9/17/2005 01:21'! browseRoot: aNode title: aString (self metaNode: self defaultMetaNode root: aNode selection: nil) labelPrefix: aString; open ! ! !OBListBrowser class methodsFor: 'configuration' stamp: 'cwp 12/5/2004 17:54'! maxPanes ^ 2! ! !OBListBrowser class methodsFor: 'configuration' stamp: 'cwp 12/5/2004 17:54'! minPanes ^ 1! ! !OBListBrowser methodsFor: 'morphic' stamp: 'dr 9/22/2008 11:28'! defaultBackgroundColor ^ Color lightBlue ! ! !OBListBrowser methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:17'! defaultLabel label isNil ifFalse: [ ^ label ]. ^ self labelPrefix , ' ' , self root name printString! ! !OBListBrowser methodsFor: 'accessing' stamp: 'dr 2/10/2009 16:23'! label: aString label := aString! ! !OBListBrowser methodsFor: 'accessing' stamp: 'cwp 11/25/2004 22:18'! labelPrefix ^ labelPrefix ifNil: [labelPrefix := self root metaNode edges first label capitalized, ' of']! ! !OBListBrowser methodsFor: 'accessing' stamp: 'cwp 10/17/2004 20:54'! labelPrefix: aString labelPrefix := aString! ! OBListBrowser subclass: #OBMethodStringsBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBMethodStringsBrowser class methodsFor: 'as yet unclassified' stamp: 'DM 5/23/2007 20:21'! browseRoot: aNode target: targetNode (self root: aNode selection: targetNode) open.! ! !OBMethodStringsBrowser class methodsFor: 'as yet unclassified' stamp: 'DM 5/23/2007 20:43'! defaultMetaNode | matches selection | selection := OBMetaNode named: 'Selection'. matches := OBMetaNode named: 'Methods'. selection childAt: #methods put: matches. matches displaySelector: #fullName; ancestrySelector: #isAncestorOf:. ^ selection! ! !OBMethodStringsBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 6/21/2007 15:30'! defaultBackgroundColor | color | color := Preferences messageListWindowColor. ^ color isColor ifFalse: [super defaultBackgroundColor] ifTrue: [color]! ! !OBMethodStringsBrowser methodsFor: 'as yet unclassified' stamp: 'DM 5/23/2007 20:24'! defaultLabel ^ 'Methods with literal', self selectorString, self numOfMatchesString! ! !OBMethodStringsBrowser methodsFor: 'as yet unclassified' stamp: 'DM 5/23/2007 20:26'! numOfMatchesString ^ '[' , self root methods size asString , ']'! ! !OBMethodStringsBrowser methodsFor: 'as yet unclassified' stamp: 'DM 5/23/2007 20:23'! selectorString ^ ' ''', self root selector string, ''' '! ! OBListBrowser subclass: #OBReferencesBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBReferencesBrowser class methodsFor: 'configuration' stamp: 'dr 10/29/2008 15:53'! defaultMetaNode | class method sender | class := OBMetaNode named: 'Class'. method := OBMetaNode named: 'References'. sender := OBMetaNode named: 'Sender'. class childAt: #users put: method. method displaySelector: #fullNameWithProtocol. self chasingBrowsers ifTrue: [method childAt: #senders put: sender. sender displaySelector: #fullNameWithProtocol; childAt: #senders put: sender]. ^ class! ! !OBReferencesBrowser class methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:34'! title ^ 'References to'! ! OBListBrowser subclass: #OBSendersBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! OBSendersBrowser subclass: #OBHierarchySendersBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBHierarchySendersBrowser class methodsFor: 'configuration' stamp: 'dr 4/19/2007 10:57'! defaultMetaNode ^self sendersNav: #hierarchySenders. ! ! !OBHierarchySendersBrowser class methodsFor: 'configuration' stamp: 'dr 7/2/2007 16:55'! title ^'Hierarchy Senders of' ! ! !OBSendersBrowser class methodsFor: 'defaults' stamp: 'dr 7/2/2007 14:46'! defaultMetaNode ^self sendersNav: #senders! ! !OBSendersBrowser class methodsFor: 'as yet unclassified' stamp: 'dr 10/21/2008 12:56'! sendersNav: navSelector | selector sender | selector := OBMetaNode named: 'Selector'. sender := OBMetaNode named: 'Sender'. selector childAt: navSelector put: sender; addFilter: OBRescueFilter new. sender displaySelector: #fullNameWithProtocol; addFilter: OBRescueFilter new. self chasingBrowsers ifTrue: [sender childAt: navSelector put: sender]. ^ selector ! ! !OBSendersBrowser class methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:36'! title ^ 'Senders of'! ! OBListBrowser subclass: #OBVariablesBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBVariablesBrowser class methodsFor: 'private' stamp: 'PDC 6/27/2007 22:49'! addChasingFiltersTo: nodes (nodes at: #method) childAt: #senders put: (nodes at: #message); addFilter: OBModalFilter new. (nodes at: #var) addFilter: OBModalFilter new. (nodes at: #message) displaySelector: #fullName; childAt: #senders put: (nodes at: #message); addFilter: OBModalFilter new! ! !OBVariablesBrowser class methodsFor: 'private' stamp: 'PDC 6/27/2007 22:52'! buildClassNodeIn: nodeDictionary (nodeDictionary at: #class) childAt: #instanceVariables labeled: 'instance' put: (nodeDictionary at: #var); childAt: #classVariables labeled: 'class' put: (nodeDictionary at: #var); addFilter: OBModalFilter new! ! !OBVariablesBrowser class methodsFor: 'private' stamp: 'PDC 6/27/2007 22:52'! buildMethodNodeIn: nodeDictionary (nodeDictionary at: #method) displaySelector: #fullName! ! !OBVariablesBrowser class methodsFor: 'private' stamp: 'PDC 6/27/2007 22:53'! buildVarNodeIn: nodeDictionary (nodeDictionary at: #var) childAt: #accessors put: (nodeDictionary at: #method); addFilter: OBClassSortFilter new! ! !OBVariablesBrowser class methodsFor: 'private' stamp: 'PDC 6/27/2007 22:55'! connectNodesIn: nodeDictionary self buildClassNodeIn: nodeDictionary; buildVarNodeIn: nodeDictionary; buildMethodNodeIn: nodeDictionary! ! !OBVariablesBrowser class methodsFor: 'configuration' stamp: 'PDC 6/27/2007 22:55'! defaultMetaNode | nodes | nodes := Dictionary new. self initializeNodesIn: nodes; connectNodesIn: nodes. self chasingBrowsers ifTrue: [self addChasingFiltersTo: nodes]. ^ nodes at: #class! ! !OBVariablesBrowser class methodsFor: 'private' stamp: 'PDC 6/27/2007 22:51'! initializeNodesIn: nodeDictionary nodeDictionary at: #class put: (OBMetaNode named: 'Class'); at: #var put: (OBMetaNode named: 'Variable'); at: #method put: (OBMetaNode named: 'Method'); at: #message put: (OBMetaNode named: 'Message')! ! !OBVariablesBrowser class methodsFor: 'configuration' stamp: 'avi 5/30/2007 22:13'! minPanes ^ 2! ! !OBVariablesBrowser class methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:35'! title ^ 'Variables of'! ! OBCodeBrowser subclass: #OBProtocolBrowser instanceVariableNames: 'theClass limitClass filter' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBProtocolBrowser class methodsFor: 'configuration' stamp: 'DM 5/23/2007 15:33'! defaultMetaNode | protocol method class | class := OBMetaNode named: 'Class'. protocol := OBMetaNode named: 'Protocol'. method := OBMetaNode named: 'Method'. class ancestrySelector: #isDescendantOfClass:; childAt: #allCategories put: protocol. protocol ancestrySelector: #isDescendantOfMethodCat:; childAt: #allMethods put: method. method ancestrySelector: #isDescendantOfMethod:; displaySelector: #nameWithClassNameInBrackets. ^ class! ! !OBProtocolBrowser class methodsFor: 'configuration' stamp: 'DM 5/20/2007 15:31'! on: aNode ^ (self root: aNode selection: aNode) open! ! !OBProtocolBrowser class methodsFor: 'configuration' stamp: 'DM 5/20/2007 02:32'! paneCount ^ 2.! ! !OBProtocolBrowser methodsFor: 'commands' stamp: 'DM 5/21/2007 16:36'! cmdFilterProtocol ^ OBCmdLimitProtocol! ! !OBProtocolBrowser methodsFor: 'building' stamp: 'cwp 5/31/2007 21:26'! defaultBackgroundColor | color | color := Preferences lexiconWindowColor. ^ color == false ifTrue: [Color lightGreen] ifFalse: [color]! ! !OBProtocolBrowser methodsFor: 'accessing' stamp: 'DM 5/20/2007 15:33'! defaultLabel ^ 'Vocabulary of ' , self root theClass name.! ! !OBProtocolBrowser methodsFor: 'accessing' stamp: 'DM 5/22/2007 18:41'! defaultLimitClass ^ (theClass isKindOf: Metaclass) ifTrue: [Object class] ifFalse: [Object]! ! !OBProtocolBrowser methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:20'! limitClass ^ limitClass isNil ifTrue: [ self defaultLimitClass ] ifFalse: [ limitClass ]! ! !OBProtocolBrowser methodsFor: 'accessing' stamp: 'DM 5/31/2007 14:55'! limitClass: ann limitClass := ann node. filter limitClass: ann node! ! !OBProtocolBrowser methodsFor: 'updating' stamp: 'DM 5/31/2007 14:54'! refresh: ann panels do: [:p | p changed: #commands].! ! !OBProtocolBrowser methodsFor: 'initialization' stamp: 'DM 5/23/2007 14:38'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. theClass := aNode theClass. filter := OBLimitProtocolFilter on: aNode theClass. aMetaNode addFilter: filter! ! !OBProtocolBrowser methodsFor: 'updating' stamp: 'DM 5/31/2007 14:57'! subscribe super subscribe. self announcer observe: OBRefreshRequired send: #refresh: to: self; observe: OBNodeChanged send: #limitClass: to: self.! ! !OBProtocolBrowser methodsFor: 'private' stamp: 'DM 5/23/2007 15:25'! theClass ^ theClass.! ! OBCodeBrowser subclass: #OBSearchBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBSearchBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 5/19/2007 23:33'! defaultMetaNode | root search | root := OBMetaNode named: 'root'. search := OBMetaNode named: 'search'. root childAt: #children put: search. self buildMetagraphOn: search. ^root! ! !OBSearchBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 4/1/2007 22:56'! defaultRootNode ^ OBCollectionNode on: IdentitySet new! ! !OBSearchBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 4/16/2007 00:17'! initialize self registerInOpenMenu! ! !OBSearchBrowser class methodsFor: 'as yet unclassified' stamp: 'lr 2/17/2009 20:55'! mercuryPanel ^ OBMercuryPanel new! ! !OBSearchBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 4/16/2007 00:16'! registerInOpenMenu TheWorldMenu registerOpenCommand: {'Search Browser'. {self. #open}}. ! ! !OBSearchBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 4/16/2007 00:18'! title ^ 'Search Browser'! ! !OBSearchBrowser class methodsFor: 'as yet unclassified' stamp: 'dr 10/18/2008 10:36'! unload TheWorldMenu unregisterOpenCommandWithReceiver: self.! ! !OBSearchBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 4/15/2007 23:20'! with: aSearchNode ^ self metaNode: self defaultMetaNode root: (OBCollectionNode on: (OrderedCollection with: aSearchNode)) selection: aSearchNode! ! !OBSearchBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 4/1/2007 23:01'! defaultBackgroundColor ^ Color lightGreen ! ! !OBSearchBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 4/15/2007 22:28'! isSearchBrowser ^ true! ! OBCodeBrowser subclass: #OBSystemBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBSystemBrowser commentStamp: 'cwp 1/7/2005 23:56' prior: 0! This is the basic system browser that is the work-horse of Smalltalk development tools. It presents four panes showing class categories, classes, method categories and methods.! !OBSystemBrowser class methodsFor: 'configuration' stamp: 'lr 4/3/2009 13:42'! defaultMetaNode | env classCategory | env := OBMetaNode named: 'Environment'. classCategory := OBMetaNode named: 'ClassCategory'. env childAt: #categories put: classCategory. classCategory ancestrySelector: #isDescendantOfClassCat:. self buildMetagraphOn: classCategory. classCategory edges do: [ :each | each metaNode doubleClickSelector: #browseHierarchy ]. ^env! ! !OBSystemBrowser class methodsFor: 'configuration' stamp: 'dr 7/20/2007 15:23'! defaultRootNode ^ OBEnvironmentNode forImage! ! !OBSystemBrowser class methodsFor: 'initializing' stamp: ''! initialize self registerInOpenMenu! ! !OBSystemBrowser class methodsFor: 'instance creation' stamp: 'dvf 8/31/2005 13:17'! onClass: aClass ^self selection: aClass asNode! ! !OBSystemBrowser class methodsFor: 'instance creation' stamp: 'cwp 12/15/2004 21:42'! onClass: aClass category: aSymbol ^ self selection: (OBMethodCategoryNode on: aSymbol inClass: aClass)! ! !OBSystemBrowser class methodsFor: 'instance creation' stamp: 'cwp 12/5/2004 17:38'! onClass: aClass selector: aSelector ^ self selection: (OBMethodNode on: aSelector inClass: aClass)! ! !OBSystemBrowser class methodsFor: 'instance creation' stamp: 'cwp 12/15/2004 21:45'! onEnvironment: anEnvironment category: aSymbol ^ self selection: (OBClassCategoryNode on: aSymbol inEnvironment: anEnvironment)! ! !OBSystemBrowser class methodsFor: 'opening' stamp: 'cwp 12/5/2004 18:32'! openOnClass: aClass ^ (self onClass: aClass) open! ! !OBSystemBrowser class methodsFor: 'opening' stamp: 'cwp 12/15/2004 21:47'! openOnClass: aClass category: aSymbol ^ (self onClass: aClass category: aSymbol) open! ! !OBSystemBrowser class methodsFor: 'opening' stamp: 'dr 9/24/2008 11:57'! openOnClass: aClass selector: aSelector aSelector ifNil: [^ (self onClass: aClass) open]. ^ (self onClass: aClass selector: aSelector) open.! ! !OBSystemBrowser class methodsFor: 'opening' stamp: 'cwp 12/15/2004 21:54'! openOnEnvironment: anEnvironment category: aSymbol ^ (self onEnvironment: anEnvironment category: aSymbol) open! ! !OBSystemBrowser class methodsFor: 'initializing' stamp: ''! registerInOpenMenu TheWorldMenu registerOpenCommand: {'Image Browser'. {self. #open}}. ! ! !OBSystemBrowser class methodsFor: 'configuration' stamp: 'dc 4/11/2008 09:21'! title ^ 'OB System Browser'! ! !OBSystemBrowser class methodsFor: 'initializing' stamp: 'dr 10/18/2008 10:36'! unload TheWorldMenu unregisterOpenCommandWithReceiver: self.! ! !OBSystemBrowser methodsFor: 'morphic' stamp: 'dr 11/28/2008 14:17'! defaultBackgroundColor | color | color := Preferences browserWindowColor. ^ color == false ifTrue: [Color lightGreen] ifFalse: [color]! ! !OBSystemBrowser methodsFor: 'testing' stamp: 'cwp 4/18/2007 23:49'! isClassBrowser ^ true! ! OBCodeBrowser subclass: #OBVersionBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBVersionBrowser commentStamp: 'cwp 1/7/2005 23:58' prior: 0! OBVersionBrowser displays a list of OBMethodVersions, which represent versions of a method present in the source or changes files. ! !OBVersionBrowser class methodsFor: 'configuration' stamp: 'dr 9/17/2008 13:48'! defaultMetaNode | version | version := OBMetaNode named: 'Version'. version ancestrySelector: #isDescendantOfMethodVersion:. ^ (OBMetaNode named: 'Method') childAt: #versions put: version; yourself.! ! !OBVersionBrowser class methodsFor: 'configuration' stamp: 'cwp 11/27/2004 22:32'! maxPanes ^ 1! ! !OBVersionBrowser class methodsFor: 'configuration' stamp: 'cwp 11/27/2004 22:32'! minPanes ^ 1! ! !OBVersionBrowser class methodsFor: 'opening' stamp: 'lr 4/25/2007 09:51'! openOn: aMethodVersionNode ^ (self root: aMethodVersionNode selection: aMethodVersionNode versions first) open! ! !OBVersionBrowser class methodsFor: 'configuration' stamp: 'cwp 11/27/2004 22:34'! optionalButtons ^ #('browse' 'revert')! ! !OBVersionBrowser methodsFor: 'morphic' stamp: 'avi 11/29/2004 21:52'! defaultBackgroundColor ^ Color lightMagenta! ! !OBVersionBrowser methodsFor: 'accessing' stamp: 'cwp 11/27/2004 22:28'! defaultLabel ^ 'Versions of ', self root name printString! ! !Class methodsFor: '*ob-standard-converting' stamp: 'lr 8/4/2007 10:04'! asClassSideNode ^ OBMetaclassNode on: self! ! !Class methodsFor: '*ob-standard-converting' stamp: 'lr 2/12/2009 10:38'! asNode ^ OBClassNode on: self! ! !CompiledMethod methodsFor: '*ob-standard' stamp: 'dr 9/23/2008 10:43'! isSubclassResponsibility ^self isSubclassResponsibility: self markerOrNil ! ! !TestCase class methodsFor: '*ob-standard' stamp: 'lr 4/4/2009 09:18'! browserIcon | classHistory | self isAbstract ifTrue: [ ^ super browserIcon ]. (TestResult class methodDictionary includesKey: #historyFor:) ifFalse: [ ^ #testGray ]. classHistory := TestResult historyFor: self. (classHistory at: #errors) isEmpty ifFalse: [ ^ #testRed ]. (classHistory at: #failures) isEmpty ifFalse: [ ^ #testOrange ]. (classHistory at: #passed) isEmpty ifFalse: [ ^ #testGreen ]. ^ #testGray! ! !TestCase class methodsFor: '*ob-standard' stamp: 'lr 4/3/2009 10:44'! browserIconFor: aSelector | history | (TestResult class methodDictionary includesKey: #historyFor:) ifFalse: [ ^ #testGray ]. history := TestResult historyFor: self. ((history at: #errors) includes: aSelector) ifTrue: [ ^ #testRed ]. ((history at: #failures) includes: aSelector) ifTrue: [ ^ #testOrange ]. ((history at: #passed) includes: aSelector) ifTrue: [ ^ #testGreen ]. ^ #testGray! ! !MethodReference methodsFor: '*OB-Standard' stamp: 'lr 2/12/2009 10:40'! asNode ^ OBMethodNode on: self! ! !ClassTrait methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:28'! asClassSideNode ^ OBMetaclassNode on: self! ! !ClassTrait methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:28'! asNode ^ OBMetaclassNode on: self! ! OBDefinition subclass: #OBClassCommentDefinition instanceVariableNames: 'theClass' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBClassCommentDefinition class methodsFor: 'as yet unclassified' stamp: 'cwp 8/7/2007 00:09'! on: aClass ^ self new setClass: aClass! ! !OBClassCommentDefinition methodsFor: 'accessing' stamp: 'dc 10/6/2007 15:26'! selectedClass ^ theClass ! ! !OBClassCommentDefinition methodsFor: 'accessing' stamp: 'dc 10/6/2007 15:27'! setClass: aClass theClass := aClass! ! !OBClassCommentDefinition methodsFor: 'callbacks' stamp: 'cwp 8/7/2007 00:07'! text ^ theClass comment! ! !OBClassCommentDefinition methodsFor: 'callbacks' stamp: 'cwp 8/7/2007 00:24'! text: aText theClass comment: aText stamp: Utilities changeStamp. ^ true! ! OBDefinition subclass: #OBClassDefinition instanceVariableNames: 'environment template' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBClassDefinition commentStamp: 'cwp 1/8/2005 13:13' prior: 0! OBClassDefinition presents a textual interface for examining, modifying and creating classes. Given a class, it knows how to display the definition expression that reflects it's current state, and knows how to create or modify a class given a definition expression. OBClassDefinition implements a number of safety checks when defining or redefining classes, to ensure that existing classes are not accidentally overwritten.! !OBClassDefinition class methodsFor: 'instance creation' stamp: ''! environment: anEnvironment template: aString ^ self new setEnvironment: anEnvironment template: aString! ! !OBClassDefinition methodsFor: 'callbacks' stamp: ''! accept: aText notifying: aController ^ self defineClass: aText notifying: aController! ! !OBClassDefinition methodsFor: 'confirmation' stamp: ''! confirmDefinition: definition "Check to make sure the user isn't accidentally over-writing an existing class." (((self isRedefinition: definition) not) and: [self definedClassExists: definition]) ifTrue: [^ self confirmRedefinition: definition] ifFalse: [^ true]! ! !OBClassDefinition methodsFor: 'confirmation' stamp: ''! confirmRedefinition: definition | newName prompt | newName := self nameOfClassDefinedBy: definition. prompt := (newName, ' is an existing class in this system. Redefining it might cause serious problems. Is this really what you want to do?') asText. ^ OBConfirmationRequest prompt: prompt confirm: 'Redefine'! ! !OBClassDefinition methodsFor: 'class definition' stamp: ''! defineClass: definition notifying: aController | evaluator newClass | (self confirmDefinition: definition) ifFalse: [^ false]. evaluator := self evaluatorForDefinition: definition. newClass := evaluator evaluate: definition notifying: aController logged: true. newClass ifNil: [^ false]. self signalSelectionOf: newClass. ^ true ! ! !OBClassDefinition methodsFor: 'confirmation' stamp: ''! definedClassExists: definition ^ environment hasClassNamed: (self nameOfClassDefinedBy: definition)! ! !OBClassDefinition methodsFor: 'class definition' stamp: ''! evaluatorForDefinition: definition | tokens | tokens := Scanner new scanTokens: definition. ^ (environment at: tokens first ifAbsent: [nil]) subclassDefinerClass! ! !OBClassDefinition methodsFor: 'confirmation' stamp: ''! isRedefinition: aDefinition ^ (self nameOfClassDefinedBy: aDefinition) = (self nameOfClassDefinedBy: template)! ! !OBClassDefinition methodsFor: 'confirmation' stamp: ''! nameOfClassDefinedBy: definition ^ (Scanner new scanTokens: definition) third! ! !OBClassDefinition methodsFor: 'confirmation' stamp: 'cwp 10/18/2004 00:13'! selectedClass ^ environment at: (self nameOfClassDefinedBy: template) ifAbsent: [nil]! ! !OBClassDefinition methodsFor: 'initializing' stamp: ''! setEnvironment: anEnvironment template: aText environment := anEnvironment. template := aText.! ! !OBClassDefinition methodsFor: 'class definition' stamp: 'cwp 10/23/2005 14:42'! signalSelectionOf: aClass aClass asNode demandSelection! ! !OBClassDefinition methodsFor: 'callbacks' stamp: ''! text ^ template! ! OBDefinition subclass: #OBMethodDefinition instanceVariableNames: 'theClass category source selection callback compileClass compileCategory compileText' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBMethodDefinition commentStamp: 'cwp 1/8/2005 13:20' prior: 0! OBMethodDefinition knows how to present method source in the browser's text pane and compile a new CompiledMethod when the source changes. It implements several safety checks to ensure that methods are not accidentally overwritten.! !OBMethodDefinition class methodsFor: 'instance creation' stamp: 'cwp 10/17/2004 23:07'! inCategory: aString inClass: aClass ^ self selection: nil source: nil inCategory: aString inClass: aClass! ! !OBMethodDefinition class methodsFor: 'instance creation' stamp: 'cwp 10/17/2004 23:07'! selection: anInterval source: aText inCategory: aCategory inClass: aClass ^ self new setClass: aClass category: aCategory source: aText selection: anInterval! ! !OBMethodDefinition class methodsFor: 'instance creation' stamp: 'cwp 10/17/2004 23:07'! selection: anInterval source: aText inClass: aClass ^ self selection: anInterval source: aText inCategory: nil inClass: aClass ! ! !OBMethodDefinition class methodsFor: 'instance creation' stamp: 'cwp 10/17/2004 23:03'! source: aText inClass: aClass ^ self selection: nil source: aText inCategory: nil inClass: aClass! ! !OBMethodDefinition methodsFor: 'callbacks' stamp: 'dr 11/4/2008 19:43'! accept: aText notifying: aController | newSelector | newSelector := self compileMethod: aText notifying: aController. newSelector ifNil: [^ false]. (self nodeFor: newSelector) demandSelection. ^ true! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:36'! callback: aBlockContext callback := aBlockContext! ! !OBMethodDefinition methodsFor: 'accessing' stamp: ''! category ^ category ifNil: [category := self theClass whichCategoryIncludesSelector: self selector]! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 20:09'! compileCategory ^ compileCategory! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 20:09'! compileCategory: anObject compileCategory := anObject! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 18:36'! compileClass ^ compileClass! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 18:36'! compileClass: anObject compileClass := anObject! ! !OBMethodDefinition methodsFor: 'compiling' stamp: 'cwp 10/15/2007 23:38'! compileMethod: aText notifying: aController self compileClass: self theClass. self compileCategory: self category. self compileText: aText. ^((self confirmMethod: aText) and: [self executePrecompilationValidations]) ifTrue: [self compileNotifying: aController] ifFalse: [nil]! ! !OBMethodDefinition methodsFor: 'compiling' stamp: 'lr 3/4/2009 22:16'! compileNotifying: aController ^ self compileClass compile: self compileText classified: self compileCategory notifying: aController! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:17'! compileSelector ^ self compileText isNil ifFalse: [ Parser new parseSelector: self compileText ]! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 18:37'! compileText ^ compileText! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 18:37'! compileText: anObject compileText := anObject! ! !OBMethodDefinition methodsFor: 'confirming' stamp: 'lr 11/13/2008 13:44'! confirmMethod: aText | sel | sel := Parser new parseSelector: aText. ^ (self theClass isMeta and: [ (self selectorAlreadyDefined: sel) not and: [ Metaclass isScarySelector: sel ] ]) ifTrue: [ self confirmScarySelector: sel ] ifFalse: [ ^ true ]! ! !OBMethodDefinition methodsFor: 'confirming' stamp: ''! confirmScarySelector: aSelector | prompt | prompt := aSelector, ' is used in the existing class system. Overriding it could cause serious problems. Is this really what you want to do?'. ^ OBConfirmationRequest prompt: prompt confirm: 'Override'! ! !OBMethodDefinition methodsFor: 'validation' stamp: 'jk 8/22/2007 19:02'! executePrecompilationValidations "It executes all selectors beginning with 'validate'. All such selector have to return true/false value and have no arguments. After success validation, self compileText will compiled in self compileClass. 'self compileSelector can be used.'" (self class allSelectors select: [:ea | ea beginsWith: 'validate']) do: [:selector | (self perform: selector) ifFalse: [^ false]]. ^ true! ! !OBMethodDefinition methodsFor: 'compiling' stamp: 'cwp 10/17/2004 23:33'! nodeFor: aSelector ^ callback value: aSelector! ! !OBMethodDefinition methodsFor: 'callbacks' stamp: ''! selectedClass ^ self theClass! ! !OBMethodDefinition methodsFor: 'callbacks' stamp: 'lr 3/4/2009 08:20'! selection ^ selection ifNil: [ 1 to: (source isNil ifTrue: [ self text size ] ifFalse: [ 0 ]) ]! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:17'! selector ^ source isNil ifFalse: [ Parser new parseSelector: source ]! ! !OBMethodDefinition methodsFor: 'confirming' stamp: ''! selectorAlreadyDefined: aSelector ^ self theClass selectors includes: aSelector! ! !OBMethodDefinition methodsFor: 'initializing' stamp: 'cwp 10/17/2004 23:33'! setClass: aClass category: aString source: aText selection: anInterval theClass := aClass. category := aString. source := aText. selection := anInterval. callback := [:sel | OBMethodNode on: sel inClass: theClass]! ! !OBMethodDefinition methodsFor: 'callbacks' stamp: 'lr 3/4/2009 08:18'! text ^ source isNil ifFalse: [ source asText makeSelectorBold ] ifTrue: [ self theClass sourceCodeTemplate ]! ! !OBMethodDefinition methodsFor: 'accessing' stamp: ''! theClass ^ theClass! ! OBDefinition subclass: #OBOrganizationDefinition instanceVariableNames: 'organizer' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBOrganizationDefinition commentStamp: 'cwp 1/8/2005 13:31' prior: 0! OBOrganizationDefinition knows how to display and edit the organization of classes or methods by a Categorizer.! !OBOrganizationDefinition class methodsFor: 'as yet unclassified' stamp: 'cwp 9/22/2004 21:20'! on: anOrganizer ^ self new organizer: anOrganizer! ! !OBOrganizationDefinition methodsFor: 'as yet unclassified' stamp: 'cwp 9/22/2004 21:21'! organizer: anOrganizer organizer := anOrganizer! ! !OBOrganizationDefinition methodsFor: 'callbacks' stamp: 'cwp 9/22/2004 21:18'! text ^ organizer asString! ! !OBOrganizationDefinition methodsFor: 'callbacks' stamp: 'dr 11/19/2008 16:21'! text: aText organizer changeFromString: aText asString. OBAnnouncer current announce: OBRefreshRequired. ^ true! ! OBDefinition subclass: #OBReadOnlyDefinition instanceVariableNames: 'text' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBReadOnlyDefinition methodsFor: 'callbacks' stamp: 'dc 6/18/2007 19:31'! setText: aText text := aText! ! !OBReadOnlyDefinition methodsFor: 'callbacks' stamp: 'dc 6/18/2007 19:14'! text ^ text! ! Object subclass: #OBAnnotationRequest instanceVariableNames: 'selector class separator' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBAnnotationRequest class methodsFor: 'instance-creation' stamp: 'PDC 6/25/2007 22:01'! onClass: aClass selector: aSelector ^ self new onClass: aClass selector: aSelector; yourself! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 11/13/2008 13:44'! allChangeSets ^ (ChangeSorter allChangeSetsWithClass: class selector: selector) ifNotEmpty: [ String streamContents: [ :aStream | (ChangeSorter allChangeSetsWithClass: class selector: selector) size = 1 ifTrue: [ aStream nextPutAll: 'only in change set ' ] ifFalse: [ aStream nextPutAll: 'in change sets: ' ]. (ChangeSorter allChangeSetsWithClass: class selector: selector) do: [ :aChangeSet | aStream nextPutAll: aChangeSet name; nextPutAll: ' ' ] ] ] ifEmpty: [ 'in no change set' ]! ! !OBAnnotationRequest methodsFor: 'actions' stamp: 'lr 3/4/2009 22:07'! annotationRequests ^ Preferences defaultAnnotationRequests! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'dc 5/2/2007 18:57'! documentation ^ class precodeCommentOrInheritedCommentFor: selector! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'dc 5/2/2007 18:20'! firstComment ^ class firstCommentAt: selector! ! !OBAnnotationRequest methodsFor: 'actions' stamp: 'lr 2/12/2009 10:41'! getAnnotations ^ String streamContents: [ :aStream | ((self annotationRequests collect: [ :request | self perform: request ]) reject: [ :stringOrNil | stringOrNil isEmptyOrNil ]) do: [ :ea | aStream nextPutAll: ea ] separatedBy: [ aStream nextPutAll: separator ] ]! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'dr 9/17/2008 14:52'! implementorsCount |implementorsCount | implementorsCount := self systemNavigation numberOfImplementorsOf: selector. implementorsCount := implementorsCount == 1 ifTrue: ['1 implementor'] ifFalse: [implementorsCount printString , ' implementors']. ^ implementorsCount ! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'dc 5/2/2007 18:57'! masterComment ^ class supermostPrecodeCommentFor: selector! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'dc 5/2/2007 18:53'! messageCategory ^ class organization categoryOfElement: selector! ! !OBAnnotationRequest methodsFor: 'accessing' stamp: 'dc 6/18/2007 18:55'! method ^ class compiledMethodAt: selector ifAbsent: [nil]! ! !OBAnnotationRequest methodsFor: 'initialize-release' stamp: 'MAD 1/14/2009 11:44'! onClass: aClass selector: aSelector class := aClass. selector := aSelector. separator := ' - '.! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 3/4/2009 09:36'! priorTimeStamp | stamp | ^ (stamp := VersionsBrowser timeStampFor: selector class: class reverseOrdinal: 2) isNil ifFalse: [ 'prior time stamp: ' , stamp ]! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'dc 5/2/2007 18:34'! priorVersionsCount | versionsCount | versionsCount := VersionsBrowser versionCountForSelector: selector class: class. ^ versionsCount > 1 ifTrue: [versionsCount == 2 ifTrue: ['1 prior version'] ifFalse: [versionsCount printString, ' prior versions']] ifFalse: ['no prior versions']! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'dc 5/2/2007 18:37'! recentChangeSet ^ ChangeSorter mostRecentChangeSetWithChangeForClass: class selector: selector! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'dc 5/2/2007 18:31'! sendersCount | sendersCount | sendersCount := (self systemNavigation allCallsOn: selector) size. sendersCount := sendersCount == 1 ifTrue: ['1 sender'] ifFalse: [sendersCount printString , ' senders']. ^ sendersCount! ! !OBAnnotationRequest methodsFor: 'accessing' stamp: 'dc 5/2/2007 18:14'! separator: aString separator := aString! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 3/4/2009 09:36'! timeStamp ^ self method isNil ifFalse: [ Utilities timeStampForMethod: self method ]! ! Object subclass: #OBClassReference instanceVariableNames: 'name isMeta' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBClassReference commentStamp: 'cwp 1/8/2005 13:15' prior: 0! OBClassReference provides a way to refer to classes that may or may not be loaded into the image. It refers to the class indirectly, via name, rather than with a direct pointer to the class object. It also provides a number of convenience methods, which makes it more convenient than using the class name directly.! !OBClassReference class methodsFor: 'instance creation' stamp: ''! metaNamed: aSymbol ^ (self named: aSymbol) beMeta! ! !OBClassReference class methodsFor: 'instance creation' stamp: ''! named: aSymbol ^ self new setName: aSymbol! ! !OBClassReference class methodsFor: 'instance creation' stamp: ''! to: aClass ^ self named: aClass name! ! !OBClassReference methodsFor: 'comparing' stamp: ''! <= other ^ self name <= other name! ! !OBClassReference methodsFor: 'comparing' stamp: 'lr 11/13/2008 13:44'! = other ^ (other isKindOf: self class) and: [ name = other theNonMetaName and: [ isMeta = other isMeta ] ]! ! !OBClassReference methodsFor: 'accessing' stamp: ''! beMeta isMeta := true! ! !OBClassReference methodsFor: 'accessing' stamp: ''! beNonMeta isMeta := false! ! !OBClassReference methodsFor: 'comparing' stamp: ''! hash ^ isMeta ifTrue: [name hash bitInvert] ifFalse: [name hash]! ! !OBClassReference methodsFor: 'testing' stamp: ''! isMeta ^ isMeta! ! !OBClassReference methodsFor: 'accessing' stamp: ''! name ^ isMeta ifTrue: [name, ' class'] ifFalse: [name]! ! !OBClassReference methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: 'OBClassReference'. aStream nextPut: $<. aStream nextPutAll: name. isMeta ifTrue: [aStream nextPutAll: ' class']. aStream nextPut: $>.! ! !OBClassReference methodsFor: 'converting' stamp: ''! referenceToMethod: aSelector | ref | ref := MethodReference new. ref setClassSymbol: name classIsMeta: isMeta methodSymbol: aSelector stringVersion: ''. ^ ref! ! !OBClassReference methodsFor: 'initializing' stamp: ''! setName: aSymbol name := (aSymbol copyUpTo: $ ) asSymbol. isMeta := aSymbol endsWith: ' class'.! ! !OBClassReference methodsFor: 'accessing' stamp: ''! theClass | theClass | theClass := self theNonMetaClass ifNil: [^ nil]. ^ isMeta ifFalse: [theClass] ifTrue: [theClass class]! ! !OBClassReference methodsFor: 'accessing' stamp: ''! theNonMetaClass ^ Smalltalk at: name ifAbsent: [].! ! !OBClassReference methodsFor: 'accessing' stamp: ''! theNonMetaName ^ name! ! !OBClassReference methodsFor: 'accessing' stamp: ''! theNonMetaName: aSymbol name := aSymbol! ! Object subclass: #OBMercuryQuery instanceVariableNames: 'pattern isWild browser' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMercuryQuery commentStamp: 'PDC 6/29/2007 07:08' prior: 0! OBMercuryQuery is an abstract superclass for queries made through the 'Mercury' panel in OmniBrowser based browser. The main interface is the class method, find:for:, which builds an appropriate concrete query object for the query string and calls find on it.! OBMercuryQuery subclass: #OBMClassQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMClassQuery commentStamp: 'PDC 6/29/2007 07:11' prior: 0! I handle mercury queries like 'Object' and 'OBNode*'. I find classes.! !OBMClassQuery methodsFor: 'private' stamp: 'cb 7/16/2008 11:55'! find ((isWild not and: [pattern size = 1 and: [(Smalltalk hasClassNamed: pattern first)]]) or: [self searchNode classes size = 1]) ifTrue: [self openClassBrowser] ifFalse: [self openSearchBrowser]! ! !OBMClassQuery methodsFor: 'private' stamp: 'dc 9/13/2007 16:17'! openClassBrowser | classNode | classNode := OBClassNode on: (Smalltalk at: pattern first asSymbol). ^self browser isClassBrowser ifTrue: [self browser jumpTo: classNode] ifFalse: [classNode browse]! ! !OBMClassQuery methodsFor: 'accessing' stamp: 'PDC 6/29/2007 06:17'! searchNode ^ OBClassSearchNode on: pattern! ! !OBMClassQuery methodsFor: 'as yet unclassified' stamp: 'cb 7/16/2008 12:05'! setRawQuery: aString panel: aPanel pattern := aString findTokens: #*. isWild := aString includes: $*. browser := aPanel browser. ^ self! ! OBMercuryQuery subclass: #OBMClassRefsQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMClassRefsQuery commentStamp: 'PDC 6/29/2007 07:13' prior: 0! I handle mercury queries like '#Object'. I find references to classes.! !OBMClassRefsQuery methodsFor: 'executing' stamp: 'lr 3/4/2009 08:17'! find (Smalltalk classNamed: pattern) isNil ifFalse: [ self openSearchBrowser ]! ! !OBMClassRefsQuery methodsFor: 'accessing' stamp: 'PDC 6/29/2007 06:17'! searchNode ^ OBClassRefSearchNode on: pattern! ! OBMercuryQuery subclass: #OBMMethodQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMMethodQuery commentStamp: 'PDC 6/29/2007 07:12' prior: 0! I handle queries that look like 'browse' and 'browse*'. I find method implementors.! !OBMMethodQuery methodsFor: 'private' stamp: 'cwp 9/1/2007 00:26'! browseImplementors | node | node := OBSelectorNode on: pattern asSymbol. (browser announce: (OBShowImplementors of: node)) execute! ! !OBMMethodQuery methodsFor: 'executing' stamp: 'PDC 6/29/2007 06:23'! find isWild ifTrue: [self findMethod] ifFalse: [self browseImplementors]! ! !OBMMethodQuery methodsFor: 'private' stamp: 'PDC 6/29/2007 06:28'! findMethod self openSearchBrowser! ! !OBMMethodQuery methodsFor: 'accessing' stamp: 'dr 5/14/2008 13:26'! searchNode ^ OBMethodSearchNode on: pattern! ! OBMercuryQuery subclass: #OBMMethodSendersQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMMethodSendersQuery commentStamp: 'PDC 6/29/2007 07:13' prior: 0! I handle queries like '#browse'. I find method senders.! !OBMMethodSendersQuery methodsFor: 'executing' stamp: 'cwp 8/31/2007 23:54'! find | node | node := OBSelectorNode on: pattern asSymbol. (browser announce: (OBShowSenders of: node)) execute! ! !OBMMethodSendersQuery methodsFor: 'accessing' stamp: 'cwp 7/20/2007 00:25'! searchNode ^ OBSenderSearchNode on: pattern! ! OBMercuryQuery subclass: #OBMStringQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMStringQuery commentStamp: 'PDC 6/29/2007 07:13' prior: 0! I handle queries that look like "'this is a string'". I find strings in methods.! !OBMStringQuery methodsFor: 'executing' stamp: 'PDC 6/29/2007 05:52'! find self systemNavigation browseMethodsWithString: pattern.! ! !OBMercuryQuery class methodsFor: 'finding' stamp: 'PDC 6/29/2007 06:44'! find: aText for: aPanel (self from: aText panel: aPanel) find! ! !OBMercuryQuery class methodsFor: 'instance creation' stamp: 'PDC 6/29/2007 07:18'! from: aString | rawQuery | rawQuery := aString asString withBlanksTrimmed. rawQuery first = $' ifTrue: [^ OBMStringQuery new setRawQuery: rawQuery]. ^ (self selectClassForQuery: rawQuery) new setRawQuery: rawQuery! ! !OBMercuryQuery class methodsFor: 'instance creation' stamp: 'PDC 6/29/2007 07:18'! from: aString panel: aPanel | rawQuery | rawQuery := aString asString withBlanksTrimmed. rawQuery first = $' ifTrue: [^ OBMStringQuery new setRawQuery: rawQuery]. ^ (self selectClassForQuery: rawQuery) new setRawQuery: rawQuery panel: aPanel! ! !OBMercuryQuery class methodsFor: 'documentation' stamp: 'cb 7/19/2007 21:14'! helpMessage ^'Mercury syntax Foo (browse class Foo) Foo*Bar* (find classes with partial name) #Foo (refs to class Foo) foo (implementors of foo) foo* (implementors of methods starting with foo) #foo (senders of foo) ''foo'' (find methods containing this string)'! ! !OBMercuryQuery class methodsFor: 'private' stamp: 'lr 11/13/2008 13:44'! isClassQuery: aString ^ (aString first = $* and: [ aString size > 1 and: [ aString second ~= $* ] ]) or: [ (aString allButLast indexOf: $*) > 1 or: [ aString first isUppercase ] ]! ! !OBMercuryQuery class methodsFor: 'private' stamp: 'cb 7/19/2007 10:44'! selectClassForQuery: rawQuery ^ rawQuery first = $# ifTrue: [(rawQuery allButFirst first isUppercase) ifTrue: [OBMClassRefsQuery] ifFalse: [OBMMethodSendersQuery]] ifFalse: [(self isClassQuery: rawQuery) ifTrue: [OBMClassQuery] ifFalse: [OBMMethodQuery]]! ! !OBMercuryQuery methodsFor: 'executing' stamp: 'cwp 7/20/2007 00:24'! announce: anAnnouncement ^ browser announce: anAnnouncement! ! !OBMercuryQuery methodsFor: 'accessing' stamp: 'PDC 6/29/2007 06:04'! browser ^browser! ! !OBMercuryQuery methodsFor: 'executing' stamp: 'PDC 6/29/2007 06:32'! find self subclassResponsibility ! ! !OBMercuryQuery methodsFor: 'actions' stamp: 'PDC 6/29/2007 06:18'! openSearchBrowser ^ self openSearchBrowserOn: self searchNode! ! !OBMercuryQuery methodsFor: 'actions' stamp: 'dr 2/15/2008 14:18'! openSearchBrowserOn: searchNode ^ self browser isSearchBrowser ifFalse: [(OBSearchBrowser with: searchNode) open] ifTrue: [self browser root addChild: searchNode. (self announce: OBAboutToChange) isVetoed ifTrue: [self browser noteChanges] ifFalse: [self announce: (OBSelectingNode node: searchNode)]]! ! !OBMercuryQuery methodsFor: 'accessing' stamp: 'PDC 6/29/2007 06:32'! searchNode self subclassResponsibility ! ! !OBMercuryQuery methodsFor: 'initialization' stamp: 'PDC 6/29/2007 06:37'! setRawQuery: aString | tokens | tokens := Scanner new scanTokens: aString. pattern := tokens at: 1. isWild := (tokens at: 2 ifAbsent: []) = #*. ^ self! ! !OBMercuryQuery methodsFor: 'initialization' stamp: 'PDC 6/29/2007 06:37'! setRawQuery: aString panel: aPanel self setRawQuery: aString. browser := aPanel browser. ^ self! ! Object subclass: #OBMetagraphBuilder instanceVariableNames: 'metaNodes selectors root' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMetagraphBuilder class methodsFor: 'as yet unclassified' stamp: 'PDC 6/27/2007 08:03'! on: root class: classSel comment: commentSel metaclass: metaclassSel ^self new setRoot: root classSel: classSel commentSel: commentSel metaclassSel: metaclassSel! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'dc 9/7/2007 11:55'! addMetaNode: aMetaNode ^ self metaNodes at: aMetaNode name put: aMetaNode! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! allMethodCategoryMetaNode ^ self metaNode: #AllMethodCategory! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! classCommentMetaNode ^ self metaNode: #ClassComment! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! classMetaNode ^ self metaNode: #Class! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:05'! classSelector ^ self selectorAt: #classSel! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:05'! classSelector: aSelector ^ self selectorAt: #classSel put: aSelector! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:05'! commentSelector ^ self selectorAt: #commentSel! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:06'! commentSelector: aSelector ^ self selectorAt: #commentSel put: aSelector! ! !OBMetagraphBuilder methodsFor: 'execution' stamp: 'jk 8/26/2007 18:08'! execute ((self class allSelectors select: [:ea | ea beginsWith: 'populate']) asSortedArray) do: [:selector | self perform: selector]. ^ self root! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'dc 9/7/2007 11:57'! metaNode: aMetaNodeName ^ self metaNodes at: aMetaNodeName ifAbsentPut:[OBMetaNode named: aMetaNodeName]! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'dc 9/7/2007 11:56'! metaNodes ^ metaNodes ifNil: [ metaNodes := IdentityDictionary new]! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! metaclassMetaNode ^ self metaNode: #Metaclass! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:06'! metaclassSelector ^ self selectorAt: #metaclassSel! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:06'! metaclassSelector: aSelector ^ self selectorAt: #metaclassSel put: aSelector! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! methodCategoryMetaNode ^ self metaNode: #MethodCategory! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! methodMetaNode ^ self metaNode: #Method! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'jk 8/26/2007 17:12'! populateAllMethodCategoryNode self allMethodCategoryMetaNode childAt: #methods put: self methodMetaNode! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 3/28/2009 15:16'! populateClassCommentMetaNode self classCommentMetaNode ancestrySelector: #isDescendantOfClass:; addFilter: OBClassIconFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 3/28/2009 15:14'! populateClassNode self classMetaNode ancestrySelector: #isDescendantOfClass:; childAt: #allCategory put: self allMethodCategoryMetaNode; childAt: #categories put: self methodCategoryMetaNode; autoSelect: (OBAutoSelection on: self allMethodCategoryMetaNode); addFilter: OBClassIconFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 3/28/2009 15:14'! populateMetaclassNode self metaclassMetaNode ancestrySelector: #isDescendantOfClass:; childAt: #allCategory put: self allMethodCategoryMetaNode; childAt: #categories put: self methodCategoryMetaNode; autoSelect: (OBAutoSelection on: self allMethodCategoryMetaNode); addFilter: OBClassIconFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'jk 8/26/2007 17:13'! populateMethodCategoryNode self methodCategoryMetaNode ancestrySelector: #isDescendantOfMethodCat:; childAt: #methods put: self methodMetaNode! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'dr 11/20/2008 09:23'! populateMethodNode self methodMetaNode ancestrySelector: #isDescendantOfMethod:; addFilter: OBInheritanceFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 3/28/2009 15:13'! populateRoot self root childAt: self classSelector labeled: 'instance' put: self classMetaNode; childAt: self commentSelector labeled: '?' put: self classCommentMetaNode; childAt: self metaclassSelector labeled: 'class' put: self metaclassMetaNode; addFilter: OBModalFilter new; addFilter: OBClassSortFilter new ! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'jk 8/26/2007 16:54'! root ^ root! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:56'! root: rootMetaNode root := rootMetaNode. self addMetaNode: rootMetaNode! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'jk 8/26/2007 17:58'! selectorAt: aSelector ^ self selectors at: aSelector! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'jk 8/26/2007 17:59'! selectorAt: aKey put: aValue ^ self selectors at: aKey put: aValue! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'jk 8/26/2007 17:49'! selectors ^ selectors ifNil: [ selectors := Dictionary new.]! ! !OBMetagraphBuilder methodsFor: 'initialization' stamp: 'jk 8/26/2007 18:02'! setRoot: rootNode classSel: classSelector commentSel: commentSelector metaclassSel: metaclassSelector self root: rootNode. self classSelector: classSelector. self commentSelector: commentSelector. self metaclassSelector: metaclassSelector. ^ self! ! Object subclass: #OBMethodVersion instanceVariableNames: 'sources pointer classRef category stamp prior selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMethodVersion commentStamp: 'cwp 1/8/2005 13:25' prior: 0! OBMethodVerison represents a version of a method found in the .sources or .changes files. It provides methods for parsing the method definition referenced by a source pointer, and for filing in the source to replace the current version of the method.! !OBMethodVersion class methodsFor: 'instance creation' stamp: ''! fromSources: sources andPointer: pointer ^ self new setSources: sources pointer: pointer! ! !OBMethodVersion class methodsFor: 'scanning' stamp: 'PDC 6/29/2007 06:55'! scan: sources from: pointer | versions current | versions := OrderedCollection new. current := self fromSources: sources andPointer: pointer. [current notNil] whileTrue: [versions add: current. current := current previous]. ^ versions! ! !OBMethodVersion class methodsFor: 'scanning' stamp: ''! versionsOfMethod: methodReference | class selector | class := methodReference actualClass. selector := methodReference methodSymbol. ^ self scan: SourceFiles from: (class compiledMethodAt: selector) sourcePointer! ! !OBMethodVersion methodsFor: 'comparing' stamp: 'cwp 10/17/2004 23:45'! = other ^ self species = other species and: [self pointer = other pointer]! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! category ^ category! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! classSymbol ^ classRef name! ! !OBMethodVersion methodsFor: 'compiling' stamp: 'lr 3/4/2009 09:35'! fileIn self theClass isNil ifTrue: [ ^ self ]. self theClass compile: self source classified: self category withStamp: self stamp notifying: nil! ! !OBMethodVersion methodsFor: 'comparing' stamp: 'cwp 10/17/2004 23:45'! hash ^ pointer hash! ! !OBMethodVersion methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:51'! latest ^ self class fromSources: sources andPointer: (classRef theClass compiledMethodAt: selector) sourcePointer! ! !OBMethodVersion methodsFor: 'initializing' stamp: 'cwp 11/6/2004 23:14'! parseChunk: aString | tokens | tokens := Scanner new scanTokens: aString. classRef := OBClassReference named: tokens first. tokens second = #class ifTrue: [classRef beMeta. category := tokens fourth. stamp := tokens sixth] ifFalse: [category := tokens third. tokens size > 3 ifTrue: [stamp := tokens fifth]]. tokens size > 6 ifTrue: [prior := tokens last].! ! !OBMethodVersion methodsFor: 'initializing' stamp: 'PDC 6/25/2007 21:58'! parseSource | file position chunk | file := sources at: (sources fileIndexFromSourcePointer: pointer). position := sources filePositionFromSourcePointer: pointer. chunk := ''. position > file size ifTrue: [self error: 'Invalid source pointer']. file position: (0 max: position-150). "Skip back to before the preamble" [file position < (position-1)] "then pick it up from the front" whileTrue: [chunk := file nextChunk]. self parseChunk: chunk.! ! !OBMethodVersion methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:42'! pointer ^ pointer! ! !OBMethodVersion methodsFor: 'initializing' stamp: 'dr 12/13/2008 17:37'! previous ^(prior notNil and: [prior > 0]) ifTrue: [self class fromSources: sources andPointer: prior]! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! selector ^ selector ifNil: [self setSelector]! ! !OBMethodVersion methodsFor: 'initializing' stamp: ''! setSelector | file | file := sources at: (sources fileIndexFromSourcePointer: pointer). file position: (sources filePositionFromSourcePointer: pointer). ^ selector := Parser new parseSelector: file nextChunk.! ! !OBMethodVersion methodsFor: 'initializing' stamp: ''! setSources: aSourceFileArray pointer: aSourcePointer sources := aSourceFileArray. pointer := aSourcePointer. self parseSource.! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! source | file | file := sources at: (sources fileIndexFromSourcePointer: pointer). file position: (sources filePositionFromSourcePointer: pointer). ^ file nextChunk asText makeSelectorBold! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! stamp ^ stamp! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! theClass ^ classRef theClass! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! theClassName ^ classRef name! ! Object subclass: #OBSystemBrowserAdaptor instanceVariableNames: 'class selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBSystemBrowserAdaptor commentStamp: 'cwp 1/8/2005 13:35' prior: 0! OBSystemBrowserAdaptor implements the protocol expected by the SystemBrowser app registry, and thus allows OmniBrowser to be chosen as the default system browser. Caveat: because the required protocol is a little ...odd.... it can't be implemented well by OBSystemBrowser directly. OBSystemBrowserAdaptor does this reasonably well, but it has no way to provide a more natural name than its class name to the app registry menu.! !OBSystemBrowserAdaptor class methodsFor: 'configuration' stamp: 'dr 7/19/2007 16:34'! browserClass ^OBSystemBrowser! ! !OBSystemBrowserAdaptor class methodsFor: 'registry protocol' stamp: 'dr 7/19/2007 16:34'! fullOnClass: aClass selector: aSelector ^ self browserClass openOnClass: aClass selector: aSelector! ! !OBSystemBrowserAdaptor class methodsFor: 'initializing' stamp: 'cwp 12/5/2004 22:01'! initialize self register! ! !OBSystemBrowserAdaptor class methodsFor: 'registry protocol' stamp: 'dr 7/19/2007 16:35'! open self browserClass open! ! !OBSystemBrowserAdaptor class methodsFor: 'registry protocol' stamp: 'dr 7/19/2007 16:35'! openBrowser self browserClass open! ! !OBSystemBrowserAdaptor class methodsFor: 'registry protocol' stamp: 'dr 7/19/2007 16:35'! openBrowserView: adaptor label: ignored ^ self browserClass openOnClass: adaptor targetClass selector: adaptor selector! ! !OBSystemBrowserAdaptor class methodsFor: 'initializing' stamp: 'cwp 1/8/2005 21:52'! register Smalltalk at: #SystemBrowser ifPresent: [:class | class register: self]! ! !OBSystemBrowserAdaptor class methodsFor: 'initializing' stamp: 'dr 10/18/2008 10:32'! unload SystemBrowser unregister: self.! ! !OBSystemBrowserAdaptor class methodsFor: 'initializing' stamp: 'cwp 1/8/2005 21:53'! unregister Smalltalk at: #SystemBrowser ifPresent: [:class | class unregister: self]! ! !OBSystemBrowserAdaptor methodsFor: 'registry protocol' stamp: 'cwp 12/5/2004 21:50'! labelString ^ 'System Browser'! ! !OBSystemBrowserAdaptor methodsFor: 'registry protocol' stamp: 'cwp 12/5/2004 21:49'! openEditString: anUndefinedObject ^ self! ! !OBSystemBrowserAdaptor methodsFor: 'accessing' stamp: 'cwp 12/5/2004 21:55'! selector ^ selector! ! !OBSystemBrowserAdaptor methodsFor: 'registry protocol' stamp: 'cwp 12/5/2004 21:49'! setClass: aClass selector: aSelector class := aClass. selector := aSelector! ! !OBSystemBrowserAdaptor methodsFor: 'actions' stamp: 'dc 4/24/2007 15:09'! spawnHierarchy ^ OBHierarchyBrowser openOnClass: self targetClass ! ! !OBSystemBrowserAdaptor methodsFor: 'accessing' stamp: 'dr 4/24/2007 18:05'! targetClass ^class! ! !UndefinedObject methodsFor: '*OB-Standard-testing' stamp: 'PDC 6/29/2007 06:02'! isClassBrowser ^false! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'dvf 8/17/2005 17:31'! asCommentNode ^ OBClassCommentNode on: self theNonMetaClass ! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 3/29/2009 16:36'! browserIcon ^ nil! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 3/4/2009 22:06'! package ^ PackageOrganizer default packageOfClass: self ifNone: [ nil ]! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 3/4/2009 10:14'! packageName ^ self package isNil ifFalse: [ self package packageName ] ifTrue: [ '' ]! ! !MessageNode methodsFor: '*ob-standard' stamp: 'lr 2/12/2009 10:41'! selectorIs: aSymbol aSymbol isNil ifTrue: [ ^ false ]. ((selector isKindOf: SelectorNode) or: [ selector isKindOf: Association ]) ifTrue: [ ^ selector key == aSymbol ]. selector isSymbol ifTrue: [ ^ selector == aSymbol ]. ^ false! ! Notification subclass: #OBSourceFilesRequest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBSourceFilesRequest commentStamp: 'cwp 1/8/2005 13:09' prior: 0! OBSourceFilesRequest is used to work around the fact that Squeak's source files are stored in a global array called SourceFiles. When testing OBMethodVersion and OBVersionBrowser, we don't want to use the real source files, as they are too unpredictable. Instead the test cases supply a source file array with known contents. Therefore, OBMethodVersion never refers directly to the SourceFiles global. Instead it raises an OBSourceFiles request. If this occurs during a test, the test catches the notification and resumes using the test source files. Otherwise, the default action resumes using the global source file array.! !OBSourceFilesRequest methodsFor: 'exceptionDescription' stamp: ''! defaultAction ^ SourceFiles! ! !OBSourceFilesRequest methodsFor: 'exceptionDescription' stamp: 'cwp 11/27/2004 22:49'! isBrowseRequest ^ false! ! !TraitDescription methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:26'! asCommentNode ^ OBClassCommentNode on: self baseTrait! ! !TraitDescription methodsFor: '*ob-standard' stamp: 'lr 3/29/2009 16:37'! browserIcon ^ nil! ! OBFilter subclass: #OBClassIconFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Filters'! !OBClassIconFilter methodsFor: 'filtering' stamp: 'lr 5/4/2009 21:10'! clickIconColumn: aColumn forNode: aNode | filter classes choice index | filter := OBClassSortFilter new. OBWaitRequest block: [ classes := filter nodesFrom: aNode classHierarchy forNode: aNode ]. classes size < 2 ifTrue: [ ^ super clickIconColumn: aColumn forNode: aNode ]. index := classes indexOf: aNode ifAbsent: [ ^ false ]. choice := OBChoiceRequest prompt: 'Select Class' labels: (classes collect: [ :each | filter displayString: each theClassName forParent: aNode child: each ]) values: classes lines: (Array with: index - 1 with: index). choice isNil ifFalse: [ choice announceSelectionWith: aColumn browser ]. ^ true! ! !OBClassIconFilter methodsFor: 'filtering' stamp: 'lr 3/29/2009 16:38'! icon: aSymbol forNode: aNode ^ aNode theNonMetaClass browserIcon ifNil: [ #blank ]! ! OBFilter subclass: #OBClassSortFilter instanceVariableNames: 'indents order' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Filters'! !OBClassSortFilter methodsFor: 'private' stamp: 'lr 4/3/2009 13:12'! buildIndentIndex indents := IdentityDictionary new. order do: [:assoc | indents at: assoc value put: assoc key size - 1].! ! !OBClassSortFilter methodsFor: 'private' stamp: 'cwp 5/20/2007 02:20'! collectSortedNodes ^order asArray collect: [:assoc | assoc value]! ! !OBClassSortFilter methodsFor: 'filtering' stamp: 'dr 9/17/2008 14:02'! displayString: aStringOrText forParent: pNode child: cNode | count indented | count := (indents at: cNode ifAbsent: [^ aStringOrText]) * 2. indented := String new: count + aStringOrText size. 1 to: count do: [:i | indented at: i put: $ ]. indented replaceFrom: count + 1 to: indented size with: aStringOrText. aStringOrText isText ifTrue: [ aStringOrText setString: indented setRuns: aStringOrText runs. ^aStringOrText ]. ^indented ! ! !OBClassSortFilter methodsFor: 'private' stamp: 'cwp 5/20/2007 02:20'! initializeResults | i chain2 chain1 result max | order := SortedCollection sortBlock: [:assoc1 :assoc2 | result := nil. chain1 := assoc1 key. chain2 := assoc2 key. max := chain1 size min: chain2 size. i := 1. [result isNil and: [i <= max]] whileTrue: [(chain1 at: i) = (chain2 at: i) ifTrue: [i := i + 1] ifFalse: [result := (chain1 at: i) name < (chain2 at: i) name]]. result isNil ifTrue: [chain1 size < chain2 size] ifFalse: [result]]! ! !OBClassSortFilter methodsFor: 'filtering' stamp: 'lr 4/3/2009 13:13'! nodesFrom: nodes forNode: parent "Sort nodes according to their position in the class hierarchy" | classes supersChain | self initializeResults. classes := (nodes collect: [:classNode | classNode theClass]) asOrderedCollection. classes ifEmpty: [^nodes]. nodes do: [:classNode | supersChain := classNode theClass withAllSuperclasses reversed. supersChain removeAllSuchThat: [:cl | (classes includes: cl) not]. order add: supersChain contents -> classNode]. self buildIndentIndex. ^self collectSortedNodes! ! OBFilter subclass: #OBInheritanceFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Filters'! !OBInheritanceFilter methodsFor: 'filtering' stamp: 'lr 5/4/2009 21:12'! clickIconColumn: aColumn forNode: aNode | filter implementors choice index | filter := OBClassSortFilter new. OBWaitRequest block: [ implementors := filter nodesFrom: aNode hierarchyImplementors forNode: aNode ]. implementors size < 2 ifTrue: [ ^ super clickIconColumn: aColumn forNode: aNode ]. index := implementors indexOf: aNode ifAbsent: [ ^ false ]. choice := OBChoiceRequest prompt: 'Select Implementor' labels: (implementors collect: [ :each | filter displayString: each theClassName forParent: aNode child: each ]) values: implementors lines: (Array with: index - 1 with: index). choice isNil ifFalse: [ choice announceSelectionWith: aColumn browser ]. ^ true! ! !OBInheritanceFilter methodsFor: 'filtering' stamp: 'lr 4/4/2009 09:34'! icon: aSymbol forNode: aNode | method | method := aNode theClass lookupSelector: aNode selector. method ifNil: [ ^ #blank ]. method literals do: [ :literal | (literal == #halt or: [ literal == #haltIfNil or: [ literal == #haltIf: or: [ literal == #haltOnce ] ] ]) ifTrue: [ ^ #breakpoint ]. (literal == #flag: or: [ literal == #needsWork or: [ literal == #notYetImplemented ] ]) ifTrue: [ ^ #flag ] ]. ((aNode selector beginsWith: #test) and: [ (aNode theClass includesBehavior: TestCase) and: [ aNode theClass isAbstract not ] ]) ifTrue: [ ^ aNode theClass browserIconFor: aNode selector ]. ^ aNode isOverride ifTrue: [ aNode isOverridden ifTrue: [ #arrowUpAndDown ] ifFalse: [ #arrowUp ] ] ifFalse: [ aNode isOverridden ifTrue: [ #arrowDown ] ifFalse: [ #blank ] ]! ! OBFilter subclass: #OBLimitProtocolFilter instanceVariableNames: 'theClass limitClass' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Filters'! !OBLimitProtocolFilter class methodsFor: 'instance creation' stamp: 'DM 5/23/2007 14:37'! on: aClass ^ self new forClass: aClass.! ! !OBLimitProtocolFilter methodsFor: 'filtering' stamp: 'PDC 6/28/2007 07:37'! defaultLimitClass "it's too bad that this needs to be duplicated between the ProtocolBrowser and here'" ^ (theClass = theClass theMetaClass) ifTrue: [Object class] ifFalse: [Object]! ! !OBLimitProtocolFilter methodsFor: 'filtering' stamp: 'DM 5/22/2007 19:24'! displayString: aString forNode: aNode (aNode isKindOf: OBMethodNode) ifFalse: [^ aString]. ^ aNode theClass = theClass ifTrue: [aString asText addAttribute: TextEmphasis bold] ifFalse: [aString].! ! !OBLimitProtocolFilter methodsFor: 'filtering' stamp: 'DM 5/23/2007 01:42'! filterMethods: methods onClasses: allClasses forNode: aNode ^ methods select: [:m | allClasses anySatisfy: [:c | c includesSelector: m selector]]! ! !OBLimitProtocolFilter methodsFor: 'filtering' stamp: 'DM 5/23/2007 01:44'! filterProtocols: protocols onClasses: allClasses forNode: aNode ^ protocols allButFirst "the first is the synthetic --all-- category" select: [:p | allClasses anySatisfy: [:c | c organization categories includes: p name]]! ! !OBLimitProtocolFilter methodsFor: 'updating' stamp: 'DM 5/23/2007 14:37'! forClass: aClass theClass := aClass! ! !OBLimitProtocolFilter methodsFor: 'filtering' stamp: 'DM 5/23/2007 01:17'! limitClass: aClass limitClass := aClass.! ! !OBLimitProtocolFilter methodsFor: 'filtering' stamp: 'lr 3/4/2009 08:20'! limitClassFor: aNode ^ limitClass isNil ifTrue: [ self defaultLimitClass ] ifFalse: [ limitClass ]! ! !OBLimitProtocolFilter methodsFor: 'filtering' stamp: 'PDC 6/25/2007 23:08'! nodesFrom: nodes forNode: aNode | allClasses limit | nodes ifEmpty: [^ nodes]. limit := self limitClassFor: aNode. allClasses := aNode theClass withAllSuperclasses copyUpTo: limit. allClasses add: limit. ^ (nodes first isKindOf: OBMethodCategoryNode) ifTrue: [self filterProtocols: nodes onClasses: allClasses forNode: aNode] ifFalse: [self filterMethods: nodes onClasses: allClasses forNode: aNode]! ! !OBLimitProtocolFilter methodsFor: 'filtering' stamp: 'DM 5/23/2007 14:35'! setMetaNode: aMetaNode super setMetaNode: aMetaNode. aMetaNode children do: [ :each | (each filters includes: self) ifFalse: [ each addFilter: self ] ].! ! !ClassOrganizer methodsFor: '*ob-standard-testing' stamp: 'cwp 9/18/2004 23:59'! isClassOrganizer ^ true! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cb 7/18/2007 11:46'! hasOrganization ^ false! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cwp 4/1/2007 22:59'! hasSelector ^ false! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cwp 4/1/2007 23:00'! hasVersions ^ false! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cb 7/18/2007 11:48'! isCategory ^ false! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cb 7/18/2007 11:48'! isEnvironment ^ false! ! OBAnnouncement subclass: #OBNavigate instanceVariableNames: 'bid action fan label' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBNavigate class methodsFor: 'as yet unclassified' stamp: 'dr 9/17/2008 14:02'! of: aNode ^ self new setRoot: aNode! ! !OBNavigate class methodsFor: 'as yet unclassified' stamp: 'dr 2/10/2009 16:25'! of: aNode label: aString ^(self of: aNode) label: aString; yourself! ! !OBNavigate methodsFor: 'as yet unclassified' stamp: 'lr 3/21/2009 20:03'! bid: anInteger toDo: aBlock anInteger > bid ifFalse: [ ^ self ]. bid := anInteger. action := aBlock! ! !OBNavigate methodsFor: 'accessing' stamp: 'lr 3/4/2009 22:08'! browserClass self subclassResponsibility! ! !OBNavigate methodsFor: 'as yet unclassified' stamp: 'lr 3/4/2009 08:24'! defaultAction ^ [fan children isEmpty ifTrue: [OBInformRequest message: self noChildrenMessage] ifFalse: [self browserClass browseRoot: fan parent label: self label]]! ! !OBNavigate methodsFor: 'as yet unclassified' stamp: 'dr 10/1/2007 16:28'! defaultMetaNode ^self browserClass defaultMetaNode! ! !OBNavigate methodsFor: 'as yet unclassified' stamp: 'cwp 8/20/2007 22:51'! execute ^ action value! ! !OBNavigate methodsFor: 'accessing' stamp: 'cwp 8/20/2007 23:10'! fan ^ fan! ! !OBNavigate methodsFor: 'initialize-release' stamp: 'cwp 8/20/2007 22:52'! initialize bid := 0. action := self defaultAction! ! !OBNavigate methodsFor: 'accessing' stamp: 'dr 2/10/2009 16:25'! label ^label! ! !OBNavigate methodsFor: 'accessing' stamp: 'dr 2/10/2009 16:25'! label: aString label := aString! ! !OBNavigate methodsFor: 'accessing' stamp: 'lr 3/4/2009 22:13'! noChildrenMessage self subclassResponsibility! ! !OBNavigate methodsFor: 'accessing' stamp: 'cwp 8/26/2007 00:30'! setRoot: aNode fan := (aNode copy metaNode: self defaultMetaNode) asFan! ! OBNavigate subclass: #OBShowHierarchyImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowHierarchyImplementors methodsFor: 'as yet unclassified' stamp: 'dr 9/21/2007 11:20'! browserClass ^ OBHierarchyImplementorsBrowser! ! !OBShowHierarchyImplementors methodsFor: 'as yet unclassified' stamp: 'dr 9/21/2007 11:20'! noChildrenMessage ^ 'no hierarchy implementors'! ! OBNavigate subclass: #OBShowHierarchySenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowHierarchySenders methodsFor: 'as yet unclassified' stamp: 'dr 9/21/2007 11:16'! browserClass ^ OBHierarchySendersBrowser! ! !OBShowHierarchySenders methodsFor: 'as yet unclassified' stamp: 'dr 9/21/2007 11:19'! noChildrenMessage ^'no hierarchy senders'! ! OBNavigate subclass: #OBShowImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowImplementors methodsFor: 'as yet unclassified' stamp: 'cwp 8/26/2007 00:34'! browserClass ^ OBImplementorsBrowser! ! !OBShowImplementors methodsFor: 'as yet unclassified' stamp: 'cwp 8/26/2007 00:34'! noChildrenMessage ^ 'no implementors'! ! OBNavigate subclass: #OBShowSenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowSenders methodsFor: 'as yet unclassified' stamp: 'cwp 8/26/2007 00:33'! browserClass ^ OBSendersBrowser! ! !OBShowSenders methodsFor: 'as yet unclassified' stamp: 'cwp 8/26/2007 00:33'! noChildrenMessage ^'no senders'! ! !Collection class methodsFor: '*ob-standard' stamp: 'lr 3/28/2009 15:54'! browserIcon ^ #collection! ! OBNode subclass: #OBCodeNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBCodeNode commentStamp: 'cwp 1/8/2005 11:12' prior: 0! OBCodeNode is an abstract superclass for node classes that represent program elements active in the image. Though it provides little functionality, it exists for structural purposes.! OBCodeNode subclass: #OBClassAwareNode instanceVariableNames: 'theClass' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassAwareNode commentStamp: 'cwp 1/8/2005 11:23' prior: 0! OBClassAware node models program elements that are part of a class. It provides methods for manipulating the class, as well as methods relating to sorting according to class hierarchy. iVars theClass - the class that this node is part of superior - during hierarchical sorting this refers to the nearest superclass that belongs to the group being sorted! !OBClassAwareNode class methodsFor: 'as yet unclassified' stamp: 'PDC 6/26/2007 21:41'! on: anObject self subclassResponsibility ! ! !OBClassAwareNode class methodsFor: 'sorting' stamp: 'dr 10/24/2008 18:55'! sortHierarchicallyOptimized: nodes "Reimplements sortHierarchically in a crude and ugly way that is however much more efficient" | classNodes sortedResults supersChain superior result chain1 chain2 i max | classNodes := (nodes collect: [:classNode | classNode theClass]) asOrderedCollection. sortedResults := SortedCollection sortBlock: [:assoc1 :assoc2 | result := nil. chain1 := assoc1 key. chain2 := assoc2 key. max := chain1 size min: chain2 size. i := 1. [result isNil and: [i <= max]] whileTrue: [ (chain1 at: i) = (chain2 at: i) ifTrue: [i := i + 1] ifFalse: [result := (chain1 at: i) name < (chain2 at: i) name]]. result isNil ifTrue: [ chain1 size < chain2 size] ifFalse: [result] ]. nodes do: [:classNode | supersChain := classNode theClass withAllSuperclasses reversed. supersChain removeAllSuchThat: [:cl | (classNodes includes: cl) not]. superior := supersChain size > 1 ifTrue: [superior := supersChain atLast: 2. nodes detect: [:e | e theClass = superior]] ifFalse: [nil]. sortedResults add: supersChain contents -> classNode. ]. ^(sortedResults collect: [:assoc | assoc value]) asArray! ! !OBClassAwareNode methodsFor: 'navigating' stamp: 'lr 2/17/2009 20:43'! allCategories "Return all categories of theClass and its superclasses." | categories | categories := self theClass withAllSuperclasses inject: Set new into: [ :result :class | result addAll: class organization categories; yourself ]. ^ OrderedCollection new add: (OBAllMethodCategoryNode on: self theClass); addAll: (categories asSortedCollection collect: [ :category | OBMethodCategoryNode on: category inClass: self theClass ]); yourself! ! !OBClassAwareNode methodsFor: 'actions' stamp: 'dr 2/15/2008 15:30'! browse OBCodeBrowser defaultBrowserClass openOnClass: self theNonMetaClass! ! !OBClassAwareNode methodsFor: 'actions' stamp: 'lr 4/3/2009 13:59'! browseHierarchy OBHierarchyBrowser openOnClass: self theClass! ! !OBClassAwareNode methodsFor: 'nodes' stamp: 'dvf 8/31/2005 13:11'! classNode ^self theClass asNode! ! !OBClassAwareNode methodsFor: 'ancestry' stamp: ''! isDescendantOfClass: aClassNode ^ self theClassName = aClassNode theClassName! ! !OBClassAwareNode methodsFor: 'ancestry' stamp: 'dr 9/18/2008 10:17'! isDescendantOfClassCat: aClassCategoryNode "optimized version: sending #category to the class is slow" ^ (self theNonMetaClass environment organization listAtCategoryNamed: aClassCategoryNode name) includes: self theNonMetaClassName ! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theClass ^ theClass! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theClass: aClass theClass := aClass! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theClassName ^ self theClass name! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theMetaClass ^ self theClass theMetaClass! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theNonMetaClass ^ self theClass theNonMetaClass! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theNonMetaClassName ^ self theNonMetaClass name! ! OBClassAwareNode subclass: #OBClassCommentNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassCommentNode commentStamp: 'cwp 1/8/2005 11:24' prior: 0! OBClassCommentNode represents the comment attached to a particular class. ! !OBClassCommentNode class methodsFor: 'as yet unclassified' stamp: ''! on: classRef ^ self new setClass: classRef! ! !OBClassCommentNode methodsFor: 'comparing' stamp: 'dr 10/29/2008 22:13'! = aClassOrCommentNode ^(aClassOrCommentNode isKindOf: OBClassAwareNode) and: [self theClass = aClassOrCommentNode theClass]! ! !OBClassCommentNode methodsFor: 'definition' stamp: 'jk 8/23/2007 17:16'! definition ^ OBClassCommentDefinition on: self theClass! ! !OBClassCommentNode methodsFor: 'testing' stamp: 'dr 10/30/2008 09:52'! isClassCommentNode ^true! ! !OBClassCommentNode methodsFor: 'public' stamp: 'cwp 12/13/2004 00:51'! name ^ self theClass name! ! !OBClassCommentNode methodsFor: 'initializing' stamp: ''! setClass: aClass self theClass: aClass! ! OBClassAwareNode subclass: #OBClassNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassNode commentStamp: 'lr 8/4/2007 10:30' prior: 0! OBClassNode wraps a class for display in various types of code browsers. It provides many navigation methods for the different types of browsers where classes may appear. The instance-variable theClass is always a non-metaclass.! !OBClassNode class methodsFor: 'instance creation' stamp: 'cwp 11/30/2004 21:06'! on: aClass ^ self new setClass: aClass ! ! !OBClassNode methodsFor: 'accessing' stamp: 'PDC 6/25/2007 22:40'! = other ^(self species = other species) and: [self theClass = other theClass] ! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 1/7/2005 23:05'! allCategory ^ Array with: (OBAllMethodCategoryNode on: self theClass)! ! !OBClassNode methodsFor: 'ancestry' stamp: ''! ancestrySelector ^ #isDescendantOfClass:! ! !OBClassNode methodsFor: 'navigating' stamp: 'lr 2/17/2009 20:47'! categories | categories publicCategories privateCategories | categories := self theClass organization categories. publicCategories := categories reject: [ :each | each beginsWith: #private ]. privateCategories := categories select: [ :each | each beginsWith: #private ]. ^ publicCategories sort , privateCategories sort collect: [ :each | OBMethodCategoryNode on: each inClass: self theClass ]! ! !OBClassNode methodsFor: 'nodes' stamp: 'dr 7/4/2008 16:49'! categoryNodeNamed: aString ^ OBMethodCategoryNode on: aString inClass: theClass! ! !OBClassNode methodsFor: 'accessing' stamp: 'dr 10/23/2008 14:12'! classCategory ^self theNonMetaClass category! ! !OBClassNode methodsFor: 'nodes' stamp: 'dr 10/23/2008 14:11'! classCategoryNode ^ OBClassCategoryNode on: self classCategory inEnvironment: self theClass environment! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 12/12/2004 23:31'! classHierarchy ^ self nodeHierarchyWithClass: OBClassNode! ! !OBClassNode methodsFor: 'navigating' stamp: ''! classVariables ^ self theClass allClassVarNames asArray sort collect: [:ea | OBClassVariableNode on: ea inClass: self theClass]! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 12/12/2004 23:31'! commentHierarchy ^ self nodeHierarchyWithClass: OBClassCommentNode! ! !OBClassNode methodsFor: 'accessing' stamp: ''! definition ^ OBClassDefinition environment: self theClass environment template: self theClass definition! ! !OBClassNode methodsFor: 'drag and drop' stamp: 'lr 3/28/2006 18:29'! dropOnClassCategory: aNode self theNonMetaClass category: aNode name. self signalSelection. ^ true! ! !OBClassNode methodsFor: 'drag and drop' stamp: 'lr 4/6/2006 11:31'! dropSelector ^ #dropOnClass:! ! !OBClassNode methodsFor: 'commands' stamp: 'dr 7/10/2008 16:26'! fileOut self theNonMetaClass fileOut! ! !OBClassNode methodsFor: 'testing' stamp: 'cwp 6/30/2006 00:57'! hasOrganization ^ true! ! !OBClassNode methodsFor: 'accessing' stamp: 'PDC 6/25/2007 21:38'! hash ^ self theClass hash! ! !OBClassNode methodsFor: 'navigating' stamp: ''! instanceVariables ^ self theClass allInstVarNames asArray sort collect: [:ea | OBInstanceVariableNode on: ea inClass: self theClass]! ! !OBClassNode methodsFor: 'testing' stamp: 'dr 11/28/2007 14:57'! isClassNode ^true! ! !OBClassNode methodsFor: 'ancestry' stamp: 'dr 12/2/2008 18:42'! isDescendantOfMethodCat: category ^ false! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 12/12/2004 23:30'! metaclassHierarchy ^ self nodeHierarchyWithClass: OBMetaclassNode! ! !OBClassNode methodsFor: 'accessing' stamp: 'lr 2/9/2008 09:18'! methods ^ self theClass selectors collect: [ :each | (MethodReference class: self theClass selector: each) asNode ]! ! !OBClassNode methodsFor: 'displaying' stamp: 'dr 9/15/2008 17:13'! name ^ self theClass name! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 5/20/2007 00:27'! nodeHierarchyWithClass: aClass ^ self surroundingHierarchy collect: [:ea | aClass on: ea]! ! !OBClassNode methodsFor: 'accessing' stamp: ''! organization ^ self theClass organization! ! !OBClassNode methodsFor: 'printing' stamp: 'cwp 12/10/2004 23:53'! printOn: aStream aStream print: self class; nextPut: $<; print: self theClass; nextPut: $>! ! !OBClassNode methodsFor: 'initializing' stamp: 'lr 8/4/2007 10:29'! setClass: aClass self theClass: aClass theNonMetaClass! ! !OBClassNode methodsFor: 'accessing' stamp: 'dr 10/23/2008 13:28'! surroundingHierarchy | class result | result := OrderedCollection new. class := self theNonMetaClass. class allSuperclasses reverseDo: [:aClass | result add: aClass]. class allSubclassesWithLevelDo: [:aClass :level | result add: aClass] startingLevel: 0. ^ result! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 10/17/2007 23:58'! users | nodes | nodes := (SystemNavigation default allCallsOn: (theClass environment associationAt: theClass name)) collect: [:ref | OBClassRefNode on: self name inMethod: ref]. ^ nodes asArray sort: [:a :b | a theClassName <= b theClassName]! ! OBClassNode subclass: #OBMetaclassNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMetaclassNode commentStamp: 'lr 8/4/2007 10:30' prior: 0! OBMetaclassNode is essentially the same as an OBClassNode, but overrides a few methods to work properly with metaclasses. The instance-variable theClass is always a metaclass.! !OBMetaclassNode methodsFor: 'actions' stamp: 'dr 2/15/2008 15:36'! browse ^ OBCodeBrowser defaultBrowserClass openOnClass: self theNonMetaClass! ! !OBMetaclassNode methodsFor: 'displaying' stamp: 'cwp 12/13/2004 00:56'! name ^ self nonMetaName! ! !OBMetaclassNode methodsFor: 'displaying' stamp: ''! nonMetaName ^ self theNonMetaClass name! ! !OBMetaclassNode methodsFor: 'initializing' stamp: 'lr 8/4/2007 10:29'! setClass: aClass self theClass: aClass theMetaClass! ! OBClassAwareNode subclass: #OBMethodCategoryNode instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMethodCategoryNode commentStamp: 'cwp 1/8/2005 12:29' prior: 0! OBMethodCategory represents a category within a ClassOrganization. Instead of an organization definition, OBMethodCategory presents a MethodDefinition with the class' default method template.! OBMethodCategoryNode subclass: #OBAllMethodCategoryNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBAllMethodCategoryNode commentStamp: 'cwp 1/8/2005 12:31' prior: 0! OBAllMethodCategory implements the synthetic '-- all --' category, which contains all the methods in a class.! !OBAllMethodCategoryNode class methodsFor: 'as yet unclassified' stamp: ''! on: className ^ self on: '-- all --' inClass: className! ! !OBAllMethodCategoryNode methodsFor: 'accessing' stamp: ''! category ^ 'as yet unclassified'! ! !OBAllMethodCategoryNode methodsFor: 'accessing' stamp: ''! methodReferences ^ self theClass selectors asSortedArray collect: [:ea | MethodReference new setStandardClass: self theClass methodSymbol: ea]! ! !OBMethodCategoryNode class methodsFor: 'actions' stamp: 'cwp 9/18/2004 22:58'! actionsForParent: aNode ^ #()! ! !OBMethodCategoryNode class methodsFor: 'instance creation' stamp: 'PDC 6/26/2007 21:47'! on: aClass self subclassResponsibility ! ! !OBMethodCategoryNode class methodsFor: 'instance creation' stamp: ''! on: aString inClass: aClassReference ^ self new setName: aString class: aClassReference! ! !OBMethodCategoryNode methodsFor: 'comparing' stamp: 'PDC 6/25/2007 22:42'! = other ^ self species = other species and: [self theClass = other theClass and: [self name = other name]]! ! !OBMethodCategoryNode methodsFor: 'navigating' stamp: 'lr 2/17/2009 20:49'! allMethods | allMethods | allMethods := OrderedCollection new. self theClass withAllSuperclassesDo: [ :class | class methodDict keysAndValuesDo: [ :selector :method | self name = (class organization categoryOfElement: selector) ifTrue: [ allMethods add: selector] ] ]. ^ allMethods collect: [ :selector | OBMethodNode on: selector inClass: (self theClass whichClassIncludesSelector: selector) ]! ! !OBMethodCategoryNode methodsFor: 'ancestry' stamp: ''! ancestrySelector ^ #isDescendantOfMethodCat:! ! !OBMethodCategoryNode methodsFor: 'actions' stamp: 'dr 2/15/2008 15:37'! browse OBCodeBrowser defaultBrowserClass openOnClass: self theClass category: name! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: ''! category ^ name! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: ''! container ^ self theClass! ! !OBMethodCategoryNode methodsFor: 'public' stamp: ''! definition ^ OBMethodDefinition inCategory: self category inClass: self theClass! ! !OBMethodCategoryNode methodsFor: 'drag and drop' stamp: 'lr 4/6/2006 11:46'! dropOnClass: aNode self methods do: [ :each | each dropOnClass: aNode ]. aNode signalChildrenChanged. ^ true! ! !OBMethodCategoryNode methodsFor: 'drag and drop' stamp: ''! dropSelector ^ #dropOnMethodCategory:! ! !OBMethodCategoryNode methodsFor: 'services' stamp: ''! fileOut self theClass fileOutCategory: name! ! !OBMethodCategoryNode methodsFor: 'comparing' stamp: 'cwp 7/6/2007 00:02'! hash ^ theClass hash bitXor: name hash! ! !OBMethodCategoryNode methodsFor: 'testing' stamp: 'dr 10/30/2008 10:23'! isCategoryNode ^true! ! !OBMethodCategoryNode methodsFor: 'ancestry' stamp: ''! isDescendantOfMethodCat: other ^ (other theClassName = self theClassName) and: [other name = name]! ! !OBMethodCategoryNode methodsFor: 'testing' stamp: 'dr 10/30/2008 09:49'! isMethodCategoryNode ^true! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: 'cwp 9/14/2005 09:06'! methodReferences ^ (self theClass organization listAtCategoryNamed: name) collect: [:ea | MethodReference new setClassSymbol: self theNonMetaClassName classIsMeta: self theClass isMeta methodSymbol: ea stringVersion: ''] ! ! !OBMethodCategoryNode methodsFor: 'navigating' stamp: 'dvf 8/19/2005 17:16'! methods ^ self methodReferences collect: [:ref | ref asNode]! ! !OBMethodCategoryNode methodsFor: 'public' stamp: 'dr 7/18/2007 11:51'! name ^name! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: 'dvf 8/16/2005 17:47'! printOn: aStream super printOn: aStream. aStream nextPut: $<. self name printOn: aStream. aStream nextPut: $>.! ! !OBMethodCategoryNode methodsFor: 'actions' stamp: 'cwp 9/19/2004 00:11'! remove self theClass removeCategory: name. self signalDeletion! ! !OBMethodCategoryNode methodsFor: 'actions' stamp: 'dr 2/10/2009 11:13'! renameTo: aString forRoot: aNode self container organization renameCategory: self name toBe: aString.! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: 'dr 2/4/2009 20:55'! setName: aString name := aString! ! !OBMethodCategoryNode methodsFor: 'initializing' stamp: ''! setName: aString class: aClass name := aString. self theClass: aClass! ! OBClassAwareNode subclass: #OBMethodNode instanceVariableNames: 'selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMethodNode commentStamp: 'cwp 1/8/2005 12:37' prior: 0! OBMethodNode wraps a method in a particular class. It supplies an OBMethodDefinition for displaying and editing the source code of the method, and various actions for manipulating the method. It has two roles: first it appears in the right most pane of a standard system browser. Second, it often serves as the root node for an OBListBrowser, and has navigation methods for senders, implementors etc. OBMethodNode also serves as the superclass for nodes that represent *parts* of a method, such as sends of a particular message, references to a class, accesses to a instance variable, etc.! OBMethodNode subclass: #OBClassRefNode instanceVariableNames: 'className' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassRefNode commentStamp: 'cwp 1/8/2005 12:38' prior: 0! Each instance of OBClassRefNode refers to a reference to a particular class from the source code of a method. It's used in the OBListBrowser created by the 'browse references' class action.! !OBClassRefNode class methodsFor: 'as yet unclassified' stamp: 'cwp 12/1/2004 00:50'! on: aClassName inMethod: aMethodRef ^ self new setClassName: aClassName reference: aMethodRef! ! !OBClassRefNode methodsFor: 'accessing' stamp: 'cwp 12/8/2004 22:14'! name ^ className! ! !OBClassRefNode methodsFor: 'accessing' stamp: 'cwp 12/1/2004 01:16'! selection | start parser | (parser := Compiler parserClass new) parseSelector: self source. start := parser endOfLastToken. start := (self source asString findString: className startingAt: start). ^ start to: start + className size - 1! ! !OBClassRefNode methodsFor: 'initialize-release' stamp: 'cwp 12/1/2004 01:10'! setClassName: theName reference: aMethodRef self setReference: aMethodRef. className := theName. ! ! OBMethodNode subclass: #OBMessageNode instanceVariableNames: 'message' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMessageNode commentStamp: 'cwp 1/8/2005 12:40' prior: 0! An OBMessageNode refers to a message send in the source code of a method. They are typically used in the 'senders' browser.! !OBMessageNode class methodsFor: 'instance creation' stamp: ''! fromMethodNode: aMethodNode ^ self new setMessage: aMethodNode selector selector: aMethodNode selector class: aMethodNode theClass! ! !OBMessageNode class methodsFor: 'instance creation' stamp: ''! on: aSelector inMethod: aSelector2 inClass: classRef ^ self new setMessage: aSelector selector: aSelector2 class: classRef! ! !OBMessageNode class methodsFor: 'instance creation' stamp: ''! on: aSelector inMethodNode: aNode ^ self on: aSelector inMethod: aNode selector inClass: aNode theClass! ! !OBMessageNode class methodsFor: 'instance creation' stamp: 'lr 2/12/2009 10:39'! on: aSelector inMethodReference: ref ^ self on: aSelector inMethod: ref methodSymbol inClass: ref actualClass! ! !OBMessageNode methodsFor: 'converting' stamp: 'cwp 8/22/2007 23:56'! asMethodNode ^ OBMethodNode on: selector inClass: self theClass! ! !OBMessageNode methodsFor: 'navigating' stamp: ''! implementors ^ self implementorsOf: message! ! !OBMessageNode methodsFor: 'displaying' stamp: 'cwp 12/8/2004 21:26'! name ^ message! ! !OBMessageNode methodsFor: 'accessing' stamp: 'cwp 7/18/2007 19:31'! selection | methodNode assoc | methodNode := Parser new parse: self source class: self theClass. assoc := (methodNode encoder rawSourceRanges) associations detect: [:ea | ea key selectorIs: message] ifNone: [nil -> (1 to: 0)]. "Some messages are generated by the compiler." ^ assoc value! ! !OBMessageNode methodsFor: 'navigating' stamp: ''! sendersOfMessage ^ self sendersOf: message! ! !OBMessageNode methodsFor: 'initializing' stamp: ''! setMessage: aSelector selector: aSelector2 class: aClass message := aSelector. selector := aSelector2. self theClass: aClass! ! !OBMessageNode methodsFor: 'accessing' stamp: 'alog 2/25/2008 03:49'! unifySelectors selector := message! ! !OBMethodNode class methodsFor: 'instance creation' stamp: ''! on: aMethodReference ^ self new setReference: aMethodReference! ! !OBMethodNode class methodsFor: 'instance creation' stamp: 'dr 1/9/2008 14:18'! on: aSelector inClass: aClassReference ^ self new setSelector: aSelector class: aClassReference! ! !OBMethodNode methodsFor: 'comparing' stamp: 'lr 11/13/2008 13:44'! = other ^ self species = other species and: [ self theClass = other theClass and: [ self selector = other selector ] ]! ! !OBMethodNode methodsFor: 'private' stamp: ''! addOverridersOf: aSelector inClass: aClass to: aCollection aClass subclasses do: [:ea | (ea includesSelector: aSelector) ifTrue: [aCollection add: ea] ifFalse: [self addOverridersOf: aSelector inClass: ea to: aCollection]]! ! !OBMethodNode methodsFor: 'ancestry' stamp: ''! ancestrySelector ^ #isDescendantOfMethod: ! ! !OBMethodNode methodsFor: 'displaying' stamp: 'dc 5/2/2007 19:05'! annotationString ^ (OBAnnotationRequest onClass: self theClass selector: self selector) getAnnotations.! ! !OBMethodNode methodsFor: 'converting' stamp: 'cwp 8/26/2007 01:39'! asMethodNode ^ self! ! !OBMethodNode methodsFor: 'actions' stamp: 'dr 2/15/2008 15:37'! browse OBCodeBrowser defaultBrowserClass defaultBrowserClass openOnClass: self theClass selector: selector! ! !OBMethodNode methodsFor: 'accessing' stamp: 'lr 2/12/2009 10:41'! category ^ [ self reference category ifNil: [ '' ] ] on: Error do: [ :err | '' ]! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 2/12/2009 10:41'! defaultSource ^ String streamContents: [ :stream | self writeMethodHeaderTo: stream. stream nextPut: Character cr; tab; nextPutAll: '"This method does not exist."'; nextPut: Character cr; tab; nextPutAll: 'self halt.' ]! ! !OBMethodNode methodsFor: 'accessing' stamp: 'cwp 12/1/2004 00:36'! definition ^ OBMethodDefinition selection: self selection source: self source inClass: self theClass! ! !OBMethodNode methodsFor: 'displaying' stamp: 'dr 9/25/2008 11:27'! displayString ^ [(self theClass includesLocalSelector: selector) ifTrue: [super displayString] ifFalse: [super displayString asText addAttribute: TextEmphasis italic]] onDNU: #includesLocalSelector: do: [super displayString]! ! !OBMethodNode methodsFor: 'private' stamp: 'cwp 10/18/2004 00:29'! doRemove self theClass removeSelector: self selector. self signalDeletion! ! !OBMethodNode methodsFor: 'drag and drop' stamp: 'lr 4/18/2006 08:55'! dropOnClass: aNode aNode theClass compile: self source classified: (self theClass organization categoryOfElement: self selector). InputSensor default shiftPressed ifFalse: [ self theClass removeSelector: self selector ]. aNode signalChildrenChanged. ^ true! ! !OBMethodNode methodsFor: 'drag and drop' stamp: 'dc 8/24/2007 11:57'! dropOnMethodCategory: aNode "We don't support dropping on another class yet." aNode theClass = self theClass ifFalse: [^ false]. self theClass organization classify: self selector under: aNode category suppressIfDefault: false. aNode signalChildrenChanged. ^ true! ! !OBMethodNode methodsFor: 'actions' stamp: ''! fileOut self theClass fileOutMethod: selector! ! !OBMethodNode methodsFor: 'displaying' stamp: 'cwp 12/8/2004 21:08'! fullName ^ self theClassName, '>>', selector! ! !OBMethodNode methodsFor: 'displaying' stamp: 'lr 3/9/2009 00:01'! fullNameWithProtocol ^ self fullName , ' {' , self category , '} [' , self packageName , ']'! ! !OBMethodNode methodsFor: 'testing' stamp: 'cwp 10/11/2006 20:46'! hasSelector ^ true! ! !OBMethodNode methodsFor: 'testing' stamp: 'cwp 10/9/2006 18:13'! hasVersions ^ true! ! !OBMethodNode methodsFor: 'comparing' stamp: 'cwp 12/8/2004 22:07'! hash ^ theClass hash bitXor: selector hash! ! !OBMethodNode methodsFor: 'navigating' stamp: 'dr 7/2/2007 17:10'! hierarchyImplementors ^OBClassAwareNode sortHierarchicallyOptimized: (self hierarchyImplementorsOf: selector)! ! !OBMethodNode methodsFor: 'private' stamp: 'dr 2/7/2008 09:49'! hierarchyImplementorsOf: aSelector | classCollection | classCollection := SortedCollection new. self theClass withAllSuperAndSubclassesDoGently: [:class | (class includesSelector: aSelector) ifTrue: [classCollection add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]. ^classCollection collect: [:ref | ref asNode]! ! !OBMethodNode methodsFor: 'navigating' stamp: 'dr 7/2/2007 17:10'! hierarchySenders ^self hierarchySendersOf: selector! ! !OBMethodNode methodsFor: 'private' stamp: 'dr 7/2/2007 17:01'! hierarchySendersOf: aSelector | hierarchySenders | hierarchySenders := (SystemNavigation default allCallsOn: aSelector) select: [:ea | (self theClass withAllSuperclasses includes: ea actualClass) or: [ self theClass allSubclasses includes: ea actualClass]]. ^hierarchySenders asSortedArray collect: [:ref | OBMessageNode on: aSelector inMethodReference: ref]! ! !OBMethodNode methodsFor: 'navigating' stamp: 'cwp 1/2/2005 23:12'! implementors ^ self implementorsOf: selector! ! !OBMethodNode methodsFor: 'private' stamp: 'cwp 12/8/2004 23:48'! implementorsOf: aSelector ^ (SystemNavigation default allImplementorsOf: aSelector) asSortedArray collect: [:ref | OBMethodNode on: ref]! ! !OBMethodNode methodsFor: 'private' stamp: 'cwp 12/8/2004 23:49'! inheritanceRoot | rootClass | rootClass := (self theClass withAllSuperclasses asArray select: [:ea | ea includesSelector: self selector]) last. ^ OBCollectionNode on: {OBMethodNode on: self selector inClass: rootClass}! ! !OBMethodNode methodsFor: 'ancestry' stamp: 'cwp 11/28/2004 10:37'! isDescendantOfMethod: other ^ other selector = selector and: [self theClass withAllSuperclasses includes: other theClass]. ! ! !OBMethodNode methodsFor: 'ancestry' stamp: 'dr 11/29/2008 17:26'! isDescendantOfMethodCat: aMethodCatNode ^aMethodCatNode theClass = self theClass and: [(self theClass organization categoryOfElement: self selector) = aMethodCatNode name]! ! !OBMethodNode methodsFor: 'ancestry' stamp: 'cwp 10/17/2004 23:55'! isDescendantOfMethodVersion: anOBMethodVersionNode ^ false! ! !OBMethodNode methodsFor: 'testing' stamp: 'jk 8/25/2007 16:46'! isLocalSelector ^ self theClass localSelectors includes: self selector.! ! !OBMethodNode methodsFor: 'testing' stamp: 'dr 11/2/2006 11:21'! isMethodNode ^true! ! !OBMethodNode methodsFor: 'testing' stamp: 'cwp 7/24/2007 00:48'! isOverridden self theClass allSubclassesDo: [:class | (class includesSelector: self selector) ifTrue: [^ true]]. ^ false! ! !OBMethodNode methodsFor: 'testing' stamp: 'cwp 7/24/2007 00:49'! isOverride self theClass allSuperclassesDo: [:class | (class includesSelector: self selector) ifTrue: [^ true]]. ^ false! ! !OBMethodNode methodsFor: 'nodes' stamp: ''! messageNode ^ OBMessageNode fromMethodNode: self! ! !OBMethodNode methodsFor: 'private' stamp: ''! messageSelectors ^ ((self theClass compiledMethodAt: self selector ifAbsent: [^ #()]) messages) asSortedArray! ! !OBMethodNode methodsFor: 'navigating' stamp: 'dc 1/26/2008 11:52'! messages ^ self messageSelectors collect: [:sel | OBMessageNode on: sel inMethod: selector inClass: self theClass]! ! !OBMethodNode methodsFor: 'actions' stamp: 'lr 3/4/2009 08:17'! moveToPackage | packagesNames selection packages | packages := PackageOrganizer default packages asSortedCollection: [ :a :b | a packageName <= b packageName ]. packagesNames := packages collect: [ :ea | ea packageName ]. selection := OBChoiceRequest prompt: nil labels: packagesNames values: packages. selection isNil ifFalse: [ selection addMethod: self reference ]! ! !OBMethodNode methodsFor: 'displaying' stamp: 'cwp 12/8/2004 21:08'! name ^ selector! ! !OBMethodNode methodsFor: 'displaying' stamp: 'jk 5/20/2007 11:01'! nameWithClassNameInBrackets ^ selector, ' (', self theClassName, ')'! ! !OBMethodNode methodsFor: 'navigating' stamp: 'cwp 12/8/2004 23:49'! overrides | classes | classes := OrderedCollection new. self addOverridersOf: self selector inClass: self theClass to: classes. ^ classes collect: [:ea | OBMethodNode on: selector inClass: ea] ! ! !OBMethodNode methodsFor: 'displaying' stamp: 'lr 3/9/2009 00:01'! packageName ^ (PackageOrganizer default mostSpecificPackageOfMethod: self reference ifNone: [ ^ 'Unknown' ]) packageName! ! !OBMethodNode methodsFor: 'printing' stamp: 'cwp 12/8/2004 21:59'! printOn: aStream aStream nextPutAll: self class name; nextPut: $<; nextPutAll: self theClass name; nextPut: $#; nextPutAll: self selector; nextPut: $>! ! !OBMethodNode methodsFor: 'accessing' stamp: ''! reference ^ self referenceForMethod: selector ofClass: self theClassName! ! !OBMethodNode methodsFor: 'actions' stamp: 'lr 3/4/2009 08:17'! remove | senders choice | senders := SystemNavigation default allCallsOn: self selector. senders isEmpty ifTrue: [ ^ self doRemove ]. choice := OBChoiceRequest prompt: 'This message has ' , senders size asString , ' senders.' labels: #( 'Remove it' 'Remove, then browse senders' 'Don''t remove, but show me those senders' 'Forget it -- do nothing -- sorry I asked' ) values: #( #doRemove #removeAndBrowse #simpleBrowseSenders nil ). choice isNil ifFalse: [ ^ self perform: choice ]! ! !OBMethodNode methodsFor: 'private' stamp: ''! removeAndBrowse self simpleBrowseSenders. self theClass removeSelector: self selector. self signalDeletion! ! !OBMethodNode methodsFor: 'accessing' stamp: 'cwp 12/1/2004 00:37'! selection ^ 1 to: 0! ! !OBMethodNode methodsFor: 'accessing' stamp: ''! selector ^ selector! ! !OBMethodNode methodsFor: 'navigating' stamp: ''! selectorAndMessages ^ self messages copyWithFirst: self messageNode! ! !OBMethodNode methodsFor: 'navigating' stamp: ''! senders ^ self sendersOf: selector! ! !OBMethodNode methodsFor: 'private' stamp: ''! sendersOf: aSelector ^ (SystemNavigation default allCallsOn: aSelector) asSortedArray collect: [:ref | OBMessageNode on: aSelector inMethodReference: ref]! ! !OBMethodNode methodsFor: 'initializing' stamp: ''! setReference: aMethodReference self setSelector: aMethodReference methodSymbol class: (aMethodReference actualClass)! ! !OBMethodNode methodsFor: 'initializing' stamp: ''! setSelector: aSelector class: aClass selector := aSelector. self theClass: aClass ! ! !OBMethodNode methodsFor: 'private' stamp: 'avi 9/17/2005 01:29'! simpleBrowseSenders OBSendersBrowser browseRoot: self! ! !OBMethodNode methodsFor: 'actions' stamp: 'dc 6/27/2007 13:03'! source ^ (self theClass sourceCodeAt: self selector ifAbsent: [^ self defaultSource]) asText makeSelectorBold! ! !OBMethodNode methodsFor: 'accessing' stamp: ''! sourceFiles ^ OBSourceFilesRequest signal! ! !OBMethodNode methodsFor: 'private' stamp: ''! sourcePointer ^ (self theClass compiledMethodAt: self selector) sourcePointer! ! !OBMethodNode methodsFor: 'navigating' stamp: ''! versions ^ (OBMethodVersion scan: self sourceFiles from: self sourcePointer) collect: [:ea | OBMethodVersionNode on: ea]! ! !OBMethodNode methodsFor: 'private' stamp: 'dc 6/27/2007 13:21'! writeMethodHeaderTo: aStream |keywords| self selector numArgs = 0 ifTrue: [aStream nextPutAll: self selector. ^ self]. keywords := self selector keywords. (1 to: keywords size) do: [:i | aStream nextPutAll: (keywords at: i); space; nextPutAll: 'arg'; print: i ] separatedBy: [aStream space]! ! OBMethodNode subclass: #OBMethodVersionNode instanceVariableNames: 'version' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMethodVersionNode commentStamp: 'cwp 1/8/2005 12:41' prior: 0! OBMethodVersions refer to OBMethodVersions, and are used by the VersionBrowser.! !OBMethodVersionNode class methodsFor: 'instance creation' stamp: ''! on: aMethodVersion ^ self new setVersion: aMethodVersion! ! !OBMethodVersionNode methodsFor: 'actions' stamp: 'dr 2/15/2008 15:37'! browse OBCodeBrowser defaultBrowserClass openOnClass: self theClass selector: version selector! ! !OBMethodVersionNode methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:57'! category ^ self theClass organization categoryOfElement: version selector! ! !OBMethodVersionNode methodsFor: 'compiling' stamp: 'cwp 10/17/2004 23:53'! definition ^ (OBMethodDefinition source: version source inClass: self theClass) callback: [:sel | version selector = sel ifTrue: [self class on: version latest] ifFalse: [OBMethodNode on: sel inClass: self theClass]]! ! !OBMethodVersionNode methodsFor: 'ancestry' stamp: 'cwp 10/17/2004 23:43'! isDescendantOfMethodVersion: aNode ^ (version = aNode version)! ! !OBMethodVersionNode methodsFor: 'displaying' stamp: 'cwp 11/27/2004 21:38'! name | stamp | stamp := version stamp ifNil: ['']. ^ version theClassName, '>>', version selector, ' ', stamp! ! !OBMethodVersionNode methodsFor: 'accessing' stamp: ''! reference ^ self referenceForMethod: version selector ofClass: self theClassName.! ! !OBMethodVersionNode methodsFor: 'accessing' stamp: 'cwp 10/11/2006 20:55'! selector ^ version selector! ! !OBMethodVersionNode methodsFor: 'initializing' stamp: 'cwp 3/11/2007 21:29'! setVersion: aMethodVersion version := aMethodVersion. self setSelector: version selector class: version theClass! ! !OBMethodVersionNode methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:44'! version ^ version! ! OBClassAwareNode subclass: #OBVariableNode instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBVariableNode commentStamp: 'cwp 1/8/2005 12:46' prior: 0! OBVariableNode is an abstract superclass for the two types of variables a class can contain - class variables and instance variables. The only difference between the two subclasses is how they search for methods that refer to them.! OBVariableNode subclass: #OBClassVariableNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassVariableNode commentStamp: 'cwp 1/8/2005 12:51' prior: 0! OBClassVariable provides a method for finding methods which refer to a shared variable, ie, by searching for an association in the literal frame rather than for bytecodes refering to an instance variable.! !OBClassVariableNode methodsFor: 'navigating' stamp: 'cwp 12/8/2004 23:47'! accessors | literal | literal := (self theClass withAllSuperclasses gather: [:ea | ea classPool associations]) detect: [:ea | ea key = name]. ^ ((self systemNavigation allCallsOn: literal) asArray sort) collect: [:ref | OBMethodNode on: ref]! ! OBVariableNode subclass: #OBInstanceVariableNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBInstanceVariableNode commentStamp: 'cwp 1/8/2005 12:50' prior: 0! OBClassVariable provides a method for finding methods which refer to an instance, ie, by searching for instance variable access bytecodes rather than for an association in the literal frame.! !OBInstanceVariableNode methodsFor: 'navigating' stamp: 'cwp 12/8/2004 23:48'! accessors | accessors | accessors := OrderedCollection new. self theClass withAllSubAndSuperclassesDo: [:class | (class whichSelectorsAccess: name) asSortedCollection do: [:ea | ea = #DoIt ifFalse: [accessors add: (self referenceForMethod: ea ofClass: class name)]]]. ^ accessors asArray collect: [:ref | OBMethodNode on: ref]! ! !OBVariableNode class methodsFor: 'instance creation' stamp: 'PDC 6/26/2007 21:47'! on: anObject self subclassResponsibility ! ! !OBVariableNode class methodsFor: 'instance creation' stamp: ''! on: instVarName inClass: aClassReference ^ self new setName: instVarName class: aClassReference! ! !OBVariableNode methodsFor: 'navigating' stamp: 'PDC 6/25/2007 23:01'! accessors self subclassResponsibility ! ! !OBVariableNode methodsFor: 'displaying' stamp: ''! name ^ name! ! !OBVariableNode methodsFor: 'initializing' stamp: ''! setName: aString class: aClass name := aString. self theClass: aClass! ! OBCodeNode subclass: #OBClassCategoryNode instanceVariableNames: 'environment name' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassCategoryNode commentStamp: 'cwp 1/8/2005 12:58' prior: 0! OBClassCategory represents a system category in the image's SystemOrganization.! !OBClassCategoryNode class methodsFor: 'instance creation' stamp: ''! on: aString ^ self new setName: aString! ! !OBClassCategoryNode class methodsFor: 'instance creation' stamp: ''! on: aString inEnvironment: anEnvironment ^ self new setName: aString environment: anEnvironment! ! !OBClassCategoryNode methodsFor: 'ancestry' stamp: ''! ancestrySelector ^ #isDescendantOfClassCat:! ! !OBClassCategoryNode methodsFor: 'actions' stamp: 'dr 2/15/2008 15:30'! browse OBCodeBrowser defaultBrowserClass openOnEnvironment: environment category: name! ! !OBClassCategoryNode methodsFor: 'private' stamp: ''! classNames ^ environment organization listAtCategoryNamed: name! ! !OBClassCategoryNode methodsFor: 'navigating' stamp: 'dvf 8/15/2005 17:31'! classes ^ self classNames collect: [:ea | (environment at: ea) asNode]! ! !OBClassCategoryNode methodsFor: 'navigating' stamp: 'dvf 8/17/2005 17:25'! comments ^ self classNames collect: [:ea | (environment at: ea) asCommentNode ]! ! !OBClassCategoryNode methodsFor: 'accessing' stamp: 'cwp 9/22/2004 22:13'! container ^ environment! ! !OBClassCategoryNode methodsFor: 'displaying' stamp: ''! definition ^ OBClassDefinition environment: environment template: ((environment at: #Class) template: name)! ! !OBClassCategoryNode methodsFor: 'drag and drop' stamp: ''! dropSelector ^ #dropOnClassCategory:! ! !OBClassCategoryNode methodsFor: 'services' stamp: ''! fileOut environment organization fileOutCategory: name.! ! !OBClassCategoryNode methodsFor: 'testing' stamp: 'cwp 7/17/2006 08:47'! isCategory ^ true! ! !OBClassCategoryNode methodsFor: 'testing' stamp: 'dr 10/30/2008 09:54'! isCategoryNode ^ true! ! !OBClassCategoryNode methodsFor: 'testing' stamp: 'dr 10/30/2008 09:48'! isClassCategoryNode ^true! ! !OBClassCategoryNode methodsFor: 'ancestry' stamp: ''! isDescendantOfClassCat: other ^ other name = name! ! !OBClassCategoryNode methodsFor: 'class creation' stamp: ''! isRedefinedBy: definition "No class is selected, so the definition can't be a redefinition." ^ false! ! !OBClassCategoryNode methodsFor: 'navigating' stamp: 'dvf 8/15/2005 17:52'! metaclasses ^self classNames collect: [:ea | (environment at: ea) asClassSideNode]! ! !OBClassCategoryNode methodsFor: 'displaying' stamp: 'dr 12/9/2008 20:17'! name ^name! ! !OBClassCategoryNode methodsFor: 'printing' stamp: 'cwp 5/11/2007 00:59'! printOn: aStream aStream nextPutAll: self class name; nextPut: $<; nextPutAll: self name; nextPut: $>! ! !OBClassCategoryNode methodsFor: 'actions' stamp: 'cwp 9/19/2004 00:11'! remove environment organization removeSystemCategory: name. self signalDeletion! ! !OBClassCategoryNode methodsFor: 'actions' stamp: 'dr 2/10/2009 11:13'! renameTo: aString forRoot: aNode self container organization renameCategory: self name toBe: aString. ! ! !OBClassCategoryNode methodsFor: 'initializing' stamp: ''! setName: aString self setName: aString environment: self class environment! ! !OBClassCategoryNode methodsFor: 'initializing' stamp: ''! setName: aString environment: anEnvironment name := aString asSymbol. environment := anEnvironment! ! !OBClassCategoryNode methodsFor: 'displaying' stamp: ''! text ^ 'Object subclass: #NameOfSubclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: ''', self name, ''''! ! !OBCodeNode class methodsFor: 'as yet unclassified' stamp: 'PDC 6/26/2007 21:40'! on: anObject self subclassResponsibility ! ! !OBCodeNode methodsFor: 'displaying' stamp: 'lr 5/2/2007 17:30'! annotationString "Provide a line of content for an annotation pane, representing information about the method associated with the selected node." ^ nil! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 6/30/2006 00:37'! hasOrganization ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 10/11/2006 20:47'! hasSelector ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 10/9/2006 18:12'! hasVersions ^ false! ! OBCodeNode subclass: #OBEnvironmentNode instanceVariableNames: 'environment' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBEnvironmentNode commentStamp: 'cwp 1/8/2005 13:01' prior: 0! OBEnvironmentNode wraps an instance of SystemDictionary. In current Squeak images, there is only one such instance, but OB-Standard is coded so as to use rely on this assumption as little as possible. Thus OBEnvironmentNode typically serves as the root of the standard browser, and passes its environment on to other nodes in the tree.! !OBEnvironmentNode class methodsFor: 'as yet unclassified' stamp: ''! forImage ^ self on: Smalltalk! ! !OBEnvironmentNode class methodsFor: 'as yet unclassified' stamp: ''! on: anEnvironment ^ self new setEnvironment: anEnvironment! ! !OBEnvironmentNode methodsFor: 'navigating' stamp: ''! categories ^ environment organization categories collect: [:cat | OBClassCategoryNode on: cat inEnvironment: environment]! ! !OBEnvironmentNode methodsFor: 'navigating' stamp: 'cwp 9/20/2005 08:43'! categoryNodeNamed: aString ^ OBClassCategoryNode on: aString! ! !OBEnvironmentNode methodsFor: 'accessing' stamp: ''! environment ^ environment! ! !OBEnvironmentNode methodsFor: 'testing' stamp: 'cwp 6/30/2006 00:54'! hasOrganization ^ true! ! !OBEnvironmentNode methodsFor: 'testing' stamp: 'cwp 10/9/2006 13:36'! isEnvironment ^ true! ! !OBEnvironmentNode methodsFor: 'displaying' stamp: 'lr 2/9/2008 12:00'! name ^ environment name! ! !OBEnvironmentNode methodsFor: 'accessing' stamp: ''! organization ^ self environment organization! ! !OBEnvironmentNode methodsFor: 'initializing' stamp: ''! setEnvironment: anEnvironment environment := anEnvironment! ! OBCodeNode subclass: #OBSearchNode instanceVariableNames: 'query' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! OBSearchNode subclass: #OBClassRefSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassRefSearchNode methodsFor: 'private' stamp: 'cwp 4/15/2007 21:27'! classSatisfiesQuery: aClass ^ (SystemNavigation default allCallsOn: (Smalltalk associationAt: query) from: aClass) isEmpty not! ! !OBClassRefSearchNode methodsFor: 'navigation' stamp: 'dr 2/18/2009 16:13'! classes | refs classNames nodes | refs := SystemNavigation default allCallsOn: (Smalltalk associationAt: query ifAbsent: [^#()]). classNames := refs collect: [:ea | ea classSymbol]. nodes := classNames asSet collect: [:ea | OBClassNode on: (Smalltalk at: ea)]. ^ nodes asArray sort: [:a :b | a theClassName <= b theClassName]! ! !OBClassRefSearchNode methodsFor: 'display' stamp: 'cwp 7/20/2007 22:23'! name ^ (super name copyWithFirst: $#) , ' (class refs)'! ! OBSearchNode subclass: #OBClassSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassSearchNode methodsFor: 'private' stamp: 'dr 2/18/2009 16:10'! classSatisfiesQuery: aString | classQueried | classQueried := aString. query do: [:aQuery | (classQueried includesSubstring: aQuery caseSensitive: false) ifTrue: [classQueried := classQueried copyFrom: (classQueried indexOfSubCollection: aQuery) + aQuery size to: classQueried size] ifFalse:[^false]]. ^true! ! !OBClassSearchNode methodsFor: 'navigation' stamp: 'lr 11/13/2008 13:44'! classes ^ ((SystemNavigation default allClasses select: [ :ea | self classSatisfiesQuery: ea ]) collect: [ :ea | OBClassNode on: ea ]) asArray! ! !OBClassSearchNode methodsFor: 'display' stamp: 'cb 7/19/2007 13:52'! name |name| name := '*'. query do: [:ea | name := name , ea, '*']. ^name, ' (classes)'! ! OBSearchNode subclass: #OBImplementorSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBImplementorSearchNode methodsFor: 'as yet unclassified' stamp: 'cwp 4/15/2007 20:40'! classSatisfiesQuery: aClass ^ aClass includesSelector: query! ! !OBImplementorSearchNode methodsFor: 'as yet unclassified' stamp: 'dr 10/22/2008 09:44'! classes ^ (SystemNavigation default allClassesImplementing: query) collect: [:ea | OBClassNode on: ea]! ! !OBImplementorSearchNode methodsFor: 'display' stamp: 'dr 10/22/2008 09:15'! name ^super name, ' (implementors)' ! ! OBSearchNode subclass: #OBMethodSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMethodSearchNode methodsFor: 'as yet unclassified' stamp: 'dr 10/22/2008 09:54'! classSatisfiesQuery: aClass ^ aClass selectors anySatisfy: [:ea | ea includesSubstring: query caseSensitive: true]! ! !OBMethodSearchNode methodsFor: 'as yet unclassified' stamp: 'dr 10/22/2008 09:38'! classes | nav classes | nav := self systemNavigation. classes := IdentitySet new. (Symbol selectorsContaining: query) do: [:ea | classes addAll: (nav allClassesImplementing: ea)]. ^ classes asArray collect: [:ea | OBClassNode on: ea]! ! !OBMethodSearchNode methodsFor: 'display' stamp: 'cb 7/19/2007 21:18'! name ^ super name, '* (implementors)'! ! !OBSearchNode class methodsFor: 'as yet unclassified' stamp: 'dr 10/22/2008 09:38'! on: aString ^ self basicNew setRawQuery: aString! ! !OBSearchNode methodsFor: 'comparing' stamp: 'cwp 4/19/2007 00:36'! = other ^ self species = other species and: [self query = other query]! ! !OBSearchNode methodsFor: 'private' stamp: 'PDC 6/25/2007 21:23'! classSatisfiesQuery: aClass self subclassResponsibility ! ! !OBSearchNode methodsFor: 'navigation' stamp: 'PDC 6/25/2007 21:19'! classes self subclassResponsibility ! ! !OBSearchNode methodsFor: 'navigation' stamp: 'PDC 6/25/2007 21:16'! comments ^self classes collect: [:ea| ea theClass asCommentNode]! ! !OBSearchNode methodsFor: 'displaying' stamp: 'dr 10/20/2008 16:17'! displayString ^ self name.! ! !OBSearchNode methodsFor: 'comparing' stamp: 'cwp 4/19/2007 00:36'! hash ^ query hash! ! !OBSearchNode methodsFor: 'ancestry' stamp: 'cwp 4/15/2007 20:31'! isAncestorOf: aNode ^ self = aNode or: [self classSatisfiesQuery: aNode theClass]! ! !OBSearchNode methodsFor: 'ancestry' stamp: 'cwp 5/12/2007 23:12'! isAncestorOf: aNode using: aSelector ^ self = aNode or: [self classSatisfiesQuery: aNode theClass]! ! !OBSearchNode methodsFor: 'navigation' stamp: 'PDC 6/25/2007 21:17'! metaclasses ^self classes collect: [:ea| ea theMetaClass asClassSideNode]! ! !OBSearchNode methodsFor: 'display' stamp: 'cwp 4/7/2007 23:28'! name ^ query! ! !OBSearchNode methodsFor: 'private' stamp: 'cwp 4/15/2007 20:14'! nodesForRefs: refs | classNames nodes | classNames := refs collect: [:ea | ea classSymbol]. nodes := classNames asSet collect: [:ea | OBClassNode on: (Smalltalk at: ea)]. ^ nodes asArray sort: [:a :b | a theClassName <= b theClassName]! ! !OBSearchNode methodsFor: 'accessing' stamp: 'cwp 4/8/2007 00:26'! query ^ query! ! !OBSearchNode methodsFor: 'initialize-release' stamp: 'PDC 6/29/2007 06:37'! setRawQuery: aString query := aString! ! OBSearchNode subclass: #OBSenderSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBSenderSearchNode methodsFor: 'as yet unclassified' stamp: 'cwp 4/15/2007 21:27'! classSatisfiesQuery: aClass ^ (SystemNavigation default allCallsOn: query from: aClass) isEmpty not! ! !OBSenderSearchNode methodsFor: 'as yet unclassified' stamp: 'cwp 4/15/2007 21:32'! classes ^ self nodesForRefs: (SystemNavigation default allCallsOn: query) ! ! !OBSenderSearchNode methodsFor: 'display' stamp: 'cb 7/17/2007 11:53'! name ^ (super name copyWithFirst: $#) , ' (senders)'! ! OBCodeNode subclass: #OBSelectorNode instanceVariableNames: 'selector methods' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBSelectorNode commentStamp: 'cwp 1/8/2005 13:03' prior: 0! OBSelectorNode wraps an instance of Symbol. It typically serves as the root of a senders or implementors OBListBrowser, and is used when cmd-n or cmd-m is invoke from the definition panel, and so no OBMethodNode is available.! !OBSelectorNode class methodsFor: 'instance creation' stamp: 'cwp 10/31/2004 01:11'! on: aSelector ^ self new selector: aSelector! ! !OBSelectorNode methodsFor: 'testing' stamp: 'cwp 10/11/2006 20:56'! hasSelector ^ true! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'cwp 12/8/2004 23:48'! implementors ^ (SystemNavigation default allImplementorsOf: self selector) asSortedArray collect: [:ref | OBMethodNode on: ref]! ! !OBSelectorNode methodsFor: 'ancestry' stamp: 'DM 5/23/2007 18:20'! isAncestorOf: aNode ^ (aNode source findString: selector string startingAt: 0 ) isNonZero.! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'PDC 6/25/2007 22:55'! methods methods ifNil: [methods := SystemNavigation default allMethodsNoDoitsSelect: [:m | m hasLiteralSuchThat: [:lit | lit isString and: [lit isSymbol not and: [lit includesSubstring: selector string caseSensitive: false]]]]]. ^ methods collect: [:m | OBMethodNode on: m]! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'cwp 10/31/2004 01:12'! name ^ selector printString! ! !OBSelectorNode methodsFor: 'accessing' stamp: 'dr 7/18/2007 13:57'! reference | references | "this is a bit hacky actually..." references := SystemNavigation default allImplementorsOf: selector. references ifEmpty: [self error: 'No method with this selector exists!!']. ^references first! ! !OBSelectorNode methodsFor: 'accessing' stamp: 'cwp 10/31/2004 01:11'! selector ^ selector! ! !OBSelectorNode methodsFor: 'accessing' stamp: 'cwp 10/31/2004 01:10'! selector: aSelector selector := aSelector! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'cwp 10/31/2004 01:12'! selectorAndMessages ^ Array with: self! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'cwp 11/1/2004 02:22'! senders ^ (SystemNavigation default allCallsOn: self selector) asSortedArray collect: [:ref | OBMessageNode on: self selector inMethodReference: ref]! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'cwp 10/31/2004 01:48'! sendersOfMessage ^ (SystemNavigation default allCallsOn: self selector) asSortedArray collect: [:ref | OBMessageNode on: self selector inMethodReference: ref]! ! !OBNode methodsFor: '*ob-standard-testing' stamp: 'dr 11/26/2008 10:46'! isCategoryNode ^ false! ! !OBNode methodsFor: '*ob-standard-testing' stamp: 'dr 11/26/2008 10:46'! isClassCategoryNode ^false! ! !OBNode methodsFor: '*ob-standard-testing' stamp: 'dr 11/26/2008 10:46'! isClassCommentNode ^false! ! !OBNode methodsFor: '*ob-standard-testing' stamp: 'dr 11/26/2008 10:46'! isClassNode ^false! ! !OBNode methodsFor: '*ob-standard-testing' stamp: 'dr 11/26/2008 10:47'! isEnvironment ^ false! ! !OBNode methodsFor: '*ob-standard-testing' stamp: 'dr 11/26/2008 10:46'! isMethodCategoryNode ^false! ! !OBNode methodsFor: '*ob-standard-testing' stamp: 'dr 11/26/2008 10:45'! isMethodNode ^false! ! !Metaclass methodsFor: '*ob-standard-converting' stamp: 'lr 8/4/2007 10:34'! asClassSideNode ^ OBMetaclassNode on: self! ! !Metaclass methodsFor: '*ob-standard-converting' stamp: 'lr 8/4/2007 10:33'! asNode ^ OBMetaclassNode on: self! ! OBTextPanel subclass: #OBAnnotationPanel instanceVariableNames: 'text' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Panels'! !OBAnnotationPanel methodsFor: 'callbacks' stamp: 'lr 5/2/2007 17:23'! accept: aString notifying: aController ^ false! ! !OBAnnotationPanel methodsFor: 'building' stamp: 'cwp 7/25/2007 23:57'! buildOn: aBuilder ^aBuilder textfield: self with: []! ! !OBAnnotationPanel methodsFor: 'accessing' stamp: 'dr 4/11/2008 13:45'! environment ^ Smalltalk! ! !OBAnnotationPanel methodsFor: 'callbacks' stamp: 'lr 5/2/2007 17:20'! selection ^ 1 to: 0! ! !OBAnnotationPanel methodsFor: 'updating' stamp: 'lr 3/4/2009 08:20'! selectionChanged: ann text := ann node isNil ifTrue: [ String new ] ifFalse: [ ann node annotationString ]. self changed: #text! ! !OBAnnotationPanel methodsFor: 'updating' stamp: 'lr 5/2/2007 17:17'! subscribe self announcer observe: OBSelectionChanged send: #selectionChanged: to: self! ! !OBAnnotationPanel methodsFor: 'callbacks' stamp: 'lr 5/2/2007 17:21'! text ^ text! ! !OBAnnotationPanel methodsFor: 'building' stamp: 'lr 5/2/2007 17:19'! vResizing ^ #rigid! ! OBTextPanel subclass: #OBMercuryPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Panels'! !OBMercuryPanel class methodsFor: 'class initialization' stamp: 'lr 1/31/2009 14:10'! initialize "OBMercuryPanel initialize" Preferences addPreference: #mercuryPanel categories: #('browsing') default: false balloonHelp: 'Adds the mercury panel to OmniBrowser. This panel is the one on top to search senders, implementors, classes...'! ! !OBMercuryPanel class methodsFor: 'class initialization' stamp: 'dr 10/18/2008 10:34'! unload Preferences removePreference: #mercuryPanel! ! !OBMercuryPanel methodsFor: 'callbacks' stamp: 'dr 10/20/2008 18:08'! accept: aText notifying: anObject aText asString withBlanksTrimmed ifEmpty: [^self]. OBMercuryQuery find: aText for: self. self changed: #text! ! !OBMercuryPanel methodsFor: 'user interface' stamp: 'cwp 4/19/2007 22:30'! addTextCommandsToMenu: aMenu selection: aTextSelection! ! !OBMercuryPanel methodsFor: 'building' stamp: 'cwp 8/16/2007 11:40'! buildOn: aBuilder ^ aBuilder textfield: self with: []! ! !OBMercuryPanel methodsFor: 'private' stamp: 'cwp 7/20/2007 00:33'! environment ^ Smalltalk! ! !OBMercuryPanel methodsFor: 'callbacks' stamp: 'cwp 2/25/2007 19:44'! selection ^ 1 to: 0! ! !OBMercuryPanel methodsFor: 'actions' stamp: 'cwp 3/3/2007 00:28'! string: aString self systemNavigation browseMethodsWithString: aString! ! !OBMercuryPanel methodsFor: 'callbacks' stamp: 'cwp 2/25/2007 19:43'! text ^ ''! ! !OBMercuryPanel methodsFor: 'building' stamp: 'cwp 3/18/2007 20:54'! vResizing ^ #rigid! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 3/4/2009 22:11'! browseIt: aSymbol | entry | entry := self environment at: aSymbol ifAbsent: [nil]. entry ifNil: [^ self implementorsOfIt: aSymbol]. ((entry isKindOf: Class) or: [entry isKindOf: Trait]) ifFalse: [entry := entry class]. OBCodeBrowser defaultBrowserClass openOnClass: entry. ^ true! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 3/4/2009 22:14'! environment ^ Smalltalk! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'cwp 8/26/2007 01:04'! implementorsOfIt: aSelector | node | node := OBSelectorNode on: aSelector. (self announce: (OBShowImplementors of: node)) execute. ^true! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'dr 11/14/2008 11:16'! referencesToIt: aClassName | class | class := self environment at: aClassName ifAbsent: [^false]. class isBehavior ifFalse: [^false]. OBReferencesBrowser browseRoot: (OBClassNode on: class). ^true! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'cwp 8/24/2007 01:08'! sendersOfIt: aSelector | node | node := OBSelectorNode on: aSelector. (self announce: (OBShowSenders of: node)) execute. ^true! ! !Exception class methodsFor: '*ob-standard' stamp: 'lr 3/28/2009 15:56'! browserIcon ^ #exception! ! !ParseNode methodsFor: '*ob-standard' stamp: 'cwp 7/18/2007 19:31'! selectorIs: aSymbol ^ false! ! OBCommand subclass: #OBCategoryCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCategoryCommand methodsFor: 'as yet unclassified' stamp: 'avi 5/30/2007 23:07'! group ^ #category! ! !OBCategoryCommand methodsFor: 'as yet unclassified' stamp: 'lr 11/13/2008 13:44'! isActive ^ target hasOrganization and: [ (requestor isSelected: target) not and: [ requestor selectedNode isNil or: [ requestor selectedNode isCategoryNode ] ] ]! ! OBCategoryCommand subclass: #OBCmdCreateCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCreateCategory methodsFor: 'private' stamp: 'cwp 9/25/2006 00:12'! categoryTemplateFor: anOrganization ^ anOrganization isClassOrganizer ifTrue: ['category name'] ifFalse: ['Category-Name']! ! !OBCmdCreateCategory methodsFor: 'execution' stamp: 'lr 3/21/2009 20:03'! execute | catName | catName := self requestCategoryToUser. catName isNil ifTrue: [ ^ self ]. target organization addCategory: catName. self select: (target categoryNodeNamed: catName) with: requestor announcer! ! !OBCmdCreateCategory methodsFor: 'accessing' stamp: 'lr 6/9/2007 10:33'! icon ^ #newIcon! ! !OBCmdCreateCategory methodsFor: 'accessing' stamp: 'dr 7/2/2008 14:32'! label ^ 'add category...'! ! !OBCmdCreateCategory methodsFor: 'execution' stamp: 'dc 1/16/2008 12:41'! requestCategoryToUser ^ OBTextRequest prompt: 'Please type new category name' template: (self categoryTemplateFor: target organization)! ! OBCmdCreateCategory subclass: #OBCmdCreateClassCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCreateClassCategory methodsFor: 'testing' stamp: 'dc 1/16/2008 13:37'! isActive ^ (requestor selectedNode isNil or: [requestor selectedNode isKindOf: OBClassCategoryNode]) and: [super isActive]! ! OBCmdCreateCategory subclass: #OBCmdCreateMethodCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCreateMethodCategory methodsFor: 'private' stamp: 'damiencassou 4/17/2009 15:35'! getCategories: labels reject: reject lines: lines | cats | target theClass allSuperclassesDo: [ :cls | cls = Object ifFalse: [ cats := cls organization categories reject: [ :cat | reject includes: cat ]. cats isEmpty ifFalse: [ lines add: labels size. labels addAll: cats asSortedCollection. reject addAll: cats ] ] ]! ! !OBCmdCreateMethodCategory methodsFor: 'testing' stamp: 'dr 10/28/2008 15:39'! isActive ^ (requestor selectedNode isNil or: [requestor selectedNode isKindOf: OBMethodCategoryNode]) and: [super isActive]! ! !OBCmdCreateMethodCategory methodsFor: 'execution' stamp: 'dc 1/16/2008 13:39'! requestCategoryToUser "Present a choice of categories or prompt for a new category name." | labels reject lines answer newLabel | newLabel := 'new...'. labels := OrderedCollection with: newLabel. reject := Set new. reject addAll: target organization categories ; add: ClassOrganizer nullCategory ; add: ClassOrganizer default. lines := OrderedCollection new. self getCategories: labels reject: reject lines: lines. ^ (labels size = 1 or: [ answer := OBChoiceRequest prompt: 'Add Category' labels: labels values: labels lines: lines. answer ifNil: [ ^ nil ]. answer = newLabel ]) ifTrue: [ super requestCategoryToUser ] ifFalse: [ answer ]! ! OBCategoryCommand subclass: #OBCmdRemoveEmptyCats instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveEmptyCats methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:52'! execute target organization removeEmptyCategories! ! !OBCmdRemoveEmptyCats methodsFor: 'accessing' stamp: 'cwp 9/28/2006 08:52'! label ^ 'remove empty categories'! ! OBCategoryCommand subclass: #OBCmdReorgCats instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdReorgCats methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:53'! execute | definition organizer | organizer := target organization. definition := OBOrganizationDefinition on: organizer. requestor announce: definition! ! !OBCmdReorgCats methodsFor: 'accessing' stamp: 'cwp 9/28/2006 09:12'! label ^ 'reorganize categories'! ! OBCommand subclass: #OBCmdAutoCategorize instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdAutoCategorize methodsFor: 'execution' stamp: 'lr 3/4/2009 08:17'! execute "Categorize methods by looking in parent classes for a method category." | organizers organizer | organizer := target organization. organizers := organizer subject withAllSuperclasses collect: [ :ea | ea organization ]. (organizer listAtCategoryNamed: ClassOrganizer default) do: [ :sel | | found | found := (organizers collect: [ :org | org categoryOfElement: sel ]) detect: [ :ea | ea ~= ClassOrganizer default and: [ ea notNil ] ] ifNone: [ ]. found isNil ifFalse: [ organizer classify: sel under: found ] ]! ! !OBCmdAutoCategorize methodsFor: 'accessing' stamp: 'cwp 10/9/2006 15:07'! group ^ #category! ! !OBCmdAutoCategorize methodsFor: 'testing' stamp: 'lr 11/13/2008 13:44'! isActive ^ target hasOrganization and: [ target organization isClassOrganizer and: [ (requestor isSelected: target) not ] ]! ! !OBCmdAutoCategorize methodsFor: 'accessing' stamp: 'cwp 9/25/2006 00:25'! label ^ 'categorize automatically'! ! OBCommand subclass: #OBCmdBrowse instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowse methodsFor: 'execution' stamp: 'dr 9/5/2008 11:23'! execute target browse! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'cwp 10/9/2006 17:56'! group ^ #navigation! ! !OBCmdBrowse methodsFor: 'testing' stamp: 'cwp 10/9/2006 15:44'! isActive ^ (requestor isSelected: target) and: [target respondsTo: #browse] ! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'cwp 10/9/2006 15:18'! keystroke ^ $b! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'cwp 10/9/2006 15:17'! label ^ 'browse'! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'dc 8/26/2008 17:40'! longDescription ^ 'open a new browser on the current element'! ! !OBCmdBrowse methodsFor: 'testing' stamp: 'cwp 3/11/2007 19:34'! wantsButton ^ true! ! OBCommand subclass: #OBCmdBrowseHierarchy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'lr 4/25/2007 09:28'! buttonLabel ^ 'hierarchy'! ! !OBCmdBrowseHierarchy methodsFor: 'execution' stamp: 'lr 4/3/2009 13:44'! execute target browseHierarchy! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'cwp 10/11/2006 00:17'! group ^ #navigation! ! !OBCmdBrowseHierarchy methodsFor: 'testing' stamp: 'dr 7/11/2008 11:22'! isActive ^ ((target isKindOf: OBClassAwareNode) or: [(target respondsTo: #theClass) and: [target theClass notNil]]) and: [requestor isSelected: target]! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'dc. 12/15/2007 15:46'! keystroke ^ $h! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'cwp 10/11/2006 00:05'! label ^ 'browse hierarchy'! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'dc 8/26/2008 17:49'! longDescription ^ 'browse the hierarchy of the class'! ! !OBCmdBrowseHierarchy methodsFor: 'testing' stamp: 'lr 4/25/2007 09:40'! wantsButton ^ (target isKindOf: OBMethodVersionNode) not! ! OBCommand subclass: #OBCmdBrowseImplementorsOfIt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseImplementorsOfIt class methodsFor: 'as yet unclassified' stamp: 'cwp 10/16/2006 22:13'! takesNodes ^ false! ! !OBCmdBrowseImplementorsOfIt class methodsFor: 'as yet unclassified' stamp: 'cwp 10/16/2006 22:01'! takesText ^ true! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'execution' stamp: 'cwp 8/24/2007 01:34'! execute | node | node := OBSelectorNode on: target selector. (requestor announce: (OBShowImplementors of: node)) execute! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'testing' stamp: 'cwp 10/16/2006 21:32'! isActive ^ true! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'testing' stamp: 'cwp 10/16/2006 23:14'! isEnabled ^ target hasSelector! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'accessing' stamp: 'cwp 3/11/2007 19:53'! keystroke ^ $m! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'accessing' stamp: 'cwp 3/11/2007 19:52'! label ^ 'implementors'! ! OBCommand subclass: #OBCmdBrowseInheritance instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseInheritance methodsFor: 'execution' stamp: 'cwp 10/17/2006 21:28'! execute OBInheritanceBrowser openRoot: target inheritanceRoot selection: target! ! !OBCmdBrowseInheritance methodsFor: 'accessing' stamp: 'cwp 10/17/2006 21:30'! group ^ #navigation! ! !OBCmdBrowseInheritance methodsFor: 'testing' stamp: 'cwp 10/17/2006 21:15'! isActive ^ target hasSelector and: [requestor isSelected: target]! ! !OBCmdBrowseInheritance methodsFor: 'accessing' stamp: 'cwp 10/17/2006 21:31'! label ^ 'inheritance'! ! !OBCmdBrowseInheritance methodsFor: 'testing' stamp: 'lr 4/25/2007 09:40'! wantsButton ^ (target isKindOf: OBMethodVersionNode) not! ! OBCommand subclass: #OBCmdBrowseList instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! OBCmdBrowseList subclass: #OBCmdBrowseHierarchyImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseHierarchyImplementors methodsFor: 'configuration' stamp: 'dr 9/21/2007 11:22'! announcementClass ^ OBShowHierarchyImplementors! ! !OBCmdBrowseHierarchyImplementors methodsFor: 'command' stamp: 'dr 7/2/2007 14:59'! isActive ^(target isKindOf: OBMethodNode) and: [(requestor isSelected: target) "and: [target hasHierarchyImplementors]"]! ! !OBCmdBrowseHierarchyImplementors methodsFor: 'command' stamp: 'dr 4/17/2007 16:50'! label ^'hierarchy implementors'! ! OBCmdBrowseList subclass: #OBCmdBrowseHierarchySenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseHierarchySenders methodsFor: 'configuration' stamp: 'dr 9/21/2007 11:22'! announcementClass ^ OBShowHierarchySenders! ! !OBCmdBrowseHierarchySenders methodsFor: 'command' stamp: 'dr 4/19/2007 10:52'! label ^'hierarchy senders'! ! OBCmdBrowseList subclass: #OBCmdBrowseImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseImplementors methodsFor: 'configuration' stamp: 'cwp 8/20/2007 23:00'! announcementClass ^ OBShowImplementors! ! !OBCmdBrowseImplementors methodsFor: 'accessing' stamp: 'cwp 10/15/2006 21:13'! keystroke ^ $m! ! !OBCmdBrowseImplementors methodsFor: 'accessing' stamp: 'cwp 10/15/2006 21:09'! label ^ 'implementors'! ! !OBCmdBrowseImplementors methodsFor: 'accessing' stamp: 'dc 8/26/2008 17:50'! longDescription ^ 'browse implementors of...'! ! !OBCmdBrowseImplementors methodsFor: 'testing' stamp: 'lr 4/25/2007 09:40'! wantsButton ^ (target isKindOf: OBMethodVersionNode) not! ! !OBCmdBrowseList methodsFor: 'accessing' stamp: 'lr 3/4/2009 22:07'! announcementClass self subclassResponsibility! ! !OBCmdBrowseList methodsFor: 'command' stamp: 'lr 1/31/2009 14:04'! execute (requestor announce: (self announcementClass of: target messageNode unifySelectors)) execute! ! !OBCmdBrowseList methodsFor: 'command' stamp: 'dr 7/2/2007 15:12'! group ^ #navigation! ! !OBCmdBrowseList methodsFor: 'command' stamp: 'dr 7/2/2007 15:15'! isActive ^ target hasSelector and: [requestor isSelected: target]! ! OBCmdBrowseList subclass: #OBCmdBrowseSenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseSenders methodsFor: 'configuration' stamp: 'cwp 8/20/2007 23:00'! announcementClass ^ OBShowSenders! ! !OBCmdBrowseSenders methodsFor: 'command' stamp: 'cwp 10/11/2006 20:35'! keystroke ^ $n! ! !OBCmdBrowseSenders methodsFor: 'accessing' stamp: 'cwp 10/11/2006 20:32'! label ^ 'senders'! ! !OBCmdBrowseSenders methodsFor: 'accessing' stamp: 'dc 8/26/2008 17:52'! longDescription ^ 'browse senders of...'! ! !OBCmdBrowseSenders methodsFor: 'testing' stamp: 'cwp 7/7/2007 21:03'! wantsButton ^ true! ! OBCommand subclass: #OBCmdBrowseMethodVersions instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseMethodVersions methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:49'! execute OBVersionBrowser openOn: target copy! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'cwp 10/9/2006 18:09'! group ^ #navigation! ! !OBCmdBrowseMethodVersions methodsFor: 'testing' stamp: 'cwp 10/9/2006 18:16'! isActive ^ target hasVersions and: [requestor isSelected: target]! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'cwp 3/11/2007 19:53'! keystroke ^ $v! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'cwp 10/9/2006 18:12'! label ^ 'versions'! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'dc 8/26/2008 17:51'! longDescription ^ 'display the different versions of this method'! ! !OBCmdBrowseMethodVersions methodsFor: 'testing' stamp: 'lr 4/25/2007 09:40'! wantsButton ^ (target isKindOf: OBMethodVersionNode) not! ! OBCommand subclass: #OBCmdBrowseMethodsWithIt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseMethodsWithIt class methodsFor: 'as yet unclassified' stamp: 'DM 5/23/2007 16:39'! takesNodes ^ false! ! !OBCmdBrowseMethodsWithIt class methodsFor: 'as yet unclassified' stamp: 'DM 5/23/2007 16:39'! takesText ^ true! ! !OBCmdBrowseMethodsWithIt methodsFor: 'execution' stamp: 'DM 5/23/2007 20:54'! execute OBMethodStringsBrowser browseRoot: (OBSelectorNode on: target text) target: requestor browser currentNode! ! !OBCmdBrowseMethodsWithIt methodsFor: 'testing' stamp: 'DM 5/23/2007 16:32'! isActive ^ true.! ! !OBCmdBrowseMethodsWithIt methodsFor: 'accessing' stamp: 'DM 5/23/2007 20:51'! keystroke ^ $E.! ! !OBCmdBrowseMethodsWithIt methodsFor: 'accessing' stamp: 'DM 5/23/2007 16:40'! label ^ 'methods containing'! ! OBCommand subclass: #OBCmdBrowseProtocol instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseProtocol methodsFor: 'execution' stamp: 'jk 8/20/2007 12:17'! execute OBProtocolBrowser on: target copy.! ! !OBCmdBrowseProtocol methodsFor: 'accessing' stamp: 'jk 5/20/2007 00:00'! group ^ #navigation! ! !OBCmdBrowseProtocol methodsFor: 'testing' stamp: 'jk 5/20/2007 00:02'! isActive ^ (target isKindOf: OBClassAwareNode ) and: [requestor isSelected: target]! ! !OBCmdBrowseProtocol methodsFor: 'accessing' stamp: 'DM 5/20/2007 15:42'! keystroke ^ $P ! ! !OBCmdBrowseProtocol methodsFor: 'accessing' stamp: 'DM 5/20/2007 15:38'! label ^ 'browse protocol'! ! OBCommand subclass: #OBCmdBrowseReferences instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseReferences methodsFor: 'execution' stamp: 'cwp 12/7/2006 22:05'! execute OBReferencesBrowser browseRoot: target theNonMetaClass asNode! ! !OBCmdBrowseReferences methodsFor: 'accessing' stamp: 'cwp 12/7/2006 22:30'! group ^ #navigation! ! !OBCmdBrowseReferences methodsFor: 'testing' stamp: 'dc 8/2/2007 17:32'! isActive ^ (target isKindOf: OBClassAwareNode) and: [requestor isSelected: target]! ! !OBCmdBrowseReferences methodsFor: 'as yet unclassified' stamp: 'ben 8/3/2007 12:12'! keystroke ^ $N! ! !OBCmdBrowseReferences methodsFor: 'accessing' stamp: 'cwp 12/7/2006 21:43'! label ^ 'browse references'! ! OBCommand subclass: #OBCmdBrowseSendersOfIt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseSendersOfIt class methodsFor: 'as yet unclassified' stamp: 'cwp 10/15/2006 01:00'! takesNodes ^ false! ! !OBCmdBrowseSendersOfIt class methodsFor: 'as yet unclassified' stamp: 'cwp 10/15/2006 01:00'! takesText ^ true! ! !OBCmdBrowseSendersOfIt methodsFor: 'execution' stamp: 'cwp 8/24/2007 00:35'! execute | node | node := OBSelectorNode on: target selector. (requestor announce: (OBShowSenders of: node)) execute! ! !OBCmdBrowseSendersOfIt methodsFor: 'testing' stamp: 'cwp 10/14/2006 21:06'! isActive ^ true! ! !OBCmdBrowseSendersOfIt methodsFor: 'testing' stamp: 'cwp 10/15/2006 19:31'! isEnabled ^ target hasSelector! ! !OBCmdBrowseSendersOfIt methodsFor: 'accessing' stamp: 'cwp 3/11/2007 19:57'! keystroke ^ $n! ! !OBCmdBrowseSendersOfIt methodsFor: 'accessing' stamp: 'cwp 3/11/2007 19:57'! label ^ 'senders'! ! OBCommand subclass: #OBCmdChaseVariables instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdChaseVariables methodsFor: 'accessing' stamp: 'lr 4/25/2007 09:28'! buttonLabel ^ 'variables'! ! !OBCmdChaseVariables methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:49'! execute ^ OBVariablesBrowser browseRoot: target classNode! ! !OBCmdChaseVariables methodsFor: 'accessing' stamp: 'cwp 10/10/2006 22:50'! group ^ #navigation! ! !OBCmdChaseVariables methodsFor: 'testing' stamp: 'dr 7/11/2008 11:23'! isActive ^ ((target isKindOf: OBClassAwareNode) or: [(target respondsTo: #theClass) and: [target theClass notNil]]) and: [requestor isSelected: target]! ! !OBCmdChaseVariables methodsFor: 'accessing' stamp: 'cwp 10/10/2006 22:20'! label ^ 'chase variables'! ! !OBCmdChaseVariables methodsFor: 'testing' stamp: 'lr 4/25/2007 09:40'! wantsButton ^ (target isKindOf: OBMethodVersionNode) not! ! OBCommand subclass: #OBCmdClassTemplate instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdClassTemplate methodsFor: 'accessing' stamp: 'dc 7/16/2007 18:34'! currentCategory ^ target theNonMetaClass category! ! !OBCmdClassTemplate methodsFor: 'accessing' stamp: 'dc 7/16/2007 18:36'! currentClass ^ target theNonMetaClass! ! !OBCmdClassTemplate methodsFor: 'accessing' stamp: 'dc 7/16/2007 18:34'! currentEnvironment ^ target theNonMetaClass environment! ! !OBCmdClassTemplate methodsFor: 'execution' stamp: 'lr 3/4/2009 08:17'! execute | definition | definition := self templateDefinition. definition isNil ifFalse: [ requestor announce: (OBDefinitionChanged definition: definition) ]! ! !OBCmdClassTemplate methodsFor: 'testing' stamp: 'dc 7/22/2007 21:02'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target]! ! !OBCmdClassTemplate methodsFor: 'private' stamp: 'dc 7/16/2007 18:42'! templateDefinition self subclassResponsibility! ! OBCmdClassTemplate subclass: #OBCmdNewClassTemplate instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdNewClassTemplate methodsFor: 'execution' stamp: 'dc 4/23/2007 15:08'! execute | class definition | class := target theNonMetaClass. definition := (OBClassDefinition environment: class environment template: (Class template: class category)). requestor announce: (OBDefinitionChanged definition: definition)! ! !OBCmdNewClassTemplate methodsFor: 'accessing' stamp: 'dc 4/23/2007 14:29'! label ^ 'new class template'! ! !OBCmdNewClassTemplate methodsFor: 'private' stamp: 'dc 7/16/2007 18:42'! templateDefinition ^ OBClassDefinition environment: self currentEnvironment template: (Class template: self currentCategory)! ! OBCmdClassTemplate subclass: #OBCmdSubclassTemplate instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdSubclassTemplate methodsFor: 'accessing' stamp: 'cwp 12/7/2006 23:04'! label ^ 'subclass template'! ! !OBCmdSubclassTemplate methodsFor: 'private' stamp: 'dc 7/16/2007 18:42'! templateDefinition ^ OBClassDefinition environment: self currentEnvironment template: (Class templateForSubclassOf: self currentClass category: self currentCategory)! ! OBCommand subclass: #OBCmdCompareToCurrent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCompareToCurrent methodsFor: 'accessing' stamp: 'dr 12/16/2008 10:28'! buttonLabel ^ 'compare to current'! ! !OBCmdCompareToCurrent methodsFor: 'execution' stamp: 'dr 12/16/2008 11:21'! execute | defPanel s1 s2 text current change | defPanel := requestor browser definitionPanel. current := target source. change := target version source. s1 := current string. s2 := change string. s1 = s2 ifTrue: [^ self inform: 'Exact Match' translated]. text := TextDiffBuilder buildDisplayPatchFrom: s1 to: s2 inClass: target theNonMetaClass prettyDiffs: false. defPanel definition: (OBTextDefinition text: text).! ! !OBCmdCompareToCurrent methodsFor: 'testing' stamp: 'dr 12/16/2008 10:28'! isActive ^ (target isKindOf: OBMethodVersionNode) and: [requestor isSelected: target]! ! !OBCmdCompareToCurrent methodsFor: 'accessing' stamp: 'dr 12/16/2008 10:28'! keystroke ^ $c! ! !OBCmdCompareToCurrent methodsFor: 'accessing' stamp: 'dr 12/16/2008 10:29'! label ^ 'compare to current method'! ! !OBCmdCompareToCurrent methodsFor: 'accessing' stamp: 'dr 12/16/2008 10:29'! longDescription ^ 'compare current method version to current selection'! ! !OBCmdCompareToCurrent methodsFor: 'testing' stamp: 'dr 12/16/2008 10:28'! wantsButton ^ target isKindOf: OBMethodVersionNode! ! OBCommand subclass: #OBCmdCopyClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCopyClass methodsFor: 'as yet unclassified' stamp: 'PDC 6/25/2007 21:54'! copyClass: oldClass as: newName | oldDefinition newDefinition | (oldClass environment hasClassNamed: newName) ifTrue: [^ self error: newName , ' already exists']. oldDefinition := oldClass definition. newDefinition := oldDefinition copyReplaceAll: '#' , oldClass name asString with: '#' , newName asString. ^ Cursor wait showWhile: [| newClass | newClass := Compiler evaluate: newDefinition logged: true. newClass copyAllCategoriesFrom: oldClass. newClass class copyAllCategoriesFrom: oldClass class. newClass]! ! !OBCmdCopyClass methodsFor: 'execution' stamp: 'lr 3/21/2009 20:03'! execute | newName newClass | newName := OBTextRequest prompt: 'Please type new class name' template: target theNonMetaClassName asString. newName isNil ifTrue: [ ^ self ]. newClass := self copyClass: target theNonMetaClass as: newName asSymbol. self select: newClass asNode with: requestor announcer! ! !OBCmdCopyClass methodsFor: 'accessing' stamp: 'cwp 11/2/2006 22:00'! group ^ #identity! ! !OBCmdCopyClass methodsFor: 'testing' stamp: 'cwp 11/2/2006 20:43'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target] ! ! !OBCmdCopyClass methodsFor: 'accessing' stamp: 'cwp 11/2/2006 20:06'! label ^ 'copy...'! ! OBCommand subclass: #OBCmdFileOut instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdFileOut methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:50'! execute target fileOut! ! !OBCmdFileOut methodsFor: 'testing' stamp: 'cwp 10/9/2006 15:43'! isActive ^ (requestor isSelected: target) and: [target respondsTo: #fileOut]! ! !OBCmdFileOut methodsFor: 'accessing' stamp: 'dr 7/16/2008 11:13'! keystroke ^ $o! ! !OBCmdFileOut methodsFor: 'accessing' stamp: 'cwp 10/7/2006 11:19'! label ^ 'file out'! ! OBCommand subclass: #OBCmdLimitProtocol instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdLimitProtocol methodsFor: 'execution' stamp: 'DM 5/23/2007 14:49'! execute | menu | menu := (MenuMorph entitled: self menuString) defaultTarget: self. menu add: (self menuLabelForClass: target theClass) selector: #limitClass: argument: target theClass; addLine. target theClass allSuperclassesDo: [:each | menu add: (self menuLabelForClass: each) selector: #limitClass: argument: each]. menu popUpInWorld! ! !OBCmdLimitProtocol methodsFor: 'testing' stamp: 'DM 5/23/2007 18:51'! isActive ^ target theClass ~= ProtoObject and: [requestor isSelected: target]! ! !OBCmdLimitProtocol methodsFor: 'limit class' stamp: 'DM 5/22/2007 02:53'! isLimitClass: aClass ^ self limitClass = aClass.! ! !OBCmdLimitProtocol methodsFor: 'accessing' stamp: 'DM 5/23/2007 15:26'! label ^ requestor browser theClass = ProtoObject ifTrue: ['limit'] ifFalse: ['limit: ' , self limitClass name]! ! !OBCmdLimitProtocol methodsFor: 'limit class' stamp: 'DM 5/22/2007 18:41'! limitClass ^ requestor browser limitClass! ! !OBCmdLimitProtocol methodsFor: 'limit class' stamp: 'DM 5/31/2007 14:59'! limitClass: aClass requestor announce: (OBNodeChanged node: aClass); announce: (OBRefreshRequired new)! ! !OBCmdLimitProtocol methodsFor: 'private' stamp: 'DM 5/22/2007 04:03'! menuLabelForClass: aClass | content | content := (self isLimitClass: aClass) ifTrue: [aClass name asText addAttribute: TextEmphasis bold] ifFalse: [aClass name]. ^ content! ! !OBCmdLimitProtocol methodsFor: 'private' stamp: 'DM 5/21/2007 14:50'! menuString ^ 'Show only methods implemented at or above...'! ! !OBCmdLimitProtocol methodsFor: 'testing' stamp: 'DM 5/21/2007 14:23'! wantsButton ^ true! ! OBCommand subclass: #OBCmdMultiView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdMultiView methodsFor: 'accessing' stamp: 'ms 6/27/2007 11:13'! compiledMethod ^target theClass compiledMethodAt: target selector ifAbsent: [CompiledMethod new]! ! !OBCmdMultiView methodsFor: 'execution' stamp: 'lr 3/4/2009 08:17'! execute | viewType | viewType := OBChoiceRequest labels: #(#Source #Bytecode #Decompile #PrettyPrint ). viewType isNil ifFalse: [ self perform: (#toggle , viewType) asSymbol ]! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'ms 6/26/2007 16:32'! isActive ^ (target isKindOf: OBMethodNode) and: [requestor isSelected: target]! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'lr 2/17/2009 17:44'! label ^ 'view'! ! !OBCmdMultiView methodsFor: 'accessing' stamp: 'dc 8/26/2008 17:54'! longDescription ^ 'display different views of the current method'! ! !OBCmdMultiView methodsFor: 'utils' stamp: 'ms 6/27/2007 11:35'! setTextInDefinitionPanel: aTextOrString (requestor announce: OBAboutToChange) isVetoed ifFalse: [requestor announce: (OBDefinitionChanged definition: (OBReadOnlyDefinition new setText: aTextOrString; yourself))]! ! !OBCmdMultiView methodsFor: 'utils' stamp: 'ms 6/27/2007 11:20'! toggleBytecode self setTextInDefinitionPanel: self compiledMethod symbolic! ! !OBCmdMultiView methodsFor: 'utils' stamp: 'ms 6/27/2007 11:20'! toggleDecompile self setTextInDefinitionPanel: self compiledMethod decompileString! ! !OBCmdMultiView methodsFor: 'utils' stamp: 'ms 6/27/2007 14:50'! togglePrettyPrint self setTextInDefinitionPanel: (self class formatterClass format: target source in: target theClass notifying: nil contentsSymbol: nil)! ! !OBCmdMultiView methodsFor: 'utils' stamp: 'ms 6/27/2007 11:23'! toggleSource (requestor announce: OBAboutToChange) isVetoed ifFalse: [requestor announce: target definition]. ! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'ms 6/26/2007 18:09'! wantsButton ^ true! ! OBCommand subclass: #OBCmdRemoveCat instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveCat methodsFor: 'execution' stamp: 'dc 10/6/2007 11:25'! execute | list choice | list := target container organization listAtCategoryNamed: target name. list isEmpty ifTrue: [^ target remove]. choice := OBConfirmationRequest prompt: 'Are you sure you want to remove this category and all its elements?' confirm: 'Remove'. (choice notNil and: [choice]) ifTrue: [^ target remove]! ! !OBCmdRemoveCat methodsFor: 'accessing' stamp: 'dr 7/3/2008 17:20'! group ^ #general! ! !OBCmdRemoveCat methodsFor: 'accessing' stamp: 'lr 6/9/2007 09:59'! icon ^ #deleteIcon! ! !OBCmdRemoveCat methodsFor: 'testing' stamp: 'dr 10/30/2008 09:54'! isActive ^ target isCategoryNode and: [requestor isSelected: target]! ! !OBCmdRemoveCat methodsFor: 'accessing' stamp: 'cwp 9/28/2006 08:37'! keystroke ^ $x! ! !OBCmdRemoveCat methodsFor: 'accessing' stamp: 'dr 7/3/2008 17:17'! label ^ 'remove category...'! ! OBCommand subclass: #OBCmdRemoveClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveClass methodsFor: 'execution' stamp: 'PDC 6/25/2007 22:44'! execute (OBConfirmationRequest prompt: 'Are you certain that you want to REMOVE the class ' , target theNonMetaClassName , ' from the system?' confirm: 'Remove') ifFalse: [^ self]. target theNonMetaClass removeFromSystem. target signalDeletion! ! !OBCmdRemoveClass methodsFor: 'accessing' stamp: 'cwp 11/3/2006 00:15'! group ^ #identity! ! !OBCmdRemoveClass methodsFor: 'accessing' stamp: 'cwp 6/8/2007 20:37'! icon ^ #deleteIcon! ! !OBCmdRemoveClass methodsFor: 'testing' stamp: 'dr 9/30/2008 11:25'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target]! ! !OBCmdRemoveClass methodsFor: 'accessing' stamp: 'cwp 11/3/2006 00:17'! keystroke ^ $x! ! !OBCmdRemoveClass methodsFor: 'accessing' stamp: 'dr 7/3/2008 17:16'! label ^ 'remove class...'! ! OBCommand subclass: #OBCmdRemoveElement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveElement methodsFor: 'execution' stamp: 'cb 7/19/2007 14:49'! execute target removeChild: requestor selectedNode. requestor listChanged! ! !OBCmdRemoveElement methodsFor: 'testing' stamp: 'cwp 7/20/2007 22:11'! isActive ^ (target isKindOf: OBCollectionNode) and: [requestor hasSelection]! ! !OBCmdRemoveElement methodsFor: 'accessing' stamp: 'cb 7/19/2007 14:33'! label ^'remove element'! ! OBCommand subclass: #OBCmdRemoveMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveMethod methodsFor: 'private' stamp: 'cwp 12/9/2006 20:37'! browseSenders OBSendersBrowser browseRoot: target! ! !OBCmdRemoveMethod methodsFor: 'private' stamp: 'lr 3/21/2009 20:03'! doRemove | methods idxToBeRemoved method | methods := OrderedCollection new. requestor previous isNil ifFalse: [ | selectedNode | selectedNode := requestor previous selectedNode. (selectedNode isClassNode or: [ selectedNode isMethodCategoryNode ]) ifTrue: [ methods := selectedNode methods. idxToBeRemoved := methods indexOf: target ] ]. target theClass removeSelector: target selector. requestor announce: (OBNodeDeleted node: target). methods size > 1 ifFalse: [ ^ self ]. method := methods at: idxToBeRemoved + 1 ifAbsent: [ methods at: idxToBeRemoved - 1 ]. self select: method with: requestor announcer! ! !OBCmdRemoveMethod methodsFor: 'execution' stamp: 'lr 3/4/2009 08:17'! execute | senders choice | senders := SystemNavigation default allCallsOn: target selector. senders isEmpty ifTrue: [ ^ self doRemove ]. choice := OBChoiceRequest prompt: 'This message has ' , senders size asString , ' senders.' labels: #( 'Remove it' 'Remove, then browse senders' 'Don''t remove, but show me those senders' 'Forget it -- do nothing -- sorry I asked' ) values: #( #doRemove #removeAndBrowse #browseSenders nil ). choice isNil ifFalse: [ ^ self perform: choice ]! ! !OBCmdRemoveMethod methodsFor: 'accessing' stamp: 'lr 6/9/2007 09:59'! icon ^ #deleteIcon! ! !OBCmdRemoveMethod methodsFor: 'testing' stamp: 'dr 9/30/2008 11:27'! isActive ^ (target isKindOf: OBMethodNode) and: [requestor isSelected: target]! ! !OBCmdRemoveMethod methodsFor: 'accessing' stamp: 'cwp 12/8/2006 23:18'! keystroke ^ $x! ! !OBCmdRemoveMethod methodsFor: 'accessing' stamp: 'dr 7/3/2008 17:13'! label ^ 'remove method...'! ! !OBCmdRemoveMethod methodsFor: 'private' stamp: 'cwp 12/9/2006 20:37'! removeAndBrowse self browseSenders. self doRemove! ! OBCommand subclass: #OBCmdRenameCat instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameCat methodsFor: 'execution' stamp: 'lr 3/21/2009 20:03'! execute | category | category := OBTextRequest prompt: 'Please type new category name' template: target name. category isNil ifTrue: [ ^ self ]. target renameTo: category forRoot: requestor browser root. self select: (target setName: category) with: requestor announcer! ! !OBCmdRenameCat methodsFor: 'accessing' stamp: 'dr 7/3/2008 17:20'! group ^ #general! ! !OBCmdRenameCat methodsFor: 'testing' stamp: 'dr 10/30/2008 09:54'! isActive ^ target isCategoryNode and: [requestor isSelected: target]! ! !OBCmdRenameCat methodsFor: 'accessing' stamp: 'cwp 10/6/2006 21:16'! label ^ 'rename category...'! ! OBCommand subclass: #OBCmdRenameClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameClass methodsFor: 'as yet unclassified' stamp: 'cwp 11/2/2006 23:47'! browseObsoleteRefs: aClassNode as: oldName | binding | binding := aClassNode theNonMetaClass environment associationAt: aClassNode theNonMetaClass name. (SystemNavigation default allCallsOn: binding) isEmpty ifFalse: [OBReferencesBrowser browseRoot: aClassNode title: 'Obsolete references to']! ! !OBCmdRenameClass methodsFor: 'execution' stamp: 'lr 3/21/2009 20:03'! execute | newName oldName | newName := OBTextRequest prompt: 'Please type new class name' template: target theNonMetaClassName asString. newName isNil ifTrue: [ ^ self ]. oldName := target theNonMetaClass name. target theNonMetaClass environment renameClassNamed: oldName as: newName asSymbol. self browseObsoleteRefs: target as: oldName! ! !OBCmdRenameClass methodsFor: 'accessing' stamp: 'cwp 11/2/2006 23:58'! group ^ #identity! ! !OBCmdRenameClass methodsFor: 'testing' stamp: 'cwp 11/2/2006 23:01'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target]! ! !OBCmdRenameClass methodsFor: 'accessing' stamp: 'cwp 11/2/2006 22:47'! label ^ 'rename...'! ! OBCommand subclass: #OBCmdResetSearch instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdResetSearch methodsFor: 'execution' stamp: 'cb 7/19/2007 15:25'! execute "OBSearchBrowser reset. self halt." target setCollection: OrderedCollection new. requestor listChanged.! ! !OBCmdResetSearch methodsFor: 'testing' stamp: 'cwp 7/20/2007 22:11'! isActive ^ target isKindOf: OBCollectionNode! ! !OBCmdResetSearch methodsFor: 'accessing' stamp: 'cb 7/19/2007 14:47'! label ^'reset list'! ! OBCommand subclass: #OBCmdRevertMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRevertMethod methodsFor: 'accessing' stamp: 'lr 4/25/2007 09:31'! buttonLabel ^ 'revert'! ! !OBCmdRevertMethod methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:54'! execute target version fileIn! ! !OBCmdRevertMethod methodsFor: 'testing' stamp: 'cwp 10/9/2006 18:30'! isActive ^ (target isKindOf: OBMethodVersionNode) and: [requestor isSelected: target]! ! !OBCmdRevertMethod methodsFor: 'accessing' stamp: 'cwp 10/9/2006 18:26'! keystroke ^ $r! ! !OBCmdRevertMethod methodsFor: 'accessing' stamp: 'cwp 10/9/2006 18:24'! label ^ 'revert to version'! ! !OBCmdRevertMethod methodsFor: 'accessing' stamp: 'dc 8/26/2008 17:56'! longDescription ^ 'reverts the method to the current selection'! ! !OBCmdRevertMethod methodsFor: 'testing' stamp: 'lr 4/25/2007 09:38'! wantsButton ^ target isKindOf: OBMethodVersionNode! ! OBCommand subclass: #OBCmdSearchingClasses instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! OBCmdSearchingClasses subclass: #OBCmdFindClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdFindClass methodsFor: 'private' stamp: 'lr 8/3/2007 11:53'! allBehaviorsIn: anEnvironment ^ anEnvironment classNames asArray! ! !OBCmdFindClass methodsFor: 'private' stamp: 'cwp 7/20/2007 21:51'! candidateClassesIn: anEnvironment pattern: pattern | matching | matching := (self allBehaviorsIn: anEnvironment) select: (self selectorBlockFor: pattern). ^ matching isEmpty ifTrue: [nil] ifFalse: [matching]! ! !OBCmdFindClass methodsFor: 'private' stamp: 'lr 3/4/2009 08:17'! findClassIn: anEnvironment pattern: pattern | classNames className | classNames := (self candidateClassesIn: anEnvironment pattern: pattern) ifNil: [ ^ nil ]. className := classNames size = 1 ifTrue: [ classNames first ] ifFalse: [ self userSelectionOf: classNames for: (pattern copyWithout: $.) asLowercase ]. ^ className isNil ifFalse: [ anEnvironment at: className asSymbol ]! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'cwp 10/9/2006 13:39'! keystroke ^ $f! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'cwp 10/9/2006 13:34'! label ^ 'find class...'! ! !OBCmdFindClass methodsFor: 'private' stamp: 'dc 7/22/2007 21:11'! requestClassToUser | pattern | pattern := OBTextRequest prompt: 'Please type the name or fragment to look for' template: ''. pattern ifNil: [^nil]. ^ self findClassIn: target environment pattern: pattern.! ! !OBCmdFindClass methodsFor: 'private' stamp: 'PDC 6/28/2007 06:50'! selectorBlockFor: pattern | toMatch | toMatch := (pattern copyWithout: $.) asLowercase. ^ (pattern endsWith: '.') ifTrue: [[:ea | ea asLowercase = toMatch]] ifFalse: [[:ea | ea includesSubstring: toMatch caseSensitive: false]]! ! !OBCmdFindClass methodsFor: 'private' stamp: 'lr 3/4/2009 08:20'! userSelectionOf: classNames for: toMatch | exactMatch | exactMatch := classNames detect: [ :ea | ea asLowercase = toMatch ] ifNone: [ nil ]. ^ exactMatch isNil ifTrue: [ OBChoiceRequest labels: classNames lines: #() ] ifFalse: [ OBChoiceRequest labels: (classNames copyWithFirst: exactMatch) lines: #(1 ) ]! ! !OBCmdSearchingClasses methodsFor: 'execution' stamp: 'lr 3/4/2009 08:17'! execute | class | class := self requestClassToUser. class isNil ifFalse: [ self select: class asNode with: requestor announcer ]! ! !OBCmdSearchingClasses methodsFor: 'accessing' stamp: 'dc 7/16/2007 15:04'! group ^ #class! ! !OBCmdSearchingClasses methodsFor: 'accessing' stamp: 'dc 7/16/2007 15:04'! icon ^ #findIcon! ! !OBCmdSearchingClasses methodsFor: 'testing' stamp: 'dc 7/16/2007 15:04'! isActive ^ target isEnvironment! ! !OBCmdSearchingClasses methodsFor: 'private' stamp: 'dc 7/16/2007 15:03'! requestClassToUser "Ask the user for the class he wants to visit. Returns a class or nil." self subclassResponsibility ! ! OBCommand subclass: #OBCmdSelectMethodCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdSelectMethodCategory methodsFor: 'execution' stamp: 'cb 4/15/2008 22:24'! execute (requestor parent isKindOf: OBAllMethodCategoryNode) ifTrue: [self select: (OBMethodCategoryNode on: (target theClass organization categoryOfElement: target selector) inClass: target theClass) with: requestor announcer ] ifFalse: [self select: (OBAllMethodCategoryNode on: target theClass) with: requestor announcer ]. self select: target with: requestor announcer! ! !OBCmdSelectMethodCategory methodsFor: 'testing' stamp: 'dc. 12/15/2007 15:18'! isActive ^ (target isKindOf: OBMethodNode) and: [requestor isSelected: target]! ! !OBCmdSelectMethodCategory methodsFor: 'accessing' stamp: 'dc. 12/15/2007 15:36'! keystroke ^ $C! ! !OBCmdSelectMethodCategory methodsFor: 'accessing' stamp: 'lr 2/17/2009 17:47'! label ^ 'toggle all/category'! ! !Morph class methodsFor: '*ob-standard' stamp: 'lr 3/28/2009 16:02'! browserIcon ^ #morph! ! OBCodeBrowser initialize! OBSearchBrowser initialize! OBSystemBrowser initialize! OBSystemBrowserAdaptor initialize! OBMercuryPanel initialize!