1
0

Helios-Core.st 35 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837
  1. Smalltalk current createPackage: 'Helios-Core'!
  2. InterfacingObject 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 environment commitPackage: self selectedPackage
  149. !
  150. copyClassTo: aClassName
  151. self withChangesDo: [
  152. self environment
  153. copyClass: self selectedClass theNonMetaClass
  154. to: aClassName ]
  155. !
  156. moveClassToPackage: aPackageName
  157. self withChangesDo: [
  158. self environment
  159. moveClass: self selectedClass theNonMetaClass
  160. toPackage: aPackageName ]
  161. !
  162. moveMethodToClass: aClassName
  163. self withChangesDo: [
  164. self environment
  165. moveMethod: self selectedMethod
  166. toClass: aClassName ]
  167. !
  168. moveMethodToProtocol: aProtocol
  169. self withChangesDo: [
  170. self environment
  171. moveMethod: self selectedMethod
  172. toProtocol: aProtocol ]
  173. !
  174. openClassNamed: aString
  175. | class |
  176. self withChangesDo: [
  177. class := self environment classNamed: aString.
  178. self selectedPackage: class package.
  179. self selectedClass: class ]
  180. !
  181. removeClass
  182. self withChangesDo: [
  183. self manager
  184. confirm: 'Do you REALLY want to remove class ', self selectedClass name
  185. ifTrue: [ self environment removeClass: self selectedClass ] ]
  186. !
  187. removeMethod
  188. self withChangesDo: [
  189. self manager
  190. confirm: 'Do you REALLY want to remove method ', self selectedMethod methodClass name,' >> #', self selectedMethod selector
  191. ifTrue: [ self environment removeMethod: self selectedMethod ] ]
  192. !
  193. removeProtocol
  194. self withChangesDo: [
  195. self manager
  196. confirm: 'Do you REALLY want to remove protocol ', self selectedProtocol
  197. ifTrue: [ self environment
  198. removeProtocol: self selectedProtocol
  199. from: self selectedClass ] ]
  200. !
  201. renameClassTo: aClassName
  202. self withChangesDo: [
  203. self environment
  204. renameClass: self selectedClass theNonMetaClass
  205. to: aClassName ]
  206. !
  207. renameProtocolTo: aString
  208. self withChangesDo: [
  209. self environment
  210. renameProtocol: self selectedProtocol
  211. to: aString
  212. in: self selectedClass ]
  213. ! !
  214. !HLToolModel methodsFor: 'compiling'!
  215. compileClassComment: aString
  216. self environment
  217. compileClassComment: aString
  218. for: self selectedClass
  219. !
  220. compileClassDefinition: aString
  221. self environment compileClassDefinition: aString
  222. !
  223. compileMethod: aString
  224. | method |
  225. self withCompileErrorHandling: [
  226. method := self environment
  227. compileMethod: aString
  228. for: self selectedClass
  229. protocol: self compilationProtocol.
  230. self selectedMethod: method ]
  231. ! !
  232. !HLToolModel methodsFor: 'defaults'!
  233. allProtocol
  234. ^ '-- all --'
  235. !
  236. unclassifiedProtocol
  237. ^ 'as yet unclassified'
  238. ! !
  239. !HLToolModel methodsFor: 'error handling'!
  240. handleCompileError: anError
  241. self announcer announce: (HLCompileErrorRaised new
  242. error: anError;
  243. yourself)
  244. !
  245. handleParseError: anError
  246. | split line column messageToInsert |
  247. split := anError messageText tokenize: ' : '.
  248. messageToInsert := split second.
  249. "21 = 'Parse error on line ' size + 1"
  250. split := split first copyFrom: 21 to: split first size.
  251. split := split tokenize: ' column '.
  252. line := split first.
  253. column := split second.
  254. self announcer announce: (HLParseErrorRaised new
  255. line: line asNumber;
  256. column: column asNumber;
  257. message: messageToInsert;
  258. error: anError;
  259. yourself)
  260. !
  261. handleUnkownVariableError: anError
  262. self announcer announce: (HLUnknownVariableErrorRaised new
  263. error: anError;
  264. yourself)
  265. !
  266. withCompileErrorHandling: aBlock
  267. self environment
  268. evaluate: [
  269. self environment
  270. evaluate: [
  271. self environment
  272. evaluate: aBlock
  273. on: ParseError
  274. do: [:ex | self handleParseError: ex ] ]
  275. on: UnknownVariableError
  276. do: [ :ex | self handleUnkownVariableError: ex ] ]
  277. on: CompilerError
  278. do: [ :ex | self handleCompileError: ex ]
  279. ! !
  280. !HLToolModel methodsFor: 'private'!
  281. compilationProtocol
  282. | currentProtocol |
  283. currentProtocol := self selectedProtocol.
  284. currentProtocol ifNil: [ currentProtocol := self unclassifiedProtocol ].
  285. self selectedMethod ifNotNil: [ currentProtocol := self selectedMethod protocol ].
  286. ^ currentProtocol = self allProtocol
  287. ifTrue: [ self unclassifiedProtocol ]
  288. ifFalse: [ currentProtocol ]
  289. !
  290. withHelperLabelled: aString do: aBlock
  291. "TODO: doesn't belong here"
  292. '#helper' asJQuery remove.
  293. [ :html |
  294. html div
  295. id: 'helper';
  296. with: aString ] appendToJQuery: 'body' asJQuery.
  297. [
  298. aBlock value.
  299. '#helper' asJQuery remove
  300. ]
  301. valueWithTimeout: 10
  302. ! !
  303. !HLToolModel methodsFor: 'testing'!
  304. isToolModel
  305. ^ true
  306. !
  307. shouldCompileClassDefinition: aString
  308. ^ self selectedClass isNil or: [
  309. aString match: '^[A-Z]' ]
  310. ! !
  311. !HLToolModel class methodsFor: 'actions'!
  312. on: anEnvironment
  313. ^ self new
  314. environment: anEnvironment;
  315. yourself
  316. ! !
  317. ProgressHandler subclass: #HLProgressHandler
  318. instanceVariableNames: ''
  319. package: 'Helios-Core'!
  320. !HLProgressHandler commentStamp!
  321. I am a specific progress handler for Helios, displaying progresses in a modal window.!
  322. !HLProgressHandler methodsFor: 'progress handling'!
  323. do: aBlock on: aCollection displaying: aString
  324. HLProgressWidget default
  325. do: aBlock
  326. on: aCollection
  327. displaying: aString
  328. ! !
  329. Widget subclass: #HLTabWidget
  330. instanceVariableNames: 'widget label root'
  331. package: 'Helios-Core'!
  332. !HLTabWidget commentStamp!
  333. I am a widget specialized into building another widget as an Helios tab.
  334. I should not be used directly, `HLWidget class >> #openAsTab` should be used instead.
  335. ## Example
  336. HLWorkspace openAsTab!
  337. !HLTabWidget methodsFor: 'accessing'!
  338. activate
  339. self manager activate: self
  340. !
  341. add
  342. self manager addTab: self
  343. !
  344. cssClass
  345. ^ self widget tabClass
  346. !
  347. displayLabel
  348. ^ self label size > 20
  349. ifTrue: [ (self label first: 20), '...' ]
  350. ifFalse: [ self label ]
  351. !
  352. focus
  353. self widget canHaveFocus ifTrue: [
  354. self widget focus ]
  355. !
  356. label
  357. ^ label ifNil: [ '' ]
  358. !
  359. label: aString
  360. label := aString
  361. !
  362. manager
  363. ^ HLManager current
  364. !
  365. widget
  366. ^ widget
  367. !
  368. widget: aWidget
  369. widget := aWidget
  370. ! !
  371. !HLTabWidget methodsFor: 'actions'!
  372. hide
  373. root ifNotNil: [ root asJQuery css: 'visibility' put: 'hidden' ]
  374. !
  375. registerBindings
  376. self widget registerBindings
  377. !
  378. remove
  379. self widget unregister.
  380. root ifNotNil: [ root asJQuery remove ]
  381. !
  382. show
  383. root
  384. ifNil: [ self appendToJQuery: 'body' asJQuery ]
  385. ifNotNil: [ root asJQuery css: 'visibility' put: 'visible' ]
  386. ! !
  387. !HLTabWidget methodsFor: 'rendering'!
  388. renderOn: html
  389. root := html div
  390. class: 'tab';
  391. yourself.
  392. self renderTab
  393. !
  394. renderTab
  395. root contents: [ :html |
  396. html div
  397. class: 'amber_box';
  398. with: [ self widget renderOn: html ] ]
  399. ! !
  400. !HLTabWidget methodsFor: 'testing'!
  401. isActive
  402. ^ self manager activeTab = self
  403. ! !
  404. !HLTabWidget class methodsFor: 'instance creation'!
  405. on: aWidget labelled: aString
  406. ^ self new
  407. widget: aWidget;
  408. label: aString;
  409. yourself
  410. ! !
  411. Widget subclass: #HLWidget
  412. instanceVariableNames: 'wrapper'
  413. package: 'Helios-Core'!
  414. !HLWidget commentStamp!
  415. I am the abstract superclass of all Helios widgets.
  416. I provide common methods, additional behavior to widgets useful for Helios, like dialog creation, command execution and tab creation.
  417. ## API
  418. 1. Rendering
  419. Instead of overriding `#renderOn:` as with other Widget subclasses, my subclasses should override `#renderContentOn:`.
  420. 2. Refreshing
  421. To re-render a widget, use `#refresh`.
  422. 3. Key bindings registration and tabs
  423. When displayed as a tab, the widget has a chance to register keybindings with the `#registerBindingsOn:` hook method.
  424. 4. Unregistration
  425. When a widget has subscribed to announcements or other actions that need to be cleared when closing the tab, the hook method `#unregister` will be called by helios.
  426. 5. Tabs
  427. To enable a widget class to be open as a tab, override the class-side `#canBeOpenAsTab` method to answer `true`. `#tabClass` and `#tabPriority` can be overridden too to respectively change the css class of the tab and the order of tabs in the main menu.
  428. 6. Command execution
  429. An helios command (instance of `HLCommand` or one of its subclass) can be executed with `#execute:`.!
  430. !HLWidget methodsFor: 'accessing'!
  431. manager
  432. ^ HLManager current
  433. !
  434. tabClass
  435. ^ self class tabClass
  436. !
  437. wrapper
  438. ^ wrapper
  439. ! !
  440. !HLWidget methodsFor: 'actions'!
  441. confirm: aString ifTrue: aBlock
  442. self manager confirm: aString ifTrue: aBlock
  443. !
  444. execute: aCommand
  445. HLManager current keyBinder
  446. activate;
  447. applyBinding: aCommand asBinding
  448. !
  449. openAsTab
  450. HLManager current addTab: (HLTabWidget on: self labelled: self class tabLabel)
  451. !
  452. request: aString do: aBlock
  453. self manager request: aString do: aBlock
  454. !
  455. request: aString value: valueString do: aBlock
  456. self manager
  457. request: aString
  458. value: valueString
  459. do: aBlock
  460. !
  461. unregister
  462. "This method is called whenever the receiver is closed (as a tab).
  463. Widgets subscribing to announcements should unregister there"
  464. ! !
  465. !HLWidget methodsFor: 'keybindings'!
  466. bindKeyDown: keyDownBlock keyUp: keyUpBlock
  467. self wrapper asJQuery
  468. keydown: keyDownBlock;
  469. keyup: keyUpBlock
  470. !
  471. registerBindings
  472. self registerBindingsOn: self manager keyBinder bindings
  473. !
  474. registerBindingsOn: aBindingGroup
  475. !
  476. unbindKeyDownKeyUp
  477. self wrapper asJQuery
  478. unbind: 'keydown';
  479. unbind: 'keyup'
  480. ! !
  481. !HLWidget methodsFor: 'rendering'!
  482. renderContentOn: html
  483. !
  484. renderOn: html
  485. wrapper := html div.
  486. [ :renderer | self renderContentOn: renderer ] appendToJQuery: wrapper asJQuery
  487. ! !
  488. !HLWidget methodsFor: 'testing'!
  489. canHaveFocus
  490. ^ false
  491. ! !
  492. !HLWidget methodsFor: 'updating'!
  493. refresh
  494. self wrapper ifNil: [ ^ self ].
  495. self wrapper asJQuery empty.
  496. [ :html | self renderContentOn: html ] appendToJQuery: self wrapper asJQuery
  497. ! !
  498. !HLWidget class methodsFor: 'accessing'!
  499. openAsTab
  500. HLManager current addTab: (HLTabWidget on: self new labelled: self tabLabel)
  501. !
  502. tabClass
  503. ^ ''
  504. !
  505. tabLabel
  506. ^ 'Tab'
  507. !
  508. tabPriority
  509. ^ 500
  510. ! !
  511. !HLWidget class methodsFor: 'testing'!
  512. canBeOpenAsTab
  513. ^ false
  514. ! !
  515. HLWidget subclass: #HLFocusableWidget
  516. instanceVariableNames: ''
  517. package: 'Helios-Core'!
  518. !HLFocusableWidget commentStamp!
  519. I am a widget that can be focused.
  520. ## API
  521. Instead of overriding `#renderOn:` as with other `Widget` subclasses, my subclasses should override `#renderContentOn:`.
  522. To bring the focus to the widget, use the `#focus` method.!
  523. !HLFocusableWidget methodsFor: 'accessing'!
  524. focusClass
  525. ^ 'focused'
  526. ! !
  527. !HLFocusableWidget methodsFor: 'events'!
  528. blur
  529. self wrapper asJQuery blur
  530. !
  531. focus
  532. self wrapper asJQuery focus
  533. ! !
  534. !HLFocusableWidget methodsFor: 'rendering'!
  535. renderContentOn: html
  536. !
  537. renderOn: html
  538. wrapper := html div
  539. class: 'hl_widget';
  540. yourself.
  541. wrapper with: [ self renderContentOn: html ].
  542. wrapper
  543. at: 'tabindex' put: '0';
  544. onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
  545. onFocus: [ self wrapper asJQuery addClass: self focusClass ]
  546. ! !
  547. !HLFocusableWidget methodsFor: 'testing'!
  548. canHaveFocus
  549. ^ true
  550. !
  551. hasFocus
  552. ^ self wrapper notNil and: [ self wrapper asJQuery hasClass: self focusClass ]
  553. ! !
  554. HLFocusableWidget subclass: #HLListWidget
  555. instanceVariableNames: 'items selectedItem mapping'
  556. package: 'Helios-Core'!
  557. !HLListWidget methodsFor: 'accessing'!
  558. cssClassForItem: anObject
  559. ^ ''
  560. !
  561. items
  562. ^ items ifNil: [ items := self defaultItems ]
  563. !
  564. items: aCollection
  565. items := aCollection
  566. !
  567. listCssClassForItem: anObject
  568. ^ self selectedItem = anObject
  569. ifTrue: [ 'active' ]
  570. ifFalse: [ 'inactive' ]
  571. !
  572. positionOf: aListItem
  573. <
  574. return aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1
  575. >
  576. !
  577. selectedItem
  578. ^ selectedItem
  579. !
  580. selectedItem: anObject
  581. selectedItem := anObject
  582. ! !
  583. !HLListWidget methodsFor: 'actions'!
  584. activateFirstListItem
  585. self activateListItem: ((wrapper asJQuery find: 'li.inactive') eq: 0)
  586. !
  587. activateItem: anObject
  588. self activateListItem: (mapping
  589. at: anObject
  590. ifAbsent: [ ^ self ]) asJQuery
  591. !
  592. activateListItem: aListItem
  593. | item |
  594. (aListItem get: 0) ifNil: [ ^self ].
  595. aListItem parent children removeClass: 'active'.
  596. aListItem addClass: 'active'.
  597. self ensureVisible: aListItem.
  598. "Activate the corresponding item"
  599. item := (self items at: (aListItem attr: 'list-data') asNumber).
  600. self selectedItem == item ifFalse: [
  601. self selectItem: item ]
  602. !
  603. activateNextListItem
  604. self activateListItem: (self wrapper asJQuery find: 'li.active') next.
  605. "select the first item if none is selected"
  606. (self wrapper asJQuery find: ' .active') get ifEmpty: [
  607. self activateFirstListItem ]
  608. !
  609. activatePreviousListItem
  610. self activateListItem: (self wrapper asJQuery find: 'li.active') prev
  611. !
  612. ensureVisible: aListItem
  613. "Move the scrollbar to show the active element"
  614. | parent position |
  615. position := self positionOf: aListItem.
  616. parent := aListItem parent.
  617. aListItem position top < 0 ifTrue: [
  618. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
  619. aListItem position top + aListItem height > parent height ifTrue: [
  620. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ]
  621. !
  622. focus
  623. super focus.
  624. self items isEmpty ifFalse: [
  625. self selectedItem ifNil: [ self activateFirstListItem ] ]
  626. !
  627. refresh
  628. super refresh.
  629. self ensureVisible: (mapping
  630. at: self selectedItem
  631. ifAbsent: [ ^ self ]) asJQuery
  632. !
  633. selectItem: anObject
  634. self selectedItem: anObject
  635. ! !
  636. !HLListWidget methodsFor: 'defaults'!
  637. defaultItems
  638. ^ #()
  639. ! !
  640. !HLListWidget methodsFor: 'events'!
  641. setupKeyBindings
  642. (HLRepeatedKeyDownHandler on: self)
  643. whileKeyDown: 38 do: [ self activatePreviousListItem ];
  644. whileKeyDown: 40 do: [ self activateNextListItem ];
  645. rebindKeys
  646. ! !
  647. !HLListWidget methodsFor: 'initialization'!
  648. initialize
  649. super initialize.
  650. mapping := Dictionary new.
  651. ! !
  652. !HLListWidget methodsFor: 'private'!
  653. registerMappingFrom: anObject to: aTag
  654. mapping at: anObject put: aTag
  655. ! !
  656. !HLListWidget methodsFor: 'rendering'!
  657. renderButtonsOn: html
  658. !
  659. renderContentOn: html
  660. html ul
  661. class: 'nav nav-pills nav-stacked';
  662. with: [ self renderListOn: html ].
  663. html div class: 'pane_actions form-actions'; with: [
  664. self renderButtonsOn: html ].
  665. self setupKeyBindings
  666. !
  667. renderItem: anObject on: html
  668. | li |
  669. li := html li.
  670. self registerMappingFrom: anObject to: li.
  671. li
  672. at: 'list-data' put: (self items indexOf: anObject) asString;
  673. class: (self listCssClassForItem: anObject);
  674. with: [
  675. html a
  676. with: [
  677. (html tag: 'i') class: (self cssClassForItem: anObject).
  678. self renderItemLabel: anObject on: html ];
  679. onClick: [
  680. self activateListItem: li asJQuery ] ]
  681. !
  682. renderItemLabel: anObject on: html
  683. html with: anObject asString
  684. !
  685. renderListOn: html
  686. mapping := Dictionary new.
  687. self items do: [ :each |
  688. self renderItem: each on: html ]
  689. ! !
  690. HLListWidget subclass: #HLNavigationListWidget
  691. instanceVariableNames: 'previous next'
  692. package: 'Helios-Core'!
  693. !HLNavigationListWidget methodsFor: 'accessing'!
  694. next
  695. ^ next
  696. !
  697. next: aWidget
  698. next := aWidget.
  699. aWidget previous = self ifFalse: [ aWidget previous: self ]
  700. !
  701. previous
  702. ^ previous
  703. !
  704. previous: aWidget
  705. previous := aWidget.
  706. aWidget next = self ifFalse: [ aWidget next: self ]
  707. ! !
  708. !HLNavigationListWidget methodsFor: 'actions'!
  709. nextFocus
  710. self next ifNotNil: [ self next focus ]
  711. !
  712. previousFocus
  713. self previous ifNotNil: [ self previous focus ]
  714. ! !
  715. !HLNavigationListWidget methodsFor: 'events'!
  716. setupKeyBindings
  717. super setupKeyBindings.
  718. self wrapper asJQuery keydown: [ :e |
  719. e which = 39 ifTrue: [
  720. self nextFocus ].
  721. e which = 37 ifTrue: [
  722. self previousFocus ] ]
  723. ! !
  724. HLNavigationListWidget subclass: #HLToolListWidget
  725. instanceVariableNames: 'model'
  726. package: 'Helios-Core'!
  727. !HLToolListWidget methodsFor: 'accessing'!
  728. commandCategory
  729. ^ self label
  730. !
  731. label
  732. ^ 'List'
  733. !
  734. menuCommands
  735. "Answer a collection of commands to be put in the cog menu"
  736. ^ ((HLToolCommand concreteClasses
  737. select: [ :each | each isValidFor: self model ])
  738. collect: [ :each | each for: self model ])
  739. select: [ :each |
  740. each category = self commandCategory and: [
  741. each isAction and: [ each isActive ] ] ]
  742. !
  743. model
  744. ^ model
  745. !
  746. model: aBrowserModel
  747. model := aBrowserModel.
  748. self
  749. observeSystem;
  750. observeModel
  751. !
  752. selectedItem: anItem
  753. "Selection changed, update the cog menu"
  754. super selectedItem: anItem.
  755. self updateMenu
  756. ! !
  757. !HLToolListWidget methodsFor: 'actions'!
  758. activateListItem: anItem
  759. self model withChangesDo: [ super activateListItem: anItem ]
  760. !
  761. activateNextListItem
  762. self model withChangesDo: [ super activateNextListItem ]
  763. !
  764. activatePreviousListItem
  765. self model withChangesDo: [ super activatePreviousListItem ]
  766. !
  767. observeModel
  768. !
  769. observeSystem
  770. !
  771. unregister
  772. super unregister.
  773. self model announcer unsubscribe: self.
  774. self model systemAnnouncer unsubscribe: self
  775. ! !
  776. !HLToolListWidget methodsFor: 'rendering'!
  777. renderContentOn: html
  778. self renderHeadOn: html.
  779. super renderContentOn: html
  780. !
  781. renderHeadOn: html
  782. html div
  783. class: 'list-label';
  784. with: [
  785. html with: self label.
  786. self renderMenuOn: html ]
  787. !
  788. renderMenuOn: html
  789. | commands |
  790. commands := self menuCommands.
  791. commands isEmpty ifTrue: [ ^ self ].
  792. html div
  793. class: 'btn-group cog';
  794. with: [
  795. html a
  796. class: 'btn dropdown-toggle';
  797. at: 'data-toggle' put: 'dropdown';
  798. with: [ (html tag: 'i') class: 'icon-cog' ].
  799. html ul
  800. class: 'dropdown-menu pull-right';
  801. with: [
  802. self menuCommands do: [ :each |
  803. html li with: [ html a
  804. with: each menuLabel;
  805. onClick: [ self execute: each ] ] ] ] ]
  806. ! !
  807. !HLToolListWidget methodsFor: 'updating'!
  808. updateMenu
  809. (self wrapper asJQuery find: '.cog') remove.
  810. [ :html | self renderMenuOn: html ]
  811. appendToJQuery: (self wrapper asJQuery find: '.list-label')
  812. ! !
  813. !HLToolListWidget class methodsFor: 'instance creation'!
  814. on: aModel
  815. ^ self new
  816. model: aModel;
  817. yourself
  818. ! !
  819. HLListWidget subclass: #HLTabListWidget
  820. instanceVariableNames: 'callback'
  821. package: 'Helios-Core'!
  822. !HLTabListWidget commentStamp!
  823. I am a widget used to display a list of helios tabs.
  824. When a tab is selected, `callback` is evaluated with the selected tab as argument.!
  825. !HLTabListWidget methodsFor: 'accessing'!
  826. callback
  827. ^ callback ifNil: [ [] ]
  828. !
  829. callback: aBlock
  830. callback := aBlock
  831. ! !
  832. !HLTabListWidget methodsFor: 'actions'!
  833. selectItem: aTab
  834. super selectItem: aTab.
  835. self callback value: aTab
  836. ! !
  837. !HLTabListWidget methodsFor: 'rendering'!
  838. renderItemLabel: aTab on: html
  839. html span
  840. class: aTab cssClass;
  841. with: aTab label
  842. ! !
  843. HLWidget subclass: #HLManager
  844. instanceVariableNames: 'tabs activeTab environment history'
  845. package: 'Helios-Core'!
  846. !HLManager methodsFor: 'accessing'!
  847. activeTab
  848. ^ activeTab
  849. !
  850. environment
  851. "The default environment used by all Helios objects"
  852. ^ environment ifNil: [ environment := self defaultEnvironment ]
  853. !
  854. environment: anEnvironment
  855. environment := anEnvironment
  856. !
  857. history
  858. ^ history ifNil: [ history := OrderedCollection new ]
  859. !
  860. history: aCollection
  861. history := aCollection
  862. !
  863. keyBinder
  864. ^ HLKeyBinder current
  865. !
  866. tabs
  867. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  868. ! !
  869. !HLManager methodsFor: 'actions'!
  870. activate: aTab
  871. self keyBinder flushBindings.
  872. aTab registerBindings.
  873. activeTab := aTab.
  874. self
  875. refresh;
  876. addToHistory: aTab;
  877. show: aTab
  878. !
  879. addTab: aTab
  880. self tabs add: aTab.
  881. self activate: aTab
  882. !
  883. addToHistory: aTab
  884. self removeFromHistory: aTab.
  885. self history add: aTab
  886. !
  887. confirm: aString ifFalse: aBlock
  888. HLConfirmationWidget new
  889. confirmationString: aString;
  890. cancelBlock: aBlock;
  891. show
  892. !
  893. confirm: aString ifTrue: aBlock
  894. HLConfirmationWidget new
  895. confirmationString: aString;
  896. actionBlock: aBlock;
  897. show
  898. !
  899. registerErrorHandler: anErrorHandler
  900. self environment registerErrorHandler: anErrorHandler
  901. !
  902. registerInspector: anInspector
  903. self environment registerInspector: anInspector
  904. !
  905. registerProgressHandler: aProgressHandler
  906. self environment registerProgressHandler: aProgressHandler
  907. !
  908. removeActiveTab
  909. self removeTab: self activeTab
  910. !
  911. removeFromHistory: aTab
  912. self history: (self history reject: [ :each | each == aTab ])
  913. !
  914. removeTab: aTab
  915. (self tabs includes: aTab) ifFalse: [ ^ self ].
  916. self removeFromHistory: aTab.
  917. self tabs remove: aTab.
  918. self keyBinder flushBindings.
  919. aTab remove.
  920. self refresh.
  921. self history ifNotEmpty: [
  922. self history last activate ]
  923. !
  924. request: aString do: aBlock
  925. self
  926. request: aString
  927. value: ''
  928. do: aBlock
  929. !
  930. request: aString value: valueString do: aBlock
  931. HLRequestWidget new
  932. confirmationString: aString;
  933. actionBlock: aBlock;
  934. value: valueString;
  935. show
  936. ! !
  937. !HLManager methodsFor: 'defaults'!
  938. defaultEnvironment
  939. "If helios is loaded from within a frame, answer the parent window environment"
  940. | parent parentSmalltalk |
  941. parent := window opener ifNil: [ window parent ].
  942. parent ifNil: [ ^ Environment new ].
  943. parentSmalltalk := (parent at: 'requirejs') value: 'amber_vm/smalltalk'.
  944. parentSmalltalk ifNil: [ ^ Environment new ].
  945. ^ (parentSmalltalk at: 'Environment') new
  946. ! !
  947. !HLManager methodsFor: 'initialization'!
  948. initialize
  949. super initialize.
  950. HLErrorHandler register.
  951. HLProgressHandler register.
  952. self registerInspector: HLInspector.
  953. self registerErrorHandler: ErrorHandler current.
  954. self registerProgressHandler: ProgressHandler current.
  955. self keyBinder setupEvents
  956. ! !
  957. !HLManager methodsFor: 'rendering'!
  958. refresh
  959. '.navbar' asJQuery remove.
  960. self appendToJQuery: 'body' asJQuery
  961. !
  962. renderAddOn: html
  963. html li
  964. class: 'dropdown';
  965. with: [
  966. html a
  967. class: 'dropdown-toggle';
  968. at: 'data-toggle' put: 'dropdown';
  969. with: [
  970. html with: 'Open...'.
  971. (html tag: 'b') class: 'caret' ].
  972. html ul
  973. class: 'dropdown-menu';
  974. with: [
  975. ((HLWidget withAllSubclasses
  976. select: [ :each | each canBeOpenAsTab ])
  977. sorted: [ :a :b | a tabPriority < b tabPriority ])
  978. do: [ :each |
  979. html li with: [
  980. html a
  981. with: each tabLabel;
  982. onClick: [ each openAsTab ] ] ] ] ]
  983. !
  984. renderContentOn: html
  985. html div
  986. class: 'navbar navbar-fixed-top';
  987. with: [ html div
  988. class: 'navbar-inner';
  989. with: [ self renderTabsOn: html ] ]
  990. !
  991. renderTabsOn: html
  992. html ul
  993. class: 'nav';
  994. with: [
  995. self tabs do: [ :each |
  996. html li
  997. class: (each isActive ifTrue: [ 'active' ] ifFalse: [ 'inactive' ]);
  998. with: [
  999. html a
  1000. with: [
  1001. ((html tag: 'i') class: 'close')
  1002. onClick: [ self removeTab: each ].
  1003. html span
  1004. class: each cssClass;
  1005. with: each displayLabel ];
  1006. onClick: [ each activate ] ] ].
  1007. self renderAddOn: html ]
  1008. !
  1009. show: aTab
  1010. self tabs do: [ :each | each hide ].
  1011. aTab show; focus
  1012. ! !
  1013. HLManager class instanceVariableNames: 'current'!
  1014. !HLManager class methodsFor: 'accessing'!
  1015. current
  1016. ^ current ifNil: [ current := self basicNew initialize ]
  1017. ! !
  1018. !HLManager class methodsFor: 'initialization'!
  1019. initialize
  1020. self current appendToJQuery: 'body' asJQuery
  1021. ! !
  1022. !HLManager class methodsFor: 'instance creation'!
  1023. new
  1024. "Use current instead"
  1025. self shouldNotImplement
  1026. ! !
  1027. HLWidget subclass: #HLModalWidget
  1028. instanceVariableNames: ''
  1029. package: 'Helios-Core'!
  1030. !HLModalWidget commentStamp!
  1031. I implement an abstract modal widget.!
  1032. !HLModalWidget methodsFor: 'accessing'!
  1033. cssClass
  1034. ^ ''
  1035. ! !
  1036. !HLModalWidget methodsFor: 'actions'!
  1037. cancel
  1038. self remove
  1039. !
  1040. confirm
  1041. "Override in subclasses"
  1042. self remove
  1043. !
  1044. remove
  1045. '.dialog' asJQuery removeClass: 'active'.
  1046. [
  1047. '#overlay' asJQuery remove.
  1048. '.dialog' asJQuery remove
  1049. ] valueWithTimeout: 300
  1050. !
  1051. show
  1052. self appendToJQuery: 'body' asJQuery
  1053. ! !
  1054. !HLModalWidget methodsFor: 'rendering'!
  1055. hasButtons
  1056. ^ true
  1057. !
  1058. renderButtonsOn: html
  1059. | confirmButton |
  1060. html div
  1061. class: 'buttons';
  1062. with: [
  1063. html button
  1064. class: 'button';
  1065. with: 'Cancel';
  1066. onClick: [ self cancel ].
  1067. confirmButton := html button
  1068. class: 'button default';
  1069. with: 'Confirm';
  1070. onClick: [ self confirm ] ].
  1071. confirmButton asJQuery focus
  1072. !
  1073. renderContentOn: html
  1074. | confirmButton |
  1075. html div id: 'overlay'.
  1076. html div
  1077. class: 'dialog ', self cssClass;
  1078. with: [
  1079. self renderMainOn: html.
  1080. self hasButtons ifTrue: [
  1081. self renderButtonsOn: html ] ].
  1082. '.dialog' asJQuery addClass: 'active'.
  1083. self setupKeyBindings
  1084. !
  1085. renderMainOn: html
  1086. !
  1087. setupKeyBindings
  1088. '.dialog' asJQuery keyup: [ :e |
  1089. e keyCode = String esc asciiValue ifTrue: [ self cancel ] ]
  1090. ! !
  1091. HLModalWidget subclass: #HLConfirmationWidget
  1092. instanceVariableNames: 'confirmationString actionBlock cancelBlock'
  1093. package: 'Helios-Core'!
  1094. !HLConfirmationWidget commentStamp!
  1095. I display confirmation messages.
  1096. Instead of creating an instance directly, use `HLWidget >> #confirm:ifTrue:`.!
  1097. !HLConfirmationWidget methodsFor: 'accessing'!
  1098. actionBlock
  1099. ^ actionBlock ifNil: [ [] ]
  1100. !
  1101. actionBlock: aBlock
  1102. actionBlock := aBlock
  1103. !
  1104. cancelBlock
  1105. ^ cancelBlock ifNil: [ [] ]
  1106. !
  1107. cancelBlock: aBlock
  1108. cancelBlock := aBlock
  1109. !
  1110. confirmationString
  1111. ^ confirmationString ifNil: [ 'Confirm' ]
  1112. !
  1113. confirmationString: aString
  1114. confirmationString := aString
  1115. ! !
  1116. !HLConfirmationWidget methodsFor: 'actions'!
  1117. cancel
  1118. self cancelBlock value.
  1119. super cancel
  1120. !
  1121. confirm
  1122. super confirm.
  1123. self actionBlock value
  1124. ! !
  1125. !HLConfirmationWidget methodsFor: 'rendering'!
  1126. renderMainOn: html
  1127. html span with: self confirmationString
  1128. ! !
  1129. HLConfirmationWidget subclass: #HLRequestWidget
  1130. instanceVariableNames: 'input value'
  1131. package: 'Helios-Core'!
  1132. !HLRequestWidget commentStamp!
  1133. I display a modal window requesting user input.
  1134. Instead of creating instances manually, use `HLWidget >> #request:do:` and `#request:value:do:`.!
  1135. !HLRequestWidget methodsFor: 'accessing'!
  1136. cssClass
  1137. ^ 'large'
  1138. !
  1139. value
  1140. ^ value ifNil: [ '' ]
  1141. !
  1142. value: aString
  1143. value := aString
  1144. ! !
  1145. !HLRequestWidget methodsFor: 'actions'!
  1146. confirm
  1147. super confirm.
  1148. self actionBlock value: input asJQuery val
  1149. ! !
  1150. !HLRequestWidget methodsFor: 'rendering'!
  1151. renderMainOn: html
  1152. super renderMainOn: html.
  1153. input := html textarea.
  1154. input asJQuery val: self value
  1155. ! !
  1156. HLModalWidget subclass: #HLProgressWidget
  1157. instanceVariableNames: 'progressBars visible'
  1158. package: 'Helios-Core'!
  1159. !HLProgressWidget commentStamp!
  1160. I am a widget used to display progress modal dialogs.
  1161. My default instance is accessed with `HLProgressWidget class >> #default`.
  1162. See `HLProgressHandler` for usage.!
  1163. !HLProgressWidget methodsFor: 'accessing'!
  1164. progressBars
  1165. ^ progressBars ifNil: [ progressBars := OrderedCollection new ]
  1166. ! !
  1167. !HLProgressWidget methodsFor: 'actions'!
  1168. addProgressBar: aProgressBar
  1169. self show.
  1170. self progressBars add: aProgressBar.
  1171. aProgressBar appendToJQuery: (self wrapper asJQuery find: '.dialog')
  1172. !
  1173. do: aBlock on: aCollection displaying: aString
  1174. | progressBar |
  1175. progressBar := HLProgressBarWidget new
  1176. parent: self;
  1177. label: aString;
  1178. workBlock: aBlock;
  1179. collection: aCollection;
  1180. yourself.
  1181. self addProgressBar: progressBar.
  1182. progressBar start
  1183. !
  1184. flush
  1185. self progressBars do: [ :each |
  1186. self removeProgressBar: each ]
  1187. !
  1188. remove
  1189. self isVisible ifTrue: [
  1190. visible := false.
  1191. super remove ]
  1192. !
  1193. removeProgressBar: aProgressBar
  1194. self progressBars remove: aProgressBar ifAbsent: [].
  1195. aProgressBar wrapper asJQuery remove.
  1196. self progressBars ifEmpty: [ self remove ]
  1197. !
  1198. show
  1199. self isVisible ifFalse: [
  1200. visible := true.
  1201. super show ]
  1202. ! !
  1203. !HLProgressWidget methodsFor: 'rendering'!
  1204. renderMainOn: html
  1205. self progressBars do: [ :each |
  1206. html with: each ]
  1207. ! !
  1208. !HLProgressWidget methodsFor: 'testing'!
  1209. hasButtons
  1210. ^ false
  1211. !
  1212. isVisible
  1213. ^ visible ifNil: [ false ]
  1214. ! !
  1215. HLProgressWidget class instanceVariableNames: 'default'!
  1216. !HLProgressWidget class methodsFor: 'accessing'!
  1217. default
  1218. ^ default ifNil: [ default := self new ]
  1219. ! !
  1220. HLModalWidget subclass: #HLTabSelectionWidget
  1221. instanceVariableNames: 'tabs tabList selectedTab selectCallback cancelCallback confirmCallback'
  1222. package: 'Helios-Core'!
  1223. !HLTabSelectionWidget commentStamp!
  1224. I am a modal window used to select or create tabs.!
  1225. !HLTabSelectionWidget methodsFor: 'accessing'!
  1226. cancelCallback
  1227. ^ cancelCallback ifNil: [ [] ]
  1228. !
  1229. cancelCallback: aBlock
  1230. cancelCallback := aBlock
  1231. !
  1232. confirmCallback
  1233. ^ confirmCallback ifNil: [ [] ]
  1234. !
  1235. confirmCallback: aBlock
  1236. confirmCallback := aBlock
  1237. !
  1238. selectCallback
  1239. ^ selectCallback ifNil: [ [] ]
  1240. !
  1241. selectCallback: aBlock
  1242. selectCallback := aBlock
  1243. !
  1244. selectedTab
  1245. ^ selectedTab
  1246. !
  1247. selectedTab: aTab
  1248. selectedTab := aTab
  1249. !
  1250. tabs
  1251. ^ tabs ifNil: [ #() ]
  1252. !
  1253. tabs: aCollection
  1254. tabs := aCollection
  1255. ! !
  1256. !HLTabSelectionWidget methodsFor: 'actions'!
  1257. cancel
  1258. super cancel.
  1259. self cancelCallback value
  1260. !
  1261. confirm
  1262. super confirm.
  1263. self confirmCallback value: self selectedTab
  1264. !
  1265. selectTab: aTab
  1266. self selectedTab: aTab.
  1267. self selectCallback value: aTab
  1268. !
  1269. setupKeyBindings
  1270. super setupKeyBindings.
  1271. '.dialog' asJQuery keyup: [ :e |
  1272. e keyCode = String cr asciiValue ifTrue: [ self confirm ] ]
  1273. ! !
  1274. !HLTabSelectionWidget methodsFor: 'rendering'!
  1275. renderContentOn: html
  1276. super renderContentOn: html.
  1277. self tabList focus
  1278. !
  1279. renderMainOn: html
  1280. html div
  1281. class: 'title';
  1282. with: 'Tab selection'.
  1283. html with: self tabList
  1284. !
  1285. renderTab: aTab on: html
  1286. html
  1287. span
  1288. class: aTab cssClass;
  1289. with: aTab label
  1290. !
  1291. renderTabsOn: html
  1292. self tabs do: [ :each |
  1293. html li with: [
  1294. html a
  1295. with: [
  1296. self renderTab: each on: html ];
  1297. onClick: [ self selectTab: each ] ] ]
  1298. !
  1299. tabList
  1300. tabList ifNil: [
  1301. tabList := HLTabListWidget new.
  1302. tabList
  1303. callback: [ :tab | self selectTab: tab. tabList focus ];
  1304. selectedItem: self selectedTab;
  1305. items: self tabs ].
  1306. ^ tabList
  1307. ! !
  1308. HLWidget subclass: #HLProgressBarWidget
  1309. instanceVariableNames: 'label parent workBlock collection bar'
  1310. package: 'Helios-Core'!
  1311. !HLProgressBarWidget commentStamp!
  1312. I am a widget used to display a progress bar while iterating over a collection.!
  1313. !HLProgressBarWidget methodsFor: 'accessing'!
  1314. collection
  1315. ^ collection
  1316. !
  1317. collection: aCollection
  1318. collection := aCollection
  1319. !
  1320. label
  1321. ^ label
  1322. !
  1323. label: aString
  1324. label := aString
  1325. !
  1326. parent
  1327. ^ parent
  1328. !
  1329. parent: aProgress
  1330. parent := aProgress
  1331. !
  1332. workBlock
  1333. ^ workBlock
  1334. !
  1335. workBlock: aBlock
  1336. workBlock := aBlock
  1337. ! !
  1338. !HLProgressBarWidget methodsFor: 'actions'!
  1339. evaluateAt: anInteger
  1340. self updateProgress: (anInteger / self collection size) * 100.
  1341. anInteger <= self collection size
  1342. ifTrue: [
  1343. [
  1344. self workBlock value: (self collection at: anInteger).
  1345. self evaluateAt: anInteger + 1 ] valueWithTimeout: 10 ]
  1346. ifFalse: [ [ self remove ] valueWithTimeout: 500 ]
  1347. !
  1348. remove
  1349. self parent removeProgressBar: self
  1350. !
  1351. start
  1352. "Make sure the UI has some time to update itself between each iteration"
  1353. self evaluateAt: 1
  1354. !
  1355. updateProgress: anInteger
  1356. bar asJQuery css: 'width' put: anInteger asString, '%'
  1357. ! !
  1358. !HLProgressBarWidget methodsFor: 'rendering'!
  1359. renderContentOn: html
  1360. html span with: self label.
  1361. html div
  1362. class: 'progress';
  1363. with: [
  1364. bar := html div
  1365. class: 'bar';
  1366. style: 'width: 0%' ]
  1367. ! !
  1368. HLProgressBarWidget class instanceVariableNames: 'default'!
  1369. !HLProgressBarWidget class methodsFor: 'accessing'!
  1370. default
  1371. ^ default ifNil: [ default := self new ]
  1372. ! !
  1373. HLWidget subclass: #HLSUnit
  1374. instanceVariableNames: ''
  1375. package: 'Helios-Core'!
  1376. !HLSUnit class methodsFor: 'accessing'!
  1377. tabClass
  1378. ^ 'sunit'
  1379. !
  1380. tabLabel
  1381. ^ 'SUnit'
  1382. !
  1383. tabPriority
  1384. ^ 1000
  1385. ! !
  1386. !HLSUnit class methodsFor: 'testing'!
  1387. canBeOpenAsTab
  1388. ^ true
  1389. ! !