'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 2 April 2003 at 3:33:03 pm'! Object subclass: #AppRegistry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Applications'! !AppRegistry commentStamp: 'ads 4/2/2003 15:30' prior: 0! AppRegistry is a simple little class, not much more than a wrapper around a collection. It's intended to help break dependencies between packages. For example, if you'd like to be able to send e-mail, you could use the bare-bones MailComposition class, or you could use the full-blown Celeste e-mail client. Instead of choosing one or the other, you can call "MailSender default" (where MailSender is a subclass of AppRegistry), and thus avoid creating a hard-coded dependency on either of the two mail senders. This will only really be useful, of course, for applications that have a very simple, general, well-defined interface. Most of the time, you're probably better off just marking your package as being dependent on a specific other package, and avoiding the hassle of this whole AppRegistry thing. But for simple things like e-mail senders or web browsers, it might be useful. ! AppRegistry class instanceVariableNames: 'registeredClasses default '! !AppRegistry methodsFor: 'as yet unclassified' stamp: 'ads 4/2/2003 15:04'! seeClassSide "All the code for AppRegistry is on the class side."! ! !AppRegistry class methodsFor: 'as yet unclassified' stamp: 'ads 3/29/2003 13:36'! appName "Defaults to the class name, which is probably good enough, but you could override this in subclasses if you want to." ^ self name! ! !AppRegistry class methodsFor: 'as yet unclassified' stamp: 'ads 4/2/2003 15:31'! askForDefault | menu | self registeredClasses isEmpty ifTrue: [self inform: 'There are no ', self appName, ' applications registered.'. ^ default _ nil]. self registeredClasses size = 1 ifTrue: [^ default _ self registeredClasses anyOne]. menu _ CustomMenu new. self registeredClasses do: [:c | menu add: c name printString action: c]. ^ default _ menu startUpWithCaption: 'Which ', self appName, ' would you prefer?'! ! !AppRegistry class methodsFor: 'as yet unclassified' stamp: 'ads 3/29/2003 13:11'! default ^ default ifNil: [self askForDefault]! ! !AppRegistry class methodsFor: 'as yet unclassified' stamp: 'ads 4/2/2003 15:25'! register: aProviderClass (self registeredClasses includes: aProviderClass) ifFalse: [default _ nil. "so it'll ask for a new default, since if you're registering a new app you probably want to use it" self registeredClasses add: aProviderClass].! ! !AppRegistry class methodsFor: 'as yet unclassified' stamp: 'ads 3/29/2003 13:01'! registeredClasses ^ registeredClasses ifNil: [registeredClasses _ OrderedCollection new]! ! !AppRegistry class methodsFor: 'as yet unclassified' stamp: 'ads 3/29/2003 13:03'! unregister: aProviderClass (default = aProviderClass) ifTrue: [default _ nil]. self registeredClasses remove: aProviderClass ifAbsent: [].! !