1
0

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