contrib-legacy/src/IDE.st

Smalltalk createPackage: 'IDE'!
(Smalltalk packageAt: 'IDE' ifAbsent: [ self error: 'Package not created: IDE' ]) imports: {'codemirror/addon/hint/show-hint'. 'codemirror/lib/codemirror'. 'codemirror/mode/smalltalk/smalltalk'. 'css!!./resources/amber'. 'css!!codemirror/addon/hint/show-hint'. 'css!!codemirror/lib/codemirror'. 'css!!codemirror/theme/ambiance'. 'jquery-ui'}!
Widget subclass: #ClassesList
	instanceVariableNames: 'browser ul nodes'
	package: 'IDE'!

!ClassesList methodsFor: 'accessing'!

browser
	^ browser
!

browser: aBrowser
	browser := aBrowser
!

category
	^ self browser selectedPackage
!

getNodes
	| classes children others |
	classes := self browser classes.
	children := #().
	others := #().
	classes do: [ :each |
		(classes includes: each superclass)
			ifFalse: [ children add: each ]
			ifTrue: [ others add: each ]].
	^ children collect: [ :each |
		ClassesListNode on: each browser: self browser classes: others level: 0 ]
!

nodes
	nodes ifNil: [ nodes := self getNodes ].
	^ nodes
!

resetNodes
	nodes := nil
! !

!ClassesList methodsFor: 'rendering'!

renderOn: html
	ul := html ul
		class: 'amber_column browser classes';
		yourself.
	self updateNodes
!

updateNodes
	ul contents: [ :html |
		self nodes do: [ :each |
			each renderOn: html ]]
! !

!ClassesList class methodsFor: 'instance creation'!

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

Widget subclass: #ClassesListNode
	instanceVariableNames: 'browser theClass level nodes'
	package: 'IDE'!

!ClassesListNode methodsFor: 'accessing'!

browser
	^ browser
!

browser: aBrowser
	browser := aBrowser
!

getNodesFrom: aCollection
	| children others |
	children := #().
	others := #().
	aCollection do: [ :each |
		(each superclass = self theClass)
			ifTrue: [ children add: each ]
			ifFalse: [ others add: each ]].
	nodes:= children collect: [ :each |
		ClassesListNode on: each browser: self browser classes: others level: self level + 1 ]
!

label
	| str |
	str := String new writeStream.
	self level timesRepeat: [
		str nextPutAll: '    ' ].
	str nextPutAll: self theClass name.
	^ str contents
!

level
	^ level
!

level: anInteger
	level := anInteger
!

nodes
	^ nodes
!

theClass
	^ theClass
!

theClass: aClass
	theClass := aClass
! !

!ClassesListNode methodsFor: 'rendering'!

renderOn: html
	| li cssClass |
	cssClass := ''.
	li := html li
		onClick: [ self browser selectClass: self theClass ].
	li asJQuery html: self label.

	self browser selectedClass = self theClass ifTrue: [
		cssClass := cssClass, ' selected' ].

	self theClass comment ifNotEmpty: [
		cssClass := cssClass, ' commented' ].

	li class: cssClass.

	self nodes do: [ :each |
		each renderOn: html ]
! !

!ClassesListNode class methodsFor: 'instance creation'!

on: aClass browser: aBrowser classes: aCollection level: anInteger
	^ self new
		theClass: aClass;
		browser: aBrowser;
		level: anInteger;
		getNodesFrom: aCollection;
		yourself
! !

Object subclass: #DebugErrorHandler
	instanceVariableNames: ''
	package: 'IDE'!

!DebugErrorHandler methodsFor: 'error handling'!

handleError: anError
	[ Debugger new
		error: anError;
		open ] on: Error do: [ :error |
			ConsoleErrorHandler new handleError: error ]
! !

!DebugErrorHandler class methodsFor: 'initialization'!

initialize
	ErrorHandler register: self new
! !

Widget subclass: #SourceArea
	instanceVariableNames: 'editor div receiver onDoIt'
	package: 'IDE'!

!SourceArea methodsFor: 'accessing'!

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
!

setEditorOn: aTextarea
	<inlineJS: '$self["@editor"] = $self._class()._codeMirror().fromTextArea(aTextarea, {
		theme: "ide.codeMirrorTheme"._settingValueIfAbsent_("default"),
		mode: "text/x-stsrc",
		lineNumbers: true,
		enterMode: "flat",
		indentWithTabs: true,
		indentUnit: 4,
		matchBrackets: true,
		electricChars: false
	})'>
!

val
	^ editor getValue
!

val: aString
	editor setValue: aString
! !

!SourceArea methodsFor: 'actions'!

clear
	self val: ''
!

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 |
		^ Terminal alert: ex messageText ].
	^ compiler evaluateExpression: aString on: self receiver
!

fileIn
	Importer new import: self currentLineOrSelection readStream
!

focus
	self editor focus.
!

handleKeyDown: anEvent
	<inlineJS: 'if(anEvent.ctrlKey) {
		if(anEvent.keyCode === 80) { //ctrl+p
			$self._printIt();
			anEvent.preventDefault();
			return false;
		}
		if(anEvent.keyCode === 68) { //ctrl+d
			$self._doIt();
			anEvent.preventDefault();
			return false;
		}
		if(anEvent.keyCode === 73) { //ctrl+i
			$self._inspectIt();
			anEvent.preventDefault();
			return false;
		}
	}'>
!

inspectIt
	self doIt inspect
!

print: aString
	| start stop currentLine |
	currentLine := (editor getCursor: false) line.
	start := HashedCollection new.
	start at: 'line' put: currentLine.
	start at: 'ch' put: (editor getCursor: false) ch.
	(editor getSelection) ifEmpty: [
		"select current line if selection is empty"
		start at: 'ch' put: (editor getLine: currentLine) size.
		editor setSelection: #{'line' -> currentLine. 'ch' -> 0} end: start.
	].
	stop := HashedCollection new.
	stop at: 'line' put: currentLine.
	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.
	self focus.
! !

!SourceArea methodsFor: 'events'!

onKeyDown: aBlock
	div onKeyDown: aBlock
!

onKeyUp: aBlock
	div onKeyUp: aBlock
! !

!SourceArea methodsFor: 'rendering'!

renderOn: html
	| textarea |
	div := html div class: 'source'.
	div with: [ textarea := html textarea ].
	self setEditorOn: textarea asDomNode.
	div onKeyDown: [ :e | self handleKeyDown: e ]
! !

!SourceArea class methodsFor: 'accessing'!

codeMirror
	^ require value: 'codemirror/lib/codemirror'
! !

