1
0

Helios-Browser.st 27 KB

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