1
0

Helios-Core.st 34 KB

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