Helios-Browser.st 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708
  1. Smalltalk current createPackage: 'Helios-Browser' properties: #{}!
  2. HLWidget subclass: #HLBrowser
  3. instanceVariableNames: 'model packagesListWidget classesListWidget protocolsListWidget methodsListWidget sourceWidget'
  4. package: 'Helios-Browser'!
  5. !HLBrowser methodsFor: 'accessing'!
  6. announcer
  7. ^ self model announcer
  8. !
  9. environment
  10. ^ self model environment
  11. !
  12. model
  13. ^ model ifNil: [ model := HLBrowserModel new ]
  14. !
  15. model: aModel
  16. model := aModel
  17. ! !
  18. !HLBrowser methodsFor: 'keybindings'!
  19. registerBindingsOn: aBindingGroup
  20. aBindingGroup
  21. addGroupKey: 66 labelled: 'Browse';
  22. addGroupKey: 71 labelled: 'Go to';
  23. addGroupKey: 84 labelled: 'Toggle'.
  24. HLBrowserCommand withAllSubclasses do: [ :each |
  25. each key ifNotNil: [
  26. (aBindingGroup at: each bindingGroup)
  27. add: (each on: self model) asBinding ] ]
  28. ! !
  29. !HLBrowser methodsFor: 'rendering'!
  30. renderContentOn: html
  31. html with: (HLContainer with: (HLHorizontalSplitter
  32. with: (HLVerticalSplitter
  33. with: (HLVerticalSplitter
  34. with: self packagesListWidget
  35. with: self classesListWidget)
  36. with: (HLVerticalSplitter
  37. with: self protocolsListWidget
  38. with: self methodsListWidget))
  39. with: self sourceWidget))
  40. ! !
  41. !HLBrowser methodsFor: 'widgets'!
  42. classesListWidget
  43. ^ classesListWidget ifNil: [
  44. classesListWidget := HLClassesListWidget on: self model.
  45. classesListWidget next: self protocolsListWidget ]
  46. !
  47. methodsListWidget
  48. ^ methodsListWidget ifNil: [
  49. methodsListWidget := HLMethodsListWidget on: self model ]
  50. !
  51. packagesListWidget
  52. ^ packagesListWidget ifNil: [
  53. packagesListWidget := HLPackagesListWidget on: self model.
  54. packagesListWidget next: self classesListWidget ]
  55. !
  56. protocolsListWidget
  57. ^ protocolsListWidget ifNil: [
  58. protocolsListWidget := HLProtocolsListWidget on: self model.
  59. protocolsListWidget next: self methodsListWidget ]
  60. !
  61. sourceWidget
  62. ^ sourceWidget ifNil: [
  63. sourceWidget := HLBrowserSourceWidget on: self model ]
  64. ! !
  65. HLBrowser class instanceVariableNames: 'nextId'!
  66. !HLBrowser class methodsFor: 'accessing'!
  67. nextId
  68. nextId ifNil: [ nextId := 0 ].
  69. ^ 'browser_', (nextId + 1) asString
  70. !
  71. tabLabel
  72. ^ 'Browser'
  73. !
  74. tabPriority
  75. ^ 0
  76. ! !
  77. !HLBrowser class methodsFor: 'testing'!
  78. canBeOpenAsTab
  79. ^ true
  80. ! !
  81. HLNavigationListWidget subclass: #HLBrowserListWidget
  82. instanceVariableNames: 'model'
  83. package: 'Helios-Browser'!
  84. !HLBrowserListWidget methodsFor: 'accessing'!
  85. model
  86. ^ model
  87. !
  88. model: aBrowserModel
  89. model := aBrowserModel.
  90. self observeModel
  91. ! !
  92. !HLBrowserListWidget methodsFor: 'actions'!
  93. observeModel
  94. ! !
  95. !HLBrowserListWidget class methodsFor: 'instance creation'!
  96. on: aModel
  97. ^ self new
  98. model: aModel;
  99. yourself
  100. ! !
  101. HLBrowserListWidget subclass: #HLClassesListWidget
  102. instanceVariableNames: ''
  103. package: 'Helios-Browser'!
  104. !HLClassesListWidget methodsFor: 'accessing'!
  105. getChildrenOf: aClass
  106. ^ self items select: [ :each | each superclass = aClass ]
  107. !
  108. getRootClassesOf: aCollection
  109. ^ aCollection select: [ :each |
  110. (each allSuperclasses intersection: aCollection) isEmpty ]
  111. !
  112. iconForItem: aClass
  113. ^ aClass theNonMetaClass comment isEmpty
  114. ifFalse: [ 'icon-none' ]
  115. ifTrue: [ 'icon-question-sign' ]
  116. !
  117. showInstance
  118. ^ self model showInstance
  119. ! !
  120. !HLClassesListWidget methodsFor: 'actions'!
  121. focusMethodsListWidget
  122. self model announcer announce: HLMethodsListFocus new
  123. !
  124. focusProtocolsListWidget
  125. self model announcer announce: HLProtocolsListFocus new
  126. !
  127. observeModel
  128. self model announcer
  129. on: HLPackageSelected do: [ :ann | self onPackageSelected: ann item ];
  130. on: HLShowInstanceToggled do: [ :ann | self onShowInstanceToggled ];
  131. on: HLClassSelected do: [ :ann | self onClassSelected: ann item ]
  132. !
  133. selectItem: aClass
  134. super selectItem: aClass.
  135. self model selectedClass: aClass
  136. !
  137. showInstance: aBoolean
  138. self model showInstance: aBoolean
  139. ! !
  140. !HLClassesListWidget methodsFor: 'reactions'!
  141. onClassSelected: aClass
  142. self focus
  143. !
  144. onPackageSelected: aPackage
  145. self selectedItem: nil.
  146. self items: (aPackage
  147. ifNil: [ #() ]
  148. ifNotNil: [ (aPackage classes
  149. collect: [ :each | each theNonMetaClass ]) asSet asArray ]).
  150. self refresh
  151. !
  152. onShowInstanceToggled
  153. self refresh
  154. ! !
  155. !HLClassesListWidget methodsFor: 'rendering'!
  156. renderButtonsOn: html
  157. html div
  158. class: 'btn-group';
  159. at: 'data-toggle' put: 'buttons-radio';
  160. with: [
  161. html button
  162. class: (String streamContents: [ :str |
  163. str nextPutAll: 'btn'.
  164. self showInstance ifTrue: [
  165. str nextPutAll: ' active'] ]);
  166. with: 'Instance';
  167. onClick: [ self showInstance: true ].
  168. html button
  169. class: (String streamContents: [ :str |
  170. str nextPutAll: 'btn'.
  171. self model showInstance ifFalse: [
  172. str nextPutAll: ' active'] ]);
  173. with: 'Class';
  174. onClick: [ self model showInstance: false ] ].
  175. html button
  176. class: 'btn';
  177. at: 'data-toggle' put: 'button';
  178. with: 'Comment'
  179. !
  180. renderItem: aClass level: anInteger on: html
  181. | li |
  182. li := html li.
  183. li
  184. at: 'list-data' put: (self items indexOf: aClass);
  185. class: (self cssClassForItem: aClass);
  186. with: [
  187. html a
  188. with: [
  189. (html tag: 'i') class: (self iconForItem: aClass).
  190. self renderItemLabel: aClass level: anInteger on: html ];
  191. onClick: [
  192. self activateListItem: li asJQuery ] ].
  193. (self getChildrenOf: aClass) do: [ :each |
  194. self renderItem: each level: anInteger + 1 on: html ]
  195. !
  196. renderItem: aClass on: html
  197. super renderItem: aClass on: html.
  198. (self getChildrenOf: aClass) do: [ :each |
  199. self renderItem: each level: 1 on: html ]
  200. !
  201. renderItemLabel: aClass level: anInteger on: html
  202. html span asJQuery html: (String streamContents: [ :str |
  203. anInteger timesRepeat: [
  204. str nextPutAll: '    '].
  205. str nextPutAll: aClass name ])
  206. !
  207. renderItemLabel: aClass on: html
  208. self renderItemLabel: aClass level: 0 on: html
  209. !
  210. renderListOn: html
  211. (self getRootClassesOf: self items)
  212. do: [ :each | self renderItem: each on: html ]
  213. ! !
  214. HLBrowserListWidget subclass: #HLMethodsListWidget
  215. instanceVariableNames: 'selectorsCache'
  216. package: 'Helios-Browser'!
  217. !HLMethodsListWidget methodsFor: 'accessing'!
  218. allProtocol
  219. ^ self model allProtocol
  220. !
  221. iconForItem: aCompiledMethod
  222. | override overriden |
  223. override := self isOverride: aCompiledMethod.
  224. overriden := self isOverriden: aCompiledMethod.
  225. ^ override
  226. ifTrue: [ overriden
  227. ifTrue: [ 'icon-resize-vertical' ]
  228. ifFalse: [ 'icon-arrow-up' ] ]
  229. ifFalse: [
  230. overriden
  231. ifTrue: [ 'icon-arrow-down' ]
  232. ifFalse: [ 'icon-none' ] ]
  233. !
  234. methodsInProtocol: aString
  235. ^ aString = self allProtocol
  236. ifTrue: [ self model selectedClass methods ]
  237. ifFalse: [ self model selectedClass methodsInProtocol: aString ]
  238. !
  239. overrideSelectors
  240. ^ self selectorsCache
  241. at: 'override'
  242. ifAbsentPut: [
  243. self model selectedClass allSuperclasses
  244. inject: Set new into: [ :acc :each | acc addAll: each selectors; yourself ] ]
  245. !
  246. overridenSelectors
  247. ^ self selectorsCache
  248. at: 'overriden'
  249. ifAbsentPut: [
  250. self model selectedClass allSubclasses
  251. inject: Set new into: [ :acc :each | acc addAll: each selectors; yourself ] ]
  252. !
  253. selectorsCache
  254. ^ selectorsCache
  255. ! !
  256. !HLMethodsListWidget methodsFor: 'actions'!
  257. observeModel
  258. self model announcer on: HLProtocolSelected do: [ :ann |
  259. self onProtocolSelected: ann item ].
  260. self model announcer on: HLShowInstanceToggled do: [ :ann |
  261. self onProtocolSelected: nil ].
  262. self model announcer on: HLMethodSelected do: [ :ann |
  263. self onMethodSelected: ann item ]
  264. !
  265. selectItem: aCompiledMethod
  266. super selectItem: aCompiledMethod.
  267. self model selectedMethod: aCompiledMethod
  268. ! !
  269. !HLMethodsListWidget methodsFor: 'cache'!
  270. flushSelectorsCache
  271. selectorsCache := Dictionary new
  272. ! !
  273. !HLMethodsListWidget methodsFor: 'initialization'!
  274. initialize
  275. super initialize.
  276. self flushSelectorsCache
  277. ! !
  278. !HLMethodsListWidget methodsFor: 'reactions'!
  279. onMethodSelected: aMethod
  280. self focus
  281. !
  282. onProtocolSelected: aString
  283. self selectedItem: nil.
  284. self items: (self model selectedClass
  285. ifNil: [ #() ]
  286. ifNotNil: [ aString
  287. ifNil: [ #() ]
  288. ifNotNil: [ self methodsInProtocol: aString ] ]).
  289. self refresh
  290. ! !
  291. !HLMethodsListWidget methodsFor: 'rendering'!
  292. renderContentOn: html
  293. self model showInstance
  294. ifFalse: [ html div
  295. class: 'class_side';
  296. with: [ super renderContentOn: html ] ]
  297. ifTrue: [ super renderContentOn: html ].
  298. self flushSelectorsCache
  299. !
  300. renderItemLabel: aCompiledMethod on: html
  301. html with: aCompiledMethod selector
  302. ! !
  303. !HLMethodsListWidget methodsFor: 'testing'!
  304. isOverride: aMethod
  305. ^ self overrideSelectors includes: aMethod selector
  306. !
  307. isOverriden: aMethod
  308. ^ self overridenSelectors includes: aMethod selector
  309. ! !
  310. HLBrowserListWidget subclass: #HLPackagesListWidget
  311. instanceVariableNames: ''
  312. package: 'Helios-Browser'!
  313. !HLPackagesListWidget methodsFor: 'accessing'!
  314. initializeItems
  315. ^ items := self model packages sort:[:a :b|
  316. a name < b name]
  317. !
  318. items
  319. ^ items ifNil: [self initializeItems]
  320. ! !
  321. !HLPackagesListWidget methodsFor: 'actions'!
  322. focusClassesListWidget
  323. self model announcer announce: HLClassesListFocus new
  324. !
  325. observeModel
  326. self model announcer on: HLPackageSelected do: [ :ann |
  327. self onPackageSelected: ann item ]
  328. !
  329. selectItem: aPackage
  330. super selectItem: aPackage.
  331. self model selectedPackage: aPackage
  332. ! !
  333. !HLPackagesListWidget methodsFor: 'reactions'!
  334. onPackageSelected: aPackage
  335. self focus
  336. ! !
  337. !HLPackagesListWidget methodsFor: 'rendering'!
  338. renderButtonsOn: html
  339. html span class: 'info'; with: 'Auto commit'.
  340. html div
  341. class: 'btn-group switch';
  342. at: 'data-toggle' put: 'buttons-radio';
  343. with: [
  344. html button
  345. class: (String streamContents: [ :str |
  346. str nextPutAll: 'btn' ]);
  347. with: 'On'.
  348. html button
  349. class: (String streamContents: [ :str |
  350. str nextPutAll: 'btn active' ]);
  351. with: 'Off' ].
  352. html a
  353. class: 'btn';
  354. with: 'Commit'.
  355. ! !
  356. HLBrowserListWidget subclass: #HLProtocolsListWidget
  357. instanceVariableNames: ''
  358. package: 'Helios-Browser'!
  359. !HLProtocolsListWidget methodsFor: 'accessing'!
  360. allProtocol
  361. ^ self model allProtocol
  362. !
  363. selectedItem
  364. ^ super selectedItem" ifNil: [ self allProtocol ]"
  365. ! !
  366. !HLProtocolsListWidget methodsFor: 'actions'!
  367. observeModel
  368. self model announcer on: HLClassSelected do: [ :ann |
  369. self onClassSelected: ann item ].
  370. self model announcer on: HLShowInstanceToggled do: [ :ann |
  371. self onClassSelected: self model selectedClass ].
  372. self model announcer on: HLProtocolSelected do: [ :ann |
  373. self onProtocolSelected: ann item ]
  374. !
  375. selectItem: aString
  376. super selectItem: aString.
  377. self model selectedProtocol: aString
  378. ! !
  379. !HLProtocolsListWidget methodsFor: 'reactions'!
  380. onClassSelected: aClass
  381. self selectedItem: nil.
  382. self items: (aClass
  383. ifNil: [ Array with: self allProtocol ]
  384. ifNotNil: [
  385. (Array with: self allProtocol)
  386. addAll: aClass protocols;
  387. yourself ]).
  388. self refresh
  389. !
  390. onProtocolSelected: aString
  391. self focus
  392. ! !
  393. !HLProtocolsListWidget methodsFor: 'rendering'!
  394. renderContentOn: html
  395. self model showInstance
  396. ifFalse: [ html div
  397. class: 'class_side';
  398. with: [ super renderContentOn: html ] ]
  399. ifTrue: [ super renderContentOn: html ]
  400. ! !
  401. Object subclass: #HLBrowserModel
  402. instanceVariableNames: 'announcer environment selectedPackage selectedClass selectedProtocol selectedMethod showInstance showComment'
  403. package: 'Helios-Browser'!
  404. !HLBrowserModel methodsFor: 'accessing'!
  405. allProtocol
  406. ^ '-- All --'
  407. !
  408. announcer
  409. ^ announcer ifNil: [ announcer := Announcer new ]
  410. !
  411. environment
  412. ^ environment ifNil: [ HLManager current environment ]
  413. !
  414. environment: anEnvironment
  415. environment := anEnvironment
  416. !
  417. packages
  418. ^ self environment packages
  419. !
  420. selectedClass
  421. ^ selectedClass
  422. !
  423. selectedClass: aClass
  424. selectedClass = aClass ifFalse: [
  425. aClass
  426. ifNil: [ selectedClass := nil ]
  427. ifNotNil: [
  428. self showInstance
  429. ifTrue: [ selectedClass := aClass theNonMetaClass ]
  430. ifFalse: [ selectedClass := aClass theMetaClass ] ].
  431. self
  432. selectedMethod: nil;
  433. selectedProtocol: nil ].
  434. self announcer announce: (HLClassSelected on: self selectedClass)
  435. !
  436. selectedMethod
  437. ^ selectedMethod
  438. !
  439. selectedMethod: aCompiledMethod
  440. selectedMethod = aCompiledMethod ifFalse: [
  441. selectedMethod := aCompiledMethod ].
  442. self announcer announce: (HLMethodSelected on: aCompiledMethod)
  443. !
  444. selectedPackage
  445. ^ selectedPackage
  446. !
  447. selectedPackage: aPackage
  448. selectedPackage = aPackage ifFalse: [
  449. selectedPackage := aPackage.
  450. self selectedClass: nil ].
  451. self announcer announce: (HLPackageSelected on: aPackage)
  452. !
  453. selectedProtocol
  454. ^ selectedProtocol
  455. !
  456. selectedProtocol: aString
  457. selectedProtocol = aString ifFalse: [
  458. selectedProtocol := aString.
  459. self selectedMethod: nil ].
  460. self announcer announce: (HLProtocolSelected on: aString)
  461. !
  462. showComment
  463. ^ showComment ifNil: [ false ]
  464. !
  465. showComment: aBoolean
  466. showComment := aBoolean.
  467. self announcer announce: HLShowCommentToggled new
  468. !
  469. showInstance
  470. ^ showInstance ifNil: [ true ]
  471. !
  472. showInstance: aBoolean
  473. showInstance := aBoolean.
  474. self selectedClass ifNotNil: [
  475. self selectedClass: (aBoolean
  476. ifTrue: [self selectedClass theNonMetaClass ]
  477. ifFalse: [ self selectedClass theMetaClass ]) ].
  478. self announcer announce: HLShowInstanceToggled new
  479. ! !
  480. !HLBrowserModel class methodsFor: 'actions'!
  481. on: anEnvironment
  482. ^ self new
  483. environment: anEnvironment;
  484. yourself
  485. ! !
  486. HLWidget subclass: #HLBrowserSourceWidget
  487. instanceVariableNames: 'model codeWidget'
  488. package: 'Helios-Browser'!
  489. !HLBrowserSourceWidget methodsFor: 'accessing'!
  490. codeWidget
  491. ^ codeWidget ifNil: [ codeWidget := HLCodeWidget new ]
  492. !
  493. contents
  494. ^ self sourceArea contents
  495. !
  496. contents: aString
  497. self codeWidget contents: aString
  498. !
  499. model
  500. ^ model
  501. !
  502. model: aBrowserModel
  503. model := aBrowserModel.
  504. self observeModel
  505. ! !
  506. !HLBrowserSourceWidget methodsFor: 'actions'!
  507. observeModel
  508. self model announcer on: HLMethodSelected do: [ :ann |
  509. self onMethodSelected: ann item ].
  510. self model announcer on: HLClassSelected do: [ :ann |
  511. self onClassSelected: ann item ].
  512. self model announcer on: HLProtocolSelected do: [ :ann |
  513. self onProtocolSelected: ann item ]
  514. ! !
  515. !HLBrowserSourceWidget methodsFor: 'reactions'!
  516. onClassSelected: aClass
  517. aClass ifNil: [ ^ self contents: '' ].
  518. self contents: aClass definition
  519. !
  520. onMethodSelected: aCompiledMethod
  521. aCompiledMethod ifNil: [ ^ self contents: '' ].
  522. self contents: aCompiledMethod source
  523. !
  524. onProtocolSelected: aString
  525. self model selectedClass ifNil: [ ^ self contents: '' ].
  526. self contents: self model selectedClass definition
  527. ! !
  528. !HLBrowserSourceWidget methodsFor: 'rendering'!
  529. renderContentOn: html
  530. self codeWidget renderOn: html
  531. ! !
  532. !HLBrowserSourceWidget class methodsFor: 'instance creation'!
  533. on: aBrowserModel
  534. ^ self new
  535. model: aBrowserModel;
  536. yourself
  537. ! !