Helios-Core.st 43 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293
  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: 'tabsWidget environment history announcer'
  886. package: 'Helios-Core'!
  887. !HLManager methodsFor: 'accessing'!
  888. activeTab
  889. ^ self tabsWidget 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 - 90) / self tabs size
  912. !
  913. tabs
  914. ^ self tabsWidget tabs
  915. !
  916. tabsWidget
  917. ^ tabsWidget ifNil: [ tabsWidget := HLTabsWidget new ]
  918. ! !
  919. !HLManager methodsFor: 'actions'!
  920. activate: aTab
  921. self tabsWidget activate: aTab
  922. !
  923. addTab: aTab
  924. self tabsWidget addTab: aTab
  925. !
  926. confirm: aString ifFalse: aBlock
  927. self
  928. confirm: aString
  929. ifTrue: []
  930. ifFalse: aBlock
  931. !
  932. confirm: aString ifTrue: aBlock
  933. self
  934. confirm: aString
  935. ifTrue: aBlock
  936. ifFalse: []
  937. !
  938. confirm: aString ifTrue: aBlock ifFalse: anotherBlock
  939. HLConfirmationWidget new
  940. confirmationString: aString;
  941. actionBlock: aBlock;
  942. cancelBlock: anotherBlock;
  943. show
  944. !
  945. inform: aString
  946. HLInformationWidget new
  947. informationString: aString;
  948. show
  949. !
  950. removeActiveTab
  951. self tabsWidget removeActiveTab
  952. !
  953. request: aString do: aBlock
  954. self
  955. request: aString
  956. value: ''
  957. do: aBlock
  958. !
  959. request: aString value: valueString do: aBlock
  960. HLRequestWidget new
  961. confirmationString: aString;
  962. actionBlock: aBlock;
  963. value: valueString;
  964. show
  965. ! !
  966. !HLManager methodsFor: 'defaults'!
  967. defaultEnvironment
  968. "If helios is loaded from within a frame, answer the parent window environment"
  969. | parent parentSmalltalkGlobals |
  970. parent := window opener ifNil: [ window parent ].
  971. parent ifNil: [ ^ Environment new ].
  972. parentSmalltalkGlobals := (parent at: 'requirejs') value: 'amber_vm/globals'.
  973. parentSmalltalkGlobals ifNil: [ ^ Environment new ].
  974. ^ (parentSmalltalkGlobals at: 'Environment') new
  975. ! !
  976. !HLManager methodsFor: 'initialization'!
  977. setup
  978. self
  979. registerServices;
  980. setupEvents.
  981. self keyBinder setupEvents.
  982. self tabsWidget setupEvents.
  983. '#helper' asJQuery fadeOut
  984. ! !
  985. !HLManager methodsFor: 'private'!
  986. registerServices
  987. self
  988. registerInspector;
  989. registerErrorHandler;
  990. registerProgressHandler;
  991. registerTranscript;
  992. registerFinder
  993. !
  994. setupEvents
  995. 'body' asJQuery keydown: [ :event |
  996. "On ctrl keydown, adds a 'navigation' css class to <body>
  997. for the CodeMirror navigation links. See `HLCodeWidget`."
  998. event ctrlKey ifTrue: [
  999. 'body' asJQuery addClass: 'navigation' ] ].
  1000. 'body' asJQuery keyup: [ :event |
  1001. 'body' asJQuery removeClass: 'navigation' ].
  1002. window asJQuery resize: [ :event |
  1003. self refresh ]
  1004. ! !
  1005. !HLManager methodsFor: 'rendering'!
  1006. renderContentOn: html
  1007. html with: self tabsWidget.
  1008. html with: HLWelcomeWidget new
  1009. ! !
  1010. !HLManager methodsFor: 'services'!
  1011. registerErrorHandler
  1012. self environment registerErrorHandler: HLErrorHandler new.
  1013. ErrorHandler register: HLErrorHandler new
  1014. !
  1015. registerFinder
  1016. self environment registerFinder: HLFinder new.
  1017. Finder register: HLFinder new
  1018. !
  1019. registerInspector
  1020. self environment registerInspector: HLInspector.
  1021. Inspector register: HLInspector
  1022. !
  1023. registerProgressHandler
  1024. self environment registerProgressHandler: HLProgressHandler new.
  1025. ProgressHandler register: HLProgressHandler new
  1026. !
  1027. registerTranscript
  1028. self environment registerTranscript: HLTranscriptHandler
  1029. ! !
  1030. HLManager class instanceVariableNames: 'current'!
  1031. !HLManager class methodsFor: 'accessing'!
  1032. current
  1033. ^ current ifNil: [ current := self basicNew initialize ]
  1034. ! !
  1035. !HLManager class methodsFor: 'initialization'!
  1036. setup
  1037. self current
  1038. setup;
  1039. appendToJQuery: 'body' asJQuery
  1040. ! !
  1041. !HLManager class methodsFor: 'instance creation'!
  1042. new
  1043. "Use current instead"
  1044. self shouldNotImplement
  1045. ! !
  1046. HLWidget subclass: #HLModalWidget
  1047. instanceVariableNames: ''
  1048. package: 'Helios-Core'!
  1049. !HLModalWidget commentStamp!
  1050. I implement an abstract modal widget.!
  1051. !HLModalWidget methodsFor: 'actions'!
  1052. remove
  1053. '.dialog' asJQuery removeClass: 'active'.
  1054. [
  1055. '#overlay' asJQuery remove.
  1056. wrapper asJQuery remove
  1057. ] valueWithTimeout: 300
  1058. !
  1059. show
  1060. self appendToJQuery: 'body' asJQuery
  1061. ! !
  1062. !HLModalWidget methodsFor: 'private'!
  1063. giveFocusToButton: aButton
  1064. aButton asJQuery focus
  1065. ! !
  1066. !HLModalWidget methodsFor: 'rendering'!
  1067. hasButtons
  1068. ^ true
  1069. !
  1070. renderButtonsOn: html
  1071. !
  1072. renderContentOn: html
  1073. | confirmButton |
  1074. html div id: 'overlay'.
  1075. html div
  1076. class: 'dialog ', self cssClass;
  1077. with: [
  1078. self renderMainOn: html.
  1079. self hasButtons ifTrue: [
  1080. self renderButtonsOn: html ] ].
  1081. '.dialog' asJQuery addClass: 'active'.
  1082. self setupKeyBindings
  1083. !
  1084. renderMainOn: html
  1085. !
  1086. setupKeyBindings
  1087. '.dialog' asJQuery keyup: [ :e |
  1088. e keyCode = String esc asciiValue ifTrue: [ self cancel ] ]
  1089. ! !
  1090. HLModalWidget subclass: #HLConfirmationWidget
  1091. instanceVariableNames: 'cancelButtonLabel confirmButtonLabel confirmationString actionBlock cancelBlock'
  1092. package: 'Helios-Core'!
  1093. !HLConfirmationWidget commentStamp!
  1094. I display confirmation dialog.
  1095. ## API
  1096. HLWidget contains convenience methods like `HLWidget >> #confirm:ifTrue:` for creating confirmation dialogs.!
  1097. !HLConfirmationWidget methodsFor: 'accessing'!
  1098. actionBlock
  1099. ^ actionBlock ifNil: [ [] ]
  1100. !
  1101. actionBlock: aBlock
  1102. actionBlock := aBlock
  1103. !
  1104. cancelBlock
  1105. ^ cancelBlock ifNil: [ [] ]
  1106. !
  1107. cancelBlock: aBlock
  1108. cancelBlock := aBlock
  1109. !
  1110. cancelButtonLabel
  1111. ^ cancelButtonLabel ifNil: [ 'Cancel' ]
  1112. !
  1113. cancelButtonLabel: aString
  1114. ^ cancelButtonLabel := aString
  1115. !
  1116. confirmButtonLabel
  1117. ^ confirmButtonLabel ifNil: [ 'Confirm' ]
  1118. !
  1119. confirmButtonLabel: aString
  1120. ^ confirmButtonLabel := aString
  1121. !
  1122. confirmationString
  1123. ^ confirmationString ifNil: [ 'Confirm' ]
  1124. !
  1125. confirmationString: aString
  1126. confirmationString := aString
  1127. ! !
  1128. !HLConfirmationWidget methodsFor: 'actions'!
  1129. cancel
  1130. self cancelBlock value.
  1131. self remove
  1132. !
  1133. confirm
  1134. self remove.
  1135. self actionBlock value
  1136. ! !
  1137. !HLConfirmationWidget methodsFor: 'rendering'!
  1138. renderButtonsOn: html
  1139. | confirmButton |
  1140. html div
  1141. class: 'buttons';
  1142. with: [
  1143. html button
  1144. class: 'button';
  1145. with: self cancelButtonLabel;
  1146. onClick: [ self cancel ].
  1147. confirmButton := html button
  1148. class: 'button default';
  1149. with: self confirmButtonLabel;
  1150. onClick: [ self confirm ] ].
  1151. self giveFocusToButton:confirmButton
  1152. !
  1153. renderMainOn: html
  1154. html span
  1155. class: 'head';
  1156. with: self confirmationString
  1157. ! !
  1158. HLConfirmationWidget subclass: #HLRequestWidget
  1159. instanceVariableNames: 'input multiline value'
  1160. package: 'Helios-Core'!
  1161. !HLRequestWidget commentStamp!
  1162. I display a modal window requesting user input.
  1163. ## API
  1164. `HLWidget >> #request:do:` and `#request:value:do:` are convenience methods for creating modal request dialogs.!
  1165. !HLRequestWidget methodsFor: 'accessing'!
  1166. beMultiline
  1167. multiline := true
  1168. !
  1169. beSingleline
  1170. multiline := false
  1171. !
  1172. cssClass
  1173. ^ 'large'
  1174. !
  1175. value
  1176. ^ value ifNil: [ '' ]
  1177. !
  1178. value: aString
  1179. value := aString
  1180. ! !
  1181. !HLRequestWidget methodsFor: 'actions'!
  1182. confirm
  1183. | val |
  1184. val := input asJQuery val.
  1185. self remove.
  1186. self actionBlock value: val
  1187. ! !
  1188. !HLRequestWidget methodsFor: 'private'!
  1189. giveFocusToButton: aButton
  1190. ! !
  1191. !HLRequestWidget methodsFor: 'rendering'!
  1192. renderMainOn: html
  1193. super renderMainOn: html.
  1194. self isMultiline
  1195. ifTrue: [ input := html textarea ]
  1196. ifFalse: [ input := html input
  1197. type: 'text';
  1198. onKeyDown: [ :event |
  1199. event keyCode = 13 ifTrue: [
  1200. self confirm ] ];
  1201. yourself ].
  1202. input asJQuery
  1203. val: self value;
  1204. focus
  1205. ! !
  1206. !HLRequestWidget methodsFor: 'testing'!
  1207. isMultiline
  1208. ^ multiline ifNil: [ true ]
  1209. ! !
  1210. HLModalWidget subclass: #HLProgressWidget
  1211. instanceVariableNames: 'progressBars visible'
  1212. package: 'Helios-Core'!
  1213. !HLProgressWidget commentStamp!
  1214. I am a widget used to display progress modal dialogs.
  1215. My default instance is accessed with `HLProgressWidget class >> #default`.
  1216. See `HLProgressHandler` for usage.!
  1217. !HLProgressWidget methodsFor: 'accessing'!
  1218. progressBars
  1219. ^ progressBars ifNil: [ progressBars := OrderedCollection new ]
  1220. ! !
  1221. !HLProgressWidget methodsFor: 'actions'!
  1222. addProgressBar: aProgressBar
  1223. self show.
  1224. self progressBars add: aProgressBar.
  1225. aProgressBar appendToJQuery: (self wrapper asJQuery find: '.dialog')
  1226. !
  1227. do: aBlock on: aCollection displaying: aString
  1228. | progressBar |
  1229. progressBar := HLProgressBarWidget new
  1230. parent: self;
  1231. label: aString;
  1232. workBlock: aBlock;
  1233. collection: aCollection;
  1234. yourself.
  1235. self addProgressBar: progressBar.
  1236. progressBar start
  1237. !
  1238. flush
  1239. self progressBars do: [ :each |
  1240. self removeProgressBar: each ]
  1241. !
  1242. remove
  1243. self isVisible ifTrue: [
  1244. visible := false.
  1245. super remove ]
  1246. !
  1247. removeProgressBar: aProgressBar
  1248. self progressBars remove: aProgressBar ifAbsent: [].
  1249. aProgressBar wrapper asJQuery remove.
  1250. self progressBars ifEmpty: [ self remove ]
  1251. !
  1252. show
  1253. self isVisible ifFalse: [
  1254. visible := true.
  1255. super show ]
  1256. ! !
  1257. !HLProgressWidget methodsFor: 'rendering'!
  1258. renderMainOn: html
  1259. self progressBars do: [ :each |
  1260. html with: each ]
  1261. ! !
  1262. !HLProgressWidget methodsFor: 'testing'!
  1263. hasButtons
  1264. ^ false
  1265. !
  1266. isVisible
  1267. ^ visible ifNil: [ false ]
  1268. ! !
  1269. HLProgressWidget class instanceVariableNames: 'default'!
  1270. !HLProgressWidget class methodsFor: 'accessing'!
  1271. default
  1272. ^ default ifNil: [ default := self new ]
  1273. ! !
  1274. HLModalWidget subclass: #HLTabSelectionWidget
  1275. instanceVariableNames: 'tabs tabList selectedTab selectCallback cancelCallback confirmCallback'
  1276. package: 'Helios-Core'!
  1277. !HLTabSelectionWidget commentStamp!
  1278. I am a modal window used to select or create tabs.!
  1279. !HLTabSelectionWidget methodsFor: 'accessing'!
  1280. cancelCallback
  1281. ^ cancelCallback ifNil: [ [] ]
  1282. !
  1283. cancelCallback: aBlock
  1284. cancelCallback := aBlock
  1285. !
  1286. confirmCallback
  1287. ^ confirmCallback ifNil: [ [] ]
  1288. !
  1289. confirmCallback: aBlock
  1290. confirmCallback := aBlock
  1291. !
  1292. selectCallback
  1293. ^ selectCallback ifNil: [ [] ]
  1294. !
  1295. selectCallback: aBlock
  1296. selectCallback := aBlock
  1297. !
  1298. selectedTab
  1299. ^ selectedTab
  1300. !
  1301. selectedTab: aTab
  1302. selectedTab := aTab
  1303. !
  1304. tabs
  1305. ^ tabs ifNil: [ #() ]
  1306. !
  1307. tabs: aCollection
  1308. tabs := aCollection
  1309. ! !
  1310. !HLTabSelectionWidget methodsFor: 'actions'!
  1311. cancel
  1312. self remove.
  1313. self cancelCallback value
  1314. !
  1315. confirm
  1316. self remove.
  1317. self confirmCallback value: self selectedTab
  1318. !
  1319. selectTab: aTab
  1320. self selectedTab: aTab.
  1321. self selectCallback value: aTab
  1322. !
  1323. setupKeyBindings
  1324. super setupKeyBindings.
  1325. '.dialog' asJQuery keyup: [ :e |
  1326. e keyCode = String cr asciiValue ifTrue: [ self confirm ] ]
  1327. ! !
  1328. !HLTabSelectionWidget methodsFor: 'rendering'!
  1329. renderButtonsOn: html
  1330. | confirmButton |
  1331. html div
  1332. class: 'buttons';
  1333. with: [
  1334. html button
  1335. class: 'button';
  1336. with: 'Cancel';
  1337. onClick: [ self cancel ].
  1338. confirmButton := html button
  1339. class: 'button default';
  1340. with: 'Select tab';
  1341. onClick: [ self confirm ] ].
  1342. self giveFocusToButton:confirmButton
  1343. !
  1344. renderContentOn: html
  1345. super renderContentOn: html.
  1346. self tabList focus
  1347. !
  1348. renderMainOn: html
  1349. html div
  1350. class: 'title';
  1351. with: 'Tab selection'.
  1352. html with: self tabList
  1353. !
  1354. renderTab: aTab on: html
  1355. html
  1356. span
  1357. class: aTab cssClass;
  1358. with: aTab label
  1359. !
  1360. renderTabsOn: html
  1361. self tabs do: [ :each |
  1362. html li with: [
  1363. html a
  1364. with: [
  1365. self renderTab: each on: html ];
  1366. onClick: [ self selectTab: each ] ] ]
  1367. !
  1368. tabList
  1369. tabList ifNil: [
  1370. tabList := HLTabListWidget new.
  1371. tabList
  1372. callback: [ :tab | self selectTab: tab. tabList focus ];
  1373. selectedItem: self selectedTab;
  1374. items: self tabs ].
  1375. ^ tabList
  1376. ! !
  1377. HLWidget subclass: #HLProgressBarWidget
  1378. instanceVariableNames: 'label parent workBlock collection bar'
  1379. package: 'Helios-Core'!
  1380. !HLProgressBarWidget commentStamp!
  1381. I am a widget used to display a progress bar while iterating over a collection.!
  1382. !HLProgressBarWidget methodsFor: 'accessing'!
  1383. collection
  1384. ^ collection
  1385. !
  1386. collection: aCollection
  1387. collection := aCollection
  1388. !
  1389. label
  1390. ^ label
  1391. !
  1392. label: aString
  1393. label := aString
  1394. !
  1395. parent
  1396. ^ parent
  1397. !
  1398. parent: aProgress
  1399. parent := aProgress
  1400. !
  1401. workBlock
  1402. ^ workBlock
  1403. !
  1404. workBlock: aBlock
  1405. workBlock := aBlock
  1406. ! !
  1407. !HLProgressBarWidget methodsFor: 'actions'!
  1408. evaluateAt: anInteger
  1409. self updateProgress: (anInteger / self collection size) * 100.
  1410. anInteger <= self collection size
  1411. ifTrue: [
  1412. [
  1413. self workBlock value: (self collection at: anInteger).
  1414. self evaluateAt: anInteger + 1 ] valueWithTimeout: 10 ]
  1415. ifFalse: [ [ self remove ] valueWithTimeout: 500 ]
  1416. !
  1417. remove
  1418. self parent removeProgressBar: self
  1419. !
  1420. start
  1421. "Make sure the UI has some time to update itself between each iteration"
  1422. self evaluateAt: 1
  1423. !
  1424. updateProgress: anInteger
  1425. bar asJQuery css: 'width' put: anInteger asString, '%'
  1426. ! !
  1427. !HLProgressBarWidget methodsFor: 'rendering'!
  1428. renderContentOn: html
  1429. html span with: self label.
  1430. html div
  1431. class: 'progress';
  1432. with: [
  1433. bar := html div
  1434. class: 'bar';
  1435. style: 'width: 0%' ]
  1436. ! !
  1437. HLProgressBarWidget class instanceVariableNames: 'default'!
  1438. !HLProgressBarWidget class methodsFor: 'accessing'!
  1439. default
  1440. ^ default ifNil: [ default := self new ]
  1441. ! !
  1442. HLWidget subclass: #HLTabWidget
  1443. instanceVariableNames: 'widget label root'
  1444. package: 'Helios-Core'!
  1445. !HLTabWidget commentStamp!
  1446. I am a widget specialized into building another widget as an Helios tab.
  1447. I should not be used directly, `HLWidget class >> #openAsTab` should be used instead.
  1448. ## Example
  1449. HLWorkspace openAsTab!
  1450. !HLTabWidget methodsFor: 'accessing'!
  1451. activate
  1452. self manager activate: self
  1453. !
  1454. cssClass
  1455. ^ self widget tabClass
  1456. !
  1457. focus
  1458. self widget canHaveFocus ifTrue: [
  1459. self widget focus ]
  1460. !
  1461. label
  1462. ^ label ifNil: [ '' ]
  1463. !
  1464. label: aString
  1465. label := aString
  1466. !
  1467. manager
  1468. ^ HLManager current
  1469. !
  1470. widget
  1471. ^ widget
  1472. !
  1473. widget: aWidget
  1474. widget := aWidget
  1475. ! !
  1476. !HLTabWidget methodsFor: 'actions'!
  1477. add
  1478. self manager addTab: self.
  1479. self observeManager
  1480. !
  1481. hide
  1482. root ifNotNil: [ root asJQuery css: 'visibility' put: 'hidden' ]
  1483. !
  1484. observeManager
  1485. self manager announcer
  1486. on: HLTabLabelChanged
  1487. send: #onTabLabelChanged:
  1488. to: self
  1489. !
  1490. registerBindings
  1491. self widget registerBindings
  1492. !
  1493. remove
  1494. self unregister.
  1495. self widget unregister.
  1496. root ifNotNil: [ root asJQuery remove ]
  1497. !
  1498. show
  1499. root
  1500. ifNil: [ self appendToJQuery: 'body' asJQuery ]
  1501. ifNotNil: [ root asJQuery css: 'visibility' put: 'visible' ]
  1502. !
  1503. unregister
  1504. self manager announcer unsubscribe: self
  1505. ! !
  1506. !HLTabWidget methodsFor: 'reactions'!
  1507. onTabLabelChanged: anAnnouncement
  1508. anAnnouncement widget = self widget ifTrue: [
  1509. self label = anAnnouncement label ifFalse: [
  1510. self label: anAnnouncement label.
  1511. self manager refresh ] ]
  1512. ! !
  1513. !HLTabWidget methodsFor: 'rendering'!
  1514. renderOn: html
  1515. root := html div
  1516. class: 'tab';
  1517. yourself.
  1518. self renderTab
  1519. !
  1520. renderTab
  1521. root contents: [ :html |
  1522. html div
  1523. class: 'amber_box';
  1524. with: [ self widget renderOn: html ] ]
  1525. ! !
  1526. !HLTabWidget methodsFor: 'testing'!
  1527. isActive
  1528. ^ self manager activeTab = self
  1529. ! !
  1530. !HLTabWidget class methodsFor: 'instance creation'!
  1531. on: aWidget labelled: aString
  1532. ^ self new
  1533. widget: aWidget;
  1534. label: aString;
  1535. yourself
  1536. ! !
  1537. HLWidget subclass: #HLTabsWidget
  1538. instanceVariableNames: 'tabs activeTab history selectionDisabled'
  1539. package: 'Helios-Core'!
  1540. !HLTabsWidget methodsFor: 'accessing'!
  1541. activeTab
  1542. ^ activeTab
  1543. !
  1544. history
  1545. ^ history ifNil: [ history := OrderedCollection new ]
  1546. !
  1547. history: aCollection
  1548. history := aCollection
  1549. !
  1550. tabWidth
  1551. ^ (window asJQuery width - 90) / self tabs size
  1552. !
  1553. tabs
  1554. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  1555. ! !
  1556. !HLTabsWidget methodsFor: 'actions'!
  1557. activate: aTab
  1558. self isSelectionDisabled ifTrue: [ ^ self ].
  1559. self manager keyBinder flushBindings.
  1560. aTab registerBindings.
  1561. activeTab := aTab.
  1562. self
  1563. refresh;
  1564. addToHistory: aTab;
  1565. show: aTab
  1566. !
  1567. activateNextTab
  1568. | nextTab |
  1569. self tabs ifEmpty: [ ^ self ].
  1570. nextTab := self tabs
  1571. at: (self tabs indexOf: self activeTab) + 1
  1572. ifAbsent: [ self tabs first ].
  1573. self activate: nextTab
  1574. !
  1575. activatePreviousTab
  1576. | previousTab |
  1577. self tabs ifEmpty: [ ^ self ].
  1578. previousTab := self tabs
  1579. at: (self tabs indexOf: self activeTab) - 1
  1580. ifAbsent: [ self tabs last ].
  1581. self activate: previousTab
  1582. !
  1583. addTab: aTab
  1584. self tabs add: aTab.
  1585. self activate: aTab
  1586. !
  1587. addToHistory: aTab
  1588. self removeFromHistory: aTab.
  1589. self history add: aTab
  1590. !
  1591. disableSelection
  1592. selectionDisabled := true
  1593. !
  1594. enableSelection
  1595. selectionDisabled := false
  1596. !
  1597. removeActiveTab
  1598. self removeTab: self activeTab
  1599. !
  1600. removeFromHistory: aTab
  1601. self history: (self history reject: [ :each | each == aTab ])
  1602. !
  1603. removeTab: aTab
  1604. (self tabs includes: aTab) ifFalse: [ ^ self ].
  1605. self removeFromHistory: aTab.
  1606. self tabs remove: aTab.
  1607. self manager keyBinder flushBindings.
  1608. aTab remove.
  1609. self refresh.
  1610. self history ifNotEmpty: [
  1611. self history last activate ]
  1612. !
  1613. updateTabsOrder
  1614. tabs := '.main-tabs li' asJQuery toArray
  1615. collect: [ :each | each at: 'tab-data' ]
  1616. ! !
  1617. !HLTabsWidget methodsFor: 'private'!
  1618. setupEvents
  1619. 'body' asJQuery keydown: [ :event |
  1620. "ctrl+> and ctrl+<"
  1621. (event ctrlKey and: [ event which = 188 ]) ifTrue: [
  1622. self activatePreviousTab.
  1623. event preventDefault ].
  1624. (event ctrlKey and: [ event which = 190 ]) ifTrue: [
  1625. self activateNextTab.
  1626. event preventDefault ] ]
  1627. ! !
  1628. !HLTabsWidget methodsFor: 'rendering'!
  1629. renderAddOn: html
  1630. html div
  1631. class: 'dropdown new_tab';
  1632. with: [
  1633. html a
  1634. class: 'dropdown-toggle';
  1635. at: 'data-toggle' put: 'dropdown';
  1636. with: [
  1637. (html tag: 'b') class: 'caret' ].
  1638. html ul
  1639. class: 'dropdown-menu';
  1640. with: [
  1641. ((HLWidget withAllSubclasses
  1642. select: [ :each | each canBeOpenAsTab ])
  1643. sorted: [ :a :b | a tabPriority < b tabPriority ])
  1644. do: [ :each |
  1645. html li with: [
  1646. html a
  1647. with: each tabLabel;
  1648. onClick: [ each openAsTab ] ] ] ] ]
  1649. !
  1650. renderContentOn: html
  1651. html div
  1652. class: 'navbar navbar-fixed-top';
  1653. with: [ html div
  1654. class: 'navbar-inner';
  1655. with: [ self renderTabsOn: html ] ].
  1656. self renderAddOn: html
  1657. !
  1658. renderTab: aTab on: html
  1659. | li |
  1660. li := html li
  1661. style: 'width: ', self tabWidth asString, 'px';
  1662. class: (aTab isActive ifTrue: [ 'tab active' ] ifFalse: [ 'tab inactive' ]);
  1663. with: [
  1664. html a
  1665. with: [
  1666. ((html tag: 'i') class: 'close')
  1667. onClick: [ self removeTab: aTab ].
  1668. html span
  1669. class: aTab cssClass;
  1670. title: aTab label;
  1671. with: aTab label ] ];
  1672. onClick: [ aTab activate ].
  1673. (li asJQuery get: 0) at: 'tab-data' put: aTab
  1674. !
  1675. renderTabsOn: html
  1676. | ul |
  1677. ul := html ul
  1678. class: 'nav main-tabs';
  1679. with: [
  1680. self tabs do: [ :each |
  1681. self renderTab: each on: html ] ].
  1682. ul asJQuery sortable: #{
  1683. 'containment' -> 'parent'.
  1684. 'start' -> [ self disableSelection ].
  1685. 'stop' -> [ [ self enableSelection] valueWithTimeout: 300 ].
  1686. 'update' -> [ self updateTabsOrder ]
  1687. }
  1688. !
  1689. show: aTab
  1690. self tabs do: [ :each | each hide ].
  1691. aTab show; focus
  1692. ! !
  1693. !HLTabsWidget methodsFor: 'testing'!
  1694. isSelectionDisabled
  1695. ^ selectionDisabled ifNil: [ false ]
  1696. ! !
  1697. HLTabsWidget class instanceVariableNames: 'current'!
  1698. HLWidget subclass: #HLWelcomeWidget
  1699. instanceVariableNames: ''
  1700. package: 'Helios-Core'!
  1701. !HLWelcomeWidget methodsFor: 'accessing'!
  1702. cssClass
  1703. ^ 'welcome'
  1704. ! !
  1705. !HLWelcomeWidget methodsFor: 'actions'!
  1706. openClassBrowser
  1707. HLBrowser openAsTab
  1708. !
  1709. openHelp
  1710. !
  1711. openTestRunner
  1712. !
  1713. openWorkspace
  1714. HLWorkspace openAsTab
  1715. ! !
  1716. !HLWelcomeWidget methodsFor: 'rendering'!
  1717. renderButtonsOn: html
  1718. html button
  1719. class: 'button';
  1720. with: 'Class Browser';
  1721. onClick: [ self openClassBrowser ].
  1722. html button
  1723. class: 'button';
  1724. with: 'Workspace';
  1725. onClick: [ self openWorkspace ].
  1726. html button
  1727. class: 'button';
  1728. with: 'Test Runner';
  1729. onClick: [ self openTestRunner ].
  1730. html button
  1731. class: 'button';
  1732. with: 'Help';
  1733. onClick: [ self openHelp ]
  1734. !
  1735. renderContentOn: html
  1736. self
  1737. renderHelpOn: html;
  1738. renderButtonsOn: html
  1739. !
  1740. renderHelpOn: html
  1741. html h2 with: 'No tools are open'.
  1742. html ul with: [
  1743. html li with: 'Perform actions with ctrl + space'.
  1744. html li with: 'Open one of the common tools:' ]
  1745. ! !