Kernel-Announcements.st 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. Smalltalk current createPackage: 'Kernel-Announcements' properties: #{}!
  2. Object subclass: #AnnouncementSubscription
  3. instanceVariableNames: 'block announcementClass'
  4. package: 'Kernel-Announcements'!
  5. !AnnouncementSubscription methodsFor: 'accessing'!
  6. announcementClass
  7. ^announcementClass
  8. !
  9. announcementClass: aClass
  10. announcementClass := aClass
  11. !
  12. block
  13. ^block
  14. !
  15. block: aBlock
  16. block := aBlock
  17. ! !
  18. !AnnouncementSubscription methodsFor: 'announcing'!
  19. deliver: anAnnouncement
  20. (self handlesAnnouncement: anAnnouncement)
  21. ifTrue: [self block value: anAnnouncement]
  22. !
  23. handlesAnnouncement: anAnnouncement
  24. ^anAnnouncement isKindOf: self announcementClass
  25. ! !
  26. Object subclass: #Announcer
  27. instanceVariableNames: 'registry subscriptions'
  28. package: 'Kernel-Announcements'!
  29. !Announcer methodsFor: 'announcing'!
  30. announce: anAnnouncement
  31. subscriptions do: [:each |
  32. each deliver: anAnnouncement]
  33. ! !
  34. !Announcer methodsFor: 'initialization'!
  35. initialize
  36. super initialize.
  37. subscriptions := Array new
  38. ! !
  39. !Announcer methodsFor: 'subscribing'!
  40. on: aClass do: aBlock
  41. subscriptions add: (AnnouncementSubscription new
  42. block: aBlock;
  43. announcementClass: aClass;
  44. yourself)
  45. ! !
  46. Announcer subclass: #SystemAnnouncer
  47. instanceVariableNames: ''
  48. package: 'Kernel-Announcements'!
  49. !SystemAnnouncer commentStamp!
  50. My unique instance #current is the global announcer handling all Amber system-related announces!
  51. SystemAnnouncer class instanceVariableNames: 'current'!
  52. !SystemAnnouncer class methodsFor: 'accessing'!
  53. current
  54. ^ current ifNil: [ current := super new ]
  55. ! !
  56. !SystemAnnouncer class methodsFor: 'instance creation'!
  57. new
  58. self shouldNotImplement
  59. ! !
  60. Object subclass: #SystemAnnouncement
  61. instanceVariableNames: 'theClass'
  62. package: 'Kernel-Announcements'!
  63. !SystemAnnouncement commentStamp!
  64. I am the superclass of all system announcements!
  65. !SystemAnnouncement methodsFor: 'accessing'!
  66. theClass
  67. ^ theClass
  68. !
  69. theClass: aClass
  70. theClass := aClass
  71. ! !
  72. SystemAnnouncement subclass: #ClassAdded
  73. instanceVariableNames: ''
  74. package: 'Kernel-Announcements'!
  75. !ClassAdded commentStamp!
  76. I am emitted when a class is added to the system.
  77. See ClassBuilder >> #addSubclassOf:... methods!
  78. SystemAnnouncement subclass: #ClassCommentChanged
  79. instanceVariableNames: ''
  80. package: 'Kernel-Announcements'!
  81. !ClassCommentChanged commentStamp!
  82. I am emitted when the comment of a class changes. (Behavior >> #comment)!
  83. SystemAnnouncement subclass: #ClassDefinitionChanged
  84. instanceVariableNames: ''
  85. package: 'Kernel-Announcements'!
  86. !ClassDefinitionChanged commentStamp!
  87. I am emitted when the defintion of a class changes.
  88. See ClassBuilder >> #class:instanceVariableNames:!
  89. SystemAnnouncement subclass: #ClassRemoved
  90. instanceVariableNames: ''
  91. package: 'Kernel-Announcements'!
  92. !ClassRemoved commentStamp!
  93. I am emitted when a class is removed.
  94. See Smalltalk >> #removeClass:!
  95. SystemAnnouncement subclass: #ClassRenamed
  96. instanceVariableNames: ''
  97. package: 'Kernel-Announcements'!
  98. !ClassRenamed commentStamp!
  99. I am emitted when a class is renamed.
  100. See ClassBuilder >> #renameClass:to:!
  101. SystemAnnouncement subclass: #MethodAnnouncement
  102. instanceVariableNames: 'method'
  103. package: 'Kernel-Announcements'!
  104. !MethodAnnouncement methodsFor: 'accessing'!
  105. method
  106. ^ method
  107. !
  108. method: aCompiledMethod
  109. method := aCompiledMethod
  110. ! !
  111. MethodAnnouncement subclass: #MethodAdded
  112. instanceVariableNames: ''
  113. package: 'Kernel-Announcements'!
  114. MethodAnnouncement subclass: #MethodRemoved
  115. instanceVariableNames: ''
  116. package: 'Kernel-Announcements'!