resin 0.3.1 → 0.4.0

data/amber/st/IDE.st

@@ -156,10 +156,10 @@ ErrorHandler subclass: #DebugErrorHandler
 !DebugErrorHandler methodsFor: 'error handling'!
 
 handleError: anError
-	[Debugger new
+	[ Debugger new
 		error: anError;
-		open] on: Error do: [:error |
-			ErrorHandler new handleError: error]
+		open ] on: Error do: [ :error |
+			ErrorHandler new handleError: error ]
 ! !
 
 !DebugErrorHandler class methodsFor: 'initialization'!
@@ -208,22 +208,6 @@ selection
 	^editor getSelection
 !
 
-selectionEnd
-   ^textarea element selectionEnd
-!
-
-selectionEnd: anInteger
-   textarea element selectionEnd: anInteger
-!
-
-selectionStart
-   ^textarea element selectionStart
-!
-
-selectionStart: anInteger
-   textarea element selectionStart: anInteger
-!
-
 setEditorOn: aTextarea
 	<self['@editor'] = CodeMirror.fromTextArea(aTextarea, {
 		theme: 'amber',
@@ -296,13 +280,20 @@ inspectIt
 !
 
 print: aString
-	| start stop |
+	| start stop currentLine |
+    currentLine := (editor getCursor: false) line.
 	start := HashedCollection new.
-	stop := HashedCollection new.
-	start at: 'line' put: (editor getCursor: false) line.
+	start at: 'line' put: currentLine.
 	start at: 'ch' put: (editor getCursor: false) ch.
-	stop at: 'line' put: (start at: 'line').
+    (editor getSelection) ifEmpty: [
+    	"select current line if selection is empty"
+    	start at: 'ch' put: (editor getLine: currentLine) size.
+        editor setSelection: #{'line' -> currentLine. 'ch' -> 0} end: start.
+    ].
+	stop := HashedCollection new.
+	stop at: 'line' put: currentLine.
 	stop at: 'ch' put: ((start at: 'ch') + aString size + 2).
+
 	editor replaceSelection: (editor getSelection, ' ', aString, ' ').
 	editor setCursor: (editor getCursor: true).
 	editor setSelection: stop end: start
@@ -790,15 +781,15 @@ cancelChanges
 
 commitPackage
 	selectedPackage ifNotNil: [ |package|
-               						 package := Package named: selectedPackage.
-               						 {	Exporter 			-> (package commitPathJs, '/', selectedPackage, '.js').
-                        					StrippedExporter 	-> (package commitPathJs, '/', selectedPackage, '.deploy.js').
-                       						 ChunkExporter 		-> (package commitPathSt, '/', selectedPackage, '.st') 			} 
-                 
-                						do: [:commitStrategy| |fileContents|
-                                                                     	fileContents := (commitStrategy key new exportPackage: selectedPackage).
-                                                                     	self ajaxPutAt: commitStrategy value data:  fileContents]
-         						]
+		package := Package named: selectedPackage.
+		{  	Exporter              -> (package commitPathJs, '/', selectedPackage, '.js').
+			StrippedExporter -> (package commitPathJs, '/', selectedPackage, '.deploy.js').
+			ChunkExporter    -> (package commitPathSt, '/', selectedPackage, '.st')
+		} do: [:commitStrategy| |fileContents|
+			fileContents := (commitStrategy key new exportPackage: selectedPackage).
+			self ajaxPutAt: commitStrategy value data:  fileContents
+  		]
+	]
 !
 
 compile
@@ -839,7 +830,7 @@ compileMethodDefinition
 compileMethodDefinitionFor: aClass
     | compiler method source node | 
     source := sourceArea val.
-    selectedProtocol ifNil: [selectedProtocol := selectedMethod category].
+    selectedProtocol ifNil: [ selectedProtocol := selectedMethod category ].
     compiler := Compiler new.
     compiler source: source.
     node := compiler parse: source.
@@ -847,15 +838,13 @@ compileMethodDefinitionFor: aClass
 	^window alert: 'PARSE ERROR: ', node reason, ', position: ', node position asString].
     compiler currentClass: aClass.
     method := compiler eval: (compiler compileNode: node).
