Helios-Browser.st 28 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360
  1. Smalltalk current createPackage: 'Helios-Browser'!
  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: 'actions'!
  19. focus
  20. ^ self packagesListWidget focus
  21. ! !
  22. !HLBrowser methodsFor: 'keybindings'!
  23. registerBindingsOn: aBindingGroup
  24. HLBrowserCommand
  25. registerConcreteClassesOn: aBindingGroup
  26. for: self model
  27. ! !
  28. !HLBrowser methodsFor: 'rendering'!
  29. renderContentOn: html
  30. html with: (HLContainer with: (HLHorizontalSplitter
  31. with: (HLVerticalSplitter
  32. with: (HLVerticalSplitter
  33. with: self packagesListWidget
  34. with: self classesListWidget)
  35. with: (HLVerticalSplitter
  36. with: self protocolsListWidget
  37. with: self methodsListWidget))
  38. with: self sourceWidget)).
  39. self packagesListWidget focus
  40. ! !
  41. !HLBrowser methodsFor: 'testing'!
  42. canHaveFocus
  43. ^ true
  44. ! !
  45. !HLBrowser methodsFor: 'widgets'!
  46. classesListWidget
  47. ^ classesListWidget ifNil: [
  48. classesListWidget := HLClassesListWidget on: self model.
  49. classesListWidget next: self protocolsListWidget ]
  50. !
  51. methodsListWidget
  52. ^ methodsListWidget ifNil: [
  53. methodsListWidget := HLMethodsListWidget on: self model ]
  54. !
  55. packagesListWidget
  56. ^ packagesListWidget ifNil: [
  57. packagesListWidget := HLPackagesListWidget on: self model.
  58. packagesListWidget next: self classesListWidget ]
  59. !
  60. protocolsListWidget
  61. ^ protocolsListWidget ifNil: [
  62. protocolsListWidget := HLProtocolsListWidget on: self model.
  63. protocolsListWidget next: self methodsListWidget ]
  64. !
  65. sourceWidget
  66. ^ sourceWidget ifNil: [
  67. sourceWidget := HLBrowserSourceWidget on: self model ]
  68. ! !
  69. HLBrowser class instanceVariableNames: 'nextId'!
  70. !HLBrowser class methodsFor: 'accessing'!
  71. nextId
  72. nextId ifNil: [ nextId := 0 ].
  73. ^ 'browser_', (nextId + 1) asString
  74. !
  75. tabLabel
  76. ^ 'Browser'
  77. !
  78. tabPriority
  79. ^ 0
  80. ! !
  81. !HLBrowser class methodsFor: 'testing'!
  82. canBeOpenAsTab
  83. ^ true
  84. ! !
  85. HLNavigationListWidget subclass: #HLBrowserListWidget
  86. instanceVariableNames: 'model'
  87. package: 'Helios-Browser'!
  88. !HLBrowserListWidget methodsFor: 'accessing'!
  89. model
  90. ^ model
  91. !
  92. model: aBrowserModel
  93. model := aBrowserModel.
  94. self observeModel
  95. ! !
  96. !HLBrowserListWidget methodsFor: 'actions'!
  97. observeModel
  98. !
  99. observeSystem
  100. ! !
  101. !HLBrowserListWidget methodsFor: 'initialization'!
  102. initialize
  103. super initialize.
  104. self observeSystem
  105. ! !
  106. !HLBrowserListWidget class methodsFor: 'instance creation'!
  107. on: aModel
  108. ^ self new
  109. model: aModel;
  110. yourself
  111. ! !
  112. HLBrowserListWidget subclass: #HLClassesListWidget
  113. instanceVariableNames: ''
  114. package: 'Helios-Browser'!
  115. !HLClassesListWidget methodsFor: 'accessing'!
  116. getChildrenOf: aClass
  117. ^ self items select: [ :each | each superclass = aClass ]
  118. !
  119. getRootClassesOf: aCollection
  120. ^ aCollection select: [ :each |
  121. (aCollection includes: each superclass) not ]
  122. !
  123. iconForItem: aClass
  124. ^ aClass theNonMetaClass comment isEmpty
  125. ifFalse: [ 'icon-none' ]
  126. ifTrue: [ 'icon-question-sign' ]
  127. !
  128. showInstance
  129. ^ self model showInstance
  130. ! !
  131. !HLClassesListWidget methodsFor: 'actions'!
  132. focusMethodsListWidget
  133. self model announcer announce: HLMethodsListFocus new
  134. !
  135. focusProtocolsListWidget
  136. self model announcer announce: HLProtocolsListFocus new
  137. !
  138. observeModel
  139. self model announcer
  140. on: HLPackageSelected do: [ :ann | self onPackageSelected: ann item ];
  141. on: HLShowInstanceToggled do: [ :ann | self onShowInstanceToggled ];
  142. on: HLClassSelected do: [ :ann | self onClassSelected: ann item ];
  143. on: HLClassesFocusRequested do: [ :ann | self onClassesFocusRequested ]
  144. !
  145. observeSystem
  146. SystemAnnouncer current
  147. on: ClassAdded
  148. do: [ :ann | self onClassAdded: ann theClass ];
  149. on: ClassRemoved
  150. do: [ :ann | self onClassRemoved: ann theClass ]
  151. !
  152. selectItem: aClass
  153. self model selectedClass: aClass
  154. !
  155. showInstance: aBoolean
  156. self model showInstance: aBoolean
  157. ! !
  158. !HLClassesListWidget methodsFor: 'private'!
  159. setItemsForPackage: aPackage
  160. self items: (aPackage
  161. ifNil: [ #() ]
  162. ifNotNil: [ ((aPackage classes
  163. collect: [ :each | each theNonMetaClass ]) asSet asArray)
  164. sort: [:a :b | a name < b name ] ]).
  165. !
  166. setItemsForSelectedPackage
  167. self setItemsForPackage: self model selectedPackage
  168. ! !
  169. !HLClassesListWidget methodsFor: 'reactions'!
  170. onClassAdded: aClass
  171. aClass package = self model selectedPackage ifFalse: [ ^ self ].
  172. self setItemsForSelectedPackage.
  173. self refresh
  174. !
  175. onClassRemoved: aClass
  176. aClass package = self model selectedPackage ifFalse: [ ^ self ].
  177. aClass = self model selectedClass ifTrue: [ self selectItem: nil ].
  178. self setItemsForSelectedPackage.
  179. self refresh
  180. !
  181. onClassSelected: aClass
  182. | selectedClass |
  183. aClass ifNil: [ ^ self ].
  184. selectedClass := aClass theNonMetaClass.
  185. self selectedItem: selectedClass.
  186. self hasFocus ifFalse: [
  187. self
  188. activateItem: selectedClass;
  189. focus ]
  190. !
  191. onClassesFocusRequested
  192. self focus
  193. !
  194. onPackageSelected: aPackage
  195. self selectedItem: nil.
  196. self setItemsForSelectedPackage.
  197. self refresh
  198. !
  199. onShowInstanceToggled
  200. self refresh
  201. ! !
  202. !HLClassesListWidget methodsFor: 'rendering'!
  203. renderButtonsOn: html
  204. html div
  205. class: 'btn-group';
  206. at: 'data-toggle' put: 'buttons-radio';
  207. with: [
  208. html button
  209. class: (String streamContents: [ :str |
  210. str nextPutAll: 'btn'.
  211. self showInstance ifTrue: [
  212. str nextPutAll: ' active'] ]);
  213. with: 'Instance';
  214. onClick: [ self showInstance: true ].
  215. html button
  216. class: (String streamContents: [ :str |
  217. str nextPutAll: 'btn'.
  218. self model showInstance ifFalse: [
  219. str nextPutAll: ' active'] ]);
  220. with: 'Class';
  221. onClick: [ self model showInstance: false ] ].
  222. html button
  223. class: 'btn';
  224. at: 'data-toggle' put: 'button';
  225. with: 'Comment'
  226. !
  227. renderItem: aClass level: anInteger on: html
  228. | li |
  229. li := html li.
  230. self registerMappingFrom: aClass to: li.
  231. li
  232. at: 'list-data' put: (self items indexOf: aClass);
  233. class: (self cssClassForItem: aClass);
  234. with: [
  235. html a
  236. with: [
  237. (html tag: 'i') class: (self iconForItem: aClass).
  238. self renderItemLabel: aClass level: anInteger on: html ];
  239. onClick: [
  240. self activateListItem: li asJQuery ] ].
  241. (self getChildrenOf: aClass) do: [ :each |
  242. self renderItem: each level: anInteger + 1 on: html ]
  243. !
  244. renderItem: aClass on: html
  245. super renderItem: aClass on: html.
  246. (self getChildrenOf: aClass) do: [ :each |
  247. self renderItem: each level: 1 on: html ]
  248. !
  249. renderItemLabel: aClass level: anInteger on: html
  250. html span asJQuery html: (String streamContents: [ :str |
  251. anInteger timesRepeat: [
  252. str nextPutAll: '&nbsp;&nbsp;&nbsp;&nbsp;'].
  253. str nextPutAll: aClass name ])
  254. !
  255. renderItemLabel: aClass on: html
  256. self renderItemLabel: aClass level: 0 on: html
  257. !
  258. renderListOn: html
  259. (self getRootClassesOf: self items)
  260. do: [ :each | self renderItem: each on: html ]
  261. ! !
  262. HLBrowserListWidget subclass: #HLMethodsListWidget
  263. instanceVariableNames: ''
  264. package: 'Helios-Browser'!
  265. !HLMethodsListWidget methodsFor: 'accessing'!
  266. allProtocol
  267. ^ self model allProtocol
  268. !
  269. iconForItem: aSelector
  270. | override overriden method |
  271. method := self methodForSelector: aSelector.
  272. override := self isOverride: method.
  273. overriden := self isOverridden: method.
  274. ^ override
  275. ifTrue: [ overriden
  276. ifTrue: [ 'icon-resize-vertical' ]
  277. ifFalse: [ 'icon-arrow-up' ] ]
  278. ifFalse: [
  279. overriden
  280. ifTrue: [ 'icon-arrow-down' ]
  281. ifFalse: [ 'icon-none' ] ]
  282. !
  283. methodForSelector: aSelector
  284. ^ self model selectedClass
  285. methodDictionary at: aSelector
  286. !
  287. methodsInProtocol: aString
  288. self model selectedClass ifNil: [ ^ #() ].
  289. ^ aString = self allProtocol
  290. ifTrue: [ self model selectedClass methods ]
  291. ifFalse: [ self model selectedClass methodsInProtocol: aString ]
  292. !
  293. overrideSelectors
  294. ^ self selectorsCache
  295. at: 'override'
  296. ifAbsentPut: [
  297. self model selectedClass allSuperclasses
  298. inject: Set new into: [ :acc :each | acc addAll: each selectors; yourself ] ]
  299. !
  300. overridenSelectors
  301. ^ self selectorsCache
  302. at: 'overriden'
  303. ifAbsentPut: [
  304. self model selectedClass allSubclasses
  305. inject: Set new into: [ :acc :each | acc addAll: each selectors; yourself ] ]
  306. !
  307. selectorsCache
  308. ^ self class selectorsCache
  309. !
  310. selectorsInProtocol: aString
  311. ^ (self methodsInProtocol: aString)
  312. collect: [ :each | each selector ]
  313. ! !
  314. !HLMethodsListWidget methodsFor: 'actions'!
  315. observeModel
  316. self model announcer
  317. on: HLProtocolSelected
  318. do: [ :ann | self onProtocolSelected: ann item ];
  319. on: HLShowInstanceToggled
  320. do: [ :ann | self onProtocolSelected: nil ];
  321. on: HLMethodSelected
  322. do: [ :ann | self onMethodSelected: ann item ];
  323. on: HLMethodsFocusRequested
  324. do: [ :ann | self onMethodsFocusRequested ]
  325. !
  326. observeSystem
  327. SystemAnnouncer current
  328. on: ProtocolAdded
  329. do: [ :ann | self onProtocolAdded: ann theClass ];
  330. on: ProtocolRemoved
  331. do: [ :ann | self onProtocolRemoved: ann theClass ];
  332. on: MethodAdded
  333. do: [ :ann | self onMethodAdded: ann method ];
  334. on: MethodRemoved
  335. do: [ :ann | self onMethodRemoved: ann method ]
  336. !
  337. selectItem: aSelector
  338. aSelector ifNil: [ ^ self model selectedMethod: nil ].
  339. self model selectedMethod: (self methodForSelector: aSelector)
  340. ! !
  341. !HLMethodsListWidget methodsFor: 'cache'!
  342. flushSelectorsCache
  343. selectorsCache := Dictionary new
  344. ! !
  345. !HLMethodsListWidget methodsFor: 'initialization'!
  346. initialize
  347. super initialize.
  348. self flushSelectorsCache
  349. ! !
  350. !HLMethodsListWidget methodsFor: 'private'!
  351. setItemsForProtocol: aString
  352. ^ self items: (aString
  353. ifNil: [ #() ]
  354. ifNotNil: [ self selectorsInProtocol: aString ])
  355. !
  356. setItemsForSelectedProtocol
  357. self setItemsForProtocol: self model selectedProtocol
  358. ! !
  359. !HLMethodsListWidget methodsFor: 'reactions'!
  360. onMethodAdded: aMethod
  361. self model selectedClass = aMethod methodClass ifFalse: [ ^ self ].
  362. self setItemsForSelectedProtocol.
  363. self refresh
  364. !
  365. onMethodRemoved: aMethod
  366. self items detect: [ :each | each = aMethod selector ] ifNone: [ ^ self ].
  367. self selectedItem ifNotNil: [
  368. (aMethod methodClass = self model selectedClass and: [ aMethod selector = self selectedItem selector ])
  369. ifTrue: [ self selectItem: nil ] ].
  370. self setItemsForSelectedProtocol.
  371. self refresh
  372. !
  373. onMethodSelected: aMethod
  374. self selectedItem: aMethod.
  375. aMethod ifNil: [ ^ self ].
  376. self hasFocus ifFalse: [
  377. self
  378. activateItem: aMethod;
  379. focus ]
  380. !
  381. onMethodsFocusRequested
  382. self focus
  383. !
  384. onProtocolAdded: aClass
  385. self model selectedClass = aClass ifFalse: [ ^ self ].
  386. self setItemsForSelectedProtocol.
  387. self refresh.
  388. self focus
  389. !
  390. onProtocolRemoved: aClass
  391. self model selectedClass = aClass ifFalse: [ ^ self ].
  392. self setItemsForSelectedProtocol.
  393. self refresh.
  394. self focus
  395. !
  396. onProtocolSelected: aString
  397. self selectedItem: nil.
  398. self setItemsForSelectedProtocol.
  399. self refresh
  400. ! !
  401. !HLMethodsListWidget methodsFor: 'rendering'!
  402. renderContentOn: html
  403. self model showInstance
  404. ifFalse: [ html div
  405. class: 'class_side';
  406. with: [ super renderContentOn: html ] ]
  407. ifTrue: [ super renderContentOn: html ]
  408. !
  409. renderItemLabel: aSelector on: html
  410. html with: aSelector
  411. ! !
  412. !HLMethodsListWidget methodsFor: 'testing'!
  413. isOverridden: aMethod
  414. ^ self selectorsCache isOverridden: aMethod
  415. !
  416. isOverride: aMethod
  417. ^ self selectorsCache isOverride: aMethod
  418. ! !
  419. HLMethodsListWidget class instanceVariableNames: 'selectorsCache'!
  420. !HLMethodsListWidget class methodsFor: 'accessing'!
  421. selectorsCache
  422. ^ HLSelectorsCache current
  423. ! !
  424. HLBrowserListWidget subclass: #HLPackagesListWidget
  425. instanceVariableNames: ''
  426. package: 'Helios-Browser'!
  427. !HLPackagesListWidget methodsFor: 'accessing'!
  428. initializeItems
  429. ^ items := self model packages sort:[:a :b|
  430. a name < b name]
  431. !
  432. items
  433. ^ items ifNil: [self initializeItems]
  434. ! !
  435. !HLPackagesListWidget methodsFor: 'actions'!
  436. focusClassesListWidget
  437. self model announcer announce: HLClassesListFocus new
  438. !
  439. observeModel
  440. self model announcer
  441. on: HLPackageSelected
  442. do: [ :ann | self onPackageSelected: ann item ];
  443. on: HLPackagesFocusRequested
  444. do: [ :ann | self onPackagesFocusRequested ]
  445. !
  446. selectItem: aPackage
  447. self model selectedPackage: aPackage
  448. ! !
  449. !HLPackagesListWidget methodsFor: 'reactions'!
  450. onPackageSelected: aPackage
  451. self selectedItem: aPackage.
  452. self hasFocus ifFalse: [
  453. self
  454. activateItem: aPackage;
  455. focus ]
  456. !
  457. onPackagesFocusRequested
  458. self focus
  459. ! !
  460. !HLPackagesListWidget methodsFor: 'rendering'!
  461. renderButtonsOn: html
  462. html span class: 'info'; with: 'Auto commit'.
  463. html div
  464. class: 'btn-group switch';
  465. at: 'data-toggle' put: 'buttons-radio';
  466. with: [
  467. html button
  468. class: (String streamContents: [ :str |
  469. str nextPutAll: 'btn' ]);
  470. with: 'On'.
  471. html button
  472. class: (String streamContents: [ :str |
  473. str nextPutAll: 'btn active' ]);
  474. with: 'Off' ].
  475. html a
  476. class: 'btn';
  477. with: 'Commit'.
  478. ! !
  479. HLBrowserListWidget subclass: #HLProtocolsListWidget
  480. instanceVariableNames: ''
  481. package: 'Helios-Browser'!
  482. !HLProtocolsListWidget methodsFor: 'accessing'!
  483. allProtocol
  484. ^ self model allProtocol
  485. !
  486. selectedItem
  487. ^ super selectedItem" ifNil: [ self allProtocol ]"
  488. ! !
  489. !HLProtocolsListWidget methodsFor: 'actions'!
  490. observeModel
  491. self model announcer
  492. on: HLClassSelected
  493. do: [ :ann | self onClassSelected: ann item ];
  494. on: HLShowInstanceToggled
  495. do: [ :ann | self onClassSelected: self model selectedClass ];
  496. on: HLProtocolSelected
  497. do: [ :ann | self onProtocolSelected: ann item ];
  498. on: HLProtocolsFocusRequested
  499. do: [ :ann | self onProtocolsFocusRequested ]
  500. !
  501. observeSystem
  502. SystemAnnouncer current
  503. on: ProtocolAdded
  504. do: [ :ann | self onProtocolAdded: ann protocol to: ann theClass ];
  505. on: ProtocolRemoved
  506. do: [ :ann | self onProtocolRemoved: ann protocol from: ann theClass ]
  507. !
  508. selectItem: aString
  509. self model selectedProtocol: aString
  510. ! !
  511. !HLProtocolsListWidget methodsFor: 'private'!
  512. setItemsForClass: aClass
  513. self items: (aClass
  514. ifNil: [ Array with: self allProtocol ]
  515. ifNotNil: [
  516. (Array with: self allProtocol)
  517. addAll: aClass protocols;
  518. yourself ])
  519. !
  520. setItemsForSelectedClass
  521. self setItemsForClass: self model selectedClass
  522. ! !
  523. !HLProtocolsListWidget methodsFor: 'reactions'!
  524. onClassSelected: aClass
  525. self selectedItem: nil.
  526. self setItemsForSelectedClass.
  527. self refresh
  528. !
  529. onProtocolAdded: aString to: aClass
  530. aClass = self model selectedClass ifFalse: [ ^ self ].
  531. self setItemsForSelectedClass.
  532. self refresh
  533. !
  534. onProtocolRemoved: aString from: aClass
  535. aClass = self model selectedClass ifFalse: [ ^ self ].
  536. self model selectedProtocol = aString
  537. ifTrue: [ self selectItem: nil ].
  538. self setItemsForSelectedClass.
  539. self refresh
  540. !
  541. onProtocolSelected: aString
  542. self selectedItem: aString.
  543. aString ifNil: [ ^ self ].
  544. self hasFocus ifFalse: [
  545. self
  546. activateItem: aString;
  547. focus ]
  548. !
  549. onProtocolsFocusRequested
  550. self focus
  551. ! !
  552. !HLProtocolsListWidget methodsFor: 'rendering'!
  553. renderContentOn: html
  554. self model showInstance
  555. ifFalse: [ html div
  556. class: 'class_side';
  557. with: [ super renderContentOn: html ] ]
  558. ifTrue: [ super renderContentOn: html ]
  559. ! !
  560. Object subclass: #HLBrowserModel
  561. instanceVariableNames: 'announcer environment selectedPackage selectedClass selectedProtocol selectedSelector showInstance showComment'
  562. package: 'Helios-Browser'!
  563. !HLBrowserModel methodsFor: 'accessing'!
  564. announcer
  565. ^ announcer ifNil: [ announcer := Announcer new ]
  566. !
  567. availableClassNames
  568. ^ self environment availableClassNames
  569. !
  570. availableProtocols
  571. ^ self environment availableProtocolsFor: self selectedClass
  572. !
  573. environment
  574. ^ environment ifNil: [ HLManager current environment ]
  575. !
  576. environment: anEnvironment
  577. environment := anEnvironment
  578. !
  579. handleUnkownVariableError: anError
  580. self announcer announce: (HLUnknownVariableErrorRaised new
  581. error: anError;
  582. yourself)
  583. !
  584. manager
  585. ^ HLManager current
  586. !
  587. packages
  588. ^ self environment packages
  589. !
  590. selectedClass
  591. ^ selectedClass
  592. !
  593. selectedClass: aClass
  594. selectedClass = aClass ifTrue: [
  595. aClass ifNil: [ ^ self ].
  596. self selectedProtocol: nil ].
  597. aClass
  598. ifNil: [ selectedClass := nil ]
  599. ifNotNil: [
  600. self showInstance
  601. ifTrue: [ selectedClass := aClass theNonMetaClass ]
  602. ifFalse: [ selectedClass := aClass theMetaClass ] ].
  603. self selectedProtocol: nil.
  604. self announcer announce: (HLClassSelected on: self selectedClass)
  605. !
  606. selectedMethod
  607. ^ self selectedClass ifNotNil: [
  608. self selectedClass methodDictionary
  609. at: selectedSelector
  610. ifAbsent: [ nil ] ]
  611. !
  612. selectedMethod: aCompiledMethod
  613. selectedSelector = aCompiledMethod ifTrue: [ ^ self ].
  614. aCompiledMethod
  615. ifNil: [ selectedSelector := nil ]
  616. ifNotNil: [
  617. selectedSelector = aCompiledMethod selector ifTrue: [ ^ self ].
  618. selectedSelector := aCompiledMethod selector ].
  619. self announcer announce: (HLMethodSelected on: aCompiledMethod)
  620. !
  621. selectedPackage
  622. ^ selectedPackage
  623. !
  624. selectedPackage: aPackage
  625. selectedPackage = aPackage ifTrue: [ ^ self ].
  626. selectedPackage := aPackage.
  627. self selectedClass: nil.
  628. self announcer announce: (HLPackageSelected on: aPackage)
  629. !
  630. selectedProtocol
  631. ^ selectedProtocol
  632. !
  633. selectedProtocol: aString
  634. selectedProtocol = aString ifTrue: [ ^ self ].
  635. selectedProtocol := aString.
  636. self selectedMethod: nil.
  637. self announcer announce: (HLProtocolSelected on: aString)
  638. !
  639. showComment
  640. ^ showComment ifNil: [ false ]
  641. !
  642. showComment: aBoolean
  643. showComment := aBoolean.
  644. self announcer announce: HLShowCommentToggled new
  645. !
  646. showInstance
  647. ^ showInstance ifNil: [ true ]
  648. !
  649. showInstance: aBoolean
  650. showInstance := aBoolean.
  651. self selectedClass ifNotNil: [
  652. self selectedClass: (aBoolean
  653. ifTrue: [self selectedClass theNonMetaClass ]
  654. ifFalse: [ self selectedClass theMetaClass ]) ].
  655. self announcer announce: HLShowInstanceToggled new
  656. ! !
  657. !HLBrowserModel methodsFor: 'actions'!
  658. addInstVarNamed: aString
  659. self environment addInstVarNamed: aString to: self selectedClass.
  660. self announcer announce: (HLInstVarAdded new
  661. theClass: self selectedClass;
  662. variableName: aString;
  663. yourself)
  664. !
  665. focusOnClasses
  666. self announcer announce: HLClassesFocusRequested new
  667. !
  668. focusOnMethods
  669. self announcer announce: HLMethodsFocusRequested new
  670. !
  671. focusOnPackages
  672. self announcer announce: HLPackagesFocusRequested new
  673. !
  674. focusOnProtocols
  675. self announcer announce: HLProtocolsFocusRequested new
  676. !
  677. focusOnSourceCode
  678. self announcer announce: HLSourceCodeFocusRequested new
  679. !
  680. save: aString
  681. (self shouldCompileClassDefinition: aString)
  682. ifTrue: [ self compileClassDefinition: aString ]
  683. ifFalse: [ self compileMethod: aString ]
  684. !
  685. saveSourceCode
  686. self announcer announce: HLSaveSourceCode new
  687. ! !
  688. !HLBrowserModel methodsFor: 'commands actions'!
  689. commitPackage
  690. self environment commitPackage: self selectedPackage
  691. !
  692. moveMethodToClass: aClassName
  693. self environment
  694. moveMethod: self selectedMethod
  695. toClass: aClassName
  696. !
  697. moveMethodToProtocol: aProtocol
  698. self environment moveMethod: self selectedMethod toProtocol: aProtocol
  699. !
  700. openClassNamed: aString
  701. | class |
  702. class := self environment classNamed: aString.
  703. self selectedPackage: class package.
  704. self selectedClass: class
  705. !
  706. removeMethod
  707. (self manager confirm: 'Do you REALLY want to remove method ', self selectedMethod methodClass name,' >> #', self selectedMethod selector)
  708. ifTrue: [ self environment removeMethod: self selectedMethod ]
  709. ! !
  710. !HLBrowserModel methodsFor: 'compiling'!
  711. compileClassComment: aString
  712. self environment
  713. compileClassComment: aString
  714. for: self selectedClass
  715. !
  716. compileClassDefinition: aString
  717. self environment compileClassDefinition: aString
  718. !
  719. compileMethod: aString
  720. self withCompileErrorHandling: [ self environment
  721. compileMethod: aString
  722. for: self selectedClass
  723. protocol: self compilationProtocol ]
  724. ! !
  725. !HLBrowserModel methodsFor: 'defaults'!
  726. allProtocol
  727. ^ '-- all --'
  728. !
  729. unclassifiedProtocol
  730. ^ 'as yet unclassified'
  731. ! !
  732. !HLBrowserModel methodsFor: 'error handling'!
  733. handleCompileError: anError
  734. self announcer announce: (HLCompileErrorRaised new
  735. error: anError;
  736. yourself)
  737. !
  738. handleParseError: anError
  739. | split line column messageToInsert |
  740. split := anError messageText tokenize: ' : '.
  741. messageToInsert := split second.
  742. "21 = 'Parse error on line ' size + 1"
  743. split := split first copyFrom: 21 to: split first size.
  744. split := split tokenize: ' column '.
  745. line := split first.
  746. column := split second.
  747. self announcer announce: (HLParseErrorRaised new
  748. line: line asNumber;
  749. column: column asNumber;
  750. message: messageToInsert;
  751. error: anError;
  752. yourself)
  753. !
  754. withCompileErrorHandling: aBlock
  755. [
  756. [
  757. aBlock
  758. on: ParseError
  759. do: [:ex | self handleParseError: ex ]
  760. ]
  761. on: UnknownVariableError
  762. do: [ :ex | self handleUnkownVariableError: ex ]
  763. ]
  764. on: CompilerError
  765. do: [ :ex | self handleCompileError: ex ]
  766. ! !
  767. !HLBrowserModel methodsFor: 'private'!
  768. compilationProtocol
  769. | currentProtocol |
  770. currentProtocol := self selectedProtocol.
  771. currentProtocol ifNil: [ currentProtocol := self unclassifiedProtocol ].
  772. self selectedMethod ifNotNil: [ currentProtocol := self selectedMethod protocol ].
  773. ^ currentProtocol = self allProtocol
  774. ifTrue: [ self unclassifiedProtocol ]
  775. ifFalse: [ currentProtocol ]
  776. ! !
  777. !HLBrowserModel methodsFor: 'testing'!
  778. shouldCompileClassDefinition: aString
  779. ^ self selectedClass isNil or: [
  780. aString first asUppercase = aString first ]
  781. ! !
  782. !HLBrowserModel class methodsFor: 'actions'!
  783. on: anEnvironment
  784. ^ self new
  785. environment: anEnvironment;
  786. yourself
  787. ! !
  788. HLWidget subclass: #HLBrowserSourceWidget
  789. instanceVariableNames: 'model methodContents codeWidget'
  790. package: 'Helios-Browser'!
  791. !HLBrowserSourceWidget methodsFor: 'accessing'!
  792. codeWidget
  793. ^ codeWidget ifNil: [ codeWidget := HLSourceCodeWidget on: self model ]
  794. !
  795. contents
  796. ^ self codeWidget contents
  797. !
  798. contents: aString
  799. self methodContents: aString.
  800. self codeWidget contents: aString
  801. !
  802. methodContents
  803. ^ methodContents ifNil: [ methodContents := '' ]
  804. !
  805. methodContents: aString
  806. methodContents := aString
  807. !
  808. model
  809. ^ model
  810. !
  811. model: aBrowserModel
  812. model := aBrowserModel.
  813. self observeModel
  814. ! !
  815. !HLBrowserSourceWidget methodsFor: 'actions'!
  816. focus
  817. self codeWidget focus
  818. !
  819. observeModel
  820. self model announcer
  821. on: HLMethodSelected
  822. do: [ :ann | self onMethodSelected: ann item ];
  823. on: HLClassSelected
  824. do: [ :ann | self onClassSelected: ann item ];
  825. on: HLProtocolSelected
  826. do: [ :ann | self onProtocolSelected: ann item ];
  827. on: HLSourceCodeFocusRequested
  828. do: [ :ann | self onSourceCodeFocusRequested ]
  829. !
  830. observeSystem
  831. SystemAnnouncer current
  832. on: MethodModified
  833. do: [ :ann | self onMethodModified: ann method ]
  834. ! !
  835. !HLBrowserSourceWidget methodsFor: 'initialization'!
  836. initialize
  837. super initialize.
  838. self observeSystem
  839. ! !
  840. !HLBrowserSourceWidget methodsFor: 'reactions'!
  841. onClassSelected: aClass
  842. aClass ifNil: [ ^ self contents: '' ].
  843. self contents: aClass definition
  844. !
  845. onMethodModified: aMethod
  846. self model selectedClass = aMethod methodClass ifFalse: [ ^ self ].
  847. self model selectedMethod ifNil: [ ^ self ].
  848. self model selectedMethod selector = aMethod selector ifFalse: [ ^ self ].
  849. self refresh
  850. !
  851. onMethodSelected: aCompiledMethod
  852. aCompiledMethod ifNil: [ ^ self contents: '' ].
  853. self contents: aCompiledMethod source
  854. !
  855. onProtocolSelected: aString
  856. self model selectedClass ifNil: [ ^ self contents: '' ].
  857. self contents: self model selectedClass definition
  858. !
  859. onSourceCodeFocusRequested
  860. self focus
  861. ! !
  862. !HLBrowserSourceWidget methodsFor: 'rendering'!
  863. renderContentOn: html
  864. self codeWidget renderOn: html
  865. ! !
  866. !HLBrowserSourceWidget methodsFor: 'testing'!
  867. hasFocus
  868. ^ self codeWidget hasFocus
  869. !
  870. hasModification
  871. ^ (self methodContents = self contents) not
  872. ! !
  873. !HLBrowserSourceWidget methodsFor: 'updating'!
  874. refresh
  875. self hasModification ifTrue: [ ^ self ].
  876. self hasFocus ifTrue: [ ^ self ].
  877. self contents: self model selectedMethod source
  878. ! !
  879. !HLBrowserSourceWidget class methodsFor: 'instance creation'!
  880. on: aBrowserModel
  881. ^ self new
  882. model: aBrowserModel;
  883. yourself
  884. ! !
  885. Object subclass: #HLClassCache
  886. instanceVariableNames: 'class selectorsCache overrideCache overriddenCache'
  887. package: 'Helios-Browser'!
  888. !HLClassCache methodsFor: 'accessing'!
  889. overriddenCache
  890. ^ overriddenCache ifNil: [ overriddenCache := HashedCollection new ]
  891. !
  892. overrideCache
  893. ^ overrideCache ifNil: [ overrideCache := HashedCollection new ]
  894. !
  895. selectorsCache
  896. ^ selectorsCache
  897. !
  898. selectorsCache: aCache
  899. selectorsCache := aCache
  900. !
  901. theClass
  902. ^ class
  903. !
  904. theClass: aClass
  905. class := aClass
  906. ! !
  907. !HLClassCache methodsFor: 'actions'!
  908. invalidateChildrenSelector: aSelector
  909. self theClass subclasses do: [ :each |
  910. (self selectorsCache cacheFor: each)
  911. removeSelector: aSelector;
  912. invalidateChildrenSelector: aSelector ]
  913. !
  914. invalidateParentSelector: aSelector
  915. self theClass superclass ifNotNil: [
  916. (self selectorsCache cacheFor: self theClass superclass)
  917. removeSelector: aSelector;
  918. invalidateParentSelector: aSelector ]
  919. !
  920. invalidateSelector: aSelector
  921. self
  922. invalidateParentSelector: aSelector;
  923. invalidateChildrenSelector: aSelector;
  924. removeSelector: aSelector
  925. ! !
  926. !HLClassCache methodsFor: 'private'!
  927. removeSelector: aSelector
  928. self overriddenCache
  929. removeKey: aSelector
  930. ifAbsent: [ ].
  931. self overrideCache
  932. removeKey: aSelector
  933. ifAbsent: [ ]
  934. ! !
  935. !HLClassCache methodsFor: 'testing'!
  936. isOverridden: aMethod
  937. ^ self overriddenCache
  938. at: aMethod selector
  939. ifAbsentPut: [ aMethod isOverridden ]
  940. !
  941. isOverride: aMethod
  942. ^ self overrideCache
  943. at: aMethod selector
  944. ifAbsentPut: [ aMethod isOverride ]
  945. ! !
  946. !HLClassCache class methodsFor: 'instance creation'!
  947. on: aClass selectorsCache: aSelectorsCache
  948. ^ self new
  949. theClass: aClass;
  950. selectorsCache: aSelectorsCache;
  951. yourself
  952. ! !
  953. Object subclass: #HLSelectorsCache
  954. instanceVariableNames: 'classesCache'
  955. package: 'Helios-Browser'!
  956. !HLSelectorsCache methodsFor: 'accessing'!
  957. cacheFor: aClass
  958. aClass ifNil: [ ^ nil ].
  959. ^ self classesCache
  960. at: aClass name
  961. ifAbsentPut: [ self newCacheFor: aClass ]
  962. !
  963. classesCache
  964. ^ classesCache ifNil: [ classesCache := HashedCollection new ]
  965. ! !
  966. !HLSelectorsCache methodsFor: 'actions'!
  967. observeSystem
  968. SystemAnnouncer current
  969. on: MethodAdded
  970. do: [ :ann | self onMethodAdded: ann method ];
  971. on: MethodRemoved
  972. do: [ :ann | self onMethodRemoved: ann method ]
  973. ! !
  974. !HLSelectorsCache methodsFor: 'factory'!
  975. newCacheFor: aClass
  976. ^ HLClassCache
  977. on: aClass
  978. selectorsCache: self
  979. ! !
  980. !HLSelectorsCache methodsFor: 'initialization'!
  981. initialize
  982. super initialize.
  983. self observeSystem
  984. ! !
  985. !HLSelectorsCache methodsFor: 'private'!
  986. invalidateCacheFor: aMethod
  987. (self cacheFor: aMethod methodClass)
  988. invalidateSelector: aMethod selector
  989. ! !
  990. !HLSelectorsCache methodsFor: 'reactions'!
  991. onMethodAdded: aMethod
  992. self invalidateCacheFor: aMethod
  993. !
  994. onMethodRemoved: aMethod
  995. self invalidateCacheFor: aMethod
  996. ! !
  997. !HLSelectorsCache methodsFor: 'testing'!
  998. isOverridden: aMethod
  999. ^ (self cacheFor: aMethod methodClass)
  1000. isOverridden: aMethod
  1001. !
  1002. isOverride: aMethod
  1003. ^ (self cacheFor: aMethod methodClass)
  1004. isOverride: aMethod
  1005. ! !
  1006. HLSelectorsCache class instanceVariableNames: 'current'!
  1007. !HLSelectorsCache class methodsFor: 'accessing'!
  1008. current
  1009. ^ current ifNil: [ current := super new ]
  1010. !
  1011. flush
  1012. current := nil
  1013. ! !
  1014. !HLSelectorsCache class methodsFor: 'instance creation'!
  1015. new
  1016. self shouldNotImplement
  1017. ! !
  1018. !CompiledMethod methodsFor: '*Helios-Browser'!
  1019. isOverridden
  1020. | selector |
  1021. selector := self selector.
  1022. self methodClass allSubclassesDo: [ :each |
  1023. (each includesSelector: selector)
  1024. ifTrue: [ ^ true ] ].
  1025. ^ false
  1026. !
  1027. isOverride
  1028. | superclass |
  1029. superclass := self methodClass superclass.
  1030. superclass ifNil: [ ^ false ].
  1031. ^ (self methodClass superclass lookupSelector: self selector) notNil
  1032. ! !