!SourceArea class methodsFor: 'initialization'!

initialize
	super initialize.
	self setupCodeMirror
!

setupCodeMirror
	<inlineJS: '$self._codeMirror().keyMap["default"].fallthrough = ["basic"]'>
! !

Widget subclass: #TabManager
	instanceVariableNames: 'selectedTab tabs opened ul input'
	package: 'IDE'!

!TabManager methodsFor: 'accessing'!

labelFor: aWidget
	| label maxSize |
	maxSize := 15.
	label := aWidget label copyFrom: 0 to: (aWidget label size min: maxSize).
	aWidget label size > maxSize ifTrue: [
		label := label, '...' ].
	^ label
!

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

!TabManager methodsFor: 'actions'!

close
	opened ifTrue: [
	'#amber' asJQuery hide.
	ul asJQuery hide.
	selectedTab hide.
	self removeBodyMargin.
	'body' asJQuery removeClass: 'amberBody'.
	opened := false ]
!

closeTab: aWidget
	self removeTab: aWidget.
	self selectTab: self tabs last.
	aWidget remove.
	self update
!

newBrowserTab
	Browser open
!

onResize: aBlock
	'#amber' asJQuery resizable: #{
		'handles' -> 'n'.
		'resize' -> aBlock.
		'minHeight' -> 230
	}
!

onWindowResize: aBlock
	window asJQuery resize: aBlock
!

open
	opened ifFalse: [
	'body' asJQuery addClass: 'amberBody'.
	'#amber' asJQuery show.
	ul asJQuery show.
	self updateBodyMargin.
	selectedTab show.
	opened := true ]
!

removeBodyMargin
	self setBodyMargin: 0
!

search: aString
	| searchedClass |
	searchedClass := Smalltalk globals at: aString.
		searchedClass isClass
			ifTrue: [ Browser openOn: searchedClass ]
			ifFalse: [ ReferencesBrowser search: aString ]
!

selectTab: aWidget
	self open.
	selectedTab := aWidget.
	self tabs do: [ :each |
	each hide ].
	aWidget show.
	
	self update
!

setBodyMargin: anInteger
	'.amberBody' asJQuery css: 'margin-bottom' put: anInteger asString, 'px'
!

updateBodyMargin
	self setBodyMargin: '#amber' asJQuery height
!

updatePosition
	'#amber' asJQuery
		css: 'top' put: '';
		css: 'bottom' put: '0px'
! !

!TabManager methodsFor: 'adding/Removing'!

addTab: aWidget
	self tabs add: aWidget.
	aWidget appendToJQuery: '#amber' asJQuery.
	aWidget hide
!

removeTab: aWidget
	self tabs remove: aWidget.
	self update
! !

!TabManager methodsFor: 'initialization'!

initialize
	super initialize.
	Inspector register: IDEInspector.
	opened := true.
	[ :html | html div id: 'amber' ] appendToJQuery: 'body' asJQuery.
	'body' asJQuery
	addClass: 'amberBody'.
	self appendToJQuery: '#amber' asJQuery.
	self
	addTab: IDETranscript current;
	addTab: Workspace new;
	addTab: TestRunner new.
	self selectTab: self tabs last.
	self
	onResize: [ self updateBodyMargin; updatePosition ];
	onWindowResize: [ self updatePosition ]
! !

!TabManager methodsFor: 'rendering'!

renderOn: html
	html div id: 'logo'.
	self renderToolbarOn: html.
	ul := html ul
		id: 'amberTabs';
		yourself.
	self renderTabs
!

renderTabFor: aWidget on: html
	| li |
	li := html li.
	selectedTab = aWidget ifTrue: [
	li class: 'selected' ].
	li with: [
		html span class: 'ltab'.
		html span
			class: 'mtab';
			with: [
				aWidget canBeClosed ifTrue: [
					html span
						class: 'close';
						with: 'x';
					onClick: [ self closeTab: aWidget ]].
			html span with: (self labelFor: aWidget) ].
		html span class: 'rtab' ];
	onClick: [ self selectTab: aWidget ]
!

renderTabs
	ul contents: [ :html |
		self tabs do: [ :each |
		self renderTabFor: each on: html ].
		html li
		class: 'newtab';
		with: [
			html span class: 'ltab'.
			html span class: 'mtab'; with: ' + '.
			html span class: 'rtab' ];
		onClick: [ self newBrowserTab ]]
!

renderToolbarOn: html
	html div
		id: 'amber_toolbar';
		with: [
			input := html input
				class: 'implementors';
				yourself.
			input onKeyPress: [ :event |
				event keyCode = 13 ifTrue: [
				self search: input asJQuery val ]].
			html div id: 'amber_close'; onClick: [ self close ]]
! !

!TabManager methodsFor: 'updating'!

update
	self renderTabs
! !

TabManager class instanceVariableNames: 'current'!

!TabManager class methodsFor: 'actions'!

toggleAmberIDE
	'#amber' asJQuery length = 0
		ifTrue: [ Browser open ]
		ifFalse: [
			('#amber' asJQuery is: ':visible')
				ifTrue: [ TabManager current close ]
				ifFalse: [ TabManager current open ] ]
! !

!TabManager class methodsFor: 'instance creation'!

current
	^ current ifNil: [ current := super new ]
!

new
	self shouldNotImplement
! !

Widget subclass: #TabWidget
	instanceVariableNames: 'div'
	package: 'IDE'!

!TabWidget methodsFor: 'accessing'!

label
	self subclassResponsibility
! !

!TabWidget methodsFor: 'actions'!

close
	TabManager current closeTab: self
!

hide
	div asJQuery hide
!

open
	TabManager current addTab: self.
	TabManager current selectTab: self
!

remove
	div asJQuery remove
!

show
	div asJQuery show
! !

!TabWidget methodsFor: 'rendering'!

renderBoxOn: html
!

renderButtonsOn: html
!

renderOn: html
	div := html div
		class: 'amberTool';
		yourself.
	self renderTab
!

renderTab
	div contents: [ :html |
		html div
		class: 'amber_box';
		with: [ self renderBoxOn: html ].
		html div
		class: 'amber_buttons';
		with: [ self renderButtonsOn: html ]]
!

update
	self renderTab
! !

!TabWidget methodsFor: 'testing'!

canBeClosed
	^ false
! !

!TabWidget class methodsFor: 'instance creation'!

open
	^ self new open
! !

TabWidget subclass: #Browser
	instanceVariableNames: 'selectedPackage selectedClass selectedProtocol selectedMethod packagesList classesList protocolsList methodsList sourceArea tabsList selectedTab saveButton classButtons methodButtons unsavedChanges'
	package: 'IDE'!

