Helios-References.st 6.7 KB

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