Fixed cr lf confusion, hopefully almost everywhere.

js/IDE.js

@@ -518,13 +518,13 @@ var self=this;
 try{var lines=nil;
 var startLine=nil;
 var endLine=nil;
-lines=smalltalk.send(smalltalk.send(smalltalk.send(self['@textarea'], "_asJQuery", []), "_val", []), "_tokenize_", [smalltalk.send(smalltalk.String, "_cr", [])]);
+lines=smalltalk.send(smalltalk.send(smalltalk.send(self['@textarea'], "_asJQuery", []), "_val", []), "_tokenize_", [smalltalk.send(smalltalk.String, "_lf", [])]);
 startLine=endLine=(0);
 smalltalk.send(lines, "_do_", [(function(each){endLine=smalltalk.send(startLine, "__plus", [smalltalk.send(each, "_size", [])]);startLine=smalltalk.send(endLine, "__plus", [(1)]);return smalltalk.send(smalltalk.send(endLine, "__gt_eq", [smalltalk.send(self, "_selectionStart", [])]), "_ifTrue_", [(function(){smalltalk.send(self, "_selectionEnd_", [endLine]);return (function(){throw({name: 'stReturn', selector: '_currentLine', fn: function(){return each}})})();})]);})]);
 return self;
 } catch(e) {if(e.name === 'stReturn' && e.selector === '_currentLine'){return e.fn()} throw(e)}},
-source: unescape('currentLine%0A%20%20%20%20%7C%20lines%20startLine%20endLine%7C%0A%20%20%20%20lines%20%3A%3D%20textarea%20asJQuery%20val%20tokenize%3A%20String%20cr.%0A%20%20%20%20startLine%20%3A%3D%20endLine%20%3A%3D%200.%0A%20%20%20%20lines%20do%3A%20%5B%3Aeach%20%7C%0A%09endLine%20%3A%3D%20startLine%20+%20each%20size.%0A%09startLine%20%3A%3D%20endLine%20+%201.%0A%09endLine%20%3E%3D%20self%20selectionStart%20ifTrue%3A%20%5B%0A%09%20%20%20%20self%20selectionEnd%3A%20endLine.%0A%09%20%20%20%20%5Eeach%5D%5D%0A'),
-messageSends: ["tokenize:", "val", "asJQuery", "cr", "do:", unescape("+"), "size", "ifTrue:", unescape("%3E%3D"), "selectionStart", "selectionEnd:"],
+source: unescape('currentLine%0A%20%20%20%20%7C%20lines%20startLine%20endLine%7C%0A%20%20%20%20lines%20%3A%3D%20textarea%20asJQuery%20val%20tokenize%3A%20String%20lf.%0A%20%20%20%20startLine%20%3A%3D%20endLine%20%3A%3D%200.%0A%20%20%20%20lines%20do%3A%20%5B%3Aeach%20%7C%0A%09endLine%20%3A%3D%20startLine%20+%20each%20size.%0A%09startLine%20%3A%3D%20endLine%20+%201.%0A%09endLine%20%3E%3D%20self%20selectionStart%20ifTrue%3A%20%5B%0A%09%20%20%20%20self%20selectionEnd%3A%20endLine.%0A%09%20%20%20%20%5Eeach%5D%5D%0A'),
+messageSends: ["tokenize:", "val", "asJQuery", "lf", "do:", unescape("+"), "size", "ifTrue:", unescape("%3E%3D"), "selectionStart", "selectionEnd:"],
 referencedClasses: [smalltalk.String]
 }),
 smalltalk.Workspace);
@@ -1061,11 +1061,11 @@ fn: function (){
 var self=this;
 var stream=nil;
 stream=smalltalk.send("", "_writeStream", []);
-smalltalk.send(self['@selectedClass'], "_ifNotNil_", [(function(){(function($rec){smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(smalltalk.send(self['@selectedClass'], "_superclass", []), "_asString", [])]);smalltalk.send($rec, "_nextPutAll_", [unescape("%20subclass%3A%20%23")]);smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(self['@selectedClass'], "_name", [])]);smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(smalltalk.send(smalltalk.String, "_cr", []), "__comma", [smalltalk.send(smalltalk.String, "_tab", [])])]);return smalltalk.send($rec, "_nextPutAll_", [unescape("instanceVariableNames%3A%20%27")]);})(stream);smalltalk.send(smalltalk.send(self['@selectedClass'], "_instanceVariableNames", []), "_do_separatedBy_", [(function(each){return smalltalk.send(stream, "_nextPutAll_", [each]);}), (function(){return smalltalk.send(stream, "_nextPutAll_", [" "]);})]);return (function($rec){smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(smalltalk.send(unescape("%27"), "__comma", [smalltalk.send(smalltalk.String, "_cr", [])]), "__comma", [smalltalk.send(smalltalk.String, "_tab", [])])]);smalltalk.send($rec, "_nextPutAll_", [unescape("category%3A%20%27")]);smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(self['@selectedClass'], "_category", [])]);return smalltalk.send($rec, "_nextPutAll_", [unescape("%27")]);})(stream);})]);
+smalltalk.send(self['@selectedClass'], "_ifNotNil_", [(function(){(function($rec){smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(smalltalk.send(self['@selectedClass'], "_superclass", []), "_asString", [])]);smalltalk.send($rec, "_nextPutAll_", [unescape("%20subclass%3A%20%23")]);smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(self['@selectedClass'], "_name", [])]);smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(smalltalk.send(smalltalk.String, "_lf", []), "__comma", [smalltalk.send(smalltalk.String, "_tab", [])])]);return smalltalk.send($rec, "_nextPutAll_", [unescape("instanceVariableNames%3A%20%27")]);})(stream);smalltalk.send(smalltalk.send(self['@selectedClass'], "_instanceVariableNames", []), "_do_separatedBy_", [(function(each){return smalltalk.send(stream, "_nextPutAll_", [each]);}), (function(){return smalltalk.send(stream, "_nextPutAll_", [" "]);})]);return (function($rec){smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(smalltalk.send(unescape("%27"), "__comma", [smalltalk.send(smalltalk.String, "_lf", [])]), "__comma", [smalltalk.send(smalltalk.String, "_tab", [])])]);smalltalk.send($rec, "_nextPutAll_", [unescape("category%3A%20%27")]);smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(self['@selectedClass'], "_category", [])]);return smalltalk.send($rec, "_nextPutAll_", [unescape("%27")]);})(stream);})]);
 return smalltalk.send(stream, "_contents", []);
 return self;},
-source: unescape('classDeclarationSource%0A%20%20%20%20%7C%20stream%20%7C%0A%20%20%20%20stream%20%3A%3D%20%27%27%20writeStream.%0A%20%20%20%20selectedClass%20ifNotNil%3A%20%5B%0A%09stream%20%0A%09%20%20%20%20nextPutAll%3A%20selectedClass%20superclass%20asString%3B%0A%09%20%20%20%20nextPutAll%3A%20%27%20subclass%3A%20%23%27%3B%0A%09%20%20%20%20nextPutAll%3A%20selectedClass%20name%3B%0A%09%20%20%20%20nextPutAll%3A%20String%20cr%2C%20String%20tab%3B%0A%09%20%20%20%20nextPutAll%3A%20%27instanceVariableNames%3A%20%27%27%27.%0A%09selectedClass%20instanceVariableNames%20%0A%09%20%20%20%20do%3A%20%5B%3Aeach%20%7C%20stream%20nextPutAll%3A%20each%5D%20%0A%09%20%20%20%20separatedBy%3A%20%5Bstream%20nextPutAll%3A%20%27%20%27%5D.%0A%09stream%0A%09%20%20%20%20nextPutAll%3A%20%27%27%27%27%2C%20String%20cr%2C%20String%20tab%3B%0A%09%20%20%20%20nextPutAll%3A%20%27category%3A%20%27%27%27%3B%0A%09%20%20%20%20nextPutAll%3A%20selectedClass%20category%3B%0A%09%20%20%20%20nextPutAll%3A%20%27%27%27%27%5D.%0A%20%20%20%20%5Estream%20contents%0A'),
-messageSends: ["writeStream", "ifNotNil:", "nextPutAll:", "asString", "superclass", "name", unescape("%2C"), "cr", "tab", "do:separatedBy:", "instanceVariableNames", "category", "contents"],
+source: unescape('classDeclarationSource%0A%20%20%20%20%7C%20stream%20%7C%0A%20%20%20%20stream%20%3A%3D%20%27%27%20writeStream.%0A%20%20%20%20selectedClass%20ifNotNil%3A%20%5B%0A%09stream%20%0A%09%20%20%20%20nextPutAll%3A%20selectedClass%20superclass%20asString%3B%0A%09%20%20%20%20nextPutAll%3A%20%27%20subclass%3A%20%23%27%3B%0A%09%20%20%20%20nextPutAll%3A%20selectedClass%20name%3B%0A%09%20%20%20%20nextPutAll%3A%20String%20lf%2C%20String%20tab%3B%0A%09%20%20%20%20nextPutAll%3A%20%27instanceVariableNames%3A%20%27%27%27.%0A%09selectedClass%20instanceVariableNames%20%0A%09%20%20%20%20do%3A%20%5B%3Aeach%20%7C%20stream%20nextPutAll%3A%20each%5D%20%0A%09%20%20%20%20separatedBy%3A%20%5Bstream%20nextPutAll%3A%20%27%20%27%5D.%0A%09stream%0A%09%20%20%20%20nextPutAll%3A%20%27%27%27%27%2C%20String%20lf%2C%20String%20tab%3B%0A%09%20%20%20%20nextPutAll%3A%20%27category%3A%20%27%27%27%3B%0A%09%20%20%20%20nextPutAll%3A%20selectedClass%20category%3B%0A%09%20%20%20%20nextPutAll%3A%20%27%27%27%27%5D.%0A%20%20%20%20%5Estream%20contents%0A'),
+messageSends: ["writeStream", "ifNotNil:", "nextPutAll:", "asString", "superclass", "name", unescape("%2C"), "lf", "tab", "do:separatedBy:", "instanceVariableNames", "category", "contents"],
 referencedClasses: [smalltalk.String]
 }),
 smalltalk.Browser);

js/Kernel.js

@@ -4283,9 +4283,9 @@ selector: 'cr',
 category: 'accessing',
 fn: function (){
 var self=this;
-return '\n';;
+return '\r';;
 return self;},
-source: unescape('cr%0A%09%7B%27return%20%27%27%5Cn%27%27%3B%27%7D'),
+source: unescape('cr%0A%09%7B%27return%20%27%27%5Cr%27%27%3B%27%7D'),
 messageSends: [],
 referencedClasses: []
 }),
@@ -4298,9 +4298,9 @@ selector: 'lf',
 category: 'accessing',
 fn: function (){
 var self=this;
-return '\r';;
+return '\n';;
 return self;},
-source: unescape('lf%0A%09%7B%27return%20%27%27%5Cr%27%27%3B%27%7D%0A'),
+source: unescape('lf%0A%09%7B%27return%20%27%27%5Cn%27%27%3B%27%7D%0A'),
 messageSends: [],
 referencedClasses: []
 }),

st/Canvas.st

@@ -1,188 +1,535 @@
-Object subclass: #CanvasRenderingContext
	instanceVariableNames: ''
	category: 'Canvas'!

!CanvasRenderingContext methodsFor: 'drawing arcs'!

arcTo: aPoint radius: aNumber startAngle: aNumber2 endAngle: aNumber3 anticlockwise: aBoolean
-	{'self.arc(aPoint._x(), aPoint._y(), aNumber, aNumber2, aNumber3, aBoolean)'} 
!

arcTo: aPoint radius: aNumber
-	self arcTo: aPoint radius: aNumber startAngle: 0 endAngle: Number pi * 2 anticlockwise: false
! !

!CanvasRenderingContext methodsFor: 'drawing paths'!

fillStyle: aString
-	{'self.fillStyle = String(aString)'}
!

beginPath
-	{'self.beginPath()'}
!

closePath
-	{'self.closePath()'}
!

fill
-	{'self.fill()'}
!

stroke
-	{'self.stroke()'}
!

moveTo: aPoint
-	{'self.moveTo(aPoint._x(), aPoint._y())'}
!

lineTo: aPoint
-	{'self.lineTo(aPoint._x(), aPoint._y())'}
!

strokeStyle: aString
-	{'self.strokeStyle = String(aString)'}
!

lineWidth: aNumber
-	{'self.lineWidth = aNumber'}
! !

!CanvasRenderingContext methodsFor: 'drawing rectangles'!

fillRectFrom: aPoint to: anotherPoint
-	{'self.fillRect(aPoint._x(), aPoint._y(), anotherPoint._x(), anotherPoint._y())'}
!

strokeRectFrom: aPoint to: anotherPoint
-	{'self.strokeRect(aPoint._x(), aPoint._y(), anotherPoint._x(), anotherPoint._y())'}
!

clearRectFrom: aPoint to: anotherPoint
-	{'self.fillRect(aPoint._x(), aPoint._y(), anotherPoint._x(), anotherPoint._y())'}
! !

!CanvasRenderingContext class methodsFor: 'instance creation'!

tagBrush: aTagBrush
-	{'return aTagBrush._element().getContext(''2d'')'}
! !

Object subclass: #HTMLCanvas
	instanceVariableNames: 'root'
	category: 'Canvas'!

!HTMLCanvas methodsFor: '*JQuery'!

