Helios-Core.st 35 KB

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