Helios-References.st 7.4 KB

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