appendToJQuery: aJQuery
+Object subclass: #CanvasRenderingContext
+	instanceVariableNames: ''
+	category: 'Canvas'!
+
+!CanvasRenderingContext methodsFor: 'drawing arcs'!
+
+arcTo: aPoint radius: aNumber startAngle: aNumber2 endAngle: aNumber3 anticlockwise: aBoolean
+	{'self.arc(aPoint._x(), aPoint._y(), aNumber, aNumber2, aNumber3, aBoolean)'} 
+!
+
+arcTo: aPoint radius: aNumber
+	self arcTo: aPoint radius: aNumber startAngle: 0 endAngle: Number pi * 2 anticlockwise: false
+! !
+
+!CanvasRenderingContext methodsFor: 'drawing paths'!
+
+fillStyle: aString
+	{'self.fillStyle = String(aString)'}
+!
+
+beginPath
+	{'self.beginPath()'}
+!
+
+closePath
+	{'self.closePath()'}
+!
+
+fill
+	{'self.fill()'}
+!
+
+stroke
+	{'self.stroke()'}
+!
+
+moveTo: aPoint
+	{'self.moveTo(aPoint._x(), aPoint._y())'}
+!
+
+lineTo: aPoint
+	{'self.lineTo(aPoint._x(), aPoint._y())'}
+!
+
+strokeStyle: aString
+	{'self.strokeStyle = String(aString)'}
+!
+
+lineWidth: aNumber
+	{'self.lineWidth = aNumber'}
+! !
+
+!CanvasRenderingContext methodsFor: 'drawing rectangles'!
+
+fillRectFrom: aPoint to: anotherPoint
+	{'self.fillRect(aPoint._x(), aPoint._y(), anotherPoint._x(), anotherPoint._y())'}
+!
+
+strokeRectFrom: aPoint to: anotherPoint
+	{'self.strokeRect(aPoint._x(), aPoint._y(), anotherPoint._x(), anotherPoint._y())'}
+!
+
+clearRectFrom: aPoint to: anotherPoint
+	{'self.fillRect(aPoint._x(), aPoint._y(), anotherPoint._x(), anotherPoint._y())'}
+! !
+
+!CanvasRenderingContext class methodsFor: 'instance creation'!
+
+tagBrush: aTagBrush
+	{'return aTagBrush._element().getContext(''2d'')'}
+! !
+
+Object subclass: #HTMLCanvas
+	instanceVariableNames: 'root'
+	category: 'Canvas'!
+
+!HTMLCanvas methodsFor: '*JQuery'!
+
+appendToJQuery: aJQuery
     aJQuery appendElement: root element
-
! !

!HTMLCanvas methodsFor: 'accessing'!

root: aTagBrush
+
+! !
+
+!HTMLCanvas methodsFor: 'accessing'!
+
+root: aTagBrush
     root := aTagBrush
-
!

root
+
+!
+
+root
     ^root
-
! !

!HTMLCanvas methodsFor: 'adding'!

with: anObject
+
+! !
+
+!HTMLCanvas methodsFor: 'adding'!
+
+with: anObject
     ^self root with: anObject
-
! !

!HTMLCanvas methodsFor: 'initialization'!

initialize
+
+! !
+
+!HTMLCanvas methodsFor: 'initialization'!
+
+initialize
     super initialize.
     root := TagBrush fromString: 'div' canvas: self
-
! !

!HTMLCanvas methodsFor: 'tags'!

newTag: aString
+
+! !
+
+!HTMLCanvas methodsFor: 'tags'!
+
+newTag: aString
     ^TagBrush fromString: aString canvas: self
-
!

tag: aString
+
+!
+
+tag: aString
     ^root addBrush: (self newTag: aString)
-
!

h1
+
+!
+
+h1
     ^self tag: 'h1'
-
!

h2
+
+!
+
+h2
     ^self tag: 'h2'
-
!

h3
+
+!
+
+h3
     ^self tag: 'h3'
-
!

h4
+
+!
+
+h4
     ^self tag: 'h4'
-
!

h5
+
+!
+
+h5
     ^self tag: 'h5'
-
!

h6
+
+!
+
+h6
     ^self tag: 'h6'
-
!

p
+
+!
+
+p
     ^self tag: 'p'
-
!

div
+
+!
+
+div
     ^self tag: 'div'
-
!

span
+
+!
+
+span
     ^self tag: 'span'
-
!

img
+
+!
+
+img
     ^self tag: 'img'
-
!

ul
+
+!
+
+ul
     ^self tag: 'ul'
-
!

ol
+
+!
+
+ol
     ^self tag: 'ol'
-
!

li
+
+!
+
+li
     ^self tag: 'li'
-
!

table
+
+!
+
+table
     ^self tag: 'table'
-
!

tr
+
+!
+
+tr
     ^self tag: 'tr'
-
!

td 
+
+!
+
+td 
     ^self tag: 'td'
-
!

th
+
+!
+
+th
     ^self tag: 'th'
-
!

form
+
+!
+
+form
     ^self tag: 'form'
-
!

input
+
+!
+
+input
     ^self tag: 'input'
-
!

button
+
+!
+
+button
     ^self tag: 'button'
-
!

select
+
+!
+
+select
     ^self tag: 'select'
-
!

option
+
+!
+
+option
     ^self tag: 'option'
-
!

textarea
+
+!
+
+textarea
     ^self tag: 'textarea'
-
!

a
+
+!
+
+a
     ^self tag: 'a'
-
!

canvas
+
+!
+
+canvas
 	^self tag: 'canvas'
-
! !

Object subclass: #TagBrush
	instanceVariableNames: 'canvas, element'
	category: 'Canvas'!

!TagBrush methodsFor: 'accessing'!

element
+
+! !
+
+Object subclass: #TagBrush
+	instanceVariableNames: 'canvas, element'
+	category: 'Canvas'!
+
+!TagBrush methodsFor: 'accessing'!
+
+element
     ^element
-
! !

!TagBrush methodsFor: 'adding'!

contents: anObject
+
+! !
+
+!TagBrush methodsFor: 'adding'!
+
+contents: anObject
     self asJQuery empty.
     self append: anObject
-
!

addBrush: aTagBrush
+
+!
+
+addBrush: aTagBrush
     self appendChild: aTagBrush element.
     ^aTagBrush
-
!

with: anObject
+
+!
+
+with: anObject
     self append: anObject
-
!

append: anObject
+
+!
+
+append: anObject
     anObject appendToBrush: self
-
!

appendToBrush: aTagBrush
+
+!
+
+appendToBrush: aTagBrush
     aTagBrush addBrush: self
-
!

appendBlock: aBlock
+
+!
+
+appendBlock: aBlock
     | root |
     root := canvas root.
     canvas root: self.
     aBlock value: canvas.
     canvas root: root
-
!

appendChild: anElement
+
+!
+
+appendChild: anElement
     {'self[''@element''].appendChild(anElement)'}
-
!

appendString: aString
+
+!
+
+appendString: aString
     self appendChild: (self createTextNodeFor: aString)
-
! !

!TagBrush methodsFor: 'attributes'!

at: aString put: aValue
+
+! !
+
+!TagBrush methodsFor: 'attributes'!
+
+at: aString put: aValue
     {'self[''@element''].setAttribute(aString, aValue)'}
-
!

removeAt: aString
+
+!
+
+removeAt: aString
     {'self[''@element''].removeAttribute(aString)'}
-
!

class: aString
+
+!
+
+class: aString
     self at: 'class' put: aString
-
!

id: aString
+
+!
+
+id: aString
     self at: 'id' put: aString
-
!

src: aString
+
+!
+
+src: aString
     self  at: 'src' put: aString
-
!

href: aString
+
+!
+
+href: aString
     self at: 'href' put: aString
-
!

title: aString
+
+!
+
+title: aString
     self at: 'title' put: aString
-
!

style: aString
+
+!
+
+style: aString
     self at: 'style' put: aString
-
! !

!TagBrush methodsFor: 'converting'!

asJQuery
+
+! !
+
+!TagBrush methodsFor: 'converting'!
+
+asJQuery
 	{'return smalltalk.JQuery._from_(jQuery(self[''@element'']))'}
-
!

asJQueryDo: aBlock
+
+!
+
+asJQueryDo: aBlock
     aBlock value: self asJQuery
-
! !

!TagBrush methodsFor: 'events'!

onKeyDown: aBlock
+
+! !
+
+!TagBrush methodsFor: 'events'!
+
+onKeyDown: aBlock
     self asJQuery on: 'keydown' do: aBlock
-
!

onKeyPress: aBlock
+
+!
+
+onKeyPress: aBlock
     self asJQuery on: 'keypress' do: aBlock
-
!

onKeyUp: aBlock
+
+!
+
+onKeyUp: aBlock
     self asJQuery on: 'keyup' do: aBlock
-
!

onFocus: aBlock
+
+!
+
+onFocus: aBlock
     self asJQuery on: 'focus' do: aBlock
-
!

onBlur: aBlock
+
+!
+
+onBlur: aBlock
     self asJQuery on: 'blur' do: aBlock
-
!

onChange: aBlock
+
+!
+
+onChange: aBlock
     self asJQuery on: 'change' do: aBlock
-
!

onClick: aBlock
+
+!
+
+onClick: aBlock
     self asJQuery on: 'click' do: aBlock
-
! !

!TagBrush methodsFor: 'initialization'!

initializeFromString: aString canvas: aCanvas
+
+! !
+
+!TagBrush methodsFor: 'initialization'!
+
+initializeFromString: aString canvas: aCanvas
     element := self createElementFor: aString.
     canvas := aCanvas
-
! !

!TagBrush methodsFor: 'private'!

createElementFor: aString
+
+! !
+
+!TagBrush methodsFor: 'private'!
+
+createElementFor: aString
 	{'return document.createElement(String(aString))'}
-
!

createTextNodeFor: aString
+
+!
+
+createTextNodeFor: aString
 	{'return document.createTextNode(String(aString))'}
-
! !

!TagBrush class methodsFor: 'instance creation'!

fromString: aString canvas: aCanvas
+
+! !
+
+!TagBrush class methodsFor: 'instance creation'!
+
+fromString: aString canvas: aCanvas
     ^self new
 	initializeFromString: aString canvas: aCanvas;
 	yourself
-
! !

Object subclass: #Widget
	instanceVariableNames: 'root'
	category: 'Canvas'!

!Widget methodsFor: 'accessing'!

root
+
+! !
+
+Object subclass: #Widget
+	instanceVariableNames: 'root'
+	category: 'Canvas'!
+
+!Widget methodsFor: 'accessing'!
+
+root
     ^root
-
! !

!Widget methodsFor: 'actions'!

alert: aString
+
+! !
+
+!Widget methodsFor: 'actions'!
+
+alert: aString
     {'alert(aString)'}
-
!

confirm: aString
+
+!
+
+confirm: aString
     {'return window.confirm(aString)'}
-
!

prompt: aString
+
+!
+
+prompt: aString
     ^self prompt: aString default: ''
-
!

prompt: aString default: anotherString
+
+!
+
+prompt: aString default: anotherString
     {'return window.prompt(aString, anotherString)'}
-
!

update
+
+!
+
+update
     | canvas |
     canvas := HTMLCanvas new.
     canvas root: self root.
     self root asJQuery empty.
     self renderOn: canvas
-
! !

!Widget methodsFor: 'adding'!

appendToBrush: aTagBrush
+
+! !
+
+!Widget methodsFor: 'adding'!
+
+appendToBrush: aTagBrush
     self appendToJQuery: aTagBrush asJQuery
-
!

appendToJQuery: aJQuery
+
+!
+
+appendToJQuery: aJQuery
     self render.
     aJQuery append: self root asJQuery
-
! !

!Widget methodsFor: 'rendering'!

render
+
+! !
+
+!Widget methodsFor: 'rendering'!
+
+render
     | canvas |
     canvas := HTMLCanvas new.
     root := canvas root.
     self renderOn: canvas
-
!

renderOn: html
+
+!
+
+renderOn: html
     self
-
! !

TagBrush subclass: #CanvasBrush
	instanceVariableNames: ''
	category: 'Canvas'!

!CanvasBrush methodsFor: 'initialization'!

initializeWithCanvas: aCanvas
-	canvas := aCanvas
! !

!CanvasBrush methodsFor: 'private'!

createElement
-	{'return document.createElement(''canvas'')'}
! !

!CanvasBrush class methodsFor: 'instance creation'!

canvas: aCanvas
+
+! !
+
+TagBrush subclass: #CanvasBrush
+	instanceVariableNames: ''
+	category: 'Canvas'!
+
+!CanvasBrush methodsFor: 'initialization'!
+
+initializeWithCanvas: aCanvas
+	canvas := aCanvas
+! !
+
+!CanvasBrush methodsFor: 'private'!
+
+createElement
+	{'return document.createElement(''canvas'')'}
+! !
+
+!CanvasBrush class methodsFor: 'instance creation'!
+
+canvas: aCanvas
 	^self new
 		initializeWithCanvas: aCanvas;
-		yourself
! !



appendToBrush: aTagBrush
+		yourself
+! !
+
+
+
+appendToBrush: aTagBrush
     aTagBrush append: self asString
-
!

appendToBrush: aTagBrush
-    aTagBrush appendBlock: self
!

appendToBrush: aTagBrush
+
+!
+
+appendToBrush: aTagBrush
+    aTagBrush appendBlock: self
+!
+
+appendToBrush: aTagBrush
     aTagBrush appendString: self
-
!
+
+!

st/Compiler.st

@@ -1,38 +1,113 @@
-Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!Node methodsFor: 'accessing'!

nodes
+Object subclass: #Node
+	instanceVariableNames: 'nodes'
+	category: 'Compiler'!
+
+!Node methodsFor: 'accessing'!
+
+nodes
 	^nodes ifNil: [nodes := Array new]
-
!

addNode: aNode
+
+!
+
+addNode: aNode
 	self nodes add: aNode
-
! !

!Node methodsFor: 'building'!

nodes: aCollection
+
+! !
+
+!Node methodsFor: 'building'!
+
+nodes: aCollection
 	nodes := aCollection
-
! !

!Node methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!Node methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitNode: self
-
! !

Node subclass: #MethodNode
	instanceVariableNames: 'selector, arguments, source'
	category: 'Compiler'!

!MethodNode methodsFor: 'accessing'!

selector
+
+! !
+
+Node subclass: #MethodNode
+	instanceVariableNames: 'selector, arguments, source'
+	category: 'Compiler'!
+
+!MethodNode methodsFor: 'accessing'!
+
+selector
 	^selector
