Smalltalk createPackage: 'Helios-References'! HLWidget subclass: #HLReferences slots: {#model. #sendersListWidget. #implementorsListWidget. #classReferencesListWidget. #regexpListWidget. #sourceCodeWidget} package: 'Helios-References'! !HLReferences methodsFor: 'accessing'! classReferencesListWidget ^ classReferencesListWidget ifNil: [ classReferencesListWidget := HLClassReferencesListWidget on: self model. classReferencesListWidget next: self regexpListWidget ] ! implementorsListWidget ^ implementorsListWidget ifNil: [ implementorsListWidget := HLImplementorsListWidget on: self model. implementorsListWidget next: self classReferencesListWidget ] ! model ^ model ifNil: [ model := (HLReferencesModel new environment: self manager environment; yourself) ] ! model: aModel model := aModel ! regexpListWidget ^ regexpListWidget ifNil: [ regexpListWidget := HLRegexpListWidget on: self model. regexpListWidget next: self sourceCodeWidget ] ! sendersListWidget ^ sendersListWidget ifNil: [ sendersListWidget := HLSendersListWidget on: self model. sendersListWidget next: self implementorsListWidget ] ! sourceCodeWidget ^ sourceCodeWidget ifNil: [ sourceCodeWidget := HLBrowserCodeWidget new browserModel: self model; yourself ] ! ! !HLReferences methodsFor: 'actions'! registerBindingsOn: aBindingGroup HLToolCommand registerConcreteClassesOn: aBindingGroup for: self model ! search: aString self model search: aString. self setTabLabel: aString ! ! !HLReferences methodsFor: 'rendering'! renderContentOn: html html with: (HLContainer with: (HLHorizontalSplitter with: (HLVerticalSplitter with: (HLVerticalSplitter with: self sendersListWidget with: self implementorsListWidget) with: (HLVerticalSplitter with: self classReferencesListWidget with: self regexpListWidget)) with: self sourceCodeWidget)). self sendersListWidget focus ! ! !HLReferences class methodsFor: 'accessing'! tabClass ^ 'references' ! tabLabel ^ 'References' ! tabPriority ^ 100 ! ! !HLReferences class methodsFor: 'testing'! canBeOpenAsTab ^ false ! ! HLToolListWidget subclass: #HLReferencesListWidget slots: {} package: 'Helios-References'! !HLReferencesListWidget methodsFor: 'accessing'! commandCategory ^ 'Methods' ! label ^ 'List' ! ! !HLReferencesListWidget methodsFor: 'actions'! activateListItem: anItem self model withChangesDo: [ super activateListItem: anItem ] ! observeModel self model announcer on: HLSearchReferences do: [ :ann | self onSearchReferences: ann searchString ]; on: HLMethodSelected do: [ :ann | self onMethodSelected: ann item ] ! reselectItem: aMethod self selectItem: aMethod ! selectItem: aMethod super selectItem: aMethod. self model selectedClass: nil; selectedMethod: aMethod ! ! !HLReferencesListWidget methodsFor: 'reactions'! onMethodSelected: aMethod aMethod ifNil: [ ^ self ]. (self items includes: aMethod) ifFalse: [ ^ self ]. self selectedItem: aMethod; activateItem: aMethod ! onSearchReferences: aString self subclassResponsibility ! ! !HLReferencesListWidget methodsFor: 'rendering'! renderItemLabel: aMethod on: html html with: aMethod asString ! ! !HLReferencesListWidget class methodsFor: 'instance creation'! on: aModel ^ self new model: aModel; yourself ! ! HLReferencesListWidget subclass: #HLClassReferencesListWidget slots: {} package: 'Helios-References'! !HLClassReferencesListWidget methodsFor: 'accessing'! label ^ 'Class references' ! ! !HLClassReferencesListWidget methodsFor: 'reactions'! onSearchReferences: aString self selectItem: nil. self items: (self model classReferencesOf: aString). self refresh ! ! HLReferencesListWidget subclass: #HLImplementorsListWidget slots: {} package: 'Helios-References'! !HLImplementorsListWidget methodsFor: 'accessing'! label ^ 'Implementors' ! ! !HLImplementorsListWidget methodsFor: 'reactions'! onSearchReferences: aString self selectItem: nil. self items: (self model implementorsOf: aString). self refresh ! ! HLReferencesListWidget subclass: #HLRegexpListWidget slots: {} package: 'Helios-References'! !HLRegexpListWidget methodsFor: 'accessing'! label ^ 'Source search' ! ! !HLRegexpListWidget methodsFor: 'reactions'! onSearchReferences: aString self selectItem: nil. self items: (self model regexpReferencesOf: aString). self refresh ! ! HLReferencesListWidget subclass: #HLSendersListWidget slots: {} package: 'Helios-References'! !HLSendersListWidget methodsFor: 'accessing'! label ^ 'Senders' ! ! !HLSendersListWidget methodsFor: 'reactions'! onSearchReferences: aString self selectItem: nil. self items: (self model sendersOf: aString). self refresh ! ! HLToolModel subclass: #HLReferencesModel slots: {#methodsCache. #classesAndMetaclassesCache} package: 'Helios-References'! !HLReferencesModel methodsFor: 'accessing'! allMethods ^ self methodsCache ! classReferencesOf: aString "Answer all methods referencing the class named aString" ^self allMethods select: [ :each | (each referencedClasses includes: aString) ] ! classesAndMetaclasses ^ self classesAndMetaclassesCache ! implementorsOf: aString ^ self allMethods select: [ :each | each selector = aString ] ! regexpReferencesOf: aString ^ self allMethods select: [ :each | each source match: aString ] ! sendersOf: aString ^ self allMethods select: [ :each | each messageSends includes: aString ] ! ! !HLReferencesModel methodsFor: 'actions'! openClassNamed: aString | browser | self withChangesDo: [ browser := HLBrowser openAsTab. browser openClassNamed: aString ] ! openMethod | browser | self selectedMethod ifNil: [ ^ self ]. self withChangesDo: [ browser := HLBrowser openAsTab. browser openMethod: self selectedMethod ] ! search: aString self updateCaches. self announcer announce: (HLSearchReferences new searchString: aString; yourself) ! ! !HLReferencesModel methodsFor: 'cache'! classesAndMetaclassesCache classesAndMetaclassesCache ifNil: [ self updateClassesAndMetaclassesCache ]. ^ classesAndMetaclassesCache ! methodsCache methodsCache ifNil: [ self updateMethodsCache ]. ^ methodsCache ! updateCaches self updateClassesAndMetaclassesCache; updateMethodsCache ! updateClassesAndMetaclassesCache classesAndMetaclassesCache := OrderedCollection new. self environment classes do: [ :eachClass | eachClass includingPossibleMetaDo: [ :each | classesAndMetaclassesCache add: each ] ] ! updateMethodsCache methodsCache := OrderedCollection new. self classesAndMetaclasses do: [ :each | methodsCache addAll: each methods ] ! ! !HLReferencesModel methodsFor: 'testing'! isReferencesModel ^ true ! !