Smalltalk current createPackage: 'Helios-Core' properties: #{}! Widget subclass: #HLSourceArea instanceVariableNames: 'editor textarea div receiver onDoIt' package: 'Helios-Core'! !HLSourceArea methodsFor: 'accessing'! contents ^editor getValue ! contents: aString editor setValue: aString ! currentLine ^editor getLine: (editor getCursor line) ! currentLineOrSelection ^editor somethingSelected ifFalse: [self currentLine] ifTrue: [self selection] ! editor ^editor ! onDoIt ^onDoIt ! onDoIt: aBlock onDoIt := aBlock ! receiver ^receiver ifNil: [DoIt new] ! receiver: anObject receiver := anObject ! selection ^editor getSelection ! selectionEnd ^textarea element selectionEnd ! selectionEnd: anInteger textarea element selectionEnd: anInteger ! selectionStart ^textarea element selectionStart ! selectionStart: anInteger textarea element selectionStart: anInteger ! setEditorOn: aTextarea ! val ^editor getValue ! val: aString editor setValue: aString ! ! !HLSourceArea methodsFor: 'actions'! clear self contents: '' ! doIt | result | result := self eval: self currentLineOrSelection. self onDoIt ifNotNil: [self onDoIt value]. ^result ! eval: aString | compiler | compiler := Compiler new. [compiler parseExpression: aString] on: Error do: [:ex | ^window alert: ex messageText]. ^(compiler eval: (compiler compile: 'doIt ^[', aString, '] value' forClass: DoIt)) fn applyTo: self receiver arguments: #() ! fileIn Importer new import: self currentLineOrSelection readStream ! handleKeyDown: anEvent ! inspectIt self doIt inspect ! print: aString | start stop | start := HashedCollection new. stop := HashedCollection new. start at: 'line' put: (editor getCursor: false) line. start at: 'ch' put: (editor getCursor: false) ch. stop at: 'line' put: (start at: 'line'). stop at: 'ch' put: ((start at: 'ch') + aString size + 2). editor replaceSelection: (editor getSelection, ' ', aString, ' '). editor setCursor: (editor getCursor: true). editor setSelection: stop end: start ! printIt self print: self doIt printString ! ! !HLSourceArea methodsFor: 'events'! onKeyDown: aBlock div onKeyDown: aBlock ! onKeyUp: aBlock div onKeyUp: aBlock ! ! !HLSourceArea methodsFor: 'rendering'! renderOn: html div := html div class: 'source'. div with: [textarea := html textarea]. self setEditorOn: textarea element. div onKeyDown: [:e | self handleKeyDown: e] ! ! Object subclass: #HLTab instanceVariableNames: 'widget label' package: 'Helios-Core'! !HLTab methodsFor: 'accessing'! activate self manager activate: self ! add self manager addTab: self ! 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: 'rootDiv' package: 'Helios-Core'! !HLWidget methodsFor: 'accessing'! manager ^ HLManager current ! ! !HLWidget methodsFor: 'announcements'! subscribeTo: anAnnouncer ! ! !HLWidget methodsFor: 'keybindings'! registerBindings self registerBindingsOn: self manager keyBinder bindings ! registerBindingsOn: aBindingGroup ! ! !HLWidget methodsFor: 'rendering'! renderContentOn: html ! renderOn: html self registerBindings. rootDiv := html div with: [ self renderContentOn: html ] ! ! !HLWidget methodsFor: 'updating'! refresh rootDiv ifNil: [ ^ self ]. rootDiv asJQuery empty. [ :html | self renderContentOn: html ] appendToJQuery: rootDiv asJQuery ! ! !HLWidget class methodsFor: 'accessing'! openAsTab 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 ^ rootDiv notNil and: [ rootDiv asJQuery hasClass: self focusClass ] ! ! !HLFocusableWidget methodsFor: 'rendering'! renderContentOn: html ! renderHiddenInputOn: html hiddenInput := html input style: 'position: absolute; left: -100000px;'; onBlur: [ rootDiv asJQuery removeClass: self focusClass ]; onFocus: [ rootDiv asJQuery addClass: self focusClass ] ! renderOn: html self registerBindings. self renderHiddenInputOn: html. rootDiv := html div class: 'hl_widget'; onClick: [ hiddenInput asJQuery focus ]; with: [ self renderContentOn: html ] ! ! 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: aCollection items := aCollection ! selectedItem ^ selectedItem ! selectedItem: anObject selectedItem := anObject ! ! !HLListWidget methodsFor: 'actions'! activateListItem: aListItem | parent position | (aListItem get: 0) ifNil: [ ^self ]. . 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) ! selectItem: anObject self selectedItem: anObject ! ! !HLListWidget methodsFor: 'events'! setupKeyBindings 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: [ self activateListItem: selected 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. "self selectItem: anObject" ] ] ! 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: #HLInspector instanceVariableNames: '' package: 'Helios-Core'! HLWidget subclass: #HLManager instanceVariableNames: 'tabs activeTab keyBinder' package: 'Helios-Core'! !HLManager methodsFor: 'accessing'! activeTab ^ activeTab ! keyBinder ^ keyBinder ifNil: [ keyBinder := HLKeyBinder new ] ! tabs ^ tabs ifNil: [ tabs := OrderedCollection new ] ! ! !HLManager methodsFor: 'actions'! activate: aTab self keyBinder flushBindings. activeTab := aTab. self refresh; show: aTab ! addTab: aTab self tabs add: aTab. self activate: aTab ! removeTab: aTab "Todo: activate the previously activated tab. Keep a history of tabs selection" (self tabs includes: aTab) ifFalse: [ ^ self ]. self tabs remove: aTab. self refresh ! ! !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-circle') onClick: [ self removeTab: each ]. html with: each label ]; onClick: [ each activate ] ] ]. self renderAddOn: html ] ! show: aTab (window jQuery: '#container') empty. aTab widget appendToJQuery: '#container' asJQuery ! ! 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 ! ! HLWidget subclass: #HLWorkspace instanceVariableNames: '' package: 'Helios-Core'! !HLWorkspace class methodsFor: 'accessing'! tabLabel ^ 'Workspace' ! tabPriority ^ 10 ! ! !HLWorkspace class methodsFor: 'testing'! canBeOpenAsTab ^ true ! !