Smalltalk current createPackage: 'Kernel-Announcements'! Object subclass: #AnnouncementSubscription instanceVariableNames: 'valuable announcementClass' package: 'Kernel-Announcements'! !AnnouncementSubscription commentStamp! The subscription is a single entry in a subscription registry of an `Announcer`. Several subscriptions by the same object is possible.! !AnnouncementSubscription methodsFor: 'accessing'! announcementClass ^ announcementClass ! announcementClass: aClass announcementClass := aClass ! block "Use #valuable instead" self deprecatedAPI. ^ self valuable ! block: aValuable "Use #valuable instead" self deprecatedAPI. self valuable: aValuable ! receiver ^ self valuable receiver ! valuable ^ valuable ! valuable: aValuable valuable := aValuable ! ! !AnnouncementSubscription methodsFor: 'announcing'! deliver: anAnnouncement (self handlesAnnouncement: anAnnouncement) ifTrue: [self valuable value: anAnnouncement] ! handlesAnnouncement: anAnnouncement "anAnnouncement might be announced from within another Amber environment" ^ (Smalltalk current at: self announcementClass name) ifNil: [ ^ false ] ifNotNil: [ :class | class includesBehavior: (Smalltalk current at: anAnnouncement class theNonMetaClass name) ] ! ! Object subclass: #Announcer instanceVariableNames: 'registry subscriptions' package: 'Kernel-Announcements'! !Announcer commentStamp! The code is based on the announcements as [described by Vassili Bykov](http://www.cincomsmalltalk.com/userblogs/vbykov/blogView?searchCategory=Announcements%20Framework). The Announcer holds annoncement subscriptions (`AnnouncementSubscription`) in a private registry. Use `#on:do:` to register subscriptions.! !Announcer methodsFor: 'announcing'! announce: anAnnouncement subscriptions do: [ :each | each deliver: anAnnouncement ] ! ! !Announcer methodsFor: 'initialization'! initialize super initialize. subscriptions := Array new ! ! !Announcer methodsFor: 'subscribing'! on: aClass do: aBlock subscriptions add: (AnnouncementSubscription new valuable: aBlock; announcementClass: aClass; yourself) ! ! Announcer subclass: #SystemAnnouncer instanceVariableNames: '' package: 'Kernel-Announcements'! !SystemAnnouncer commentStamp! My unique instance #current is the global announcer handling all Amber system-related announces! SystemAnnouncer class instanceVariableNames: 'current'! !SystemAnnouncer class methodsFor: 'accessing'! current ^ current ifNil: [ current := super new ] ! ! !SystemAnnouncer class methodsFor: 'instance creation'! new self shouldNotImplement ! ! Object subclass: #SystemAnnouncement instanceVariableNames: 'theClass' package: 'Kernel-Announcements'! !SystemAnnouncement commentStamp! I am the superclass of all system announcements! !SystemAnnouncement methodsFor: 'accessing'! theClass ^ theClass ! theClass: aClass theClass := aClass ! ! SystemAnnouncement subclass: #ClassAnnouncement instanceVariableNames: 'theClass' package: 'Kernel-Announcements'! !ClassAnnouncement methodsFor: 'accessing'! theClass ^ theClass ! theClass: aClass theClass := aClass ! ! ClassAnnouncement subclass: #ClassAdded instanceVariableNames: '' package: 'Kernel-Announcements'! !ClassAdded commentStamp! I am emitted when a class is added to the system. See ClassBuilder >> #addSubclassOf:... methods! ClassAnnouncement subclass: #ClassCommentChanged instanceVariableNames: '' package: 'Kernel-Announcements'! !ClassCommentChanged commentStamp! I am emitted when the comment of a class changes. (Behavior >> #comment)! ClassAnnouncement subclass: #ClassDefinitionChanged instanceVariableNames: '' package: 'Kernel-Announcements'! !ClassDefinitionChanged commentStamp! I am emitted when the defintion of a class changes. See ClassBuilder >> #class:instanceVariableNames:! ClassAnnouncement subclass: #ClassMigrated instanceVariableNames: 'oldClass' package: 'Kernel-Announcements'! !ClassMigrated methodsFor: 'accessing'! oldClass ^ oldClass ! oldClass: aClass oldClass := aClass ! ! ClassAnnouncement subclass: #ClassMoved instanceVariableNames: 'oldPackage' package: 'Kernel-Announcements'! !ClassMoved methodsFor: 'accessing'! oldPackage ^ oldPackage ! oldPackage: aPackage oldPackage := aPackage ! ! ClassAnnouncement subclass: #ClassRemoved instanceVariableNames: '' package: 'Kernel-Announcements'! !ClassRemoved commentStamp! I am emitted when a class is removed. See Smalltalk >> #removeClass:! ClassAnnouncement subclass: #ClassRenamed instanceVariableNames: '' package: 'Kernel-Announcements'! !ClassRenamed commentStamp! I am emitted when a class is renamed. See ClassBuilder >> #renameClass:to:! SystemAnnouncement subclass: #MethodAnnouncement instanceVariableNames: 'method' package: 'Kernel-Announcements'! !MethodAnnouncement methodsFor: 'accessing'! method ^ method ! method: aCompiledMethod method := aCompiledMethod ! ! MethodAnnouncement subclass: #MethodAdded instanceVariableNames: '' package: 'Kernel-Announcements'! MethodAnnouncement subclass: #MethodModified instanceVariableNames: 'oldMethod' package: 'Kernel-Announcements'! !MethodModified methodsFor: 'accessing'! oldMethod ^ oldMethod ! oldMethod: aMethod oldMethod := aMethod ! ! MethodAnnouncement subclass: #MethodMoved instanceVariableNames: 'oldProtocol' package: 'Kernel-Announcements'! !MethodMoved methodsFor: 'accessing'! oldProtocol ^ oldProtocol ! oldProtocol: aString oldProtocol := aString ! ! MethodAnnouncement subclass: #MethodRemoved instanceVariableNames: '' package: 'Kernel-Announcements'! SystemAnnouncement subclass: #PackageAnnouncement instanceVariableNames: 'package' package: 'Kernel-Announcements'! !PackageAnnouncement methodsFor: 'accessing'! package ^ package ! package: aPackage package := aPackage ! ! PackageAnnouncement subclass: #PackageAdded instanceVariableNames: '' package: 'Kernel-Announcements'! PackageAnnouncement subclass: #PackageRemoved instanceVariableNames: '' package: 'Kernel-Announcements'! SystemAnnouncement subclass: #ProtocolAnnouncement instanceVariableNames: 'theClass protocol' package: 'Kernel-Announcements'! !ProtocolAnnouncement methodsFor: 'accessing'! protocol ^ protocol ! protocol: aString protocol := aString ! theClass ^ theClass ! theClass: aClass theClass := aClass ! ! ProtocolAnnouncement subclass: #ProtocolAdded instanceVariableNames: '' package: 'Kernel-Announcements'! ProtocolAnnouncement subclass: #ProtocolRemoved instanceVariableNames: '' package: 'Kernel-Announcements'!