Helios-Core.st 46 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407
  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 selectedClass: (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. removeTab
  414. self manager removeTabForWidget: self
  415. !
  416. setTabLabel: aString
  417. self manager announcer announce: (HLTabLabelChanged new
  418. widget: self;
  419. label: aString;
  420. yourself)
  421. !
  422. tabClass
  423. ^ self class tabClass
  424. !
  425. wrapper
  426. ^ wrapper
  427. ! !
  428. !HLWidget methodsFor: 'actions'!
  429. confirm: aString ifTrue: aBlock
  430. self manager confirm: aString ifTrue: aBlock
  431. !
  432. confirm: aString ifTrue: aBlock ifFalse: anotherBlock
  433. self manager
  434. confirm: aString
  435. ifTrue: aBlock
  436. ifFalse: anotherBlock
  437. !
  438. execute: aCommand
  439. HLManager current keyBinder
  440. activate;
  441. applyBinding: aCommand asBinding
  442. !
  443. inform: aString
  444. self manager inform: aString
  445. !
  446. openAsTab
  447. (HLTabWidget on: self labelled: self defaultTabLabel)
  448. add
  449. !
  450. request: aString do: aBlock
  451. self manager request: aString do: aBlock
  452. !
  453. request: aString value: valueString do: aBlock
  454. self manager
  455. request: aString
  456. value: valueString
  457. do: aBlock
  458. !
  459. unregister
  460. "This method is called whenever the receiver is closed (as a tab).
  461. Widgets subscribing to announcements should unregister there"
  462. ! !
  463. !HLWidget methodsFor: 'defaults'!
  464. defaultTabLabel
  465. ^ self class tabLabel
  466. ! !
  467. !HLWidget methodsFor: 'keybindings'!
  468. bindKeyDown: keyDownBlock keyUp: keyUpBlock
  469. self wrapper asJQuery
  470. keydown: keyDownBlock;
  471. keyup: keyUpBlock
  472. !
  473. registerBindings
  474. self registerBindingsOn: self manager keyBinder bindings
  475. !
  476. registerBindingsOn: aBindingGroup
  477. !
  478. unbindKeyDownKeyUp
  479. self wrapper asJQuery
  480. unbind: 'keydown';
  481. unbind: 'keyup'
  482. ! !
  483. !HLWidget methodsFor: 'rendering'!
  484. renderContentOn: html
  485. !
  486. renderOn: html
  487. wrapper := html div
  488. class: self cssClass;
  489. yourself.
  490. [ :renderer | self renderContentOn: renderer ] appendToJQuery: wrapper asJQuery
  491. ! !
  492. !HLWidget methodsFor: 'testing'!
  493. canHaveFocus
  494. ^ false
  495. ! !
  496. !HLWidget methodsFor: 'updating'!
  497. refresh
  498. self wrapper ifNil: [ ^ self ].
  499. self wrapper asJQuery empty.
  500. [ :html | self renderContentOn: html ] appendToJQuery: self wrapper asJQuery
  501. ! !
  502. !HLWidget class methodsFor: 'accessing'!
  503. openAsTab
  504. | instance |
  505. instance := self new.
  506. (HLTabWidget
  507. on: instance
  508. labelled: instance defaultTabLabel) add.
  509. ^ instance
  510. !
  511. tabClass
  512. ^ ''
  513. !
  514. tabLabel
  515. ^ 'Tab'
  516. !
  517. tabPriority
  518. ^ 500
  519. ! !
  520. !HLWidget class methodsFor: 'testing'!
  521. canBeOpenAsTab
  522. ^ false
  523. ! !
  524. HLWidget subclass: #HLFocusableWidget
  525. instanceVariableNames: ''
  526. package: 'Helios-Core'!
  527. !HLFocusableWidget commentStamp!
  528. I am a widget that can be focused.
  529. ## API
  530. Instead of overriding `#renderOn:` as with other `Widget` subclasses, my subclasses should override `#renderContentOn:`.
  531. To bring the focus to the widget, use the `#focus` method.!
  532. !HLFocusableWidget methodsFor: 'accessing'!
  533. focusClass
  534. ^ 'focused'
  535. ! !
  536. !HLFocusableWidget methodsFor: 'events'!
  537. blur
  538. self wrapper asJQuery blur
  539. !
  540. focus
  541. self wrapper asJQuery focus
  542. ! !
  543. !HLFocusableWidget methodsFor: 'rendering'!
  544. renderContentOn: html
  545. !
  546. renderOn: html
  547. wrapper := html div
  548. class: self cssClass;
  549. yourself.
  550. wrapper with: [ self renderContentOn: html ].
  551. wrapper
  552. at: 'tabindex' put: '0';
  553. onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
  554. onFocus: [ self wrapper asJQuery addClass: self focusClass ]
  555. ! !
  556. !HLFocusableWidget methodsFor: 'testing'!
  557. canHaveFocus
  558. ^ true
  559. !
  560. hasFocus
  561. ^ self wrapper notNil and: [ self wrapper asJQuery hasClass: self focusClass ]
  562. ! !
  563. HLFocusableWidget subclass: #HLListWidget
  564. instanceVariableNames: 'items selectedItem'
  565. package: 'Helios-Core'!
  566. !HLListWidget methodsFor: 'accessing'!
  567. activeItemCssClass
  568. ^'active'
  569. !
  570. buttonsDivCssClass
  571. ^ 'pane_actions form-actions'
  572. !
  573. cssClassForItem: anObject
  574. ^ ''
  575. !
  576. findListItemFor: anObject
  577. ^ (((wrapper asJQuery find: 'li')
  578. filter: [ :thisArg :otherArg | (thisArg asJQuery data: 'item') = anObject ] currySelf) eq: 0)
  579. !
  580. items
  581. ^ items ifNil: [ items := self defaultItems ]
  582. !
  583. items: aCollection
  584. items := aCollection
  585. !
  586. listCssClass
  587. ^'nav nav-pills nav-stacked'
  588. !
  589. listCssClassForItem: anObject
  590. ^ self selectedItem = anObject
  591. ifTrue: [ self activeItemCssClass ]
  592. ifFalse: [ 'inactive' ]
  593. !
  594. positionOf: aListItem
  595. <
  596. return aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1
  597. >
  598. !
  599. selectedItem
  600. ^ selectedItem
  601. !
  602. selectedItem: anObject
  603. selectedItem := anObject
  604. ! !
  605. !HLListWidget methodsFor: 'actions'!
  606. activateFirstListItem
  607. self activateListItem: ((wrapper asJQuery find: 'li.inactive') eq: 0)
  608. !
  609. activateItem: anObject
  610. self activateListItem: (self findListItemFor: anObject)
  611. !
  612. activateListItem: aListItem
  613. | item |
  614. (aListItem get: 0) ifNil: [ ^ self ].
  615. aListItem parent children removeClass: self activeItemCssClass.
  616. aListItem addClass: self activeItemCssClass.
  617. self ensureVisible: aListItem.
  618. "Activate the corresponding item"
  619. item := aListItem data: 'item'.
  620. self selectedItem == item ifFalse: [
  621. self selectItem: item ]
  622. !
  623. activateNextListItem
  624. self activateListItem: (self wrapper asJQuery find: ('li.', self activeItemCssClass)) next.
  625. "select the first item if none is selected"
  626. (self wrapper asJQuery find: (' .', self activeItemCssClass)) get ifEmpty: [
  627. self activateFirstListItem ]
  628. !
  629. activatePreviousListItem
  630. self activateListItem: (self wrapper asJQuery find: ('li.', self activeItemCssClass)) prev
  631. !
  632. ensureVisible: aListItem
  633. "Move the scrollbar to show the active element"
  634. | parent position |
  635. (aListItem get: 0) ifNil: [ ^ self ].
  636. position := self positionOf: aListItem.
  637. parent := aListItem parent.
  638. aListItem position top < 0 ifTrue: [
  639. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
  640. aListItem position top + aListItem height > parent height ifTrue: [
  641. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ]
  642. !
  643. focus
  644. super focus.
  645. self items isEmpty ifFalse: [
  646. self selectedItem ifNil: [ self activateFirstListItem ] ]
  647. !
  648. reactivateListItem: aListItem
  649. self activateListItem: aListItem.
  650. self reselectItem: self selectedItem
  651. !
  652. refresh
  653. super refresh.
  654. self selectedItem ifNotNil: [self ensureVisible: (self findListItemFor: self selectedItem)].
  655. !
  656. reselectItem: anObject
  657. !
  658. selectItem: anObject
  659. self selectedItem: anObject
  660. ! !
  661. !HLListWidget methodsFor: 'defaults'!
  662. defaultItems
  663. ^ #()
  664. ! !
  665. !HLListWidget methodsFor: 'events'!
  666. setupKeyBindings
  667. (HLRepeatedKeyDownHandler on: self)
  668. whileKeyDown: 38 do: [ self activatePreviousListItem ];
  669. whileKeyDown: 40 do: [ self activateNextListItem ];
  670. rebindKeys.
  671. self wrapper asJQuery keydown: [ :e |
  672. e which = 13 ifTrue: [
  673. self reselectItem: self selectedItem ] ]
  674. ! !
  675. !HLListWidget methodsFor: 'reactions'!
  676. onItemDoubleClicked: anEvent on: anObject
  677. "The item that this widget has rendered for anObject has been double clicked."
  678. "no-op"
  679. ! !
  680. !HLListWidget methodsFor: 'rendering'!
  681. renderButtonsOn: html
  682. !
  683. renderContentOn: html
  684. html ul
  685. class: self listCssClass;
  686. with: [ self renderListOn: html ];
  687. onClick: [ self focus ].
  688. html div class: self buttonsDivCssClass; with: [
  689. self renderButtonsOn: html ].
  690. self setupKeyBindings
  691. !
  692. renderItem: anObject on: html
  693. | li a |
  694. li := html li.
  695. li asJQuery data: 'item' put: anObject.
  696. li
  697. class: (self listCssClassForItem: anObject);
  698. with: [
  699. a := html a
  700. with: [
  701. (html tag: 'i') class: (self cssClassForItem: anObject).
  702. self renderItemLabel: anObject on: html ];
  703. onClick: [ self reactivateListItem: li asJQuery ].
  704. a asJQuery dblclick: [ :ev | self onItemDoubleClicked: ev on: anObject ].
  705. ]
  706. !
  707. renderItemLabel: anObject on: html
  708. html with: anObject asString
  709. !
  710. renderListOn: html
  711. self items do: [ :each |
  712. self renderItem: each on: html ]
  713. ! !
  714. HLListWidget subclass: #HLNavigationListWidget
  715. instanceVariableNames: 'previous next'
  716. package: 'Helios-Core'!
  717. !HLNavigationListWidget methodsFor: 'accessing'!
  718. next
  719. ^ next
  720. !
  721. next: aWidget
  722. next := aWidget.
  723. aWidget previous = self ifFalse: [ aWidget previous: self ]
  724. !
  725. previous
  726. ^ previous
  727. !
  728. previous: aWidget
  729. previous := aWidget.
  730. aWidget next = self ifFalse: [ aWidget next: self ]
  731. ! !
  732. !HLNavigationListWidget methodsFor: 'actions'!
  733. nextFocus
  734. self next ifNotNil: [ self next focus ]
  735. !
  736. previousFocus
  737. self previous ifNotNil: [ self previous focus ]
  738. ! !
  739. !HLNavigationListWidget methodsFor: 'events'!
  740. setupKeyBindings
  741. super setupKeyBindings.
  742. self wrapper asJQuery keydown: [ :e |
  743. e which = 39 ifTrue: [
  744. self nextFocus ].
  745. e which = 37 ifTrue: [
  746. self previousFocus ] ]
  747. ! !
  748. HLNavigationListWidget subclass: #HLToolListWidget
  749. instanceVariableNames: 'model'
  750. package: 'Helios-Core'!
  751. !HLToolListWidget methodsFor: 'accessing'!
  752. commandCategory
  753. ^ self label
  754. !
  755. label
  756. ^ 'List'
  757. !
  758. menuCommands
  759. "Answer a collection of commands to be put in the cog menu"
  760. ^ ((HLToolCommand concreteClasses
  761. select: [ :each | each isValidFor: self model ])
  762. collect: [ :each | each for: self model ])
  763. select: [ :each |
  764. each category = self commandCategory and: [
  765. each isAction and: [ each isActive ] ] ]
  766. !
  767. model
  768. ^ model
  769. !
  770. model: aBrowserModel
  771. model := aBrowserModel.
  772. self
  773. observeSystem;
  774. observeModel
  775. !
  776. selectedItem: anItem
  777. "Selection changed, update the cog menu"
  778. super selectedItem: anItem.
  779. self updateMenu
  780. ! !
  781. !HLToolListWidget methodsFor: 'actions'!
  782. activateListItem: anItem
  783. self model withChangesDo: [ super activateListItem: anItem ]
  784. !
  785. activateNextListItem
  786. self model withChangesDo: [ super activateNextListItem ]
  787. !
  788. activatePreviousListItem
  789. self model withChangesDo: [ super activatePreviousListItem ]
  790. !
  791. observeModel
  792. !
  793. observeSystem
  794. !
  795. reactivateListItem: anItem
  796. self model withChangesDo: [ super reactivateListItem: anItem ]
  797. !
  798. unregister
  799. super unregister.
  800. self model announcer unsubscribe: self.
  801. self model systemAnnouncer unsubscribe: self
  802. ! !
  803. !HLToolListWidget methodsFor: 'rendering'!
  804. renderContentOn: html
  805. self renderHeadOn: html.
  806. super renderContentOn: html
  807. !
  808. renderHeadOn: html
  809. html div
  810. class: 'list-label';
  811. with: [
  812. html with: self label.
  813. self renderMenuOn: html ]
  814. !
  815. renderMenuOn: html
  816. | commands |
  817. commands := self menuCommands.
  818. commands isEmpty ifTrue: [ ^ self ].
  819. html div
  820. class: 'btn-group cog';
  821. with: [
  822. html a
  823. class: 'btn dropdown-toggle';
  824. at: 'data-toggle' put: 'dropdown';
  825. with: [ (html tag: 'i') class: 'icon-chevron-down' ].
  826. html ul
  827. class: 'dropdown-menu pull-right';
  828. with: [
  829. self menuCommands do: [ :each |
  830. html li with: [ html a
  831. with: each menuLabel;
  832. onClick: [ self execute: each ] ] ] ] ]
  833. ! !
  834. !HLToolListWidget methodsFor: 'updating'!
  835. updateMenu
  836. (self wrapper asJQuery find: '.cog') remove.
  837. [ :html | self renderMenuOn: html ]
  838. appendToJQuery: (self wrapper asJQuery find: '.list-label')
  839. ! !
  840. !HLToolListWidget class methodsFor: 'instance creation'!
  841. on: aModel
  842. ^ self new
  843. model: aModel;
  844. yourself
  845. ! !
  846. HLListWidget subclass: #HLTabListWidget
  847. instanceVariableNames: 'callback'
  848. package: 'Helios-Core'!
  849. !HLTabListWidget commentStamp!
  850. I am a widget used to display a list of helios tabs.
  851. When a tab is selected, `callback` is evaluated with the selected tab as argument.!
  852. !HLTabListWidget methodsFor: 'accessing'!
  853. callback
  854. ^ callback ifNil: [ [] ]
  855. !
  856. callback: aBlock
  857. callback := aBlock
  858. ! !
  859. !HLTabListWidget methodsFor: 'actions'!
  860. selectItem: aTab
  861. super selectItem: aTab.
  862. self callback value: aTab
  863. ! !
  864. !HLTabListWidget methodsFor: 'rendering'!
  865. renderItemLabel: aTab on: html
  866. html span
  867. class: aTab cssClass;
  868. with: aTab label
  869. ! !
  870. HLWidget subclass: #HLInformationWidget
  871. instanceVariableNames: 'informationString'
  872. package: 'Helios-Core'!
  873. !HLInformationWidget commentStamp!
  874. I display an information dialog.
  875. ## API
  876. `HLWidget >> #inform:` is a convenience method for creating information dialogs.!
  877. !HLInformationWidget methodsFor: 'accessing'!
  878. informationString
  879. ^ informationString ifNil: [ '' ]
  880. !
  881. informationString: anObject
  882. informationString := anObject
  883. ! !
  884. !HLInformationWidget methodsFor: 'actions'!
  885. remove
  886. [
  887. self wrapper asJQuery fadeOut: 100.
  888. [ self wrapper asJQuery remove ]
  889. valueWithTimeout: 400.
  890. ]
  891. valueWithTimeout: 1500
  892. !
  893. show
  894. self appendToJQuery: 'body' asJQuery
  895. ! !
  896. !HLInformationWidget methodsFor: 'rendering'!
  897. renderContentOn: html
  898. html div
  899. class: 'growl';
  900. with: self informationString.
  901. self remove
  902. ! !
  903. HLWidget subclass: #HLManager
  904. instanceVariableNames: 'topBarWidget tabsWidget environment history announcer'
  905. package: 'Helios-Core'!
  906. !HLManager methodsFor: 'accessing'!
  907. activeTab
  908. ^ self tabsWidget activeTab
  909. !
  910. announcer
  911. ^ announcer ifNil: [ announcer := Announcer new ]
  912. !
  913. environment
  914. "The default environment used by all Helios objects"
  915. ^ environment ifNil: [ environment := self defaultEnvironment ]
  916. !
  917. environment: anEnvironment
  918. environment := anEnvironment
  919. !
  920. history
  921. ^ history ifNil: [ history := OrderedCollection new ]
  922. !
  923. history: aCollection
  924. history := aCollection
  925. !
  926. keyBinder
  927. ^ HLKeyBinder current
  928. !
  929. setEditorTheme: aTheme
  930. 'helios.editorTheme' asSetting value: aTheme
  931. !
  932. setTheme: aTheme
  933. | currentTheme |
  934. currentTheme := 'helios.theme' asSettingIfAbsent: 'default'.
  935. 'body' asJQuery
  936. removeClass: currentTheme value;
  937. addClass: aTheme.
  938. 'helios.theme' asSetting value: aTheme
  939. !
  940. tabWidth
  941. ^ (window asJQuery width - 90) / self tabs size
  942. !
  943. tabs
  944. ^ self tabsWidget tabs
  945. !
  946. tabsWidget
  947. ^ tabsWidget ifNil: [ tabsWidget := HLTabsWidget new ]
  948. !
  949. topBarWidget
  950. ^ topBarWidget ifNil: [ topBarWidget := HLTopBarWidget new ]
  951. ! !
  952. !HLManager methodsFor: 'actions'!
  953. activate: aTab
  954. self tabsWidget activate: aTab
  955. !
  956. addTab: aTab
  957. self tabsWidget addTab: aTab
  958. !
  959. confirm: aString ifFalse: aBlock
  960. self
  961. confirm: aString
  962. ifTrue: []
  963. ifFalse: aBlock
  964. !
  965. confirm: aString ifTrue: aBlock
  966. self
  967. confirm: aString
  968. ifTrue: aBlock
  969. ifFalse: []
  970. !
  971. confirm: aString ifTrue: aBlock ifFalse: anotherBlock
  972. HLConfirmationWidget new
  973. confirmationString: aString;
  974. actionBlock: aBlock;
  975. cancelBlock: anotherBlock;
  976. show
  977. !
  978. inform: aString
  979. HLInformationWidget new
  980. informationString: aString;
  981. show
  982. !
  983. removeActiveTab
  984. self tabsWidget removeActiveTab
  985. !
  986. removeTabForWidget: aWidget
  987. self tabsWidget removeTabForWidget: aWidget
  988. !
  989. request: aString do: aBlock
  990. self
  991. request: aString
  992. value: ''
  993. do: aBlock
  994. !
  995. request: aString value: valueString do: aBlock
  996. HLRequestWidget new
  997. confirmationString: aString;
  998. actionBlock: aBlock;
  999. value: valueString;
  1000. show
  1001. ! !
  1002. !HLManager methodsFor: 'defaults'!
  1003. defaultEnvironment
  1004. "If helios is loaded from within a frame, answer the parent window environment"
  1005. | parent parentSmalltalkGlobals |
  1006. parent := window opener ifNil: [ window parent ].
  1007. parent ifNil: [ ^ Environment new ].
  1008. [ parentSmalltalkGlobals := ((parent at: 'requirejs') value: 'amber/boot') at: 'globals' ]
  1009. on: Error do: [ parentSmalltalkGlobals := (parent at: 'requirejs') value: 'amber_vm/globals' ].
  1010. parentSmalltalkGlobals ifNil: [ ^ Environment new ].
  1011. ^ (parentSmalltalkGlobals at: 'Environment') new
  1012. ! !
  1013. !HLManager methodsFor: 'initialization'!
  1014. setup
  1015. self
  1016. registerServices;
  1017. setupEvents.
  1018. self keyBinder setupEvents.
  1019. self tabsWidget setupEvents.
  1020. self setupTheme.
  1021. '#helper' asJQuery fadeOut
  1022. ! !
  1023. !HLManager methodsFor: 'private'!
  1024. registerServices
  1025. self
  1026. registerInspector;
  1027. registerErrorHandler;
  1028. registerProgressHandler;
  1029. registerTranscript;
  1030. registerFinder
  1031. !
  1032. setupEvents
  1033. 'body' asJQuery keydown: [ :event |
  1034. "On ctrl keydown, adds a 'navigation' css class to <body>
  1035. for the CodeMirror navigation links. See `HLCodeWidget`."
  1036. event ctrlKey ifTrue: [
  1037. 'body' asJQuery addClass: 'navigation' ] ].
  1038. 'body' asJQuery keyup: [ :event |
  1039. 'body' asJQuery removeClass: 'navigation' ].
  1040. window asJQuery resize: [ :event |
  1041. self refresh ]
  1042. !
  1043. setupTheme
  1044. "self
  1045. setTheme: 'niflheim';
  1046. setEditorTheme: 'niflheim'."
  1047. self
  1048. setTheme: 'default';
  1049. setEditorTheme: 'default'.
  1050. ! !
  1051. !HLManager methodsFor: 'rendering'!
  1052. renderContentOn: html
  1053. html with: self topBarWidget.
  1054. html with: self tabsWidget.
  1055. html with: HLWelcomeWidget new
  1056. ! !
  1057. !HLManager methodsFor: 'services'!
  1058. registerErrorHandler
  1059. self environment registerErrorHandler: HLErrorHandler new.
  1060. ErrorHandler register: HLErrorHandler new
  1061. !
  1062. registerFinder
  1063. self environment registerFinder: HLFinder new.
  1064. Finder register: HLFinder new
  1065. !
  1066. registerInspector
  1067. self environment registerInspector: HLInspector.
  1068. Inspector register: HLInspector
  1069. !
  1070. registerProgressHandler
  1071. self environment registerProgressHandler: HLProgressHandler new.
  1072. ProgressHandler register: HLProgressHandler new
  1073. !
  1074. registerTranscript
  1075. self environment registerTranscript: HLTranscriptHandler
  1076. ! !
  1077. HLManager class instanceVariableNames: 'current'!
  1078. !HLManager class methodsFor: 'accessing'!
  1079. current
  1080. ^ current ifNil: [ current := self basicNew initialize ]
  1081. ! !
  1082. !HLManager class methodsFor: 'initialization'!
  1083. setup
  1084. self current
  1085. setup;
  1086. appendToJQuery: 'body' asJQuery
  1087. ! !
  1088. !HLManager class methodsFor: 'instance creation'!
  1089. new
  1090. "Use current instead"
  1091. self shouldNotImplement
  1092. ! !
  1093. HLWidget subclass: #HLModalWidget
  1094. instanceVariableNames: ''
  1095. package: 'Helios-Core'!
  1096. !HLModalWidget commentStamp!
  1097. I implement an abstract modal widget.!
  1098. !HLModalWidget methodsFor: 'actions'!
  1099. remove
  1100. '.dialog' asJQuery removeClass: 'active'.
  1101. [
  1102. '#overlay' asJQuery remove.
  1103. wrapper asJQuery remove
  1104. ] valueWithTimeout: 300
  1105. !
  1106. show
  1107. self appendToJQuery: 'body' asJQuery
  1108. ! !
  1109. !HLModalWidget methodsFor: 'private'!
  1110. giveFocusToButton: aButton
  1111. aButton asJQuery focus
  1112. ! !
  1113. !HLModalWidget methodsFor: 'rendering'!
  1114. hasButtons
  1115. ^ true
  1116. !
  1117. renderButtonsOn: html
  1118. !
  1119. renderContentOn: html
  1120. | confirmButton |
  1121. html div id: 'overlay'.
  1122. html div
  1123. class: 'dialog ', self cssClass;
  1124. with: [
  1125. self renderMainOn: html.
  1126. self hasButtons ifTrue: [
  1127. self renderButtonsOn: html ] ].
  1128. '.dialog' asJQuery addClass: 'active'.
  1129. self setupKeyBindings
  1130. !
  1131. renderMainOn: html
  1132. !
  1133. setupKeyBindings
  1134. '.dialog' asJQuery keyup: [ :e |
  1135. e keyCode = String esc asciiValue ifTrue: [ self cancel ] ]
  1136. ! !
  1137. HLModalWidget subclass: #HLConfirmationWidget
  1138. instanceVariableNames: 'cancelButtonLabel confirmButtonLabel confirmationString actionBlock cancelBlock'
  1139. package: 'Helios-Core'!
  1140. !HLConfirmationWidget commentStamp!
  1141. I display confirmation dialog.
  1142. ## API
  1143. HLWidget contains convenience methods like `HLWidget >> #confirm:ifTrue:` for creating confirmation dialogs.!
  1144. !HLConfirmationWidget methodsFor: 'accessing'!
  1145. actionBlock
  1146. ^ actionBlock ifNil: [ [] ]
  1147. !
  1148. actionBlock: aBlock
  1149. actionBlock := aBlock
  1150. !
  1151. cancelBlock
  1152. ^ cancelBlock ifNil: [ [] ]
  1153. !
  1154. cancelBlock: aBlock
  1155. cancelBlock := aBlock
  1156. !
  1157. cancelButtonLabel
  1158. ^ cancelButtonLabel ifNil: [ 'Cancel' ]
  1159. !
  1160. cancelButtonLabel: aString
  1161. ^ cancelButtonLabel := aString
  1162. !
  1163. confirmButtonLabel
  1164. ^ confirmButtonLabel ifNil: [ 'Confirm' ]
  1165. !
  1166. confirmButtonLabel: aString
  1167. ^ confirmButtonLabel := aString
  1168. !
  1169. confirmationString
  1170. ^ confirmationString ifNil: [ 'Confirm' ]
  1171. !
  1172. confirmationString: aString
  1173. confirmationString := aString
  1174. ! !
  1175. !HLConfirmationWidget methodsFor: 'actions'!
  1176. cancel
  1177. self cancelBlock value.
  1178. self remove
  1179. !
  1180. confirm
  1181. self remove.
  1182. self actionBlock value
  1183. ! !
  1184. !HLConfirmationWidget methodsFor: 'rendering'!
  1185. renderButtonsOn: html
  1186. | confirmButton |
  1187. html div
  1188. class: 'buttons';
  1189. with: [
  1190. html button
  1191. class: 'button';
  1192. with: self cancelButtonLabel;
  1193. onClick: [ self cancel ].
  1194. confirmButton := html button
  1195. class: 'button default';
  1196. with: self confirmButtonLabel;
  1197. onClick: [ self confirm ] ].
  1198. self giveFocusToButton:confirmButton
  1199. !
  1200. renderMainOn: html
  1201. html span
  1202. class: 'head';
  1203. with: self confirmationString
  1204. ! !
  1205. HLConfirmationWidget subclass: #HLRequestWidget
  1206. instanceVariableNames: 'input multiline value'
  1207. package: 'Helios-Core'!
  1208. !HLRequestWidget commentStamp!
  1209. I display a modal window requesting user input.
  1210. ## API
  1211. `HLWidget >> #request:do:` and `#request:value:do:` are convenience methods for creating modal request dialogs.!
  1212. !HLRequestWidget methodsFor: 'accessing'!
  1213. beMultiline
  1214. multiline := true
  1215. !
  1216. beSingleline
  1217. multiline := false
  1218. !
  1219. cssClass
  1220. ^ 'large'
  1221. !
  1222. value
  1223. ^ value ifNil: [ '' ]
  1224. !
  1225. value: aString
  1226. value := aString
  1227. ! !
  1228. !HLRequestWidget methodsFor: 'actions'!
  1229. confirm
  1230. | val |
  1231. val := input asJQuery val.
  1232. self remove.
  1233. self actionBlock value: val
  1234. ! !
  1235. !HLRequestWidget methodsFor: 'private'!
  1236. giveFocusToButton: aButton
  1237. ! !
  1238. !HLRequestWidget methodsFor: 'rendering'!
  1239. renderMainOn: html
  1240. super renderMainOn: html.
  1241. self isMultiline
  1242. ifTrue: [ input := html textarea ]
  1243. ifFalse: [ input := html input
  1244. type: 'text';
  1245. onKeyDown: [ :event |
  1246. event keyCode = 13 ifTrue: [
  1247. self confirm ] ];
  1248. yourself ].
  1249. input asJQuery
  1250. val: self value;
  1251. focus
  1252. ! !
  1253. !HLRequestWidget methodsFor: 'testing'!
  1254. isMultiline
  1255. ^ multiline ifNil: [ true ]
  1256. ! !
  1257. HLModalWidget subclass: #HLProgressWidget
  1258. instanceVariableNames: 'progressBars visible'
  1259. package: 'Helios-Core'!
  1260. !HLProgressWidget commentStamp!
  1261. I am a widget used to display progress modal dialogs.
  1262. My default instance is accessed with `HLProgressWidget class >> #default`.
  1263. See `HLProgressHandler` for usage.!
  1264. !HLProgressWidget methodsFor: 'accessing'!
  1265. progressBars
  1266. ^ progressBars ifNil: [ progressBars := OrderedCollection new ]
  1267. ! !
  1268. !HLProgressWidget methodsFor: 'actions'!
  1269. addProgressBar: aProgressBar
  1270. self show.
  1271. self progressBars add: aProgressBar.
  1272. aProgressBar appendToJQuery: (self wrapper asJQuery find: '.dialog')
  1273. !
  1274. do: aBlock on: aCollection displaying: aString
  1275. | progressBar |
  1276. progressBar := HLProgressBarWidget new
  1277. parent: self;
  1278. label: aString;
  1279. workBlock: aBlock;
  1280. collection: aCollection;
  1281. yourself.
  1282. self addProgressBar: progressBar.
  1283. progressBar start
  1284. !
  1285. flush
  1286. self progressBars do: [ :each |
  1287. self removeProgressBar: each ]
  1288. !
  1289. remove
  1290. self isVisible ifTrue: [
  1291. visible := false.
  1292. super remove ]
  1293. !
  1294. removeProgressBar: aProgressBar
  1295. self progressBars remove: aProgressBar ifAbsent: [].
  1296. aProgressBar wrapper asJQuery remove.
  1297. self progressBars ifEmpty: [ self remove ]
  1298. !
  1299. show
  1300. self isVisible ifFalse: [
  1301. visible := true.
  1302. super show ]
  1303. ! !
  1304. !HLProgressWidget methodsFor: 'rendering'!
  1305. renderMainOn: html
  1306. self progressBars do: [ :each |
  1307. html with: each ]
  1308. ! !
  1309. !HLProgressWidget methodsFor: 'testing'!
  1310. hasButtons
  1311. ^ false
  1312. !
  1313. isVisible
  1314. ^ visible ifNil: [ false ]
  1315. ! !
  1316. HLProgressWidget class instanceVariableNames: 'default'!
  1317. !HLProgressWidget class methodsFor: 'accessing'!
  1318. default
  1319. ^ default ifNil: [ default := self new ]
  1320. ! !
  1321. HLModalWidget subclass: #HLTabSelectionWidget
  1322. instanceVariableNames: 'tabs tabList selectedTab selectCallback cancelCallback confirmCallback'
  1323. package: 'Helios-Core'!
  1324. !HLTabSelectionWidget commentStamp!
  1325. I am a modal window used to select or create tabs.!
  1326. !HLTabSelectionWidget methodsFor: 'accessing'!
  1327. cancelCallback
  1328. ^ cancelCallback ifNil: [ [] ]
  1329. !
  1330. cancelCallback: aBlock
  1331. cancelCallback := aBlock
  1332. !
  1333. confirmCallback
  1334. ^ confirmCallback ifNil: [ [] ]
  1335. !
  1336. confirmCallback: aBlock
  1337. confirmCallback := aBlock
  1338. !
  1339. selectCallback
  1340. ^ selectCallback ifNil: [ [] ]
  1341. !
  1342. selectCallback: aBlock
  1343. selectCallback := aBlock
  1344. !
  1345. selectedTab
  1346. ^ selectedTab
  1347. !
  1348. selectedTab: aTab
  1349. selectedTab := aTab
  1350. !
  1351. tabs
  1352. ^ tabs ifNil: [ #() ]
  1353. !
  1354. tabs: aCollection
  1355. tabs := aCollection
  1356. ! !
  1357. !HLTabSelectionWidget methodsFor: 'actions'!
  1358. cancel
  1359. self remove.
  1360. self cancelCallback value
  1361. !
  1362. confirm
  1363. self remove.
  1364. self confirmCallback value: self selectedTab
  1365. !
  1366. selectTab: aTab
  1367. self selectedTab: aTab.
  1368. self selectCallback value: aTab
  1369. !
  1370. setupKeyBindings
  1371. super setupKeyBindings.
  1372. '.dialog' asJQuery keyup: [ :e |
  1373. e keyCode = String cr asciiValue ifTrue: [ self confirm ] ]
  1374. ! !
  1375. !HLTabSelectionWidget methodsFor: 'rendering'!
  1376. renderButtonsOn: html
  1377. | confirmButton |
  1378. html div
  1379. class: 'buttons';
  1380. with: [
  1381. html button
  1382. class: 'button';
  1383. with: 'Cancel';
  1384. onClick: [ self cancel ].
  1385. confirmButton := html button
  1386. class: 'button default';
  1387. with: 'Select tab';
  1388. onClick: [ self confirm ] ].
  1389. self giveFocusToButton:confirmButton
  1390. !
  1391. renderContentOn: html
  1392. super renderContentOn: html.
  1393. self tabList focus
  1394. !
  1395. renderMainOn: html
  1396. html div
  1397. class: 'title';
  1398. with: 'Tab selection'.
  1399. html with: self tabList
  1400. !
  1401. renderTab: aTab on: html
  1402. html
  1403. span
  1404. class: aTab cssClass;
  1405. with: aTab label
  1406. !
  1407. renderTabsOn: html
  1408. self tabs do: [ :each |
  1409. html li with: [
  1410. html a
  1411. with: [
  1412. self renderTab: each on: html ];
  1413. onClick: [ self selectTab: each ] ] ]
  1414. !
  1415. tabList
  1416. tabList ifNil: [
  1417. tabList := HLTabListWidget new.
  1418. tabList
  1419. callback: [ :tab | self selectTab: tab. tabList focus ];
  1420. selectedItem: self selectedTab;
  1421. items: self tabs ].
  1422. ^ tabList
  1423. ! !
  1424. HLWidget subclass: #HLProgressBarWidget
  1425. instanceVariableNames: 'label parent workBlock collection bar'
  1426. package: 'Helios-Core'!
  1427. !HLProgressBarWidget commentStamp!
  1428. I am a widget used to display a progress bar while iterating over a collection.!
  1429. !HLProgressBarWidget methodsFor: 'accessing'!
  1430. collection
  1431. ^ collection
  1432. !
  1433. collection: aCollection
  1434. collection := aCollection
  1435. !
  1436. label
  1437. ^ label
  1438. !
  1439. label: aString
  1440. label := aString
  1441. !
  1442. parent
  1443. ^ parent
  1444. !
  1445. parent: aProgress
  1446. parent := aProgress
  1447. !
  1448. workBlock
  1449. ^ workBlock
  1450. !
  1451. workBlock: aBlock
  1452. workBlock := aBlock
  1453. ! !
  1454. !HLProgressBarWidget methodsFor: 'actions'!
  1455. evaluateAt: anInteger
  1456. self updateProgress: (anInteger / self collection size) * 100.
  1457. anInteger <= self collection size
  1458. ifTrue: [
  1459. [
  1460. self workBlock value: (self collection at: anInteger).
  1461. self evaluateAt: anInteger + 1 ] valueWithTimeout: 10 ]
  1462. ifFalse: [ [ self remove ] valueWithTimeout: 500 ]
  1463. !
  1464. remove
  1465. self parent removeProgressBar: self
  1466. !
  1467. start
  1468. "Make sure the UI has some time to update itself between each iteration"
  1469. self evaluateAt: 1
  1470. !
  1471. updateProgress: anInteger
  1472. bar asJQuery css: 'width' put: anInteger asString, '%'
  1473. ! !
  1474. !HLProgressBarWidget methodsFor: 'rendering'!
  1475. renderContentOn: html
  1476. html span with: self label.
  1477. html div
  1478. class: 'progress';
  1479. with: [
  1480. bar := html div
  1481. class: 'bar';
  1482. style: 'width: 0%' ]
  1483. ! !
  1484. HLProgressBarWidget class instanceVariableNames: 'default'!
  1485. !HLProgressBarWidget class methodsFor: 'accessing'!
  1486. default
  1487. ^ default ifNil: [ default := self new ]
  1488. ! !
  1489. HLWidget subclass: #HLTabWidget
  1490. instanceVariableNames: 'widget label root'
  1491. package: 'Helios-Core'!
  1492. !HLTabWidget commentStamp!
  1493. I am a widget specialized into building another widget as an Helios tab.
  1494. I should not be used directly, `HLWidget class >> #openAsTab` should be used instead.
  1495. ## Example
  1496. HLWorkspace openAsTab!
  1497. !HLTabWidget methodsFor: 'accessing'!
  1498. activate
  1499. self manager activate: self
  1500. !
  1501. cssClass
  1502. ^ self widget tabClass
  1503. !
  1504. focus
  1505. self widget canHaveFocus ifTrue: [
  1506. self widget focus ]
  1507. !
  1508. label
  1509. ^ label ifNil: [ '' ]
  1510. !
  1511. label: aString
  1512. label := aString
  1513. !
  1514. manager
  1515. ^ HLManager current
  1516. !
  1517. widget
  1518. ^ widget
  1519. !
  1520. widget: aWidget
  1521. widget := aWidget
  1522. ! !
  1523. !HLTabWidget methodsFor: 'actions'!
  1524. add
  1525. self manager addTab: self.
  1526. self observeManager
  1527. !
  1528. hide
  1529. root ifNotNil: [ root asJQuery css: 'visibility' put: 'hidden' ]
  1530. !
  1531. observeManager
  1532. self manager announcer
  1533. on: HLTabLabelChanged
  1534. send: #onTabLabelChanged:
  1535. to: self
  1536. !
  1537. registerBindings
  1538. self widget registerBindings
  1539. !
  1540. remove
  1541. self unregister.
  1542. self widget unregister.
  1543. root ifNotNil: [ root asJQuery remove ]
  1544. !
  1545. show
  1546. root
  1547. ifNil: [ self appendToJQuery: 'body' asJQuery ]
  1548. ifNotNil: [ root asJQuery css: 'visibility' put: 'visible' ]
  1549. !
  1550. unregister
  1551. self manager announcer unsubscribe: self
  1552. ! !
  1553. !HLTabWidget methodsFor: 'reactions'!
  1554. onTabLabelChanged: anAnnouncement
  1555. anAnnouncement widget = self widget ifTrue: [
  1556. self label = anAnnouncement label ifFalse: [
  1557. self label: anAnnouncement label.
  1558. self manager refresh ] ]
  1559. ! !
  1560. !HLTabWidget methodsFor: 'rendering'!
  1561. renderOn: html
  1562. root := html div
  1563. class: 'tab';
  1564. yourself.
  1565. self renderTab
  1566. !
  1567. renderTab
  1568. root contents: [ :html |
  1569. html div
  1570. class: 'amber_box';
  1571. with: [ self widget renderOn: html ] ]
  1572. ! !
  1573. !HLTabWidget methodsFor: 'testing'!
  1574. isActive
  1575. ^ self manager activeTab = self
  1576. ! !
  1577. !HLTabWidget class methodsFor: 'instance creation'!
  1578. on: aWidget labelled: aString
  1579. ^ self new
  1580. widget: aWidget;
  1581. label: aString;
  1582. yourself
  1583. ! !
  1584. HLWidget subclass: #HLTabsWidget
  1585. instanceVariableNames: 'tabs activeTab history selectionDisabled'
  1586. package: 'Helios-Core'!
  1587. !HLTabsWidget methodsFor: 'accessing'!
  1588. activeTab
  1589. ^ activeTab
  1590. !
  1591. history
  1592. ^ history ifNil: [ history := OrderedCollection new ]
  1593. !
  1594. history: aCollection
  1595. history := aCollection
  1596. !
  1597. tabWidth
  1598. ^ (window asJQuery width - 90) / self tabs size
  1599. !
  1600. tabs
  1601. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  1602. ! !
  1603. !HLTabsWidget methodsFor: 'actions'!
  1604. activate: aTab
  1605. self isSelectionDisabled ifTrue: [ ^ self ].
  1606. self manager keyBinder flushBindings.
  1607. aTab registerBindings.
  1608. activeTab := aTab.
  1609. self
  1610. refresh;
  1611. addToHistory: aTab;
  1612. show: aTab
  1613. !
  1614. activateNextTab
  1615. | nextTab |
  1616. self tabs ifEmpty: [ ^ self ].
  1617. nextTab := self tabs
  1618. at: (self tabs indexOf: self activeTab) + 1
  1619. ifAbsent: [ self tabs first ].
  1620. self activate: nextTab
  1621. !
  1622. activatePreviousTab
  1623. | previousTab |
  1624. self tabs ifEmpty: [ ^ self ].
  1625. previousTab := self tabs
  1626. at: (self tabs indexOf: self activeTab) - 1
  1627. ifAbsent: [ self tabs last ].
  1628. self activate: previousTab
  1629. !
  1630. addTab: aTab
  1631. self tabs add: aTab.
  1632. self activate: aTab
  1633. !
  1634. addToHistory: aTab
  1635. self removeFromHistory: aTab.
  1636. self history add: aTab
  1637. !
  1638. disableSelection
  1639. selectionDisabled := true
  1640. !
  1641. enableSelection
  1642. selectionDisabled := false
  1643. !
  1644. removeActiveTab
  1645. self removeTab: self activeTab
  1646. !
  1647. removeFromHistory: aTab
  1648. self history: (self history reject: [ :each | each == aTab ])
  1649. !
  1650. removeTab: aTab
  1651. (self tabs includes: aTab) ifFalse: [ ^ self ].
  1652. self removeFromHistory: aTab.
  1653. self tabs remove: aTab.
  1654. self manager keyBinder flushBindings.
  1655. aTab remove.
  1656. self refresh.
  1657. self history ifNotEmpty: [
  1658. self history last activate ]
  1659. !
  1660. removeTabForWidget: aWidget
  1661. self removeTab: (self tabs
  1662. detect: [ :each | each widget = aWidget ]
  1663. ifNone: [ ^ self ])
  1664. !
  1665. updateTabsOrder
  1666. tabs := '.main-tabs li' asJQuery toArray
  1667. collect: [ :each | each at: 'tab-data' ]
  1668. ! !
  1669. !HLTabsWidget methodsFor: 'private'!
  1670. setupEvents
  1671. 'body' asJQuery keydown: [ :event |
  1672. "ctrl+> and ctrl+<"
  1673. (event ctrlKey and: [ event which = 188 ]) ifTrue: [
  1674. self activatePreviousTab.
  1675. event preventDefault ].
  1676. (event ctrlKey and: [ event which = 190 ]) ifTrue: [
  1677. self activateNextTab.
  1678. event preventDefault ] ]
  1679. ! !
  1680. !HLTabsWidget methodsFor: 'rendering'!
  1681. renderAddOn: html
  1682. html div
  1683. class: 'dropdown new_tab';
  1684. with: [
  1685. html a
  1686. class: 'dropdown-toggle';
  1687. at: 'data-toggle' put: 'dropdown';
  1688. with: [
  1689. (html tag: 'b') class: 'caret' ].
  1690. html ul
  1691. class: 'dropdown-menu';
  1692. with: [
  1693. ((HLWidget withAllSubclasses
  1694. select: [ :each | each canBeOpenAsTab ])
  1695. sorted: [ :a :b | a tabPriority < b tabPriority ])
  1696. do: [ :each |
  1697. html li with: [
  1698. html a
  1699. with: each tabLabel;
  1700. onClick: [ each openAsTab ] ] ] ] ]
  1701. !
  1702. renderContentOn: html
  1703. html div
  1704. class: 'navbar navbar-fixed-top';
  1705. with: [ html div
  1706. class: 'navbar-inner';
  1707. with: [ self renderTabsOn: html ] ].
  1708. "obsolete
  1709. self renderAddOn: html"
  1710. !
  1711. renderTab: aTab on: html
  1712. | li |
  1713. li := html li
  1714. style: 'width: ', self tabWidth asString, 'px';
  1715. class: (aTab isActive ifTrue: [ 'tab active' ] ifFalse: [ 'tab inactive' ]);
  1716. with: [
  1717. html a
  1718. with: [
  1719. ((html tag: 'i') class: 'close')
  1720. onClick: [ self removeTab: aTab ].
  1721. html span
  1722. class: aTab cssClass;
  1723. title: aTab label;
  1724. with: aTab label ] ];
  1725. onClick: [ aTab activate ].
  1726. (li asJQuery get: 0) at: 'tab-data' put: aTab
  1727. !
  1728. renderTabsOn: html
  1729. | ul |
  1730. ul := html ul
  1731. class: 'nav main-tabs';
  1732. with: [
  1733. self tabs do: [ :each |
  1734. self renderTab: each on: html ] ].
  1735. ul asJQuery sortable: #{
  1736. 'containment' -> 'parent'.
  1737. 'start' -> [ self disableSelection ].
  1738. 'stop' -> [ [ self enableSelection] valueWithTimeout: 300 ].
  1739. 'update' -> [ self updateTabsOrder ]
  1740. }
  1741. !
  1742. show: aTab
  1743. self tabs do: [ :each | each hide ].
  1744. aTab show; focus
  1745. ! !
  1746. !HLTabsWidget methodsFor: 'testing'!
  1747. isSelectionDisabled
  1748. ^ selectionDisabled ifNil: [ false ]
  1749. ! !
  1750. HLTabsWidget class instanceVariableNames: 'current'!
  1751. HLWidget subclass: #HLTopBarWidget
  1752. instanceVariableNames: 'inputView'
  1753. package: 'Helios-Core'!
  1754. !HLTopBarWidget methodsFor: 'reactions'!
  1755. onSearchKeyUp: anEvent
  1756. anEvent keyCode = 13 ifTrue:[
  1757. self search: inputView asJQuery val ]
  1758. !
  1759. search: aString
  1760. HLReferences openAsTab search: aString
  1761. ! !
  1762. !HLTopBarWidget methodsFor: 'rendering'!
  1763. renderContentOn: html
  1764. html div
  1765. class: 'toolbar';
  1766. with: [ html div
  1767. "class: 'navbar-inner';"
  1768. with: [
  1769. inputView := html input
  1770. class: 'search';
  1771. at: 'placeholder' put: 'Search classes, senders and more..';
  1772. onKeyUp: [ :ev | self onSearchKeyUp: ev ];
  1773. value: ''.
  1774. html div
  1775. class: 'buttons_bar';
  1776. with: [
  1777. html button class: 'button'; onClick: [ HLBrowser openAsTab ]; with: 'Browser'.
  1778. html button class: 'button'; onClick: [ HLWorkspace openAsTab ]; with: 'Workspace'.
  1779. html button class: 'button'; onClick: [ HLSUnit openAsTab ]; with: 'Tests' ].
  1780. ] ].
  1781. ! !
  1782. HLWidget subclass: #HLWelcomeWidget
  1783. instanceVariableNames: ''
  1784. package: 'Helios-Core'!
  1785. !HLWelcomeWidget methodsFor: 'accessing'!
  1786. cssClass
  1787. ^ 'welcome'
  1788. ! !
  1789. !HLWelcomeWidget methodsFor: 'actions'!
  1790. openClassBrowser
  1791. HLBrowser openAsTab
  1792. !
  1793. openHelp
  1794. !
  1795. openTestRunner
  1796. HLSUnit openAsTab
  1797. !
  1798. openWorkspace
  1799. HLWorkspace openAsTab
  1800. ! !
  1801. !HLWelcomeWidget methodsFor: 'rendering'!
  1802. renderButtonsOn: html
  1803. html button
  1804. class: 'button';
  1805. with: 'Class Browser';
  1806. onClick: [ self openClassBrowser ].
  1807. html button
  1808. class: 'button';
  1809. with: 'Workspace';
  1810. onClick: [ self openWorkspace ].
  1811. html button
  1812. class: 'button';
  1813. with: 'Test Runner';
  1814. onClick: [ self openTestRunner ].
  1815. "html button
  1816. class: 'button';
  1817. with: 'Help';
  1818. onClick: [ self openHelp ]"
  1819. !
  1820. renderContentOn: html
  1821. self
  1822. renderHelpOn: html;
  1823. renderButtonsOn: html
  1824. !
  1825. renderHelpOn: html
  1826. html h2 with: 'No tools are open'.
  1827. html ul with: [
  1828. html li with: 'Perform actions with ctrl + space'.
  1829. html li with: 'Open one of the common tools:' ]
  1830. ! !