2
0

Kernel-Announcements.st 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241
  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 isKindOf: self announcementClass
  28. ! !
  29. Object subclass: #Announcer
  30. instanceVariableNames: 'registry subscriptions'
  31. package: 'Kernel-Announcements'!
  32. !Announcer commentStamp!
  33. The code is based on the announcements as [described by Vassili Bykov](http://www.cincomsmalltalk.com/userblogs/vbykov/blogView?searchCategory=Announcements%20Framework).
  34. The Announcer holds annoncement subscriptions (`AnnouncementSubscription`) in a private registry.
  35. Use `#on:do:` to register subscriptions.!
  36. !Announcer methodsFor: 'announcing'!
  37. announce: anAnnouncement
  38. subscriptions do: [:each |
  39. each deliver: anAnnouncement]
  40. ! !
  41. !Announcer methodsFor: 'initialization'!
  42. initialize
  43. super initialize.
  44. subscriptions := Array new
  45. ! !
  46. !Announcer methodsFor: 'subscribing'!
  47. on: aClass do: aBlock
  48. subscriptions add: (AnnouncementSubscription new
  49. block: aBlock;
  50. announcementClass: aClass;
  51. yourself)
  52. ! !
  53. Announcer subclass: #SystemAnnouncer
  54. instanceVariableNames: ''
  55. package: 'Kernel-Announcements'!
  56. !SystemAnnouncer commentStamp!
  57. My unique instance #current is the global announcer handling all Amber system-related announces!
  58. SystemAnnouncer class instanceVariableNames: 'current'!
  59. !SystemAnnouncer class methodsFor: 'accessing'!
  60. current
  61. ^ current ifNil: [ current := super new ]
  62. ! !
  63. !SystemAnnouncer class methodsFor: 'instance creation'!
  64. new
  65. self shouldNotImplement
  66. ! !
  67. Object subclass: #SystemAnnouncement
  68. instanceVariableNames: 'theClass'
  69. package: 'Kernel-Announcements'!
  70. !SystemAnnouncement commentStamp!
  71. I am the superclass of all system announcements!
  72. !SystemAnnouncement methodsFor: 'accessing'!
  73. theClass
  74. ^ theClass
  75. !
  76. theClass: aClass
  77. theClass := aClass
  78. ! !
  79. SystemAnnouncement subclass: #ClassAnnouncement
  80. instanceVariableNames: 'theClass'
  81. package: 'Kernel-Announcements'!
  82. !ClassAnnouncement methodsFor: 'accessing'!
  83. theClass
  84. ^ theClass
  85. !
  86. theClass: aClass
  87. theClass := aClass
  88. ! !
  89. ClassAnnouncement subclass: #ClassAdded
  90. instanceVariableNames: ''
  91. package: 'Kernel-Announcements'!
  92. !ClassAdded commentStamp!
  93. I am emitted when a class is added to the system.
  94. See ClassBuilder >> #addSubclassOf:... methods!
  95. ClassAnnouncement subclass: #ClassCommentChanged
  96. instanceVariableNames: ''
  97. package: 'Kernel-Announcements'!
  98. !ClassCommentChanged commentStamp!
  99. I am emitted when the comment of a class changes. (Behavior >> #comment)!
  100. ClassAnnouncement subclass: #ClassDefinitionChanged
  101. instanceVariableNames: ''
  102. package: 'Kernel-Announcements'!
  103. !ClassDefinitionChanged commentStamp!
  104. I am emitted when the defintion of a class changes.
  105. See ClassBuilder >> #class:instanceVariableNames:!
  106. ClassAnnouncement subclass: #ClassRemoved
  107. instanceVariableNames: ''
  108. package: 'Kernel-Announcements'!
  109. !ClassRemoved commentStamp!
  110. I am emitted when a class is removed.
  111. See Smalltalk >> #removeClass:!
  112. ClassAnnouncement subclass: #ClassRenamed
  113. instanceVariableNames: ''
  114. package: 'Kernel-Announcements'!
  115. !ClassRenamed commentStamp!
  116. I am emitted when a class is renamed.
  117. See ClassBuilder >> #renameClass:to:!
  118. SystemAnnouncement subclass: #MethodAnnouncement
  119. instanceVariableNames: 'method'
  120. package: 'Kernel-Announcements'!
  121. !MethodAnnouncement methodsFor: 'accessing'!
  122. method
  123. ^ method
  124. !
  125. method: aCompiledMethod
  126. method := aCompiledMethod
  127. ! !
  128. MethodAnnouncement subclass: #MethodAdded
  129. instanceVariableNames: ''
  130. package: 'Kernel-Announcements'!
  131. MethodAnnouncement subclass: #MethodModified
  132. instanceVariableNames: 'oldMethod'
  133. package: 'Kernel-Announcements'!
  134. !MethodModified methodsFor: 'accessing'!
  135. oldMethod
  136. ^ oldMethod
  137. !
  138. oldMethod: aMethod
  139. oldMethod := aMethod
  140. ! !
  141. MethodAnnouncement subclass: #MethodRemoved
  142. instanceVariableNames: ''
  143. package: 'Kernel-Announcements'!
  144. SystemAnnouncement subclass: #PackageAnnouncement
  145. instanceVariableNames: 'package'
  146. package: 'Kernel-Announcements'!
  147. !PackageAnnouncement methodsFor: 'accessing'!
  148. package
  149. ^ package
  150. !
  151. package: aPackage
  152. package := aPackage
  153. ! !
  154. PackageAnnouncement subclass: #PackageAdded
  155. instanceVariableNames: ''
  156. package: 'Kernel-Announcements'!
  157. PackageAnnouncement subclass: #PackageRemoved
  158. instanceVariableNames: ''
  159. package: 'Kernel-Announcements'!
  160. SystemAnnouncement subclass: #ProtocolAnnouncement
  161. instanceVariableNames: 'theClass protocol'
  162. package: 'Kernel-Announcements'!
  163. !ProtocolAnnouncement methodsFor: 'accessing'!
  164. protocol
  165. ^ protocol
  166. !
  167. protocol: aString
  168. protocol := aString
  169. !
  170. theClass
  171. ^ theClass
  172. !
  173. theClass: aClass
  174. theClass := aClass
  175. ! !
  176. ProtocolAnnouncement subclass: #ProtocolAdded
  177. instanceVariableNames: ''
  178. package: 'Kernel-Announcements'!
  179. ProtocolAnnouncement subclass: #ProtocolRemoved
  180. instanceVariableNames: ''
  181. package: 'Kernel-Announcements'!