!Browser methodsFor: 'accessing'!

classCommentSource
	^ selectedClass comment
!

classDeclarationTemplate
	^ 'Object subclass: #NameOfSubclass
	instanceVariableNames: ''''
	package: ''', self selectedPackage, ''''
!

classes
	^ ((Smalltalk classes
	select: [ :each | each category = selectedPackage ])
	sort: [ :a :b | a name < b name ]) asSet
!

declarationSource
	| klass |
	klass := self selectedClassOrMetaClass.
	^ klass ifNotNil: [ klass definition ] ifNil: [
		selectedTab = #instance ifTrue: [ self classDeclarationTemplate ] ifFalse: [ '' ] 
	]
!

dummyMethodSource
	^ 'messageSelectorAndArgumentNames
	"comment stating purpose of message"

	| temporary variable names |
	statements'
!

label
	^ selectedClass
	ifNil: [ 'Browser (nil)' ]
	ifNotNil: [ 'Browser: ', selectedClass name ]
!

methodSource
	^ selectedMethod
	ifNil: [ self dummyMethodSource ]
	ifNotNil: [ selectedMethod source ]
!

methods
	| klass |
	selectedTab = #comment ifTrue: [ ^ #() ].
	klass := self selectedClassOrMetaClass.
	^ (selectedProtocol
	ifNil: [
		klass
		ifNil: [ #() ]
		ifNotNil: [ klass methodDictionary values ]]
	ifNotNil: [
		klass methodsInProtocol: selectedProtocol ]) 
				sort: [ :a :b | a selector < b selector ]
!

packages
	| packages |
	packages := Array new.
	Smalltalk classes do: [ :each |
	(packages includes: each category) ifFalse: [
		packages add: each category ]].
	^ packages sort
!

protocols
	| klass |
	selectedClass ifNil: [ ^ #() ].
	selectedTab = #comment ifTrue: [ ^ #() ].
	klass := self selectedClassOrMetaClass.
	klass ifNil: [ ^ #() ].
	klass methodDictionary ifEmpty: [ ^ {'not yet classified'} ].
	^ klass protocols
!

selectedClass
	^ selectedClass
!

selectedClassOrMetaClass
	^ selectedClass ifNotNil: [
		selectedTab = #instance
			ifTrue: [ selectedClass ]
			ifFalse: [ selectedClass theMetaClass ] ]
!

selectedPackage
	^ selectedPackage
!

source
	selectedTab = #comment ifFalse: [
	^ (selectedProtocol notNil or: [ selectedMethod notNil ])
		ifFalse: [ self declarationSource ]
		ifTrue: [ self methodSource ]].
	^ selectedClass
	ifNil: [ '' ]
	ifNotNil: [ self classCommentSource ]
! !

!Browser methodsFor: 'actions'!

addNewClass
	| className |
	className := Terminal prompt: 'New class'.
	(className notNil and: [ className notEmpty ]) ifTrue: [
		Object subclass: className instanceVariableNames: '' package: self selectedPackage.
			self
			resetClassesList;
			updateClassesList.
		self selectClass: (Smalltalk globals at: className) ]
!

addNewProtocol
	| newProtocol |
	
	newProtocol := Terminal prompt: 'New method protocol'.
	
	(newProtocol notNil and: [ newProtocol notEmpty ]) ifTrue: [
		selectedMethod protocol: newProtocol.
		self setMethodProtocol: newProtocol ]
!

cancelChanges
	^ unsavedChanges
	ifTrue: [ Terminal confirm: 'Cancel changes?' ]
	ifFalse: [ true ]
!

commitPackage
	selectedPackage ifNotNil: [
		(Package named: selectedPackage) commit ]
!

compile
	| currentEditLine |
	self disableSaveButton.
	currentEditLine := sourceArea editor getCursor.
	selectedTab = #comment
	ifTrue: [
			selectedClass ifNotNil: [
				self compileClassComment ]]
	ifFalse: [
			(selectedProtocol notNil or: [ selectedMethod notNil ])
				ifFalse: [ self compileDefinition ]
				ifTrue: [ self compileMethodDefinition ]].
	sourceArea editor setCursor: currentEditLine.
!

compileClassComment
	selectedClass comment: sourceArea val
!

compileDefinition
	| newClass |
	newClass := Compiler new evaluateExpression: sourceArea val.
	self
	resetClassesList;
	updateCategoriesList;
	updateClassesList.
	self selectClass: newClass
!

compileMethodDefinition
	self compileMethodDefinitionFor: self selectedClassOrMetaClass
!

compileMethodDefinitionFor: aClass
	| compiler package method compiledSource source node |
	source := sourceArea val.
	selectedProtocol ifNil: [ selectedProtocol := selectedMethod protocol ].
	[[ method := Compiler new
		install: source forClass: aClass protocol: selectedProtocol ]
	on: ParseError do: [ :e |
		^ Terminal alert: 'PARSE ERROR: ', e messageText ]]
	on: UnknownVariableError do: [ :e |
		"Do not try to redeclare javascript's objects"
		(Platform includesGlobal: e variableName) ifFalse: [
		(Terminal confirm: 'Declare ''', e variableName, ''' as instance variable?') ifFalse: [ ^ nil ] ifTrue: [
			Environment new addInstVarNamed: e variableName to: aClass.
			^ self compileMethodDefinitionFor: aClass ] ] ].
	self updateMethodsList.
	self selectMethod: method
!

copyClass
	| className |
	className := Terminal prompt: 'Copy class'.
	(className notNil and: [ className notEmpty ]) ifTrue: [
		ClassBuilder new copyClass: self selectedClass named: className.
			self
			resetClassesList;
			updateClassesList.
		self selectClass: (Smalltalk globals at: className) ]
!

disableSaveButton
	saveButton ifNotNil: [
	saveButton at: 'disabled' put: true ].
	unsavedChanges := false
!

handleSourceAreaKeyDown: anEvent
	<inlineJS: 'if(anEvent.ctrlKey) {
		if(anEvent.keyCode === 83) { //ctrl+s
			$self._compile();
			anEvent.preventDefault();
			return false;
		}
	}
	'>
!

hideClassButtons
	classButtons asJQuery hide
!

hideMethodButtons
	methodButtons asJQuery hide
!

removeClass
	(Terminal confirm: 'Do you really want to remove ', selectedClass name, '?')
	ifTrue: [
		Smalltalk removeClass: selectedClass.
		self resetClassesList.
		self selectClass: nil ]
!

removeMethod
	self cancelChanges ifTrue: [
	(Terminal confirm: 'Do you really want to remove #', selectedMethod selector, '?')
		ifTrue: [
		self selectedClassOrMetaClass removeCompiledMethod: selectedMethod.
		self selectMethod: nil ]]
!

removePackage

	(Terminal confirm: 'Do you really want to remove the whole package ', selectedPackage, ' with all its classes?')
	ifTrue: [
		Smalltalk removePackage: selectedPackage.
		self updateCategoriesList ]
!

renameClass
	| newName |
	newName := Terminal prompt: 'Rename class ', selectedClass name.
	(newName notNil and: [ newName notEmpty ]) ifTrue: [
	selectedClass rename: newName.
	self
		updateClassesList;
		updateSourceAndButtons ]
!

renamePackage

	| newName |
	newName := Terminal prompt: 'Rename package ', selectedPackage.
	newName ifNotNil: [ newName ifNotEmpty: [
	Smalltalk renamePackage: selectedPackage to: newName.
	self updateCategoriesList ]]
!

search: aString
	self cancelChanges ifTrue: [ | searchedClass |
		searchedClass := Smalltalk globals at: aString.
		searchedClass isClass
			ifTrue: [ self class openOn: searchedClass ]
			ifFalse: [ self searchReferencesOf: aString ]]
!

searchClassReferences
	ReferencesBrowser search: selectedClass name
!

searchReferencesOf: aString
	ReferencesBrowser search: aString
!

selectCategory: aCategory
	self cancelChanges ifTrue: [
	selectedPackage := aCategory.
	selectedClass := selectedProtocol := selectedMethod := nil.
	self resetClassesList.
	self
		updateCategoriesList;
		updateClassesList;
		updateProtocolsList;
		updateMethodsList;
		updateSourceAndButtons ]
!

selectClass: aClass
	self cancelChanges ifTrue: [
	selectedClass := aClass.
	selectedProtocol := selectedMethod := nil.
	self
		updateClassesList;
		updateProtocolsList;
		updateMethodsList;
		updateSourceAndButtons ]
!

selectMethod: aMethod
	self cancelChanges ifTrue: [
	selectedMethod := aMethod.
	self
		updateProtocolsList;
		updateMethodsList;
		updateSourceAndButtons ]
!

selectProtocol: aString
	self cancelChanges ifTrue: [
	selectedProtocol := aString.
	selectedMethod := nil.
	self
		updateProtocolsList;
		updateMethodsList;
		updateSourceAndButtons ]
!

selectTab: aString
	self cancelChanges ifTrue: [
	selectedTab := aString.
	self selectProtocol: nil.
	self updateTabsList ]
!

setMethodProtocol: aString
	| klass |
	klass := self selectedClassOrMetaClass.
	self cancelChanges ifTrue: [ selectedMethod methodClass = klass
		ifFalse: [ Terminal alert: 'Method is from trait composition.' ]
		ifTrue: [ (self protocols includes: aString)
			ifFalse: [ self addNewProtocol ]
			ifTrue: [
				selectedMethod protocol: aString.
				klass compile: selectedMethod source protocol: aString.
				selectedProtocol := aString.
				self
					updateProtocolsList;
					updateMethodsList;
					updateSourceAndButtons ]]]
!

showClassButtons
	classButtons asJQuery show
!

showMethodButtons
	methodButtons asJQuery show
! !

!Browser methodsFor: 'initialization'!

initialize
	super initialize.
	selectedTab := #instance.
	selectedPackage := self packages first.
	unsavedChanges := false
! !

!Browser methodsFor: 'rendering'!

renderBottomPanelOn: html
	html div
	class: 'amber_sourceCode';
	with: [
		sourceArea := SourceArea new.
		sourceArea renderOn: html.
			sourceArea onKeyDown: [ :e |
				self handleSourceAreaKeyDown: e ].
		sourceArea onKeyUp: [ self updateStatus ]]
!

renderBoxOn: html
	self
	renderTopPanelOn: html;
	renderTabsOn: html;
	renderBottomPanelOn: html
!

renderButtonsOn: html
	saveButton := html button.
	saveButton
	with: 'Save';
	onClick: [ self compile ].
	methodButtons := html span.
	classButtons := html span.
	html div
	class: 'right';
	with: [
		html button
			with: 'DoIt';
			onClick: [ sourceArea doIt ].
		html button
			with: 'PrintIt';
			onClick: [ sourceArea printIt ].
		html button with: 'InspectIt';
			onClick: [ sourceArea inspectIt ]].
	self updateSourceAndButtons
!

renderTabsOn: html
	tabsList := html ul class: 'amber_tabs amber_browser'.
	self updateTabsList.
!

renderTopPanelOn: html
	html div
		class: 'top';
		with: [
			packagesList := html ul class: 'amber_column browser packages'.
				html div class: 'amber_packagesButtons'; with: [
				html button
					title: 'Commit classes in this package to disk';
					onClick: [ self commitPackage ];
					with: 'Commit'.
					html button
					title: 'Rename package';
					onClick: [ self renamePackage ];
					with: 'Rename'.
					html button
					title: 'Remove this package from the system';
					onClick: [ self removePackage ];
					with: 'Remove' ].
			classesList := ClassesList on: self.
			classesList renderOn: html.
			protocolsList := html ul class: 'amber_column browser protocols'.
			methodsList := html ul class: 'amber_column browser methods'.
			self
				updateCategoriesList;
				updateClassesList;
				updateProtocolsList;
				updateMethodsList.
			html div class: 'amber_clear' ]
! !

!Browser methodsFor: 'testing'!

canBeClosed
	^ true
! !

!Browser methodsFor: 'updating'!

resetClassesList
	classesList resetNodes
!

updateCategoriesList
	packagesList contents: [ :html |
	self packages do: [ :each || li label |
		label := each ifEmpty: [ 'Unclassified' ].
		li := html li.
		selectedPackage = each ifTrue: [
		li class: 'selected' ].
		li
		with: label;
		onClick: [ self selectCategory: each ]] ]
!

updateClassesList
	TabManager current update.
	classesList updateNodes
!

updateMethodsList
	methodsList contents: [ :html |
	self methods do: [ :each || li |
		li := html li.
		selectedMethod = each ifTrue: [
		li class: 'selected' ].
		li
		with: each selector;
		with: (each methodClass = self selectedClassOrMetaClass ifTrue: [''] ifFalse: [ ' (', each methodClass name, ')' ]);
		onClick: [ self selectMethod: each ]] ]
!

updateProtocolsList
	protocolsList contents: [ :html |
	self protocols do: [ :each || li |
		li := html li.
		selectedProtocol = each ifTrue: [
		li class: 'selected' ].
		li
		with: each;
		onClick: [ self selectProtocol: each ]] ]
!

updateSourceAndButtons
	| currentProtocol |

	self disableSaveButton.
	classButtons contents: [ :html |
		html button
			title: 'Create a new class';
			onClick: [ self addNewClass ];
			with: 'New class'.
		html button
			with: 'Rename class';
			onClick: [ self renameClass ].
		html button
			with: 'Copy class';
			onClick: [ self copyClass ].
		html button
			with: 'Remove class';
			onClick: [ self removeClass ].
		html button
			with: 'References';
			onClick: [ self searchClassReferences ]].
	methodButtons contents: [ :html | | protocolSelect referencesSelect |
		html button
			with: 'Remove method';
			onClick: [ self removeMethod ].
		protocolSelect := html select.
				protocolSelect
			onChange: [ self setMethodProtocol: protocolSelect asJQuery val ];
			with: [
				html option
					with: 'Method protocol';
					at: 'disabled' put: 'disabled'.
				html option
					class: 'important';
					with: 'New...'.
				currentProtocol := selectedProtocol.
				(currentProtocol isNil and: [ selectedMethod notNil ])
					ifTrue: [ currentProtocol := selectedMethod category ].
				self protocols do: [ :each | | option |
					option := html option with: each.
					currentProtocol = each ifTrue: [ option at: 'selected' put: 'selected' ] ] ].
		selectedMethod isNil ifFalse: [
			referencesSelect := html select.
						referencesSelect
				onChange: [ self searchReferencesOf: referencesSelect asJQuery val ];
				with: [ |option|
					html option
						with: 'References';
						at: 'disabled' put: 'disabled';
						at: 'selected' put: 'selected'.
					html option
						class: 'important';
						with: selectedMethod selector.
					selectedMethod messageSends sorted do: [ :each |
						html option with: each ]] ]].
	selectedMethod isNil
		ifTrue: [
			self hideMethodButtons.
				(selectedClass isNil or: [ selectedProtocol notNil ])
					ifTrue: [ self hideClassButtons ]
					ifFalse: [ self showClassButtons ]]
		ifFalse: [
			self hideClassButtons.
			self showMethodButtons ].
	sourceArea val: self source
!

updateStatus
	sourceArea val = self source
		ifTrue: [
			saveButton ifNotNil: [
				saveButton at: 'disabled' put: true ].
				unsavedChanges := false ]
		ifFalse: [
			saveButton ifNotNil: [
				saveButton removeAt: 'disabled' ].
			unsavedChanges := true ]
!

updateTabsList
	tabsList contents: [ :html || li |
	li := html li.
	selectedTab = #instance ifTrue: [ li class: 'selected' ].
	li
		with: [
		html span class: 'ltab'.
		html span class: 'mtab'; with: 'Instance'.
		html span class: 'rtab' ];
		onClick: [ self selectTab: #instance ].
	li := html li.
	selectedTab = #class ifTrue: [ li class: 'selected' ].
	li
		with: [
		html span class: 'ltab'.
		html span class: 'mtab'; with: 'Class'.
		html span class: 'rtab' ];
		onClick: [ self selectTab: #class ].
	li := html li.
	selectedTab = #comment ifTrue: [ li class: 'selected' ].
	li
		with: [
		html span class: 'ltab'.
		html span class: 'mtab'; with: 'Comment'.
		html span class: 'rtab' ];
		onClick: [ self selectTab: #comment ]]
! !

!Browser class methodsFor: 'convenience'!

open
	self new open
!

openOn: aClass
	^ self new
	open;
	selectCategory: aClass category;
	selectClass: aClass
! !

TabWidget subclass: #Debugger
	instanceVariableNames: 'error selectedContext sourceArea ul ul2 inspector saveButton unsavedChanges selectedVariable selectedVariableName inspectButton'
	package: 'IDE'!

!Debugger methodsFor: 'accessing'!

allVariables
	| all |
	all := Dictionary new.

	self receiver class allInstanceVariableNames do: [ :each |
		all at: each put: (self receiver instVarAt: each) ].
	
	selectedContext locals keysAndValuesDo: [ :key :value |
		all at: key put: value ].
	
	^ all
!

error
	^ error
!

error: anError
	error := anError
!

label
	^ '[ Debugger ]'
!

method
	^ selectedContext method
!

receiver
	^ selectedContext receiver
!

source
	^ self method
		ifNil: [ 'Method doesn''t exist!!' ]
		ifNotNil: [ self method source ]
! !

!Debugger methodsFor: 'actions'!

inspectSelectedVariable
	selectedVariable inspect
!

proceed
	self close.
	selectedContext receiver perform: selectedContext selector withArguments: selectedContext locals
!

save
	| protocol |
	protocol := (selectedContext receiver class methodDictionary at: selectedContext selector) category.
	selectedContext receiver class compile: sourceArea val protocol: protocol.
	self updateStatus
!

selectContext: aContext
	selectedContext := aContext.
	selectedVariable := nil.
	selectedVariableName := nil.
	self
		updateContextsList;
		updateSourceArea;
		updateInspector;
		updateVariablesList;
		updateStatus
!

selectVariable: anObject named: aString
	
	selectedVariable := anObject.
	selectedVariableName := aString.
	inspector contents: [ :html | html with: anObject printString ].
	self updateVariablesList
! !

!Debugger methodsFor: 'initialization'!

initialize
	super initialize.
	unsavedChanges = false
! !

!Debugger methodsFor: 'rendering'!

renderBottomPanelOn: html
	html div
		class: 'amber_sourceCode debugger';
		with: [
			sourceArea := SourceArea new.
			sourceArea renderOn: html ].
	ul2 := html ul class: 'amber_column debugger variables'.
	inspector := html div class: 'amber_column debugger inspector'.
	sourceArea
		onKeyUp: [ self updateStatus ]
!

renderBoxOn: html
	self
		renderTopPanelOn: html;
		renderBottomPanelOn: html
!

renderButtonsOn: html
	saveButton := html button
		with: 'Save';
		onClick: [ self save ].
	html button
		with: 'DoIt';
		onClick: [ sourceArea doIt ].
	html button
		with: 'PrintIt';
		onClick: [ sourceArea printIt ].
	html button
		with: 'InspectIt';
		onClick: [ sourceArea inspectIt ].
	html button
		with: 'Proceed';
		onClick: [ self proceed ].
	html button
		with: 'Abandon';
		onClick: [ self close ].
	inspectButton := html button
		class: 'amber_button debugger inspect';
		with: 'Inspect';
		onClick: [ self inspectSelectedVariable ].
	self
		updateSourceArea;
		updateStatus;
		updateVariablesList;
		updateInspector
!

renderContext: aContext on: html
	| li context |
	context := aContext.
	
	[ context notNil ] whileTrue: [
		li := html li.
		selectedContext = context ifTrue: [ li class: 'selected' ].
		li
			with: context asString;
			onClick: (context in: [:ctx | [ self selectContext: ctx ]]).
		context := context outerContext ]
!

renderTopPanelOn: html
	selectedContext := self error context.
	html div
		class: 'top';
		with: [
			html div
				class: 'label';
				with: self error messageText.
			ul := html ul
				class: 'amber_column debugger contexts';
				with: [ self renderContext: self error context on: html ]]
! !

!Debugger methodsFor: 'testing'!

canBeClosed
	^ true
! !

!Debugger methodsFor: 'updating'!

updateContextsList
	ul contents: [ :html |
		self renderContext: self error context on: html ]
!

updateInspector
	inspector contents: [ :html | ]
!

updateSourceArea
	sourceArea val: self source
!

updateStatus
	sourceArea val = self source
		ifTrue: [
			saveButton ifNotNil: [
				saveButton at: 'disabled' put: true ].
			unsavedChanges := false ]
		ifFalse: [
			saveButton ifNotNil: [
				saveButton removeAt: 'disabled' ].
			unsavedChanges := true ]
!

updateVariablesList
	ul2 contents: [ :html | | li |
		li := html li
			with: 'self';
			onClick: [ self selectVariable: self receiver named: 'self' ].
				selectedVariableName = 'self' ifTrue: [ li class: 'selected' ].
		
		self allVariables keysAndValuesDo: [ :key :value |
						li := html li
							with: key;
							onClick: [ self selectVariable: value named: key ].
						selectedVariableName = key ifTrue: [
							li class: 'selected' ] ] ].
							
	selectedVariable
		ifNil: [ inspectButton at: 'disabled' put: true ]
		ifNotNil: [ inspectButton removeAt: 'disabled' ]
! !

TabWidget subclass: #IDEInspector
	instanceVariableNames: 'label variables object selectedVariable variablesList valueTextarea diveButton sourceArea'
	package: 'IDE'!

!IDEInspector methodsFor: 'accessing'!

label
	^ label ifNil: [ 'Inspector (nil)' ]
!

selectedVariable
	^ selectedVariable
!

selectedVariable: aString
	selectedVariable := aString
!

setLabel: aString
	label := aString
!

setVariables: aCollection
	variables := aCollection
!

sourceArea
	^ sourceArea
!

variables
	^ variables
! !

!IDEInspector methodsFor: 'actions'!

dive
	(self variables at: self selectedVariable) inspect
!

inspect: anObject
	object := anObject.
	variables := #().
	object inspectOn: self
!

refresh
	self
		inspect: object;
		updateVariablesList;
		updateValueTextarea
! !

!IDEInspector methodsFor: 'rendering'!

renderBottomPanelOn: html
	html div
	class: 'amber_sourceCode';
	with: [
		sourceArea := SourceArea new
		receiver: object;
		onDoIt: [ self refresh ];
		yourself.
			sourceArea renderOn: html ]
!

renderBoxOn: html
	self
		renderTopPanelOn: html;
		renderBottomPanelOn: html
!

renderButtonsOn: html
	html button
		with: 'DoIt';
		onClick: [ self sourceArea doIt ].
	html button
		with: 'PrintIt';
		onClick: [ self sourceArea printIt ].
	html button
		with: 'InspectIt';
		onClick: [ self sourceArea inspectIt ].
	self updateButtons
!

renderTopPanelOn: html
	html div
		class: 'top';
		with: [
			variablesList := html ul class: 'amber_column variables'.
			valueTextarea := html textarea class: 'amber_column value'; at: 'readonly' put: 'readonly'; yourself.
			html div class: 'amber_tabs inspector'; with: [
				html button
					class: 'amber_button inspector refresh';
					with: 'Refresh';
					onClick: [ self refresh ].
				diveButton := html button
					class: 'amber_button inspector dive';
					with: 'Dive';
					onClick: [ self dive ]].
			html div class: 'amber_clear' ].
	self
		updateVariablesList;
		updateValueTextarea.
! !

!IDEInspector methodsFor: 'testing'!

canBeClosed
	^ true
! !

!IDEInspector methodsFor: 'updating'!

selectVariable: aString
	self selectedVariable: aString.
	self
		updateVariablesList;
		updateValueTextarea;
		updateButtons
!

updateButtons
	(self selectedVariable notNil and: [ (self variables at: self selectedVariable) notNil ])
		ifFalse: [ diveButton at: 'disabled' put: true ]
		ifTrue: [ diveButton removeAt: 'disabled' ]
!

updateValueTextarea
	valueTextarea asJQuery val: (self selectedVariable isNil
		ifTrue: [ '' ]
		ifFalse: [ (self variables at: self selectedVariable) printString ])
!

updateVariablesList
	variablesList contents: [ :html |
		self variables keysDo: [ :each || li |
			li := html li.
			li
				with: each;
				onClick: [ self selectVariable: each ].
			self selectedVariable = each ifTrue: [
				li class: 'selected' ]] ]
! !

!IDEInspector class methodsFor: 'instance creation'!

inspect: anObject
	^ self new
		inspect: anObject;
		open;
		yourself
!

on: anObject
	^ self new
		inspect: anObject;
		yourself
! !

TabWidget subclass: #IDETranscript
	instanceVariableNames: 'textarea'
	package: 'IDE'!

!IDETranscript methodsFor: 'accessing'!

label
	^ 'Transcript'
! !

!IDETranscript methodsFor: 'actions'!

clear
	textarea asJQuery val: ''
!

cr
	textarea asJQuery val: textarea asJQuery val, String cr.
!

open
	TabManager current
	open;
	selectTab: self
!

show: anObject
	textarea ifNil: [ self open ].
	textarea asJQuery val: textarea asJQuery val, anObject asString.
! !

!IDETranscript methodsFor: 'rendering'!

renderBoxOn: html
	textarea := html textarea.
	textarea
	class: 'amber_transcript';
	at: 'spellcheck' put: 'false'
!

renderButtonsOn: html
	html button
	with: 'Clear transcript';
	onClick: [ self clear ]
! !

IDETranscript class instanceVariableNames: 'current'!

!IDETranscript class methodsFor: 'initialization'!

initialize
	Transcript register: self current
! !

!IDETranscript class methodsFor: 'instance creation'!

current
	^ current ifNil: [ current := super new ]
!

new
	self shouldNotImplement
!

open
	TabManager current
		open;
		selectTab: self current
! !

TabWidget subclass: #ProgressBar
	instanceVariableNames: 'percent progressDiv div'
	package: 'IDE'!

!ProgressBar methodsFor: 'accessing'!

percent
	^ percent ifNil: [ 0 ]
!

percent: aNumber
	percent := aNumber
! !

!ProgressBar methodsFor: 'rendering'!

renderOn: html
	div := html div
		class: 'progress_bar';
		yourself.
	self renderProgressBar
!

renderProgressBar
	div contents: [ :html |
		html div
			class: 'progress';
			style: 'width:', self percent asString, '%' ]
! !

!ProgressBar methodsFor: 'updating'!

updatePercent: aNumber
	self percent: aNumber.
	self renderProgressBar
! !

TabWidget subclass: #ReferencesBrowser
	instanceVariableNames: 'implementors senders implementorsList input timer selector sendersList referencedClasses referencedClassesList matches matchesList'
	package: 'IDE'!

!ReferencesBrowser methodsFor: 'accessing'!

classesAndMetaclasses
	^ Smalltalk classes, (Smalltalk classes collect: [ :each | each theMetaClass ]) copyWithout: nil
!

implementors
	^ implementors ifNil: [ implementors := Array new ]
!

label
	^ '[ References ]'
!

matches
	^ matches ifNil: [ matches := Array new ]
!

referencedClasses
	^ referencedClasses ifNil: [ referencedClasses := Array new ]
!

selector
	^ selector
!

senders
	^ senders ifNil: [ senders := Array new ]
! !

!ReferencesBrowser methodsFor: 'actions'!

openBrowserOn: aMethod
	| browser |
	browser := Browser openOn: (aMethod methodClass isMetaclass
		ifTrue: [ aMethod methodClass instanceClass ] ifFalse: [ aMethod methodClass ]).
	aMethod methodClass isMetaclass ifTrue: [ browser selectTab: #class ].
	browser
		selectProtocol: aMethod category;
		selectMethod: aMethod
!

search: aString
	self
		searchReferencesFor: aString;
		updateImplementorsList;
		updateSendersList;
		updateReferencedClassesList;
		updateMatchesList
!

searchMethodSource
	| regex |
	regex := selector allButFirst.
	self classesAndMetaclasses do: [ :each |
		each methodDictionary valuesDo: [ :value |
			(value source match: regex) ifTrue: [
				self matches add: value ]] ]
!

searchReferencedClasses
	self classesAndMetaclasses do: [ :each |
		each methodDictionary valuesDo: [ :value |
			(value referencedClasses includes: selector) ifTrue: [
				self referencedClasses add: value ]] ]
!

searchReferencesFor: aString
	selector := aString.
	implementors := Array new.
	senders := Array new.
	referencedClasses := Array new.
	matches := Array new.
	self searchMethodSource.
	(selector match: '^[A-Z]')
		ifFalse: [ self searchSelectorReferences ]
		ifTrue: [ self searchReferencedClasses ]
!

searchSelectorReferences
	self classesAndMetaclasses do: [ :each |
		each methodDictionary keysAndValuesDo: [ :key :value |
			key = selector ifTrue: [ self implementors add: value ].
			(value messageSends includes: selector) ifTrue: [
				self senders add: value ]] ]
! !

!ReferencesBrowser methodsFor: 'initialization'!

initialize
	super initialize.
	selector := ''
! !

!ReferencesBrowser methodsFor: 'private'!

setInputEvents
	input
		onKeyUp: [ timer := [ self search: input asJQuery val ] valueWithTimeout: 100 ];
		onKeyDown: [ timer ifNotNil: [ timer clearTimeout ]]
! !

!ReferencesBrowser methodsFor: 'rendering'!

renderBoxOn: html
	self
		renderInputOn: html;
		renderImplementorsOn: html;
		renderSendersOn: html;
		renderReferencedClassesOn: html;
		renderMatchesOn: html
!

renderImplementorsOn: html
	implementorsList := html ul class: 'amber_column implementors'.
	self updateImplementorsList
!

renderInputOn: html
	input := html input
		class: 'implementors';
		yourself.
	input asJQuery val: selector.
	self setInputEvents
!

renderMatchesOn: html
	matchesList := html ul class: 'amber_column matches'.
	self updateMatchesList
!

renderReferencedClassesOn: html
	referencedClassesList := html ul class: 'amber_column referenced_classes'.
	self updateReferencedClassesList
!

renderSendersOn: html
	sendersList := html ul class: 'amber_column senders'.
	self updateSendersList
! !

!ReferencesBrowser methodsFor: 'testing'!

canBeClosed
	^ true
! !

!ReferencesBrowser methodsFor: 'updating'!

updateImplementorsList
	implementorsList contents: [ :html |
	html li
		class: 'column_label';
		with: 'Implementors (', self implementors size asString, ')';
		style: 'font-weight: bold'.
	self implementors do: [ :each || li |
		li := html li.
		li
		with: (each methodClass asString, ' >> ', self selector);
		onClick: [ self openBrowserOn: each ]] ]
!

updateMatchesList
	matchesList contents: [ :html |
	html li
		class: 'column_label';
		with: 'Regex matches (', self matches size asString, ')';
		style: 'font-weight: bold'.
	self matches do: [ :each || li |
		li := html li.
		li
		with: (each methodClass asString, ' >> ', each selector);
		onClick: [ self openBrowserOn: each ]] ]
!

updateReferencedClassesList
	referencedClassesList contents: [ :html |
	html li
		class: 'column_label';
		with: 'Class references (', self referencedClasses size asString, ')';
		style: 'font-weight: bold'.
	self referencedClasses do: [ :each |
		html li
			with: (each methodClass asString, ' >> ', each selector);
			onClick: [ self openBrowserOn: each ]] ]
!

updateSendersList
	sendersList contents: [ :html |
	html li
		class: 'column_label';
		with: 'Senders (', self senders size asString, ')';
		style: 'font-weight: bold'.
	self senders do: [ :each |
		html li
			with: (each methodClass asString, ' >> ', each selector);
			onClick: [ self openBrowserOn: each ]] ]
! !

!ReferencesBrowser class methodsFor: 'instance creation'!

search: aString
	^ self new
		searchReferencesFor: aString;
		open
! !

TabWidget subclass: #TestRunner
	instanceVariableNames: 'selectedCategories packagesList selectedClasses classesList selectedMethods progressBar methodsList result statusDiv'
	package: 'IDE'!

!TestRunner methodsFor: 'accessing'!

allClasses
	^ TestCase allSubclasses select: [ :each | each isAbstract not ]
!

classes
	^ (self allClasses
	select: [ :each | self selectedCategories includes: each category ])
	sort: [ :a :b | a name > b name ]
!

label
	^ 'SUnit'
!

packages
	| packages |
	packages := Array new.
	self allClasses do: [ :each |
	(packages includes: each category) ifFalse: [
		packages add: each category ]].
	^ packages sort
!

progressBar
	^ progressBar ifNil: [ progressBar := ProgressBar new ]
!

result
	^ result
!

selectedCategories
	^ selectedCategories ifNil: [ selectedCategories := Array new ]
!

selectedClasses
	^ selectedClasses ifNil: [ selectedClasses := Array new ]
!

statusInfo
	^ self printTotal, self printPasses, self printErrors, self printFailures
!

testCases
	| testCases |
	testCases := #().
	(self selectedClasses
		select: [ :each | self selectedCategories includes: each category ])
		do: [ :each | testCases addAll: each buildSuite ].
	^ testCases
! !

!TestRunner methodsFor: 'actions'!

performFailure: aTestCase
	aTestCase runCase
!

run: aCollection
| worker |
	worker := TestSuiteRunner on: aCollection.
	result := worker result.
	worker announcer on: ResultAnnouncement do: [ :ann |
		ann result == result ifTrue: [
			self progressBar updatePercent: result runs / result total * 100.
			self updateStatusDiv.
			self updateMethodsList
		]
	].
	worker run
!

selectAllCategories
	self packages do: [ :each |
		(selectedCategories includes: each) ifFalse: [
			self selectedCategories add: each ]].
	self
		updateCategoriesList;
		updateClassesList
!

selectAllClasses
	self classes do: [ :each |
		(selectedClasses includes: each) ifFalse: [
			self selectedClasses add: each ]].
	self
		updateCategoriesList;
		updateClassesList
!

toggleCategory: aCategory
	(self isSelectedCategory: aCategory)
		ifFalse: [ selectedCategories add: aCategory ]
		ifTrue: [ selectedCategories remove: aCategory ].
	self
		updateCategoriesList;
		updateClassesList
!

toggleClass: aClass
	(self isSelectedClass: aClass)
		ifFalse: [ selectedClasses add: aClass ]
		ifTrue: [ selectedClasses remove: aClass ].
	self
		updateClassesList
! !

!TestRunner methodsFor: 'initialization'!

initialize
	super initialize.
	result := TestResult new
! !

!TestRunner methodsFor: 'printing'!

printErrors
	^ self result errors size asString , ' errors, '
!

printFailures
	^ self result failures size asString, ' failures'
!

printPasses
	^ (self result runs - self result errors size - self result failures size) asString , ' passes, '
!

printTotal
	^ self result total asString, ' runs, '
! !

!TestRunner methodsFor: 'rendering'!

renderBoxOn: html
	self
	renderCategoriesOn: html;
	renderClassesOn: html;
	renderResultsOn: html
!

renderButtonsOn: html
	html button
	with: 'Run selected';
	onClick: [ self run: self testCases ]
!

renderCategoriesOn: html
	packagesList := html ul class: 'amber_column sunit packages'.
	self updateCategoriesList
!

renderClassesOn: html
	classesList := html ul class: 'amber_column sunit classes'.
	self updateClassesList
!

renderErrorsOn: html
	self result errors do: [ :each |
		html li
			class: 'errors';
			with: each class name, ' >> ', each selector;
						onClick: [ self performFailure: each ]]
!

renderFailuresOn: html
	self result failures do: [ :each |
		html li
			class: 'failures';
			with: each class name, ' >> ', each selector;
						onClick: [ self performFailure: each ]]
!

renderResultsOn: html
	statusDiv := html div.
	html with: self progressBar.
	methodsList := html ul class: 'amber_column sunit results'.
	self updateMethodsList.
	self updateStatusDiv
! !

!TestRunner methodsFor: 'testing'!

isSelectedCategory: aCategory
	^ (self selectedCategories includes: aCategory)
!

isSelectedClass: aClass
	^ (self selectedClasses includes: aClass)
! !

!TestRunner methodsFor: 'updating'!

updateCategoriesList
	packagesList contents: [ :html |
		html li
		class: 'all';
		with: 'All';
		onClick: [ self selectAllCategories ].
	self packages do: [ :each || li |
		li := html li.
		(self selectedCategories includes: each) ifTrue: [
		li class: 'selected' ].
		li
		with: each;
		onClick: [ self toggleCategory: each ]] ]
!

updateClassesList
	classesList contents: [ :html |
	self selectedCategories ifNotEmpty: [
		html li
			class: 'all';
			with: 'All';
			onClick: [ self selectAllClasses ]].
	self classes do: [ :each || li |
		li := html li.
		(self selectedClasses includes: each) ifTrue: [
			li class: 'selected' ].
		li
			with: each name;
			onClick: [ self toggleClass: each ]] ]
!

updateMethodsList
	methodsList contents: [ :html |
		self renderErrorsOn: html.
				self renderFailuresOn: html ]
!

updateStatusDiv
	statusDiv class: 'sunit status ', result status.
	statusDiv contents: [ :html |
		html span with: self statusInfo ]
! !

TabWidget subclass: #Workspace
	instanceVariableNames: 'sourceArea'
	package: 'IDE'!

!Workspace methodsFor: 'accessing'!

label
	^ 'Workspace'
! !

!Workspace methodsFor: 'actions'!

clearWorkspace
	sourceArea clear
!

doIt
	sourceArea doIt
!

fileIn
	sourceArea fileIn
!

inspectIt
	sourceArea inspectIt
!

printIt
	sourceArea printIt
!

show
	super show.
	sourceArea focus.
! !

!Workspace methodsFor: 'rendering'!

renderBoxOn: html
	sourceArea := SourceArea new.
	sourceArea renderOn: html
!

renderButtonsOn: html
	html button
	with: 'DoIt';
	title: 'ctrl+d';
	onClick: [ self doIt ].
	html button
	with: 'PrintIt';
	title: 'ctrl+p';
	onClick: [ self printIt ].
	html button
	with: 'InspectIt';
	title: 'ctrl+i';
	onClick: [ self inspectIt ].
	html button
	with: 'FileIn';
	title: 'ctrl+f';
	onClick: [ self fileIn ].
	html button
	with: 'Clear workspace';
	onClick: [ self clearWorkspace ]
! !