Helios-Core.st 12 KB

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