1
0

Helios-Browser.st 28 KB

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