2
0

Kernel-Announcements.st 6.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288
  1. Smalltalk current createPackage: 'Kernel-Announcements'!
  2. Object subclass: #AnnouncementSubscription
  3. instanceVariableNames: 'block announcementClass'
  4. package: 'Kernel-Announcements'!
  5. !AnnouncementSubscription commentStamp!
  6. The subscription is a single entry in a subscription registry of an `Announcer`.
  7. Several subscriptions by the same object is possible.!
  8. !AnnouncementSubscription methodsFor: 'accessing'!
  9. announcementClass
  10. ^ announcementClass
  11. !
  12. announcementClass: aClass
  13. announcementClass := aClass
  14. !
  15. block
  16. ^block
  17. !
  18. block: aBlock
  19. block := aBlock
  20. ! !
  21. !AnnouncementSubscription methodsFor: 'announcing'!
  22. deliver: anAnnouncement
  23. (self handlesAnnouncement: anAnnouncement)
  24. ifTrue: [self block value: anAnnouncement]
  25. !
  26. handlesAnnouncement: anAnnouncement
  27. "anAnnouncement might be announced from within another Amber environment"
  28. ^ (Smalltalk current at: self announcementClass name)
  29. ifNil: [ ^ false ]
  30. ifNotNil: [ :class |
  31. class includesBehavior: (Smalltalk current at: anAnnouncement class theNonMetaClass name) ]
  32. ! !
  33. Object subclass: #Announcer
  34. instanceVariableNames: 'registry subscriptions'
  35. package: 'Kernel-Announcements'!
  36. !Announcer commentStamp!
  37. The code is based on the announcements as [described by Vassili Bykov](http://www.cincomsmalltalk.com/userblogs/vbykov/blogView?searchCategory=Announcements%20Framework).
  38. The Announcer holds annoncement subscriptions (`AnnouncementSubscription`) in a private registry.
  39. Use `#on:do:` to register subscriptions.!
  40. !Announcer methodsFor: 'announcing'!
  41. announce: anAnnouncement
  42. subscriptions do: [:each |
  43. each deliver: anAnnouncement]
  44. ! !
  45. !Announcer methodsFor: 'initialization'!
  46. initialize
  47. super initialize.
  48. subscriptions := Array new
  49. ! !
  50. !Announcer methodsFor: 'subscribing'!
  51. on: aClass do: aBlock
  52. subscriptions add: (AnnouncementSubscription new
  53. block: aBlock;
  54. announcementClass: aClass;
  55. yourself)
  56. ! !
  57. Announcer subclass: #SystemAnnouncer
  58. instanceVariableNames: ''
  59. package: 'Kernel-Announcements'!
  60. !SystemAnnouncer commentStamp!
  61. My unique instance #current is the global announcer handling all Amber system-related announces!
  62. SystemAnnouncer class instanceVariableNames: 'current'!
  63. !SystemAnnouncer class methodsFor: 'accessing'!
  64. current
  65. ^ current ifNil: [ current := super new ]
  66. ! !
  67. !SystemAnnouncer class methodsFor: 'instance creation'!
  68. new
  69. self shouldNotImplement
  70. ! !
  71. Object subclass: #SystemAnnouncement
  72. instanceVariableNames: 'theClass'
  73. package: 'Kernel-Announcements'!
  74. !SystemAnnouncement commentStamp!
  75. I am the superclass of all system announcements!
  76. !SystemAnnouncement methodsFor: 'accessing'!
  77. theClass
  78. ^ theClass
  79. !
  80. theClass: aClass
  81. theClass := aClass
  82. ! !
  83. SystemAnnouncement subclass: #ClassAnnouncement
  84. instanceVariableNames: 'theClass'
  85. package: 'Kernel-Announcements'!
  86. !ClassAnnouncement methodsFor: 'accessing'!
  87. theClass
  88. ^ theClass
  89. !
  90. theClass: aClass
  91. theClass := aClass
  92. ! !
  93. ClassAnnouncement subclass: #ClassAdded
  94. instanceVariableNames: ''
  95. package: 'Kernel-Announcements'!
  96. !ClassAdded commentStamp!
  97. I am emitted when a class is added to the system.
  98. See ClassBuilder >> #addSubclassOf:... methods!
  99. ClassAnnouncement subclass: #ClassCommentChanged
  100. instanceVariableNames: ''
  101. package: 'Kernel-Announcements'!
  102. !ClassCommentChanged commentStamp!
  103. I am emitted when the comment of a class changes. (Behavior >> #comment)!
  104. ClassAnnouncement subclass: #ClassDefinitionChanged
  105. instanceVariableNames: ''
  106. package: 'Kernel-Announcements'!
  107. !ClassDefinitionChanged commentStamp!
  108. I am emitted when the defintion of a class changes.
  109. See ClassBuilder >> #class:instanceVariableNames:!
  110. ClassAnnouncement subclass: #ClassMigrated
  111. instanceVariableNames: 'oldClass'
  112. package: 'Kernel-Announcements'!
  113. !ClassMigrated methodsFor: 'accessing'!
  114. oldClass
  115. ^ oldClass
  116. !
  117. oldClass: aClass
  118. oldClass := aClass
  119. ! !
  120. ClassAnnouncement subclass: #ClassMoved
  121. instanceVariableNames: 'oldPackage'
  122. package: 'Kernel-Announcements'!
  123. !ClassMoved methodsFor: 'accessing'!
  124. oldPackage
  125. ^ oldPackage
  126. !
  127. oldPackage: aPackage
  128. oldPackage := aPackage
  129. ! !
  130. ClassAnnouncement subclass: #ClassRemoved
  131. instanceVariableNames: ''
  132. package: 'Kernel-Announcements'!
  133. !ClassRemoved commentStamp!
  134. I am emitted when a class is removed.
  135. See Smalltalk >> #removeClass:!
  136. ClassAnnouncement subclass: #ClassRenamed
  137. instanceVariableNames: ''
  138. package: 'Kernel-Announcements'!
  139. !ClassRenamed commentStamp!
  140. I am emitted when a class is renamed.
  141. See ClassBuilder >> #renameClass:to:!
  142. SystemAnnouncement subclass: #MethodAnnouncement
  143. instanceVariableNames: 'method'
  144. package: 'Kernel-Announcements'!
  145. !MethodAnnouncement methodsFor: 'accessing'!
  146. method
  147. ^ method
  148. !
  149. method: aCompiledMethod
  150. method := aCompiledMethod
  151. ! !
  152. MethodAnnouncement subclass: #MethodAdded
  153. instanceVariableNames: ''
  154. package: 'Kernel-Announcements'!
  155. MethodAnnouncement subclass: #MethodModified
  156. instanceVariableNames: 'oldMethod'
  157. package: 'Kernel-Announcements'!
  158. !MethodModified methodsFor: 'accessing'!
  159. oldMethod
  160. ^ oldMethod
  161. !
  162. oldMethod: aMethod
  163. oldMethod := aMethod
  164. ! !
  165. MethodAnnouncement subclass: #MethodMoved
  166. instanceVariableNames: 'oldProtocol'
  167. package: 'Kernel-Announcements'!
  168. !MethodMoved methodsFor: 'accessing'!
  169. oldProtocol
  170. ^ oldProtocol
  171. !
  172. oldProtocol: aString
  173. oldProtocol := aString
  174. ! !
  175. MethodAnnouncement subclass: #MethodRemoved
  176. instanceVariableNames: ''
  177. package: 'Kernel-Announcements'!
  178. SystemAnnouncement subclass: #PackageAnnouncement
  179. instanceVariableNames: 'package'
  180. package: 'Kernel-Announcements'!
  181. !PackageAnnouncement methodsFor: 'accessing'!
  182. package
  183. ^ package
  184. !
  185. package: aPackage
  186. package := aPackage
  187. ! !
  188. PackageAnnouncement subclass: #PackageAdded
  189. instanceVariableNames: ''
  190. package: 'Kernel-Announcements'!
  191. PackageAnnouncement subclass: #PackageRemoved
  192. instanceVariableNames: ''
  193. package: 'Kernel-Announcements'!
  194. SystemAnnouncement subclass: #ProtocolAnnouncement
  195. instanceVariableNames: 'theClass protocol'
  196. package: 'Kernel-Announcements'!
  197. !ProtocolAnnouncement methodsFor: 'accessing'!
  198. protocol
  199. ^ protocol
  200. !
  201. protocol: aString
  202. protocol := aString
  203. !
  204. theClass
  205. ^ theClass
  206. !
  207. theClass: aClass
  208. theClass := aClass
  209. ! !
  210. ProtocolAnnouncement subclass: #ProtocolAdded
  211. instanceVariableNames: ''
  212. package: 'Kernel-Announcements'!
  213. ProtocolAnnouncement subclass: #ProtocolRemoved
  214. instanceVariableNames: ''
  215. package: 'Kernel-Announcements'!