1
0

Helios-Core.st 12 KB

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