1
0

Helios-Core.st 35 KB

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