2
0

Helios-Core.st 25 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343
  1. Smalltalk current createPackage: 'Helios-Core'!
  2. Object subclass: #HLModel
  3. instanceVariableNames: 'announcer environment'
  4. package: 'Helios-Core'!
  5. !HLModel methodsFor: 'accessing'!
  6. announcer
  7. ^ announcer ifNil: [ announcer := Announcer new ]
  8. !
  9. environment
  10. ^ environment ifNil: [ self manager environment ]
  11. !
  12. environment: anEnvironment
  13. environment := anEnvironment
  14. !
  15. manager
  16. ^ HLManager current
  17. !
  18. systemAnnouncer
  19. ^ self environment systemAnnouncer
  20. ! !
  21. !HLModel methodsFor: 'error handling'!
  22. withChangesDo: aBlock
  23. [
  24. self announcer announce: (HLAboutToChange new
  25. actionBlock: aBlock).
  26. aBlock value.
  27. ]
  28. on: HLChangeForbidden
  29. do: [ :ex | ]
  30. ! !
  31. !HLModel methodsFor: 'testing'!
  32. isBrowserModel
  33. ^ false
  34. !
  35. isReferencesModel
  36. ^ false
  37. !
  38. isToolModel
  39. ^ false
  40. ! !
  41. HLModel subclass: #HLToolModel
  42. instanceVariableNames: 'selectedClass selectedPackage selectedProtocol selectedSelector'
  43. package: 'Helios-Core'!
  44. !HLToolModel methodsFor: 'accessing'!
  45. allSelectors
  46. ^ self environment allSelectors
  47. !
  48. availableClassNames
  49. ^ self environment availableClassNames
  50. !
  51. availablePackageNames
  52. ^ self environment availablePackageNames
  53. !
  54. availablePackages
  55. ^ self environment availablePackageNames
  56. !
  57. availableProtocols
  58. ^ self environment availableProtocolsFor: self selectedClass
  59. !
  60. packages
  61. ^ self environment packages
  62. !
  63. selectedClass
  64. ^ selectedClass
  65. !
  66. selectedClass: aClass
  67. (self selectedClass = aClass and: [ aClass isNil ])
  68. ifTrue: [ ^ self ].
  69. self withChangesDo: [
  70. selectedClass = aClass ifTrue: [
  71. self selectedProtocol: nil ].
  72. aClass
  73. ifNil: [ selectedClass := nil ]
  74. ifNotNil: [
  75. self selectedPackage: aClass theNonMetaClass package.
  76. self showInstance
  77. ifTrue: [ selectedClass := aClass theNonMetaClass ]
  78. ifFalse: [ selectedClass := aClass theMetaClass ] ].
  79. self selectedProtocol: nil.
  80. self announcer announce: (HLClassSelected on: self selectedClass) ]
  81. !
  82. selectedMethod
  83. ^ self selectedClass ifNotNil: [
  84. self selectedClass methodDictionary
  85. at: selectedSelector
  86. ifAbsent: [ nil ] ]
  87. !
  88. selectedMethod: aCompiledMethod
  89. selectedSelector = aCompiledMethod ifTrue: [ ^ self ].
  90. self withChangesDo: [
  91. aCompiledMethod
  92. ifNil: [ selectedSelector := nil ]
  93. ifNotNil: [
  94. selectedClass := aCompiledMethod methodClass.
  95. selectedSelector := aCompiledMethod selector ].
  96. self announcer announce: (HLMethodSelected on: aCompiledMethod) ]
  97. !
  98. selectedPackage
  99. ^ selectedPackage
  100. !
  101. selectedPackage: aPackage
  102. selectedPackage = aPackage ifTrue: [ ^ self ].
  103. self withChangesDo: [
  104. selectedPackage := aPackage.
  105. self selectedClass: nil.
  106. self announcer announce: (HLPackageSelected on: aPackage) ]
  107. !
  108. selectedProtocol
  109. ^ selectedProtocol
  110. !
  111. selectedProtocol: aString
  112. selectedProtocol = aString ifTrue: [ ^ self ].
  113. self withChangesDo: [
  114. selectedProtocol := aString.
  115. self selectedMethod: nil.
  116. self announcer announce: (HLProtocolSelected on: aString) ]
  117. ! !
  118. !HLToolModel methodsFor: 'actions'!
  119. addInstVarNamed: aString
  120. self environment addInstVarNamed: aString to: self selectedClass.
  121. self announcer announce: (HLInstVarAdded new
  122. theClass: self selectedClass;
  123. variableName: aString;
  124. yourself)
  125. !
  126. save: aString
  127. self announcer announce: HLSourceCodeSaved new.
  128. (self shouldCompileClassDefinition: aString)
  129. ifTrue: [ self compileClassDefinition: aString ]
  130. ifFalse: [ self compileMethod: aString ]
  131. !
  132. saveSourceCode
  133. self announcer announce: HLSaveSourceCode new
  134. ! !
  135. !HLToolModel methodsFor: 'commands actions'!
  136. commitPackage
  137. self
  138. withHelperLabelled: 'Committing package ', self selectedPackage name, '...'
  139. do: [ self environment commitPackage: self selectedPackage ]
  140. !
  141. copyClassTo: aClassName
  142. self withChangesDo: [
  143. self environment
  144. copyClass: self selectedClass theNonMetaClass
  145. to: aClassName ]
  146. !
  147. moveClassToPackage: aPackageName
  148. self withChangesDo: [
  149. self environment
  150. moveClass: self selectedClass theNonMetaClass
  151. toPackage: aPackageName ]
  152. !
  153. moveMethodToClass: aClassName
  154. self withChangesDo: [
  155. self environment
  156. moveMethod: self selectedMethod
  157. toClass: aClassName ]
  158. !
  159. moveMethodToProtocol: aProtocol
  160. self withChangesDo: [
  161. self environment
  162. moveMethod: self selectedMethod
  163. toProtocol: aProtocol ]
  164. !
  165. openClassNamed: aString
  166. | class |
  167. self withChangesDo: [
  168. class := self environment classNamed: aString.
  169. self selectedPackage: class package.
  170. self selectedClass: class ]
  171. !
  172. removeClass
  173. self withChangesDo: [
  174. self manager
  175. confirm: 'Do you REALLY want to remove class ', self selectedClass name
  176. ifTrue: [ self environment removeClass: self selectedClass ] ]
  177. !
  178. removeMethod
  179. self withChangesDo: [
  180. self manager
  181. confirm: 'Do you REALLY want to remove method ', self selectedMethod methodClass name,' >> #', self selectedMethod selector
  182. ifTrue: [ self environment removeMethod: self selectedMethod ] ]
  183. !
  184. removeProtocol
  185. self withChangesDo: [
  186. self manager
  187. confirm: 'Do you REALLY want to remove protocol ', self selectedProtocol
  188. ifTrue: [ self environment
  189. removeProtocol: self selectedProtocol
  190. from: self selectedClass ] ]
  191. !
  192. renameClassTo: aClassName
  193. self withChangesDo: [
  194. self environment
  195. renameClass: self selectedClass theNonMetaClass
  196. to: aClassName ]
  197. !
  198. renameProtocolTo: aString
  199. self withChangesDo: [
  200. self environment
  201. renameProtocol: self selectedProtocol
  202. to: aString
  203. in: self selectedClass ]
  204. ! !
  205. !HLToolModel methodsFor: 'compiling'!
  206. compileClassComment: aString
  207. self environment
  208. compileClassComment: aString
  209. for: self selectedClass
  210. !
  211. compileClassDefinition: aString
  212. self environment compileClassDefinition: aString
  213. !
  214. compileMethod: aString
  215. | method |
  216. self withCompileErrorHandling: [
  217. method := self environment
  218. compileMethod: aString
  219. for: self selectedClass
  220. protocol: self compilationProtocol.
  221. self selectedMethod: method ]
  222. ! !
  223. !HLToolModel methodsFor: 'defaults'!
  224. allProtocol
  225. ^ '-- all --'
  226. !
  227. unclassifiedProtocol
  228. ^ 'as yet unclassified'
  229. ! !
  230. !HLToolModel methodsFor: 'error handling'!
  231. handleCompileError: anError
  232. self announcer announce: (HLCompileErrorRaised new
  233. error: anError;
  234. yourself)
  235. !
  236. handleParseError: anError
  237. | split line column messageToInsert |
  238. split := anError messageText tokenize: ' : '.
  239. messageToInsert := split second.
  240. "21 = 'Parse error on line ' size + 1"
  241. split := split first copyFrom: 21 to: split first size.
  242. split := split tokenize: ' column '.
  243. line := split first.
  244. column := split second.
  245. self announcer announce: (HLParseErrorRaised new
  246. line: line asNumber;
  247. column: column asNumber;
  248. message: messageToInsert;
  249. error: anError;
  250. yourself)
  251. !
  252. handleUnkownVariableError: anError
  253. self announcer announce: (HLUnknownVariableErrorRaised new
  254. error: anError;
  255. yourself)
  256. !
  257. withCompileErrorHandling: aBlock
  258. [
  259. [
  260. aBlock
  261. on: ParseError
  262. do: [:ex | self handleParseError: ex ]
  263. ]
  264. on: UnknownVariableError
  265. do: [ :ex | self handleUnkownVariableError: ex ]
  266. ]
  267. on: CompilerError
  268. do: [ :ex | self handleCompileError: ex ]
  269. ! !
  270. !HLToolModel methodsFor: 'private'!
  271. compilationProtocol
  272. | currentProtocol |
  273. currentProtocol := self selectedProtocol.
  274. currentProtocol ifNil: [ currentProtocol := self unclassifiedProtocol ].
  275. self selectedMethod ifNotNil: [ currentProtocol := self selectedMethod protocol ].
  276. ^ currentProtocol = self allProtocol
  277. ifTrue: [ self unclassifiedProtocol ]
  278. ifFalse: [ currentProtocol ]
  279. !
  280. withHelperLabelled: aString do: aBlock
  281. "TODO: doesn't belong here"
  282. (window jQuery: '#helper') remove.
  283. [ :html |
  284. html div
  285. id: 'helper';
  286. with: aString ] appendToJQuery: 'body' asJQuery.
  287. [
  288. aBlock value.
  289. (window jQuery: '#helper') remove
  290. ]
  291. valueWithTimeout: 10
  292. ! !
  293. !HLToolModel methodsFor: 'testing'!
  294. isToolModel
  295. ^ true
  296. !
  297. shouldCompileClassDefinition: aString
  298. ^ self selectedClass isNil or: [
  299. aString first asUppercase = aString first ]
  300. ! !
  301. !HLToolModel class methodsFor: 'actions'!
  302. on: anEnvironment
  303. ^ self new
  304. environment: anEnvironment;
  305. yourself
  306. ! !
  307. Widget subclass: #HLTab
  308. instanceVariableNames: 'widget label root'
  309. package: 'Helios-Core'!
  310. !HLTab methodsFor: 'accessing'!
  311. activate
  312. self manager activate: self
  313. !
  314. add
  315. self manager addTab: self
  316. !
  317. displayLabel
  318. ^ self label size > 20
  319. ifTrue: [ (self label first: 20), '...' ]
  320. ifFalse: [ self label ]
  321. !
  322. focus
  323. self widget canHaveFocus ifTrue: [
  324. self widget focus ]
  325. !
  326. label
  327. ^ label ifNil: [ '' ]
  328. !
  329. label: aString
  330. label := aString
  331. !
  332. manager
  333. ^ HLManager current
  334. !
  335. widget
  336. ^ widget
  337. !
  338. widget: aWidget
  339. widget := aWidget
  340. ! !
  341. !HLTab methodsFor: 'actions'!
  342. hide
  343. root ifNotNil: [ root asJQuery css: 'visibility' put: 'hidden' ]
  344. !
  345. registerBindings
  346. self widget registerBindings
  347. !
  348. remove
  349. self widget unregister.
  350. root ifNotNil: [ root asJQuery remove ]
  351. !
  352. show
  353. root
  354. ifNil: [ self appendToJQuery: 'body' asJQuery ]
  355. ifNotNil: [ root asJQuery css: 'visibility' put: 'visible' ]
  356. ! !
  357. !HLTab methodsFor: 'rendering'!
  358. renderOn: html
  359. root := html div
  360. class: 'tab';
  361. yourself.
  362. self renderTab
  363. !
  364. renderTab
  365. root contents: [ :html |
  366. html div
  367. class: 'amber_box';
  368. with: [ self widget renderOn: html ] ]
  369. ! !
  370. !HLTab methodsFor: 'testing'!
  371. isActive
  372. ^ self manager activeTab = self
  373. ! !
  374. !HLTab class methodsFor: 'instance creation'!
  375. on: aWidget labelled: aString
  376. ^ self new
  377. widget: aWidget;
  378. label: aString;
  379. yourself
  380. ! !
  381. Widget subclass: #HLWidget
  382. instanceVariableNames: 'wrapper'
  383. package: 'Helios-Core'!
  384. !HLWidget methodsFor: 'accessing'!
  385. manager
  386. ^ HLManager current
  387. !
  388. wrapper
  389. ^ wrapper
  390. ! !
  391. !HLWidget methodsFor: 'actions'!
  392. alert: aString
  393. window alert: aString
  394. !
  395. confirm: aString ifTrue: aBlock
  396. self manager confirm: aString ifTrue: aBlock
  397. !
  398. execute: aCommand
  399. HLManager current keyBinder
  400. activate;
  401. applyBinding: aCommand asBinding
  402. !
  403. unregister
  404. "This method is called whenever the receiver is closed (as a tab).
  405. Widgets subscribing to announcements should unregister there"
  406. ! !
  407. !HLWidget methodsFor: 'keybindings'!
  408. registerBindings
  409. self registerBindingsOn: self manager keyBinder bindings
  410. !
  411. registerBindingsOn: aBindingGroup
  412. ! !
  413. !HLWidget methodsFor: 'rendering'!
  414. renderContentOn: html
  415. !
  416. renderOn: html
  417. wrapper := html div.
  418. [ :renderer | self renderContentOn: renderer ] appendToJQuery: wrapper asJQuery
  419. ! !
  420. !HLWidget methodsFor: 'testing'!
  421. canHaveFocus
  422. ^ false
  423. ! !
  424. !HLWidget methodsFor: 'updating'!
  425. refresh
  426. self wrapper ifNil: [ ^ self ].
  427. self wrapper asJQuery empty.
  428. [ :html | self renderContentOn: html ] appendToJQuery: self wrapper asJQuery
  429. ! !
  430. !HLWidget class methodsFor: 'accessing'!
  431. openAsTab
  432. self canBeOpenAsTab ifFalse: [ ^ self ].
  433. HLManager current addTab: (HLTab on: self new labelled: self tabLabel)
  434. !
  435. tabLabel
  436. ^ 'Tab'
  437. !
  438. tabPriority
  439. ^ 500
  440. ! !
  441. !HLWidget class methodsFor: 'testing'!
  442. canBeOpenAsTab
  443. ^ false
  444. ! !
  445. HLWidget subclass: #HLConfirmation
  446. instanceVariableNames: 'confirmationString actionBlock cancelBlock'
  447. package: 'Helios-Core'!
  448. !HLConfirmation methodsFor: 'accessing'!
  449. actionBlock
  450. ^ actionBlock ifNil: [ [] ]
  451. !
  452. actionBlock: aBlock
  453. actionBlock := aBlock
  454. !
  455. cancelBlock
  456. ^ cancelBlock ifNil: [ [] ]
  457. !
  458. cancelBlock: aBlock
  459. cancelBlock := aBlock
  460. !
  461. confirmationString
  462. ^ confirmationString ifNil: [ 'Confirm' ]
  463. !
  464. confirmationString: aString
  465. confirmationString := aString
  466. ! !
  467. !HLConfirmation methodsFor: 'actions'!
  468. cancel
  469. self cancelBlock value.
  470. self remove
  471. !
  472. confirm
  473. self actionBlock value.
  474. self remove
  475. !
  476. remove
  477. (window jQuery: '.confirmation') removeClass: 'active'.
  478. [
  479. (window jQuery: '#overlay') remove.
  480. (window jQuery: '.confirmation') remove
  481. ] valueWithTimeout: 300
  482. ! !
  483. !HLConfirmation methodsFor: 'rendering'!
  484. renderContentOn: html
  485. | confirmButton |
  486. html div id: 'overlay'.
  487. html div
  488. class: 'confirmation';
  489. with: [
  490. html span with: self confirmationString.
  491. html div
  492. class: 'buttons';
  493. with: [
  494. html button
  495. class: 'button';
  496. with: 'Cancel';
  497. onClick: [ self cancel ].
  498. confirmButton := html button
  499. class: 'button default';
  500. with: 'Confirm';
  501. onClick: [ self confirm ] ] ].
  502. confirmButton asJQuery focus.
  503. (window jQuery: '.confirmation') addClass: 'active'.
  504. self setupKeyBindings
  505. !
  506. setupKeyBindings
  507. (window jQuery: '.confirmation') keyup: [ :e |
  508. e keyCode = 27 ifTrue: [ self cancel ] ]
  509. ! !
  510. HLWidget subclass: #HLDebugger
  511. instanceVariableNames: ''
  512. package: 'Helios-Core'!
  513. HLWidget subclass: #HLFocusableWidget
  514. instanceVariableNames: ''
  515. package: 'Helios-Core'!
  516. !HLFocusableWidget methodsFor: 'accessing'!
  517. focusClass
  518. ^ 'focused'
  519. ! !
  520. !HLFocusableWidget methodsFor: 'events'!
  521. blur
  522. self wrapper asJQuery blur
  523. !
  524. focus
  525. self wrapper asJQuery focus
  526. !
  527. hasFocus
  528. ^ self wrapper notNil and: [ self wrapper asJQuery is: ':focus' ]
  529. ! !
  530. !HLFocusableWidget methodsFor: 'rendering'!
  531. renderContentOn: html
  532. !
  533. renderOn: html
  534. self registerBindings.
  535. wrapper := html div
  536. class: 'hl_widget';
  537. yourself.
  538. wrapper with: [ self renderContentOn: html ].
  539. wrapper
  540. at: 'tabindex' put: '0';
  541. onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
  542. onFocus: [ self wrapper asJQuery addClass: self focusClass ]
  543. ! !
  544. !HLFocusableWidget methodsFor: 'testing'!
  545. canHaveFocus
  546. ^ true
  547. ! !
  548. HLFocusableWidget subclass: #HLListWidget
  549. instanceVariableNames: 'items selectedItem mapping'
  550. package: 'Helios-Core'!
  551. !HLListWidget methodsFor: 'accessing'!
  552. cssClassForItem: anObject
  553. ^ self selectedItem = anObject
  554. ifTrue: [ 'active' ]
  555. ifFalse: [ 'inactive' ]
  556. !
  557. iconForItem: anObject
  558. ^ ''
  559. !
  560. items
  561. ^ items ifNil: [ items := self defaultItems ]
  562. !
  563. items: aCollection
  564. items := aCollection
  565. !
  566. positionOf: aListItem
  567. <
  568. return aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1
  569. >
  570. !
  571. selectedItem
  572. ^ selectedItem
  573. !
  574. selectedItem: anObject
  575. selectedItem := anObject
  576. ! !
  577. !HLListWidget methodsFor: 'actions'!
  578. activateFirstListItem
  579. self activateListItem: (window jQuery: ((wrapper asJQuery find: 'li.inactive') get: 0))
  580. !
  581. activateItem: anObject
  582. self activateListItem: (mapping
  583. at: anObject
  584. ifAbsent: [ ^ self ]) asJQuery
  585. !
  586. activateListItem: aListItem
  587. | item |
  588. (aListItem get: 0) ifNil: [ ^self ].
  589. aListItem parent children removeClass: 'active'.
  590. aListItem addClass: 'active'.
  591. self ensureVisible: aListItem.
  592. "Activate the corresponding item"
  593. item := (self items at: (aListItem attr: 'list-data') asNumber).
  594. self selectedItem == item ifFalse: [
  595. self selectItem: item ]
  596. !
  597. activateNextListItem
  598. self activateListItem: (window jQuery: '.focused .nav-pills .active') next.
  599. "select the first item if none is selected"
  600. (window jQuery: '.focused .nav-pills .active') get ifEmpty: [
  601. self activateFirstListItem ]
  602. !
  603. activatePreviousListItem
  604. self activateListItem: (window jQuery: '.focused .nav-pills .active') prev
  605. !
  606. ensureVisible: aListItem
  607. "Move the scrollbar to show the active element"
  608. | perent position |
  609. position := self positionOf: aListItem.
  610. parent := aListItem parent.
  611. aListItem position top < 0 ifTrue: [
  612. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
  613. aListItem position top + aListItem height > parent height ifTrue: [
  614. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ]
  615. !
  616. focus
  617. super focus.
  618. self items isEmpty ifFalse: [
  619. self selectedItem ifNil: [ self activateFirstListItem ] ]
  620. !
  621. refresh
  622. super refresh.
  623. self ensureVisible: (mapping
  624. at: self selectedItem
  625. ifAbsent: [ ^ self ]) asJQuery
  626. !
  627. selectItem: anObject
  628. self selectedItem: anObject
  629. ! !
  630. !HLListWidget methodsFor: 'defaults'!
  631. defaultItems
  632. ^ #()
  633. ! !
  634. !HLListWidget methodsFor: 'events'!
  635. setupKeyBindings
  636. "TODO: refactor this!!"
  637. | active interval delay repeatInterval |
  638. active := false.
  639. repeatInterval := 70.
  640. self wrapper asJQuery unbind: 'keydown'.
  641. self wrapper asJQuery keydown: [ :e |
  642. (e which = 38 and: [ active = false ]) ifTrue: [
  643. active := true.
  644. self activatePreviousListItem.
  645. delay := [
  646. interval := [
  647. (self wrapper asJQuery hasClass: self focusClass)
  648. ifTrue: [
  649. self activatePreviousListItem ]
  650. ifFalse: [
  651. active := false.
  652. interval ifNotNil: [ interval clearInterval ].
  653. delay ifNotNil: [ delay clearTimeout] ] ]
  654. valueWithInterval: repeatInterval ]
  655. valueWithTimeout: 300 ].
  656. (e which = 40 and: [ active = false ]) ifTrue: [
  657. active := true.
  658. self activateNextListItem.
  659. delay := [
  660. interval := [
  661. (self wrapper asJQuery hasClass: self focusClass)
  662. ifTrue: [
  663. self activateNextListItem ]
  664. ifFalse: [
  665. active := false.
  666. interval ifNotNil: [ interval clearInterval ].
  667. delay ifNotNil: [ delay clearTimeout] ] ]
  668. valueWithInterval: repeatInterval ]
  669. valueWithTimeout: 300 ] ].
  670. self wrapper asJQuery keyup: [ :e |
  671. active ifTrue: [
  672. active := false.
  673. interval ifNotNil: [ interval clearInterval ].
  674. delay ifNotNil: [ delay clearTimeout] ] ]
  675. ! !
  676. !HLListWidget methodsFor: 'initialization'!
  677. initialize
  678. super initialize.
  679. mapping := Dictionary new.
  680. ! !
  681. !HLListWidget methodsFor: 'private'!
  682. registerMappingFrom: anObject to: aTag
  683. mapping at: anObject put: aTag
  684. ! !
  685. !HLListWidget methodsFor: 'rendering'!
  686. renderButtonsOn: html
  687. !
  688. renderContentOn: html
  689. html ul
  690. class: 'nav nav-pills nav-stacked';
  691. with: [ self renderListOn: html ].
  692. html div class: 'pane_actions form-actions'; with: [
  693. self renderButtonsOn: html ].
  694. self setupKeyBindings
  695. !
  696. renderItem: anObject on: html
  697. | li |
  698. li := html li.
  699. self registerMappingFrom: anObject to: li.
  700. li
  701. class: (self cssClassForItem: anObject);
  702. at: 'list-data' put: (self items indexOf: anObject) asString;
  703. with: [
  704. html a
  705. with: [
  706. (html tag: 'i') class: (self iconForItem: anObject).
  707. self renderItemLabel: anObject on: html ];
  708. onClick: [
  709. self activateListItem: li asJQuery ] ]
  710. !
  711. renderItemLabel: anObject on: html
  712. html with: anObject asString
  713. !
  714. renderListOn: html
  715. mapping := Dictionary new.
  716. self items do: [ :each |
  717. self renderItem: each on: html ]
  718. ! !
  719. HLListWidget subclass: #HLNavigationListWidget
  720. instanceVariableNames: 'previous next'
  721. package: 'Helios-Core'!
  722. !HLNavigationListWidget methodsFor: 'accessing'!
  723. next
  724. ^ next
  725. !
  726. next: aWidget
  727. next := aWidget.
  728. aWidget previous = self ifFalse: [ aWidget previous: self ]
  729. !
  730. previous
  731. ^ previous
  732. !
  733. previous: aWidget
  734. previous := aWidget.
  735. aWidget next = self ifFalse: [ aWidget next: self ]
  736. ! !
  737. !HLNavigationListWidget methodsFor: 'actions'!
  738. nextFocus
  739. self next ifNotNil: [ self next focus ]
  740. !
  741. previousFocus
  742. self previous ifNotNil: [ self previous focus ]
  743. ! !
  744. !HLNavigationListWidget methodsFor: 'events'!
  745. setupKeyBindings
  746. super setupKeyBindings.
  747. self wrapper asJQuery keydown: [ :e |
  748. e which = 39 ifTrue: [
  749. self nextFocus ].
  750. e which = 37 ifTrue: [
  751. self previousFocus ] ]
  752. ! !
  753. HLNavigationListWidget subclass: #HLToolListWidget
  754. instanceVariableNames: 'model'
  755. package: 'Helios-Core'!
  756. !HLToolListWidget methodsFor: 'accessing'!
  757. commandCategory
  758. ^ self label
  759. !
  760. label
  761. ^ 'List'
  762. !
  763. menuCommands
  764. "Answer a collection of commands to be put in the cog menu"
  765. ^ ((HLToolCommand concreteClasses
  766. select: [ :each | each isValidFor: self model ])
  767. collect: [ :each | each for: self model ])
  768. select: [ :each |
  769. each category = self commandCategory and: [
  770. each isAction and: [ each isActive ] ] ]
  771. !
  772. model
  773. ^ model
  774. !
  775. model: aBrowserModel
  776. model := aBrowserModel.
  777. self
  778. observeSystem;
  779. observeModel
  780. !
  781. selectedItem: anItem
  782. "Selection changed, update the cog menu"
  783. super selectedItem: anItem.
  784. self updateMenu
  785. ! !
  786. !HLToolListWidget methodsFor: 'actions'!
  787. activateListItem: anItem
  788. self model withChangesDo: [ super activateListItem: anItem ]
  789. !
  790. activateNextListItem
  791. self model withChangesDo: [ super activateNextListItem ]
  792. !
  793. activatePreviousListItem
  794. self model withChangesDo: [ super activatePreviousListItem ]
  795. !
  796. observeModel
  797. !
  798. observeSystem
  799. !
  800. unregister
  801. super unregister.
  802. self model announcer unsubscribe: self.
  803. self model systemAnnouncer unsubscribe: self
  804. ! !
  805. !HLToolListWidget methodsFor: 'rendering'!
  806. renderContentOn: html
  807. self renderHeadOn: html.
  808. super renderContentOn: html
  809. !
  810. renderHeadOn: html
  811. html div
  812. class: 'list-label';
  813. with: [
  814. html with: self label.
  815. self renderMenuOn: html ]
  816. !
  817. renderMenuOn: html
  818. | commands |
  819. commands := self menuCommands.
  820. commands isEmpty ifTrue: [ ^ self ].
  821. html div
  822. class: 'btn-group cog';
  823. with: [
  824. html a
  825. class: 'btn dropdown-toggle';
  826. at: 'data-toggle' put: 'dropdown';
  827. with: [ (html tag: 'i') class: 'icon-cog' ].
  828. html ul
  829. class: 'dropdown-menu pull-right';
  830. with: [
  831. self menuCommands do: [ :each |
  832. html li with: [ html a
  833. with: each menuLabel;
  834. onClick: [ self execute: each ] ] ] ] ]
  835. ! !
  836. !HLToolListWidget methodsFor: 'updating'!
  837. updateMenu
  838. (self wrapper asJQuery find: '.cog') remove.
  839. [ :html | self renderMenuOn: html ]
  840. appendToJQuery: (self wrapper asJQuery find: '.list-label')
  841. ! !
  842. !HLToolListWidget class methodsFor: 'instance creation'!
  843. on: aModel
  844. ^ self new
  845. model: aModel;
  846. yourself
  847. ! !
  848. HLWidget subclass: #HLManager
  849. instanceVariableNames: 'tabs activeTab keyBinder environment history'
  850. package: 'Helios-Core'!
  851. !HLManager methodsFor: 'accessing'!
  852. activeTab
  853. ^ activeTab
  854. !
  855. environment
  856. "The default environment used by all Helios objects"
  857. ^ environment ifNil: [ environment := self defaultEnvironment ]
  858. !
  859. environment: anEnvironment
  860. environment := anEnvironment
  861. !
  862. history
  863. ^ history ifNil: [ history := OrderedCollection new ]
  864. !
  865. history: aCollection
  866. history := aCollection
  867. !
  868. keyBinder
  869. ^ keyBinder ifNil: [ keyBinder := HLKeyBinder new ]
  870. !
  871. tabs
  872. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  873. ! !
  874. !HLManager methodsFor: 'actions'!
  875. activate: aTab
  876. self keyBinder flushBindings.
  877. aTab registerBindings.
  878. activeTab := aTab.
  879. self
  880. refresh;
  881. addToHistory: aTab;
  882. show: aTab
  883. !
  884. addTab: aTab
  885. self tabs add: aTab.
  886. self activate: aTab
  887. !
  888. addToHistory: aTab
  889. self removeFromHistory: aTab.
  890. self history add: aTab
  891. !
  892. confirm: aString ifFalse: aBlock
  893. (HLConfirmation new
  894. confirmationString: aString;
  895. cancelBlock: aBlock;
  896. yourself)
  897. appendToJQuery: 'body' asJQuery
  898. !
  899. confirm: aString ifTrue: aBlock
  900. (HLConfirmation new
  901. confirmationString: aString;
  902. actionBlock: aBlock;
  903. yourself)
  904. appendToJQuery: 'body' asJQuery
  905. !
  906. removeActiveTab
  907. self removeTab: self activeTab
  908. !
  909. removeFromHistory: aTab
  910. self history: (self history reject: [ :each | each == aTab ])
  911. !
  912. removeTab: aTab
  913. (self tabs includes: aTab) ifFalse: [ ^ self ].
  914. self removeFromHistory: aTab.
  915. self tabs remove: aTab.
  916. self keyBinder flushBindings.
  917. aTab remove.
  918. self refresh.
  919. self history ifNotEmpty: [
  920. self history last activate ]
  921. ! !
  922. !HLManager methodsFor: 'defaults'!
  923. defaultEnvironment
  924. "If helios is loaded from within a frame, answer the parent window environment"
  925. window parent ifNil: [ ^ Environment new ].
  926. ^ ((window parent at: 'smalltalk')
  927. at: 'Environment') new
  928. ! !
  929. !HLManager methodsFor: 'initialization'!
  930. initialize
  931. super initialize.
  932. self keyBinder setupEvents
  933. ! !
  934. !HLManager methodsFor: 'rendering'!
  935. refresh
  936. (window jQuery: '.navbar') remove.
  937. self appendToJQuery: 'body' asJQuery
  938. !
  939. renderAddOn: html
  940. html li
  941. class: 'dropdown';
  942. with: [
  943. html a
  944. class: 'dropdown-toggle';
  945. at: 'data-toggle' put: 'dropdown';
  946. with: [
  947. html with: 'Open...'.
  948. (html tag: 'b') class: 'caret' ].
  949. html ul
  950. class: 'dropdown-menu';
  951. with: [
  952. ((HLWidget withAllSubclasses
  953. select: [ :each | each canBeOpenAsTab ])
  954. sorted: [ :a :b | a tabPriority < b tabPriority ])
  955. do: [ :each |
  956. html li with: [
  957. html a
  958. with: each tabLabel;
  959. onClick: [ each openAsTab ] ] ] ] ]
  960. !
  961. renderContentOn: html
  962. html div
  963. class: 'navbar navbar-fixed-top';
  964. with: [ html div
  965. class: 'navbar-inner';
  966. with: [ self renderTabsOn: html ] ]
  967. !
  968. renderTabsOn: html
  969. html ul
  970. class: 'nav';
  971. with: [
  972. self tabs do: [ :each |
  973. html li
  974. class: (each isActive ifTrue: [ 'active' ] ifFalse: [ 'inactive' ]);
  975. with: [
  976. html a
  977. with: [
  978. ((html tag: 'i') class: 'icon-remove')
  979. onClick: [ self removeTab: each ].
  980. html with: each displayLabel ];
  981. onClick: [ each activate ] ] ].
  982. self renderAddOn: html ]
  983. !
  984. show: aTab
  985. self tabs do: [ :each | each hide ].
  986. aTab show; focus
  987. ! !
  988. HLManager class instanceVariableNames: 'current'!
  989. !HLManager class methodsFor: 'accessing'!
  990. current
  991. ^ current ifNil: [ current := self basicNew initialize ]
  992. ! !
  993. !HLManager class methodsFor: 'initialization'!
  994. initialize
  995. self current appendToJQuery: 'body' asJQuery
  996. ! !
  997. !HLManager class methodsFor: 'instance creation'!
  998. new
  999. "Use current instead"
  1000. self shouldNotImplement
  1001. ! !
  1002. HLWidget subclass: #HLSUnit
  1003. instanceVariableNames: ''
  1004. package: 'Helios-Core'!
  1005. !HLSUnit class methodsFor: 'accessing'!
  1006. tabLabel
  1007. ^ 'SUnit'
  1008. !
  1009. tabPriority
  1010. ^ 1000
  1011. ! !
  1012. !HLSUnit class methodsFor: 'testing'!
  1013. canBeOpenAsTab
  1014. ^ true
  1015. ! !
  1016. HLWidget subclass: #HLTranscript
  1017. instanceVariableNames: ''
  1018. package: 'Helios-Core'!
  1019. !HLTranscript class methodsFor: 'accessing'!
  1020. tabLabel
  1021. ^ 'Transcript'
  1022. !
  1023. tabPriority
  1024. ^ 600
  1025. ! !
  1026. !HLTranscript class methodsFor: 'testing'!
  1027. canBeOpenAsTab
  1028. ^ true
  1029. ! !