1
0
ソースを参照

Fixed cr lf confusion, hopefully almost everywhere.

Göran Krampe 13 年 前
コミット
290e53867d
12 ファイル変更3686 行追加785 行削除
  1. 6 6
      js/Compiler.js
  2. 6 6
      js/IDE.js
  3. 4 4
      js/Kernel.js
  4. 10 22
      js/Parser.js
  5. 441 94
      st/Canvas.st
  6. 517 109
      st/Compiler.st
  7. 266 51
      st/Examples.st
  8. 568 123
      st/IDE.st
  9. 259 57
      st/JQuery.st
  10. 717 147
      st/Kernel.st
  11. 560 101
      st/Parser.st
  12. 332 65
      st/SUnit.st

ファイルの差分が大きいため隠しています
+ 6 - 6
js/Compiler.js


+ 6 - 6
js/IDE.js

@@ -518,13 +518,13 @@ var self=this;
 try{var lines=nil;
 try{var lines=nil;
 var startLine=nil;
 var startLine=nil;
 var endLine=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);
 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}})})();})]);})]);
 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;
 return self;
 } catch(e) {if(e.name === 'stReturn' && e.selector === '_currentLine'){return e.fn()} throw(e)}},
 } 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]
 referencedClasses: [smalltalk.String]
 }),
 }),
 smalltalk.Workspace);
 smalltalk.Workspace);
@@ -1061,11 +1061,11 @@ fn: function (){
 var self=this;
 var self=this;
 var stream=nil;
 var stream=nil;
 stream=smalltalk.send("", "_writeStream", []);
 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 smalltalk.send(stream, "_contents", []);
 return self;},
 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]
 referencedClasses: [smalltalk.String]
 }),
 }),
 smalltalk.Browser);
 smalltalk.Browser);

+ 4 - 4
js/Kernel.js

@@ -4283,9 +4283,9 @@ selector: 'cr',
 category: 'accessing',
 category: 'accessing',
 fn: function (){
 fn: function (){
 var self=this;
 var self=this;
-return '\n';;
+return '\r';;
 return self;},
 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: [],
 messageSends: [],
 referencedClasses: []
 referencedClasses: []
 }),
 }),
@@ -4298,9 +4298,9 @@ selector: 'lf',
 category: 'accessing',
 category: 'accessing',
 fn: function (){
 fn: function (){
 var self=this;
 var self=this;
-return '\r';;
+return '\n';;
 return self;},
 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: [],
 messageSends: [],
 referencedClasses: []
 referencedClasses: []
 }),
 }),

ファイルの差分が大きいため隠しています
+ 10 - 22
js/Parser.js


+ 441 - 94
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
     aJQuery appendElement: root element
-
! !

!HTMLCanvas methodsFor: 'accessing'!

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

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

!HTMLCanvas methodsFor: 'adding'!

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

!HTMLCanvas methodsFor: 'initialization'!

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

!HTMLCanvas methodsFor: 'tags'!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

canvas
+
+!
+
+canvas
 	^self tag: '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
     ^element
-
! !

!TagBrush methodsFor: 'adding'!

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

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

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

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

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

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

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

appendString: aString
+
+!
+
+appendString: aString
     self appendChild: (self createTextNodeFor: 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)'}
     {'self[''@element''].setAttribute(aString, aValue)'}
-
!

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

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

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

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

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

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

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

!TagBrush methodsFor: 'converting'!

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

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

!TagBrush methodsFor: 'events'!

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

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

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

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

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

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

onClick: aBlock
+
+!
+
+onClick: aBlock
     self asJQuery on: 'click' do: 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.
     element := self createElementFor: aString.
     canvas := aCanvas
     canvas := aCanvas
-
! !

!TagBrush methodsFor: 'private'!

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

createTextNodeFor: aString
+
+!
+
+createTextNodeFor: aString
 	{'return document.createTextNode(String(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
     ^self new
 	initializeFromString: aString canvas: aCanvas;
 	initializeFromString: aString canvas: aCanvas;
 	yourself
 	yourself
-
! !

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

!Widget methodsFor: 'accessing'!

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

!Widget methodsFor: 'actions'!

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

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

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

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

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

!Widget methodsFor: 'adding'!

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

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

!Widget methodsFor: 'rendering'!

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

renderOn: html
+
+!
+
+renderOn: html
     self
     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
 	^self new
 		initializeWithCanvas: aCanvas;
 		initializeWithCanvas: aCanvas;
-		yourself
! !



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

appendToBrush: aTagBrush
-    aTagBrush appendBlock: self
!

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

+ 517 - 109
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]
 	^nodes ifNil: [nodes := Array new]
