Helios-Core.st 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707
  1. Smalltalk current createPackage: 'Helios-Core'!
  2. Widget subclass: #HLTab
  3. instanceVariableNames: 'widget label root'
  4. package: 'Helios-Core'!
  5. !HLTab methodsFor: 'accessing'!
  6. activate
  7. self manager activate: self
  8. !
  9. add
  10. self manager addTab: self
  11. !
  12. displayLabel
  13. ^ self label size > 20
  14. ifTrue: [ (self label first: 20), '...' ]
  15. ifFalse: [ self label ]
  16. !
  17. focus
  18. self widget canHaveFocus ifTrue: [
  19. self widget focus ]
  20. !
  21. label
  22. ^ label ifNil: [ '' ]
  23. !
  24. label: aString
  25. label := aString
  26. !
  27. manager
  28. ^ HLManager current
  29. !
  30. widget
  31. ^ widget
  32. !
  33. widget: aWidget
  34. widget := aWidget
  35. ! !
  36. !HLTab methodsFor: 'actions'!
  37. hide
  38. root ifNotNil: [
  39. root asJQuery hide ]
  40. !
  41. registerBindings
  42. self widget registerBindings
  43. !
  44. remove
  45. root ifNotNil: [ root asJQuery remove ]
  46. !
  47. show
  48. root
  49. ifNil: [ self appendToJQuery: 'body' asJQuery ]
  50. ifNotNil: [ root asJQuery show ]
  51. ! !
  52. !HLTab methodsFor: 'rendering'!
  53. renderOn: html
  54. root := html div
  55. class: 'tab';
  56. yourself.
  57. self renderTab
  58. !
  59. renderTab
  60. root contents: [ :html |
  61. html div
  62. class: 'amber_box';
  63. with: [ self widget renderOn: html ] ]
  64. ! !
  65. !HLTab methodsFor: 'testing'!
  66. isActive
  67. ^ self manager activeTab = self
  68. ! !
  69. !HLTab class methodsFor: 'instance creation'!
  70. on: aWidget labelled: aString
  71. ^ self new
  72. widget: aWidget;
  73. label: aString;
  74. yourself
  75. ! !
  76. Widget subclass: #HLWidget
  77. instanceVariableNames: 'wrapper'
  78. package: 'Helios-Core'!
  79. !HLWidget methodsFor: 'accessing'!
  80. manager
  81. ^ HLManager current
  82. !
  83. wrapper
  84. ^ wrapper
  85. ! !
  86. !HLWidget methodsFor: 'actions'!
  87. alert: aString
  88. window alert: aString
  89. !
  90. confirm: aString
  91. ^ window confirm: aString
  92. ! !
  93. !HLWidget methodsFor: 'keybindings'!
  94. registerBindings
  95. self registerBindingsOn: self manager keyBinder bindings
  96. !
  97. registerBindingsOn: aBindingGroup
  98. ! !
  99. !HLWidget methodsFor: 'rendering'!
  100. renderContentOn: html
  101. !
  102. renderOn: html
  103. wrapper := html div.
  104. [ :renderer | self renderContentOn: renderer ] appendToJQuery: wrapper asJQuery
  105. ! !
  106. !HLWidget methodsFor: 'testing'!
  107. canHaveFocus
  108. ^ false
  109. ! !
  110. !HLWidget methodsFor: 'updating'!
  111. refresh
  112. self wrapper ifNil: [ ^ self ].
  113. self wrapper asJQuery empty.
  114. [ :html | self renderContentOn: html ] appendToJQuery: self wrapper asJQuery
  115. ! !
  116. !HLWidget class methodsFor: 'accessing'!
  117. openAsTab
  118. self canBeOpenAsTab ifFalse: [ ^ self ].
  119. HLManager current addTab: (HLTab on: self new labelled: self tabLabel)
  120. !
  121. tabLabel
  122. ^ 'Tab'
  123. !
  124. tabPriority
  125. ^ 500
  126. ! !
  127. !HLWidget class methodsFor: 'testing'!
  128. canBeOpenAsTab
  129. ^ false
  130. ! !
  131. HLWidget subclass: #HLDebugger
  132. instanceVariableNames: ''
  133. package: 'Helios-Core'!
  134. HLWidget subclass: #HLFocusableWidget
  135. instanceVariableNames: 'hiddenInput'
  136. package: 'Helios-Core'!
  137. !HLFocusableWidget methodsFor: 'accessing'!
  138. focusClass
  139. ^ 'focused'
  140. ! !
  141. !HLFocusableWidget methodsFor: 'events'!
  142. blur
  143. hiddenInput asJQuery blur
  144. !
  145. focus
  146. hiddenInput asJQuery focus
  147. !
  148. hasFocus
  149. ^ self wrapper notNil and: [ self wrapper asJQuery hasClass: self focusClass ]
  150. ! !
  151. !HLFocusableWidget methodsFor: 'rendering'!
  152. renderContentOn: html
  153. !
  154. renderHiddenInputOn: html
  155. hiddenInput := html input
  156. style: 'position: absolute; left: -100000px;';
  157. onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
  158. onFocus: [ self wrapper asJQuery addClass: self focusClass ]
  159. !
  160. renderOn: html
  161. self registerBindings.
  162. self renderHiddenInputOn: html.
  163. wrapper := html div
  164. class: 'hl_widget';
  165. onClick: [ hiddenInput asJQuery focus ];
  166. with: [
  167. self renderContentOn: html ]
  168. ! !
  169. !HLFocusableWidget methodsFor: 'testing'!
  170. canHaveFocus
  171. ^ true
  172. ! !
  173. HLFocusableWidget subclass: #HLListWidget
  174. instanceVariableNames: 'items selectedItem mapping'
  175. package: 'Helios-Core'!
  176. !HLListWidget methodsFor: 'accessing'!
  177. cssClassForItem: anObject
  178. ^ self selectedItem = anObject
  179. ifTrue: [ 'active' ]
  180. ifFalse: [ 'inactive' ]
  181. !
  182. iconForItem: anObject
  183. ^ ''
  184. !
  185. items
  186. ^ items ifNil: [ items := self defaultItems ]
  187. !
  188. items: aCollection
  189. items := aCollection
  190. !
  191. positionOf: aListItem
  192. <
  193. return aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1
  194. >
  195. !
  196. selectedItem
  197. ^ selectedItem
  198. !
  199. selectedItem: anObject
  200. selectedItem := anObject
  201. ! !
  202. !HLListWidget methodsFor: 'actions'!
  203. activateFirstListItem
  204. self activateListItem: (window jQuery: ((wrapper asJQuery find: 'li') get: 0))
  205. !
  206. activateItem: anObject
  207. self activateListItem: (mapping
  208. at: anObject
  209. ifAbsent: [ ^ self ]) asJQuery
  210. !
  211. activateListItem: aListItem
  212. | parent position item |
  213. (aListItem get: 0) ifNil: [ ^self ].
  214. position := self positionOf: aListItem.
  215. parent := aListItem parent.
  216. parent children removeClass: 'active'.
  217. aListItem addClass: 'active'.
  218. "Move the scrollbar to show the active element"
  219. aListItem position top < 0 ifTrue: [
  220. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
  221. aListItem position top + aListItem height > parent height ifTrue: [
  222. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ].
  223. "Activate the corresponding item"
  224. item := (self items at: (aListItem attr: 'list-data') asNumber).
  225. self selectedItem == item ifFalse: [
  226. self selectItem: item ]
  227. !
  228. activateNextListItem
  229. self activateListItem: (window jQuery: '.focused .nav-pills .active') next
  230. !
  231. activatePreviousListItem
  232. self activateListItem: (window jQuery: '.focused .nav-pills .active') prev
  233. !
  234. focus
  235. super focus.
  236. self items isEmpty ifFalse: [
  237. self selectedItem ifNil: [ self activateFirstListItem ] ]
  238. !
  239. selectItem: anObject
  240. self selectedItem: anObject
  241. ! !
  242. !HLListWidget methodsFor: 'defaults'!
  243. defaultItems
  244. ^ #()
  245. ! !
  246. !HLListWidget methodsFor: 'events'!
  247. setupKeyBindings
  248. "TODO: refactor this!!"
  249. | active interval delay repeatInterval |
  250. active := false.
  251. repeatInterval := 70.
  252. hiddenInput asJQuery unbind: 'keydown'.
  253. hiddenInput asJQuery keydown: [ :e |
  254. (e which = 38 and: [ active = false ]) ifTrue: [
  255. active := true.
  256. self activatePreviousListItem.
  257. delay := [
  258. interval := [ self activatePreviousListItem ]
  259. valueWithInterval: repeatInterval ]
  260. valueWithTimeout: 300 ].
  261. (e which = 40 and: [ active = false ]) ifTrue: [
  262. active := true.
  263. self activateNextListItem.
  264. delay := [
  265. interval := [ self activateNextListItem ]
  266. valueWithInterval: repeatInterval ]
  267. valueWithTimeout: 300 ] ].
  268. hiddenInput asJQuery keyup: [ :e |
  269. active ifTrue: [
  270. active := false.
  271. interval ifNotNil: [ interval clearInterval ].
  272. delay ifNotNil: [ delay clearTimeout] ] ]
  273. ! !
  274. !HLListWidget methodsFor: 'initialization'!
  275. initialize
  276. super initialize.
  277. mapping := Dictionary new.
  278. ! !
  279. !HLListWidget methodsFor: 'private'!
  280. registerMappingFrom: anObject to: aTag
  281. mapping at: anObject put: aTag
  282. ! !
  283. !HLListWidget methodsFor: 'rendering'!
  284. renderButtonsOn: html
  285. !
  286. renderContentOn: html
  287. html ul
  288. class: 'nav nav-pills nav-stacked';
  289. with: [ self renderListOn: html ].
  290. html div class: 'pane_actions form-actions'; with: [
  291. self renderButtonsOn: html ].
  292. self setupKeyBindings
  293. !
  294. renderItem: anObject on: html
  295. | li |
  296. li := html li.
  297. self registerMappingFrom: anObject to: li.
  298. li
  299. class: (self cssClassForItem: anObject);
  300. at: 'list-data' put: (self items indexOf: anObject) asString;
  301. with: [
  302. html a
  303. with: [
  304. (html tag: 'i') class: (self iconForItem: anObject).
  305. self renderItemLabel: anObject on: html ];
  306. onClick: [
  307. self activateListItem: li asJQuery ] ]
  308. !
  309. renderItemLabel: anObject on: html
  310. html with: anObject asString
  311. !
  312. renderListOn: html
  313. mapping := Dictionary new.
  314. self items do: [ :each |
  315. self renderItem: each on: html ]
  316. ! !
  317. HLListWidget subclass: #HLNavigationListWidget
  318. instanceVariableNames: 'previous next'
  319. package: 'Helios-Core'!
  320. !HLNavigationListWidget methodsFor: 'accessing'!
  321. next
  322. ^ next
  323. !
  324. next: aWidget
  325. next := aWidget.
  326. aWidget previous = self ifFalse: [ aWidget previous: self ]
  327. !
  328. previous
  329. ^ previous
  330. !
  331. previous: aWidget
  332. previous := aWidget.
  333. aWidget next = self ifFalse: [ aWidget next: self ]
  334. ! !
  335. !HLNavigationListWidget methodsFor: 'actions'!
  336. nextFocus
  337. self next ifNotNil: [ self next focus ]
  338. !
  339. previousFocus
  340. self previous ifNotNil: [ self previous focus ]
  341. ! !
  342. !HLNavigationListWidget methodsFor: 'events'!
  343. setupKeyBindings
  344. super setupKeyBindings.
  345. hiddenInput asJQuery keydown: [ :e |
  346. e which = 39 ifTrue: [
  347. self nextFocus ].
  348. e which = 37 ifTrue: [
  349. self previousFocus ] ]
  350. ! !
  351. HLWidget subclass: #HLManager
  352. instanceVariableNames: 'tabs activeTab keyBinder environment history'
  353. package: 'Helios-Core'!
  354. !HLManager methodsFor: 'accessing'!
  355. activeTab
  356. ^ activeTab
  357. !
  358. environment
  359. "The default environment used by all Helios objects"
  360. ^ environment ifNil: [ environment := self defaultEnvironment ]
  361. !
  362. environment: anEnvironment
  363. environment := anEnvironment
  364. !
  365. history
  366. ^ history ifNil: [ history := OrderedCollection new ]
  367. !
  368. history: aCollection
  369. history := aCollection
  370. !
  371. keyBinder
  372. ^ keyBinder ifNil: [ keyBinder := HLKeyBinder new ]
  373. !
  374. tabs
  375. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  376. ! !
  377. !HLManager methodsFor: 'actions'!
  378. activate: aTab
  379. self keyBinder flushBindings.
  380. aTab registerBindings.
  381. activeTab := aTab.
  382. self
  383. refresh;
  384. addToHistory: aTab;
  385. show: aTab
  386. !
  387. addTab: aTab
  388. self tabs add: aTab.
  389. self activate: aTab
  390. !
  391. addToHistory: aTab
  392. self removeFromHistory: aTab.
  393. self history add: aTab
  394. !
  395. removeActiveTab
  396. self removeTab: self activeTab
  397. !
  398. removeFromHistory: aTab
  399. self history: (self history reject: [ :each | each == aTab ])
  400. !
  401. removeTab: aTab
  402. (self tabs includes: aTab) ifFalse: [ ^ self ].
  403. self removeFromHistory: aTab.
  404. self tabs remove: aTab.
  405. self keyBinder flushBindings.
  406. aTab remove.
  407. self refresh.
  408. self history ifNotEmpty: [
  409. self history last activate ]
  410. ! !
  411. !HLManager methodsFor: 'defaults'!
  412. defaultEnvironment
  413. ^ HLLocalEnvironment new
  414. ! !
  415. !HLManager methodsFor: 'initialization'!
  416. initialize
  417. super initialize.
  418. self keyBinder setupEvents
  419. ! !
  420. !HLManager methodsFor: 'rendering'!
  421. refresh
  422. (window jQuery: '.navbar') remove.
  423. self appendToJQuery: 'body' asJQuery
  424. !
  425. renderAddOn: html
  426. html li
  427. class: 'dropdown';
  428. with: [
  429. html a
  430. class: 'dropdown-toggle';
  431. at: 'data-toggle' put: 'dropdown';
  432. with: [
  433. html with: 'Open...'.
  434. (html tag: 'b') class: 'caret' ].
  435. html ul
  436. class: 'dropdown-menu';
  437. with: [
  438. ((HLWidget withAllSubclasses
  439. select: [ :each | each canBeOpenAsTab ])
  440. sorted: [ :a :b | a tabPriority < b tabPriority ])
  441. do: [ :each |
  442. html li with: [
  443. html a
  444. with: each tabLabel;
  445. onClick: [ each openAsTab ] ] ] ] ]
  446. !
  447. renderContentOn: html
  448. html div
  449. class: 'navbar navbar-fixed-top';
  450. with: [ html div
  451. class: 'navbar-inner';
  452. with: [ self renderTabsOn: html ] ]
  453. !
  454. renderTabsOn: html
  455. html ul
  456. class: 'nav';
  457. with: [
  458. self tabs do: [ :each |
  459. html li
  460. class: (each isActive ifTrue: [ 'active' ] ifFalse: [ 'inactive' ]);
  461. with: [
  462. html a
  463. with: [
  464. ((html tag: 'i') class: 'icon-remove')
  465. onClick: [ self removeTab: each ].
  466. html with: each displayLabel ];
  467. onClick: [ each activate ] ] ].
  468. self renderAddOn: html ]
  469. !
  470. show: aTab
  471. self tabs do: [ :each | each hide ].
  472. aTab show; focus
  473. ! !
  474. HLManager class instanceVariableNames: 'current'!
  475. !HLManager class methodsFor: 'accessing'!
  476. current
  477. ^ current ifNil: [ current := self basicNew initialize ]
  478. ! !
  479. !HLManager class methodsFor: 'initialization'!
  480. initialize
  481. self current appendToJQuery: 'body' asJQuery
  482. ! !
  483. !HLManager class methodsFor: 'instance creation'!
  484. new
  485. "Use current instead"
  486. self shouldNotImplement
  487. ! !
  488. HLWidget subclass: #HLSUnit
  489. instanceVariableNames: ''
  490. package: 'Helios-Core'!
  491. !HLSUnit class methodsFor: 'accessing'!
  492. tabLabel
  493. ^ 'SUnit'
  494. !
  495. tabPriority
  496. ^ 1000
  497. ! !
  498. !HLSUnit class methodsFor: 'testing'!
  499. canBeOpenAsTab
  500. ^ true
  501. ! !
  502. HLWidget subclass: #HLTranscript
  503. instanceVariableNames: ''
  504. package: 'Helios-Core'!
  505. !HLTranscript class methodsFor: 'accessing'!
  506. tabLabel
  507. ^ 'Transcript'
  508. !
  509. tabPriority
  510. ^ 600
  511. ! !
  512. !HLTranscript class methodsFor: 'testing'!
  513. canBeOpenAsTab
  514. ^ true
  515. ! !
  516. !Package methodsFor: '*Helios-Core'!
  517. ajaxPutAt: aURL data: aString
  518. jQuery
  519. ajax: aURL
  520. options: #{ 'type' -> 'PUT'.
  521. 'data' -> aString.
  522. 'contentType' -> 'text/plain;charset=UTF-8'.
  523. 'error' -> [:xhr | window
  524. alert: 'Commiting ' , aURL , ' failed with reason: "' , (xhr responseText) , '"'] }
  525. !
  526. heliosCommit
  527. { Exporter -> (self commitPathJs, '/', self name, '.js').
  528. StrippedExporter -> (self commitPathJs, '/', self name, '.deploy.js').
  529. ChunkExporter -> (self commitPathSt, '/', self name, '.st')
  530. } do: [ :commitStrategy || fileContents |
  531. fileContents := (commitStrategy key new exportPackage: self name).
  532. self ajaxPutAt: commitStrategy value data: fileContents ]
  533. ! !