amber/st/Helios-Widgets.st

Smalltalk current createPackage: 'Helios-Widgets' properties: #{}!
Object subclass: #HLTab
	instanceVariableNames: 'widget label'
	package: 'Helios-Widgets'!

!HLTab methodsFor: 'accessing'!

activate
	self manager activate: self
!

add
	self manager addTab: self
!

label
	^ label ifNil: [ '' ]
!

label: aString
	label := aString
!

manager
	^ HLTabManager 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-Widgets'!

!HLWidget methodsFor: 'accessing'!

announcer
	^ self manager announcer
!

manager
	^ HLTabManager current
! !

!HLWidget methodsFor: 'announces'!

announce: anObject
	self announcer announce: anObject
!

on: anAnnouncement do: aBlock
	self announcer on: anAnnouncement do: aBlock
! !

!HLWidget methodsFor: 'initialization'!

initialize
	super initialize.
    self subscribe
!

subscribe
! !

!HLWidget methodsFor: 'rendering'!

renderContentOn: html
!

renderOn: html
	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
	HLTabManager current addTab: (HLTab on: self new labelled: self tabLabel)
!

tabLabel
	^ 'Tab'
!

tabPriority
	^ 500
! !

!HLWidget class methodsFor: 'testing'!

canBeOpenAsTab
	^ false
! !

HLWidget subclass: #HLBrowser
	instanceVariableNames: 'environment selectedPackage selectedClass packagesListWidget classesListWidget'
	package: 'Helios-Widgets'!

!HLBrowser methodsFor: 'accessing'!

classesListWidget
	^ classesListWidget ifNil: [
      	classesListWidget := HLClassesListWidget on: self ]
!

environment
	^ environment ifNil: [ environment := Smalltalk current ]
!

environment: anEnvironment
	environment := anEnvironment
!

packagesListWidget
	^ packagesListWidget ifNil: [
      	packagesListWidget := HLPackagesListWidget on: self ]
!

selectPackage: aPackage
	selectedPackage := aPackage.
    selectedClass := nil.
    
    self classesListWidget package: aPackage.
!

selectedPackage
	^ selectedPackage
! !

!HLBrowser methodsFor: 'rendering'!

renderContentOn: html
	html with: (HLContainer with: (HLHorizontalSplitter 
    	with: (HLVerticalSplitter
        	with: (HLVerticalSplitter
            	with: self packagesListWidget
                with: self classesListWidget)
            with: (HLVerticalSplitter
            	with: 'Protocols'
                with: 'Methods')) 
        with: 'Source Code'))
!

renderTopPanesOn: html
	html div class: 'pane'; with: self packagesListWidget.
	html div class: 'pane'; with: self classesListWidget.
    html div class: 'pane'; with: 'hello'.
	html div class: 'pane'; with: 'world'
! !

HLBrowser class instanceVariableNames: 'nextId'!

!HLBrowser class methodsFor: 'accessing'!

nextId
	nextId ifNil: [ nextId := 0 ].
    ^ 'browser_', (nextId + 1) asString
!

tabLabel
	^ 'Browser'
!

tabPriority
	^ 0
! !

!HLBrowser class methodsFor: 'testing'!

canBeOpenAsTab
	^ true
! !

HLWidget subclass: #HLDebugger
	instanceVariableNames: ''
	package: 'Helios-Widgets'!

HLWidget subclass: #HLFocusableWidget
	instanceVariableNames: 'hiddenInput'
	package: 'Helios-Widgets'!

!HLFocusableWidget methodsFor: 'accessing'!

focusClass
	^ 'focused'
! !

!HLFocusableWidget methodsFor: 'events'!

blur
	rootDiv asJQuery removeClass: self focusClass.
!

focus
	rootDiv asJQuery addClass: self focusClass
!

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: [ self blur ];
        onFocus: [ self focus ]
!

renderOn: html
	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-Widgets'!

!HLListWidget methodsFor: 'accessing'!

cssClassForItem: anObject
	^ self selectedItem = anObject
			ifTrue: [ 'active' ]
			ifFalse: [ 'inactive' ]
!

items
	^ self subclassResponsibility
!

selectedItem
	^ selectedItem ifNil: [ 
    	self items ifNotEmpty: [ self items first ] ]
!

selectedItem: anObject
	selectedItem := anObject
! !

!HLListWidget methodsFor: 'actions'!

activateListItem: aListItem
	aListItem asJQuery parent children removeClass: 'active'.
	aListItem asJQuery addClass: 'active'
