resin 0.2.2 → 0.2.3

data/amber/st/Helios-Commands.st

@@ -0,0 +1,223 @@
+Smalltalk current createPackage: 'Helios-Commands' properties: #{}!
+Object subclass: #HLCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands'!
+
+!HLCommand methodsFor: 'accessing'!
+
+documentation
+	^ self class documentation
+!
+
+key
+	^ self class key
+!
+
+label
+	^ self class label
+! !
+
+!HLCommand methodsFor: 'converting'!
+
+asBinding
+	^ (HLBindingAction on: self key labelled: self label)
+    	callback: [ self execute ]
+! !
+
+!HLCommand methodsFor: 'executing'!
+
+execute
+! !
+
+!HLCommand class methodsFor: 'accessing'!
+
+bindingGroup
+	^ nil
+!
+
+documentation
+	^ ''
+!
+
+key
+	^ nil
+!
+
+label
+	^ ''
+! !
+
+HLCommand subclass: #HLBrowserCommand
+	instanceVariableNames: 'model'
+	package: 'Helios-Commands'!
+
+!HLBrowserCommand methodsFor: 'accessing'!
+
+model
+	^ model
+!
+
+model: aBrowserModel
+	model := aBrowserModel
+! !
+
+!HLBrowserCommand class methodsFor: 'instance creation'!
+
+on: aBrowserModel
+	^ self new
+    	model: aBrowserModel;
+        yourself
+! !
+
+HLBrowserCommand subclass: #HLGoToCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands'!
+
+!HLGoToCommand class methodsFor: 'accessing'!
+
+bindingGroup
+	^ 'Go to'
+! !
+
+HLGoToCommand subclass: #HLGoToClassesCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands'!
+
+!HLGoToClassesCommand methodsFor: 'executing'!
+
+execute
+	self model selectedClass: self model selectedClass
+! !
+
+!HLGoToClassesCommand class methodsFor: 'accessing'!
+
+key
+	"c"
+    
+	^ 67
+!
+
+label
+	^ 'Classes'
+! !
+
+HLGoToCommand subclass: #HLGoToMethodsCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands'!
+
+!HLGoToMethodsCommand methodsFor: 'executing'!
+
+execute
+	self model selectedMethod: self model selectedMethod
+! !
+
+!HLGoToMethodsCommand class methodsFor: 'accessing'!
+
+key
+	"m"
+    
+	^ 77
+!
+
+label
+	^ 'Methods'
+! !
+
+HLGoToCommand subclass: #HLGoToPackagesCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands'!
+
+!HLGoToPackagesCommand methodsFor: 'executing'!
+
+execute
+	self model selectedPackage: self model selectedPackage
+! !
+
+!HLGoToPackagesCommand class methodsFor: 'accessing'!
+
+key
+	"p"
+    
+	^ 80
+!
+
+label
+	^ 'Packages'
+! !
+
+HLGoToCommand subclass: #HLGoToProtocolsCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands'!
+
+!HLGoToProtocolsCommand methodsFor: 'executing'!
+
+execute
+	self model selectedProtocol: self model selectedProtocol
+! !
+
+!HLGoToProtocolsCommand class methodsFor: 'accessing'!
+
+key
+	"p"
+    
+	^ 84
+!
+
+label
+	^ 'Protocols'
+! !
+
+HLBrowserCommand subclass: #HLToggleCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands'!
+
+!HLToggleCommand class methodsFor: 'accessing'!
+
+bindingGroup
+	^ 'Toggle'
+! !
+
+HLToggleCommand subclass: #HLToggleClassSideCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands'!
+
+!HLToggleClassSideCommand methodsFor: 'executing'!
+
+execute
+	self model showInstance: false
+! !
+
+!HLToggleClassSideCommand class methodsFor: 'accessing'!
+
+key
+	"c"
+    
+	^ 67
+!
+
+label
+	^ 'Class side'
+! !
+
+HLToggleCommand subclass: #HLToggleInstanceSideCommand
+	instanceVariableNames: ''
+	package: 'Helios-Commands'!
+
+!HLToggleInstanceSideCommand methodsFor: 'executing'!
+
+execute
+	self model showInstance: true
+! !
+
+!HLToggleInstanceSideCommand class methodsFor: 'accessing'!
+
+key
+	"i"
+    
+	^ 73
+!
+
+label
+	^ 'Instance side'
+! !
+

data/amber/st/Helios-Core.st

@@ -0,0 +1,532 @@
+Smalltalk current createPackage: 'Helios-Core' properties: #{}!
+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: 'wrapper'
+	package: 'Helios-Core'!
+
+!HLWidget methodsFor: 'accessing'!
+
+manager
+	^ HLManager current
+!
+
+wrapper
+	^ wrapper
+! !
+
+!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: 'updating'!
+
+refresh
+	self wrapper ifNil: [ ^ self ].
+    
+	self wrapper asJQuery empty.
+    [ :html | self renderContentOn: html ] appendToJQuery: self wrapper 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
+	^ 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 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
+!
+
+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 = aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1>.
+
+    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'
+	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
+!
+
+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: '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-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
+! !
+