-
!

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

!Node methodsFor: 'building'!

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

!Node methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!Node methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitNode: self
 	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
-
!

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

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

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

source
+
+!
+
+source
 	^source
 	^source
-
!

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

!MethodNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!MethodNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitMethodNode: self
 	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
-
!

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

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

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

receiver
+
+!
+
+receiver
 	^receiver
 	^receiver
-
!

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

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

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

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

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

!SendNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!SendNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitSendNode: self
 	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
-
!

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

!CascadeNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!CascadeNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitCascadeNode: self
 	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
-
!

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

right
+
+!
+
+right
 	^right
 	^right
-
!

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

!AssignmentNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!AssignmentNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitAssignmentNode: self
 	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 ifNil: [parameters := Array new]
-
!

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

!BlockNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!BlockNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitBlockNode: self
 	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 ifNil: [#()]
-
!

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

!SequenceNode methodsFor: 'testing'!

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

!SequenceNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!SequenceNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitSequenceNode: self
 	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
 	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
 	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
-
!

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

!ValueNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!ValueNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitValueNode: self
 	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
 	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
 	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 ifNil: ['']
-
!

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

!JSStatementNode methodsFor: 'visiting'!

accept: aVisitor
+
+! !
+
+!JSStatementNode methodsFor: 'visiting'!
+
+accept: aVisitor
 	aVisitor visitJSStatementNode: self
 	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
 	aNode accept: self
-
!

visitNode: aNode
-
!

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

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

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

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

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

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

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

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

visitVariableNode: aNode
-
!

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

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

visitJSStatementNode: aNode
+
+!
+
+visitJSStatementNode: aNode
 	self 
 	self 
 	    nextPutAll: 'function(){';
 	    nextPutAll: 'function(){';
 	    nextPutAll: aNode source;
 	    nextPutAll: aNode source;
 	    nextPutAll: '})()'
 	    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
 	^SmalltalkParser new
-
!

currentClass
+
+!
+
+currentClass
 	^currentClass
 	^currentClass
-
!

currentClass: aClass
+
+!
+
+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 
 	^self pseudoVariables 
 		addAll: self tempVariables;
 		addAll: self tempVariables;
-		yourself
!

classNameFor: aClass
+		yourself
+!
+
+classNameFor: aClass
 	^aClass isMetaclass
 	^aClass isMetaclass
 	    ifTrue: [aClass instanceClass name, '.klass']
 	    ifTrue: [aClass instanceClass name, '.klass']
 	    ifFalse: [
 	    ifFalse: [
 		aClass isNil
 		aClass isNil
 		    ifTrue: ['nil']
 		    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 addCompiledMethod: (self eval: (self compileExpression: aString)).
 	^DoIt new doIt
 	^DoIt new doIt
-
!

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

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

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

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

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

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

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

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

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

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

!Compiler methodsFor: 'initialization'!

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

!Compiler methodsFor: 'visiting'!

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

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

!
 	unknownVariables := #().
 	unknownVariables := #().
 	tempVariables := #().
 	tempVariables := #().
 	stream 
 	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: [
 	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('.
 	stream nextPutAll: 'fn: function('.
 	aNode arguments 
 	aNode arguments 
 	    do: [:each | 
 	    do: [:each | 
@@ -212,8 +570,8 @@ Object subclass: #Node
	instanceVariableNames: 'nodes'
	category: 'Compiler'!

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

!
 	str nextPutAll: stream contents.
 	str nextPutAll: stream contents.
 	stream := str.
 	stream := str.
 	stream 
 	stream 
-	    nextPutAll: String cr; 
+	    lf; 
 	    nextPutAll: 'return self;'.
 	    nextPutAll: 'return self;'.
 	earlyReturn ifTrue: [
 	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: '}'.
 	stream nextPutAll: '}'.
 	Smalltalk current debugMode ifTrue: [
 	Smalltalk current debugMode ifTrue: [
 		stream 
 		stream 
-			nextPutAll: ',', String cr, 'messageSends: ';
-			nextPutAll: messageSends asJavascript, ',', String cr;
+			nextPutAll: ',', String lf, 'messageSends: ';
+			nextPutAll: messageSends asJavascript, ','; lf;
 			nextPutAll: 'referencedClasses: ['.
 			nextPutAll: 'referencedClasses: ['.
 		referencedClasses 
 		referencedClasses 
 			do: [:each | stream nextPutAll: each]
 			do: [:each | stream nextPutAll: each]
 			separatedBy: [stream nextPutAll: ','].
 			separatedBy: [stream nextPutAll: ','].
 		stream nextPutAll: ']'].
 		stream nextPutAll: ']'].
-	stream nextPutAll: '})'
!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

visitVariableNode: aNode
+	stream nextPutAll: klass
+!
+
+visitVariableNode: aNode
 	(self currentClass instanceVariableNames includes: aNode value) 
 	(self currentClass instanceVariableNames includes: aNode value) 
 		ifTrue: [stream nextPutAll: 'self[''@', aNode value, ''']']
 		ifTrue: [stream nextPutAll: 'self[''@', aNode value, ''']']
 		ifFalse: [
 		ifFalse: [
 			(self knownVariables includes: aNode value) ifFalse: [
 			(self knownVariables includes: aNode value) ifFalse: [
 				unknownVariables add: aNode value].
 				unknownVariables add: aNode value].
 			stream nextPutAll: 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 |
 	aClass methodDictionary do: [:each || method |
 		method := self new load: each source forClass: aClass.
 		method := self new load: each source forClass: aClass.
 		method category: each category.
 		method category: each category.
 		aClass addCompiledMethod: method].
 		aClass addCompiledMethod: method].
-	aClass isMetaclass ifFalse: [self recompile: aClass class]
!

recompileAll
+	aClass isMetaclass ifFalse: [self recompile: aClass class]
+!
+
+recompileAll
 	Smalltalk current classes do: [:each |
 	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
+! !
+

+ 266 - 51
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.
     count := count + 1.
-    header contents: [:html | html with: count asString]
!

decrease
+    header contents: [:html | html with: count asString]
+!
+
+decrease
     count := count - 1.
     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.
     super initialize.
     count := 0
     count := 0
-
! !

!Counter methodsFor: 'rendering'!

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

rows
+	
+!
+
+rows
 	"An array of rows. Each row is a collection of points."
 	"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.
 	self newGame.
 	timer ifNotNil: [timer clearInterval].
 	timer ifNotNil: [timer clearInterval].
-	timer := [self nextStep] valueWithInterval: speed
!

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

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

drawMap
+		drawPiece
+!
+
+drawMap
 	renderingContext 
 	renderingContext 
 		fillStyle: '#fafafa';
 		fillStyle: '#fafafa';
 		fillRectFrom: 0@0 to: self width@self height.
 		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].
 		self drawLineFrom: x@0 to: x@self height].
 	0 to: self class squares y do: [:each | | y |
 	0 to: self class squares y do: [:each | | y |
 		y := each * self class squareSize.
 		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 
 	renderingContext 
 		beginPath;
 		beginPath;
 		moveTo: aPoint;
 		moveTo: aPoint;
 		lineTo: anotherPoint;
 		lineTo: anotherPoint;
-		stroke
!

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

newPiece
-	movingPiece := TetrisPiece atRandom
!

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

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

!Tetris methodsFor: 'initialization'!

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

!Tetris methodsFor: 'rendering'!

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

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

renderButtonsOn: html
+	self redraw
+!
+
+renderButtonsOn: html
 	html div 
 	html div 
 		class: 'tetris_buttons';
 		class: 'tetris_buttons';
 		with: [
 		with: [
@@ -85,62 +173,189 @@ Widget subclass: #Counter
	instanceVariableNames: 'count, header'
	category: 'Ex
 				onClick: [self startNewGame].
 				onClick: [self startNewGame].
 			html button
 			html button
 				with: 'play/pause';
 				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.
 	aRenderingContext fillStyle: self color.
 	self bounds do: [:each |
 	self bounds do: [:each |
 		aRenderingContext 
 		aRenderingContext 
 			fillRectFrom: each + self position* Tetris squareSize to: 1@1 * Tetris squareSize;
 			fillRectFrom: each + self position* Tetris squareSize to: 1@1 * Tetris squareSize;
 			strokeStyle: '#999';
 			strokeStyle: '#999';
 			lineWidth: 2;
 			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
 	^Array new
 		add: 0@0;
 		add: 0@0;
 		add: 0@1;
 		add: 0@1;
 		add: 1@0;
 		add: 1@0;
 		add: 1@1;
 		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
 	^Array new
 		add: 0@0;
 		add: 0@0;
 		add: 0@1;
 		add: 0@1;
 		add: 0@2;
 		add: 0@2;
 		add: 1@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
 	^Array new
 		add: 1@0;
 		add: 1@0;
 		add: 1@1;
 		add: 1@1;
 		add: 1@2;
 		add: 1@2;
 		add: 0@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
 	^Array new
 		add: 0@0;
 		add: 0@0;
 		add: 0@1;
 		add: 0@1;
 		add: 0@2;
 		add: 0@2;
 		add: 0@3;
 		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
 	^Array new
 		add: 0@0;
 		add: 0@0;
 		add: 1@0;
 		add: 1@0;
 		add: 2@0;
 		add: 2@0;
 		add: 1@1;
 		add: 1@1;
-		yourself
!

color
-	^'#aaf'
! !

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

ファイルの差分が大きいため隠しています
+ 568 - 123
st/IDE.st


+ 259 - 57
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."
     "Append anObject at the end of the element."
     anObject appendToJQuery: self
     anObject appendToJQuery: self
-
!

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

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

contents: anObject
+
+!
+
+contents: anObject
     self empty.
     self empty.
     self append: anObject
     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."
     "Remove an attribute from each element in the set of matched elements."
     ^self call: 'removeAttribute' withArgument: aString
     ^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."
     "Get the value of an attribute for the first element in the set of matched elements."
     ^self call: 'attr' withArgument: aString
     ^self call: 'attr' withArgument: aString
-
!

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

val: aString
+
+!
+
+val: aString
     self call: 'val' withArgument: 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)'}
     {'self[''@jquery''].css(aString, anotherString)'}
-
!

addClass: aString
+
+!
+
+addClass: aString
     "Adds the specified class(es) to each of the set of matched elements."
     "Adds the specified class(es) to each of the set of matched elements."
     self call: 'addClass' withArgument: aString
     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."
     "Remove a single class, multiple classes, or all classes from each element in the set of matched elements."
     self call: 'removeClass' withArgument: aString
     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."
     "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
     self call: 'toggleClass' withArgument: aString
-
!

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

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

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

width
+
+!
+
+width
     "Get the current computed width for the first element in the set of matched elements."
     "Get the current computed width for the first element in the set of matched elements."
     ^self call: 'width'
     ^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."
     "Get the current computed height for the first element in the set of matched elements, including padding but not border."
     ^self call: 'innerHeight'
     ^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."
     "Get the current computed width for the first element in the set of matched elements, including padding but not border."
     ^self call: 'innerWidth'
     ^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."
     "Get the current computed height for the first element in the set of matched elements, including padding, border, and optionally margin."
     ^self call: 'outerHeight'
     ^self call: 'outerHeight'
-
!

outerWidth
+
+!
+
+outerWidth
     "Get the current computed width for the first element in the set of matched elements, including padding and border."
     "Get the current computed width for the first element in the set of matched elements, including padding and border."
     ^self call: 'outerWidth'
     ^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."
     "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'
     ^(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."
     "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'
     ^(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."
     "Get the current coordinates of the first element in the set of matched elements, relative to the document."
     ^(self call: 'offset') basicAt: 'left'
     ^(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."
     "Get the current coordinates of the first element in the set of matched elements, relative to the document."
     ^(self call: 'offset') basicAt: 'top'
     ^(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."
     "Get the current horizontal position of the scroll bar for the first element in the set of matched elements."
     ^self call: 'scrollLeft'
     ^self call: 'scrollLeft'
-
!

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

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

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

!JQuery methodsFor: 'events'!

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

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

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

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

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

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

!JQuery methodsFor: 'initialization'!

initializeWithJQueryObject: anObject
+
+! !
+
+!JQuery methodsFor: 'initialization'!
+
+initializeWithJQueryObject: anObject
     jquery := 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."
     "Determine whether any of the matched elements are assigned the given class."
     ^self call: 'hasClass' withArgument: aString
     ^self call: 'hasClass' withArgument: aString
-
! !

!JQuery class methodsFor: 'instance creation'!

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

from: anObject
+
+!
+
+from: anObject
     ^self new
     ^self new
 	initializeWithJQueryObject: anObject;
 	initializeWithJQueryObject: anObject;
 	yourself
 	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]
     ^settings at: aKey ifAbsent: [nil]
-
!

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

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

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

!Ajax methodsFor: 'actions'!

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

!Ajax methodsFor: 'initialization'!

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

!Ajax class methodsFor: 'instance creation'!

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



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

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

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

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

ファイルの差分が大きいため隠しています
+ 717 - 147
st/Kernel.st


+ 560 - 101
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
 	^memo
-
! !

!PPParser methodsFor: 'initialization'!

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

!PPParser methodsFor: 'operations'!

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

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

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

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

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

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

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

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

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

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

!PPParser methodsFor: 'parsing'!

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

parseAll: aStream
+
+!
+
+parseAll: aStream
 	| result |
 	| result |
 	result := (PPSequenceParser with: self with: PPEOFParser new) memoizedParse: aStream.
 	result := (PPSequenceParser with: self with: PPEOFParser new) memoizedParse: aStream.
 	^result isParseFailure 
 	^result isParseFailure 
 	    ifTrue: [self error: (result messageFor: aStream contents)]
 	    ifTrue: [self error: (result messageFor: aStream contents)]
 	    ifFalse: [result first]
 	    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 
 	^aStream atEnd 
 	    ifFalse: [
 	    ifFalse: [
 		PPFailure new reason: 'EOF expected' at: aStream position]
 		PPFailure new reason: 'EOF expected' at: aStream position]
 	    ifTrue: [nil]
 	    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
 	^aStream atEnd
 	    ifTrue: [PPFailure new
 	    ifTrue: [PPFailure new
 			 reason: 'did not expect EOF' at: aStream position]
 			 reason: 'did not expect EOF' at: aStream position]
 	    ifFalse: [aStream next]
 	    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
 	^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
-
!

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

!PPStringParser methodsFor: 'parsing'!

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

!PPCharacterParser methodsFor: 'parsing'!

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

!PPCharacterParser methodsFor: 'private'!

match: aString
+
+! !
+
+!PPCharacterParser methodsFor: 'private'!
+
+match: aString
 	^aString match: regexp
 	^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 ifNil: [#()]
-
!

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

!PPListParser methodsFor: 'copying'!

copyWith: aParser
+
+! !
+
+!PPListParser methodsFor: 'copying'!
+
+copyWith: aParser
 	^self class withAll: (self parsers 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
 	    ^self new
 		parsers: aCollection;
 		parsers: aCollection;
 		yourself
 		yourself
-
!

with: aParser with: anotherParser
+
+!
+
+with: aParser with: anotherParser
 	    ^self withAll: (Array 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
 	^self copyWith: aRule
-
! !

!PPSequenceParser methodsFor: 'parsing'!

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

!PPChoiceParser methodsFor: 'parsing'!

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

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

!PPDelegateParser methodsFor: 'parsing'!

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

!PPDelegateParser class methodsFor: 'instance creation'!

on: aParser
+
+! !
+
+!PPDelegateParser class methodsFor: 'instance creation'!
+
+on: aParser
 	    ^self new
 	    ^self new
 		parser: aParser;
 		parser: aParser;
 		yourself
 		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
 	^self basicParse: aStream
-
!

basicParse: aStream
+
+!
+
+basicParse: aStream
 	| element position |
 	| element position |
 	position := aStream position.
 	position := aStream position.
 	element := self parser memoizedParse: aStream.
 	element := self parser memoizedParse: aStream.
 	aStream position: position.
 	aStream position: position.
 	^element
 	^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 |
 	element := self basicParse: aStream.
 	element := self basicParse: aStream.
 	^element isParseFailure 
 	^element isParseFailure 
 	    ifTrue: [nil]
 	    ifTrue: [nil]
 	    ifFalse: [PPFailure reason: element at: aStream position]
 	    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
-
!

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

!PPActionParser methodsFor: 'parsing'!

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

!PPActionParser class methodsFor: 'instance creation'!

on: aParser block: aBlock
+
+! !
+
+!PPActionParser class methodsFor: 'instance creation'!
+
+on: aParser block: aBlock
 	    ^self new
 	    ^self new
 		parser: aParser;
 		parser: aParser;
 		block: aBlock;
 		block: aBlock;
 		yourself
 		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 element stop |
 	start := aStream position.
 	start := aStream position.
 	element := self parser memoizedParse: aStream.
 	element := self parser memoizedParse: aStream.
@@ -158,7 +399,16 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 	    ifFalse: [aStream collection 
 	    ifFalse: [aStream collection 
 		copyFrom: start + 1 
 		copyFrom: start + 1 
 		to: aStream position]
 		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 element stop result |
 	start := aStream position.
 	start := aStream position.
 	element := self parser memoizedParse: aStream.
 	element := self parser memoizedParse: aStream.
@@ -166,11 +416,28 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 		ifTrue: [element]
 		ifTrue: [element]
 		ifFalse: [result := aStream collection copyFrom: start + 1 to: aStream position.
 		ifFalse: [result := aStream collection copyFrom: start + 1 to: aStream position.
 			Array with: element with: result].
 			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
-
!

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

!PPRepeatingParser methodsFor: 'parsing'!

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

!PPRepeatingParser class methodsFor: 'instance creation'!

on: aParser min: aNumber
+
+! !
+
+!PPRepeatingParser class methodsFor: 'instance creation'!
+
+on: aParser min: aNumber
 	    ^self new
 	    ^self new
 		parser: aParser;
 		parser: aParser;
 		min: aNumber;
 		min: aNumber;
 		yourself
 		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 ifNil: [0]
-
!

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

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

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

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

!PPFailure methodsFor: 'testing'!

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

!PPFailure class methodsFor: 'instance creation'!

reason: aString at: anInteger
+
+! !
+
+!PPFailure class methodsFor: 'instance creation'!
+
+reason: aString at: anInteger
 	    ^self new
 	    ^self new
 		reason: aString at: anInteger;
 		reason: aString at: anInteger;
 		yourself
 		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 |
 	| 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.
 	separator := (String cr, String space, String lf, String tab) asChoiceParser.
@@ -374,43 +686,134 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 		    yourself].
 		    yourself].
 	
 	
 	^method, PPEOFParser new ==> [:node | node first]
 	^method, PPEOFParser new ==> [:node | node first]
-
! !

!SmalltalkParser methodsFor: 'parsing'!

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

!SmalltalkParser class methodsFor: 'instance creation'!

parse: aStream
+
+! !
+
+!SmalltalkParser class methodsFor: 'instance creation'!
+
+parse: aStream
 	    ^self new
 	    ^self new
 		parse: aStream
 		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 ifNil: ['']
-
!

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

!Chunk methodsFor: 'testing'!

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

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

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

!InstructionChunk methodsFor: 'testing'!

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

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

!EmptyChunk methodsFor: 'testing'!

isEmptyChunk
+
+! !
+
+Chunk subclass: #EmptyChunk
+	instanceVariableNames: ''
+	category: 'Parser'!
+
+!EmptyChunk methodsFor: 'testing'!
+
+isEmptyChunk
 	^true
 	^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 ifNil: [
 	    instructionChunk := self ws, '!' asParser, self chunk
 	    instructionChunk := self ws, '!' asParser, self chunk
 	    ==> [:node | InstructionChunk new contents: node last contents]]
 	    ==> [:node | InstructionChunk new contents: node last contents]]
-
! !

!ChunkParser methodsFor: 'accessing'!

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

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

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

ws
+
+!
+
+ws
 	^ws ifNil: [ws := self separator star]
 	^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: '!')]]
 	^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]]
 	^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]
 	^chunkParser ifNil: [chunkParser := ChunkParser new parser]
-
! !

!Importer methodsFor: 'fileIn'!

import: aStream
+
+! !
+
+!Importer methodsFor: 'fileIn'!
+
+import: aStream
 	aStream atEnd ifFalse: [
 	aStream atEnd ifFalse: [
 	    | nextChunk |
 	    | nextChunk |
 	    nextChunk := self chunkParser parse: aStream.
 	    nextChunk := self chunkParser parse: aStream.
@@ -420,14 +823,26 @@ Object subclass: #PPParser
	instanceVariableNames: 'memo'
	category: 'Parser'!
 					 scanFrom: aStream]
 					 scanFrom: aStream]
 		    ifFalse: [Compiler new loadExpression: nextChunk contents].
 		    ifFalse: [Compiler new loadExpression: nextChunk contents].
 		self import: aStream]]
 		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 |
 	stream := '' writeStream.
 	stream := '' writeStream.
 	(Smalltalk current classes 
 	(Smalltalk current classes 
 	    select: [:each | each category = aString])
 	    select: [:each | each category = aString])
 	    do: [:each | stream nextPutAll: (self export: each)].
 	    do: [:each | stream nextPutAll: (self export: each)].
 	self exportCategoryExtensions: aString on: stream.
 	self exportCategoryExtensions: aString on: stream.
-	^stream contents
!

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

!Exporter methodsFor: 'private'!

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

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

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

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

exportMethod: aMethod of: aClass on: aStream
+
+!
+
+exportMethod: aMethod of: aClass on: aStream
 	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: ['.
 		nextPutAll: 'referencedClasses: ['.
 	    		aMethod referencedClasses 
 	    		aMethod referencedClasses 
 				do: [:each | aStream nextPutAll: 'smalltalk.', (self classNameFor: each)]
 				do: [:each | aStream nextPutAll: 'smalltalk.', (self classNameFor: each)]
 				separatedBy: [aStream nextPutAll: ','].
 				separatedBy: [aStream nextPutAll: ','].
 	aStream
 	aStream
-		nextPutAll: ']', String cr;
-		nextPutAll: '}),', String cr;
+		nextPutAll: ']';lf;
+		nextPutAll: '}),';lf;
 		nextPutAll: 'smalltalk.', (self classNameFor: aClass);
 		nextPutAll: 'smalltalk.', (self classNameFor: aClass);
-		nextPutAll: ');', String cr, String cr
!

+		nextPutAll: ');';lf;lf
+!
+
+
 exportCategoryExtensions: aString on: aStream
 exportCategoryExtensions: aString on: aStream
 	Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
 	Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
 		each methodDictionary values do: [:method |
 		each methodDictionary values do: [:method |
 			method category = ('*', aString) ifTrue: [
 			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."
 	"Chunk format."
 
 
 	aStream 
 	aStream 
@@ -517,10 +961,17 @@ exportCategoryExtensions: aString on: aStream
 		nextPutAll: '!', (self classNameFor: aClass), ' commentStamp!';lf;
 		nextPutAll: '!', (self classNameFor: aClass), ' commentStamp!';lf;
 		nextPutAll: aClass comment escaped, '!';lf].
 		nextPutAll: aClass comment escaped, '!';lf].
 	aStream lf
 	aStream lf
-
!

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

exportMethodsOf: aClass on: aStream
+		nextPutAll: '!'
+!
+
+exportMethodsOf: aClass on: aStream
+
     | methodsByCategory |
     | methodsByCategory |
     methodsByCategory := Dictionary new.
     methodsByCategory := Dictionary new.
     aClass methodDictionary values do: [:m |
     aClass methodDictionary values do: [:m |
@@ -532,7 +983,10 @@ exportCategoryExtensions: aString on: aStream
 		nextPutAll: ' methodsFor: ''', category, '''!'.
 		nextPutAll: ' methodsFor: ''', category, '''!'.
     	(methodsByCategory at: category) do: [:each |
     	(methodsByCategory at: category) do: [:each |
 		self exportMethod: each of: aClass on: aStream].
 		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: [
 	aClass class instanceVariableNames isEmpty ifFalse: [
 		aStream 
 		aStream 
@@ -542,10 +996,15 @@ exportCategoryExtensions: aString on: aStream
 		    do: [:each | aStream nextPutAll: each]
 		    do: [:each | aStream nextPutAll: each]
 		    separatedBy: [aStream nextPutAll: ', '].
 		    separatedBy: [aStream nextPutAll: ', '].
 		aStream	
 		aStream	
-		    nextPutAll: '''!'; lf; lf]
!

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

+		    ifFalse: [aClass name]]
+! !
+

+ 332 - 65
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 |
 	self class instanceVariableNames do: [ :name |
 		name = 'testSelector' ifFalse: [
 		name = 'testSelector' ifFalse: [
-			self instVarAt: name put: nil ]]
!

signalFailure: aString
+			self instVarAt: name put: nil ]]
+!
+
+signalFailure: aString
 	TestFailure new
 	TestFailure new
 		messageText: aString;
 		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 setUp.
 	self performTestFor: aTestResult]
 	self performTestFor: aTestResult]
 		on: Error
 		on: Error
@@ -16,74 +47,182 @@ Object subclass: #TestCase
	instanceVariableNames: 'testedClass'
	category: 'SUn
 			self cleanUpInstanceVariables.
 			self cleanUpInstanceVariables.
 			ex signal].
 			ex signal].
 	self tearDown.
 	self tearDown.
-	self cleanUpInstanceVariables
!

performTestFor: aResult
+	self cleanUpInstanceVariables
+!
+
+performTestFor: aResult
 	self methods do: [:each | 
 	self methods do: [:each | 
 		[[self perform: each]
 		[[self perform: each]
 			on: TestFailure do: [:ex | aResult addFailure: self class name, '>>', each]]
 			on: TestFailure do: [:ex | aResult addFailure: self class name, '>>', each]]
 			on: Error do: [:ex | aResult addError: 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
 	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 
 	html div 
 		class: 'progress_bar';
 		class: 'progress_bar';
 		with: [
 		with: [
 			html div 
 			html div 
 				class: 'progress';
 				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 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]'
     ^'[Test runner]'
-
!

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

classes
+    ^categories sort
+!
+
+classes
     ^(self allClasses 
     ^(self allClasses 
 	select: [:each | self selectedCategories includes: each category])
 	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 |
 	^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 |
 	self result failures collect: [:each |
 		html li 
 		html li 
 			class: 'failures';
 			class: 'failures';
-			with: each]
! !

!TestRunner methodsFor: 'actions'!

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

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

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

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

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

!TestRunner methodsFor: 'initialization'!

initialize
+		self updateMethodsList] valueWithTimeout: 100].
+! !
+
+!TestRunner methodsFor: 'initialization'!
+
+initialize
 	super 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 
     self 
 	renderCategoriesOn: html;
 	renderCategoriesOn: html;
 	renderClassesOn: html;
 	renderClassesOn: html;
-	renderResultsOn: html
!

renderButtonsOn: html
+	renderResultsOn: html
+!
+
+renderButtonsOn: html
     html button
     html button
 	with: 'Run selected';
 	with: 'Run selected';
 	onClick: [self run: (self selectedClasses collect: [:each | each new])]
 	onClick: [self run: (self selectedClasses collect: [:each | each new])]
-
!

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

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

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

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

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

!TestRunner methodsFor: 'testing'!

canBeClosed
+			with: each]
+! !
+
+!TestRunner methodsFor: 'testing'!
+
+canBeClosed
     ^true
     ^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 |
     categoriesList contents: [:html |
 	    html li 
 	    html li 
 		class: 'all';
 		class: 'all';
@@ -141,7 +338,10 @@ Object subclass: #TestCase
	instanceVariableNames: 'testedClass'
	category: 'SUn
 		li class: 'selected'].
 		li class: 'selected'].
 	    li
 	    li
 		with: each;
 		with: each;
-		onClick: [self toggleCategory: each]]]
!

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

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

updateStatusDiv
+                self renderErrorsOn: html]
+!
+
+updateStatusDiv
 	statusDiv class: 'sunit status ', result status.
 	statusDiv class: 'sunit status ', result status.
 	statusDiv contents: [:html |
 	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 
 	^self errors isEmpty 
 		ifTrue: [
 		ifTrue: [
 			self failures isEmpty 
 			self failures isEmpty 
 				ifTrue: ['success']
 				ifTrue: ['success']
 				ifFalse: ['failure']]
 				ifFalse: ['failure']]
-		ifFalse: ['error']
! !

!TestResult methodsFor: 'initialization'!

initialize
+		ifFalse: ['error']
+! !
+
+!TestResult methodsFor: 'initialization'!
+
+initialize
 	super initialize.
 	super initialize.
 	timestamp := Date now.
 	timestamp := Date now.
 	runs := 0.
 	runs := 0.
 	errors := Array new.
 	errors := Array new.
 	failures := 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]
+! !
+

この差分においてかなりの量のファイルが変更されているため、一部のファイルを表示していません