Smalltalk current createPackage: 'Helios-Core'!
Object subclass: #HLModel
instanceVariableNames: 'announcer environment'
package: 'Helios-Core'!
!HLModel methodsFor: 'accessing'!
announcer
^ announcer ifNil: [ announcer := Announcer new ]
!
environment
^ environment ifNil: [ self manager environment ]
!
environment: anEnvironment
environment := anEnvironment
!
manager
^ HLManager current
!
systemAnnouncer
^ self environment systemAnnouncer
! !
Widget subclass: #HLTab
instanceVariableNames: 'widget label root'
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: 'actions'!
hide
root ifNotNil: [ root asJQuery css: 'visibility' put: 'hidden' ]
!
registerBindings
self widget registerBindings
!
remove
root ifNotNil: [ root asJQuery remove ]
!
show
root
ifNil: [ self appendToJQuery: 'body' asJQuery ]
ifNotNil: [ root asJQuery css: 'visibility' put: 'visible' ]
! !
!HLTab methodsFor: 'rendering'!
renderOn: html
root := html div
class: 'tab';
yourself.
self renderTab
!
renderTab
root contents: [ :html |
html div
class: 'amber_box';
with: [ self widget renderOn: html ] ]
! !
!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
!
execute: aCommand
HLManager current keyBinder
activate;
applyBinding: aCommand asBinding
! !
!HLWidget methodsFor: 'keybindings'!
registerBindings
self registerBindingsOn: self manager keyBinder bindings
!
registerBindingsOn: aBindingGroup
! !
!HLWidget methodsFor: 'rendering'!
renderContentOn: html
!
renderOn: html
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: ''
package: 'Helios-Core'!
!HLFocusableWidget methodsFor: 'accessing'!
focusClass
^ 'focused'
! !
!HLFocusableWidget methodsFor: 'events'!
blur
self wrapper asJQuery blur
!
focus
self wrapper asJQuery focus
!
hasFocus
^ self wrapper notNil and: [ self wrapper asJQuery is: ':focus' ]
! !
!HLFocusableWidget methodsFor: 'rendering'!
renderContentOn: html
!
renderOn: html
self registerBindings.
wrapper := html div
class: 'hl_widget';
yourself.
wrapper with: [ self renderContentOn: html ].
wrapper
at: 'tabindex' put: '0';
onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
onFocus: [ self wrapper asJQuery addClass: self focusClass ]
! !
!HLFocusableWidget methodsFor: 'testing'!
canHaveFocus
^ true
! !
HLFocusableWidget subclass: #HLListWidget
instanceVariableNames: 'items selectedItem mapping'
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.inactive') get: 0))
!
activateItem: anObject
self activateListItem: (mapping
at: anObject
ifAbsent: [ ^ self ]) asJQuery
!
activateListItem: aListItem
| item |
(aListItem get: 0) ifNil: [ ^self ].
aListItem parent children removeClass: 'active'.
aListItem addClass: 'active'.
self ensureVisible: aListItem.
"Activate the corresponding item"
item := (self items at: (aListItem attr: 'list-data') asNumber).
self selectedItem == item ifFalse: [
self selectItem: item ]
!
activateNextListItem
self activateListItem: (window jQuery: '.focused .nav-pills .active') next.
"select the first item if none is selected"
(window jQuery: '.focused .nav-pills .active') get ifEmpty: [
self activateFirstListItem ]
!
activatePreviousListItem
self activateListItem: (window jQuery: '.focused .nav-pills .active') prev
!
ensureVisible: aListItem
"Move the scrollbar to show the active element"
| perent position |
position := self positionOf: aListItem.
parent := aListItem parent.
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 ]
!
focus
super focus.
self items isEmpty ifFalse: [
self selectedItem ifNil: [ self activateFirstListItem ] ]
!
refresh
super refresh.
self ensureVisible: (mapping
at: self selectedItem
ifAbsent: [ ^ self ]) asJQuery
!
selectItem: anObject
self selectedItem: anObject
! !
!HLListWidget methodsFor: 'defaults'!
defaultItems
^ #()
! !
!HLListWidget methodsFor: 'events'!
setupKeyBindings
"TODO: refactor this!!"
| active interval delay repeatInterval |
active := false.
repeatInterval := 70.
self wrapper asJQuery unbind: 'keydown'.
self wrapper asJQuery keydown: [ :e |
(e which = 38 and: [ active = false ]) ifTrue: [
active := true.
self activatePreviousListItem.
delay := [
interval := [ self activatePreviousListItem ]
valueWithInterval: repeatInterval ]
valueWithTimeout: 300 ].
(e which = 40 and: [ active = false ]) ifTrue: [
active := true.
self activateNextListItem.
delay := [
interval := [ self activateNextListItem ]
valueWithInterval: repeatInterval ]
valueWithTimeout: 300 ] ].
self wrapper asJQuery keyup: [ :e |
active ifTrue: [
active := false.
interval ifNotNil: [ interval clearInterval ].
delay ifNotNil: [ delay clearTimeout] ] ]
! !
!HLListWidget methodsFor: 'initialization'!
initialize
super initialize.
mapping := Dictionary new.
! !
!HLListWidget methodsFor: 'private'!
registerMappingFrom: anObject to: aTag
mapping at: anObject put: aTag
! !
!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.
self registerMappingFrom: anObject to: 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
mapping := Dictionary new.
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.
self wrapper 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.
aTab registerBindings.
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.
aTab remove.
self refresh.
self history ifNotEmpty: [
self history last activate ]
! !
!HLManager methodsFor: 'defaults'!
defaultEnvironment
"If helios is loaded from within a frame, answer the parent window environment"
window parent ifNil: [ ^ Environment new ].
^ ((window parent at: 'smalltalk')
at: 'Environment') new
! !
!HLManager methodsFor: 'initialization'!
initialize
super initialize.
self keyBinder setupEvents
! !
!HLManager methodsFor: 'rendering'!
refresh
(window jQuery: '.navbar') 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 ] ]
!
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
self tabs do: [ :each | each hide ].
aTab show; 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
! !