Helios-Browser.st 24 KB

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