'From Squeak3.2alpha of 14 October 2001 [latest update: #4599] on 5 January 2002 at 12:32:03 pm'! "Change Set: UnixVMMaker Date: 5 January 2002 Author: Lex Spoon A Unix-flavored VMMaker. Also, this adds the ability for VMMaker subclasses to choose whether plugins can be compiled just internally, or just externally, in addition to whether they can be compiled at all"! VMMaker subclass: #UnixVMMaker instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'VMConstruction-Building'! !UnixVMMaker commentStamp: 'ls 1/5/2002 12:13' prior: 0! A Unix-flavored VM maker.! !VMMaker methodsFor: 'plugin lists' stamp: 'ls 1/5/2002 12:16'! canSupportPluginExternally: pluginClassName "see if this plugin can be compiled externally. If this method is called, then it can be assumed thot canSupportPlugin: returned true" ^true! ! !VMMaker methodsFor: 'plugin lists' stamp: 'ls 1/5/2002 12:16'! canSupportPluginInternally: pluginClassName "see if this plugin can be compiled internally. If this method is called, then it can be assumed thot canSupportPlugin: returned true" ^true! ! !VMMaker methodsFor: 'UI access' stamp: 'ls 1/5/2002 12:27'! availableExternalPlugins allPlugins ifNil:[self initializeAllPlugins]. ^allPlugins select: [ :pluginName | self canSupportPluginExternally: pluginName ] ! ! !VMMaker methodsFor: 'UI access' stamp: 'ls 1/5/2002 12:27'! availableInternalPlugins allPlugins ifNil:[self initializeAllPlugins]. ^allPlugins select: [ :pluginName | self canSupportPluginInternally: pluginName ] ! ! !VMMaker methodsFor: 'UI access' stamp: 'ls 1/5/2002 12:27'! makeAllModulesExternal self initializeAllPlugins. self internal: #() external: self availableExternalPlugins. self changed: #reinitialize ! ! !VMMaker methodsFor: 'UI access' stamp: 'ls 1/5/2002 12:27'! makeAllModulesInternal self initializeAllPlugins. self internal: self availableInternalPlugins external: #(). self changed: #reinitialize ! ! !VMMaker methodsFor: 'UI access' stamp: 'ls 1/5/2002 12:20'! movePlugin: pluginName from: srcListName to: dstListName "the VMMakerTool UI has been used to drag a plugin from one list to another " "we need to do some tests - are the lists actually ours? is the plugin ours? is the destination list one where we must check the plugin for acceptability? " | dstList srcList | dstList _ self listOfName: dstListName. srcList _ self listOfName: srcListName. dstList == allPlugins ifTrue: [^dstList add: (srcList remove: pluginName)]. "the dest must be internal or external, so check the plugin for acceptability " (self canSupportPlugin: pluginName) ifFalse: [ ^self ]. "check that the plugin is allowed specifically in the requested list" dstList == internalPlugins ifTrue: [ (self canSupportPluginInternally: pluginName) ifFalse: [ ^self ] ]. dstList == externalPlugins ifTrue: [ (self canSupportPluginExternally: pluginName) ifFalse: [ ^self ] ]. "all is well -- move the plugin to the new list" dstList add: (srcList remove: pluginName)! ! !UnixVMMaker methodsFor: 'plugin lists' stamp: 'ls 1/5/2002 12:23'! canSupportPluginInternally: pluginClassName "if the file 'external-only' is in the plugin directory, then don't allow the plugin to be compiled internally; internal plugins aren't given their own directory to compile in, and so they must be relatively simple to be compiled internally" | pluginClass pluginDirectory | pluginClass _ Smalltalk classNamed: pluginClassName. pluginDirectory := self platformPluginsDirectory directoryNamed: pluginClass moduleName. (pluginDirectory isAFileNamed: 'external-only') ifTrue: [ ^false ]. ^ true! ! !UnixVMMaker class methodsFor: 'initialisation' stamp: 'ls 1/5/2002 12:24'! isActiveVMMakerClass ^Smalltalk platformName = 'unix'! ! !UnixVMMaker class methodsFor: 'initialisation' stamp: 'ls 1/5/2002 12:24'! isActiveVMMakerClassFor: platformName ^platformName = 'unix'! !