amber/st/ide.st

Widget subclass: #TabManager
	instanceVariableNames: 'selectedTab tabs opened'
	category: 'IDE'!

TabManager class instanceVariableNames: 'current'!

!TabManager class methodsFor: 'instance creation'!

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

new
    self shouldNotImplement
! !

!TabManager methodsFor: 'initialization'!

initialize
    super initialize.
    opened := true.
    'body' asJQuery 
	append: self;
	append: [:html | html div id: 'jtalk'];
	addClass: 'jtalkBody'.
    self 
	addTab: Transcript current;
	addTab: Workspace new.
    self selectTab: self tabs last.
    self 
	onResize: [self updateBodyMargin; updatePosition];
	onWindowResize: [self updatePosition]
! !

!TabManager methodsFor: 'accessing'!

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

!TabManager methodsFor: 'adding/Removing'!

addTab: aWidget
    self tabs add: aWidget.
    '#jtalk' asJQuery append: aWidget.
    aWidget root asJQuery hide
!

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

!TabManager methodsFor: 'actions'!

updateBodyMargin
    self setBodyMargin: '#jtalk' asJQuery height + 27
!

updatePosition
    {'jQuery(''#jtalk'').css(''top'', '''''').css(''bottom'', ''27px'');'}
!

removeBodyMargin
    self setBodyMargin: 0
!

setBodyMargin: anInteger
    '.jtalkBody' asJQuery cssAt: 'margin-bottom' put: anInteger asString, 'px'
!

onResize: aBlock
    {'jQuery(''#jtalk'').resizable({
	handles: ''n'', 
	resize: aBlock,
	minHeight: 230
});'}
!

onWindowResize: aBlock
    {'jQuery(window).resize(aBlock)'}
!

open
    opened ifFalse: [
	self root asJQuery show.
	'body' asJQuery addClass: 'jtalkBody'.
	'#jtalk' asJQuery show.
	self updateBodyMargin.
	selectedTab root asJQuery show.
	opened := true]
!

close
    opened ifTrue: [
	self root asJQuery hide.
	'#jtalk' asJQuery hide.
	self removeBodyMargin.
	'body' asJQuery removeClass: 'jtalkBody'.
	opened := false]
!

newBrowserTab
    Browser open
!

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

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

!TabManager methodsFor: 'rendering'!

renderOn: html
    html ul
	id: 'jtalkTabs';
	with: [
	    html li 
		class: 'closeAll';
		with: 'x';
		onClick: [self close].
	    self tabs do: [:each |
		self renderTabFor: each on: html].
	    html li
		class: 'newtab';
		with: ' + ';
		onClick: [self newBrowserTab]]
!

renderTabFor: aWidget on: html
    | li |
    li := html li.
    selectedTab = aWidget ifTrue: [
	li class: 'selected'].
    li with: [
	html span
	    with: aWidget label;
	    onClick: [self selectTab: aWidget].
	aWidget canBeClosed ifTrue: [
	    html span 
		class: 'close';
		with: 'x';
		onClick: [self closeTab: aWidget]]]
! !


Widget subclass: #TabWidget
	instanceVariableNames: ''
	category: 'IDE'!

!TabWidget class methodsFor: 'instance creation'!

open
    ^self new open
! !

!TabWidget methodsFor: 'accessing'!

label
    self subclassResponsibility
! !

!TabWidget methodsFor: 'actions'!

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

!TabWidget methodsFor: 'testing'!

canBeClosed
    ^false
! !

!TabWidget methodsFor: 'rendering'!

renderOn: html
    html root
	class: 'jtalkTool';
	with: [
	    html div
		class: 'jt_box';
		with: [self renderBoxOn: html].
	    html div
		class: 'jt_buttons';
		with: [self renderButtonsOn: html]]
!

renderBoxOn: html
!

renderButtonsOn: html
! !



TabWidget subclass: #Workspace
	instanceVariableNames: 'textarea'
	category: 'IDE'!

!Workspace methodsFor: 'accessing'!

label
    ^'[Workspace]'
!

selection
    ^{'return document.selection'}
!

selectionStart
    ^{'return jQuery(''.jt_workspace'')[0].selectionStart'}
!

selectionEnd
    ^{'return jQuery(''.jt_workspace'')[0].selectionEnd'}
!

selectionStart: anInteger
    {'jQuery(''.jt_workspace'')[0].selectionStart = anInteger'}
!

selectionEnd: anInteger
    {'jQuery(''.jt_workspace'')[0].selectionEnd = anInteger'}
!

currentLine
    | lines startLine endLine|
    lines := textarea asJQuery val tokenize: String cr.
    startLine := endLine := 0.
    lines do: [:each |
	endLine := startLine + each size.
	startLine := endLine + 1.
	endLine >= self selectionStart ifTrue: [
	    self selectionEnd: endLine.
	    ^each]]
! !

!Workspace methodsFor: 'actions'!

handleKeyDown: anEvent
    ^{'if(anEvent.ctrlKey) {
		if(anEvent.keyCode === 68) { //ctrl+p
			self._printIt();
			return false;
		}
		if(anEvent.keyCode === 80) { //ctrl+d
			self._doIt();
			return false;
		}
	}'}
!

clearWorkspace
    textarea asJQuery val: ''
!

doIt
    self printIt
!

printIt
    | selection |
    textarea asJQuery focus.
    self selectionStart = self selectionEnd
	ifTrue: [selection := self currentLine]
	ifFalse: [
	    selection := textarea asJQuery val copyFrom: self selectionStart + 1 to: self selectionEnd + 1].
    self print: (self eval: selection) printString
!

print: aString
    | start |
    start := self selectionEnd.
    textarea asJQuery val: (
	(textarea asJQuery val copyFrom: 1 to: start),
	' ', aString, ' ',
	(textarea asJQuery val copyFrom: start + 1 to: textarea asJQuery val size)).
    self selectionStart: start.
    self selectionEnd: start + aString size + 2
!

eval: aString
    | compiler node |
    compiler := Compiler new.
    node := compiler parseExpression: aString.
    node isParseFailure ifTrue: [
	^self alert: node reason, ', position: ', node position].
    ^compiler loadExpression: aString
! !

!Workspace methodsFor: 'rendering'!

renderBoxOn: html
    textarea := html textarea.
    textarea asJQuery call: 'tabby'.
    textarea onKeyDown: [:e | self handleKeyDown: e].
    textarea 
	class: 'jt_workspace';
	at: 'spellcheck' put: 'false'
!

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: 'Clear workspace';
	onClick: [self clearWorkspace]
! !



TabWidget subclass: #Transcript
	instanceVariableNames: 'textarea'
	category: 'IDE'!

Transcript class instanceVariableNames: 'current'!

!Transcript class methodsFor: 'instance creation'!

open
    self current open
!

new
    self shouldNotImplement
!

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

!Transcript class methodsFor: 'printing'!

show: anObject
    self current show: anObject
!

cr
    self current show: String cr
!

clear
    self current clear
! !


!Transcript methodsFor: 'accessing'!

label
    ^'[Transcript]'
! !

!Transcript methodsFor: 'actions'!

show: anObject
    textarea asJQuery val: textarea asJQuery val, anObject asString.

!

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

clear
    textarea asJQuery val: ''
! !

!Transcript methodsFor: 'rendering'!

renderBoxOn: html
    textarea := html textarea.
    textarea asJQuery call: 'tabby'.
    textarea 
	class: 'jt_transcript';
	at: 'spellcheck' put: 'false'
!

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

TabWidget subclass: #Browser
	instanceVariableNames: 'selectedCategory selectedClass selectedProtocol selectedMethod commitButton categoriesList classesList protocolsList methodsList sourceTextarea tabsList selectedTab saveButton classButtons methodButtons unsavedChanges'
	category: 'IDE'!

!Browser class methodsFor: 'convenience'!

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

open
    self new open
! !

!Browser methodsFor: 'initialization'!

initialize
    super initialize.
    selectedTab := #instance.
    unsavedChanges := false
! !

!Browser methodsFor: 'accessing'!

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

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

classes
    ^(Smalltalk current classes 
	select: [:each | each category = selectedCategory])
	sort: [:a :b | a name > b name]
!

protocols
    | klass protocols |
    protocols := Array new.
    selectedClass ifNotNil: [
	selectedTab = #comment ifTrue: [^#()].
	klass := selectedTab = #instance
	    ifTrue: [selectedClass]
	    ifFalse: [selectedClass class].
	klass methodDictionary isEmpty ifTrue: [
	    protocols add: 'not yet classified'].
	klass methodDictionary do: [:each |
	    (protocols includes: each category) ifFalse: [
		protocols add: each category]]].
    ^protocols sort
!

methods
    | klass |
    selectedTab = #comment ifTrue: [^#()].
    selectedClass ifNotNil: [
	klass := selectedTab = #instance
	    ifTrue: [selectedClass]
	    ifFalse: [selectedClass class]].
    ^(selectedProtocol 
	ifNil: [
	    klass 
		ifNil: [#()] 
		ifNotNil: [klass methodDictionary values]]
	ifNotNil: [
	    klass methodDictionary values select: [:each |
		each category = selectedProtocol]]) sort: [:a :b | a selector > b selector]
!

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

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

dummyMethodSource
    ^'messageSelectorAndArgumentNames
	"comment stating purpose of message"

	| temporary variable names |
	statements'
!

declarationSource
    ^selectedTab = #instance
	ifTrue: [self classDeclarationSource]
	ifFalse: [self metaclassDeclarationSource]
!

classDeclarationSource
    | stream |
    stream := '' writeStream.
    selectedClass ifNotNil: [
	stream 
	    nextPutAll: selectedClass superclass asString;
	    nextPutAll: ' subclass: #';
	    nextPutAll: selectedClass name;
	    nextPutAll: String cr, String tab;
	    nextPutAll: 'instanceVariableNames: '''.
	selectedClass instanceVariableNames 
	    do: [:each | stream nextPutAll: each] 
	    separatedBy: [stream nextPutAll: ' '].
	stream
	    nextPutAll: '''', String cr, String tab;
	    nextPutAll: 'category: ''';
	    nextPutAll: selectedClass category;
	    nextPutAll: ''''].
    ^stream contents
!

metaclassDeclarationSource
    | stream |
    stream := '' writeStream.
    selectedClass ifNotNil: [
	stream 
	    nextPutAll: selectedClass asString;
	    nextPutAll: ' class ';
	    nextPutAll: 'instanceVariableNames: '''.
	selectedClass class instanceVariableNames
	    do: [:each | stream nextPutAll: each]
	    separatedBy: [stream nextPutAll: ' '].
	stream nextPutAll: ''''].
    ^stream contents
!

classCommentSource
    ^selectedClass comment
! !

!Browser methodsFor: 'actions'!

enableSaveButton
    saveButton removeAt: 'disabled'.
    unsavedChanges := true
!

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

hideClassButtons
    classButtons asJQuery hide
!

showClassButtons
    classButtons asJQuery show
!

hideMethodButtons
    methodButtons asJQuery hide
!

showMethodButtons
    methodButtons asJQuery show
!

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

compileClassComment
    selectedClass comment: sourceTextarea asJQuery val
!

compileMethodDefinition
    selectedTab = #instance
	ifTrue: [self compileMethodDefinitionFor: selectedClass]
	ifFalse: [self compileMethodDefinitionFor: selectedClass class]
!

compileMethodDefinitionFor: aClass
    | compiler method source node |
    source := sourceTextarea asJQuery val.
    selectedProtocol ifNil: [selectedProtocol := selectedMethod category].
    compiler := Compiler new.
    node := compiler parse: source.
    node isParseFailure ifTrue: [
	^self alert: 'PARSE ERROR: ', node reason, ', position: ', node position asString].
    compiler currentClass: selectedClass.
    method := compiler eval: (compiler compileNode: node).
    method category: selectedProtocol.
    aClass addCompiledMethod: method.
    self updateMethodsList.
    self selectMethod: method
!

compileDefinition
    | newClass |
    newClass := Compiler new loadExpression: sourceTextarea asJQuery val.
    self 
	updateCategoriesList;
	updateClassesList
!

commitCategory
    selectedCategory ifNotNil: [
	(Ajax url: 'js/', selectedCategory, '.js')
	    at: 'type' put: 'PUT';
	    at: 'data' put: (Exporter new exportCategory: selectedCategory);
	    at: 'error' put: [self alert: 'Commit failed!!'];
	    send]
!



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

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

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

setMethodProtocol: aString
    self cancelChanges ifTrue: [
	(self protocols includes: aString)
	    ifFalse: [self addNewProtocol]
	    ifTrue: [
		selectedMethod category: aString.
		selectedProtocol := aString.
		selectedMethod := selectedMethod.
		self 
		    updateProtocolsList;
		    updateMethodsList;
		    updateSourceAndButtons]]
!

addNewProtocol
    | newProtocol |
    newProtocol := self prompt: 'New method protocol'.
    newProtocol notEmpty ifTrue: [
	selectedMethod category: newProtocol.
	self setMethodProtocol: newProtocol]
!

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

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

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

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

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


!Browser methodsFor: 'rendering'!

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

renderTopPanelOn: html
    html div 
	class: 'top'; 
	with: [
	    categoriesList := html ul class: 'jt_column categories'.
	    commitButton := html button 
		class: 'jt_commit';
		title: 'Commit classes in this category to disk';
		onClick: [self commitCategory];
		with: 'Commit category'.
	    classesList := html ul class: 'jt_column classes'.
	    protocolsList := html ul class: 'jt_column protocols'.
	    methodsList := html ul class: 'jt_column methods'.
	    self
		updateCategoriesList;
		updateClassesList;
		updateProtocolsList;
		updateMethodsList.
	    html div class: 'jt_clear']
!

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

renderBottomPanelOn: html
    html div
	class: 'jt_sourceCode';
	with: [
	    sourceTextarea := html textarea 
		onKeyPress: [self enableSaveButton];
		class: 'source';
		at: 'spellcheck' put: 'false'.
	    sourceTextarea asJQuery call: 'tabby']
!

renderButtonsOn: html
    saveButton := html button.
    saveButton 
	with: 'Save';
	onClick: [self compile].
    methodButtons := html span.
    classButtons := html span.
    self updateSourceAndButtons
! !

!Browser methodsFor: 'updating'!

updateCategoriesList
    categoriesList contents: [:html |
	self categories do: [:each || li |
	    li := html li.
	    selectedCategory = each ifTrue: [
		li class: 'selected'].
	    li
		with: each;
		onClick: [self selectCategory: each]]]
!

updateClassesList
    TabManager current update.
    classesList contents: [:html |
	self classes do: [:each || li |
	    li := html li.
	    selectedClass = each ifTrue: [
		li class: 'selected'].
	    li
		with: each name;
		onClick: [self selectClass: 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]]]
!

updateMethodsList
    methodsList contents: [:html |
	self methods do: [:each || li |
	    li := html li.
	    selectedMethod = each ifTrue: [
		li class: 'selected'].
	    li
		with: each selector;
		onClick: [self selectMethod: each]]]
!

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

updateSourceAndButtons
    self disableSaveButton.
    classButtons contents: [:html |
	html button
	    with: 'Remove class';
	    onClick: [self removeClass]].
    methodButtons contents: [:html |
	html button
	    with: 'Remove method';
	    onClick: [self removeMethod].
	html select 
	    onChange: [:s | self setMethodProtocol: s val];
	    with: [
		html option
		    with: 'Method protocol';
		    at: 'disabled' put: 'disabled'.
		html option
		    class: 'important';
		    with: 'New...'.
		self protocols do: [:each |
		    html option with: each]]].
    selectedMethod 
	ifNil: [
	    self hideMethodButtons.
	    selectedClass 
		ifNil: [self hideClassButtons]
	    ifNotNil: [self showClassButtons]]
	ifNotNil: [
	    self hideClassButtons.
	    self showMethodButtons].
    sourceTextarea asJQuery val: self source
! !

!Browser methodsFor: 'testing'!

canBeClosed
    ^true
! !