Helios-Core.st 10 KB

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