123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121 |
- 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
- ! !
|