-
!

selector: aString
+
+!
+
+selector: aString
 	selector := aString
-
!

arguments
+
+!
+
+arguments
 	^arguments ifNil: [#()]
-
!

arguments: aCollection
+
+!
+
+arguments: aCollection
 	arguments := aCollection
-
!

source
+
+!
+
+source
 	^source
-
!

source: aString
+
+!
+
+source: aString
 	source := aString
-
! !

!MethodNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!MethodNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitMethodNode: self
-
! !

Node subclass: #SendNode
	instanceVariableNames: 'selector, arguments, receiver'
	category: 'Compiler'!

!SendNode methodsFor: 'accessing'!

selector
+
+! !
+
+Node subclass: #SendNode
+	instanceVariableNames: 'selector, arguments, receiver'
+	category: 'Compiler'!
+
+!SendNode methodsFor: 'accessing'!
+
+selector
 	^selector
-
!

selector: aString
+
+!
+
+selector: aString
 	selector := aString
-
!

arguments
+
+!
+
+arguments
 	^arguments ifNil: [arguments := #()]
-
!

arguments: aCollection
+
+!
+
+arguments: aCollection
 	arguments := aCollection
-
!

receiver
+
+!
+
+receiver
 	^receiver
-
!

receiver: aNode
+
+!
+
+receiver: aNode
 	receiver := aNode
-
!

valueForReceiver: anObject
+
+!
+
+valueForReceiver: anObject
 	^SendNode new
 	    receiver: (self receiver 
 		ifNil: [anObject]
@@ -40,7 +115,10 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 	    selector: self selector;
 	    arguments: self arguments;
 	    yourself
-
!

cascadeNodeWithMessages: aCollection
+
+!
+
+cascadeNodeWithMessages: aCollection
 	| first |
 	first := SendNode new
 	    selector: self selector;
@@ -50,148 +128,428 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 	    receiver: self receiver;
 	    nodes: (Array with: first), aCollection;
 	    yourself
-
! !

!SendNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!SendNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitSendNode: self
-
! !

Node subclass: #CascadeNode
	instanceVariableNames: 'receiver'
	category: 'Compiler'!

!CascadeNode methodsFor: 'accessing'!

receiver
+
+! !
+
+Node subclass: #CascadeNode
+	instanceVariableNames: 'receiver'
+	category: 'Compiler'!
+
+!CascadeNode methodsFor: 'accessing'!
+
+receiver
 	^receiver
-
!

receiver: aNode
+
+!
+
+receiver: aNode
 	receiver := aNode
-
! !

!CascadeNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!CascadeNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitCascadeNode: self
-
! !

Node subclass: #AssignmentNode
	instanceVariableNames: 'left, right'
	category: 'Compiler'!

!AssignmentNode methodsFor: 'accessing'!

left
+
+! !
+
+Node subclass: #AssignmentNode
+	instanceVariableNames: 'left, right'
+	category: 'Compiler'!
+
+!AssignmentNode methodsFor: 'accessing'!
+
+left
 	^left
-
!

left: aNode
+
+!
+
+left: aNode
 	left := aNode
-
!

right
+
+!
+
+right
 	^right
-
!

right: aNode
+
+!
+
+right: aNode
 	right := aNode
-
! !

!AssignmentNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!AssignmentNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitAssignmentNode: self
-
! !

Node subclass: #BlockNode
	instanceVariableNames: 'parameters'
	category: 'Compiler'!

!BlockNode methodsFor: 'accessing'!

parameters
+
+! !
+
+Node subclass: #BlockNode
+	instanceVariableNames: 'parameters'
+	category: 'Compiler'!
+
+!BlockNode methodsFor: 'accessing'!
+
+parameters
 	^parameters ifNil: [parameters := Array new]
-
!

parameters: aCollection
+
+!
+
+parameters: aCollection
 	parameters := aCollection
-
! !

!BlockNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!BlockNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitBlockNode: self
-
! !

Node subclass: #SequenceNode
	instanceVariableNames: 'temps'
	category: 'Compiler'!

!SequenceNode methodsFor: 'accessing'!

temps
+
+! !
+
+Node subclass: #SequenceNode
+	instanceVariableNames: 'temps'
+	category: 'Compiler'!
+
+!SequenceNode methodsFor: 'accessing'!
+
+temps
 	^temps ifNil: [#()]
-
!

temps: aCollection
+
+!
+
+temps: aCollection
 	temps := aCollection
-
! !

!SequenceNode methodsFor: 'testing'!

asBlockSequenceNode
+
+! !
+
+!SequenceNode methodsFor: 'testing'!
+
+asBlockSequenceNode
 	^BlockSequenceNode new
 	    nodes: self nodes;
 	    temps: self temps;
 	    yourself
-
! !

!SequenceNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!SequenceNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitSequenceNode: self
-
! !

SequenceNode subclass: #BlockSequenceNode
	instanceVariableNames: ''
	category: 'Compiler'!

!BlockSequenceNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+SequenceNode subclass: #BlockSequenceNode
+	instanceVariableNames: ''
+	category: 'Compiler'!
+
+!BlockSequenceNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitBlockSequenceNode: self
-
! !

Node subclass: #ReturnNode
	instanceVariableNames: ''
	category: 'Compiler'!

!ReturnNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+Node subclass: #ReturnNode
+	instanceVariableNames: ''
+	category: 'Compiler'!
+
+!ReturnNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitReturnNode: self
-
! !

Node subclass: #ValueNode
	instanceVariableNames: 'value'
	category: 'Compiler'!

!ValueNode methodsFor: 'accessing'!

value
+
+! !
+
+Node subclass: #ValueNode
+	instanceVariableNames: 'value'
+	category: 'Compiler'!
+
+!ValueNode methodsFor: 'accessing'!
+
+value
 	^value
-
!

value: anObject
+
+!
+
+value: anObject
 	value := anObject
-
! !

!ValueNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!ValueNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitValueNode: self
-
! !

ValueNode subclass: #VariableNode
	instanceVariableNames: ''
	category: 'Compiler'!

!VariableNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+ValueNode subclass: #VariableNode
+	instanceVariableNames: ''
+	category: 'Compiler'!
+
+!VariableNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitVariableNode: self
-
! !

VariableNode subclass: #ClassReferenceNode
	instanceVariableNames: ''
	category: 'Compiler'!

!ClassReferenceNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+VariableNode subclass: #ClassReferenceNode
+	instanceVariableNames: ''
+	category: 'Compiler'!
+
+!ClassReferenceNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitClassReferenceNode: self
-
! !

Node subclass: #JSStatementNode
	instanceVariableNames: 'source'
	category: 'Compiler'!

!JSStatementNode methodsFor: 'accessing'!

source
+
+! !
+
+Node subclass: #JSStatementNode
+	instanceVariableNames: 'source'
+	category: 'Compiler'!
+
+!JSStatementNode methodsFor: 'accessing'!
+
+source
 	^source ifNil: ['']
-
!

source: aString
+
+!
+
+source: aString
 	source := aString
-
! !

!JSStatementNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!JSStatementNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitJSStatementNode: self
-
! !

Object subclass: #NodeVisitor
	instanceVariableNames: ''
	category: 'Compiler'!

!NodeVisitor methodsFor: 'visiting'!

visit: aNode
+
+! !
+
+Object subclass: #NodeVisitor
+	instanceVariableNames: ''
+	category: 'Compiler'!
+
+!NodeVisitor methodsFor: 'visiting'!
+
+visit: aNode
 	aNode accept: self
-
!

visitNode: aNode
-
!

visitMethodNode: aNode
+
+!
+
+visitNode: aNode
+
+!
+
+visitMethodNode: aNode
 	self visitNode: aNode
-
!

visitSequenceNode: aNode
+
+!
+
+visitSequenceNode: aNode
 	self visitNode: aNode
-
!

visitBlockSequenceNode: aNode
+
+!
+
+visitBlockSequenceNode: aNode
 	self visitSequenceNode: aNode
-
!

visitBlockNode: aNode
+
+!
+
+visitBlockNode: aNode
 	self visitNode: aNode
-
!

visitReturnNode: aNode
+
+!
+
+visitReturnNode: aNode
 	self visitNode: aNode
-
!

visitSendNode: aNode
+
+!
+
+visitSendNode: aNode
 	self visitNode: aNode
-
!

visitCascadeNode: aNode
+
+!
+
+visitCascadeNode: aNode
 	self visitNode: aNode
-
!

visitValueNode: aNode
+
+!
+
+visitValueNode: aNode
 	self visitNode: aNode
-
!

visitVariableNode: aNode
-
!

visitAssignmentNode: aNode
+
+!
+
+visitVariableNode: aNode
+
+!
+
+visitAssignmentNode: aNode
 	self visitNode: aNode
-
!

visitClassReferenceNode: aNode
+
+!
+
+visitClassReferenceNode: aNode
 	self 
 	    nextPutAll: 'smalltalk.';
 	    nextPutAll: aNode value
-
!

visitJSStatementNode: aNode
+
+!
+
+visitJSStatementNode: aNode
 	self 
 	    nextPutAll: 'function(){';
 	    nextPutAll: aNode source;
 	    nextPutAll: '})()'
-
! !

NodeVisitor subclass: #Compiler
	instanceVariableNames: 'stream, nestedBlocks, earlyReturn, currentClass, currentSelector, unknownVariables, tempVariables, messageSends, referencedClasses'
	category: 'Compiler'!

!Compiler methodsFor: 'accessing'!

parser
+
+! !
+
+NodeVisitor subclass: #Compiler
+	instanceVariableNames: 'stream, nestedBlocks, earlyReturn, currentClass, currentSelector, unknownVariables, tempVariables, messageSends, referencedClasses'
+	category: 'Compiler'!
+
+!Compiler methodsFor: 'accessing'!
+
+parser
 	^SmalltalkParser new
-
!

currentClass
+
+!
+
+currentClass
 	^currentClass
-
!

currentClass: aClass
+
+!
+
+currentClass: aClass
 	currentClass := aClass
-
!

unknownVariables
-	^unknownVariables copy
!

pseudoVariables
-	^#('self' 'super' 'true' 'false' 'nil' 'thisContext')
!

tempVariables
-	^tempVariables copy
!

knownVariables
+
+!
+
+unknownVariables
+	^unknownVariables copy
+!
+
+pseudoVariables
+	^#('self' 'super' 'true' 'false' 'nil' 'thisContext')
+!
+
+tempVariables
+	^tempVariables copy
+!
+
+knownVariables
 	^self pseudoVariables 
 		addAll: self tempVariables;
-		yourself
!

classNameFor: aClass
+		yourself
+!
+
+classNameFor: aClass
 	^aClass isMetaclass
 	    ifTrue: [aClass instanceClass name, '.klass']
 	    ifFalse: [
 		aClass isNil
 		    ifTrue: ['nil']
-		    ifFalse: [aClass name]]
! !

!Compiler methodsFor: 'compiling'!

loadExpression: aString
+		    ifFalse: [aClass name]]
+! !
+
+!Compiler methodsFor: 'compiling'!
+
+loadExpression: aString
 	DoIt addCompiledMethod: (self eval: (self compileExpression: aString)).
 	^DoIt new doIt
-
!

load: aString forClass: aClass
+
+!
+
+load: aString forClass: aClass
 	^self eval: (self compile: aString forClass: aClass)
-
!

compile: aString forClass: aClass
+
+!
+
+compile: aString forClass: aClass
 	self currentClass: aClass.
-	^self compile: aString
!

compileExpression: aString
+	^self compile: aString
+!
+
+compileExpression: aString
 	self currentClass: DoIt.
 	^self compileNode: (self parseExpression: aString)
-
!

eval: aString
-	{'return eval(aString)'}
!

compile: aString
+
+!
+
+eval: aString
+	{'return eval(aString)'}
+!
+
+compile: aString
 	^self compileNode: (self parse: aString)
-
!

compileNode: aNode
+
+!
+
+compileNode: aNode
 	stream := '' writeStream.
 	self visit: aNode.
 	^stream contents
-
!

parse: aString
+
+!
+
+parse: aString
     ^self parser parse: aString readStream
-
!

parseExpression: aString
+
+!
+
+parseExpression: aString
     ^self parse: 'doIt ^[', aString, '] value'
-
!

recompile: aClass
+
+!
+
+recompile: aClass
 	aClass methodDictionary do: [:each || method |
 		method := self load: each source forClass: aClass.
 		method category: each category.
 		aClass addCompiledMethod: method].
-	aClass isMetaclass ifFalse: [self recompile: aClass class]
!

recompileAll
+	aClass isMetaclass ifFalse: [self recompile: aClass class]
+!
+
+recompileAll
 	Smalltalk current classes do: [:each |
-		self recompile: each]
! !

!Compiler methodsFor: 'initialization'!

initialize
+		self recompile: each]
+! !
+
+!Compiler methodsFor: 'initialization'!
+
+initialize
 	super initialize.
 	stream := '' writeStream.
 	unknownVariables := #().
 	tempVariables := #().
 	messageSends := #().
 	classReferenced := #()
-
! !

!Compiler methodsFor: 'visiting'!

visit: aNode
+
+! !
+
+!Compiler methodsFor: 'visiting'!
+
+visit: aNode
 	aNode accept: self
-
!

visitMethodNode: aNode
+
+!
+
+visitMethodNode: aNode
 	| str currentSelector |
 	currentSelector := aNode selector asSelector.
 	nestedBlocks := 0.
@@ -201,10 +559,10 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 	unknownVariables := #().
 	tempVariables := #().
 	stream 
-	    nextPutAll: 'smalltalk.method({', String cr;
-	    nextPutAll: 'selector: "', aNode selector, '",', String cr.
+	    nextPutAll: 'smalltalk.method({'; lf;
+	    nextPutAll: 'selector: "', aNode selector, '",'; lf.
 	Smalltalk current debugMode ifTrue: [
-	    stream nextPutAll: 'source: unescape("', aNode source escaped, '"),', String cr].
+	    stream nextPutAll: 'source: unescape("', aNode source escaped, '"),';lf].
 	stream nextPutAll: 'fn: function('.
 	aNode arguments 
 	    do: [:each | 
@@ -212,8 +570,8 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 		stream nextPutAll: each]
 	    separatedBy: [stream nextPutAll: ', '].
 	stream 
-	    nextPutAll: '){', String cr;
-	    nextPutAll: 'var self=this;', String cr.
+	    nextPutAll: '){'; lf;
+	    nextPutAll: 'var self=this;'; lf.
 	str := stream.
 	stream := '' writeStream.
 	aNode nodes do: [:each |
@@ -223,21 +581,24 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 	str nextPutAll: stream contents.
 	stream := str.
 	stream 
-	    nextPutAll: String cr; 
+	    lf; 
 	    nextPutAll: 'return self;'.
 	earlyReturn ifTrue: [
-	    stream nextPutAll: String cr, '} catch(e) {if(e.name === ''stReturn'' && e.selector === ', currentSelector printString, '){return e.fn()} throw(e)}'].
+	    stream lf; nextPutAll: '} catch(e) {if(e.name === ''stReturn'' && e.selector === ', currentSelector printString, '){return e.fn()} throw(e)}'].
 	stream nextPutAll: '}'.
 	Smalltalk current debugMode ifTrue: [
 		stream 
-			nextPutAll: ',', String cr, 'messageSends: ';
-			nextPutAll: messageSends asJavascript, ',', String cr;
+			nextPutAll: ',', String lf, 'messageSends: ';
+			nextPutAll: messageSends asJavascript, ','; lf;
 			nextPutAll: 'referencedClasses: ['.
 		referencedClasses 
 			do: [:each | stream nextPutAll: each]
 			separatedBy: [stream nextPutAll: ','].
 		stream nextPutAll: ']'].
-	stream nextPutAll: '})'
!

visitBlockNode: aNode
+	stream nextPutAll: '})'
+!
+
+visitBlockNode: aNode
 	stream nextPutAll: '(function('.
 	aNode parameters 
 	    do: [:each |
@@ -247,16 +608,21 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 	stream nextPutAll: '){'.
 	aNode nodes do: [:each | self visit: each].
 	stream nextPutAll: '})'
-
!

visitSequenceNode: aNode
+
+!
+
+visitSequenceNode: aNode
 	aNode temps do: [:each |
 	    tempVariables add: each.
-	    stream nextPutAll: 'var ', each, '=nil;'.
-	    stream nextPutAll: String cr].
+	    stream nextPutAll: 'var ', each, '=nil;'; lf].
 	aNode nodes do: [:each |
 	    self visit: each.
 	    stream nextPutAll: ';']
-	    separatedBy: [stream nextPutAll: String cr]
-
!

visitBlockSequenceNode: aNode
+	    separatedBy: [stream lf]
+
+!
+
+visitBlockSequenceNode: aNode
 	| index |
 	nestedBlocks := nestedBlocks + 1.
 	aNode nodes isEmpty
@@ -265,8 +631,7 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 	    ifFalse: [
 		aNode temps do: [:each |
 		    tempVariables add: each.
-		    stream nextPutAll: 'var ', each, '=nil;'.
-		    stream nextPutAll: String cr].
+		    stream nextPutAll: 'var ', each, '=nil;'; lf].
 		index := 0.
 		aNode nodes do: [:each |
 		    index := index + 1.
@@ -275,7 +640,10 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 		    self visit: each.
 		    stream nextPutAll: ';']].
 	nestedBlocks := nestedBlocks - 1
