1
0

Spaces.st 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121
  1. Smalltalk current createPackage: 'Spaces' properties: #{}!
  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. ^ frame contentWindow eval: '(', aBlock compiledSource, ')()'
  21. ! !
  22. !ObjectSpace methodsFor: 'events'!
  23. whenReadyDo: aBlock
  24. (window jQuery: frame)
  25. bind: 'load'
  26. do: aBlock
  27. ! !
  28. !ObjectSpace methodsFor: 'initialization'!
  29. connectTo: aFrame
  30. self release.
  31. frame := aFrame
  32. !
  33. create
  34. (window jQuery: 'body') append: '<iframe style="display: none;"></iframe>'.
  35. frame := (window jQuery: 'iframe') get last.
  36. frame contentWindow location: window location
  37. !
  38. initialize
  39. super initialize.
  40. self create
  41. ! !
  42. !ObjectSpace methodsFor: 'releasing'!
  43. destroy
  44. frame ifNil: [ ^ self ].
  45. (window jQuery: frame) remove.
  46. self release
  47. !
  48. release
  49. frame := nil
  50. ! !
  51. !ObjectSpace class methodsFor: 'instance creation'!
  52. on: aFrame
  53. ^ self basicNew
  54. connectTo: aFrame;
  55. yourself
  56. ! !
  57. TestCase subclass: #ObjectSpaceTest
  58. instanceVariableNames: 'space'
  59. package: 'Spaces'!
  60. !ObjectSpaceTest methodsFor: 'initialization'!
  61. setUp
  62. space := ObjectSpace new
  63. !
  64. tearDown
  65. space destroy.
  66. space := nil
  67. ! !
  68. !ObjectSpaceTest methodsFor: 'tests'!
  69. testCreate
  70. self assert: space frame notNil
  71. !
  72. testEvaluation
  73. | result |
  74. space whenReadyDo: [
  75. result := space do: [ smalltalk ].
  76. self assert: result class name equals: 'Smalltalk'.
  77. self deny: result class = Smalltalk.
  78. self deny: result == smalltalk ]
  79. !
  80. testRelease
  81. self deny: space frame isNil.
  82. space release.
  83. self assert: space frame isNil
  84. ! !