!

selectItem: anObject
	self selectedItem: anObject
! !

!HLListWidget methodsFor: 'rendering'!

renderContentOn: html
	html ul 
    	class: 'nav nav-pills nav-stacked';
        with: [ 
        	self items do: [ :each | 
            	self renderItem: each on: html ] ]
!

renderItem: anObject on: html
	| li |
    
	li := html li.
    li
    	class: (self cssClassForItem: anObject);
        with: [ 
        	html a
            	with: [ 
            		(html tag: 'i') class: anObject heliosListIcon.
  					self renderItemLabel: anObject on: html ];
				onClick: [
                  	self activateListItem: li.
                	self selectItem: anObject ] ]
!

renderItemLabel: anObject on: html
	html with: anObject asString
! !

HLListWidget subclass: #HLBrowserListWidget
	instanceVariableNames: 'browser'
	package: 'Helios-Widgets'!

!HLBrowserListWidget methodsFor: 'accessing'!

browser
	^ browser
!

browser: aBrowser
	browser := aBrowser
! !

!HLBrowserListWidget class methodsFor: 'instance creation'!

on: aBrowser
	^ self new
    	browser: aBrowser;
        yourself
! !

HLBrowserListWidget subclass: #HLClassesListWidget
	instanceVariableNames: 'package'
	package: 'Helios-Widgets'!

!HLClassesListWidget methodsFor: 'accessing'!

items
	^ self package 
    	ifNil: [ #() ]
  		ifNotNil: [ self package classes ]
!

package
	^ package
!

package: aPackage
	package := aPackage.
    self refresh
! !

HLBrowserListWidget subclass: #HLPackagesListWidget
	instanceVariableNames: ''
	package: 'Helios-Widgets'!

!HLPackagesListWidget methodsFor: 'accessing'!

browser
	^ browser
!

browser: aBrowser
	browser := aBrowser
!

environment
	^ self browser environment
!

items
	^ self environment packages
! !

!HLPackagesListWidget methodsFor: 'actions'!

selectItem: aPackage
	super selectItem: aPackage.
    self browser selectPackage: aPackage
! !

HLWidget subclass: #HLInspector
	instanceVariableNames: ''
	package: 'Helios-Widgets'!

HLWidget subclass: #HLSUnit
	instanceVariableNames: ''
	package: 'Helios-Widgets'!

!HLSUnit class methodsFor: 'accessing'!

tabLabel
	^ 'SUnit'
!

tabPriority
	^ 1000
! !

!HLSUnit class methodsFor: 'testing'!

canBeOpenAsTab
	^ true
! !

HLWidget subclass: #HLTabManager
	instanceVariableNames: 'tabs activeTab announcer'
	package: 'Helios-Widgets'!

!HLTabManager methodsFor: 'accessing'!

activate: aTab
	activeTab := aTab.
	self 
		refresh;
		show: aTab
!

activeTab
	^ activeTab
!

addTab: aTab
	self tabs add: aTab.
    self activate: aTab
!

announcer
	^ announcer ifNil: [ announcer := Announcer new ]
!

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
!

tabs
	^ tabs ifNil: [ tabs := OrderedCollection new ]
! !

!HLTabManager 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
! !

HLTabManager class instanceVariableNames: 'current'!

!HLTabManager class methodsFor: 'accessing'!

current
	^ current ifNil: [ current := self basicNew initialize ]
! !

!HLTabManager class methodsFor: 'initialization'!

initialize
	self current appendToJQuery: 'body' asJQuery
! !

!HLTabManager class methodsFor: 'instance creation'!

new
	"Use current instead"

	self shouldNotImplement
! !

HLWidget subclass: #HLTranscript
	instanceVariableNames: ''
	package: 'Helios-Widgets'!

!HLTranscript class methodsFor: 'accessing'!

tabLabel
	^ 'Transcript'
!

tabPriority
	^ 600
! !

!HLTranscript class methodsFor: 'testing'!

canBeOpenAsTab
	^ true
! !

HLWidget subclass: #HLWorkspace
	instanceVariableNames: ''
	package: 'Helios-Widgets'!

!HLWorkspace class methodsFor: 'accessing'!

tabLabel
	^ 'Workspace'
!

tabPriority
	^ 10
! !

!HLWorkspace class methodsFor: 'testing'!

canBeOpenAsTab
	^ true
! !

!Object methodsFor: '*Helios-Widgets'!

heliosListIcon
	^ ''
! !