Helios-Browser.st 30 KB

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