1
0

Kernel-Announcements.st 7.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347
  1. Smalltalk current createPackage: 'Kernel-Announcements'!
  2. Object subclass: #AnnouncementSubscription
  3. instanceVariableNames: 'valuable announcementClass'
  4. package: 'Kernel-Announcements'!
  5. !AnnouncementSubscription commentStamp!
  6. I am 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. "Use #valuable instead"
  17. self deprecatedAPI.
  18. ^ self valuable
  19. !
  20. block: aValuable
  21. "Use #valuable instead"
  22. self deprecatedAPI.
  23. self valuable: aValuable
  24. !
  25. receiver
  26. ^ self valuable receiver
  27. !
  28. valuable
  29. ^ valuable
  30. !
  31. valuable: aValuable
  32. valuable := aValuable
  33. ! !
  34. !AnnouncementSubscription methodsFor: 'announcing'!
  35. deliver: anAnnouncement
  36. (self handlesAnnouncement: anAnnouncement)
  37. ifTrue: [self valuable value: anAnnouncement]
  38. !
  39. handlesAnnouncement: anAnnouncement
  40. "anAnnouncement might be announced from within another Amber environment"
  41. ^ (Smalltalk current at: self announcementClass name)
  42. ifNil: [ ^ false ]
  43. ifNotNil: [ :class |
  44. class includesBehavior: (Smalltalk current at: anAnnouncement class theNonMetaClass name) ]
  45. ! !
  46. Object subclass: #Announcer
  47. instanceVariableNames: 'registry subscriptions'
  48. package: 'Kernel-Announcements'!
  49. !Announcer commentStamp!
  50. I hold annoncement subscriptions (instances of `AnnouncementSubscription`) in a private registry.
  51. I announce (trigger) announces, which are then dispatched to all subscriptions.
  52. The code is based on the announcements as [described by Vassili Bykov](http://www.cincomsmalltalk.com/userblogs/vbykov/blogView?searchCategory=Announcements%20Framework).
  53. ## API
  54. Use `#announce:` to trigger an announcement.
  55. Use `#on:do:` or `#on:send:to:` to register subscriptions.
  56. When using `#on:send:to:`, unregistration can be done with `#unregister:`.
  57. ## Usage example:
  58. SystemAnnouncer current
  59. on: ClassAdded
  60. do: [ :ann | window alert: ann theClass name, ' added' ].!
  61. !Announcer methodsFor: 'announcing'!
  62. announce: anAnnouncement
  63. subscriptions do: [ :each |
  64. each deliver: anAnnouncement ]
  65. ! !
  66. !Announcer methodsFor: 'initialization'!
  67. initialize
  68. super initialize.
  69. subscriptions := OrderedCollection new
  70. ! !
  71. !Announcer methodsFor: 'subscribing'!
  72. on: aClass do: aBlock
  73. subscriptions add: (AnnouncementSubscription new
  74. valuable: aBlock;
  75. announcementClass: aClass;
  76. yourself)
  77. !
  78. on: aClass send: aSelector to: anObject
  79. subscriptions add: (AnnouncementSubscription new
  80. valuable: (MessageSend new
  81. receiver: anObject;
  82. selector: aSelector;
  83. yourself);
  84. announcementClass: aClass;
  85. yourself)
  86. !
  87. unsubscribe: anObject
  88. subscriptions := subscriptions reject: [ :each |
  89. each receiver = anObject ]
  90. ! !
  91. Announcer subclass: #SystemAnnouncer
  92. instanceVariableNames: ''
  93. package: 'Kernel-Announcements'!
  94. !SystemAnnouncer commentStamp!
  95. My unique instance is the global announcer handling all Amber system-related announces.
  96. ## API
  97. Access to the unique instance is done via `#current`!
  98. SystemAnnouncer class instanceVariableNames: 'current'!
  99. !SystemAnnouncer class methodsFor: 'accessing'!
  100. current
  101. ^ current ifNil: [ current := super new ]
  102. ! !
  103. !SystemAnnouncer class methodsFor: 'instance creation'!
  104. new
  105. self shouldNotImplement
  106. ! !
  107. Object subclass: #SystemAnnouncement
  108. instanceVariableNames: 'theClass'
  109. package: 'Kernel-Announcements'!
  110. !SystemAnnouncement commentStamp!
  111. I am the superclass of all system announcements!
  112. !SystemAnnouncement methodsFor: 'accessing'!
  113. theClass
  114. ^ theClass
  115. !
  116. theClass: aClass
  117. theClass := aClass
  118. ! !
  119. SystemAnnouncement subclass: #ClassAnnouncement
  120. instanceVariableNames: 'theClass'
  121. package: 'Kernel-Announcements'!
  122. !ClassAnnouncement commentStamp!
  123. I am the abstract superclass of class-related announcements.!
  124. !ClassAnnouncement methodsFor: 'accessing'!
  125. theClass
  126. ^ theClass
  127. !
  128. theClass: aClass
  129. theClass := aClass
  130. ! !
  131. ClassAnnouncement subclass: #ClassAdded
  132. instanceVariableNames: ''
  133. package: 'Kernel-Announcements'!
  134. !ClassAdded commentStamp!
  135. I am emitted when a class is added to the system.
  136. See ClassBuilder >> #addSubclassOf:... methods!
  137. ClassAnnouncement subclass: #ClassCommentChanged
  138. instanceVariableNames: ''
  139. package: 'Kernel-Announcements'!
  140. !ClassCommentChanged commentStamp!
  141. I am emitted when the comment of a class changes. (Behavior >> #comment)!
  142. ClassAnnouncement subclass: #ClassDefinitionChanged
  143. instanceVariableNames: ''
  144. package: 'Kernel-Announcements'!
  145. !ClassDefinitionChanged commentStamp!
  146. I am emitted when the definition of a class changes.
  147. See ClassBuilder >> #class:instanceVariableNames:!
  148. ClassAnnouncement subclass: #ClassMigrated
  149. instanceVariableNames: 'oldClass'
  150. package: 'Kernel-Announcements'!
  151. !ClassMigrated commentStamp!
  152. I am emitted when a class is migrated.!
  153. !ClassMigrated methodsFor: 'accessing'!
  154. oldClass
  155. ^ oldClass
  156. !
  157. oldClass: aClass
  158. oldClass := aClass
  159. ! !
  160. ClassAnnouncement subclass: #ClassMoved
  161. instanceVariableNames: 'oldPackage'
  162. package: 'Kernel-Announcements'!
  163. !ClassMoved commentStamp!
  164. I am emitted when a class is moved from one package to another.!
  165. !ClassMoved methodsFor: 'accessing'!
  166. oldPackage
  167. ^ oldPackage
  168. !
  169. oldPackage: aPackage
  170. oldPackage := aPackage
  171. ! !
  172. ClassAnnouncement subclass: #ClassRemoved
  173. instanceVariableNames: ''
  174. package: 'Kernel-Announcements'!
  175. !ClassRemoved commentStamp!
  176. I am emitted when a class is removed.
  177. See Smalltalk >> #removeClass:!
  178. ClassAnnouncement subclass: #ClassRenamed
  179. instanceVariableNames: ''
  180. package: 'Kernel-Announcements'!
  181. !ClassRenamed commentStamp!
  182. I am emitted when a class is renamed.
  183. See ClassBuilder >> #renameClass:to:!
  184. SystemAnnouncement subclass: #MethodAnnouncement
  185. instanceVariableNames: 'method'
  186. package: 'Kernel-Announcements'!
  187. !MethodAnnouncement commentStamp!
  188. I am the abstract superclass of method-related announcements.!
  189. !MethodAnnouncement methodsFor: 'accessing'!
  190. method
  191. ^ method
  192. !
  193. method: aCompiledMethod
  194. method := aCompiledMethod
  195. ! !
  196. MethodAnnouncement subclass: #MethodAdded
  197. instanceVariableNames: ''
  198. package: 'Kernel-Announcements'!
  199. MethodAnnouncement subclass: #MethodModified
  200. instanceVariableNames: 'oldMethod'
  201. package: 'Kernel-Announcements'!
  202. !MethodModified methodsFor: 'accessing'!
  203. oldMethod
  204. ^ oldMethod
  205. !
  206. oldMethod: aMethod
  207. oldMethod := aMethod
  208. ! !
  209. MethodAnnouncement subclass: #MethodMoved
  210. instanceVariableNames: 'oldProtocol'
  211. package: 'Kernel-Announcements'!
  212. !MethodMoved methodsFor: 'accessing'!
  213. oldProtocol
  214. ^ oldProtocol
  215. !
  216. oldProtocol: aString
  217. oldProtocol := aString
  218. ! !
  219. MethodAnnouncement subclass: #MethodRemoved
  220. instanceVariableNames: ''
  221. package: 'Kernel-Announcements'!
  222. SystemAnnouncement subclass: #PackageAnnouncement
  223. instanceVariableNames: 'package'
  224. package: 'Kernel-Announcements'!
  225. !PackageAnnouncement methodsFor: 'accessing'!
  226. package
  227. ^ package
  228. !
  229. package: aPackage
  230. package := aPackage
  231. ! !
  232. PackageAnnouncement subclass: #PackageAdded
  233. instanceVariableNames: ''
  234. package: 'Kernel-Announcements'!
  235. PackageAnnouncement subclass: #PackageRemoved
  236. instanceVariableNames: ''
  237. package: 'Kernel-Announcements'!
  238. SystemAnnouncement subclass: #ProtocolAnnouncement
  239. instanceVariableNames: 'theClass protocol'
  240. package: 'Kernel-Announcements'!
  241. !ProtocolAnnouncement methodsFor: 'accessing'!
  242. protocol
  243. ^ protocol
  244. !
  245. protocol: aString
  246. protocol := aString
  247. !
  248. theClass
  249. ^ theClass
  250. !
  251. theClass: aClass
  252. theClass := aClass
  253. ! !
  254. ProtocolAnnouncement subclass: #ProtocolAdded
  255. instanceVariableNames: ''
  256. package: 'Kernel-Announcements'!
  257. ProtocolAnnouncement subclass: #ProtocolRemoved
  258. instanceVariableNames: ''
  259. package: 'Kernel-Announcements'!