1
0

Helios-Browser.st 27 KB

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