-
!

visitReturnNode: aNode
+
+!
+
+visitReturnNode: aNode
 	nestedBlocks > 0 ifTrue: [
 	    earlyReturn := true].
 	earlyReturn
@@ -289,7 +657,10 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 	aNode nodes do: [:each |
 	    self visit: each].
 	earlyReturn ifTrue: [
-	    stream nextPutAll: '}})})()']
!

visitSendNode: aNode
+	    stream nextPutAll: '}})})()']
+!
+
+visitSendNode: aNode
 	| str receiver superSend |
 	str := stream.
 	(messageSends includes: aNode selector) ifFalse: [
@@ -308,7 +679,10 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 	stream nextPutAll: ']'.
 	superSend ifTrue: [
 		stream nextPutAll: ', smalltalk.', (self classNameFor: self currentClass superclass)].
-	stream nextPutAll: ')'
!

visitCascadeNode: aNode
+	stream nextPutAll: ')'
+!
+
+visitCascadeNode: aNode
 	| index |
 	index := 0.
 	(tempVariables includes: '$rec') ifFalse: [
@@ -324,31 +698,65 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

!
 	stream nextPutAll: '})('.
 	self visit: aNode receiver.
 	stream nextPutAll: ')'
-
!

visitValueNode: aNode
+
+!
+
+visitValueNode: aNode
 	stream nextPutAll: aNode value asJavascript
-
!

visitAssignmentNode: aNode
+
+!
+
+visitAssignmentNode: aNode
 	self visit: aNode left.
 	stream nextPutAll: '='.
 	self visit: aNode right
-
!

visitClassReferenceNode: aNode
+
+!
+
+visitClassReferenceNode: aNode
 	| klass |
 	klass := 'smalltalk.', aNode value.
 	(Smalltalk current at: aNode value) isClass ifTrue: [
 		(referencedClasses includes: klass)
 			ifFalse: [referencedClasses add: klass]].
-	stream nextPutAll: klass
!

visitVariableNode: aNode
+	stream nextPutAll: klass
+!
+
+visitVariableNode: aNode
 	(self currentClass instanceVariableNames includes: aNode value) 
 		ifTrue: [stream nextPutAll: 'self[''@', aNode value, ''']']
 		ifFalse: [
 			(self knownVariables includes: aNode value) ifFalse: [
 				unknownVariables add: aNode value].
 			stream nextPutAll: aNode value]
-
!

visitJSStatementNode: aNode
-	stream nextPutAll: (aNode source value replace: '''''' with: '''')
! !

!Compiler class methodsFor: 'compiling'!

recompile: aClass
+
+!
+
+visitJSStatementNode: aNode
+	stream nextPutAll: (aNode source value replace: '''''' with: '''')
+! !
+
+!Compiler class methodsFor: 'compiling'!
+
+recompile: aClass
 	aClass methodDictionary do: [:each || method |
 		method := self new load: each source forClass: aClass.
 		method category: each category.
 		aClass addCompiledMethod: method].
-	aClass isMetaclass ifFalse: [self recompile: aClass class]
!

recompileAll
+	aClass isMetaclass ifFalse: [self recompile: aClass class]
+!
+
+recompileAll
 	Smalltalk current classes do: [:each |
-		self recompile: each]
! !

Object subclass: #DoIt
	instanceVariableNames: ''
	category: 'Compiler'!

!DoIt methodsFor: ''!

doIt ^[ChunkExporter new exportCategory: 'Parser' ] value
! !
+		self recompile: each]
+! !
+
+Object subclass: #DoIt
+	instanceVariableNames: ''
+	category: 'Compiler'!
+
+!DoIt methodsFor: ''!
+
+doIt ^[ChunkExporter new exportCategory: 'Parser' ] value
+! !
+

st/Examples.st

@@ -1,11 +1,30 @@
-Widget subclass: #Counter
	instanceVariableNames: 'count, header'
	category: 'Examples'!

!Counter methodsFor: 'actions'!

increase
+Widget subclass: #Counter
+	instanceVariableNames: 'count, header'
+	category: 'Examples'!
+
+!Counter methodsFor: 'actions'!
+
+increase
     count := count + 1.
-    header contents: [:html | html with: count asString]
!

decrease
+    header contents: [:html | html with: count asString]
+!
+
+decrease
     count := count - 1.
-    header contents: [:html | html with: count asString]
! !

!Counter methodsFor: 'initialization'!

initialize
+    header contents: [:html | html with: count asString]
+! !
+
+!Counter methodsFor: 'initialization'!
+
+initialize
     super initialize.
     count := 0
-
! !

!Counter methodsFor: 'rendering'!

renderOn: html
+
+! !
+
+!Counter methodsFor: 'rendering'!
+
+renderOn: html
     header := html h1 
 	with: count asString;
 	yourself.
@@ -15,28 +34,66 @@ Widget subclass: #Counter
	instanceVariableNames: 'count, header'
	category: 'Ex
     html button
 	with: '--';
 	onClick: [self decrease]
-
! !

Widget subclass: #Tetris
	instanceVariableNames: 'renderingContext, timer, speed, score, rows, movingPiece'
	category: 'Examples'!

!Tetris methodsFor: 'accessing'!

width
-	^self class width
!

height
-	^self class height
!

squares
-	^self class squares
!

gluePiece: aPiece
+
+! !
+
+Widget subclass: #Tetris
+	instanceVariableNames: 'renderingContext, timer, speed, score, rows, movingPiece'
+	category: 'Examples'!
+
+!Tetris methodsFor: 'accessing'!
+
+width
+	^self class width
+!
+
+height
+	^self class height
+!
+
+squares
+	^self class squares
+!
+
+gluePiece: aPiece
 	aPiece glueOn: self
-	
!

rows
+	
+!
+
+rows
 	"An array of rows. Each row is a collection of points."
-	^rows
!

addRow: aCollection
-	self rows add: aCollection
! !

!Tetris methodsFor: 'actions'!

startNewGame
+	^rows
+!
+
+addRow: aCollection
+	self rows add: aCollection
+! !
+
+!Tetris methodsFor: 'actions'!
+
+startNewGame
 	self newGame.
 	timer ifNotNil: [timer clearInterval].
-	timer := [self nextStep] valueWithInterval: speed
!

nextStep
+	timer := [self nextStep] valueWithInterval: speed
+!
+
+nextStep
 	movingPiece ifNil: [self newPiece].
 	(movingPiece canMoveIn: self)
 		ifTrue: [movingPiece position: movingPiece position + (0@1)]
 		ifFalse: [self newPiece].
 	self redraw
-	
!

redraw
+	
+!
+
+redraw
 	renderingContext clearRectFrom: 0@ self width to: 0@ self height.
 	self 
 		drawMap;
-		drawPiece
!

drawMap
+		drawPiece
+!
+
+drawMap
 	renderingContext 
 		fillStyle: '#fafafa';
 		fillRectFrom: 0@0 to: self width@self height.
@@ -48,35 +105,66 @@ Widget subclass: #Counter
	instanceVariableNames: 'count, header'
	category: 'Ex
 		self drawLineFrom: x@0 to: x@self height].
 	0 to: self class squares y do: [:each | | y |
 		y := each * self class squareSize.
-		self drawLineFrom: 0@y to: self width@y].
!

drawLineFrom: aPoint to: anotherPoint
+		self drawLineFrom: 0@y to: self width@y].
+!
+
+drawLineFrom: aPoint to: anotherPoint
 	renderingContext 
 		beginPath;
 		moveTo: aPoint;
 		lineTo: anotherPoint;
-		stroke
!

newGame
+		stroke
+!
+
+newGame
 	rows := #().
 	movingPiece := nil.
 	speed := 200.
-	score := 0
!

newPiece
-	movingPiece := TetrisPiece atRandom
!

drawRows
+	score := 0
+!
+
+newPiece
+	movingPiece := TetrisPiece atRandom
+!
+
+drawRows
 	self rows do: [:each |].
-	movingPiece ifNotNil: [movingPiece drawOn: renderingContext]
!

drawPiece
+	movingPiece ifNotNil: [movingPiece drawOn: renderingContext]
+!
+
+drawPiece
 	movingPiece ifNotNil: [
-		movingPiece drawOn: renderingContext]
! !

!Tetris methodsFor: 'initialization'!

initialize
+		movingPiece drawOn: renderingContext]
+! !
+
+!Tetris methodsFor: 'initialization'!
+
+initialize
 	super initialize.
-	self newGame
! !

!Tetris methodsFor: 'rendering'!

renderOn: html
+	self newGame
+! !
+
+!Tetris methodsFor: 'rendering'!
+
+renderOn: html
 	html div
 		class: 'tetris';
 		with: [
 			html h3 with: 'Tetris'.
 			self renderCanvasOn: html.
-			self renderButtonsOn: html]
!

renderCanvasOn: html
+			self renderButtonsOn: html]
+!
+
+renderCanvasOn: html
 	| canvas |
 	canvas := html canvas.
 	canvas at: 'width' put: self width asString.
 	canvas at: 'height' put: self height asString.
 	renderingContext := CanvasRenderingContext tagBrush: canvas.
-	self redraw
!

renderButtonsOn: html
+	self redraw
+!
+
+renderButtonsOn: html
 	html div 
 		class: 'tetris_buttons';
 		with: [
@@ -85,62 +173,189 @@ Widget subclass: #Counter
	instanceVariableNames: 'count, header'
	category: 'Ex
 				onClick: [self startNewGame].
 			html button
 				with: 'play/pause';
-				onClick: [self update]]
! !

!Tetris class methodsFor: 'accessing'!

squareSize
-	^22
!

width
-	^self squareSize * (self squares x)
!

height
-	^self squareSize * (self squares y)
!

squares
-	^10@15
! !

Widget subclass: #TetrisPiece
	instanceVariableNames: 'rotation, position'
	category: 'Examples'!

!TetrisPiece methodsFor: 'accessing'!

rotation
-	^rotation ifNil: [rotation := 1]
!

rotation: aNumber
-	rotation := aNumber
!

position
-	^position ifNil: [(Tetris squares x / 2) -1 @ 0]
!

position: aPoint
-	^position := aPoint
!

bounds
-	self subclassResponsibility
!

color
-	^'#afa'
!

height
-	^2
! !

!TetrisPiece methodsFor: 'drawing'!

drawOn: aRenderingContext
+				onClick: [self update]]
+! !
+
+!Tetris class methodsFor: 'accessing'!
+
+squareSize
+	^22
+!
+
+width
+	^self squareSize * (self squares x)
+!
+
+height
+	^self squareSize * (self squares y)
+!
+
+squares
+	^10@15
+! !
+
+Widget subclass: #TetrisPiece
+	instanceVariableNames: 'rotation, position'
+	category: 'Examples'!
+
+!TetrisPiece methodsFor: 'accessing'!
+
+rotation
+	^rotation ifNil: [rotation := 1]
+!
+
+rotation: aNumber
+	rotation := aNumber
+!
+
+position
+	^position ifNil: [(Tetris squares x / 2) -1 @ 0]
+!
+
+position: aPoint
+	^position := aPoint
+!
+
+bounds
+	self subclassResponsibility
+!
+
+color
+	^'#afa'
+!
+
+height
+	^2
+! !
+
+!TetrisPiece methodsFor: 'drawing'!
+
+drawOn: aRenderingContext
 	aRenderingContext fillStyle: self color.
 	self bounds do: [:each |
 		aRenderingContext 
 			fillRectFrom: each + self position* Tetris squareSize to: 1@1 * Tetris squareSize;
 			strokeStyle: '#999';
 			lineWidth: 2;
-			strokeRectFrom: each + self position* Tetris squareSize to: 1@1 * Tetris squareSize]
! !

!TetrisPiece methodsFor: 'testing'!

canMove
-	^self position y < (Tetris squares y - self height)
!

canMoveIn: aTetris
-	^self position y < (aTetris squares y - self height)
! !

!TetrisPiece class methodsFor: 'instance creation'!

atRandom
-	^(self subclasses at: self subclasses size atRandom) new
! !

TetrisPiece subclass: #TetrisPieceO
	instanceVariableNames: ''
	category: 'Examples'!

!TetrisPieceO methodsFor: 'accessing'!

bounds
+			strokeRectFrom: each + self position* Tetris squareSize to: 1@1 * Tetris squareSize]
+! !
+
+!TetrisPiece methodsFor: 'testing'!
+
+canMove
+	^self position y < (Tetris squares y - self height)
+!
+
+canMoveIn: aTetris
+	^self position y < (aTetris squares y - self height)
+! !
+
+!TetrisPiece class methodsFor: 'instance creation'!
+
+atRandom
+	^(self subclasses at: self subclasses size atRandom) new
+! !
+
+TetrisPiece subclass: #TetrisPieceO
+	instanceVariableNames: ''
+	category: 'Examples'!
+
+!TetrisPieceO methodsFor: 'accessing'!
+
+bounds
 	^Array new
 		add: 0@0;
 		add: 0@1;
 		add: 1@0;
 		add: 1@1;
-		yourself
! !

TetrisPiece subclass: #TetrisPieceL
	instanceVariableNames: ''
	category: 'Examples'!

!TetrisPieceL methodsFor: 'accessing'!

bounds
+		yourself
+! !
+
+TetrisPiece subclass: #TetrisPieceL
+	instanceVariableNames: ''
+	category: 'Examples'!
+
+!TetrisPieceL methodsFor: 'accessing'!
+
+bounds
 	^Array new
 		add: 0@0;
 		add: 0@1;
 		add: 0@2;
 		add: 1@2;
-		yourself
!

color
-	^'#ffa'
!

height
-	^3
! !

TetrisPiece subclass: #TetrisPieceJ
	instanceVariableNames: ''
	category: 'Examples'!

!TetrisPieceJ methodsFor: 'accessing'!

color
-	^'#aaf'
!

bounds
+		yourself
+!
+
+color
+	^'#ffa'
+!
+
+height
+	^3
+! !
+
+TetrisPiece subclass: #TetrisPieceJ
+	instanceVariableNames: ''
+	category: 'Examples'!
+
+!TetrisPieceJ methodsFor: 'accessing'!
+
+color
+	^'#aaf'
+!
+
+bounds
 	^Array new
 		add: 1@0;
 		add: 1@1;
 		add: 1@2;
 		add: 0@2;
-		yourself
!

height
-	^3
! !

TetrisPiece subclass: #TetrisPieceI
	instanceVariableNames: ''
	category: 'Examples'!

!TetrisPieceI methodsFor: 'accessing'!

color
-	^'#faa'
!

bounds
+		yourself
+!
+
+height
+	^3
+! !
+
+TetrisPiece subclass: #TetrisPieceI
+	instanceVariableNames: ''
+	category: 'Examples'!
+
+!TetrisPieceI methodsFor: 'accessing'!
+
+color
+	^'#faa'
+!
+
+bounds
 	^Array new
 		add: 0@0;
 		add: 0@1;
 		add: 0@2;
 		add: 0@3;
-		yourself
!

height
-	^4
! !

TetrisPiece subclass: #TetrisPieceT
	instanceVariableNames: ''
	category: 'Examples'!

!TetrisPieceT methodsFor: 'accessing'!

bounds
+		yourself
+!
+
+height
+	^4
+! !
+
+TetrisPiece subclass: #TetrisPieceT
+	instanceVariableNames: ''
+	category: 'Examples'!
+
+!TetrisPieceT methodsFor: 'accessing'!
+
+bounds
 	^Array new
 		add: 0@0;
 		add: 1@0;
 		add: 2@0;
 		add: 1@1;
-		yourself
!

color
-	^'#aaf'
! !
+		yourself
+!
+
+color
+	^'#aaf'
+! !
+

st/JQuery.st

@@ -1,141 +1,343 @@
-Object subclass: #JQuery
	instanceVariableNames: 'jquery'
	category: 'JQuery'!

!JQuery methodsFor: 'DOM insertion'!

append: anObject
+Object subclass: #JQuery
+	instanceVariableNames: 'jquery'
+	category: 'JQuery'!
+
+!JQuery methodsFor: 'DOM insertion'!
+
+append: anObject
     "Append anObject at the end of the element."
     anObject appendToJQuery: self
-
!

appendElement: anElement
+
+!
+
+appendElement: anElement
     "Append anElement at the end of the element.
      Dont't call this method directly, use #append: instead"
     self call: 'append' withArgument: anElement
-
!

appendToJQuery: aJQuery
+
+!
+
+appendToJQuery: aJQuery
     aJQuery appendElement: jquery
-
!

contents: anObject
+
+!
+
+contents: anObject
     self empty.
     self append: anObject
-
!

empty
-    ^self call: 'empty'
! !

!JQuery methodsFor: 'attributes'!

removeAttribute: aString
+
+!
+
+empty
+    ^self call: 'empty'
+! !
+
+!JQuery methodsFor: 'attributes'!
+
+removeAttribute: aString
     "Remove an attribute from each element in the set of matched elements."
     ^self call: 'removeAttribute' withArgument: aString
-
!

attr: aString
+
+!
+
+attr: aString
     "Get the value of an attribute for the first element in the set of matched elements."
     ^self call: 'attr' withArgument: aString
-
!

val
+
+!
+
+val
     "Get the current value of the first element in the set of matched elements."
     ^self call: 'val'
-
!

val: aString
+
+!
+
+val: aString
     self call: 'val' withArgument: aString
-
! !

!JQuery methodsFor: 'css'!

cssAt: aString
-	{'return self[''@jquery''].css(aString)'}
!

cssAt: aString put: anotherString
+
+! !
+
+!JQuery methodsFor: 'css'!
+
+cssAt: aString
+	{'return self[''@jquery''].css(aString)'}
+!
+
+cssAt: aString put: anotherString
     {'self[''@jquery''].css(aString, anotherString)'}
-
!

addClass: aString
+
+!
+
+addClass: aString
     "Adds the specified class(es) to each of the set of matched elements."
     self call: 'addClass' withArgument: aString
-
!

removeClass: aString
+
+!
+
+removeClass: aString
     "Remove a single class, multiple classes, or all classes from each element in the set of matched elements."
     self call: 'removeClass' withArgument: aString
-
!

toggleClass: aString
+
+!
+
+toggleClass: aString
     "Add or remove one or more classes from each element in the set of matched elements, depending on either the class's presence or the value of the switch argument."
     self call: 'toggleClass' withArgument: aString
-
!

height 
+
+!
+
+height 
     "Get the current computed height for the first element in the set of matched elements."
     ^self call: 'height'
-
!

height: anInteger
+
+!
+
+height: anInteger
     self call: 'height' withArgument: anInteger
-
!

width: anInteger
+
+!
+
+width: anInteger
     self call: 'width' withArgument: anInteger
-
!

width
+
+!
+
+width
     "Get the current computed width for the first element in the set of matched elements."
     ^self call: 'width'
-
!

innerHeight
+
+!
+
+innerHeight
     "Get the current computed height for the first element in the set of matched elements, including padding but not border."
     ^self call: 'innerHeight'
-
!

innerWidth
+
+!
+
+innerWidth
     "Get the current computed width for the first element in the set of matched elements, including padding but not border."
     ^self call: 'innerWidth'
-
!

outerHeight
+
+!
+
+outerHeight
     "Get the current computed height for the first element in the set of matched elements, including padding, border, and optionally margin."
     ^self call: 'outerHeight'
-
!

outerWidth
+
+!
+
+outerWidth
     "Get the current computed width for the first element in the set of matched elements, including padding and border."
     ^self call: 'outerWidth'
-
!

top
+
+!
+
+top
     "Get the current y coordinate of the first element in the set of matched elements, relative to the offset parent."
     ^(self call: 'position') basicAt: 'top'
-
!

left
+
+!
+
+left
     "Get the current x coordinate of the first element in the set of matched elements, relative to the offset parent."
     ^(self call: 'position') basicAt: 'left'
-
!

offsetLeft
+
+!
+
+offsetLeft
     "Get the current coordinates of the first element in the set of matched elements, relative to the document."
     ^(self call: 'offset') basicAt: 'left'
-
!

offsetTop
+
+!
+
+offsetTop
     "Get the current coordinates of the first element in the set of matched elements, relative to the document."
     ^(self call: 'offset') basicAt: 'top'
-
!

scrollLeft
+
+!
+
+scrollLeft
     "Get the current horizontal position of the scroll bar for the first element in the set of matched elements."
     ^self call: 'scrollLeft'
-
!

scrollTop
+
+!
+
+scrollTop
     "Get the current vertical position of the scroll bar for the first element in the set of matched elements."
     ^self call: 'scrollTop'
-
!

scrollLeft: anInteger
+
+!
+
+scrollLeft: anInteger
     self call: 'scrollLeft' withArgument: anInteger
-
!

scrollTop: anInteger
+
+!
+
+scrollTop: anInteger
     self call: 'scrollTop' withArgument: anInteger
-
! !

!JQuery methodsFor: 'events'!

focus
+
+! !
+
+!JQuery methodsFor: 'events'!
+
+focus
     self call: 'focus'
-
!

show
+
+!
+
+show
     self call: 'show'
-
!

hide
+
+!
+
+hide
     self call: 'hide'
-
!

remove
+
+!
+
+remove
     self call: 'remove'
-
!

on: anEventString do: aBlock
+
+!
+
+on: anEventString do: aBlock
     "Attach aBlock for anEventString on the element"
     {'self[''@jquery''].bind(anEventString, function(e){aBlock(e, self)})'}
-
!

removeEvents: aString
+
+!
+
+removeEvents: aString
     "Unbind all handlers attached to the event aString"
     self call: 'unbind' withArgument: aString
-
! !

!JQuery methodsFor: 'initialization'!

initializeWithJQueryObject: anObject
+
+! !
+
+!JQuery methodsFor: 'initialization'!
+
+initializeWithJQueryObject: anObject
     jquery := anObject
-
! !

!JQuery methodsFor: 'private'!

call: aString
-	{'return self[''@jquery''][aString]()'}
!

call: aString withArgument: anObject
-    {'return self[''@jquery''][aString](anObject)'}
! !

!JQuery methodsFor: 'testing'!

hasClass: aString
+
+! !
+
+!JQuery methodsFor: 'private'!
+
+call: aString
+	{'return self[''@jquery''][aString]()'}
+!
+
+call: aString withArgument: anObject
+    {'return self[''@jquery''][aString](anObject)'}
+! !
+
+!JQuery methodsFor: 'testing'!
+
+hasClass: aString
     "Determine whether any of the matched elements are assigned the given class."
     ^self call: 'hasClass' withArgument: aString
-
! !

!JQuery class methodsFor: 'instance creation'!

fromString: aString
+
+! !
+
+!JQuery class methodsFor: 'instance creation'!
+
+fromString: aString
     | newJQuery |
     {'newJQuery = jQuery(String(aString))'}.
     ^self from: newJQuery
-
!

from: anObject
+
+!
+
+from: anObject
     ^self new
 	initializeWithJQueryObject: anObject;
 	yourself
-
!

window
-	{'return self._from_(jQuery(window))'}
!

body
-	{'return self._from_(jQuery(body))'}
!

document
-	{'return self._from_(jQuery(document))'}
! !

Object subclass: #Ajax
	instanceVariableNames: 'settings'
	category: 'JQuery'!
!Ajax commentStamp!
instance%20variable%20names%3A%0A-%20settings%20%20A%20set%20of%20key/value%20pairs%20that%20configure%20the%20Ajax%20request.%20All%20settings%20are%20optional.%0A%0AFull%20list%20of%20settings%20options%20at%20http%3A//api.jquery.com/jQuery.ajax/%0A!

!Ajax methodsFor: 'accessing'!

at: aKey
+
+!
+
+window
+	{'return self._from_(jQuery(window))'}
+!
+
+body
+	{'return self._from_(jQuery(body))'}
+!
+
+document
+	{'return self._from_(jQuery(document))'}
+! !
+
+Object subclass: #Ajax
+	instanceVariableNames: 'settings'
+	category: 'JQuery'!
+!Ajax commentStamp!
+instance%20variable%20names%3A%0A-%20settings%20%20A%20set%20of%20key/value%20pairs%20that%20configure%20the%20Ajax%20request.%20All%20settings%20are%20optional.%0A%0AFull%20list%20of%20settings%20options%20at%20http%3A//api.jquery.com/jQuery.ajax/%0A!
+
+!Ajax methodsFor: 'accessing'!
+
+at: aKey
     ^settings at: aKey ifAbsent: [nil]
-
!

at: aKey put: aValue
+
+!
+
+at: aKey put: aValue
     settings at: aKey put: aValue
-
!

url
+
+!
+
+url
     ^self at: 'url'
-
!

url: aString
+
+!
+
+url: aString
     self at: 'url' put: aString
-
! !

!Ajax methodsFor: 'actions'!

send
+
+! !
+
+!Ajax methodsFor: 'actions'!
+
+send
     {'jQuery.ajax(self[''@settings''])'}
-
! !

!Ajax methodsFor: 'initialization'!

initialize
+
+! !
+
+!Ajax methodsFor: 'initialization'!
+
+initialize
     super initialize.
     settings := Dictionary new
-
! !

!Ajax class methodsFor: 'instance creation'!

url: aString
+
+! !
+
+!Ajax class methodsFor: 'instance creation'!
+
+url: aString
     ^self new
 	url: aString;
 	yourself
-
! !



appendToJQuery: aJQuery
+
+! !
+
+
+
+appendToJQuery: aJQuery
 	| canvas |
 	canvas := HTMLCanvas new.
 	self value: canvas.
 	aJQuery append: canvas
-
!

asJQuery
+
+!
+
+asJQuery
     ^JQuery fromString: self
-
!

appendToJQuery: aJQuery
+
+!
+
+appendToJQuery: aJQuery
     {'aJQuery._appendElement_(String(self))'}
-
!

appendToJQuery: aJQuery
+
+!
+
+appendToJQuery: aJQuery
     aJQuery appendElement: root element
-
!
+
+!

st/Parser.st

@@ -1,26 +1,69 @@
-Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!

!PPParser methodsFor: 'accessing'!

memo
+Object subclass: #PPParser
+	instanceVariableNames: 'memo'
+	category: 'Parser'!
+
+!PPParser methodsFor: 'accessing'!
+
+memo
 	^memo
-
! !

!PPParser methodsFor: 'initialization'!

initialize
+
+! !
+
+!PPParser methodsFor: 'initialization'!
+
+initialize
 	memo := Dictionary new
-
! !

!PPParser methodsFor: 'operations'!

flatten
+
+! !
+
+!PPParser methodsFor: 'operations'!
+
+flatten
 	^PPFlattenParser on: self
-
!

withSource
+
+!
+
+withSource
 	^PPSourceParser on: self
-
!

==> aBlock
+
+!
+
+==> aBlock
 	^PPActionParser on: self block: aBlock
-
!

, aParser
+
+!
+
+, aParser
 	^PPSequenceParser with: self with: aParser
-
!

/ aParser
+
+!
+
+/ aParser
 	^PPChoiceParser with: self with: aParser
-
!

plus
+
+!
+
+plus
 	^PPRepeatingParser on: self min: 1
-
!

star
+
+!
+
+star
 	^PPRepeatingParser on: self min: 0
-
!

not
+
+!
+
+not
 	^PPNotParser on: self
-
!

optional
+
+!
+
+optional
 	^self / PPEpsilonParser new
-
!

memoizedParse: aStream
+
+!
+
+memoizedParse: aStream
 	| start end node |
 	start := aStream position.
 	^self memo at: start 
@@ -32,31 +75,83 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 		end := aStream position.
 		self memo at: start put: (Array with: node with: end).
 		node]
-
! !

!PPParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+!PPParser methodsFor: 'parsing'!
+
+parse: aStream
 	self subclassResponsibility
-
!

parseAll: aStream
+
+!
+
+parseAll: aStream
 	| result |
 	result := (PPSequenceParser with: self with: PPEOFParser new) memoizedParse: aStream.
 	^result isParseFailure 
 	    ifTrue: [self error: (result messageFor: aStream contents)]
 	    ifFalse: [result first]
-
! !

PPParser subclass: #PPEOFParser
	instanceVariableNames: ''
	category: 'Parser'!

!PPEOFParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+PPParser subclass: #PPEOFParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!PPEOFParser methodsFor: 'parsing'!
+
+parse: aStream
 	^aStream atEnd 
 	    ifFalse: [
 		PPFailure new reason: 'EOF expected' at: aStream position]
 	    ifTrue: [nil]
-
! !

PPParser subclass: #PPAnyParser
	instanceVariableNames: ''
	category: 'Parser'!

!PPAnyParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+PPParser subclass: #PPAnyParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!PPAnyParser methodsFor: 'parsing'!
+
+parse: aStream
 	^aStream atEnd
 	    ifTrue: [PPFailure new
 			 reason: 'did not expect EOF' at: aStream position]
 	    ifFalse: [aStream next]
-
! !

PPParser subclass: #PPEpsilonParser
	instanceVariableNames: ''
	category: 'Parser'!

!PPEpsilonParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+PPParser subclass: #PPEpsilonParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!PPEpsilonParser methodsFor: 'parsing'!
+
+parse: aStream
 	^nil
-
! !

PPParser subclass: #PPStringParser
	instanceVariableNames: 'string'
	category: 'Parser'!

!PPStringParser methodsFor: 'accessing'!

string
+
+! !
+
+PPParser subclass: #PPStringParser
+	instanceVariableNames: 'string'
+	category: 'Parser'!
+
+!PPStringParser methodsFor: 'accessing'!
+
+string
 	^string
-
!

string: aString
+
+!
+
+string: aString
 	string := aString
-
! !

!PPStringParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+!PPStringParser methodsFor: 'parsing'!
+
+parse: aStream
 	| position result |
 	position := aStream position.
 	result := aStream next: self string size.
@@ -65,29 +160,87 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 	    ifFalse: [
 		aStream position: position.
 		PPFailure new reason: 'Expected ', self string, ' but got ', (result at: position) printString; yourself]
-
! !

PPParser subclass: #PPCharacterParser
	instanceVariableNames: 'regexp'
	category: 'Parser'!

!PPCharacterParser methodsFor: 'accessing'!

string: aString
+
+! !
+
+PPParser subclass: #PPCharacterParser
+	instanceVariableNames: 'regexp'
+	category: 'Parser'!
+
+!PPCharacterParser methodsFor: 'accessing'!
+
+string: aString
 	regexp := RegularExpression fromString: '[', aString, ']'
-
! !

!PPCharacterParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+!PPCharacterParser methodsFor: 'parsing'!
+
+parse: aStream
 	^(aStream peek notNil and: [self match: aStream peek])
 	    ifTrue: [aStream next]
 	    ifFalse: [PPFailure new reason: 'Could not match' at: aStream position]
-
! !

!PPCharacterParser methodsFor: 'private'!

match: aString
+
+! !
+
+!PPCharacterParser methodsFor: 'private'!
+
+match: aString
 	^aString match: regexp
-
! !

PPParser subclass: #PPListParser
	instanceVariableNames: 'parsers'
	category: 'Parser'!

!PPListParser methodsFor: 'accessing'!

parsers
+
+! !
+
+PPParser subclass: #PPListParser
+	instanceVariableNames: 'parsers'
+	category: 'Parser'!
+
+!PPListParser methodsFor: 'accessing'!
+
+parsers
 	^parsers ifNil: [#()]
-
!

parsers: aCollection
+
+!
+
+parsers: aCollection
 	parsers := aCollection
-
! !

!PPListParser methodsFor: 'copying'!

copyWith: aParser
+
+! !
+
+!PPListParser methodsFor: 'copying'!
+
+copyWith: aParser
 	^self class withAll: (self parsers copyWith: aParser)
-
! !

!PPListParser class methodsFor: 'instance creation'!

withAll: aCollection
+
+! !
+
+!PPListParser class methodsFor: 'instance creation'!
+
+withAll: aCollection
 	    ^self new
 		parsers: aCollection;
 		yourself
-
!

with: aParser with: anotherParser
+
+!
+
+with: aParser with: anotherParser
 	    ^self withAll: (Array with: aParser with: anotherParser)
-
! !

PPListParser subclass: #PPSequenceParser
	instanceVariableNames: ''
	category: 'Parser'!

!PPSequenceParser methodsFor: 'copying'!

, aRule
+
+! !
+
+PPListParser subclass: #PPSequenceParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!PPSequenceParser methodsFor: 'copying'!
+
+, aRule
 	^self copyWith: aRule
-
! !

!PPSequenceParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+!PPSequenceParser methodsFor: 'parsing'!
+
+parse: aStream
 	| start elements element |
 	start := aStream position.
 	elements := #().
@@ -100,9 +253,23 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 	^element isParseFailure
 	    ifFalse: [elements]
 	    ifTrue: [aStream position: start. element]
-
! !

PPListParser subclass: #PPChoiceParser
	instanceVariableNames: ''
	category: 'Parser'!

!PPChoiceParser methodsFor: 'copying'!

/ aRule
+
+! !
+
+PPListParser subclass: #PPChoiceParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!PPChoiceParser methodsFor: 'copying'!
+
+/ aRule
 	^self copyWith: aRule
-
! !

!PPChoiceParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+!PPChoiceParser methodsFor: 'parsing'!
+
+parse: aStream
 	| result |
 	self parsers
     	    detect: [:each |
@@ -110,46 +277,120 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 		result isParseFailure not]
 	    ifNone: [].
 	^result
-
! !

PPParser subclass: #PPDelegateParser
	instanceVariableNames: 'parser'
	category: 'Parser'!

!PPDelegateParser methodsFor: 'accessing'!

parser
+
+! !
+
+PPParser subclass: #PPDelegateParser
+	instanceVariableNames: 'parser'
+	category: 'Parser'!
+
+!PPDelegateParser methodsFor: 'accessing'!
+
+parser
 	^parser
-
!

parser: aParser
+
+!
+
+parser: aParser
 	parser := aParser
-
! !

!PPDelegateParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+!PPDelegateParser methodsFor: 'parsing'!
+
+parse: aStream
 	^self parser memoizedParse: aStream
-
! !

!PPDelegateParser class methodsFor: 'instance creation'!

on: aParser
+
+! !
+
+!PPDelegateParser class methodsFor: 'instance creation'!
+
+on: aParser
 	    ^self new
 		parser: aParser;
 		yourself
-
! !

PPDelegateParser subclass: #PPAndParser
	instanceVariableNames: ''
	category: 'Parser'!

!PPAndParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+PPDelegateParser subclass: #PPAndParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!PPAndParser methodsFor: 'parsing'!
+
+parse: aStream
 	^self basicParse: aStream
-
!

basicParse: aStream
+
+!
+
+basicParse: aStream
 	| element position |
 	position := aStream position.
 	element := self parser memoizedParse: aStream.
 	aStream position: position.
 	^element
-
! !

PPAndParser subclass: #PPNotParser
	instanceVariableNames: ''
	category: 'Parser'!

!PPNotParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+PPAndParser subclass: #PPNotParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!PPNotParser methodsFor: 'parsing'!
+
+parse: aStream
 	| element |
 	element := self basicParse: aStream.
 	^element isParseFailure 
 	    ifTrue: [nil]
 	    ifFalse: [PPFailure reason: element at: aStream position]
-
! !

PPDelegateParser subclass: #PPActionParser
	instanceVariableNames: 'block'
	category: 'Parser'!

!PPActionParser methodsFor: 'accessing'!

block
+
+! !
+
+PPDelegateParser subclass: #PPActionParser
+	instanceVariableNames: 'block'
+	category: 'Parser'!
+
+!PPActionParser methodsFor: 'accessing'!
+
+block
 	^block
-
!

block: aBlock
+
+!
+
+block: aBlock
 	block := aBlock
-
! !

!PPActionParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+!PPActionParser methodsFor: 'parsing'!
+
+parse: aStream
 	| element |
 	element := self parser memoizedParse: aStream.
 	^element isParseFailure
 	    ifFalse: [self block value: element]
 	    ifTrue: [element]
-
! !

!PPActionParser class methodsFor: 'instance creation'!

on: aParser block: aBlock
+
+! !
+
+!PPActionParser class methodsFor: 'instance creation'!
+
+on: aParser block: aBlock
 	    ^self new
 		parser: aParser;
 		block: aBlock;
 		yourself
-
! !

PPDelegateParser subclass: #PPFlattenParser
	instanceVariableNames: ''
	category: 'Parser'!

!PPFlattenParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+PPDelegateParser subclass: #PPFlattenParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!PPFlattenParser methodsFor: 'parsing'!
+
+parse: aStream
 	| start element stop |
 	start := aStream position.
 	element := self parser memoizedParse: aStream.
@@ -158,7 +399,16 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 	    ifFalse: [aStream collection 
 		copyFrom: start + 1 
 		to: aStream position]
-
! !

PPDelegateParser subclass: #PPSourceParser
	instanceVariableNames: ''
	category: 'Parser'!

!PPSourceParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+PPDelegateParser subclass: #PPSourceParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!PPSourceParser methodsFor: 'parsing'!
+
+parse: aStream
 	| start element stop result |
 	start := aStream position.
 	element := self parser memoizedParse: aStream.
@@ -166,11 +416,28 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 		ifTrue: [element]
 		ifFalse: [result := aStream collection copyFrom: start + 1 to: aStream position.
 			Array with: element with: result].
-
! !

PPDelegateParser subclass: #PPRepeatingParser
	instanceVariableNames: 'min'
	category: 'Parser'!

!PPRepeatingParser methodsFor: 'accessing'!

min
+
+! !
+
+PPDelegateParser subclass: #PPRepeatingParser
+	instanceVariableNames: 'min'
+	category: 'Parser'!
+
+!PPRepeatingParser methodsFor: 'accessing'!
+
+min
 	^min
-
!

min: aNumber
+
+!
+
+min: aNumber
 	min := aNumber
-
! !

!PPRepeatingParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+!PPRepeatingParser methodsFor: 'parsing'!
+
+parse: aStream
 	| start element elements failure |
 	start := aStream position.
 	elements := Array new.
@@ -188,30 +455,75 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 				ifFalse: [elements addLast: element]].
 				elements]
 		ifNotNil: [failure].
-
! !

!PPRepeatingParser class methodsFor: 'instance creation'!

on: aParser min: aNumber
+
+! !
+
+!PPRepeatingParser class methodsFor: 'instance creation'!
+
+on: aParser min: aNumber
 	    ^self new
 		parser: aParser;
 		min: aNumber;
 		yourself
-
! !

Object subclass: #PPFailure
	instanceVariableNames: 'position, reason'
	category: 'Parser'!

!PPFailure methodsFor: 'accessing'!

position
+
+! !
+
+Object subclass: #PPFailure
+	instanceVariableNames: 'position, reason'
+	category: 'Parser'!
+
+!PPFailure methodsFor: 'accessing'!
+
+position
 	^position ifNil: [0]
-
!

position: aNumber
+
+!
+
+position: aNumber
 	position := aNumber
-
!

reason
+
+!
+
+reason
 	^reason ifNil: ['']
-
!

reason: aString
+
+!
+
+reason: aString
 	reason := aString
-
!

reason: aString at: anInteger
+
+!
+
+reason: aString at: anInteger
 	self 
 	    reason: aString; 
 	    position: anInteger
-
! !

!PPFailure methodsFor: 'testing'!

isParseFailure
+
+! !
+
+!PPFailure methodsFor: 'testing'!
+
+isParseFailure
 	^true
-
! !

!PPFailure class methodsFor: 'instance creation'!

reason: aString at: anInteger
+
+! !
+
+!PPFailure class methodsFor: 'instance creation'!
+
+reason: aString at: anInteger
 	    ^self new
 		reason: aString at: anInteger;
 		yourself
-
! !

Object subclass: #SmalltalkParser
	instanceVariableNames: ''
	category: 'Parser'!

!SmalltalkParser methodsFor: 'grammar'!

parser
+
+! !
+
+Object subclass: #SmalltalkParser
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!SmalltalkParser methodsFor: 'grammar'!
+
+parser
 	| method expression separator comment ws identifier keyword className string symbol number literalArray variable reference classReference literal ret methodParser expressionParser keyword unarySelector binarySelector keywordPattern unaryPattern binaryPattern assignment temps blockParamList block expression expressions subexpression statements sequence operand unaryMessage unarySend unaryTail binaryMessage binarySend binaryTail keywordMessage keywordSend keywordPair cascade message jsStatement |
 	
 	separator := (String cr, String space, String lf, String tab) asChoiceParser.
@@ -374,43 +686,134 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 		    yourself].
 	
 	^method, PPEOFParser new ==> [:node | node first]
-
! !

!SmalltalkParser methodsFor: 'parsing'!

parse: aStream
+
+! !
+
+!SmalltalkParser methodsFor: 'parsing'!
+
+parse: aStream
 	^self parser parse: aStream
-
! !

!SmalltalkParser class methodsFor: 'instance creation'!

parse: aStream
+
+! !
+
+!SmalltalkParser class methodsFor: 'instance creation'!
+
+parse: aStream
 	    ^self new
 		parse: aStream
-
! !

Object subclass: #Chunk
	instanceVariableNames: 'contents'
	category: 'Parser'!

!Chunk methodsFor: 'accessing'!

contents
+
+! !
+
+Object subclass: #Chunk
+	instanceVariableNames: 'contents'
+	category: 'Parser'!
+
+!Chunk methodsFor: 'accessing'!
+
+contents
 	^contents ifNil: ['']
-
!

contents: aString
+
+!
+
+contents: aString
 	contents := aString
-
! !

!Chunk methodsFor: 'testing'!

isEmptyChunk
+
+! !
+
+!Chunk methodsFor: 'testing'!
+
+isEmptyChunk
 	^false
-
!

isInstructionChunk
+
+!
+
+isInstructionChunk
 	^false
-
! !

Chunk subclass: #InstructionChunk
	instanceVariableNames: ''
	category: 'Parser'!

!InstructionChunk methodsFor: 'testing'!

isInstructionChunk
+
+! !
+
+Chunk subclass: #InstructionChunk
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!InstructionChunk methodsFor: 'testing'!
+
+isInstructionChunk
 	^true
-
! !

Chunk subclass: #EmptyChunk
	instanceVariableNames: ''
	category: 'Parser'!

!EmptyChunk methodsFor: 'testing'!

isEmptyChunk
+
+! !
+
+Chunk subclass: #EmptyChunk
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!EmptyChunk methodsFor: 'testing'!
+
+isEmptyChunk
 	^true
-
! !

Object subclass: #ChunkParser
	instanceVariableNames: 'parser, separator, eof, ws, chunk, emptyChunk, instructionChunk'
	category: 'Parser'!

!ChunkParser methodsFor: ''!

instructionChunk
+
+! !
+
+Object subclass: #ChunkParser
+	instanceVariableNames: 'parser, separator, eof, ws, chunk, emptyChunk, instructionChunk'
+	category: 'Parser'!
+
+!ChunkParser methodsFor: ''!
+
+instructionChunk
 	^instructionChunk ifNil: [
 	    instructionChunk := self ws, '!' asParser, self chunk
 	    ==> [:node | InstructionChunk new contents: node last contents]]
-
! !

!ChunkParser methodsFor: 'accessing'!

parser
+
+! !
+
+!ChunkParser methodsFor: 'accessing'!
+
+parser
 	^parser ifNil: [
 	    parser := self instructionChunk / self emptyChunk / self chunk / self eof]
-
!

eof
+
+!
+
+eof
 	^eof ifNil: [eof := self ws, PPEOFParser new ==> [:node | nil]]
-
!

separator
+
+!
+
+separator
 	^separator ifNil: [separator := (String cr, String space, String lf, String tab) asChoiceParser]
-
!

ws
+
+!
+
+ws
 	^ws ifNil: [ws := self separator star]
-
!

chunk
+
+!
+
+chunk
 	^chunk ifNil: [chunk := self ws, ('!!' asParser / ('!' asParser not, PPAnyParser new)) plus flatten, '!' asParser ==> [:node | Chunk new contents: (node second replace: '!!' with: '!')]]
-
!

emptyChunk
+
+!
+
+emptyChunk
 	^emptyChunk ifNil: [emptyChunk := self separator plus, '!' asParser, self ws ==> [:node | EmptyChunk new]]
-
! !

Object subclass: #Importer
	instanceVariableNames: 'chunkParser'
	category: 'Parser'!

!Importer methodsFor: 'accessing'!

chunkParser
+
+! !
+
+Object subclass: #Importer
+	instanceVariableNames: 'chunkParser'
+	category: 'Parser'!
+
+!Importer methodsFor: 'accessing'!
+
+chunkParser
 	^chunkParser ifNil: [chunkParser := ChunkParser new parser]
-
! !

!Importer methodsFor: 'fileIn'!

import: aStream
+
+! !
+
+!Importer methodsFor: 'fileIn'!
+
+import: aStream
 	aStream atEnd ifFalse: [
 	    | nextChunk |
 	    nextChunk := self chunkParser parse: aStream.
@@ -420,14 +823,26 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 					 scanFrom: aStream]
 		    ifFalse: [Compiler new loadExpression: nextChunk contents].
 		self import: aStream]]
-
! !

Object subclass: #Exporter
	instanceVariableNames: ''
	category: 'Parser'!

!Exporter methodsFor: 'fileOut'!

exportCategory: aString
+
+! !
+
+Object subclass: #Exporter
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!Exporter methodsFor: 'fileOut'!
+
+exportCategory: aString
 	| stream |
 	stream := '' writeStream.
 	(Smalltalk current classes 
 	    select: [:each | each category = aString])
 	    do: [:each | stream nextPutAll: (self export: each)].
 	self exportCategoryExtensions: aString on: stream.
-	^stream contents
!

export: aClass
+	^stream contents
+!
+
+export: aClass
 	| stream |
 	stream := '' writeStream.
 	self exportDefinitionOf: aClass on: stream.
@@ -435,7 +850,12 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 	self exportMetaDefinitionOf: aClass on: stream.
 	self exportMethodsOf: aClass class on: stream.
 	^stream contents
-
! !

!Exporter methodsFor: 'private'!

exportDefinitionOf: aClass on: aStream
+
+! !
+
+!Exporter methodsFor: 'private'!
+
+exportDefinitionOf: aClass on: aStream
 	aStream 
 	    nextPutAll: 'smalltalk.addClass(';
 	    nextPutAll: '''', (self classNameFor: aClass), ''', ';
@@ -450,13 +870,16 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 	    nextPutAll: ');'.
 	aClass comment notEmpty ifTrue: [
 	    aStream 
-	    	nextPutAll: String cr;
+	    	lf;
 		nextPutAll: 'smalltalk.';
 		nextPutAll: (self classNameFor: aClass);
 		nextPutAll: '.comment=';
 		nextPutAll: 'unescape(''', aClass comment escaped, ''')'].
-	aStream cr
-
!

exportMetaDefinitionOf: aClass on: aStream
+	aStream lf
+
+!
+
+exportMetaDefinitionOf: aClass on: aStream
 	aClass class instanceVariableNames isEmpty ifFalse: [
 	    aStream 
 		nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
@@ -464,42 +887,63 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 	    aClass class instanceVariableNames
 		do: [:each | aStream nextPutAll: '''', each, '''']
 		separatedBy: [aStream nextPutAll: ','].
-	    aStream nextPutAll: '];', String cr]
-
!

exportMethodsOf: aClass on: aStream
+	    aStream nextPutAll: '];', String lf]
+
+!
+
+exportMethodsOf: aClass on: aStream
 	aClass methodDictionary values do: [:each |
 		(each category match: '^\*') ifFalse: [
 			self exportMethod: each of: aClass on: aStream]].
-	aStream cr
!

classNameFor: aClass
+	aStream lf
+!
+
+classNameFor: aClass
 	^aClass isMetaclass
 	    ifTrue: [aClass instanceClass name, '.klass']
 	    ifFalse: [
 		aClass isNil
 		    ifTrue: ['nil']
 		    ifFalse: [aClass name]]
-
!

exportMethod: aMethod of: aClass on: aStream
+
+!
+
+exportMethod: aMethod of: aClass on: aStream
 	aStream 
-		nextPutAll: 'smalltalk.addMethod(', String cr;
-		nextPutAll: '''', aMethod selector asSelector, ''',', String cr;
-		nextPutAll: 'smalltalk.method({', String cr;
-		nextPutAll: 'selector: ''', aMethod selector, ''',', String cr;
-		nextPutAll: 'category: ''', aMethod category, ''',', String cr;
-		nextPutAll: 'fn: ', aMethod fn compiledSource, ',', String cr;
-		nextPutAll: 'source: unescape(''', aMethod source escaped, '''),', String cr;
-		nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',', String cr;
+		nextPutAll: 'smalltalk.addMethod(';lf;
+		nextPutAll: '''', aMethod selector asSelector, ''',';lf;
+		nextPutAll: 'smalltalk.method({';lf;
+		nextPutAll: 'selector: ''', aMethod selector, ''',';lf;
+		nextPutAll: 'category: ''', aMethod category, ''',';lf;
+		nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
+		nextPutAll: 'source: unescape(''', aMethod source escaped, '''),';lf;
+		nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
 		nextPutAll: 'referencedClasses: ['.
 	    		aMethod referencedClasses 
 				do: [:each | aStream nextPutAll: 'smalltalk.', (self classNameFor: each)]
 				separatedBy: [aStream nextPutAll: ','].
 	aStream
-		nextPutAll: ']', String cr;
-		nextPutAll: '}),', String cr;
+		nextPutAll: ']';lf;
+		nextPutAll: '}),';lf;
 		nextPutAll: 'smalltalk.', (self classNameFor: aClass);
-		nextPutAll: ');', String cr, String cr
!
+		nextPutAll: ');';lf;lf
+!
+
+
 exportCategoryExtensions: aString on: aStream
 	Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
 		each methodDictionary values do: [:method |
 			method category = ('*', aString) ifTrue: [
-				self exportMethod: method of: each on: aStream]]]
! !

Exporter subclass: #ChunkExporter
	instanceVariableNames: ''
	category: 'Parser'!

!ChunkExporter methodsFor: 'not yet classified'!

exportDefinitionOf: aClass on: aStream
+				self exportMethod: method of: each on: aStream]]]
+! !
+
+Exporter subclass: #ChunkExporter
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!ChunkExporter methodsFor: 'not yet classified'!
+
+exportDefinitionOf: aClass on: aStream
 	"Chunk format."
 
 	aStream 
@@ -517,10 +961,17 @@ exportCategoryExtensions: aString on: aStream
 		nextPutAll: '!', (self classNameFor: aClass), ' commentStamp!';lf;
 		nextPutAll: aClass comment escaped, '!';lf].
 	aStream lf
-
!

exportMethod: aMethod of: aClass on: aStream
+
+!
+
+exportMethod: aMethod of: aClass on: aStream
 	aStream 
 		lf; lf; nextPutAll: aMethod source; lf;
-		nextPutAll: '!'
!

exportMethodsOf: aClass on: aStream
+		nextPutAll: '!'
+!
+
+exportMethodsOf: aClass on: aStream
+
     | methodsByCategory |
     methodsByCategory := Dictionary new.
     aClass methodDictionary values do: [:m |
@@ -532,7 +983,10 @@ exportCategoryExtensions: aString on: aStream
 		nextPutAll: ' methodsFor: ''', category, '''!'.
     	(methodsByCategory at: category) do: [:each |
 		self exportMethod: each of: aClass on: aStream].
-	aStream nextPutAll: ' !'; lf; lf]
!

exportMetaDefinitionOf: aClass on: aStream
+	aStream nextPutAll: ' !'; lf; lf]
+!
+
+exportMetaDefinitionOf: aClass on: aStream
 
 	aClass class instanceVariableNames isEmpty ifFalse: [
 		aStream 
@@ -542,10 +996,15 @@ exportCategoryExtensions: aString on: aStream
 		    do: [:each | aStream nextPutAll: each]
 		    separatedBy: [aStream nextPutAll: ', '].
 		aStream	
-		    nextPutAll: '''!'; lf; lf]
!

classNameFor: aClass
+		    nextPutAll: '''!'; lf; lf]
+!
+
+classNameFor: aClass
 	^aClass isMetaclass
 	    ifTrue: [aClass instanceClass name, ' class']
 	    ifFalse: [
 		aClass isNil
 		    ifTrue: ['nil']
-		    ifFalse: [aClass name]]
! !
+		    ifFalse: [aClass name]]
+! !
+

st/SUnit.st

@@ -1,13 +1,44 @@
-Object subclass: #TestCase
	instanceVariableNames: 'testedClass'
	category: 'SUnit'!

!TestCase methodsFor: 'accessing'!

testedClass
-	^testedClass
!

testedClass: aClass
-	testedClass := aClass
! !

!TestCase methodsFor: 'private'!

cleanUpInstanceVariables
+Object subclass: #TestCase
+	instanceVariableNames: 'testedClass'
+	category: 'SUnit'!
+
+!TestCase methodsFor: 'accessing'!
+
+testedClass
+	^testedClass
+!
+
+testedClass: aClass
+	testedClass := aClass
+! !
+
+!TestCase methodsFor: 'private'!
+
+cleanUpInstanceVariables
 	self class instanceVariableNames do: [ :name |
 		name = 'testSelector' ifFalse: [
-			self instVarAt: name put: nil ]]
!

signalFailure: aString
+			self instVarAt: name put: nil ]]
+!
+
+signalFailure: aString
 	TestFailure new
 		messageText: aString;
-		signal
! !

!TestCase methodsFor: 'running'!

setUp
!

tearDown
!

methods
-	^self class methodDictionary keys select: [:each | each match: '^test']
!

runCaseFor: aTestResult
+		signal
+! !
+
+!TestCase methodsFor: 'running'!
+
+setUp
+!
+
+tearDown
+!
+
+methods
+	^self class methodDictionary keys select: [:each | each match: '^test']
+!
+
+runCaseFor: aTestResult
 	[self setUp.
 	self performTestFor: aTestResult]
 		on: Error
@@ -16,74 +47,182 @@ Object subclass: #TestCase
	instanceVariableNames: 'testedClass'
	category: 'SUn
 			self cleanUpInstanceVariables.
 			ex signal].
 	self tearDown.
-	self cleanUpInstanceVariables
!

performTestFor: aResult
+	self cleanUpInstanceVariables
+!
+
+performTestFor: aResult
 	self methods do: [:each | 
 		[[self perform: each]
 			on: TestFailure do: [:ex | aResult addFailure: self class name, '>>', each]]
 			on: Error do: [:ex | aResult addError: self class name, '>>', each].
-		aResult increaseRuns]
! !

!TestCase methodsFor: 'testing'!

assert: aBoolean
-	aBoolean ifFalse: [self signalFailure: 'Assertion failed']
!

deny: aBoolean
-	self assert: aBoolean not
! !

TestCase subclass: #ExampleTest
	instanceVariableNames: 'test'
	category: 'SUnit'!

!ExampleTest methodsFor: 'not yet classified'!

testFailure
+		aResult increaseRuns]
+! !
+
+!TestCase methodsFor: 'testing'!
+
+assert: aBoolean
+	aBoolean ifFalse: [self signalFailure: 'Assertion failed']
+!
+
+deny: aBoolean
+	self assert: aBoolean not
+! !
+
+TestCase subclass: #ExampleTest
+	instanceVariableNames: 'test'
+	category: 'SUnit'!
+
+!ExampleTest methodsFor: 'not yet classified'!
+
+testFailure
 	self deny: true
-	
!

testPasses
-	100000 timesRepeat: [self assert: 1 + 1 = 2]
!

testError
-	self assert: 1 foo
! !

TabWidget subclass: #ProgressBar
	instanceVariableNames: 'percent, progressDiv'
	category: 'SUnit'!

!ProgressBar methodsFor: 'accessing'!

percent
-	^percent ifNil: [0]
!

percent: aNumber
-	percent := aNumber
! !

!ProgressBar methodsFor: 'rendering'!

renderOn: html 
+	
+!
+
+testPasses
+	100000 timesRepeat: [self assert: 1 + 1 = 2]
+!
+
+testError
+	self assert: 1 foo
+! !
+
+TabWidget subclass: #ProgressBar
+	instanceVariableNames: 'percent, progressDiv'
+	category: 'SUnit'!
+
+!ProgressBar methodsFor: 'accessing'!
+
+percent
+	^percent ifNil: [0]
+!
+
+percent: aNumber
+	percent := aNumber
+! !
+
+!ProgressBar methodsFor: 'rendering'!
+
+renderOn: html 
 	html div 
 		class: 'progress_bar';
 		with: [
 			html div 
 				class: 'progress';
-				style: 'width:', self percent asString, '%']
! !

!ProgressBar methodsFor: 'updating'!

updatePercent: aNumber
+				style: 'width:', self percent asString, '%']
+! !
+
+!ProgressBar methodsFor: 'updating'!
+
+updatePercent: aNumber
 	self percent: aNumber.
-	self update
! !

Error subclass: #TestFailure
	instanceVariableNames: ''
	category: 'SUnit'!

TabWidget subclass: #TestRunner
	instanceVariableNames: 'selectedCategories, categoriesList, selectedClasses, classesList, selectedMethods, progressBar, methodsList, result, statusDiv'
	category: 'SUnit'!

!TestRunner methodsFor: 'accessing'!

label
+	self update
+! !
+
+Error subclass: #TestFailure
+	instanceVariableNames: ''
+	category: 'SUnit'!
+
+TabWidget subclass: #TestRunner
+	instanceVariableNames: 'selectedCategories, categoriesList, selectedClasses, classesList, selectedMethods, progressBar, methodsList, result, statusDiv'
+	category: 'SUnit'!
+
+!TestRunner methodsFor: 'accessing'!
+
+label
     ^'[Test runner]'
-
!

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

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

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

allClasses
-	^TestCase allSubclasses
!

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

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

selectedMethods
+	sort: [:a :b | a name > b name]
+!
+
+selectedCategories
+	^selectedCategories ifNil: [selectedCategories := Array new]
+!
+
+allClasses
+	^TestCase allSubclasses
+!
+
+selectedClasses
+	^selectedClasses  ifNil: [selectedClasses := Array new]
+!
+
+progressBar
+	^progressBar ifNil: [progressBar := ProgressBar new]
+!
+
+selectedMethods
 	^selectedMethods ifNil: [self selectedClasses collect: [:each |
-		each methodDictionary keys select: [:key |  key beginsWith: 'test' ]]]
!

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

result
-	^result
!

failedMethods
+		each methodDictionary keys select: [:key |  key beginsWith: 'test' ]]]
+!
+
+statusInfo
+	^self printTotal, self printPasses, self printErrors, self printFailures
+!
+
+result
+	^result
+!
+
+failedMethods
 	self result failures collect: [:each |
 		html li 
 			class: 'failures';
-			with: each]
! !

!TestRunner methodsFor: 'actions'!

selectAllCategories
+			with: each]
+! !
+
+!TestRunner methodsFor: 'actions'!
+
+selectAllCategories
 	self categories do: [:each | 
 		(selectedCategories includes: each) ifFalse: [
 			self selectedCategories add: each]].
 	self 
 	    updateCategoriesList;
-	    updateClassesList
!

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

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

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

run: aCollection
+	    updateClassesList
+!
+
+run: aCollection
 	result := TestResult new.
 	self 
 		updateStatusDiv;
@@ -94,42 +233,100 @@ Object subclass: #TestCase
	instanceVariableNames: 'testedClass'
	category: 'SUn
 		[each runCaseFor: result.
 		self progressBar updatePercent: result runs / result total * 100.
 		self updateStatusDiv.
-		self updateMethodsList] valueWithTimeout: 100].
! !

!TestRunner methodsFor: 'initialization'!

initialize
+		self updateMethodsList] valueWithTimeout: 100].
+! !
+
+!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 total) - (self result errors size + (self result failures size))) asString) , ' passes, '
!

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

!TestRunner methodsFor: 'rendering'!

renderBoxOn: html
+	result := TestResult new
+! !
+
+!TestRunner methodsFor: 'printing'!
+
+printErrors
+	^self result errors size asString , ' errors, '
+!
+
+printFailures
+	^self result failures size asString, ' failures'
+!
+
+printPasses
+	^(((self result total) - (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
+	renderResultsOn: html
+!
+
+renderButtonsOn: html
     html button
 	with: 'Run selected';
 	onClick: [self run: (self selectedClasses collect: [:each | each new])]
-
!

renderCategoriesOn: html
+
+!
+
+renderCategoriesOn: html
     	categoriesList := html ul class: 'jt_column sunit categories'.
-	self updateCategoriesList
!

renderClassesOn: html
+	self updateCategoriesList
+!
+
+renderClassesOn: html
     	classesList := html ul class: 'jt_column sunit classes'.
-	self updateClassesList
!

renderResultsOn: html
+	self updateClassesList
+!
+
+renderResultsOn: html
     	statusDiv := html div.
 	html with: self progressBar.
    	methodsList := html ul class: 'jt_column sunit methods'.
 	self updateMethodsList.
-	self updateStatusDiv
!

renderFailuresOn: html
+	self updateStatusDiv
+!
+
+renderFailuresOn: html
 	self result failures do: [:each |
 		html li 
 			class: 'failures';
-			with: each]
!

renderErrorsOn: html
+			with: each]
+!
+
+renderErrorsOn: html
 	self result errors do: [:each |
 		html li 
 			class: 'errors';
-			with: each]
! !

!TestRunner methodsFor: 'testing'!

canBeClosed
+			with: each]
+! !
+
+!TestRunner methodsFor: 'testing'!
+
+canBeClosed
     ^true
-
!

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

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

!TestRunner methodsFor: 'updating'!

updateCategoriesList
+
+!
+
+isSelectedClass: aClass
+	^(self selectedClasses includes: aClass)
+!
+
+isSelectedCategory: aCategory
+	^(self selectedCategories includes: aCategory)
+! !
+
+!TestRunner methodsFor: 'updating'!
+
+updateCategoriesList
     categoriesList contents: [:html |
 	    html li 
 		class: 'all';
@@ -141,7 +338,10 @@ Object subclass: #TestCase
	instanceVariableNames: 'testedClass'
	category: 'SUn
 		li class: 'selected'].
 	    li
 		with: each;
-		onClick: [self toggleCategory: each]]]
!

updateClassesList
+		onClick: [self toggleCategory: each]]]
+!
+
+updateClassesList
     classesList contents: [:html |
 	(self selectedCategories isEmpty) ifFalse: [
 		html li
@@ -154,33 +354,100 @@ Object subclass: #TestCase
	instanceVariableNames: 'testedClass'
	category: 'SUn
 			li class: 'selected'].
 		li
 			with: each name;
-			onClick: [self toggleClass: each]]]
!

updateMethodsList
+			onClick: [self toggleClass: each]]]
+!
+
+updateMethodsList
 	methodsList contents: [:html |
 		self renderFailuresOn: html.
-                self renderErrorsOn: html]
!

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

Object subclass: #TestResult
	instanceVariableNames: 'timestamp, runs, errors, failures, total'
	category: 'SUnit'!

!TestResult methodsFor: 'accessing'!

timestamp
-	^timestamp
!

errors
-	^errors
!

failures
-	^failures
!

total
-	^total
!

total: aNumber
-	total := aNumber
!

addError: anError
-	self errors add: anError
!

addFailure: aFailure
-	self failures add: aFailure
!

runs
-	^runs
!

increaseRuns
-	runs := runs + 1
!

status
+		html span with: self statusInfo]
+! !
+
+Object subclass: #TestResult
+	instanceVariableNames: 'timestamp, runs, errors, failures, total'
+	category: 'SUnit'!
+
+!TestResult methodsFor: 'accessing'!
+
+timestamp
+	^timestamp
+!
+
+errors
+	^errors
+!
+
+failures
+	^failures
+!
+
+total
+	^total
+!
+
+total: aNumber
+	total := aNumber
+!
+
+addError: anError
+	self errors add: anError
+!
+
+addFailure: aFailure
+	self failures add: aFailure
+!
+
+runs
+	^runs
+!
+
+increaseRuns
+	runs := runs + 1
+!
+
+status
 	^self errors isEmpty 
 		ifTrue: [
 			self failures isEmpty 
 				ifTrue: ['success']
 				ifFalse: ['failure']]
-		ifFalse: ['error']
! !

!TestResult methodsFor: 'initialization'!

initialize
+		ifFalse: ['error']
+! !
+
+!TestResult methodsFor: 'initialization'!
+
+initialize
 	super initialize.
 	timestamp := Date now.
 	runs := 0.
 	errors := Array new.
 	failures := Array new.
-	total := 0
! !

TestCase subclass: #ExampleTest2
	instanceVariableNames: ''
	category: 'SUnit'!

!ExampleTest2 methodsFor: 'not yet classified'!

testPasses
-	100000 timesRepeat: [self assert: 1 + 1 = 2]
! !

TestCase subclass: #ExampleTest3
	instanceVariableNames: ''
	category: 'SUnit'!

!ExampleTest3 methodsFor: 'not yet classified'!

testPasses
-	100000 timesRepeat: [self assert: 1 + 1 = 2]
! !
+	total := 0
+! !
+
+TestCase subclass: #ExampleTest2
+	instanceVariableNames: ''
+	category: 'SUnit'!
+
+!ExampleTest2 methodsFor: 'not yet classified'!
+
+testPasses
+	100000 timesRepeat: [self assert: 1 + 1 = 2]
+! !
+
+TestCase subclass: #ExampleTest3
+	instanceVariableNames: ''
+	category: 'SUnit'!
+
+!ExampleTest3 methodsFor: 'not yet classified'!
+
+testPasses
+	100000 timesRepeat: [self assert: 1 + 1 = 2]
+! !
+