Nicolas Petton před 11 roky
rodič
revize
f9facc1f84
1 změnil soubory, kde provedl 121 přidání a 0 odebrání
  1. 121 0
      st/Spaces.st

+ 121 - 0
st/Spaces.st

@@ -0,0 +1,121 @@
+Smalltalk current createPackage: 'Spaces' properties: #{}!
+Object subclass: #ObjectSpace
+	instanceVariableNames: 'frame'
+	package: 'Spaces'!
+!ObjectSpace commentStamp!
+I am a connection to another Smalltalk environment.
+The implementation creates an iframe on the same location as the window, and connect to the Amber environment.
+
+
+
+## Usage example:
+
+    | space |
+    
+    space := ObjectSpace new.
+    space do: [ smalltalk ] "Answers aSmalltalk"
+    (space do: [ smalltalk ]) == smalltalk "Answers false"
+    
+    space release "Remove the object space environment"!
+
+!ObjectSpace methodsFor: 'accessing'!
+
+frame
+	^ frame
+! !
+
+!ObjectSpace methodsFor: 'evaluating'!
+
+do: aBlock
+	^ frame contentWindow eval: '(', aBlock compiledSource, ')()'
+! !
+
+!ObjectSpace methodsFor: 'events'!
+
+whenReadyDo: aBlock
+	(window jQuery: frame) 
+		bind: 'load'
+		do: aBlock
+! !
+
+!ObjectSpace methodsFor: 'initialization'!
+
+connectTo: aFrame
+	self release.
+	frame := aFrame
+!
+
+create
+	(window jQuery: 'body') append: '<iframe style="display: none;"></iframe>'.
+	frame := (window jQuery: 'iframe') get last.
+	frame contentWindow location: window location
+!
+
+initialize
+	super initialize.
+	self create
+! !
+
+!ObjectSpace methodsFor: 'releasing'!
+
+destroy
+	frame ifNil: [ ^ self ].
+	(window jQuery: frame) remove.
+
+	self release
+!
+
+release
+	frame := nil
+! !
+
+!ObjectSpace class methodsFor: 'instance creation'!
+
+on: aFrame
+	^ self basicNew
+		connectTo: aFrame;
+		yourself
+! !
+
+TestCase subclass: #ObjectSpaceTest
+	instanceVariableNames: 'space'
+	package: 'Spaces'!
+
+!ObjectSpaceTest methodsFor: 'initialization'!
+
+setUp
+	space := ObjectSpace new
+!
+
+tearDown
+	space destroy.
+	space := nil
+! !
+
+!ObjectSpaceTest methodsFor: 'tests'!
+
+testCreate
+
+	self assert: space frame notNil
+!
+
+testEvaluation
+	| result |
+
+	space whenReadyDo: [
+		result := space do: [ smalltalk ].
+
+		self assert: result class name equals: 'Smalltalk'.
+		self deny: result class = Smalltalk.
+		self deny: result == smalltalk ]
+!
+
+testRelease
+
+	self deny: space frame isNil.
+
+	space release.
+	
+	self assert: space frame isNil
+! !
+