Helios-Browser.st 28 KB

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