Helios-Browser.st 29 KB

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