-    method category: selectedProtocol.
     compiler unknownVariables do: [:each |
          "Do not try to redeclare javascript's objects"
          (window at: each) ifNil: [
 	 	(window confirm: 'Declare ''', each, ''' as instance variable?') ifTrue: [
 			self addInstanceVariableNamed: each toClass: aClass.
 			^self compileMethodDefinitionFor: aClass]]].
-    aClass addCompiledMethod: method.
-    compiler setupClass: aClass.
+    ClassBuilder new installMethod: method forClass: aClass category: selectedProtocol.
     self updateMethodsList.
     self selectMethod: method
 !
@@ -1041,12 +1030,12 @@ initialize
 
 !Browser methodsFor: 'network'!
 
-ajaxPutAt: anURL data: aString
-	jQuery 
-		ajax: anURL	options: #{	'type' -> 'PUT'.
+ajaxPutAt: aURL data: aString
+	jQuery
+		ajax: aURL	options: #{	'type' -> 'PUT'.
 								'data' -> aString.
 								'contentType' -> 'text/plain;charset=UTF-8'.
-								'error' -> [window alert: 'PUT request failed at:  ', anURL] }
+								'error' -> [:xhr | window alert: 'Commiting ' , aURL , ' failed with reason: "' , (xhr responseText) , '"'] }
 ! !
 
 !Browser methodsFor: 'rendering'!
@@ -1285,16 +1274,6 @@ updateTabsList
 	    onClick: [self selectTab: #comment]]
 ! !
 
-!Browser class methodsFor: 'accessing'!
-
-commitPathJs
-	^'js'
-!
-
-commitPathSt
-	^'st'
-! !
-
 !Browser class methodsFor: 'convenience'!
 
 open
@@ -1314,10 +1293,17 @@ TabWidget subclass: #Debugger
 
 !Debugger methodsFor: 'accessing'!
 
-arguments
-	^self method 
-		ifNil: [selectedContext temps collect: [:each | nil]]
-		ifNotNil: [self method arguments]
+allVariables
+	| all |
+	all := Dictionary new.
+
+	self receiver class allInstanceVariableNames do: [:each |
+		all at: each put: (self receiver instVarAt: each) ].
+    
+    selectedContext locals keysAndValuesDo: [ :key :value |
+    	all at: key put: value ].
+    
+    ^ all
 !
 
 error
@@ -1333,7 +1319,7 @@ label
 !
 
 method
-	^selectedContext receiver class methodAt: selectedContext selector
+	^selectedContext method
 !
 
 receiver
@@ -1377,6 +1363,7 @@ selectContext: aContext
 !
 
 selectVariable: anObject named: aString
+    
 	selectedVariable := anObject.
 	selectedVariableName := aString.
 	inspector contents: [:html | html with: anObject printString].
@@ -1405,7 +1392,7 @@ renderBottomPanelOn: html
 !
 
 renderBoxOn: html
-    self 
+   self 
 	renderTopPanelOn: html;
 	renderBottomPanelOn: html
 !
@@ -1448,7 +1435,7 @@ renderContext: aContext on: html
 	li 
 		with: aContext asString;
 		onClick: [self selectContext: aContext].
-	aContext home ifNotNil: [self renderContext: aContext home on: html]
+	aContext outerContext ifNotNil: [self renderContext: aContext outerContext on: html]
 !
 
 renderTopPanelOn: html
@@ -1498,27 +1485,22 @@ updateStatus
 !
 
 updateVariablesList
-	ul2 contents: [:html | | li |
+	ul2 contents: [ :html | | li |
 		li := html li 
 			with: 'self';
-			onClick: [self selectVariable: self receiver named: 'self'].
-                selectedVariableName = 'self' ifTrue: [
-			li class: 'selected'].
-                self arguments withIndexDo: [:each :index | | param |
-                        param := selectedContext temps at: index.
+			onClick: [ self selectVariable: self receiver named: 'self' ].
+                selectedVariableName = 'self' ifTrue: [ li class: 'selected' ].
+        
+        self allVariables keysAndValuesDo: [:key :value |
                         li := html li 
-				with: each;
-				onClick: [self selectVariable: param named: each].
-                         selectedVariableName = each ifTrue: [
-				li class: 'selected']].
-                self receiver class allInstanceVariableNames do: [:each | | ivar |
-                        ivar := self receiver instVarAt: each.
-                        li := html li 
-				with: each;
-				onClick: [self selectVariable: ivar named: each].
-                         selectedVariableName = each ifTrue: [
-				li class: 'selected']]].
-	selectedVariable ifNil: [inspectButton at: 'disabled' put: true] ifNotNil: [inspectButton removeAt: 'disabled']
+							with: key;
+							onClick: [ self selectVariable: value named: key ].
+                        selectedVariableName = key ifTrue: [
+							li class: 'selected' ] ] ].
+                            
+	selectedVariable 
+    	ifNil: [ inspectButton at: 'disabled' put: true ] 
+        ifNotNil: [ inspectButton removeAt: 'disabled' ]
 ! !
 
 TabWidget subclass: #IDETranscript
@@ -2388,24 +2370,6 @@ inspectOn: anInspector
 		setVariables: variables
 ! !
 
-!Date methodsFor: '*IDE'!
-
-inspectOn: anInspector
-	| variables |
-	variables := Dictionary new.
-	variables at: '#self' put: self.
-	variables at: '#year' put: self year.
-	variables at: '#month' put: self month.
-	variables at: '#day' put: self day.
-	variables at: '#hours' put: self hours.
-	variables at: '#minutes' put: self minutes.
-	variables at: '#seconds' put: self seconds.
-	variables at: '#milliseconds' put: self milliseconds.
-	anInspector 
-		setLabel: self printString;
-		setVariables: variables
-! !
-
 !MethodContext methodsFor: '*IDE'!
 
 inspectOn: anInspector

data/amber/st/Importer-Exporter.st

@@ -345,16 +345,13 @@ Object subclass: #PackageLoader
 	instanceVariableNames: ''
 	package: 'Importer-Exporter'!
 
-!PackageLoader methodsFor: 'not yet classified'!
+!PackageLoader methodsFor: 'laoding'!
 
 initializePackageNamed: packageName prefix: aString
 
-	(Package named: packageName) classes do: [ :each |
-    	<smalltalk.init(each)>.
-        each initialize. ].
-        
-    (Package named: packageName) 
-    	commitPathJs: '/', aString, '/js';
+	(Package named: packageName) 
+    	setupClasses;
+        commitPathJs: '/', aString, '/js';
         commitPathSt: '/', aString, '/st'
 !
 

data/amber/st/Kernel-Announcements.st

@@ -2,6 +2,9 @@ Smalltalk current createPackage: 'Kernel-Announcements' properties: #{}!
 Object subclass: #AnnouncementSubscription
 	instanceVariableNames: 'block announcementClass'
 	package: 'Kernel-Announcements'!
+!AnnouncementSubscription commentStamp!
+The subscription is a single entry in a subscription registry of an `Announcer`.
+Several subscriptions by the same object is possible.!
 
 !AnnouncementSubscription methodsFor: 'accessing'!
 
@@ -35,6 +38,11 @@ handlesAnnouncement: anAnnouncement
 Object subclass: #Announcer
 	instanceVariableNames: 'registry subscriptions'
 	package: 'Kernel-Announcements'!
+!Announcer commentStamp!
+The code is based on the announcements as [described by Vassili Bykov](http://www.cincomsmalltalk.com/userblogs/vbykov/blogView?searchCategory=Announcements%20Framework).
+The Announcer holds annoncement subscriptions (`AnnouncementSubscription`) in a private registry.
+
+Use `#on:do:` to register subscriptions.!
 
 !Announcer methodsFor: 'announcing'!
 

data/amber/st/Kernel-Classes.st

@@ -68,13 +68,29 @@ instanceVariableNames
 	<return self.iVarNames>
 !
 
+lookupSelector: selector
+	"Look up the given selector in my methodDictionary.
+	Return the corresponding method if found.
+	Otherwise chase the superclass chain and try again.
+	Return nil if no method is found."
+    
+	| lookupClass |
+    
+	lookupClass := self.
+	[ lookupClass = nil ] whileFalse: [
+      	(lookupClass includesSelector: selector)
+				ifTrue: [ ^ lookupClass methodAt: selector ].
+			lookupClass := lookupClass superclass ].
+	^ nil
+!
+
 methodAt: aSymbol
-	<return smalltalk.methods(self)[aSymbol._asString()]>
+	^ self methodDictionary at: aSymbol asString
 !
 
 methodDictionary
 	<var dict = smalltalk.HashedCollection._new();
-	var methods = self.fn.prototype.methods;
+	var methods = self.methods;
 	for(var i in methods) {
 		if(methods[i].selector) {
 			dict._at_put_(methods[i].selector, methods[i]);
@@ -158,7 +174,7 @@ withAllSubclasses
 !Behavior methodsFor: 'compiling'!
 
 addCompiledMethod: aMethod
-	<smalltalk.addMethod(aMethod.selector._asSelector(), aMethod, self)>.
+	self basicAddCompiledMethod: aMethod.
     
     SystemAnnouncer current
    		announce: (MethodAdded new
@@ -179,10 +195,7 @@ compile: aString category: anotherString
 !
 
 removeCompiledMethod: aMethod
-	<
-    	smalltalk.removeMethod(aMethod)
-		smalltalk.init(self);
-    >.
+	self basicRemoveCompiledMethod: aMethod.
     
     SystemAnnouncer current
    		announce: (MethodRemoved new
@@ -201,6 +214,19 @@ new
 	^self basicNew initialize
 ! !
 
+!Behavior methodsFor: 'private'!
+
+basicAddCompiledMethod: aMethod
+	<smalltalk.addMethod(aMethod.selector._asSelector(), aMethod, self)>
+!
+
+basicRemoveCompiledMethod: aMethod
+	<
+    	smalltalk.removeMethod(aMethod)
+		smalltalk.init(self);
+    >
+! !
+
 !Behavior methodsFor: 'testing'!
 
 canUnderstand: aSelector
@@ -208,6 +234,10 @@ canUnderstand: aSelector
 		self superclass notNil and: [self superclass canUnderstand: aSelector]]
 !
 
+includesSelector: aSymbol
+	^ self methodDictionary includesKey: aSymbol asString
+!
+
 inheritsFrom: aClass
 	^aClass allSubclasses includes: self
 ! !
@@ -364,26 +394,27 @@ ClassBuilder is responsible for compiling new classes or modifying existing clas
 
 Rather than using ClassBuilder directly to compile a class, use `Class >> subclass:instanceVariableNames:package:`.!
 
-!ClassBuilder methodsFor: 'class creation'!
+!ClassBuilder methodsFor: 'api'!
 
 class: aClass instanceVariableNames: aString
-	aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
-	aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).
+	self basicClass: aClass instanceVariableNames: aString.
+    self setupClass: aClass.
     
     SystemAnnouncer current
     	announce: (ClassDefinitionChanged new
         	theClass: aClass;
-            yourself).
-    
-	self setupClass: aClass
+            yourself)
+!
+
+installMethod: aCompiledMethod forClass: aBehavior category: aString
+	aCompiledMethod category: aString.
+	aBehavior addCompiledMethod: aCompiledMethod.
+    self setupClass: aBehavior.
+	^aCompiledMethod
 !
 
 renameClass: aClass to: aString
-	<
-		smalltalk[aString] = aClass;
-		delete smalltalk[aClass.className];
-		aClass.className = aString;
-	>.
+	self basicRenameClass: aClass to: aString.
     
     SystemAnnouncer current
     	announce: (ClassRenamed new
@@ -391,6 +422,10 @@ renameClass: aClass to: aString
             yourself)
 !
 
+setupClass: aClass
+	<smalltalk.init(aClass);>
+!
+
 superclass: aClass subclass: aString
 	^self superclass: aClass subclass: aString instanceVariableNames: '' package: nil
 !
@@ -413,14 +448,49 @@ superclass: aClass subclass: aString instanceVariableNames: aString2 package: aS
 
 !ClassBuilder methodsFor: 'private'!
 
-addSubclassOf: aClass named: aString instanceVariableNames: aCollection
-	<smalltalk.addClass(aString, aClass, aCollection);
-	    return smalltalk[aString]>
+addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
+	
+    (Smalltalk current at: aString) ifNotNil: [ 
+    	^ self 
+        	migrateClassNamed: aString 
+            superclass: aClass 
+            instanceVariableNames: aCollection 
+            package: packageName ].
+
+	^ self 
+    	basicAddSubclassOf: aClass 
+        named: aString 
+        instanceVariableNames: aCollection 
+        package: packageName
 !
 
-addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
-	<smalltalk.addClass(aString, aClass, aCollection, packageName);
-	    return smalltalk[aString]>
+basicAddSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
+	<
+		smalltalk.addClass(aString, aClass, aCollection, packageName);
+		return smalltalk[aString]
+	>
+!
+
+basicClass: aClass instanceVariableNames: aString
+	self basicClass: aClass instanceVariables: (self instanceVariableNamesFor: aString)
+!
+
+basicClass: aClass instanceVariables: aCollection
+
+	aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
+	aClass basicAt: 'iVarNames' put: aCollection
+!
+
+basicRemoveClass: aClass
+	<smalltalk.removeClass(aClass)>
+!
+
+basicRenameClass: aClass to: aString
+	<
+		smalltalk[aString] = aClass;
+		delete smalltalk[aClass.className];
+		aClass.className = aString;
+	>
 !
 
 copyClass: aClass named: aString
@@ -432,28 +502,69 @@ copyClass: aClass named: aString
 		instanceVariableNames: aClass instanceVariableNames 
 		package: aClass package name.
 
-	self setupClass: newClass.
+	self copyClass: aClass to: newClass.
+    
+	^newClass
+!
 
-	aClass methodDictionary values do: [:each |
-		Compiler new install: each source forClass: newClass category: each category].
+copyClass: aClass to: anotherClass
 
-	aClass class methodDictionary values do: [:each |
-		Compiler new install: each source forClass: newClass class category: each category].
+	anotherClass comment: aClass comment.
 
-	self setupClass: newClass.
-	^newClass
+	aClass methodDictionary values do: [ :each |
+		Compiler new install: each source forClass: anotherClass category: each category ].
+
+	aClass class methodDictionary values do: [ :each |
+		Compiler new install: each source forClass: anotherClass class category: each category ].
+
+	self basicClass: anotherClass class instanceVariables: aClass class instanceVariableNames.
+
+	self setupClass: anotherClass
 !
 
 instanceVariableNamesFor: aString
-	^(aString tokenize: ' ') reject: [:each | each isEmpty]
+	^(aString tokenize: ' ') reject: [ :each | each isEmpty ]
 !
 
-setupClass: aClass
-	<smalltalk.init(aClass);>
+migrateClass: aClass superclass: anotherClass
+	self 
+    	migrateClassNamed: aClass name
+        superclass: anotherClass
+        instanceVariableNames: aClass instanceVariableNames
+        package: aClass package name
+!
+
+migrateClassNamed: aString superclass: aClass instanceVariableNames: aCollection package: packageName
+	| oldClass newClass |
+    
+    oldClass := Smalltalk current at: aString.
+    
+    "Rename the old class for existing instances"
+	self basicRenameClass: oldClass to: 'Old', aString.
+    
+    newClass := self 
+		addSubclassOf: aClass
+		named: aString 
+		instanceVariableNames: aCollection
+		package: packageName.
+
+	oldClass subclasses do: [ :each |
+    	self migrateClass: each superclass: newClass ].
+
+    [ self copyClass: oldClass to: newClass ] 
+    	on: Error
+        do: [ :exception |
+        	self 
+            	basicRemoveClass: newClass;
+            	basicRenameClass: oldClass to: aString.
+            exception signal ].
+            
+    self basicRemoveClass: oldClass.
+	^newClass
 ! !
 
 Object subclass: #ClassCategoryReader
-	instanceVariableNames: 'class category chunkParser'
+	instanceVariableNames: 'class category'
 	package: 'Kernel-Classes'!
 !ClassCategoryReader commentStamp!
 ClassCategoryReader represents a mechanism for retrieving class descriptions stored on a file.!
@@ -472,14 +583,13 @@ scanFrom: aChunkParser
 	[chunk := aChunkParser nextChunk.
 	chunk isEmpty] whileFalse: [
 	    self compileMethod: chunk].
-	Compiler new setupClass: class
+	ClassBuilder new setupClass: class
 ! !
 
 !ClassCategoryReader methodsFor: 'initialization'!
 
 initialize
 	super initialize.
-	chunkParser := ChunkParser new.
 ! !
 
 !ClassCategoryReader methodsFor: 'private'!
@@ -489,10 +599,10 @@ compileMethod: aString
 ! !
 
 Object subclass: #ClassCommentReader
-	instanceVariableNames: 'class chunkParser'
+	instanceVariableNames: 'class'
 	package: 'Kernel-Classes'!
 !ClassCommentReader commentStamp!
-ClassCommentReader represents a mechanism for retrieving class descriptions stored on a file.
+ClassCommentReader represents a mechanism for retrieving class comments stored on a file.
 See `ClassCategoryReader` too.!
 
 !ClassCommentReader methodsFor: 'accessing'!
@@ -514,7 +624,6 @@ scanFrom: aChunkParser
 
 initialize
 	super initialize.
-	chunkParser := ChunkParser new.
 ! !
 
 !ClassCommentReader methodsFor: 'private'!