1
0

Helios-Core.st 9.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532
  1. Smalltalk current createPackage: 'Helios-Core' properties: #{}!
  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. label
  13. ^ label ifNil: [ '' ]
  14. !
  15. label: aString
  16. label := aString
  17. !
  18. manager
  19. ^ HLManager current
  20. !
  21. widget
  22. ^ widget
  23. !
  24. widget: aWidget
  25. widget := aWidget
  26. ! !
  27. !HLTab methodsFor: 'testing'!
  28. isActive
  29. ^ self manager activeTab = self
  30. ! !
  31. !HLTab class methodsFor: 'instance creation'!
  32. on: aWidget labelled: aString
  33. ^ self new
  34. widget: aWidget;
  35. label: aString;
  36. yourself
  37. ! !
  38. Widget subclass: #HLWidget
  39. instanceVariableNames: 'wrapper'
  40. package: 'Helios-Core'!
  41. !HLWidget methodsFor: 'accessing'!
  42. manager
  43. ^ HLManager current
  44. !
  45. wrapper
  46. ^ wrapper
  47. ! !
  48. !HLWidget methodsFor: 'keybindings'!
  49. registerBindings
  50. self registerBindingsOn: self manager keyBinder bindings
  51. !
  52. registerBindingsOn: aBindingGroup
  53. ! !
  54. !HLWidget methodsFor: 'rendering'!
  55. renderContentOn: html
  56. !
  57. renderOn: html
  58. self registerBindings.
  59. wrapper := html div.
  60. [ :renderer | self renderContentOn: renderer ] appendToJQuery: wrapper asJQuery
  61. ! !
  62. !HLWidget methodsFor: 'updating'!
  63. refresh
  64. self wrapper ifNil: [ ^ self ].
  65. self wrapper asJQuery empty.
  66. [ :html | self renderContentOn: html ] appendToJQuery: self wrapper asJQuery
  67. ! !
  68. !HLWidget class methodsFor: 'accessing'!
  69. openAsTab
  70. HLManager current addTab: (HLTab on: self new labelled: self tabLabel)
  71. !
  72. tabLabel
  73. ^ 'Tab'
  74. !
  75. tabPriority
  76. ^ 500
  77. ! !
  78. !HLWidget class methodsFor: 'testing'!
  79. canBeOpenAsTab
  80. ^ false
  81. ! !
  82. HLWidget subclass: #HLDebugger
  83. instanceVariableNames: ''
  84. package: 'Helios-Core'!
  85. HLWidget subclass: #HLFocusableWidget
  86. instanceVariableNames: 'hiddenInput'
  87. package: 'Helios-Core'!
  88. !HLFocusableWidget methodsFor: 'accessing'!
  89. focusClass
  90. ^ 'focused'
  91. ! !
  92. !HLFocusableWidget methodsFor: 'events'!
  93. blur
  94. hiddenInput asJQuery blur
  95. !
  96. focus
  97. hiddenInput asJQuery focus
  98. !
  99. hasFocus
  100. ^ self wrapper notNil and: [ self wrapper asJQuery hasClass: self focusClass ]
  101. ! !
  102. !HLFocusableWidget methodsFor: 'rendering'!
  103. renderContentOn: html
  104. !
  105. renderHiddenInputOn: html
  106. hiddenInput := html input
  107. style: 'position: absolute; left: -100000px;';
  108. onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
  109. onFocus: [ self wrapper asJQuery addClass: self focusClass ]
  110. !
  111. renderOn: html
  112. self registerBindings.
  113. self renderHiddenInputOn: html.
  114. wrapper := html div
  115. class: 'hl_widget';
  116. onClick: [ hiddenInput asJQuery focus ];
  117. with: [
  118. self renderContentOn: html ]
  119. ! !
  120. HLFocusableWidget subclass: #HLListWidget
  121. instanceVariableNames: 'items selectedItem'
  122. package: 'Helios-Core'!
  123. !HLListWidget methodsFor: 'accessing'!
  124. cssClassForItem: anObject
  125. ^ self selectedItem = anObject
  126. ifTrue: [ 'active' ]
  127. ifFalse: [ 'inactive' ]
  128. !
  129. iconForItem: anObject
  130. ^ ''
  131. !
  132. items
  133. ^ items ifNil: [ items := self defaultItems ]
  134. !
  135. items: aCollection
  136. items := aCollection
  137. !
  138. selectedItem
  139. ^ selectedItem
  140. !
  141. selectedItem: anObject
  142. selectedItem := anObject
  143. ! !
  144. !HLListWidget methodsFor: 'actions'!
  145. activateFirstListItem
  146. self activateListItem: (window jQuery: ((wrapper asJQuery find: 'li') get: 0))
  147. !
  148. activateListItem: aListItem
  149. | parent position |
  150. (aListItem get: 0) ifNil: [ ^self ].
  151. <position = aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1>.
  152. parent := aListItem parent.
  153. parent children removeClass: 'active'.
  154. aListItem addClass: 'active'.
  155. "Move the scrollbar to show the active element"
  156. aListItem position top < 0 ifTrue: [
  157. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
  158. aListItem position top + aListItem height > parent height ifTrue: [
  159. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ].
  160. "Activate the corresponding item"
  161. self selectItem: (self items at: (aListItem attr: 'list-data') asNumber)
  162. !
  163. focus
  164. super focus.
  165. self items isEmpty ifFalse: [
  166. self selectedItem ifNil: [ self activateFirstListItem ] ]
  167. !
  168. selectItem: anObject
  169. self selectedItem: anObject
  170. ! !
  171. !HLListWidget methodsFor: 'defaults'!
  172. defaultItems
  173. ^ #()
  174. ! !
  175. !HLListWidget methodsFor: 'events'!
  176. setupKeyBindings
  177. | next |
  178. hiddenInput asJQuery unbind: 'keydown'.
  179. hiddenInput asJQuery keydown: [ :e | | selected |
  180. selected := window jQuery: '.focused .nav-pills .active'.
  181. e which = 38 ifTrue: [
  182. self activateListItem: selected prev ].
  183. e which = 40 ifTrue: [
  184. next := selected next.
  185. (next get: 0) ifNil: [ next := window jQuery: '.focused .nav-pills li:first-child' ].
  186. self activateListItem: next ] ]
  187. ! !
  188. !HLListWidget methodsFor: 'rendering'!
  189. renderButtonsOn: html
  190. !
  191. renderContentOn: html
  192. html ul
  193. class: 'nav nav-pills nav-stacked';
  194. with: [ self renderListOn: html ].
  195. html div class: 'pane_actions form-actions'; with: [
  196. self renderButtonsOn: html ].
  197. self setupKeyBindings
  198. !
  199. renderItem: anObject on: html
  200. | li |
  201. li := html li.
  202. li
  203. class: (self cssClassForItem: anObject);
  204. at: 'list-data' put: (self items indexOf: anObject) asString;
  205. with: [
  206. html a
  207. with: [
  208. (html tag: 'i') class: (self iconForItem: anObject).
  209. self renderItemLabel: anObject on: html ];
  210. onClick: [
  211. self activateListItem: li asJQuery ] ]
  212. !
  213. renderItemLabel: anObject on: html
  214. html with: anObject asString
  215. !
  216. renderListOn: html
  217. self items do: [ :each |
  218. self renderItem: each on: html ]
  219. ! !
  220. HLListWidget subclass: #HLNavigationListWidget
  221. instanceVariableNames: 'previous next'
  222. package: 'Helios-Core'!
  223. !HLNavigationListWidget methodsFor: 'accessing'!
  224. next
  225. ^ next
  226. !
  227. next: aWidget
  228. next := aWidget.
  229. aWidget previous = self ifFalse: [ aWidget previous: self ]
  230. !
  231. previous
  232. ^ previous
  233. !
  234. previous: aWidget
  235. previous := aWidget.
  236. aWidget next = self ifFalse: [ aWidget next: self ]
  237. ! !
  238. !HLNavigationListWidget methodsFor: 'actions'!
  239. nextFocus
  240. self next ifNotNil: [ self next focus ]
  241. !
  242. previousFocus
  243. self previous ifNotNil: [ self previous focus ]
  244. ! !
  245. !HLNavigationListWidget methodsFor: 'events'!
  246. setupKeyBindings
  247. super setupKeyBindings.
  248. hiddenInput asJQuery keydown: [ :e |
  249. e which = 39 ifTrue: [
  250. self nextFocus ].
  251. e which = 37 ifTrue: [
  252. self previousFocus ] ]
  253. ! !
  254. HLWidget subclass: #HLManager
  255. instanceVariableNames: 'tabs activeTab keyBinder environment'
  256. package: 'Helios-Core'!
  257. !HLManager methodsFor: 'accessing'!
  258. activeTab
  259. ^ activeTab
  260. !
  261. environment
  262. "The default environment used by all Helios objects"
  263. ^ environment ifNil: [ environment := self defaultEnvironment ]
  264. !
  265. environment: anEnvironment
  266. environment := anEnvironment
  267. !
  268. keyBinder
  269. ^ keyBinder ifNil: [ keyBinder := HLKeyBinder new ]
  270. !
  271. tabs
  272. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  273. ! !
  274. !HLManager methodsFor: 'actions'!
  275. activate: aTab
  276. self keyBinder flushBindings.
  277. activeTab := aTab.
  278. self
  279. refresh;
  280. show: aTab
  281. !
  282. addTab: aTab
  283. self tabs add: aTab.
  284. self activate: aTab
  285. !
  286. removeTab: aTab
  287. "Todo: activate the previously activated tab. Keep a history of tabs selection"
  288. (self tabs includes: aTab) ifFalse: [ ^ self ].
  289. self tabs remove: aTab.
  290. self refresh
  291. ! !
  292. !HLManager methodsFor: 'defaults'!
  293. defaultEnvironment
  294. ^ HLLocalEnvironment new
  295. ! !
  296. !HLManager methodsFor: 'initialization'!
  297. initialize
  298. super initialize.
  299. self keyBinder setupEvents
  300. ! !
  301. !HLManager methodsFor: 'rendering'!
  302. refresh
  303. (window jQuery: '.navbar') remove.
  304. (window jQuery: '#container') remove.
  305. self appendToJQuery: 'body' asJQuery
  306. !
  307. renderAddOn: html
  308. html li
  309. class: 'dropdown';
  310. with: [
  311. html a
  312. class: 'dropdown-toggle';
  313. at: 'data-toggle' put: 'dropdown';
  314. with: [
  315. html with: 'Open...'.
  316. (html tag: 'b') class: 'caret' ].
  317. html ul
  318. class: 'dropdown-menu';
  319. with: [
  320. ((HLWidget withAllSubclasses
  321. select: [ :each | each canBeOpenAsTab ])
  322. sorted: [ :a :b | a tabPriority < b tabPriority ])
  323. do: [ :each |
  324. html li with: [
  325. html a
  326. with: each tabLabel;
  327. onClick: [ each openAsTab ] ] ] ] ]
  328. !
  329. renderContentOn: html
  330. html div
  331. class: 'navbar navbar-fixed-top';
  332. with: [ html div
  333. class: 'navbar-inner';
  334. with: [ self renderTabsOn: html ] ].
  335. html div id: 'container'
  336. !
  337. renderTabsOn: html
  338. html ul
  339. class: 'nav';
  340. with: [
  341. self tabs do: [ :each |
  342. html li
  343. class: (each isActive ifTrue: [ 'active' ] ifFalse: [ 'inactive' ]);
  344. with: [
  345. html a
  346. with: [
  347. ((html tag: 'i') class: 'icon-remove-circle')
  348. onClick: [ self removeTab: each ].
  349. html with: each label ];
  350. onClick: [ each activate ] ] ].
  351. self renderAddOn: html ]
  352. !
  353. show: aTab
  354. (window jQuery: '#container') empty.
  355. aTab widget appendToJQuery: '#container' asJQuery
  356. ! !
  357. HLManager class instanceVariableNames: 'current'!
  358. !HLManager class methodsFor: 'accessing'!
  359. current
  360. ^ current ifNil: [ current := self basicNew initialize ]
  361. ! !
  362. !HLManager class methodsFor: 'initialization'!
  363. initialize
  364. self current appendToJQuery: 'body' asJQuery
  365. ! !
  366. !HLManager class methodsFor: 'instance creation'!
  367. new
  368. "Use current instead"
  369. self shouldNotImplement
  370. ! !
  371. HLWidget subclass: #HLSUnit
  372. instanceVariableNames: ''
  373. package: 'Helios-Core'!
  374. !HLSUnit class methodsFor: 'accessing'!
  375. tabLabel
  376. ^ 'SUnit'
  377. !
  378. tabPriority
  379. ^ 1000
  380. ! !
  381. !HLSUnit class methodsFor: 'testing'!
  382. canBeOpenAsTab
  383. ^ true
  384. ! !
  385. HLWidget subclass: #HLTranscript
  386. instanceVariableNames: ''
  387. package: 'Helios-Core'!
  388. !HLTranscript class methodsFor: 'accessing'!
  389. tabLabel
  390. ^ 'Transcript'
  391. !
  392. tabPriority
  393. ^ 600
  394. ! !
  395. !HLTranscript class methodsFor: 'testing'!
  396. canBeOpenAsTab
  397. ^ true
  398. ! !