1
0

Helios-Core.st 9.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538
  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. 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. positionOf: aListItem
  139. <
  140. return aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1
  141. >
  142. !
  143. selectedItem
  144. ^ selectedItem
  145. !
  146. selectedItem: anObject
  147. selectedItem := anObject
  148. ! !
  149. !HLListWidget methodsFor: 'actions'!
  150. activateFirstListItem
  151. self activateListItem: (window jQuery: ((wrapper asJQuery find: 'li') get: 0))
  152. !
  153. activateListItem: aListItem
  154. | parent position |
  155. (aListItem get: 0) ifNil: [ ^self ].
  156. position := self positionOf: aListItem.
  157. parent := aListItem parent.
  158. parent children removeClass: 'active'.
  159. aListItem addClass: 'active'.
  160. "Move the scrollbar to show the active element"
  161. aListItem position top < 0 ifTrue: [
  162. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
  163. aListItem position top + aListItem height > parent height ifTrue: [
  164. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ].
  165. "Activate the corresponding item"
  166. self selectItem: (self items at: (aListItem attr: 'list-data') asNumber)
  167. !
  168. focus
  169. super focus.
  170. self items isEmpty ifFalse: [
  171. self selectedItem ifNil: [ self activateFirstListItem ] ]
  172. !
  173. selectItem: anObject
  174. self selectedItem: anObject
  175. ! !
  176. !HLListWidget methodsFor: 'defaults'!
  177. defaultItems
  178. ^ #()
  179. ! !
  180. !HLListWidget methodsFor: 'events'!
  181. setupKeyBindings
  182. | next |
  183. hiddenInput asJQuery unbind: 'keydown'.
  184. hiddenInput asJQuery keydown: [ :e | | selected |
  185. selected := window jQuery: '.focused .nav-pills .active'.
  186. e which = 38 ifTrue: [
  187. self activateListItem: selected prev ].
  188. e which = 40 ifTrue: [
  189. next := selected next.
  190. (next get: 0) ifNil: [ next := window jQuery: '.focused .nav-pills li:first-child' ].
  191. self activateListItem: next ] ]
  192. ! !
  193. !HLListWidget methodsFor: 'rendering'!
  194. renderButtonsOn: html
  195. !
  196. renderContentOn: html
  197. html ul
  198. class: 'nav nav-pills nav-stacked';
  199. with: [ self renderListOn: html ].
  200. html div class: 'pane_actions form-actions'; with: [
  201. self renderButtonsOn: html ].
  202. self setupKeyBindings
  203. !
  204. renderItem: anObject on: html
  205. | li |
  206. li := html li.
  207. li
  208. class: (self cssClassForItem: anObject);
  209. at: 'list-data' put: (self items indexOf: anObject) asString;
  210. with: [
  211. html a
  212. with: [
  213. (html tag: 'i') class: (self iconForItem: anObject).
  214. self renderItemLabel: anObject on: html ];
  215. onClick: [
  216. self activateListItem: li asJQuery ] ]
  217. !
  218. renderItemLabel: anObject on: html
  219. html with: anObject asString
  220. !
  221. renderListOn: html
  222. self items do: [ :each |
  223. self renderItem: each on: html ]
  224. ! !
  225. HLListWidget subclass: #HLNavigationListWidget
  226. instanceVariableNames: 'previous next'
  227. package: 'Helios-Core'!
  228. !HLNavigationListWidget methodsFor: 'accessing'!
  229. next
  230. ^ next
  231. !
  232. next: aWidget
  233. next := aWidget.
  234. aWidget previous = self ifFalse: [ aWidget previous: self ]
  235. !
  236. previous
  237. ^ previous
  238. !
  239. previous: aWidget
  240. previous := aWidget.
  241. aWidget next = self ifFalse: [ aWidget next: self ]
  242. ! !
  243. !HLNavigationListWidget methodsFor: 'actions'!
  244. nextFocus
  245. self next ifNotNil: [ self next focus ]
  246. !
  247. previousFocus
  248. self previous ifNotNil: [ self previous focus ]
  249. ! !
  250. !HLNavigationListWidget methodsFor: 'events'!
  251. setupKeyBindings
  252. super setupKeyBindings.
  253. hiddenInput asJQuery keydown: [ :e |
  254. e which = 39 ifTrue: [
  255. self nextFocus ].
  256. e which = 37 ifTrue: [
  257. self previousFocus ] ]
  258. ! !
  259. HLWidget subclass: #HLManager
  260. instanceVariableNames: 'tabs activeTab keyBinder environment'
  261. package: 'Helios-Core'!
  262. !HLManager methodsFor: 'accessing'!
  263. activeTab
  264. ^ activeTab
  265. !
  266. environment
  267. "The default environment used by all Helios objects"
  268. ^ environment ifNil: [ environment := self defaultEnvironment ]
  269. !
  270. environment: anEnvironment
  271. environment := anEnvironment
  272. !
  273. keyBinder
  274. ^ keyBinder ifNil: [ keyBinder := HLKeyBinder new ]
  275. !
  276. tabs
  277. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  278. ! !
  279. !HLManager methodsFor: 'actions'!
  280. activate: aTab
  281. self keyBinder flushBindings.
  282. activeTab := aTab.
  283. self
  284. refresh;
  285. show: aTab
  286. !
  287. addTab: aTab
  288. self tabs add: aTab.
  289. self activate: aTab
  290. !
  291. removeTab: aTab
  292. "Todo: activate the previously activated tab. Keep a history of tabs selection"
  293. (self tabs includes: aTab) ifFalse: [ ^ self ].
  294. self tabs remove: aTab.
  295. self refresh
  296. ! !
  297. !HLManager methodsFor: 'defaults'!
  298. defaultEnvironment
  299. ^ HLLocalEnvironment new
  300. ! !
  301. !HLManager methodsFor: 'initialization'!
  302. initialize
  303. super initialize.
  304. self keyBinder setupEvents
  305. ! !
  306. !HLManager methodsFor: 'rendering'!
  307. refresh
  308. (window jQuery: '.navbar') remove.
  309. (window jQuery: '#container') remove.
  310. self appendToJQuery: 'body' asJQuery
  311. !
  312. renderAddOn: html
  313. html li
  314. class: 'dropdown';
  315. with: [
  316. html a
  317. class: 'dropdown-toggle';
  318. at: 'data-toggle' put: 'dropdown';
  319. with: [
  320. html with: 'Open...'.
  321. (html tag: 'b') class: 'caret' ].
  322. html ul
  323. class: 'dropdown-menu';
  324. with: [
  325. ((HLWidget withAllSubclasses
  326. select: [ :each | each canBeOpenAsTab ])
  327. sorted: [ :a :b | a tabPriority < b tabPriority ])
  328. do: [ :each |
  329. html li with: [
  330. html a
  331. with: each tabLabel;
  332. onClick: [ each openAsTab ] ] ] ] ]
  333. !
  334. renderContentOn: html
  335. html div
  336. class: 'navbar navbar-fixed-top';
  337. with: [ html div
  338. class: 'navbar-inner';
  339. with: [ self renderTabsOn: html ] ].
  340. html div id: 'container'
  341. !
  342. renderTabsOn: html
  343. html ul
  344. class: 'nav';
  345. with: [
  346. self tabs do: [ :each |
  347. html li
  348. class: (each isActive ifTrue: [ 'active' ] ifFalse: [ 'inactive' ]);
  349. with: [
  350. html a
  351. with: [
  352. ((html tag: 'i') class: 'icon-remove-circle')
  353. onClick: [ self removeTab: each ].
  354. html with: each label ];
  355. onClick: [ each activate ] ] ].
  356. self renderAddOn: html ]
  357. !
  358. show: aTab
  359. (window jQuery: '#container') empty.
  360. aTab widget appendToJQuery: '#container' asJQuery
  361. ! !
  362. HLManager class instanceVariableNames: 'current'!
  363. !HLManager class methodsFor: 'accessing'!
  364. current
  365. ^ current ifNil: [ current := self basicNew initialize ]
  366. ! !
  367. !HLManager class methodsFor: 'initialization'!
  368. initialize
  369. self current appendToJQuery: 'body' asJQuery
  370. ! !
  371. !HLManager class methodsFor: 'instance creation'!
  372. new
  373. "Use current instead"
  374. self shouldNotImplement
  375. ! !
  376. HLWidget subclass: #HLSUnit
  377. instanceVariableNames: ''
  378. package: 'Helios-Core'!
  379. !HLSUnit class methodsFor: 'accessing'!
  380. tabLabel
  381. ^ 'SUnit'
  382. !
  383. tabPriority
  384. ^ 1000
  385. ! !
  386. !HLSUnit class methodsFor: 'testing'!
  387. canBeOpenAsTab
  388. ^ true
  389. ! !
  390. HLWidget subclass: #HLTranscript
  391. instanceVariableNames: ''
  392. package: 'Helios-Core'!
  393. !HLTranscript class methodsFor: 'accessing'!
  394. tabLabel
  395. ^ 'Transcript'
  396. !
  397. tabPriority
  398. ^ 600
  399. ! !
  400. !HLTranscript class methodsFor: 'testing'!
  401. canBeOpenAsTab
  402. ^ true
  403. ! !