Helios-Core.st 40 KB

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