Kernel-Announcements.st 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161
  1. Smalltalk current createPackage: 'Kernel-Announcements' properties: #{}!
  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: #ClassAdded
  80. instanceVariableNames: ''
  81. package: 'Kernel-Announcements'!
  82. !ClassAdded commentStamp!
  83. I am emitted when a class is added to the system.
  84. See ClassBuilder >> #addSubclassOf:... methods!
  85. SystemAnnouncement subclass: #ClassCommentChanged
  86. instanceVariableNames: ''
  87. package: 'Kernel-Announcements'!
  88. !ClassCommentChanged commentStamp!
  89. I am emitted when the comment of a class changes. (Behavior >> #comment)!
  90. SystemAnnouncement subclass: #ClassDefinitionChanged
  91. instanceVariableNames: ''
  92. package: 'Kernel-Announcements'!
  93. !ClassDefinitionChanged commentStamp!
  94. I am emitted when the defintion of a class changes.
  95. See ClassBuilder >> #class:instanceVariableNames:!
  96. SystemAnnouncement subclass: #ClassRemoved
  97. instanceVariableNames: ''
  98. package: 'Kernel-Announcements'!
  99. !ClassRemoved commentStamp!
  100. I am emitted when a class is removed.
  101. See Smalltalk >> #removeClass:!
  102. SystemAnnouncement subclass: #ClassRenamed
  103. instanceVariableNames: ''
  104. package: 'Kernel-Announcements'!
  105. !ClassRenamed commentStamp!
  106. I am emitted when a class is renamed.
  107. See ClassBuilder >> #renameClass:to:!
  108. SystemAnnouncement subclass: #MethodAnnouncement
  109. instanceVariableNames: 'method'
  110. package: 'Kernel-Announcements'!
  111. !MethodAnnouncement methodsFor: 'accessing'!
  112. method
  113. ^ method
  114. !
  115. method: aCompiledMethod
  116. method := aCompiledMethod
  117. ! !
  118. MethodAnnouncement subclass: #MethodAdded
  119. instanceVariableNames: ''
  120. package: 'Kernel-Announcements'!
  121. MethodAnnouncement subclass: #MethodRemoved
  122. instanceVariableNames: ''
  123. package: 'Kernel-Announcements'!