1
0

Helios-References.st 7.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389
  1. Smalltalk 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. registerBindingsOn: aBindingGroup
  77. HLToolCommand
  78. registerConcreteClassesOn: aBindingGroup
  79. for: self model
  80. !
  81. search: aString
  82. self model search: aString.
  83. self setTabLabel: aString
  84. ! !
  85. !HLReferences methodsFor: 'rendering'!
  86. renderContentOn: html
  87. html with: (HLContainer with: (HLHorizontalSplitter
  88. with: (HLVerticalSplitter
  89. with: (HLVerticalSplitter
  90. with: self sendersListWidget
  91. with: self implementorsListWidget)
  92. with: (HLVerticalSplitter
  93. with: self classReferencesListWidget
  94. with: self regexpListWidget))
  95. with: self sourceCodeWidget)).
  96. self sendersListWidget focus
  97. ! !
  98. !HLReferences class methodsFor: 'accessing'!
  99. tabClass
  100. ^ 'references'
  101. !
  102. tabLabel
  103. ^ 'References'
  104. !
  105. tabPriority
  106. ^ 100
  107. ! !
  108. !HLReferences class methodsFor: 'testing'!
  109. canBeOpenAsTab
  110. ^ false
  111. ! !
  112. HLToolListWidget subclass: #HLReferencesListWidget
  113. instanceVariableNames: ''
  114. package: 'Helios-References'!
  115. !HLReferencesListWidget methodsFor: 'accessing'!
  116. commandCategory
  117. ^ 'Methods'
  118. !
  119. label
  120. ^ 'List'
  121. ! !
  122. !HLReferencesListWidget methodsFor: 'actions'!
  123. activateListItem: anItem
  124. self model withChangesDo: [ super activateListItem: anItem ]
  125. !
  126. observeModel
  127. self model announcer
  128. on: HLSearchReferences
  129. do: [ :ann | self onSearchReferences: ann searchString ];
  130. on: HLMethodSelected
  131. do: [ :ann | self onMethodSelected: ann item ]
  132. !
  133. selectItem: aMethod
  134. super selectItem: aMethod.
  135. self model selectedMethod: aMethod
  136. ! !
  137. !HLReferencesListWidget methodsFor: 'reactions'!
  138. onMethodSelected: aMethod
  139. aMethod ifNil: [ ^ self ].
  140. self items detect: [ :each | each = aMethod selector ] ifNone: [ ^ self ].
  141. self
  142. selectedItem: aMethod selector;
  143. activateItem: aMethod selector
  144. !
  145. onSearchReferences: aString
  146. self subclassResponsibility
  147. ! !
  148. !HLReferencesListWidget methodsFor: 'rendering'!
  149. renderItemLabel: aMethod on: html
  150. html with: aMethod methodClass name, ' >> #', aMethod selector
  151. ! !
  152. !HLReferencesListWidget class methodsFor: 'instance creation'!
  153. on: aModel
  154. ^ self new
  155. model: aModel;
  156. yourself
  157. ! !
  158. HLReferencesListWidget subclass: #HLClassReferencesListWidget
  159. instanceVariableNames: ''
  160. package: 'Helios-References'!
  161. !HLClassReferencesListWidget methodsFor: 'accessing'!
  162. label
  163. ^ 'Class references'
  164. ! !
  165. !HLClassReferencesListWidget methodsFor: 'reactions'!
  166. onSearchReferences: aString
  167. self selectItem: nil.
  168. self items: (self model classReferencesOf: aString).
  169. self refresh
  170. ! !
  171. HLReferencesListWidget subclass: #HLImplementorsListWidget
  172. instanceVariableNames: ''
  173. package: 'Helios-References'!
  174. !HLImplementorsListWidget methodsFor: 'accessing'!
  175. label
  176. ^ 'Implementors'
  177. ! !
  178. !HLImplementorsListWidget methodsFor: 'reactions'!
  179. onSearchReferences: aString
  180. self selectItem: nil.
  181. self items: (self model implementorsOf: aString).
  182. self refresh
  183. ! !
  184. HLReferencesListWidget subclass: #HLRegexpListWidget
  185. instanceVariableNames: ''
  186. package: 'Helios-References'!
  187. !HLRegexpListWidget methodsFor: 'accessing'!
  188. label
  189. ^ 'Source search'
  190. ! !
  191. !HLRegexpListWidget methodsFor: 'reactions'!
  192. onSearchReferences: aString
  193. self selectItem: nil.
  194. self items: (self model regexpReferencesOf: aString).
  195. self refresh
  196. ! !
  197. HLReferencesListWidget subclass: #HLSendersListWidget
  198. instanceVariableNames: ''
  199. package: 'Helios-References'!
  200. !HLSendersListWidget methodsFor: 'accessing'!
  201. label
  202. ^ 'Senders'
  203. ! !
  204. !HLSendersListWidget methodsFor: 'reactions'!
  205. onSearchReferences: aString
  206. self selectItem: nil.
  207. self items: (self model sendersOf: aString).
  208. self refresh
  209. ! !
  210. HLToolModel subclass: #HLReferencesModel
  211. instanceVariableNames: 'methodsCache classesAndMetaclassesCache'
  212. package: 'Helios-References'!
  213. !HLReferencesModel methodsFor: 'accessing'!
  214. allMethods
  215. ^ self methodsCache
  216. !
  217. classReferencesOf: aString
  218. "Answer all methods referencing the class named aString"
  219. ^self allMethods select: [ :each |
  220. (each referencedClasses includes: aString) ].
  221. !
  222. classesAndMetaclasses
  223. ^ self classesAndMetaclassesCache
  224. !
  225. implementorsOf: aString
  226. ^ (self allMethods select: [ :each |
  227. each selector = aString ])
  228. collect: [ :each | self methodReferenceOn: each ]
  229. !
  230. methodReferenceOn: aCompiledMethod
  231. ^ HLMethodReference on: aCompiledMethod
  232. !
  233. regexpReferencesOf: aString
  234. ^ (self allMethods select: [ :each |
  235. each source match: aString ])
  236. collect: [ :each | self methodReferenceOn: each ]
  237. !
  238. sendersOf: aString
  239. ^ (self allMethods select: [ :each |
  240. each messageSends includes: aString ])
  241. collect: [ :each | self methodReferenceOn: each ]
  242. ! !
  243. !HLReferencesModel methodsFor: 'actions'!
  244. openClassNamed: aString
  245. | browser |
  246. self withChangesDo: [
  247. browser := HLBrowser openAsTab.
  248. browser openClassNamed: aString ]
  249. !
  250. openMethod
  251. | browser |
  252. self selectedMethod ifNil: [ ^ self ].
  253. self withChangesDo: [
  254. browser := HLBrowser openAsTab.
  255. browser openMethod: self selectedMethod ]
  256. !
  257. search: aString
  258. self updateCaches.
  259. self announcer announce: (HLSearchReferences new
  260. searchString: aString;
  261. yourself)
  262. ! !
  263. !HLReferencesModel methodsFor: 'cache'!
  264. classesAndMetaclassesCache
  265. classesAndMetaclassesCache ifNil: [ self updateClassesAndMetaclassesCache ].
  266. ^ classesAndMetaclassesCache
  267. !
  268. methodsCache
  269. methodsCache ifNil: [ self updateMethodsCache ].
  270. ^ methodsCache
  271. !
  272. updateCaches
  273. self
  274. updateClassesAndMetaclassesCache;
  275. updateMethodsCache
  276. !
  277. updateClassesAndMetaclassesCache
  278. classesAndMetaclassesCache := OrderedCollection new.
  279. self environment classes do: [ :each |
  280. classesAndMetaclassesCache
  281. add: each;
  282. add: each class ]
  283. !
  284. updateMethodsCache
  285. methodsCache := OrderedCollection new.
  286. self classesAndMetaclasses
  287. do: [ :each | methodsCache addAll: each methods ]
  288. ! !
  289. !HLReferencesModel methodsFor: 'testing'!
  290. isReferencesModel
  291. ^ true
  292. ! !