Smalltalk current createPackage: 'Helios-Core'!
Object subclass: #HLTab
instanceVariableNames: 'widget label'
package: 'Helios-Core'!
!HLTab methodsFor: 'accessing'!
activate
self manager activate: self
!
add
self manager addTab: self
!
displayLabel
^ self label size > 20
ifTrue: [ (self label first: 20), '...' ]
ifFalse: [ self label ]
!
focus
self widget canHaveFocus ifTrue: [
self widget focus ]
!
label
^ label ifNil: [ '' ]
!
label: aString
label := aString
!
manager
^ HLManager current
!
widget
^ widget
!
widget: aWidget
widget := aWidget
! !
!HLTab methodsFor: 'testing'!
isActive
^ self manager activeTab = self
! !
!HLTab class methodsFor: 'instance creation'!
on: aWidget labelled: aString
^ self new
widget: aWidget;
label: aString;
yourself
! !
Widget subclass: #HLWidget
instanceVariableNames: 'wrapper'
package: 'Helios-Core'!
!HLWidget methodsFor: 'accessing'!
manager
^ HLManager current
!
wrapper
^ wrapper
! !
!HLWidget methodsFor: 'actions'!
alert: aString
window alert: aString
!
confirm: aString
^ window confirm: aString
! !
!HLWidget methodsFor: 'keybindings'!
registerBindings
self registerBindingsOn: self manager keyBinder bindings
!
registerBindingsOn: aBindingGroup
! !
!HLWidget methodsFor: 'rendering'!
renderContentOn: html
!
renderOn: html
self registerBindings.
wrapper := html div.
[ :renderer | self renderContentOn: renderer ] appendToJQuery: wrapper asJQuery
! !
!HLWidget methodsFor: 'testing'!
canHaveFocus
^ false
! !
!HLWidget methodsFor: 'updating'!
refresh
self wrapper ifNil: [ ^ self ].
self wrapper asJQuery empty.
[ :html | self renderContentOn: html ] appendToJQuery: self wrapper asJQuery
! !
!HLWidget class methodsFor: 'accessing'!
openAsTab
self canBeOpenAsTab ifFalse: [ ^ self ].
HLManager current addTab: (HLTab on: self new labelled: self tabLabel)
!
tabLabel
^ 'Tab'
!
tabPriority
^ 500
! !
!HLWidget class methodsFor: 'testing'!
canBeOpenAsTab
^ false
! !
HLWidget subclass: #HLDebugger
instanceVariableNames: ''
package: 'Helios-Core'!
HLWidget subclass: #HLFocusableWidget
instanceVariableNames: 'hiddenInput'
package: 'Helios-Core'!
!HLFocusableWidget methodsFor: 'accessing'!
focusClass
^ 'focused'
! !
!HLFocusableWidget methodsFor: 'events'!
blur
hiddenInput asJQuery blur
!
focus
hiddenInput asJQuery focus
!
hasFocus
^ self wrapper notNil and: [ self wrapper asJQuery hasClass: self focusClass ]
! !
!HLFocusableWidget methodsFor: 'rendering'!
renderContentOn: html
!
renderHiddenInputOn: html
hiddenInput := html input
style: 'position: absolute; left: -100000px;';
onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
onFocus: [ self wrapper asJQuery addClass: self focusClass ]
!
renderOn: html
self registerBindings.
self renderHiddenInputOn: html.
wrapper := html div
class: 'hl_widget';
onClick: [ hiddenInput asJQuery focus ];
with: [
self renderContentOn: html ]
! !
!HLFocusableWidget methodsFor: 'testing'!
canHaveFocus
^ true
! !
HLFocusableWidget subclass: #HLListWidget
instanceVariableNames: 'items selectedItem'
package: 'Helios-Core'!
!HLListWidget methodsFor: 'accessing'!
cssClassForItem: anObject
^ self selectedItem = anObject
ifTrue: [ 'active' ]
ifFalse: [ 'inactive' ]
!
iconForItem: anObject
^ ''
!
items
^ items ifNil: [ items := self defaultItems ]
!
items: aCollection
items := aCollection
!
positionOf: aListItem
<
return aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1
>
!
selectedItem
^ selectedItem
!
selectedItem: anObject
selectedItem := anObject
! !
!HLListWidget methodsFor: 'actions'!
activateFirstListItem
self activateListItem: (window jQuery: ((wrapper asJQuery find: 'li') get: 0))
!
activateListItem: aListItem
| parent position |
(aListItem get: 0) ifNil: [ ^self ].
position := self positionOf: aListItem.
parent := aListItem parent.
parent children removeClass: 'active'.
aListItem addClass: 'active'.
"Move the scrollbar to show the active element"
aListItem position top < 0 ifTrue: [
(parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
aListItem position top + aListItem height > parent height ifTrue: [
(parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ].
"Activate the corresponding item"
self selectItem: (self items at: (aListItem attr: 'list-data') asNumber)
!
focus
super focus.
self items isEmpty ifFalse: [
self selectedItem ifNil: [ self activateFirstListItem ] ]
!
selectItem: anObject
self selectedItem: anObject
! !
!HLListWidget methodsFor: 'defaults'!
defaultItems
^ #()
! !
!HLListWidget methodsFor: 'events'!
setupKeyBindings
| next |
hiddenInput asJQuery unbind: 'keydown'.
hiddenInput asJQuery keydown: [ :e | | selected |
selected := window jQuery: '.focused .nav-pills .active'.
e which = 38 ifTrue: [
self activateListItem: selected prev ].
e which = 40 ifTrue: [
next := selected next.
(next get: 0) ifNil: [ next := window jQuery: '.focused .nav-pills li:first-child' ].
self activateListItem: next ] ]
! !
!HLListWidget methodsFor: 'rendering'!
renderButtonsOn: html
!
renderContentOn: html
html ul
class: 'nav nav-pills nav-stacked';
with: [ self renderListOn: html ].
html div class: 'pane_actions form-actions'; with: [
self renderButtonsOn: html ].
self setupKeyBindings
!
renderItem: anObject on: html
| li |
li := html li.
li
class: (self cssClassForItem: anObject);
at: 'list-data' put: (self items indexOf: anObject) asString;
with: [
html a
with: [
(html tag: 'i') class: (self iconForItem: anObject).
self renderItemLabel: anObject on: html ];
onClick: [
self activateListItem: li asJQuery ] ]
!
renderItemLabel: anObject on: html
html with: anObject asString
!
renderListOn: html
self items do: [ :each |
self renderItem: each on: html ]
! !
HLListWidget subclass: #HLNavigationListWidget
instanceVariableNames: 'previous next'
package: 'Helios-Core'!
!HLNavigationListWidget methodsFor: 'accessing'!
next
^ next
!
next: aWidget
next := aWidget.
aWidget previous = self ifFalse: [ aWidget previous: self ]
!
previous
^ previous
!
previous: aWidget
previous := aWidget.
aWidget next = self ifFalse: [ aWidget next: self ]
! !
!HLNavigationListWidget methodsFor: 'actions'!
nextFocus
self next ifNotNil: [ self next focus ]
!
previousFocus
self previous ifNotNil: [ self previous focus ]
! !
!HLNavigationListWidget methodsFor: 'events'!
setupKeyBindings
super setupKeyBindings.
hiddenInput asJQuery keydown: [ :e |
e which = 39 ifTrue: [
self nextFocus ].
e which = 37 ifTrue: [
self previousFocus ] ]
! !
HLWidget subclass: #HLManager
instanceVariableNames: 'tabs activeTab keyBinder environment history'
package: 'Helios-Core'!
!HLManager methodsFor: 'accessing'!
activeTab
^ activeTab
!
environment
"The default environment used by all Helios objects"
^ environment ifNil: [ environment := self defaultEnvironment ]
!
environment: anEnvironment
environment := anEnvironment
!
history
^ history ifNil: [ history := OrderedCollection new ]
!
history: aCollection
history := aCollection
!
keyBinder
^ keyBinder ifNil: [ keyBinder := HLKeyBinder new ]
!
tabs
^ tabs ifNil: [ tabs := OrderedCollection new ]
! !
!HLManager methodsFor: 'actions'!
activate: aTab
self keyBinder flushBindings.
activeTab := aTab.
self
refresh;
addToHistory: aTab;
show: aTab
!
addTab: aTab
self tabs add: aTab.
self activate: aTab
!
addToHistory: aTab
self removeFromHistory: aTab.
self history add: aTab
!
removeActiveTab
self removeTab: self activeTab
!
removeFromHistory: aTab
self history: (self history reject: [ :each | each == aTab ])
!
removeTab: aTab
(self tabs includes: aTab) ifFalse: [ ^ self ].
self removeFromHistory: aTab.
self tabs remove: aTab.
self keyBinder flushBindings.
self refresh.
self history ifNotEmpty: [
self history last activate ]
! !
!HLManager methodsFor: 'defaults'!
defaultEnvironment
^ HLLocalEnvironment new
! !
!HLManager methodsFor: 'initialization'!
initialize
super initialize.
self keyBinder setupEvents
! !
!HLManager methodsFor: 'rendering'!
refresh
(window jQuery: '.navbar') remove.
(window jQuery: '#container') remove.
self appendToJQuery: 'body' asJQuery
!
renderAddOn: html
html li
class: 'dropdown';
with: [
html a
class: 'dropdown-toggle';
at: 'data-toggle' put: 'dropdown';
with: [
html with: 'Open...'.
(html tag: 'b') class: 'caret' ].
html ul
class: 'dropdown-menu';
with: [
((HLWidget withAllSubclasses
select: [ :each | each canBeOpenAsTab ])
sorted: [ :a :b | a tabPriority < b tabPriority ])
do: [ :each |
html li with: [
html a
with: each tabLabel;
onClick: [ each openAsTab ] ] ] ] ]
!
renderContentOn: html
html div
class: 'navbar navbar-fixed-top';
with: [ html div
class: 'navbar-inner';
with: [ self renderTabsOn: html ] ].
html div id: 'container'
!
renderTabsOn: html
html ul
class: 'nav';
with: [
self tabs do: [ :each |
html li
class: (each isActive ifTrue: [ 'active' ] ifFalse: [ 'inactive' ]);
with: [
html a
with: [
((html tag: 'i') class: 'icon-remove')
onClick: [ self removeTab: each ].
html with: each displayLabel ];
onClick: [ each activate ] ] ].
self renderAddOn: html ]
!
show: aTab
(window jQuery: '#container') empty.
aTab widget appendToJQuery: '#container' asJQuery.
aTab focus
! !
HLManager class instanceVariableNames: 'current'!
!HLManager class methodsFor: 'accessing'!
current
^ current ifNil: [ current := self basicNew initialize ]
! !
!HLManager class methodsFor: 'initialization'!
initialize
self current appendToJQuery: 'body' asJQuery
! !
!HLManager class methodsFor: 'instance creation'!
new
"Use current instead"
self shouldNotImplement
! !
HLWidget subclass: #HLSUnit
instanceVariableNames: ''
package: 'Helios-Core'!
!HLSUnit class methodsFor: 'accessing'!
tabLabel
^ 'SUnit'
!
tabPriority
^ 1000
! !
!HLSUnit class methodsFor: 'testing'!
canBeOpenAsTab
^ true
! !
HLWidget subclass: #HLTranscript
instanceVariableNames: ''
package: 'Helios-Core'!
!HLTranscript class methodsFor: 'accessing'!
tabLabel
^ 'Transcript'
!
tabPriority
^ 600
! !
!HLTranscript class methodsFor: 'testing'!
canBeOpenAsTab
^ true
! !