Spaces.st 2.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142
  1. Smalltalk current createPackage: 'Spaces'!
  2. Object subclass: #ObjectSpace
  3. instanceVariableNames: 'frame'
  4. package: 'Spaces'!
  5. !ObjectSpace commentStamp!
  6. I am a connection to another Smalltalk environment.
  7. The implementation creates an iframe on the same location as the window, and connect to the Amber environment.
  8. ## Usage example:
  9. | space |
  10. space := ObjectSpace new.
  11. space do: [ smalltalk ] "Answers aSmalltalk"
  12. (space do: [ smalltalk ]) == smalltalk "Answers false"
  13. space release "Remove the object space environment"!
  14. !ObjectSpace methodsFor: 'accessing'!
  15. frame
  16. ^ frame
  17. ! !
  18. !ObjectSpace methodsFor: 'evaluating'!
  19. do: aBlock
  20. self isConnected ifFalse: [ ^ ObjectSpaceConnectionError signal ].
  21. ^ frame contentWindow eval: '(', aBlock compiledSource, ')()'
  22. ! !
  23. !ObjectSpace methodsFor: 'events'!
  24. whenReadyDo: aBlock
  25. (window jQuery: frame)
  26. bind: 'load'
  27. do: aBlock
  28. ! !
  29. !ObjectSpace methodsFor: 'initialization'!
  30. connectTo: aFrame
  31. self release.
  32. frame := aFrame
  33. !
  34. create
  35. (window jQuery: 'body') append: '<iframe style="display: none;"></iframe>'.
  36. frame := (window jQuery: 'iframe') get last.
  37. frame contentWindow location: window location
  38. !
  39. initialize
  40. super initialize.
  41. self create
  42. !
  43. isConnected
  44. ^ self frame notNil
  45. ! !
  46. !ObjectSpace methodsFor: 'releasing'!
  47. destroy
  48. frame ifNil: [ ^ self ].
  49. (window jQuery: frame) remove.
  50. self release
  51. !
  52. release
  53. frame := nil
  54. ! !
  55. !ObjectSpace class methodsFor: 'instance creation'!
  56. on: aFrame
  57. ^ self basicNew
  58. connectTo: aFrame;
  59. yourself
  60. ! !
  61. Error subclass: #ObjectSpaceConnectionError
  62. instanceVariableNames: ''
  63. package: 'Spaces'!
  64. !ObjectSpaceConnectionError methodsFor: 'accessing'!
  65. messageText
  66. ^ 'The ObjectSpace is not connected'
  67. ! !
  68. TestCase subclass: #ObjectSpaceTest
  69. instanceVariableNames: 'space'
  70. package: 'Spaces'!
  71. !ObjectSpaceTest methodsFor: 'initialization'!
  72. setUp
  73. space := ObjectSpace new
  74. !
  75. tearDown
  76. space destroy
  77. ! !
  78. !ObjectSpaceTest methodsFor: 'tests'!
  79. testConnection
  80. space destroy.
  81. self deny: space isConnected.
  82. self should: [ space do: [] ] raise: ObjectSpaceConnectionError
  83. !
  84. testCreate
  85. self assert: space frame notNil.
  86. self assert: space isConnected
  87. !
  88. testEvaluation
  89. | result |
  90. space whenReadyDo: [
  91. result := space do: [ smalltalk ].
  92. self assert: result class name equals: 'Smalltalk'.
  93. self deny: result class = Smalltalk.
  94. self deny: result == smalltalk ]
  95. !
  96. testRelease
  97. self deny: space frame isNil.
  98. space release.
  99. self assert: space frame isNil
  100. ! !