1
0

Helios-Browser.st 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431
  1. Smalltalk current 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. self registerMappingFrom: aClass to: li.
  491. li
  492. at: 'list-data' put: (self items indexOf: aClass);
  493. class: (self listCssClassForItem: aClass);
  494. with: [
  495. html a
  496. with: [
  497. (html tag: 'i') class: (self cssClassForItem: aClass).
  498. self renderItemLabel: aClass level: anInteger on: html ];
  499. onClick: [
  500. self activateListItem: li asJQuery ] ].
  501. (self getChildrenOf: aClass) do: [ :each |
  502. self renderItem: each level: anInteger + 1 on: html ]
  503. !
  504. renderItem: aClass on: html
  505. super renderItem: aClass on: html.
  506. (self getChildrenOf: aClass) do: [ :each |
  507. self renderItem: each level: 1 on: html ]
  508. !
  509. renderItemLabel: aClass level: anInteger on: html
  510. html span asJQuery html: (String streamContents: [ :str |
  511. anInteger timesRepeat: [
  512. str nextPutAll: '&nbsp;&nbsp;&nbsp;&nbsp;'].
  513. str nextPutAll: aClass name ])
  514. !
  515. renderItemLabel: aClass on: html
  516. self renderItemLabel: aClass level: 0 on: html
  517. !
  518. renderListOn: html
  519. (self getRootClassesOf: self items)
  520. do: [ :each | self renderItem: each on: html ]
  521. ! !
  522. !HLClassesListWidget methodsFor: 'testing'!
  523. showClass
  524. ^ self model showInstance not
  525. !
  526. showComment
  527. ^ self model showComment
  528. !
  529. showInstance
  530. ^ self model showInstance
  531. ! !
  532. HLFocusableWidget subclass: #HLDocumentationWidget
  533. instanceVariableNames: 'model'
  534. package: 'Helios-Browser'!
  535. !HLDocumentationWidget commentStamp!
  536. I render the documentation for the selected class!
  537. !HLDocumentationWidget methodsFor: 'accessing'!
  538. documentation
  539. ^ self selectedItem
  540. ifNil: [ '' ]
  541. ifNotNil: [ :item | item comment ifEmpty: [ self defaultDocumentation ] ]
  542. !
  543. head
  544. ^ self selectedItem
  545. ifNil: [ self defaultHead ]
  546. ifNotNil: [ :item | item name ]
  547. !
  548. model
  549. ^ model
  550. !
  551. model: aModel
  552. model := aModel.
  553. self
  554. observeSystem;
  555. observeModel
  556. !
  557. selectedItem
  558. ^ self model selectedClass ifNotNil: [ :class | class theNonMetaClass ]
  559. ! !
  560. !HLDocumentationWidget methodsFor: 'actions'!
  561. editDocumentation
  562. self model editComment
  563. !
  564. observeModel
  565. self model announcer
  566. on: HLClassSelected
  567. send: #onClassSelected:
  568. to: self;
  569. on: HLEditComment
  570. send: #onEditDocumentation
  571. to: self
  572. !
  573. observeSystem
  574. self model systemAnnouncer
  575. on: ClassCommentChanged
  576. send: #onClassCommentChanged:
  577. to: self
  578. !
  579. selectClass: aClass
  580. self model selectedClass: aClass
  581. !
  582. unregister
  583. super unregister.
  584. self model announcer unregister: self
  585. ! !
  586. !HLDocumentationWidget methodsFor: 'defaults'!
  587. defaultDocumentation
  588. ^ 'No documentation available.
  589. **That''s bad. Seriously.**'
  590. !
  591. defaultHead
  592. ^ 'No class selected'
  593. ! !
  594. !HLDocumentationWidget methodsFor: 'reactions'!
  595. onClassCommentChanged: anAnnouncement
  596. anAnnouncement theClass = self model selectedClass theNonMetaClass
  597. ifTrue: [ self refresh ]
  598. !
  599. onClassSelected: anAnnouncement
  600. self refresh
  601. !
  602. onEditDocumentation
  603. self
  604. request: self model selectedClass theNonMetaClass name, ' comment'
  605. value: self model selectedClass theNonMetaClass comment
  606. do: [ :comment | self setClassComment: comment ]
  607. !
  608. setClassComment: aString
  609. self model setClassComment: aString
  610. ! !
  611. !HLDocumentationWidget methodsFor: 'rendering'!
  612. renderContentOn: html
  613. html div
  614. class: 'doc';
  615. with: [
  616. self
  617. renderHeadOn: html;
  618. renderDocOn: html ]
  619. !
  620. renderDocOn: html
  621. self selectedItem ifNotNil: [
  622. self renderInheritanceOn: html.
  623. html h1
  624. with: 'Overview';
  625. with: [
  626. html button
  627. class: 'button default';
  628. with: 'Edit';
  629. onClick: [ self editDocumentation ] ].
  630. (html div
  631. class: 'markdown';
  632. asJQuery) html: ((Showdown at: 'converter') new makeHtml: self documentation) ]
  633. !
  634. renderHeadOn: html
  635. html div
  636. class: 'head';
  637. with: self head
  638. !
  639. renderInheritanceOn: html
  640. html div
  641. class: 'inheritance';
  642. with: [
  643. html with: 'Subclass of '.
  644. self selectedItem superclass
  645. ifNil: [ html em with: 'nil' ]
  646. ifNotNil: [
  647. html a
  648. with: self selectedItem superclass name;
  649. onClick: [ self selectClass: self selectedItem superclass ] ] ]
  650. ! !
  651. HLToolListWidget subclass: #HLMethodsListWidget
  652. instanceVariableNames: 'selectorsCache'
  653. package: 'Helios-Browser'!
  654. !HLMethodsListWidget commentStamp!
  655. I render a list of methods for the selected protocol.!
  656. !HLMethodsListWidget methodsFor: 'accessing'!
  657. allProtocol
  658. ^ self model allProtocol
  659. !
  660. cssClassForItem: aSelector
  661. | override overriden method |
  662. method := self methodForSelector: aSelector.
  663. override := self isOverride: method.
  664. overriden := self isOverridden: method.
  665. ^ override
  666. ifTrue: [ overriden
  667. ifTrue: [ 'override-overridden' ]
  668. ifFalse: [ 'override' ] ]
  669. ifFalse: [
  670. overriden
  671. ifTrue: [ 'overridden' ]
  672. ifFalse: [ '' ] ]
  673. !
  674. label
  675. ^ 'Methods'
  676. !
  677. methodForSelector: aSelector
  678. ^ self model selectedClass
  679. methodDictionary at: aSelector
  680. !
  681. methodsInProtocol: aString
  682. self model selectedClass ifNil: [ ^ #() ].
  683. ^ aString = self allProtocol
  684. ifTrue: [ self model selectedClass methods ]
  685. ifFalse: [ self model selectedClass methodsInProtocol: aString ]
  686. !
  687. overrideSelectors
  688. ^ self selectorsCache
  689. at: 'override'
  690. ifAbsentPut: [
  691. self model selectedClass allSuperclasses
  692. inject: Set new into: [ :acc :each | acc addAll: each selectors; yourself ] ]
  693. !
  694. overridenSelectors
  695. ^ self selectorsCache
  696. at: 'overriden'
  697. ifAbsentPut: [
  698. self model selectedClass allSubclasses
  699. inject: Set new into: [ :acc :each | acc addAll: each selectors; yourself ] ]
  700. !
  701. selectorsCache
  702. ^ self class selectorsCache
  703. !
  704. selectorsInProtocol: aString
  705. ^ ((self methodsInProtocol: aString)
  706. collect: [ :each | each selector ]) sorted
  707. ! !
  708. !HLMethodsListWidget methodsFor: 'actions'!
  709. observeModel
  710. self model announcer
  711. on: HLProtocolSelected
  712. send: #onProtocolSelected:
  713. to: self;
  714. on: HLShowInstanceToggled
  715. send: #onShowInstanceToggled
  716. to: self;
  717. on: HLMethodSelected
  718. send: #onMethodSelected:
  719. to: self;
  720. on: HLMethodsFocusRequested
  721. send: #onMethodsFocusRequested
  722. to: self
  723. !
  724. observeSystem
  725. self model systemAnnouncer
  726. on: ProtocolAdded
  727. send: #onProtocolAdded:
  728. to: self;
  729. on: ProtocolRemoved
  730. send: #onProtocolRemoved:
  731. to: self;
  732. on: MethodAdded
  733. send: #onMethodAdded:
  734. to: self;
  735. on: MethodRemoved
  736. send: #onMethodRemoved:
  737. to: self;
  738. on: MethodMoved
  739. send: #onMethodMoved:
  740. to: self
  741. !
  742. selectItem: aSelector
  743. aSelector ifNil: [ ^ self model selectedMethod: nil ].
  744. self model selectedMethod: (self methodForSelector: aSelector)
  745. ! !
  746. !HLMethodsListWidget methodsFor: 'private'!
  747. setItemsForProtocol: aString
  748. ^ self items: (aString
  749. ifNil: [ #() ]
  750. ifNotNil: [ self selectorsInProtocol: aString ])
  751. !
  752. setItemsForSelectedProtocol
  753. self setItemsForProtocol: self model selectedProtocol
  754. ! !
  755. !HLMethodsListWidget methodsFor: 'reactions'!
  756. onMethodAdded: anAnnouncement
  757. self model selectedClass = anAnnouncement method methodClass ifFalse: [ ^ self ].
  758. self setItemsForSelectedProtocol.
  759. self refresh
  760. !
  761. onMethodMoved: anAnnouncement
  762. self model selectedMethod = anAnnouncement method ifFalse: [ ^ self ].
  763. self model selectedProtocol = self model allProtocol ifFalse: [
  764. self
  765. selectedItem: nil;
  766. selectItem: nil;
  767. setItemsForSelectedProtocol;
  768. refresh ]
  769. !
  770. onMethodRemoved: anAnnouncement
  771. | method |
  772. method := anAnnouncement method.
  773. self items detect: [ :each | each = method selector ] ifNone: [ ^ self ].
  774. self selectedItem ifNotNil: [
  775. (method methodClass = self model selectedClass and: [ method selector = self selectedItem ])
  776. ifTrue: [
  777. self selectedItem: nil;
  778. selectItem: nil ] ].
  779. self setItemsForSelectedProtocol.
  780. self refresh
  781. !
  782. onMethodSelected: anAnnouncement
  783. | selector method |
  784. method := anAnnouncement item.
  785. selector := method isCompiledMethod
  786. ifTrue: [ method selector ]
  787. ifFalse: [ nil ].
  788. self
  789. selectedItem: selector;
  790. activateItem: selector
  791. !
  792. onMethodsFocusRequested
  793. self focus
  794. !
  795. onProtocolAdded: anAnnouncement
  796. self model selectedClass = anAnnouncement theClass ifFalse: [ ^ self ].
  797. self setItemsForSelectedProtocol.
  798. self refresh.
  799. self focus
  800. !
  801. onProtocolRemoved: anAnnouncement
  802. self model selectedClass = anAnnouncement theClass ifFalse: [ ^ self ].
  803. self setItemsForSelectedProtocol.
  804. self refresh.
  805. self focus
  806. !
  807. onProtocolSelected: anAnnouncement
  808. self selectedItem: nil.
  809. self setItemsForSelectedProtocol.
  810. self refresh
  811. !
  812. onShowInstanceToggled
  813. self onProtocolSelected: nil
  814. ! !
  815. !HLMethodsListWidget methodsFor: 'rendering'!
  816. renderContentOn: html
  817. self model showInstance
  818. ifFalse: [ html div
  819. class: 'class_side';
  820. with: [ super renderContentOn: html ] ]
  821. ifTrue: [ super renderContentOn: html ]
  822. !
  823. renderItemLabel: aSelector on: html
  824. html with: aSelector
  825. ! !
  826. !HLMethodsListWidget methodsFor: 'testing'!
  827. isOverridden: aMethod
  828. ^ self selectorsCache isOverridden: aMethod
  829. !
  830. isOverride: aMethod
  831. ^ self selectorsCache isOverride: aMethod
  832. ! !
  833. HLMethodsListWidget class instanceVariableNames: 'selectorsCache'!
  834. !HLMethodsListWidget class methodsFor: 'accessing'!
  835. selectorsCache
  836. ^ HLSelectorsCache current
  837. ! !
  838. HLToolListWidget subclass: #HLPackagesListWidget
  839. instanceVariableNames: ''
  840. package: 'Helios-Browser'!
  841. !HLPackagesListWidget commentStamp!
  842. I render a list of the system packages.!
  843. !HLPackagesListWidget methodsFor: 'accessing'!
  844. cssClassForItem: anItem
  845. ^ 'package'
  846. !
  847. items
  848. ^ items ifNil: [ self initializeItems ]
  849. !
  850. label
  851. ^ 'Packages'
  852. ! !
  853. !HLPackagesListWidget methodsFor: 'actions'!
  854. commitPackage
  855. self model commitPackage
  856. !
  857. focusClassesListWidget
  858. self model announcer announce: HLClassesListFocus new
  859. !
  860. observeModel
  861. self model announcer
  862. on: HLPackageSelected
  863. send: #onPackageSelected:
  864. to: self;
  865. on: HLPackagesFocusRequested
  866. send: #onPackagesFocusRequested
  867. to: self
  868. !
  869. observeSystem
  870. self model systemAnnouncer
  871. on: ClassAdded
  872. send: #onClassAdded:
  873. to: self.
  874. self model systemAnnouncer
  875. on: PackageAdded
  876. send: #onPackageAdded:
  877. to: self
  878. !
  879. selectItem: aPackage
  880. self model selectedPackage: aPackage
  881. ! !
  882. !HLPackagesListWidget methodsFor: 'initialization'!
  883. initializeItems
  884. ^ items := self model packages
  885. sort: [ :a :b | a name < b name ]
  886. ! !
  887. !HLPackagesListWidget methodsFor: 'reactions'!
  888. onClassAdded: anAnnouncement
  889. "Amber doesn't have yet a global organizer for packages"
  890. (self items includes: anAnnouncement theClass package) ifFalse: [
  891. self
  892. initializeItems;
  893. refresh ]
  894. !
  895. onPackageAdded: anAnnouncement
  896. self
  897. initializeItems;
  898. refresh
  899. !
  900. onPackageSelected: anAnnouncement
  901. | package |
  902. package := anAnnouncement item.
  903. self selectedItem: package.
  904. self hasFocus ifFalse: [
  905. self
  906. activateItem: package;
  907. focus ]
  908. !
  909. onPackagesFocusRequested
  910. self focus
  911. ! !
  912. !HLPackagesListWidget methodsFor: 'rendering'!
  913. renderItemLabel: aPackage on: html
  914. html with: aPackage name
  915. ! !
  916. HLToolListWidget subclass: #HLProtocolsListWidget
  917. instanceVariableNames: ''
  918. package: 'Helios-Browser'!
  919. !HLProtocolsListWidget commentStamp!
  920. I render a list of protocols for the selected class.!
  921. !HLProtocolsListWidget methodsFor: 'accessing'!
  922. allProtocol
  923. ^ self model allProtocol
  924. !
  925. cssClassForItem: anItem
  926. anItem = self allProtocol ifTrue: [ ^ '' ].
  927. anItem = 'private' ifTrue: [ ^ 'private' ].
  928. anItem = 'initialization' ifTrue: [ ^ 'initialization' ].
  929. (anItem match: '^\*') ifTrue: [ ^ 'extension' ].
  930. ^ ''
  931. !
  932. label
  933. ^ 'Protocols'
  934. !
  935. selectedItem
  936. ^ super selectedItem" ifNil: [ self allProtocol ]"
  937. ! !
  938. !HLProtocolsListWidget methodsFor: 'actions'!
  939. observeModel
  940. self model announcer
  941. on: HLClassSelected
  942. send: #onClassSelected:
  943. to: self;
  944. on: HLShowInstanceToggled
  945. send: #onClassSelected:
  946. to: self;
  947. on: HLProtocolSelected
  948. send: #onProtocolSelected:
  949. to: self;
  950. on: HLProtocolsFocusRequested
  951. send: #onProtocolsFocusRequested
  952. to: self
  953. !
  954. observeSystem
  955. self model systemAnnouncer
  956. on: ProtocolAdded
  957. send: #onProtocolAdded:
  958. to: self;
  959. on: ProtocolRemoved
  960. send: #onProtocolRemoved:
  961. to: self
  962. !
  963. selectItem: aString
  964. self model selectedProtocol: aString
  965. ! !
  966. !HLProtocolsListWidget methodsFor: 'private'!
  967. setItemsForClass: aClass
  968. self items: (aClass
  969. ifNil: [ Array with: self allProtocol ]
  970. ifNotNil: [
  971. (Array with: self allProtocol)
  972. addAll: aClass protocols;
  973. yourself ])
  974. !
  975. setItemsForSelectedClass
  976. self setItemsForClass: self model selectedClass
  977. ! !
  978. !HLProtocolsListWidget methodsFor: 'reactions'!
  979. onClassSelected: anAnnouncement
  980. self selectedItem: nil.
  981. self setItemsForSelectedClass.
  982. self refresh
  983. !
  984. onProtocolAdded: anAnnouncement
  985. | class |
  986. class := anAnnouncement theClass.
  987. class = self model selectedClass ifFalse: [ ^ self ].
  988. self setItemsForSelectedClass.
  989. self refresh
  990. !
  991. onProtocolRemoved: anAnnouncement
  992. | class protocol |
  993. class := anAnnouncement theClass.
  994. protocol := anAnnouncement protocol.
  995. class = self model selectedClass ifFalse: [ ^ self ].
  996. self model selectedProtocol = protocol
  997. ifTrue: [
  998. self
  999. selectedItem: nil;
  1000. selectItem: nil ].
  1001. self setItemsForSelectedClass.
  1002. self refresh
  1003. !
  1004. onProtocolSelected: anAnnouncement
  1005. | protocol |
  1006. protocol := anAnnouncement item.
  1007. self selectedItem: protocol.
  1008. protocol ifNil: [ ^ self ].
  1009. self hasFocus ifFalse: [
  1010. self
  1011. activateItem: protocol;
  1012. focus ]
  1013. !
  1014. onProtocolsFocusRequested
  1015. self focus
  1016. ! !
  1017. !HLProtocolsListWidget methodsFor: 'rendering'!
  1018. renderContentOn: html
  1019. self model showInstance
  1020. ifFalse: [ html div
  1021. class: 'class_side';
  1022. with: [ super renderContentOn: html ] ]
  1023. ifTrue: [ super renderContentOn: html ]
  1024. ! !
  1025. Object subclass: #HLSelectorsCache
  1026. instanceVariableNames: 'classesCache'
  1027. package: 'Helios-Browser'!
  1028. !HLSelectorsCache methodsFor: 'accessing'!
  1029. cacheFor: aClass
  1030. aClass ifNil: [ ^ nil ].
  1031. ^ self classesCache
  1032. at: aClass name
  1033. ifAbsentPut: [ self newCacheFor: aClass ]
  1034. !
  1035. classesCache
  1036. ^ classesCache ifNil: [ classesCache := HashedCollection new ]
  1037. ! !
  1038. !HLSelectorsCache methodsFor: 'actions'!
  1039. observeSystem
  1040. SystemAnnouncer current
  1041. on: MethodAdded
  1042. send: #onMethodAdded:
  1043. to: self;
  1044. on: MethodRemoved
  1045. send: #onMethodRemoved:
  1046. to: self
  1047. ! !
  1048. !HLSelectorsCache methodsFor: 'factory'!
  1049. newCacheFor: aClass
  1050. ^ HLClassCache
  1051. on: aClass
  1052. selectorsCache: self
  1053. ! !
  1054. !HLSelectorsCache methodsFor: 'initialization'!
  1055. initialize
  1056. super initialize.
  1057. self observeSystem
  1058. ! !
  1059. !HLSelectorsCache methodsFor: 'private'!
  1060. invalidateCacheFor: aMethod
  1061. (self cacheFor: aMethod methodClass)
  1062. invalidateSelector: aMethod selector
  1063. ! !
  1064. !HLSelectorsCache methodsFor: 'reactions'!
  1065. onMethodAdded: anAnnouncement
  1066. self invalidateCacheFor: anAnnouncement method
  1067. !
  1068. onMethodRemoved: anAnnouncement
  1069. self invalidateCacheFor: anAnnouncement method
  1070. ! !
  1071. !HLSelectorsCache methodsFor: 'testing'!
  1072. isOverridden: aMethod
  1073. ^ (self cacheFor: aMethod methodClass)
  1074. isOverridden: aMethod
  1075. !
  1076. isOverride: aMethod
  1077. ^ (self cacheFor: aMethod methodClass)
  1078. isOverride: aMethod
  1079. ! !
  1080. HLSelectorsCache class instanceVariableNames: 'current'!
  1081. !HLSelectorsCache class methodsFor: 'accessing'!
  1082. current
  1083. ^ current ifNil: [ current := super new ]
  1084. !
  1085. flush
  1086. current := nil
  1087. ! !
  1088. !HLSelectorsCache class methodsFor: 'instance creation'!
  1089. new
  1090. self shouldNotImplement
  1091. ! !