Helios-Core.st 28 KB

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