1
0

Helios-Core.st 31 KB

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