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'! OBTextPanel subclass: #OBAnnotationPanel instanceVariableNames: 'text process' 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: 'accessing' stamp: 'lr 8/15/2010 17:53'! process ^ process! ! !OBAnnotationPanel methodsFor: 'callbacks' stamp: 'lr 5/2/2007 17:20'! selection ^ 1 to: 0! ! !OBAnnotationPanel methodsFor: 'updating' stamp: 'lr 8/16/2010 11:10'! selectionChanged: anAnnouncement process isNil ifFalse: [ process terminate ]. process := nil. anAnnouncement node isNil ifTrue: [ ^ self text: String new ]. process := [ self text: anAnnouncement node annotationString ] forkAt: Processor userBackgroundPriority! ! !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: 'updating' stamp: 'lr 8/15/2010 17:41'! text: aString text := aString. self changed: #text! ! !OBAnnotationPanel methodsFor: 'building' stamp: 'lr 5/2/2007 17:19'! vResizing ^ #rigid! ! OBTextPanel subclass: #OBMercuryPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Panels'! !OBMercuryPanel methodsFor: 'callbacks' stamp: 'lr 3/13/2010 13:13'! accept: aText notifying: anObject OBMercuryQuery find: aText asString withBlanksTrimmed 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 10/8/2010 08:44'! 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 ]. OBSystemBrowser openOnClass: entry. ^ true! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 3/4/2009 22:14'! environment ^ Smalltalk! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 7/6/2010 22:46'! implementorsOfIt: aSelector | node | node := OBSelectorNode on: aSelector. (self announce: (OBShowImplementors of: node)) execute. ^ true! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 7/6/2010 22:46'! methodStringsContainingIt: aString OBMethodStringsBrowser browseRoot: (OBSelectorNode on: aString). ^ true! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 7/6/2010 22:37'! referencesToIt: aClassName | class | class := self environment at: aClassName ifAbsent: [ nil ]. class isBehavior ifFalse: [ ^ self sendersOfIt: aClassName ]. OBReferencesBrowser browseRoot: (OBClassNode on: class). ^ true! ! !OBTextPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 7/6/2010 22:46'! sendersOfIt: aSelector | node | node := OBSelectorNode on: aSelector. (self announce: (OBShowSenders of: node)) execute. ^ true! ! !Morph class methodsFor: '*ob-standard' stamp: 'lr 3/28/2009 16:02'! browserIcon ^ #morph! ! !SystemOrganizer methodsFor: '*ob-standard-testing' stamp: 'cwp 9/18/2004 23:58'! isClassOrganizer ^ false! ! !TraitDescription methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:26'! asCommentNode ^ OBClassCommentNode on: self baseTrait! ! !TraitDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 16:11'! browserIcon ^ #blank! ! !TraitDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 16:12'! browserIcon: aClassDescription selector: aSelector ^ #blank! ! !UndefinedObject methodsFor: '*OB-Standard-testing' stamp: 'PDC 6/29/2007 06:02'! isClassBrowser ^false! ! !ClassOrganizer methodsFor: '*ob-standard-testing' stamp: 'cwp 9/18/2004 23:59'! isClassOrganizer ^ true! ! !String class methodsFor: '*ob-standard' stamp: 'lr 3/29/2009 14:20'! browserIcon ^ #string! ! !Collection class methodsFor: '*ob-standard' stamp: 'lr 3/28/2009 15:54'! browserIcon ^ #collection! ! !AnnouncementSet class methodsFor: '*ob-standard' stamp: 'lr 5/29/2010 08:17'! browserIcon ^ #announcement! ! !Magnitude class methodsFor: '*ob-standard' stamp: 'lr 7/10/2009 11:19'! browserIcon ^ #magnitude! ! !OBAnnouncement class methodsFor: '*ob-standard' stamp: 'lr 7/10/2009 11:17'! browserIcon ^ #announcement! ! OBAnnouncement subclass: #OBNavigate instanceVariableNames: 'bid action fan label' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBNavigate class methodsFor: 'instance creation' stamp: 'dr 9/17/2008 14:02'! of: aNode ^ self new setRoot: aNode! ! !OBNavigate class methodsFor: 'instance creation' stamp: 'dr 2/10/2009 16:25'! of: aNode label: aString ^(self of: aNode) label: aString; yourself! ! !OBNavigate methodsFor: 'execution' 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: 'configuration' 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: 'configuration' stamp: 'dr 10/1/2007 16:28'! defaultMetaNode ^self browserClass defaultMetaNode! ! !OBNavigate methodsFor: 'execution' 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: 'accessing' stamp: 'dr 9/21/2007 11:20'! browserClass ^ OBHierarchyImplementorsBrowser! ! !OBShowHierarchyImplementors methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:41'! noChildrenMessage ^ 'No hierarchy implementors'! ! OBNavigate subclass: #OBShowHierarchySenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowHierarchySenders methodsFor: 'accessing' stamp: 'dr 9/21/2007 11:16'! browserClass ^ OBHierarchySendersBrowser! ! !OBShowHierarchySenders methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:41'! noChildrenMessage ^ 'No hierarchy senders'! ! OBNavigate subclass: #OBShowImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowImplementors methodsFor: 'accessing' stamp: 'cwp 8/26/2007 00:34'! browserClass ^ OBImplementorsBrowser! ! !OBShowImplementors methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:41'! noChildrenMessage ^ 'No implementors'! ! OBNavigate subclass: #OBShowSenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowSenders methodsFor: 'accessing' stamp: 'cwp 8/26/2007 00:33'! browserClass ^ OBSendersBrowser! ! !OBShowSenders methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:42'! noChildrenMessage ^ 'No senders'! ! !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! ! !Text class methodsFor: '*ob-standard' stamp: 'lr 5/29/2010 08:19'! browserIcon ^ #string! ! 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 1/3/2010 16:11'! icon: aSymbol forNode: aNode ^ aNode theNonMetaClass browserIcon! ! 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 11/17/2010 16:04'! nodesFrom: nodes forNode: parent "Sort nodes according to their position in the class hierarchy" | classes supersChain | self initializeResults. classes := nodes collect: [ :classNode | classNode theClass ]. classes isEmpty ifTrue: [ ^ nodes ]. classes := classes size < 10 ifTrue: [ classes asArray ] ifFalse: [ classes asSet ]. nodes do: [ :classNode | supersChain := classNode theClass withAllSuperclasses reversed. supersChain removeAllSuchThat: [ :class | (classes includes: class) not ]. order add: supersChain contents -> classNode ]. self buildIndentIndex. ^ self collectSortedNodes! ! OBFilter subclass: #OBMethodIconFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Filters'! !OBMethodIconFilter methodsFor: 'filtering' stamp: 'lr 8/1/2010 15:32'! clickIconColumn: aColumn forNode: aNode | filter implementors choice index | aColumn browser isClassBrowser ifFalse: [ ^ false ]. 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! ! !OBMethodIconFilter methodsFor: 'filtering' stamp: 'lr 1/3/2010 16:12'! icon: aSymbol forNode: aNode ^ aNode theNonMetaClass browserIcon: aNode theClass selector: aNode selector! ! !Announcement class methodsFor: '*ob-standard' stamp: 'lr 5/29/2010 08:17'! browserIcon ^ #announcement! ! 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: '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: 'accessing' stamp: 'lr 3/13/2010 11:53'! annotationString ^ 'Class definition for ' , self theClassName! ! !OBClassAwareNode methodsFor: 'actions' stamp: 'lr 10/8/2010 08:44'! browse OBSystemBrowser openOnClass: self theNonMetaClass! ! !OBClassAwareNode methodsFor: 'actions' stamp: 'lr 9/23/2010 11:35'! browseHierarchy OBHierarchyBrowser openOnClass: self theClass! ! !OBClassAwareNode methodsFor: 'nodes' stamp: 'dvf 8/31/2005 13:11'! classNode ^self theClass asNode! ! !OBClassAwareNode methodsFor: 'actions' stamp: 'lr 6/12/2010 15:20'! focusHierarchy: aColumn self theClass isTrait ifTrue: [ ^ self ]. aColumn parent setClass: self copy. aColumn browser signalRefresh! ! !OBClassAwareNode methodsFor: 'testing' stamp: 'lr 3/13/2010 12:09'! isBrowsable ^ true! ! !OBClassAwareNode methodsFor: 'ancestry' stamp: ''! isDescendantOfClass: aClassNode ^ self theClassName = aClassNode theClassName! ! !OBClassAwareNode methodsFor: 'ancestry' stamp: 'lr 8/29/2010 11:41'! isDescendantOfClassCat: aClassCategoryNode ^ self theNonMetaClass category = aClassCategoryNode name! ! !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 methodsFor: 'displaying' stamp: 'lr 8/19/2009 22:24'! title ^ self theNonMetaClassName! ! 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: 'instance creation' 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: 'comparing' stamp: 'lr 2/7/2010 11:22'! hash ^ self theClass hash! ! !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: 'comparing' 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: 'navigating' stamp: 'cwp 12/12/2004 23:31'! classHierarchy ^ self nodeHierarchyWithClass: OBClassNode! ! !OBClassNode methodsFor: 'navigating' stamp: 'lr 11/7/2009 17:47'! classVariables ^ self theNonMetaClass 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: 'comparing' 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: 'lr 10/8/2010 08:44'! browse OBSystemBrowser 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: 'instance creation' stamp: ''! on: className ^ self on: '-- all --' inClass: className! ! !OBAllMethodCategoryNode methodsFor: 'accessing' stamp: ''! category ^ 'as yet unclassified'! ! !OBAllMethodCategoryNode methodsFor: 'accessing' stamp: 'lr 4/23/2010 08:34'! methodReferences ^ self theClass selectors asArray sort collect: [ :each | MethodReference class: self theClass selector: each ]! ! !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: 'lr 10/8/2010 08:44'! browse OBSystemBrowser openOnClass: self theClass category: self name! ! !OBMethodCategoryNode methodsFor: 'actions' stamp: 'lr 9/23/2010 11:38'! browseHierarchy OBHierarchyBrowser openOnClass: self theClass category: self 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: 'lr 11/25/2010 23:49'! remove self theClass removeCategory: name! ! !OBMethodCategoryNode methodsFor: 'actions' stamp: 'cwp 6/11/2009 16:59'! renameTo: aString 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: 'instance creation' 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: '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: 'initializing' stamp: ''! setMessage: aSelector selector: aSelector2 class: aClass message := aSelector. selector := aSelector2. self theClass: aClass! ! !OBMessageNode methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:00'! 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: 'lr 3/13/2010 11:50'! annotationString ^ (OBAnnotationRequest onClass: self theClass selector: self selector) getAnnotations! ! !OBMethodNode methodsFor: 'actions' stamp: 'lr 10/8/2010 08:44'! browse OBSystemBrowser openOnClass: self theClass selector: self selector! ! !OBMethodNode methodsFor: 'actions' stamp: 'lr 9/23/2010 11:39'! browseHierarchy OBHierarchyBrowser openOnClass: self theClass selector: self 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: 'lr 7/3/2009 21:59'! displayString ^ (self theClass includesLocalSelector: selector) ifTrue: [ super displayString ] ifFalse: [ super displayString asText addAttribute: TextEmphasis italic ]! ! !OBMethodNode methodsFor: 'drag and drop' stamp: 'lr 5/28/2010 13:54'! dropOnClass: aNode aNode theClass compile: self source classified: (self theClass organization categoryOfElement: self selector). (Sensor shiftPressed or: [ self theClass = aNode theClass ]) ifFalse: [ self theClass removeSelector: self selector ]. aNode signalChildrenChanged. ^ true! ! !OBMethodNode methodsFor: 'drag and drop' stamp: 'lr 5/28/2010 14:00'! dropOnMethodCategory: aNode aNode theClass = self theClass ifTrue: [ self theClass organization classify: self selector under: aNode category suppressIfDefault: false ] ifFalse: [ aNode theClass compile: self source classified: aNode category. Sensor shiftPressed ifFalse: [ self theClass removeSelector: self selector ] ]. 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: 'cwp 6/11/2009 15:25'! fullNameWithProtocol ^ self fullName , ' {' , self category , '}'! ! !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: 'lr 3/27/2010 20:02'! hierarchyImplementorsOf: aSelector | classCollection addBlock | classCollection := SortedCollection new. addBlock := [ :class | (class includesSelector: aSelector) ifTrue: [ classCollection add: (MethodReference new setStandardClass: class methodSymbol: aSelector) ] ]. self theClass allSuperclassesDo: addBlock. addBlock value: self theClass. self theClass allSubclassesDo: addBlock. ^ classCollection collect: [ :ref | ref asNode ]! ! !OBMethodNode methodsFor: 'navigating' stamp: 'dr 7/2/2007 17:10'! hierarchySenders ^self hierarchySendersOf: selector! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 4/23/2010 08:35'! hierarchySendersOf: aSelector | hierarchySenders | hierarchySenders := (SystemNavigation default allCallsOn: aSelector) select: [:ea | (self theClass withAllSuperclasses includes: ea actualClass) or: [ self theClass allSubclasses includes: ea actualClass]]. ^hierarchySenders asArray sort 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: 'lr 4/23/2010 08:36'! implementorsOf: aSelector ^ (SystemNavigation default allImplementorsOf: aSelector) asArray sort 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: 'navigating' stamp: 'lr 8/2/2010 15:59'! messageNode ^ OBMessageNode fromMethodNode: self! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 4/23/2010 08:35'! messageSelectors ^ ((self theClass compiledMethodAt: self selector ifAbsent: [^ #()]) messages) asArray sort! ! !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: '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: '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: 'accessing' stamp: 'cwp 12/1/2004 00:37'! selection ^ 1 to: 0! ! !OBMethodNode methodsFor: 'accessing' stamp: ''! selector ^ selector! ! !OBMethodNode methodsFor: 'navigating' stamp: 'lr 8/2/2010 15:59'! selectorAndMessages ^ self messages copyWithFirst: self messageNode! ! !OBMethodNode methodsFor: 'navigating' stamp: ''! senders ^ self sendersOf: selector! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 4/23/2010 08:35'! sendersOf: aSelector ^ (SystemNavigation default allCallsOn: aSelector) asArray sort 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: 'lr 3/12/2010 10:23'! versions ^ (OBMethodVersion scan: self sourceFiles from: self sourcePointer) collect: [ :each | OBMethodVersionNode on: each inClass: self theClass ]! ! !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 class methodsFor: 'instance creation' stamp: 'lr 3/12/2010 10:24'! on: aMethodVersion inClass: aClass ^ self new setVersion: aMethodVersion; theClass: aClass; yourself! ! !OBMethodVersionNode methodsFor: 'actions' stamp: 'lr 10/8/2010 08:44'! browse OBSystemBrowser 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: 'lr 7/3/2009 21:42'! accessors | literal | literal := self theClass bindingOf: 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: ''! 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: 'lr 10/8/2010 08:44'! browse OBSystemBrowser 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: 'lr 4/7/2010 18:48'! dropOnClassCategory: aClassCategory | categories index | categories := environment organization categories copyWithout: self name. index := categories indexOf: aClassCategory name ifAbsent: [ ^ false ]. categories := (categories copyFrom: 1 to: index) , (Array with: self name) , (categories copyFrom: index + 1 to: categories size). environment organization categories: categories. self signalSelection. ^ true! ! !OBClassCategoryNode methodsFor: 'drag and drop' stamp: ''! dropSelector ^ #dropOnClassCategory:! ! !OBClassCategoryNode methodsFor: 'services' stamp: ''! fileOut environment organization fileOutCategory: name.! ! !OBClassCategoryNode methodsFor: 'testing' stamp: 'lr 3/13/2010 12:10'! isBrowsable ^ true! ! !OBClassCategoryNode methodsFor: 'testing' stamp: 'dr 10/30/2008 09:54'! isCategoryNode ^ true! ! !OBClassCategoryNode methodsFor: 'ancestry' stamp: ''! isDescendantOfClassCat: other ^ other name = name! ! !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: 'lr 11/25/2010 23:49'! remove environment organization removeSystemCategory: name! ! !OBClassCategoryNode methodsFor: 'actions' stamp: 'cwp 6/11/2009 16:59'! renameTo: aString 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: 'instance creation' stamp: 'PDC 6/26/2007 21:40'! on: anObject self subclassResponsibility ! ! !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 methodsFor: 'testing' stamp: 'cwp 8/20/2009 22:39'! isCategoryNode ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 8/21/2009 11:23'! isClassNode ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 8/21/2009 11:23'! isEnvironmentNode ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 8/22/2009 11:17'! isMethodCategoryNode ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 8/22/2009 11:18'! isMethodNode ^ false! ! !OBCodeNode methodsFor: 'utility' stamp: 'lr 10/27/2010 20:58'! referenceForMethod: selector ofClass: className | classIsMeta symbol | classIsMeta := className endsWith: ' class'. symbol := classIsMeta ifTrue: [ (className allButLast: 6) asSymbol ] ifFalse: [ className ]. ^ MethodReference new setClassSymbol: symbol classIsMeta: classIsMeta methodSymbol: selector stringVersion: symbol , '>>' , selector! ! 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: 'instance creation' stamp: ''! forImage ^ self on: Smalltalk! ! !OBEnvironmentNode class methodsFor: 'instance creation' 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 8/21/2009 11:23'! isEnvironmentNode ^ 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: 'cwp 6/11/2009 12:45'! classSatisfiesQuery: aClass | classQueried | classQueried := aClass name. 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: 'private' stamp: 'cwp 4/15/2007 20:40'! classSatisfiesQuery: aClass ^ aClass includesSelector: query! ! !OBImplementorSearchNode methodsFor: 'navigation' 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: 'private' stamp: 'dr 10/22/2008 09:54'! classSatisfiesQuery: aClass ^ aClass selectors anySatisfy: [:ea | ea includesSubstring: query caseSensitive: true]! ! !OBMethodSearchNode methodsFor: 'navigation' 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: 'instance creation' 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: 'private' stamp: 'cwp 4/15/2007 21:27'! classSatisfiesQuery: aClass ^ (SystemNavigation default allCallsOn: query from: aClass) isEmpty not! ! !OBSenderSearchNode methodsFor: 'navigation' 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: 'lr 4/23/2010 08:35'! implementors ^ (SystemNavigation default allImplementorsOf: self selector) asArray sort collect: [:ref | OBMethodNode on: ref]! ! !OBSelectorNode methodsFor: 'ancestry' stamp: 'lr 2/7/2010 10:50'! isAncestorOf: aNode ^ (aNode source findString: selector string startingAt: 0 ) isZero not! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'lr 7/6/2010 22:13'! methods methods ifNil: [ methods := SystemNavigation default selectAllMethods: [ :method | method hasLiteralSuchThat: [ :literal | literal isString and: [ literal isSymbol not and: [ literal includesSubstring: selector string caseSensitive: false ] ] ] ] ]. ^ methods collect: [ :method | OBMethodNode on: method ]! ! !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: 'lr 8/2/2010 16:23'! selectorAndMessages ^ Array with: self! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'lr 4/23/2010 08:35'! senders ^ (SystemNavigation default allCallsOn: self selector) asArray sort collect: [:ref | OBMessageNode on: self selector inMethodReference: ref]! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'lr 8/2/2010 16:25'! unifySelectors! ! !OBNode methodsFor: '*ob-standard' stamp: 'lr 3/13/2010 11:56'! annotationString "Provide a line of content for an annotation pane, representing information about the method associated with the selected node." ^ nil! ! !OBNode methodsFor: '*ob-standard' stamp: 'lr 3/13/2010 12:08'! isBrowsable ^ 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! ! !MethodReference methodsFor: '*OB-Standard' stamp: 'lr 2/12/2009 10:40'! asNode ^ OBMethodNode on: self! ! OBDefinition subclass: #OBClassCommentDefinition instanceVariableNames: 'theClass' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBClassCommentDefinition class methodsFor: 'instance creation' 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: 'lr 5/29/2010 08:51'! setClass: aClass theClass := aClass theNonMetaClass! ! !OBClassCommentDefinition methodsFor: 'accessing' stamp: 'lr 5/29/2010 08:53'! template ^ theClass classCommentBlank! ! !OBClassCommentDefinition methodsFor: 'callbacks' stamp: 'lr 5/29/2010 08:53'! text | comment | comment := theClass organization classComment. ^ comment isEmpty ifTrue: [ self template ] ifFalse: [ comment ]! ! !OBClassCommentDefinition methodsFor: 'callbacks' stamp: 'lr 9/26/2010 18:14'! text: aText theClass comment: aText asString stamp: OBBrowserPlatform 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: 'lr 11/26/2010 00:01'! confirmRedefinition: definition | newName answer | newName := self nameOfClassDefinedBy: definition. answer := OBConfirmationRequest prompt: newName , ' is an existing class in this system. Redefining it might cause serious problems. Is this really what you want to do?' confirm: 'Redefine'. ^ answer ifNil: [false]! ! !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: 'lr 11/22/2010 22:53'! nameOfMetaclassDefinedBy: definition ^ (Scanner new scanTokens: definition) first! ! !OBClassDefinition methodsFor: 'confirmation' stamp: 'lr 11/22/2010 22:53'! selectedClass ^ environment at: (self nameOfClassDefinedBy: template) ifAbsent: [ environment at: (self nameOfMetaclassDefinedBy: template) ifAbsent: [ nil ] ]! ! !OBClassDefinition methodsFor: 'initializing' stamp: ''! setEnvironment: anEnvironment template: aText environment := anEnvironment. template := aText.! ! !OBClassDefinition methodsFor: 'class definition' stamp: 'lr 11/25/2010 23:43'! signalSelectionOf: aClass aClass asNode signalCreation! ! !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: 'lr 11/25/2010 23:39'! accept: aText notifying: aController | newSelector | newSelector := self compileMethod: aText notifying: aController. newSelector ifNil: [ ^ false ]. (self nodeFor: newSelector) signalCreation. ^ 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: 'lr 7/3/2009 21:49'! compileMethod: aText notifying: aController self compileClass: self theClass. self compileCategory: self category. self compileText: aText. ^ self compileNotifying: aController! ! !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: 'jk 8/22/2007 18:37'! compileText ^ compileText! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 18:37'! compileText: anObject compileText := anObject! ! !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: '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: 'instance creation' stamp: 'cwp 9/22/2004 21:20'! on: anOrganizer ^ self new organizer: anOrganizer! ! !OBOrganizationDefinition methodsFor: 'accessing' 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! ! !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! ! !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: 'cwp 8/22/2009 11:19'! isCategoryNode ^ false! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cwp 8/22/2009 11:18'! isEnvironmentNode ^ false! ! !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! ! !ParseNode methodsFor: '*ob-standard' stamp: 'cwp 7/18/2007 19:31'! selectorIs: aSymbol ^ false! ! !Exception class methodsFor: '*ob-standard' stamp: 'lr 3/28/2009 15:56'! browserIcon ^ #exception! ! !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! ! OBBrowser subclass: #OBCodeBrowser instanceVariableNames: 'hasChanges' classVariableNames: 'AnnotationPanelEnabled ChasingBrowsersEnabled MercuryPanelEnabled' 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 8/15/2010 15:31'! annotationPanel ^ CodeHolder showAnnotationPane 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: 'accessing' stamp: 'lr 8/15/2010 15:28'! chasingBrowsersEnabled ^ ChasingBrowsersEnabled! ! !OBCodeBrowser class methodsFor: 'accessing' stamp: 'lr 8/15/2010 15:29'! chasingBrowsersEnabled: aBoolean ChasingBrowsersEnabled := aBoolean! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'PDC 6/27/2007 23:02'! defaultRootNode ^nil! ! !OBCodeBrowser class methodsFor: 'initialization' stamp: 'lr 8/15/2010 15:31'! initialize self mercuryPanelEnabled: false. self chasingBrowsersEnabled: true! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:20'! mercuryPanel ^ self mercuryPanelEnabled ifTrue: [ OBMercuryPanel new ]! ! !OBCodeBrowser class methodsFor: 'accessing' stamp: 'lr 8/15/2010 15:19'! mercuryPanelEnabled ^ MercuryPanelEnabled! ! !OBCodeBrowser class methodsFor: 'accessing' stamp: 'lr 8/15/2010 15:19'! mercuryPanelEnabled: aBoolean MercuryPanelEnabled := aBoolean! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:40'! panels ^ Array with: self mercuryPanel with: self navigationPanel with: self annotationPanel with: self buttonPanel with: self definitionPanel! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:30'! settingsOn: aBuilder (aBuilder group: #OmniBrowser) parentName: #codeBrowsing; with: [ (aBuilder setting: #mercuryPanelEnabled) target: self; label: 'Mercury Panel'; description: 'Adds the mercury panel to OmniBrowser. This panel is the one on top to search senders, implementors, and references.'. (aBuilder setting: #chasingBrowsersEnabled) target: self; label: 'Chasing Browsers'; description: 'Use recursive multi-column browsers for senders, implementors, and references.' ]! ! !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: 'commands' stamp: 'lr 10/29/2010 11:40'! autoCategorizeCatCommand ^ OBCmdAutoCategorize! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseCommand ^ OBCmdBrowse! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseHierarchyCommand ^ OBCmdBrowseHierarchy! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseHierarchyImplementorsCommand ^ OBCmdBrowseHierarchyImplementors! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseHierarchySendersCommand ^ OBCmdBrowseHierarchySenders! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseImplementorsCommand ^ OBCmdBrowseImplementors! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseImplementorsOfItCommand ^ OBCmdBrowseImplementorsOfIt! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseInheritanceCommand ^ OBCmdBrowseInheritance! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseMethodVersionsCommand ^ OBCmdBrowseMethodVersions! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseReferencesCommand ^ OBCmdBrowseReferences! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseReferencesOfItCommand ^ OBCmdBrowseReferencesOfIt! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:51'! browseSendersCommand ^ OBCmdBrowseSenders! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! browseSendersOfItCommand ^ OBCmdBrowseSendersOfIt! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! chaseVariablesCommand ^ OBCmdChaseVariables! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'cwp 1/7/2005 23:47'! clearChanges hasChanges := false! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! compareToCurrentCommand ^ OBCmdCompareToCurrent! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! copyClassCommand ^ OBCmdCopyClass! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:52'! createCatCommands ^ Array with: OBCmdCreateClassCategory with: OBCmdCreateMethodCategory! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'dr 10/24/2008 18:57'! event: anEvent self noteChanges! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! fileOutCommand ^ OBCmdFileOut! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! findClassCommand ^ OBCmdFindClass! ! !OBCodeBrowser methodsFor: 'initializing' stamp: 'lr 3/13/2010 16:09'! initialize super initialize. hasChanges := false. self register! ! !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: 'commands' stamp: 'lr 10/29/2010 11:40'! multiViewCommand ^ OBCmdMultiView! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! newClassTemplateCommand ^ OBCmdNewClassTemplate! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'cwp 4/15/2007 23:07'! noteChanges hasChanges := true! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! promoteCategoriesCommand ^ OBCmdPromoteCategories! ! !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: 'commands' stamp: 'lr 10/29/2010 11:40'! removeCatCommand ^ OBCmdRemoveCat! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! removeClassCommand ^ OBCmdRemoveClass! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! removeElementCommand ^ OBCmdRemoveElement! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! removeEmptyCatsCommand ^ OBCmdRemoveEmptyCats! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! removeMethodCommand ^ OBCmdRemoveMethod! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:52'! renameCatCommands ^ Array with: OBCmdRenameClassCategory with: OBCmdRenameMethodCategory! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! renameClassCommand ^ OBCmdRenameClass! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! reorgCatsCommand ^ OBCmdReorgCats! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! revertMethodCommand ^ OBCmdRevertMethod! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! selectMethodCategoryCommand ^ OBCmdSelectMethodCategory! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'lr 3/13/2010 16:07'! stepAt: milliseconds in: aSystemWindow hasChanges ifTrue: [ self signalRefresh ]. self clearChanges! ! !OBCodeBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! subclassTemplateCommand ^ OBCmdSubclassTemplate! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'dr 10/24/2008 16:06'! unregister SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self. ! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'lr 3/13/2010 16:08'! 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 3/14/2010 09:55'! defaultMetaNode | rootClass | rootClass := OBMetaNode named: 'root'. self buildMetagraphOn: rootClass class: #classHierarchy comment: #commentHierarchy metaclass: #metaclassHierarchy. rootClass edges do: [ :each | each metaNode doubleClickSelector: #focusHierarchy: ]. ^ 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: 'instance creation' stamp: 'lr 9/23/2010 11:36'! onClass: aClass category: aSymbol ^self root: aClass asNode selection: (OBMethodCategoryNode on: aSymbol inClass: aClass)! ! !OBHierarchyBrowser class methodsFor: 'instance creation' stamp: 'lr 9/23/2010 11:39'! onClass: aClass selector: aSymbol ^self root: aClass asNode selection: (OBMethodNode on: aSymbol inClass: aClass)! ! !OBHierarchyBrowser class methodsFor: 'opening' stamp: 'cwp 12/15/2004 22:49'! openOnClass: aClass ^ (self onClass: aClass) open! ! !OBHierarchyBrowser class methodsFor: 'opening' stamp: 'lr 9/23/2010 11:36'! openOnClass: aClass category: aSymbol ^ (self onClass: aClass category: aSymbol) open! ! !OBHierarchyBrowser class methodsFor: 'opening' stamp: 'lr 9/23/2010 11:37'! openOnClass: aClass selector: aSymbol ^ (self onClass: aClass selector: aSymbol) 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: 'building' stamp: 'lr 8/15/2010 15:34'! defaultBackgroundColor ^ Color lightGreen! ! !OBHierarchyBrowser methodsFor: 'accessing' 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: 'lr 3/13/2010 12:15'! defaultMetaNode ^self implementorsMetaNode: #hierarchyImplementors! ! !OBHierarchyImplementorsBrowser class methodsFor: 'configuration' stamp: 'dr 4/17/2007 16:53'! title ^'Hierarchy Implementors of'! ! !OBImplementorsBrowser class methodsFor: 'configuration' stamp: 'lr 3/13/2010 12:15'! defaultMetaNode ^self implementorsMetaNode: #implementors.! ! !OBImplementorsBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:28'! implementorsMetaNode: aNavigationSelector | selector message implementor | selector := OBMetaNode named: 'Selector'. message := OBMetaNode named: 'Message'. implementor := OBMetaNode named: 'Implementor'. selector childAt: aNavigationSelector put: implementor; addFilter: OBClassSortFilter new. implementor displaySelector: #fullNameWithProtocol. self chasingBrowsersEnabled ifTrue: [ implementor childAt: #messages put: message. message childAt: aNavigationSelector put: implementor ]. ^ selector! ! !OBImplementorsBrowser class methodsFor: 'configuration' 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: 'instance creation' stamp: 'DM 5/23/2007 20:21'! browseRoot: aNode target: targetNode (self root: aNode selection: targetNode) open.! ! !OBMethodStringsBrowser class methodsFor: 'configuration' 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: 'accessing' stamp: 'DM 5/23/2007 20:24'! defaultLabel ^ 'Methods with literal', self selectorString, self numOfMatchesString! ! !OBMethodStringsBrowser methodsFor: 'accessing' stamp: 'DM 5/23/2007 20:26'! numOfMatchesString ^ '[' , self root methods size asString , ']'! ! !OBMethodStringsBrowser methodsFor: 'accessing' 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: 'lr 8/15/2010 15:28'! 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 chasingBrowsersEnabled 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: 'lr 3/13/2010 12:15'! defaultMetaNode ^self sendersMetaNode: #hierarchySenders. ! ! !OBHierarchySendersBrowser class methodsFor: 'configuration' stamp: 'dr 7/2/2007 16:55'! title ^'Hierarchy Senders of' ! ! !OBSendersBrowser class methodsFor: 'defaults' stamp: 'lr 3/13/2010 12:15'! defaultMetaNode ^self sendersMetaNode: #senders! ! !OBSendersBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:28'! sendersMetaNode: aNavigationSelector | selector sender | selector := OBMetaNode named: 'Selector'. sender := OBMetaNode named: 'Sender'. selector childAt: aNavigationSelector put: sender; addFilter: OBRescueFilter new. sender displaySelector: #fullNameWithProtocol; addFilter: OBRescueFilter new. self chasingBrowsersEnabled ifTrue: [ sender childAt: aNavigationSelector 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: 'instance creation' stamp: 'lr 11/7/2009 17:54'! browseRoot: aNode ^ self browseRoot: aNode label: self title , ' ' , aNode theClassName! ! !OBVariablesBrowser class methodsFor: 'configuration' stamp: 'lr 11/22/2010 10:22'! defaultMetaNode | class variable method message | class := OBMetaNode named: 'Class'. variable := OBMetaNode named: 'Variable'. method := OBMetaNode named: 'Method'. message := OBMetaNode named: 'Message'. class childAt: #instanceVariables labeled: 'Instance' put: variable; childAt: #classVariables labeled: 'Class' put: variable; addFilter: OBModalFilter new. variable childAt: #accessors put: method; addFilter: OBClassSortFilter new. method displaySelector: #fullName. self chasingBrowsersEnabled ifTrue: [ variable addFilter: OBModalFilter new. method childAt: #senders put: message; addFilter: OBModalFilter new. message displaySelector: #fullName; childAt: #senders put: message; addFilter: OBModalFilter new ]. ^ class! ! !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: #OBSearchBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBSearchBrowser class methodsFor: 'configuration' 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: 'configuration' stamp: 'cwp 4/1/2007 22:56'! defaultRootNode ^ OBCollectionNode on: IdentitySet new! ! !OBSearchBrowser class methodsFor: 'configuration' stamp: 'lr 2/17/2009 20:55'! mercuryPanel ^ OBMercuryPanel new! ! !OBSearchBrowser class methodsFor: 'configuration' stamp: 'cwp 4/16/2007 00:18'! title ^ 'Search Browser'! ! !OBSearchBrowser class methodsFor: 'instance creation' stamp: 'cwp 4/15/2007 23:20'! with: aSearchNode ^ self metaNode: self defaultMetaNode root: (OBCollectionNode on: (OrderedCollection with: aSearchNode)) selection: aSearchNode! ! !OBSearchBrowser methodsFor: 'building' stamp: 'cwp 4/1/2007 23:01'! defaultBackgroundColor ^ Color lightGreen ! ! !OBSearchBrowser methodsFor: 'testing' stamp: 'cwp 4/15/2007 22:28'! isSearchBrowser ^ true! ! !OBSearchBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! resetSearchCommand ^ OBCmdResetSearch! ! 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: '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: 'lr 3/4/2010 20:19'! 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: 'configuration' stamp: 'lr 7/4/2009 16:48'! title ^ 'System Browser'! ! !OBSystemBrowser methodsFor: 'morphic' stamp: 'lr 8/15/2010 15:35'! defaultBackgroundColor ^ Color lightGreen! ! !OBSystemBrowser methodsFor: 'testing' stamp: 'cwp 4/18/2007 23:49'! isClassBrowser ^ true! ! !OBSystemBrowser methodsFor: 'morphic' stamp: 'cwp 9/13/2009 10:41'! labelString ^ self navigationPanel labelString ifNil: [ self defaultLabel ]! ! 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 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! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'dvf 8/17/2005 17:31'! asCommentNode ^ OBClassCommentNode on: self theNonMetaClass ! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 16:11'! browserIcon "Answer an icon to be show in the browser for the receiving class." ^ #blank! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'DamienPollet 10/15/2010 14:17'! browserIcon: aClassDescription selector: aSelector "Answer an icon to be shown for the selector aSymbol in aClassDescription." aClassDescription methodDictionary at: aSelector ifPresent: [ :method | method literalsDo: [ :literal | (literal == #halt or: [ literal == #halt: or: [ literal == #haltIfNil or: [ literal == #haltIf: or: [ literal == #haltOnce or: [ literal == #haltOnce: or: [ literal == #haltOnCount: or: [ literal == #halt:onCount: ] ] ] ] ] ] ]) ifTrue: [ ^ #breakpoint ]. (literal == #flag: or: [ literal == #needsWork or: [ literal == #notYetImplemented or: [ literal == #isThisEverCalled ] ] ]) ifTrue: [ ^ #flag ] ] ]. ^ (aClassDescription isOverride: aSelector) ifTrue: [ (aClassDescription isOverridden: aSelector) ifTrue: [ #arrowUpAndDown ] ifFalse: [ #arrowUp ] ] ifFalse: [ (aClassDescription isOverridden: aSelector) ifTrue: [ #arrowDown ] ifFalse: [ #blank ] ]! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 16:00'! isOverridden: aSelector self allSubclassesDo: [ :class | (class includesSelector: aSelector) ifTrue: [ ^ true ] ]. ^ false! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 15:59'! isOverride: aSelector self allSuperclassesDo: [ :class | (class includesSelector: aSelector) ifTrue: [ ^ true ] ]. ^ false! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 3/4/2009 22:06'! package ^ PackageOrganizer default packageOfClass: self ifNone: [ nil ]! ! !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! ! 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 8/15/2010 17:13'! allChangeSets "A list of all change sets bearing the method." | changeSets | changeSets := ChangeSet allChangeSetsWithClass: class selector: selector. ^ changeSets isEmpty ifFalse: [ String streamContents: [ :aStream | changeSets size = 1 ifTrue: [ aStream nextPutAll: 'only in change set ' ] ifFalse: [ aStream nextPutAll: 'in change sets: ' ]. changeSets do: [ :aChangeSet | aStream nextPutAll: aChangeSet name; nextPutAll: ' ' ] ] ] ifTrue: [ 'in no change set' ]! ! !OBAnnotationRequest methodsFor: 'actions' stamp: 'lr 8/15/2010 17:09'! annotationRequests ^ CodeHolder annotationRequests! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:11'! documentation "Comment at beginning of the method or, if it has none, comment at the beginning of a superclass's implementation of the method." ^ class precodeCommentOrInheritedCommentFor: selector! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:10'! firstComment "The first comment in the method, if any." ^ class firstCommentAt: selector! ! !OBAnnotationRequest methodsFor: 'actions' stamp: 'lr 8/15/2010 17:10'! getAnnotations ^ String streamContents: [ :aStream | ((self annotationRequests collect: [ :request | self perform: request ]) reject: [ :stringOrNil | stringOrNil isEmptyOrNil ]) do: [ :each | aStream nextPutAll: each ] separatedBy: [ aStream nextPutAll: separator ] ]! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:13'! implementorsCount "A report of how many implementors there are of the message." | implementorsCount | implementorsCount := self systemNavigation numberOfImplementorsOf: selector. ^ implementorsCount = 1 ifTrue: [ '1 implementor' ] ifFalse: [ implementorsCount printString , ' implementors' ]! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:11'! masterComment "The comment at the beginning of the supermost implementor of the method if any." ^ class supermostPrecodeCommentFor: selector! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:15'! messageCategory "Which method category the method lies in." ^ class organization categoryOfElement: selector! ! !OBAnnotationRequest methodsFor: 'accessing' stamp: 'dc 6/18/2007 18:55'! method ^ class compiledMethodAt: selector ifAbsent: [nil]! ! !OBAnnotationRequest methodsFor: 'initialization' stamp: 'MAD 1/14/2009 11:44'! onClass: aClass selector: aSelector class := aClass. selector := aSelector. separator := ' - '.! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:15'! priorTimeStamp "The time stamp of the penultimate submission of the method, if any." | stamp | ^ (stamp := VersionsBrowser timeStampFor: selector class: class reverseOrdinal: 2) isNil ifFalse: [ 'prior time stamp: ' , stamp ]! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:14'! priorVersionsCount "A report of how many previous versions there are of the method." | 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: 'lr 8/15/2010 17:13'! recentChangeSet "The most recent change set bearing the method." ^ ChangeSet mostRecentChangeSetWithChangeForClass: class selector: selector! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:12'! sendersCount "A report of how many senders there of the message." | sendersCount | sendersCount := (self systemNavigation allCallsOn: selector) size. ^ sendersCount = 1 ifTrue: [ '1 sender' ] ifFalse: [ sendersCount printString , ' senders' ]! ! !OBAnnotationRequest methodsFor: 'accessing' stamp: 'dc 5/2/2007 18:14'! separator: aString separator := aString! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:10'! timeStamp "The time stamp of the last submission of the method." ^ self method isNil ifFalse: [ self method timeStamp ]! ! Object subclass: #OBBrowserPlatform instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBBrowserPlatform class methodsFor: 'accessing' stamp: 'lr 5/22/2010 09:38'! changeStamp Smalltalk at: #Utilities ifPresent: [ :utils | (utils respondsTo: #changeStamp) ifTrue: [ ^ utils changeStamp ] ]. ^ Author changeStamp! ! 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: ''! 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: '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: '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! ! 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 class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:37'! isValidQuery: aString ^ (aString size > 1 and: [ aString first = $* and: [ aString second ~= $* ] ]) or: [ (aString size > 1 and: [ aString first isUppercase ]) or: [ (aString allButLast indexOf: $*) > 1 ] ]! ! !OBMClassQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 40! ! !OBMClassQuery methodsFor: 'private' stamp: 'lr 4/5/2010 12:37'! find | searchNode classes | self browser isSearchBrowser ifTrue: [ ^ self openSearchBrowser ]. (isWild not and: [ pattern size = 1 and: [ (Smalltalk hasClassNamed: pattern first) ] ]) ifTrue: [ ^ self openClassBrowserOn: (Smalltalk classNamed: pattern first) asNode ]. searchNode := self searchNode. (classes := searchNode classes) size = 1 ifTrue: [ self openClassBrowserOn: classes first ] ifFalse: [ self openSearchBrowserOn: searchNode ]! ! !OBMClassQuery methodsFor: 'private' stamp: 'lr 4/5/2010 12:31'! openClassBrowserOn: aNode ^ self browser isClassBrowser ifTrue: [ self browser jumpTo: aNode ] ifFalse: [ aNode browse ]! ! !OBMClassQuery methodsFor: 'accessing' stamp: 'PDC 6/29/2007 06:17'! searchNode ^ OBClassSearchNode on: pattern! ! !OBMClassQuery methodsFor: 'initialization' 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 class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:31'! isValidQuery: aString ^ aString size > 1 and: [ aString first = $# and: [ aString second isUppercase ] ]! ! !OBMClassRefsQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 20! ! !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 class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:39'! isValidQuery: aString ^ true! ! !OBMMethodQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 50! ! !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! ! !OBMMethodQuery methodsFor: 'initialization' stamp: 'lr 6/11/2010 19:12'! setRawQuery: aString panel: aPanel super setRawQuery: (aString copyWithoutAll: Character separators) panel: aPanel! ! 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 class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:35'! isValidQuery: aString ^ aString size > 1 and: [ aString first = $# and: [ aString second isLowercase ] ]! ! !OBMMethodSendersQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 30! ! !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! ! !OBMMethodSendersQuery methodsFor: 'initialization' stamp: 'lr 6/11/2010 19:12'! setRawQuery: aString panel: aPanel super setRawQuery: (aString copyWithoutAll: Character separators) panel: aPanel! ! 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 class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:31'! isValidQuery: aString ^ aString size > 2 and: [ aString first = $' and: [ aString last = $' ] ]! ! !OBMStringQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 10! ! !OBMStringQuery methodsFor: 'executing' stamp: 'PDC 6/29/2007 05:52'! find self systemNavigation browseMethodsWithString: pattern.! ! !OBMercuryQuery class methodsFor: 'instance creation' stamp: 'lr 3/13/2010 13:19'! find: aText for: aPanel | query | query := self from: aText panel: aPanel. query isNil ifFalse: [ query find ]! ! !OBMercuryQuery class methodsFor: 'instance creation' stamp: 'lr 3/13/2010 13:42'! from: aString panel: aPanel | queryClasses | queryClasses := self allSubclasses select: [ :each | each isValidQuery: aString ]. queryClasses isEmpty ifTrue: [ ^ nil ]. queryClasses := queryClasses asSortedCollection: [ :a :b | a priority < b priority ]. ^ queryClasses first new setRawQuery: aString 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: 'configuration' stamp: 'lr 3/13/2010 13:11'! isValidQuery: aString ^ false! ! !OBMercuryQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:11'! priority ^ 0! ! !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: 'lr 8/22/2010 11:07'! setRawQuery: aString | tokens | tokens := Scanner new scanTokens: aString. pattern := tokens at: 1 ifAbsent: [ String new ]. isWild := (tokens at: 2 ifAbsent: [ nil ]) = #*! ! !OBMercuryQuery methodsFor: 'initialization' stamp: 'lr 8/22/2010 11:07'! setRawQuery: aString panel: aPanel self setRawQuery: aString. browser := aPanel browser! ! Object subclass: #OBMetagraphBuilder instanceVariableNames: 'metaNodes selectors root' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMetagraphBuilder class methodsFor: 'instance creation' 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: 'lr 4/23/2010 08:40'! execute (Pragma allNamed: #populate in: self class) do: [ :each | self perform: each selector ]. ^ self root! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'lr 8/13/2010 16:36'! metaNode: aMetaNodeName ^ self metaNodes at: aMetaNodeName ifAbsentPut: [ OBMetaNode named: aMetaNodeName ]! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'lr 8/13/2010 16:36'! 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: 'lr 4/23/2010 08:38'! populateAllMethodCategoryNode self allMethodCategoryMetaNode childAt: #methods put: self methodMetaNode! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 4/23/2010 08:38'! populateClassCommentMetaNode self classCommentMetaNode ancestrySelector: #isDescendantOfClass:; addFilter: OBClassIconFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 4/23/2010 08:39'! 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 4/23/2010 08:39'! 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: 'lr 4/23/2010 08:39'! populateMethodCategoryNode self methodCategoryMetaNode ancestrySelector: #isDescendantOfMethodCat:; childAt: #methods put: self methodMetaNode! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 4/23/2010 08:39'! populateMethodNode self methodMetaNode ancestrySelector: #isDescendantOfMethod:; addFilter: OBMethodIconFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 8/13/2010 16:37'! 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: 'lr 8/13/2010 16:36'! selectors ^ selectors ifNil: [ selectors := Dictionary new ]! ! !OBMetagraphBuilder methodsFor: 'initialization' stamp: 'lr 4/23/2010 08:39'! setRoot: rootNode classSel: classSelector commentSel: commentSelector metaclassSel: metaclassSelector self root: rootNode. self classSelector: classSelector. self commentSelector: commentSelector. self metaclassSelector: metaclassSelector! ! 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/12/2010 10:30'! fileIn self fileIn: self theClass! ! !OBMethodVersion methodsFor: 'compiling' stamp: 'lr 3/12/2010 10:31'! fileIn: aClass aClass isNil ifTrue: [ ^ self ]. aClass 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: 'configuration' stamp: 'cwp 9/28/2009 09:21'! nameForViewer ^ 'OmniBrowser'! ! !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: 'cwp 9/28/2009 01:25'! unload self unregister! ! !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! ! OBCommand subclass: #OBCategoryCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCategoryCommand methodsFor: 'accessing' stamp: 'avi 5/30/2007 23:07'! group ^ #category! ! !OBCategoryCommand methodsFor: 'testing' stamp: 'lr 11/8/2009 10:02'! isActive ^ target hasOrganization and: [ (requestor isSelected: target) not ]! ! OBCategoryCommand subclass: #OBCmdCreateCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCreateCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 21:09'! categories ^ self subclassResponsibility! ! !OBCmdCreateCategory methodsFor: 'execution' stamp: 'lr 9/25/2010 22:28'! execute | categories category | categories := self categories sorted. category := OBCompletionRequest new assisted: true; collection: categories; prompt: 'Add Category'; signal. category isNil ifTrue: [ ^ self ]. target organization addCategory: category. self select: (target categoryNodeNamed: category) with: requestor announcer! ! !OBCmdCreateCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 21:07'! icon ^ #newIcon! ! !OBCmdCreateCategory methodsFor: 'accessing' stamp: 'lr 9/25/2010 22:28'! label ^ 'Add category...'! ! OBCmdCreateCategory subclass: #OBCmdCreateClassCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCreateClassCategory methodsFor: 'accessing' stamp: 'lr 9/24/2010 08:06'! categories | categories | categories := Set new. PackageOrganizer default packages do: [ :package | categories add: package systemCategoryPrefix ]. target categories do: [ :node | categories add: node name ]. ^ categories! ! !OBCmdCreateClassCategory methodsFor: 'testing' stamp: 'lr 9/22/2010 21:18'! isActive ^ super isActive and: [ requestor selectedNode isKindOf: OBClassCategoryNode ]! ! OBCmdCreateCategory subclass: #OBCmdCreateMethodCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCreateMethodCategory methodsFor: 'accessing' stamp: 'lr 9/24/2010 08:07'! categories | categories | categories := Set new. target theClass withAllSuperclasses do: [ :class | class organization categories do: [ :each | categories add: each asLowercase ] ]. PackageOrganizer default packages do: [ :package | categories add: package methodCategoryPrefix ]. categories remove: ClassOrganizer nullCategory ifAbsent: [ ]; remove: ClassOrganizer default ifAbsent: [ ]. ^ categories! ! !OBCmdCreateMethodCategory methodsFor: 'testing' stamp: 'lr 11/8/2009 10:03'! isActive ^ super isActive and: [ requestor selectedNode isKindOf: OBMethodCategoryNode ]! ! OBCategoryCommand subclass: #OBCmdPromoteCategories instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdPromoteCategories methodsFor: 'execution' stamp: 'Alexandre Bergel 7/2/2010 10:34'! execute | definition organizer match categories matchingCategories newCategories selectedCategory template | selectedCategory := (requestor notNil and: [requestor class canUnderstand: #descriptor]) ifTrue: [ requestor descriptor asSymbol ] ifFalse: [ #Package ]. template := (selectedCategory includes: $-) ifTrue: [ selectedCategory copyUpTo: $- ] ifFalse: [ selectedCategory ]. template := template, '*'. match := OBTextRequest prompt: 'Enter a matching expression' template: template. (match isNil or: [ match isEmpty ]) ifTrue: [ ^ self ]. organizer := target organization. categories := organizer categories. matchingCategories := categories select: [:c | match match: c]. newCategories := matchingCategories, (categories copyWithoutAll: matchingCategories). target organization categories: newCategories. requestor browser announce: OBRefreshRequired! ! !OBCmdPromoteCategories methodsFor: 'testing' stamp: 'Alexandre Bergel 7/1/2010 15:58'! isActive ^ super isActive and: [ requestor selectedNode isKindOf: OBClassCategoryNode ]! ! !OBCmdPromoteCategories methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Promote categories...'! ! OBCategoryCommand subclass: #OBCmdRemoveEmptyCats instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveEmptyCats methodsFor: 'execution' stamp: 'lr 6/21/2009 17:07'! execute target organization removeEmptyCategories. requestor browser announce: OBRefreshRequired! ! !OBCmdRemoveEmptyCats methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Remove empty categories'! ! OBCategoryCommand subclass: #OBCmdRenameCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 21:18'! categories ^ self subclassResponsibility! ! !OBCmdRenameCategory methodsFor: 'execution' stamp: 'lr 9/24/2010 21:57'! execute | categories category | categories := self categories sorted. category := OBCompletionRequest new assisted: true; default: target name; collection: categories; prompt: 'Rename Category'; signal. category isNil ifTrue: [ ^ self ]. target renameTo: category. self select: (target setName: category) with: requestor announcer! ! !OBCmdRenameCategory methodsFor: 'testing' stamp: 'lr 9/22/2010 21:28'! isActive ^ requestor isSelected: target! ! !OBCmdRenameCategory methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Rename category...'! ! OBCmdRenameCategory subclass: #OBCmdRenameClassCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameClassCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 22:11'! categories ^ requestor parent categories collect: [ :each | each name ]! ! !OBCmdRenameClassCategory methodsFor: 'testing' stamp: 'lr 9/22/2010 21:29'! isActive ^ super isActive and: [ target isKindOf: OBClassCategoryNode ]! ! OBCmdRenameCategory subclass: #OBCmdRenameMethodCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameMethodCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 21:39'! categories | categories | categories := Set new. target theClass allSuperclasses do: [ :each | categories addAll: each organization categories ]. PackageOrganizer default packages do: [ :each | categories add: each methodCategoryPrefix ]. target theClass organization categories do: [ :each | categories remove: each ifAbsent: [ ] ]. categories remove: ClassOrganizer nullCategory ifAbsent: [ ]; remove: ClassOrganizer default ifAbsent: [ ]. ^ categories! ! !OBCmdRenameMethodCategory methodsFor: 'testing' stamp: 'lr 9/22/2010 21:29'! isActive ^ super isActive and: [ (target isKindOf: OBMethodCategoryNode) and: [ (target isKindOf: OBAllMethodCategoryNode) not ] ]! ! 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: 'lr 8/8/2010 10:07'! label ^ 'Reorganize categories'! ! OBCommand subclass: #OBCmdAutoCategorize instanceVariableNames: '' classVariableNames: 'CategorizationRules IgnoredCategories' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdAutoCategorize class methodsFor: 'private' stamp: 'lr 9/22/2010 09:07'! commonProtocolFor: aSelector in: aClass | protocols protocol | protocols := Bag new. self environment allClassesAndTraitsDo: [ :behavior | | class | class := aClass isMeta ifTrue: [ behavior theMetaClass ] ifFalse: [ behavior theNonMetaClass ]. (class includesSelector: aSelector) ifTrue: [ protocol := class organization categoryOfElement: aSelector. (self isValidProtocol: protocol) ifTrue: [ protocols add: protocol ] ] ]. protocols isEmpty ifTrue: [ ^ nil ]. protocol := protocols sortedCounts first. ^ protocol key >= 5 ifTrue: [ protocol value ]! ! !OBCmdAutoCategorize class methodsFor: 'initialization' stamp: 'lr 9/22/2010 10:17'! initialize IgnoredCategories := Array with: Categorizer default with: Categorizer allCategory with: Categorizer nullCategory. CategorizationRules := OrderedCollection new. CategorizationRules add: [ :class :selector | (selector beginsWith: 'add') ifTrue: [ #adding ] ]; add: [ :class :selector | (selector beginsWith: 'as') ifTrue: [ #converting ] ]; add: [ :class :selector | (selector beginsWith: 'accept') ifTrue: [ #visiting ] ]; add: [ :class :selector | (selector beginsWith: 'remove') ifTrue: [ #removing ] ]; add: [ :class :selector | (selector beginsWith: 'render') ifTrue: [ #rendering ] ]; add: [ :class :selector | (selector beginsWith: 'initialize') ifTrue: [ #initialization ] ]; add: [ :class :selector | ((selector beginsWith: 'is') or: [ selector beginsWith: 'has' ]) ifTrue: [ #testing ] ]; add: [ :class :selector | ((class includesBehavior: TestCase) and: [ selector beginsWith: 'test' ]) ifTrue: [ #tests ] ]; add: [ :class :selector | ((selector beginsWith: 'basic') or: [ (selector beginsWith: 'private') or: [ selector beginsWith: 'primitive' ] ]) ifTrue: [ #private ] ]; add: [ :class :selector | (class isMeta and: [ (selector beginsWith: 'new') or: [ (selector beginsWith: 'on') or: [ selector beginsWith: 'with' ] ] ]) ifTrue: [ #'instance creation' ] ]; add: [ :class :selector | ((selector numArgs = 0 and: [ class allInstVarNames includes: selector asString ]) or: [ selector numArgs = 1 and: [ class allInstVarNames includes: selector asString allButLast ] ]) ifTrue: [ #accessing ] ]; add: [ :class :selector | self superclassProtocolFor: selector in: class ]; add: [ :class :selector | self commonProtocolFor: selector in: class ]! ! !OBCmdAutoCategorize class methodsFor: 'testing' stamp: 'lr 9/22/2010 08:55'! isValidProtocol: aSymbol ^ aSymbol notNil and: [ (aSymbol beginsWith: '*') not and: [ (IgnoredCategories includes: aSymbol) not ] ]! ! !OBCmdAutoCategorize class methodsFor: 'private' stamp: 'lr 9/22/2010 09:08'! superclassProtocolFor: aSelector in: aClass aClass allSuperclassesDo: [ :class | | protocol | protocol := class organization categoryOfElement: aSelector. (self isValidProtocol: protocol) ifTrue: [ ^ protocol ]. class theNonMetaClass = ProtoObject ifTrue: [ ^ nil ] ]. ^ nil! ! !OBCmdAutoCategorize methodsFor: 'execution' stamp: 'lr 9/22/2010 08:52'! categorize: aSelector CategorizationRules do: [ :rule | | result | result := rule value: target theClass value: aSelector. result isNil ifFalse: [ ^ self organization classify: aSelector under: result ] ]! ! !OBCmdAutoCategorize methodsFor: 'execution' stamp: 'lr 8/17/2010 18:33'! execute (self organization listAtCategoryNamed: ClassOrganizer default) do: [ :each | self categorize: each ]! ! !OBCmdAutoCategorize methodsFor: 'accessing' stamp: 'cwp 10/9/2006 15:07'! group ^ #category! ! !OBCmdAutoCategorize methodsFor: 'testing' stamp: 'lr 9/22/2010 08:57'! isActive ^ target hasOrganization and: [ target organization isClassOrganizer and: [ (requestor isSelected: target) not ] ]! ! !OBCmdAutoCategorize methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Categorize automatically'! ! !OBCmdAutoCategorize methodsFor: 'accessing' stamp: 'lr 8/17/2010 18:33'! organization ^ target organization! ! 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: 'lr 3/13/2010 12:09'! isActive ^ (requestor isSelected: target) and: [ target isBrowsable ]! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'cwp 10/9/2006 15:18'! keystroke ^ $b! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 8/8/2010 10:14'! 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: 'lr 6/12/2010 15:13'! isActive ^ (requestor isSelected: target) and: [ (target isKindOf: OBClassAwareNode) and: [ target theClass isTrait not ] ]! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'dc. 12/15/2007 15:46'! keystroke ^ $h! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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: 'testing' stamp: 'cwp 10/16/2006 22:13'! takesNodes ^ false! ! !OBCmdBrowseImplementorsOfIt class methodsFor: 'testing' 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: 'lr 8/8/2010 10:07'! 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: 'lr 3/13/2010 17:05'! isActive ^ (requestor isSelected: target) and: [ target hasSelector ]! ! !OBCmdBrowseInheritance methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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: 'lr 8/8/2010 10:07'! 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: 'lr 8/8/2010 10:07'! 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: 'lr 8/8/2010 10:07'! 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 9/25/2010 16:04'! execute | localSymbols systemSymbols symbol node | localSymbols := target selectorAndMessages collect: [ :each | each name ]. symbol := OBCompletionRequest new default: localSymbols first; prompt: 'Choose ' , self label allButLast; searchBlock: [ :value | (systemSymbols isNil and: [ localSymbols first ~= value ]) ifTrue: [ systemSymbols := IdentitySet new. Smalltalk globals allClassesAndTraitsDo: [ :each | systemSymbols addAll: each selectors; addAll: each class selectors ]. systemSymbols := systemSymbols sorted ]. (systemSymbols isNil or: [ value isEmpty ]) ifTrue: [ localSymbols ] ifFalse: [ systemSymbols select: [ :each | OBCompletionRequest substring: value matches: each caseSensitive: false ] ] ]; signal. symbol ifNil: [ ^ self ]. node := OBMethodNode on: symbol asSymbol inClass: target theClass. (requestor announce: (self announcementClass of: node)) execute! ! !OBCmdBrowseList methodsFor: 'command' stamp: 'dr 7/2/2007 15:12'! group ^ #navigation! ! !OBCmdBrowseList methodsFor: 'command' stamp: 'lr 3/13/2010 17:05'! isActive ^ (requestor isSelected: target) and: [ target hasSelector ]! ! 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: 'lr 8/8/2010 10:07'! 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: 'lr 3/13/2010 17:05'! isActive ^ (requestor isSelected: target) and: [ target hasVersions ]! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'cwp 3/11/2007 19:53'! keystroke ^ $v! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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: #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: 'accessing' stamp: 'ben 8/3/2007 12:12'! keystroke ^ $N! ! !OBCmdBrowseReferences methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Browse references'! ! OBCommand subclass: #OBCmdBrowseReferencesOfIt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseReferencesOfIt class methodsFor: 'testing' stamp: 'lr 8/16/2010 10:44'! takesNodes ^ false! ! !OBCmdBrowseReferencesOfIt class methodsFor: 'testing' stamp: 'lr 8/16/2010 10:44'! takesText ^ true! ! !OBCmdBrowseReferencesOfIt methodsFor: 'execution' stamp: 'lr 8/16/2010 10:48'! execute OBReferencesBrowser browseRoot: self reference asNode! ! !OBCmdBrowseReferencesOfIt methodsFor: 'testing' stamp: 'lr 8/16/2010 10:44'! isActive ^ true! ! !OBCmdBrowseReferencesOfIt methodsFor: 'testing' stamp: 'lr 8/16/2010 10:46'! isEnabled ^ self reference notNil! ! !OBCmdBrowseReferencesOfIt methodsFor: 'accessing' stamp: 'lr 8/16/2010 10:44'! keystroke ^ $N! ! !OBCmdBrowseReferencesOfIt methodsFor: 'accessing' stamp: 'lr 8/16/2010 11:09'! label ^ 'References'! ! !OBCmdBrowseReferencesOfIt methodsFor: 'accessing' stamp: 'lr 8/16/2010 10:47'! reference ^ target hasSelector ifTrue: [ Smalltalk classNamed: target selector ]! ! OBCommand subclass: #OBCmdBrowseSendersOfIt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseSendersOfIt class methodsFor: 'testing' stamp: 'cwp 10/15/2006 01:00'! takesNodes ^ false! ! !OBCmdBrowseSendersOfIt class methodsFor: 'testing' 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: 'lr 8/8/2010 10:07'! label ^ 'Senders'! ! OBCommand subclass: #OBCmdChaseVariables instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdChaseVariables methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:14'! 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: 'lr 8/8/2010 10:07'! 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: 'lr 8/8/2010 10:07'! 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: 'lr 8/8/2010 10:07'! 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: 'lr 8/8/2010 10:14'! 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: 'lr 8/8/2010 10:07'! 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: 'execution' stamp: 'lr 1/28/2010 14:45'! 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. oldClass class instVarNames do: [ :each | newClass class addInstVarName: each ]. 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: 'lr 8/8/2010 10:07'! 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: 'lr 8/8/2010 10:07'! label ^ 'File out'! ! OBCommand subclass: #OBCmdFindClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdFindClass methodsFor: 'execution' stamp: 'lr 9/22/2010 13:01'! execute | class | class := self requestClassToUser. class isNil ifFalse: [ self select: class asNode with: requestor announcer ]! ! !OBCmdFindClass methodsFor: 'private' stamp: 'lr 9/25/2010 16:06'! findClassIn: anEnvironment pattern: aString ^ (anEnvironment classNames select: [ :each | OBCompletionRequest substring: aString matches: each caseSensitive: false ]) asSortedCollection collect: [ :each | anEnvironment at: each ]! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'lr 9/22/2010 13:01'! group ^ #class! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'lr 9/22/2010 13:01'! icon ^ #findIcon! ! !OBCmdFindClass methodsFor: 'testing' stamp: 'lr 9/22/2010 13:03'! isActive ^ target isEnvironmentNode! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'cwp 10/9/2006 13:39'! keystroke ^ $f! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Find class...'! ! !OBCmdFindClass methodsFor: 'private' stamp: 'lr 9/22/2010 20:12'! requestClassToUser ^ OBCompletionRequest new prompt: 'Find Class'; searchBlock: [ :string | self findClassIn: target environment pattern: string ]; labelBlock: [ :class | class name ]; iconBlock: [ :class | class browserIcon ]; signal! ! OBCommand subclass: #OBCmdFindMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdFindMethod methodsFor: 'private' stamp: 'lr 4/23/2010 08:37'! chooseSelector | selectors | selectors := target theClass selectors asArray sort. ^ selectors isEmpty ifFalse: [ OBChoiceRequest labels: selectors ]! ! !OBCmdFindMethod methodsFor: 'execution' stamp: 'dc 7/15/2007 16:31'! execute | selection method | selection := self chooseSelector. selection ifNotNil: [method := OBMethodNode on: selection inClass: target theClass. self select: method with: requestor announcer]! ! !OBCmdFindMethod methodsFor: 'accessing' stamp: 'cwp 6/8/2007 20:37'! icon ^ #findIcon! ! !OBCmdFindMethod methodsFor: 'testing' stamp: 'dr 1/9/2008 14:13'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target]! ! !OBCmdFindMethod methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Find method...'! ! OBCommand subclass: #OBCmdMultiView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdMultiView methodsFor: 'accessing' stamp: 'lr 1/28/2010 15:42'! compiledMethod ^ target theClass compiledMethodAt: target selector! ! !OBCmdMultiView methodsFor: 'accessing' stamp: 'lr 1/28/2010 15:35'! definition: aDefinition (requestor announce: OBAboutToChange) isVetoed ifFalse: [ requestor announce: (OBDefinitionChanged definition: aDefinition) ]! ! !OBCmdMultiView methodsFor: 'execution' stamp: 'lr 1/28/2010 15:41'! execute | viewType | viewType := OBChoiceRequest prompt: nil labels: #('source' 'pretty print' 'decompile' 'byte codes' ) values: #(showSource showPrettyPrint showDecompile showByteCodes). viewType isNil ifFalse: [ self perform: viewType ]! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'lr 1/28/2010 15:44'! isActive ^ (target isKindOf: OBMethodNode) and: [ requestor isSelected: target ] ! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'lr 8/8/2010 10:07'! label ^ 'View'! ! !OBCmdMultiView methodsFor: 'accessing' stamp: 'dc 8/26/2008 17:54'! longDescription ^ 'display different views of the current method'! ! !OBCmdMultiView methodsFor: 'actions' stamp: 'lr 1/28/2010 15:42'! showByteCodes self definition: (OBTextDefinition text: self compiledMethod symbolic)! ! !OBCmdMultiView methodsFor: 'actions' stamp: 'lr 1/28/2010 15:41'! showDecompile self definition: (OBMethodDefinition source: self compiledMethod decompileString inClass: target theClass)! ! !OBCmdMultiView methodsFor: 'actions' stamp: 'lr 1/28/2010 15:41'! showPrettyPrint self definition: (OBMethodDefinition source: (target theClass compilerClass format: target source in: target theClass notifying: nil) inClass: target theClass)! ! !OBCmdMultiView methodsFor: 'actions' stamp: 'lr 1/28/2010 15:41'! showSource self definition: target definition! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'lr 1/28/2010 15:42'! wantsButton ^ true! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'lr 8/8/2010 10:48'! wantsMenu ^ false! ! OBCommand subclass: #OBCmdRemoveCat instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveCat methodsFor: 'execution' stamp: 'lr 11/26/2010 00:01'! execute | list choice | list := target container organization listAtCategoryNamed: target name. list isEmpty ifTrue: [ ^ target remove; announceDeletionWith: requestor announcer ]. 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; announceDeletionWith: requestor announcer ]! ! !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: 'lr 8/8/2010 10:07'! label ^ 'Remove category...'! ! OBCommand subclass: #OBCmdRemoveClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveClass methodsFor: 'execution' stamp: 'lr 11/25/2010 23:40'! doRemove target theNonMetaClass removeFromSystem. target announceDeletionWith: requestor announcer! ! !OBCmdRemoveClass methodsFor: 'execution' stamp: 'lr 11/25/2010 23:55'! execute (OBConfirmationRequest prompt: 'Are you certain that you want to remove the class ' , target theNonMetaClassName , ' from the system?' confirm: 'Remove') ifFalse: [ ^ self ]. self doRemove! ! !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: 'lr 8/8/2010 10:07'! 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: 'lr 8/8/2010 10:07'! label ^ 'Remove element'! ! OBCommand subclass: #OBCmdRemoveMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveMethod methodsFor: 'private' stamp: 'lr 3/10/2010 11:17'! browseSenders OBSendersBrowser browseRoot: target copy! ! !OBCmdRemoveMethod methodsFor: 'private' stamp: 'lr 2/7/2010 11:23'! 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: 'lr 8/8/2010 10:07'! label ^ 'Remove method...'! ! !OBCmdRemoveMethod methodsFor: 'private' stamp: 'cwp 12/9/2006 20:37'! removeAndBrowse self browseSenders. self doRemove! ! OBCommand subclass: #OBCmdRenameClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameClass methodsFor: 'execution' 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: 'private' stamp: 'lr 11/25/2010 23:41'! doRename: oldName to: newName target theNonMetaClass environment renameClassNamed: oldName as: newName. target announceChangedWith: requestor announcer! ! !OBCmdRenameClass methodsFor: 'execution' stamp: 'lr 4/3/2010 12:30'! execute | newName oldName | newName := OBTextRequest prompt: 'Please type new class name' template: target theNonMetaClassName asString. newName isNil ifTrue: [ ^ self ]. oldName := target theNonMetaClass name. self doRename: oldName to: 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: 'lr 8/8/2010 10:07'! label ^ 'Rename...'! ! OBCommand subclass: #OBCmdResetSearch instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdResetSearch methodsFor: 'execution' stamp: 'lr 8/8/2010 10:53'! execute target setCollection: OrderedCollection new. requestor listChanged.! ! !OBCmdResetSearch methodsFor: 'testing' stamp: 'cwp 7/20/2007 22:11'! isActive ^ target isKindOf: OBCollectionNode! ! !OBCmdResetSearch methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Reset list'! ! OBCommand subclass: #OBCmdRevertMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRevertMethod methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:14'! buttonLabel ^ 'Revert'! ! !OBCmdRevertMethod methodsFor: 'execution' stamp: 'lr 3/12/2010 10:32'! execute target version fileIn: target theClass! ! !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: 'lr 8/8/2010 10:07'! 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: #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 8/8/2010 10:07'! label ^ 'Toggle all/category'! ! OBCodeBrowser initialize! OBSystemBrowserAdaptor initialize! OBCmdAutoCategorize initialize!