1
0

Helios-Core.st 12 KB

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