1
0

Helios-References.st 7.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390
  1. Smalltalk current createPackage: 'Helios-References'!
  2. Object subclass: #HLMethodReference
  3. instanceVariableNames: 'selector methodClass'
  4. package: 'Helios-References'!
  5. !HLMethodReference methodsFor: 'accessing'!
  6. method
  7. ^ self methodClass methodAt: self selector
  8. !
  9. methodClass
  10. ^ methodClass
  11. !
  12. methodClass: aClass
  13. methodClass := aClass
  14. !
  15. selector
  16. ^ selector
  17. !
  18. selector: aString
  19. selector := aString
  20. !
  21. source
  22. ^ self method source
  23. ! !
  24. !HLMethodReference methodsFor: 'initialization'!
  25. initializeFromMethod: aCompiledMethod
  26. self
  27. selector: aCompiledMethod selector;
  28. methodClass: aCompiledMethod methodClass
  29. ! !
  30. !HLMethodReference class methodsFor: 'instance creation'!
  31. on: aCompiledMethod
  32. ^ self new
  33. initializeFromMethod: aCompiledMethod;
  34. yourself
  35. ! !
  36. HLWidget subclass: #HLReferences
  37. instanceVariableNames: 'model sendersListWidget implementorsListWidget classReferencesListWidget regexpListWidget sourceCodeWidget'
  38. package: 'Helios-References'!
  39. !HLReferences methodsFor: 'accessing'!
  40. classReferencesListWidget
  41. ^ classReferencesListWidget ifNil: [
  42. classReferencesListWidget := HLClassReferencesListWidget on: self model.
  43. classReferencesListWidget next: self regexpListWidget ]
  44. !
  45. implementorsListWidget
  46. ^ implementorsListWidget ifNil: [
  47. implementorsListWidget := HLImplementorsListWidget on: self model.
  48. implementorsListWidget next: self classReferencesListWidget ]
  49. !
  50. model
  51. ^ model ifNil: [
  52. model := (HLReferencesModel new
  53. environment: self manager environment;
  54. yourself) ]
  55. !
  56. model: aModel
  57. model := aModel
  58. !
  59. regexpListWidget
  60. ^ regexpListWidget ifNil: [
  61. regexpListWidget := HLRegexpListWidget on: self model.
  62. regexpListWidget next: self sourceCodeWidget ]
  63. !
  64. sendersListWidget
  65. ^ sendersListWidget ifNil: [
  66. sendersListWidget := HLSendersListWidget on: self model.
  67. sendersListWidget next: self implementorsListWidget ]
  68. !
  69. sourceCodeWidget
  70. ^ sourceCodeWidget ifNil: [
  71. sourceCodeWidget := HLBrowserCodeWidget new
  72. browserModel: self model;
  73. yourself ]
  74. ! !
  75. !HLReferences methodsFor: 'actions'!
  76. open
  77. HLManager current addTab: (HLTab on: self labelled: self class tabLabel)
  78. !
  79. registerBindingsOn: aBindingGroup
  80. HLToolCommand
  81. registerConcreteClassesOn: aBindingGroup
  82. for: self model
  83. !
  84. search: aString
  85. self model search: aString
  86. ! !
  87. !HLReferences methodsFor: 'rendering'!
  88. renderContentOn: html
  89. html with: (HLContainer with: (HLHorizontalSplitter
  90. with: (HLVerticalSplitter
  91. with: (HLVerticalSplitter
  92. with: self sendersListWidget
  93. with: self implementorsListWidget)
  94. with: (HLVerticalSplitter
  95. with: self classReferencesListWidget
  96. with: self regexpListWidget))
  97. with: self sourceCodeWidget)).
  98. self sendersListWidget focus
  99. ! !
  100. !HLReferences class methodsFor: 'accessing'!
  101. tabClass
  102. ^ 'references'
  103. !
  104. tabLabel
  105. ^ 'References'
  106. !
  107. tabPriority
  108. ^ 100
  109. ! !
  110. !HLReferences class methodsFor: 'testing'!
  111. canBeOpenAsTab
  112. ^ false
  113. ! !
  114. HLToolListWidget subclass: #HLReferencesListWidget
  115. instanceVariableNames: ''
  116. package: 'Helios-References'!
  117. !HLReferencesListWidget methodsFor: 'accessing'!
  118. commandCategory
  119. ^ 'Methods'
  120. !
  121. label
  122. ^ 'List'
  123. ! !
  124. !HLReferencesListWidget methodsFor: 'actions'!
  125. activateListItem: anItem
  126. self model withChangesDo: [ super activateListItem: anItem ]
  127. !
  128. observeModel
  129. self model announcer
  130. on: HLSearchReferences
  131. do: [ :ann | self onSearchReferences: ann searchString ];
  132. on: HLMethodSelected
  133. do: [ :ann | self onMethodSelected: ann item ]
  134. !
  135. selectItem: aMethod
  136. self model selectedMethod: aMethod
  137. ! !
  138. !HLReferencesListWidget methodsFor: 'reactions'!
  139. onMethodSelected: aMethod
  140. aMethod ifNil: [ ^ self ].
  141. self items detect: [ :each | each = aMethod selector ] ifNone: [ ^ self ].
  142. self
  143. selectedItem: aMethod selector;
  144. activateItem: aMethod selector
  145. !
  146. onSearchReferences: aString
  147. self subclassResponsibility
  148. ! !
  149. !HLReferencesListWidget methodsFor: 'rendering'!
  150. renderItemLabel: aMethod on: html
  151. html with: aMethod methodClass name, ' >> #', aMethod selector
  152. ! !
  153. !HLReferencesListWidget class methodsFor: 'instance creation'!
  154. on: aModel
  155. ^ self new
  156. model: aModel;
  157. yourself
  158. ! !
  159. HLReferencesListWidget subclass: #HLClassReferencesListWidget
  160. instanceVariableNames: ''
  161. package: 'Helios-References'!
  162. !HLClassReferencesListWidget methodsFor: 'accessing'!
  163. label
  164. ^ 'Class references'
  165. ! !
  166. !HLClassReferencesListWidget methodsFor: 'reactions'!
  167. onSearchReferences: aString
  168. self selectItem: nil.
  169. self items: (self model classReferencesOf: aString).
  170. self refresh
  171. ! !
  172. HLReferencesListWidget subclass: #HLImplementorsListWidget
  173. instanceVariableNames: ''
  174. package: 'Helios-References'!
  175. !HLImplementorsListWidget methodsFor: 'accessing'!
  176. label
  177. ^ 'Implementors'
  178. ! !
  179. !HLImplementorsListWidget methodsFor: 'reactions'!
  180. onSearchReferences: aString
  181. self selectItem: nil.
  182. self items: (self model implementorsOf: aString).
  183. self refresh
  184. ! !
  185. HLReferencesListWidget subclass: #HLRegexpListWidget
  186. instanceVariableNames: ''
  187. package: 'Helios-References'!
  188. !HLRegexpListWidget methodsFor: 'accessing'!
  189. label
  190. ^ 'Source search'
  191. ! !
  192. !HLRegexpListWidget methodsFor: 'reactions'!
  193. onSearchReferences: aString
  194. self selectItem: nil.
  195. self items: (self model regexpReferencesOf: aString).
  196. self refresh
  197. ! !
  198. HLReferencesListWidget subclass: #HLSendersListWidget
  199. instanceVariableNames: ''
  200. package: 'Helios-References'!
  201. !HLSendersListWidget methodsFor: 'accessing'!
  202. label
  203. ^ 'Senders'
  204. ! !
  205. !HLSendersListWidget methodsFor: 'reactions'!
  206. onSearchReferences: aString
  207. self selectItem: nil.
  208. self items: (self model sendersOf: aString).
  209. self refresh
  210. ! !
  211. HLToolModel subclass: #HLReferencesModel
  212. instanceVariableNames: 'methodsCache classesAndMetaclassesCache'
  213. package: 'Helios-References'!
  214. !HLReferencesModel methodsFor: 'accessing'!
  215. allMethods
  216. ^ self methodsCache
  217. !
  218. allSelectors
  219. ^ (self allMethods
  220. collect: [ :each | each selector ])
  221. asSet
  222. !
  223. classReferencesOf: aString
  224. "Answer all methods referencing the class named aString"
  225. | references |
  226. references := OrderedCollection new.
  227. self classesAndMetaclasses do: [ :each |
  228. each methodDictionary values do: [ :method |
  229. (method referencedClasses includes: aString) ifTrue: [
  230. references add: method ] ] ].
  231. ^ references
  232. !
  233. classesAndMetaclasses
  234. ^ self classesAndMetaclassesCache
  235. !
  236. implementorsOf: aString
  237. ^ (self allMethods select: [ :each |
  238. each selector = aString ])
  239. collect: [ :each | self methodReferenceOn: each ]
  240. !
  241. methodReferenceOn: aCompiledMethod
  242. ^ HLMethodReference on: aCompiledMethod
  243. !
  244. regexpReferencesOf: aString
  245. ^ (self allMethods select: [ :each |
  246. each source match: aString ])
  247. collect: [ :each | self methodReferenceOn: each ]
  248. !
  249. sendersOf: aString
  250. ^ (self allMethods select: [ :each |
  251. each messageSends includes: aString ])
  252. collect: [ :each | self methodReferenceOn: each ]
  253. ! !
  254. !HLReferencesModel methodsFor: 'actions'!
  255. search: aString
  256. self updateCaches.
  257. self announcer announce: (HLSearchReferences new
  258. searchString: aString;
  259. yourself)
  260. ! !
  261. !HLReferencesModel methodsFor: 'cache'!
  262. classesAndMetaclassesCache
  263. classesAndMetaclassesCache ifNil: [ self updateClassesAndMetaclassesCache ].
  264. ^ classesAndMetaclassesCache
  265. !
  266. methodsCache
  267. methodsCache ifNil: [ self updateMethodsCache ].
  268. ^ methodsCache
  269. !
  270. updateCaches
  271. self
  272. updateClassesAndMetaclassesCache;
  273. updateMethodsCache
  274. !
  275. updateClassesAndMetaclassesCache
  276. classesAndMetaclassesCache := self environment classes
  277. inject: OrderedCollection new
  278. into: [ :acc :each |
  279. acc
  280. add: each;
  281. add: each class;
  282. yourself ]
  283. !
  284. updateMethodsCache
  285. methodsCache := self classesAndMetaclasses
  286. inject: OrderedCollection new
  287. into: [ :acc :each |
  288. acc, each methods ]
  289. ! !
  290. !HLReferencesModel methodsFor: 'testing'!
  291. isReferencesModel
  292. ^ true
  293. ! !