From VisualWorks®, 7.6 of March 3, 2008 on March 3, 2008 at 9:47:04 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <name>Store</name> <environment>Smalltalk</environment> <private>false</private> <imports> private Lens.LensGraphView private Database.ExternalDatabaseConnection private Database.ConnectionDialog private Smalltalk.* </imports> <category>Store-Base</category> <attributes> <package>PackageCategories</package> </attributes> <comment> Store
Store namespace for all Store classes. Contains the global access variables: DbRegistry - for Store database access Resistry - for image related Store queries Policies - for configurable settings
</comment> <class> <name>Changes</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none symbol defChanges dataChanges <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.Changes
Changes is the abstract superclass for NameSpaceChanges and ClassChanges. These are used by the Store XChangeSets to dynamically track changes in packages. They keep track of the type of change made to avoid spurious changes and to produce the reverse change. For example, #add followed by #remove cancel each other out and the reverse of #add is #remove. This is useful when comparing packages and switching directions (ie. to go from packageA to packageB, add the defintion. To go from packageB to packageA, remove it). Subclasses must implement the following messages: accessing modifiedTags - answer Tags for all the modifications removedTags - answer Tags for all removed defintions fileIn/Out fileOutObjectType testing isDefinitionChanged Instance Variables: dataChanges <IdentityDictionary> shared name -> the type of change defChanges <Set of symbols> the set of changes made to the Class or Namespace itself symbol <Symbol> absoluteSymbol of the class/namespace being tracked.
</comment> <class> <name>ClassChanges</name> <environment>Store</environment> <super>Store.Changes</super> <private>false</private> none methodChanges metaMethodChanges <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.ClassChanges
Tracks various types of changes to a Class for use in Store.XChangeSets. instance variables: methodChanges <IdentityDictionary: <symbol>-><symbol>> - selector to change dictionary metaMethodChanges <IdentityDictionary: <symbol>-><symbol>> - selector to change dictionary for class methods
</comment> <class> <name>XChangeSet</name> <environment>Store</environment> <super>Core.IdentityDictionary</super> <private>false</private> objects other properties <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.XChangeSet
Manages changes for an individual package/bundle. A dictionary of Store.Changes keyed by absolute class or namespace name. Instance Variables: other <OrderedCollection of: symbol> general changes, such as property keys or #componentAdded Class Variables: CurrentSet <XMainChangeSet> A singleton that tracks system wide changes and manages inter-package movements.
</comment> <class> <name>XMainChangeSet</name> <environment>Store</environment> <super>Store.XChangeSet</super> <private>false</private> objects reorganizeSystem specialDoIts <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.XMainChangeSet
There is one instance of this class (XChangeSet current). It tracks system wide changes. Instance Variables: reorganizeSystem <IdentitySet of: symbols> NameSpaces that have been reorganized. specialDoIts <Collection> usually nil. So.... not being used.
</comment> <class> <name>BundleStructureChange</name> <environment>Store</environment> <super>Kernel.ComponentChange</super> <private>false</private> none structure <imports></imports> <category>System-Changes</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.BundleStructureChange
Class BundleStructureChange represents the change to the specification of a Bundle. Instance Variables: structure <Array of: (Array with: Symbol with: String)> An array of two-element arrays. The two-element array holds the type of CodeComponent (#bundle #package) and the name
</comment> <class> <name>PundleForParcel</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none name properties contents <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.PundleForParcel
An abstract superclass for pundle/package conversions. Handles everything not related to contents,which are package/bundle specific. These classes are to save the bundle structure in parcels. They are saved in parcels and converted to pundles after loading. NOTE: Updating for packages is not yet supported. Instance Variables: name <string> pundle name properties <IndentityDictionary> pundle properties contents <Object> subclass specfic.
</comment> <class> <name>StoreError</name> <environment>Store</environment> <super>Core.Error</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.StoreError
StoreError is the abstract superclass for Store errors. It exists to group the errors as in "on: StoreError do:"
</comment> <class> <name>ComponentDescription</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none dbIdentifier id componentName fileName <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.ComponentDescription
ComponentDescription is a abstract superclass that describes components or prerequisites of a bundle. Is also provides the data structure when saving a bundle into the file. Instance Variables: dbIdentifier <Symbol> identifies the database that the id points to id <Integer> primaryKey (aka dbTrace) of the component in the database componentName <String> component name fileName <FileName> obsolete. TBR at a later date. Shared Variables: CannotLoadComponentSignal <Signal> Sigaled when component load aborted CannotStoreComponentSignal <Signal> CannotUnloadComponentSignal <Signal> Sigaled when component unload aborted
</comment> <class> <name>PackageDescription</name> <environment>Store</environment> <super>Store.ComponentDescription</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.PackageDescription
Represents a package as a component or a prerequsite.
</comment> <class> <name>DatabaseConnectionInformation</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none pundle dbIdentifier dbTrace changeSet versionString <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.DatabaseConnectionInformation
For tracking connections to different database. Instance Variables: pundle <PundleModel | BundleModel> The pundle this connection is for. dbIdentifier <String> The name of the database this connection is to. nil if unhooked. dbTrace <Integer> The primary key of the parent package record. nil if unhooked. changeSet <XChangeSet> Changes for the owning package for this database. versionString <String | nil > The cached versionString. nil if unknown.
</comment> <class> <name>DatabaseConnectionBundleInformation</name> <environment>Store</environment> <super>Store.DatabaseConnectionInformation</super> <private>false</private> none contentDescriptions fileDescriptions <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.DatabaseConnectionBundleInformation
Specialized DatabaseConnectionBundleInformation for tracking bundle content descriptions. Instance Variables: contentDescriptions <List of: PundleDescriptions> - tracks bundle contents and their db links.
</comment> <class> <name>UnloadedObjectError</name> <environment>Store</environment> <super>Store.StoreError</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.UnloadedObjectError
UnloadedObjectError is signalled when an object that Store expects to exist in the system, doesn't.
</comment> <class> <name>BasicPackagePolicy</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none alwaysUse newClassUseCurrent newNameSpaceUseCurrent newMethodUseCurrent newMethodUseClassIfNoCurrent newMethodUseClassIfCurrentSame newMethodUseClass newDatumUseCurrent newDatumUseClassIfNoCurrent newDatumUseClassIfCurrentSame newDatumUseClass warnOnFirstModification <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.BasicPackagePolicy
When a new definition (a new class, new method, new namespace or new shared variable) is introduced to the system, BasicPackagePolicy is asked which package should own the definition. The system's sole instance of BasicPackagePolicy is owned by the Policies (an instance of Access) global in the Store name space. For a new class or a new namespace definition, this policy helps decide whether the system should use the current package, or if the client should be prompted for a package to use. For a new method or a new shared variable, there are more choices. For example with a new method the choices are: Current (#currentINAU - in the settings framework) Use the current package. The instance variable, newMethodUseCurrent is set to true. The instance variables newMethodUseClass, newMethodUseClassIfCurrentSame and newMethodUseClassIfNoCurrent are set to false. Current or class package (#currentINUTCP - in the settings framework) Use the current package or package that defines the class. The instance variables, newMethodUseCurrent and newMethodUseClass are set to true. The instance variables newMethodUseClassIfCurrentSame and newMethodUseClassIfNoCurrent are set to false. Class package (#useTCP - in the settings framework) Use the package that defines the class. The instance variable newMethodUseClass is set to true. The instance variables newMethodUseCurrent, newMethodUseClassIfCurrentSame and newMethodUseClassIfNoCurrent are set to false. Class if same as current (#useTCPIC - in the settings framework) The instance variable newMethodUseClass and newMethodUseClassIfCurrentSame are set to true. The instance variables newMethodUseCurrent and newMethodUseClassIfNoCurrent are set to false. Class if same as current or none (#useTCPICON - in the settings framework) The instance variables newMethodUseClassIfCurrentSame and newMethodUseClassIfNoCurrent are set to true. The instance variables newMethodUseClass and newMethodUseCurrent are set to false. Always prompt Always prompt the client. The instance variables newMethodUseClassIfNoCurrent, newMethodUseClass, newMethodUseCurrent and newMethodUseClassIfNoCurrent are set to false. The same set of rules applies to shared variables in a name space or class. This policy also provides the ability to override the current settings, but allowing one to set alwaysUse to be the package to always use. The system uses this feature by calling the #forcePackage:while: method. Instance Variables: alwaysUse <PackageModel> The package that the policy is being forced to use. newClassUseCurrent <Boolean> Described above. newDatumUseClass <Boolean> Described above newDatumUseClassIfCurrentSame <Boolean> Described above newDatumUseClassIfNoCurrent <Boolean> Described above newDatumUseCurrent <Boolean> Described above newMethodUseClass <Boolean> Described above newMethodUseClassIfCurrentSame <Boolean> Described above newMethodUseClassIfNoCurrent <Boolean> Described above newMethodUseCurrent <Boolean> Described above newNameSpaceUseCurrent <Boolean> Described above warnOnFirstModification <Boolean> If true, warn the client that the package is being modified for the first time
</comment> <class> <name>PackageForParcel</name> <environment>Store</environment> <super>Store.PundleForParcel</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.PackageForParcel
Represents packages within a parcel.
</comment> <class> <name>Model</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.Model
Abstract superclass for image models.
</comment> <class> <name>DefNameSpaceModel</name> <environment>Store</environment> <super>Store.Model</super> <private>false</private> none package name environmentString <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.DefNameSpaceModel
Represents a namespace within a package that includes the definition and comment. Instance Variables: package <PackageModel> the receiver's package name <Symbol> the NameSpace name. environmentString <String> The absolute path of the NameSpace. The definition namespace model operates on the principle that most statics will be in the same package as the namespace. Any static that is not explicitly in another package is assumed to belong to the receiver's package. This is foot print savings at the cost of some confusion in static status.
</comment> <class> <name>StoreWarning</name> <environment>Store</environment> <super>Core.Warning</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.StoreWarning
It appears that StoreWarning existed to supress warnings about duplicate adds and what not. However, it doesn't appear to be doing much now.
</comment> <class> <name>PseudoRecord</name> <environment>Store</environment> <super>Store.Model</super> <private>false</private> none <imports></imports> <category>Store-ImageModel</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.PseudoRecord
Abstract superclass. PseudoRecords substitute for image models. They are used in comparison browsers to represent definitions that don't exist or as a generic model when the real model is not known..
</comment> <class> <name>NameSpaceDescriptor</name> <environment>Store</environment> <super>Store.PseudoRecord</super> <private>false</private> none fullName <imports></imports> <category>Store-IMG-Records</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.NameSpaceDescriptor
Represents a NameSpace which may or may not exist in the image. Instance Variables: fullName <String> absoluteName of the NameSpace
</comment> <class> <name>BundleForParcel</name> <environment>Store</environment> <super>Store.PundleForParcel</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.BundleForParcel
Represents bundles within a parcel. Instance Variables: contents <OrderedCollection> pundles
</comment> <class> <name>Change</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none type classSymbol meta nameSpaceSymbol subdef key <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.Change
Missing comment
</comment> <class> <name>ComponentRelatedChange</name> <environment>Store</environment> <super>Store.Change</super> <private>false</private> none tag <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.ComponentRelatedChange
An extension to Changes that tracks CodeComponent changes for ChangeSets. Instance Variables: tag <AbstractTag> the change
</comment> <class> <name>NameSpaceChanges</name> <environment>Store</environment> <super>Store.Changes</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.NameSpaceChanges
Tracks various types of changes to a NameSpace for use in Store.XChangeSets.
</comment> <class> <name>DatumDescriptor</name> <environment>Store</environment> <super>Store.PseudoRecord</super> <private>false</private> none dataKey nameSpaceName className <imports></imports> <category>Store-IMG-Subdefs</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.DatumDescriptor
DatumDescriptor provides a model for a shared variable that lives in a namespace or the namespace of a class. Instance Variables: dataKey <Symbol> The name of this SharedVariable nameSpaceName <String | nil> The absolute name of the namespace where this shared variable, nil if it belongs in the namespace of a class. className <String | nil> The absolute name of the class whose namespace this shared variable belongs to, nil if it belongs in a namespace proper.
</comment> <class> <name>Access</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none blessingPolicy mergePolicy packagePolicy versionPolicy publishPolicy ownershipPolicy prerequisitePolicy filePolicy <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.Access
The singleton is Store.Policies, which is simply an accessor for the current set of Store policies. These policies are meant as user subclassable customizations. Many get their values from the Store/Settings dialog. Instance Variables: blessingPolicy <BasicBlessingPolicy or subclass> Describes the available and default blessing levels. mergePolicy <BasicMergePolicy or subclass> Provides the merge tool a critera to use when performing a packagePolicy <BasicPackagePolicy or subclass> Determines which package should own new definitions (method, versionPolicy <BasicVersionPolicy or subclass> Determines how to increment the version string when publishing. publishPolicy <BasicPublishPolicy or subclass> Determines whether a client can publish a pundle. ownershipPolicy <BasicOwnershipPolicy or subclass> Provides a mechanism for how to determine who owns a pundle. prerequisitePolicy <BasicPrerequisitePolicy or subclass> Provides a mechanism for how to resolve development prerequisites filePolicy Class Instance Variables:
</comment> <class> <name>ModelForParcel</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none object hasDefinition data <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.ModelForParcel
ModelForParcel is an abstract superclass for NameSpaceForParcel and ClassForParcel. These are used within PackageForParcel to store Package information in a parcel needed to restore the bundle structure. Instance Variables: data <Collection of Symbols> - shareds owned by the package hasDefinition <Boolean> true if this package contains the object definition object <Class | NameSpace> the object we are modeling
</comment> <class> <name>NameSpaceForParcel</name> <environment>Store</environment> <super>Store.ModelForParcel</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.NameSpaceForParcel
NameSpaceForParcel is used to reflect namespaces for a package in restoring bundle structure from a parcel.
</comment> <class> <name>ExtensionNameSpaceModel</name> <environment>Store</environment> <super>Store.DefNameSpaceModel</super> <private>false</private> none data <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.ExtensionNameSpaceModel
Represents a class in a package that does not have the namespace definition, but only extension statics. Instance Variables: data <IdentitySet of: symbol> The static keys in this package.
</comment> <class> <name>NameSpaceExtensionDescriptor</name> <environment>Store</environment> <super>Store.NameSpaceDescriptor</super> <private>false</private> none <imports></imports> <category>Store-IMG-Records</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.NameSpaceExtensionDescriptor
Represents a NameSpace which may or may not exist in the image for extensions (ie. shareds)
</comment> <class> <name>PackageChooser</name> <environment>Store</environment> <super>UI.SimpleDialog</super> <private>false</private> none objectName withAdd onCancelDo sequence selectedPackage defaultPackage <imports></imports> <category>Store-UI</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.PackageChooser
A utility dialog which presents a list of the currently loaded Packages for the user to select. Optionally can allow the user to create a new Package. Answers a PackageModel. Instance Variables: defaultPackage <PackageModel or nil> If provided, will be the default selection objectName <String> used in the dialog header if provided onCancelDo <BlockClosure> - evaluated if the user cancels the dialog selectedPackage <PackageModel> the current selection sequence <SelectionInList> the list of packages withAdd <Boolean> True if the user is allowed to create a new package
</comment> <class> <name>BundleDescription</name> <environment>Store</environment> <super>Store.ComponentDescription</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.BundleDescription
Represents a bundle as a component or a prerequsite.
</comment> <class> <name>ClassForParcel</name> <environment>Store</environment> <super>Store.ModelForParcel</super> <private>false</private> none selectors metaSelectors <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.ClassForParcel
ClassForParcel is used to reflect classes for a package in restoring bundle structure from a parcel. Instance Variables: metaSelectors <Collection of Symbols> metaclass selectors the owning package owns. selectors <Collection of Symbols> selectors the owning package owns.
</comment> <class> <name>DefClassModel</name> <environment>Store</environment> <super>Store.Model</super> <private>false</private> none package fullClassSymbol <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.DefClassModel
Represents a class within a package that includes the class definition and comment. Instance Variables: package <PackageModel> the receiver's package fullClassSymbol <Symbol> the absolute symbol representing the receiver. The definition class model operates on the principle that most methods/statics will be in the same package as the class. Any method/static that is not explicitly in another package is assumed to belong to the receiver's package. This is foot print savings at the cost of some confusion in method/static status.
</comment> <class> <name>ClassDescriptor</name> <environment>Store</environment> <super>Store.PseudoRecord</super> <private>false</private> none fullClassName meta cachedName <imports></imports> <category>Store-IMG-Records</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.ClassDescriptor
Represents a class which may or may not exist in the image. Unlike ClassModels, ClassDescriptors know if they are metaclasses or not.
</comment> <class> <name>ClassExtensionDescriptor</name> <environment>Store</environment> <super>Store.ClassDescriptor</super> <private>false</private> none <imports></imports> <category>Store-IMG-Records</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.ClassExtensionDescriptor
Represents a class which may or may not exist in the image for extensions (ie. methods and shareds when the package does not own a defintion).
</comment> <class> <name>PublishAsParcelDialog</name> <environment>Store</environment> <super>UI.SimpleDialog</super> <private>false</private> none pundle bundleStructure databaseLinks parcelDirectory parcelSave parcelSaveSource parcelHideSource parcelPadded parcelRepublish parcelBackup parcelOverwrite <imports></imports> <category>Store-UI</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.PublishAsParcelDialog
The dialog to collect options for publishing a pundle as a parcel. Instance Variables: bundleStructure <ValueModel: Boolean> true if we should store the bundle structure in the parcel databaseLinks <ValueModel: Boolean> true if we should store the database links in the parcel parcelBackup <ValueModel: Boolean> true means backup any existing parcel file parcelDirectory <ValueModel: String> the directory to put the parcel parcelHideSource <ValueModel: Boolean>> sets the hideSource flag for the parcel parcelOverwrite <ValueModel: Boolean> flag whether to override existing files.. if true will do so with no warning prompt. parcelPadded <ValueModel: Boolean> sets the padded flag for the parcel parcelRepublish <ValueModel: Boolean> sets the reepublish flag for the parcel parcelSave <ValueModel: Boolean> true to save the parcel parcelSaveSource <ValueModel: Boolean> flag to tell the parcel whether to save the sources pundle <BundleModel | PackageModel> that which we are making a parcel from
</comment> <class> <name>PundleAccess</name> <environment>Store</environment> <super>UI.Model</super> <private>false</private> none packages bundles modelDictionary currentPackage nullPackage containedItemsCache <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.PundleAccess
Singleton (Store.Registry) is the manager for all code components in the local image. Description: Tracks loaded bundles/packages and maintains a model (i.e. Class/NameSpace models) to packages dictionary. Responsible for definition lookup, creating and organizing pundles. Usage: Use the global Store.Registry to obtain PackageModel and BundleModel objects. For example: Store.Registry packageNamed: 'XML-source'. or: Store.Registry bundleNamed: 'Tools-IDE'. In either case you'll get back the BundleModel or PackageModel or nil if they don't exist. Everything is in a package somewhere. The nullPackage is for all unassigned definitions. Instance Variables: packages <Dictionary key: name value: PackageModel> All loaded packages. bundles <Dictionary key: name value: BundleModel> All loaded bundles. modelDictionary <IdentityDictionary key: String value: Array of packages> key is the #absoluteName of a Class or NameSpace (eg. 'Root.Smalltalk.Store.PundleAccess'). value is an array of PackageModels containing some definitions for that class/namespace. The first package in the array contains the definiton. The rest contain extension methods or statics. currentPackage <PackageModel> Default package. nullPackage <PackageModel> Where things go when they have nowhere to go. containedItemsCache <OrderedCollection of: PunleModels> Saves list of all bundles/packages for browser speedup. Shared Variables: ParcelDirectory <LogicalFilename> When publishing a pundle to a parcel, this is the destination directory used. By default this is the current directory.
</comment> <class> <name>ExtensionClassModel</name> <environment>Store</environment> <super>Store.DefClassModel</super> <private>false</private> none selectors metaSelectors data <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.ExtensionClassModel
Represents a class in a package that does not have the class definition, but only extension methods/statics. Instance Variables: selectors <IdentitySet of: symbol> The selectors in this package metaSelectors <IdentitySet of: symbol> The meta class selectors data <IdentitySet of: symbol> The static keys in this package.
</comment> <class> <name>PundleModel</name> <environment>Store</environment> <super>Kernel.CodeComponent</super> <private>false</private> none dbInfo readonly <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.PundleModel
An abstract superclass for Package/Bundle Models. Subclasses must implement the following messages: accessing pundleChangesClass Instance Variables: changeSet <Store.XChangeSet> tracks all changes readonly <Boolean> set to true after converting a Parcel that has uninstalled code. Class Variables: EmergencyUnloadSignal <Signal> comment The XChangeSet determines what gets published when updating.
</comment> <class> <name>BundleModel</name> <environment>Store</environment> <super>Store.PundleModel</super> <private>false</private> none <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.BundleModel
Manages the contents of a bundle. Description: Code components in the local image are represented as instances of PackageModel or BundleModel. The objects in the repository are represented as instances of Package or Bundle. Note that because PackageModels and BundleModels can be reconciled against many different databases, these objects do not track version information (e.g., the properties: version, last modified, modified by). Usage: Use the global Store.Registry to obtain PackageModel and BundleModel objects. For example: Store.Registry packageNamed: 'XML-source'. or: Store.Registry bundleNamed: 'Tools-IDE'. In either case you'll get back the BundleModel or PackageModel or nil if they don't exist. Instance Variables: contents <List of: PundleModels> An ordered list of subcomponents.
</comment> <class> <name>PackageModel</name> <environment>Store</environment> <super>Store.PundleModel</super> <private>false</private> none models <imports></imports> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.PackageModel
Manages the contents of a package. Description: Code components in the local image are represented as instances of PackageModel or BundleModel. The objects in the repository are represented as instances of Package or Bundle. Note that because PackageModels and BundleModels can be reconciled against many different databases, these objects do not track version information (e.g., the properties: version, last modified, modified by). Usage: Use the global Store.Registry to obtain PackageModel and BundleModel objects. For example: Store.Registry packageNamed: 'XML-source'. or: Store.Registry bundleNamed: 'Tools-IDE'. In either case you'll get back the BundleModel or PackageModel or nil if they don't exist. Instance Variables: models <IdentityDictionary key: Class/NameSpace absoluteSymbol value: Class/NameSpaceModel>
</comment> <class> <name>MethodDescriptor</name> <environment>Store</environment> <super>Store.PseudoRecord</super> <private>false</private> none selector protocol fullClassName meta <imports></imports> <category>Store-IMG-Subdefs</category> <attributes> <package>PackageCategories</package> </attributes> </class> <comment> Store.MethodDescriptor
MethodDescriptor provides a model of a method. Instance Variables: selector <Symbol> The selector for the method protocol <Symbol | nil> The method's protocol, or nil for some unknown reason fullClassName <String> The absolute name for the class where the method lives meta <Boolean> Indicating whether the method resides on the class or instance side of the class.
</comment> <name>EmergencyUnloadSignal</name> <environment>Store.PundleModel</environment> <private>false</private> <constant>false</constant> <category>signals</category> <attributes> <package>PackageCategories</package> </attributes> <name>Policies</name> <environment>Store</environment> <private>false</private> <constant>false</constant> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> <name>Registry</name> <environment>Store</environment> <private>false</private> <constant>false</constant> <category>PackageCategories</category> <attributes> <package>PackageCategories</package> </attributes> <name>ParcelDirectory</name> <environment>Store.PundleAccess</environment> <private>false</private> <constant>false</constant> <category>settings</category> <initializer>Filename currentDirectory asLogicalFileSpecification</initializer> <attributes> <package>PackageCategories</package> </attributes> <name>BundleIcon</name> <environment>Store.BundleModel</environment> <private>false</private> <constant>false</constant> <category>visuals</category> <initializer>nil</initializer> <attributes> <package>PackageCategories</package> </attributes> <name>PackageIcon</name> <environment>Store.PackageModel</environment> <private>false</private> <constant>false</constant> <category>visuals</category> <initializer>nil</initializer> <attributes> <package>PackageCategories</package> </attributes> <name>CurrentSet</name> <environment>Store.XChangeSet</environment> <private>false</private> <constant>false</constant> <category>current</category> <attributes> <package>PackageCategories</package> </attributes> <methods> Store.Changes <category>printing</category>
printOn: aStream "Append to the argument aStream a sequence of characters that identifies the receiver." self putStatsOn: aStream
</methods> <methods> Store.Changes <category>testing</category>
isAdded ^self defChangesIncludes: #add
isChanged ^self defChangesIncludes: #change
isDataModified ^( self getDataChangesIfNone: [ ^false ] ) size > 0
isDefinitionChanged self subclassResponsibility
isDefinitionRemoved ^self defChangesIncludes: #removeDefinition
isForClass ^false
isForNameSpace ^false
isModified ^( defChanges size > 0 ) | ( dataChanges size > 0 )
isOverridden ^self defChangesIncludes: #override
isRelocated ^self defChangesIncludes: #relocate
isRemoved ^self defChangesIncludes: #remove
isRenamed ^self defChangesIncludes: #rename
</methods> <methods> Store.Changes <category>private-access</category>
alterChanges defChanges isNil ifTrue: [ defChanges := Set new ]. ^defChanges
alterDataChanges dataChanges isNil ifTrue: [dataChanges := IdentityDictionary new]. ^dataChanges
getDataChangesIfNone: aBlock dataChanges isNil ifTrue: [ ^aBlock value ]. ^dataChanges
getDefChangesIfNone: aBlock defChanges isNil ifTrue: [ ^aBlock value ]. ^defChanges
</methods> <methods> Store.Changes <category>private-queries</category>
defChangesIncludes: changeType ^( self getDefChangesIfNone: [ ^false ] ) includes: changeType
modifiedKeysSubdefChanges: subdefChanges | mods | mods := OrderedCollection new. subdefChanges isNil ifFalse: [ subdefChanges keysAndValuesDo: [ :key :changeType | ( changeType ~~ #remove ) & ( changeType ~~ #override ) ifTrue: [ mods add: key ] ] ]. ^mods
nameSpaceChangeTypes ^#( #add #removeDefinition #remove #change #rename #reorganize #comment )
removedKeysSubdefChanges: subdefChanges | mods | mods := OrderedCollection new. subdefChanges isNil ifFalse: [ subdefChanges keysAndValuesDo: [ :key :changeType | changeType == #remove ifTrue: [ mods add: key ] ] ]. ^mods
</methods> <methods> Store.Changes <category>accessing</category>
itemCount ^defChanges size + dataChanges size
modifiedDataKeys ^self modifiedKeysSubdefChanges: ( self getDataChangesIfNone: [ nil ] )
modifiedTags "Answer a collection of tags for changed or add definitions, methods or data, not including removed definitions." self subclassResponsibility
oldName | name | name := (self getDefChangesIfNone: [self error: 'class changes empty']) detect: [ :x | x isString and: [ 'oldName: *' match: x ] ] ifNone: [ ^'ERROR oldName not found' asSymbol ]. ^(Compiler preferredParserClass new scanTokens: name) last asSymbol
reflection "Answer a reflection of the receiver- the opposite of any change." | reflection | reflection := self class symbol: symbol. ( self getDefChangesIfNone: [ #() ] ) do: [ :type | reflection doChangeType: ( self reverse: type ) ]. self dataChanges do: [ :change | reflection doSubdefChange: ( self subdefReverse: change ) ]. ^reflection.
removedDataKeys ^self removedKeysSubdefChanges: (self getDataChangesIfNone: [nil])
removedTags "Answer a collection of tags for removed definitions, methods or data." self subclassResponsibility
symbol "class or namespace symbol" ^symbol
symbol: aSymbol "class or namespace symbol" symbol := aSymbol asSymbol
</methods> <methods> Store.Changes <category>private-changes</category>
commentChanges ^#( #comment #commentMeta )
defChanges ^#( #add #removeDefinition #remove #change #rename #changeMeta #commentMeta)
internalError: warning " StoreWarning raiseSignal: ( 'Proceedable Internal Error<n><1s>: <2s>' expandMacrosWith: self class printString with: warning ) "
modifyAll "For cases where we don't know what changed, assume everything changed." self initializeChanges. #( #change #reorganize #comment ) do: [:ct | self alterChanges add: ct].
reverse: changeType "Answer a change that reflects the opposite of changeType - for ChangeSet reflections." changeType == #add ifTrue: [ ^#remove ]. changeType == #remove ifTrue: [ ^#add ]. changeType == #removeDefinition ifTrue: [ ^#add ]. ^changeType
subdefChanges: subdefChanges changeType: changeType key: key "Process the subdef change." "For overrides, both an override and a remove come through and the net result should be no change." | oldType | changeType == #removeChanges ifTrue: [ ^subdefChanges removeKey: key ifAbsent: [nil ] ]. oldType := subdefChanges at: key ifAbsent: [ #none ]. changeType == #override ifTrue: [ ^oldType == #remove ifTrue: [ subdefChanges removeKey: key ifAbsent: [nil ] ] ifFalse: [ subdefChanges at: key put: #override ] ]. ( oldType == #override and: [ changeType == #remove ] ) ifTrue: [ ^subdefChanges removeKey: key ifAbsent: [nil ] ]. ( changeType == #add ) & ( oldType == #remove ) ifTrue: [ ^subdefChanges at: key put: #change ]. ( changeType == #remove ) & ( oldType == #add ) ifTrue: [ ^subdefChanges removeKey: key ]. ( changeType == #change ) & ( oldType == #add ) ifTrue: [ ^self ]. subdefChanges at: key put: changeType.
subdefReverse: aChange "Reverse a change to reflect the opposite of aChange's changeType - for ChangeSet reflections." aChange isAdd ifTrue: [ ^aChange remove; yourself ]. aChange isRemove ifTrue: [ ^aChange add; yourself ]. ^aChange
</methods> <methods> Store.Changes <category>initialize-release</category>
initialize self initializeChanges. self initializeSubdefChanges
initializeChanges defChanges := nil.
initializeSubdefChanges dataChanges := nil.
</methods> <methods> Store.Changes <category>changes</category>
doChangeType: changeType "Make change 'changeType' to the receiver. If the class/namespace was previously removed removing again is redundant and may indicate problems adding (after a remove) is like changing everything - cannot be add because of possible future remove if overriding, clear the removal, to clear ChangeSet some other kind of modification should not occur, assume we missed an add if the class/namespace was previously added removing clears all changes: X - X = 0 adding is redundant other modifications are legitimate but are already covered in the add state if the class/namespace was not changed or was modified removing should become removal (only) adding to an unchanged becomes an add, but to something with changes should not occur other modifications are included in the set of modifications." "For overrides, both an override and a remove come through and the net result should be no change." | nowRemoved nowAdded nowOverridden | nowRemoved := changeType == #removeDefinition | ( changeType == #remove ). nowAdded := changeType == #add. nowOverridden := changeType == #override. nowOverridden ifTrue: [ ^( self isRemoved or: [ self isDefinitionRemoved ] ) ifTrue: [ self initializeChanges ] "cancels the removal" ifFalse: [ self alterChanges add: changeType ]. "save mark for removal" ]. nowRemoved ifTrue: [ self isOverridden ifTrue: [ ^self initializeChanges ] "cancels override" ]. ( self isRemoved or: [ self isDefinitionRemoved ] ) ifTrue: [ ^nowRemoved ifTrue: [ self internalError: (#redundantRemove << #packages >> 'redundant remove') ] ifFalse: [ nowAdded ifTrue: [ self modifyAll ] ifFalse: [ self internalError: ((#changeAppliedToMissingClassOrNamespace << #packages >> '<1s> to removed namespace/class') expandMacrosWith: changeType asString). self modifyAll ] ] ]. self isAdded ifTrue: [ nowRemoved ifTrue: [ self initializeChanges ] ifFalse: [ nowAdded ifTrue: [ self modifyAll ] ifFalse: [ self alterChanges add: changeType ] ] ] ifFalse: [ nowRemoved ifTrue: [ self initializeChanges. self alterChanges add: changeType ] ifFalse: [ | cha | cha := self alterChanges. nowAdded ifTrue: [ cha size = 0 ifTrue: [ cha add: changeType ] ifFalse: [ self modifyAll ] ] ifFalse: [ cha add: changeType ] ] ]
removeDefChanges: changes changes do: [ :sym | self alterChanges remove: sym ifAbsent: nil ].
renameOldSymbol: oldSymbol "Include indication that a namespace/class has been renamed." "only original name of pre-existing class matters" ( ( self isRenamed ) or: [ self isAdded ] ) ifFalse: [ self alterChanges add: 'oldName: ' , oldSymbol. self alterChanges add: #rename ]
</methods> <methods> Store.Changes <category>fileIn/Out</category>
fileOutDataChangesFor: object for: aPackage within: aBundle on: fileManager | removes changes dChanges | removes := OrderedCollection new. changes := OrderedCollection new. dChanges := self getDataChangesIfNone: [ nil ]. dChanges notNil ifTrue: [ dChanges keysAndValuesDo: [ :key :change | change = #remove ifTrue: [ ( self isRemoved or: [ self isDefinitionRemoved ] ) ifFalse: [ removes add: key ] ] ifFalse: [ changes add: key ] ] ]. changes isEmpty ifFalse: [ ( aPackage == nil or: [ aPackage isLoaded ] ) ifTrue: [ fileManager fileOutData: changes for: object asNameSpace ] ifFalse: [ aPackage fileOutDataKeys: changes in: object on: fileManager ]. ]. removes do: [ :key | ( ( aBundle ~~ nil ) and: [ aBundle includesDataKey: key ownerName: symbol asString ] ) ifFalse: [ fileManager removeObject: object fullName, '.', key type: #variable ] ].
fileOutDataChangesFor: object on: fileManager within: aBundle | removes changes dChanges | removes := OrderedCollection new. changes := OrderedCollection new. dChanges := self getDataChangesIfNone: [ nil ]. dChanges notNil ifTrue: [ dChanges keysAndValuesDo: [ :key :change | change = #remove ifTrue: [ ( self isRemoved or: [ self isDefinitionRemoved ] ) ifFalse: [ removes add: key ] ] ifFalse: [ changes add: key ] ] ]. changes isEmpty ifFalse: [ fileManager fileOutData: changes for: object asNameSpace ]. removes do: [ :key | ( ( aBundle ~~ nil ) and: [ aBundle includesDataKey: key ownerName: symbol asString ] ) ifFalse: [ fileManager removeObject: object fullName, '.', key type: #variable ] ].
fileOutObjectType "Answer a symbol that represents the type of the receiver." ^self subclassResponsibility
putDataStatsOn: stream | removes changes adds | removes := OrderedCollection new. changes := OrderedCollection new. adds := OrderedCollection new. (self getDataChangesIfNone: [ ^self] ) keysAndValuesDo: [:mSel :mChange | mChange = #remove ifTrue: [removes add: mSel] ifFalse: [mChange = #change ifTrue: [changes add: mSel] ifFalse: [adds add: mSel]]]. adds isEmpty ifFalse: [stream tab; tab; nextPutAll: (#AddedDataC << #packages >> 'Added data:') asString; cr. adds do: [:dataKey | stream tab; tab; tab; nextPutAll: dataKey; cr]]. changes isEmpty ifFalse: [stream tab; tab; nextPutAll: (#ChangedDataC << #packages >> 'Changed data:') asString; cr. changes do: [:dataKey | stream tab; tab; tab; nextPutAll: dataKey; cr]]. removes isEmpty ifFalse: [stream tab; tab; nextPutAll: (#RemovedDataC << #packages >> 'Removed data:') asString; cr. removes do: [:dataKey | stream tab; tab; tab; nextPutAll: dataKey; cr]]
</methods> <methods> Store.Changes <category>actions</category>
forgetDataChange: dataKey "Forget all changes relating to a dataKey" ( self getDataChangesIfNone: [ ^nil ] ) removeKey: dataKey ifAbsent: nil.
forgetTag: aTag "Forget changes associated with aTag." aTag isCommentTag ifTrue: [ ^self removeDefChanges: self commentChanges ]. aTag isForClass | aTag isForNameSpace ifTrue: [ ^self removeDefChanges: self defChanges ]. aTag isForData ifTrue: [ ^self forgetDataChange: aTag dataKey.]. aTag isForMethod ifTrue: [ ^self forgetMethod: aTag selector meta: aTag isMeta.].
</methods> <methods> Store.Changes class <category>instance creation</category>
symbol: aSymbol ^self new symbol: aSymbol; yourself.
</methods> <methods> Store.ClassChanges <category>testing</category>
areMethodsModifiedMeta: meta ^(self getMethodChangesMeta: meta ifNone: [^false]) size > 0
isClassChangedMeta: meta ^self defChangesIncludes: (meta ifTrue: [#changeMeta] ifFalse: [#change])
isClassCommentedMeta: meta ^self defChangesIncludes: (meta ifTrue: [#commentMeta] ifFalse: [#comment])
isClassModifiedMeta: meta ( self getDefChangesIfNone: [^false] ) do: [ :changeType | ( ( self classChangeTypesMeta: meta ) includes: changeType ) ifTrue: [ ^true ] ]. ^false
isClassNonDestructivelyModified (self getDefChangesIfNone: [^false]) do: [:changeType | (#(changeMeta #reorganizeMeta #commentMeta #add #change #reorganize #comment) includes: changeType) ifTrue: [^true]]. ^false
isClassReorganizedMeta: meta ^self defChangesIncludes: (meta ifTrue: [#reorganizeMeta] ifFalse: [#reorganize])
isCommented ^( self isClassCommentedMeta: false ) | ( self isClassCommentedMeta: true )
isDefinitionChanged ^( self isClassChangedMeta: false ) | ( self isClassChangedMeta: true )
isDefTypeModified: defType ^defType == #data ifTrue: [ self isDataModified ] ifFalse: [ self isMetaModified: ( defType == #meta ) ]
isForClass ^true
isMetaModified: isMeta ^isMeta ifTrue: [ metaMethodChanges size > 0 ] ifFalse: [ methodChanges size > 0 ]
isMethodChangedSelector: selector meta: meta | dict | dict := self getMethodChangesMeta: meta ifNone: [^false]. ^(dict at: selector ifAbsent: [^false]) == #change
isModified ^super isModified | ( methodChanges size > 0 ) | ( metaMethodChanges size > 0 )
isModifiedMeta: meta (self areMethodsModifiedMeta: meta) ifTrue: [ ^true ]. (self isClassModifiedMeta: meta) ifTrue: [ ^true ]. ^false
isNonDestructivelyModified ( self getDefChangesIfNone: [ ^false ] ) do: [ :changeType | ( #( #changeMeta #reorganizeMeta #commentMeta #add #change #reorganize #comment ) includes: changeType ) ifTrue: [ ^true ] ]. ^false
isReorganized ^( self isClassReorganizedMeta: true ) | ( self isClassReorganizedMeta: false )
</methods> <methods> Store.ClassChanges <category>changes</category>
doChange: change super doChangeType: ( change typeWithMeta ).
doSubdefChange: change change isDataChange ifTrue: [ self subdefChanges: self alterDataChanges changeType: change type key: change key ] ifFalse: [ self subdefChanges: ( self alterMethodChangesMeta: change meta ) changeType: change type key: change key. ].
</methods> <methods> Store.ClassChanges <category>private-queries</category>
classChangeTypesMeta: meta ^meta ifTrue: [#(#changeMeta #reorganizeMeta #commentMeta)] ifFalse: [#(#add #removeDefinition #remove #change #rename #reorganize #comment)]
</methods> <methods> Store.ClassChanges <category>private-changes</category>
modifyAll "For cases where we don't know what changed for the class, assume everything changed." super modifyAll. #( #changeMeta #reorganizeMeta #commentMeta ) do: [ :ct | self alterChanges add: ct ]
</methods> <methods> Store.ClassChanges <category>initialize-release</category>
initializeSubdefChanges methodChanges := nil. metaMethodChanges := nil. dataChanges := nil.
</methods> <methods> Store.ClassChanges <category>actions</category>
forgetMethod: selector meta: isMeta | selectors | selectors := self getMethodChangesMeta: isMeta ifNone: [ ^self ]. selectors removeKey: selector ifAbsent: [ nil ]
forgetMethodChange: selector meta: isMeta | selectors | selectors := self getMethodChangesMeta: isMeta ifNone: [ ^self ]. selectors removeKey: selector ifAbsent: nil.
</methods> <methods> Store.ClassChanges <category>accessing</category>
dataChanges "Answer a collection of Changes for all modified/added/removed statics." | coll | dataChanges == nil ifTrue: [ ^#( ) ]. coll := OrderedCollection new. dataChanges keysAndValuesDo: [ :key :type | coll add: ( Change new classSymbol: symbol; dataKey: key; perform: type; yourself ) ]. ^coll
itemCount ^super itemCount + methodChanges size + metaMethodChanges size
methodChanges "Answer a collection of Changes for all modified/added/removed statics." | coll | coll := OrderedCollection new. methodChanges == nil ifFalse: [ methodChanges keysAndValuesDo: [ :key :type | coll add: ( Change new classSymbol: symbol; selector: key; perform: type; yourself ) ]. ]. metaMethodChanges == nil ifFalse: [ metaMethodChanges keysAndValuesDo: [ :key :type | coll add: ( Change new classSymbol: symbol, ' class'; selector: key; perform: type; yourself ) ]. ]. ^coll
modifiedDatumDescriptors ^( self getDataChangesIfNone: [ ^#( ) ] ) keys collect: [ :key | DatumDescriptor fromDataKey: key className: symbol asString ].
modifiedMethodDescriptorsMeta: isMeta ^( self getMethodChangesMeta: isMeta ifNone: [ ^#( ) ] ) keys collect: [ :key | MethodDescriptor fromSelector: key className: symbol asString meta: isMeta ].
modifiedSelectorsMeta: meta ^self modifiedKeysSubdefChanges: (self getMethodChangesMeta: meta ifNone: [nil])
reflection "Answer a reflection of the receiver- the opposite of any change." | reflection | reflection := super reflection. self methodChanges do: [ :change | reflection doSubdefChange: ( self subdefReverse: change ) ]. ^reflection.
removedSelectorsMeta: meta ^self removedKeysSubdefChanges: (self getMethodChangesMeta: meta ifNone: [nil])
</methods> <methods> Store.ClassChanges <category>private-access</category>
alterMethodChangesMeta: meta ^meta ifTrue: [ metaMethodChanges == nil ifTrue: [ metaMethodChanges := IdentityDictionary new ]. metaMethodChanges ] ifFalse: [ methodChanges == nil ifTrue: [ methodChanges := IdentityDictionary new ]. methodChanges ]
getMethodChangesMeta: meta ifNone: aBlock | dict | dict := meta ifTrue: [metaMethodChanges] ifFalse: [methodChanges]. dict isNil ifTrue: [^aBlock value]. ^dict
</methods> <methods> Store.ClassChanges <category>fileIn/Out</category>
putDefStatsOn: stream self isAdded ifTrue: [stream nextPutAll: (#ClassAdded << #packages >> 'Class added.') asString; cr]. self isRenamed ifTrue: [stream nextPutAll: ((#ClassRenamedFrom1s << #packages >> 'Class renamed from <1s>.') expandMacrosWith: self oldName); cr]. self isDefinitionRemoved ifTrue: [stream nextPutAll: (#ClassDefinitionRemoved << #packages >> 'Class definition removed.') asString; cr]. self isRemoved ifTrue: [stream nextPutAll: (#ClassRemoved << #packages >> 'Class removed.') asString; cr]. (self isClassChangedMeta: false) ifTrue: [stream nextPutAll: (#ClassRedefined << #packages >> 'Class redefined.') asString; cr]. self isOverridden ifTrue: [ stream nextPutAll: (#ClassOverridden << #packages >> 'Class overridden.') asString; cr ]. (self isClassChangedMeta: true) ifTrue: [stream nextPutAll: (#MetaclassRedefined << #packages >> 'Metaclass redefined.') asString; cr]. (self isClassReorganizedMeta: false) ifTrue: [stream nextPutAll: (#ClassReorganized << #packages >> 'Class reorganized.') asString; cr]. (self isClassReorganizedMeta: true) ifTrue: [stream nextPutAll: (#MetaclassReorganized << #packages >> 'Metaclass reorganized.') asString; cr]. (self isClassCommentedMeta: false) ifTrue: [stream nextPutAll: (#ClassCommentChanged << #packages >> 'Class comment changed.') asString; cr]. (self isClassCommentedMeta: true) ifTrue: [stream nextPutAll: (#MetaclassCommentChanged << #packages >> 'Metaclass comment changed.') asString; cr].
putMethodStatsMeta: meta on: stream | removes changes adds | removes := OrderedCollection new. changes := OrderedCollection new. adds := OrderedCollection new. (self getMethodChangesMeta: meta ifNone: [^self]) keysAndValuesDo: [:mSel :mChange | mChange = #remove ifTrue: [removes add: mSel] ifFalse: [mChange = #change ifTrue: [changes add: mSel] ifFalse: [adds add: mSel]]]. adds isEmpty ifFalse: [stream tab; tab; nextPutAll: (#AddedMethodsC << #packages >> 'Added methods:') asString; cr. adds do: [:selector | stream tab; tab; tab; nextPutAll: selector; cr]]. changes isEmpty ifFalse: [stream tab; tab; nextPutAll: (#ChangedMethodsC << #packages >> 'Changed methods:') asString; cr. changes do: [:selector | stream tab; tab; tab; nextPutAll: selector; cr]]. removes isEmpty ifFalse: [stream tab; tab; nextPutAll: (#RemovedMethodsC << #packages >> 'Removed methods:') asString; cr. removes do: [:selector | stream tab; tab; tab; nextPutAll: selector; cr]]
putStatsOn: stream self putDefStatsOn: stream. self putDataStatsOn: stream. (self areMethodsModifiedMeta: false) ifTrue: [stream nextPutAll: (#InstanceMethodsChanged << #packages >> 'Instance side methods changed:') asString; cr. self putMethodStatsMeta: false on: stream]. (self areMethodsModifiedMeta: true) ifTrue: [stream nextPutAll: (#ClassSideMethodsChangedC << #packages >> 'Class side methods changed:') asString; cr. self putMethodStatsMeta: true on: stream]. self isDataModified ifTrue: [stream nextPutAll: (#DataChangedC << #packages >> 'Data changed:') asString; cr. self putDataStatsOn: stream ].
</methods> <methods> Store.ClassChanges class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Store.XChangeSet <category>changes</category>
addOtherChange: aChange self other add: aChange
addPropertyChange: aSymbol self properties add: aSymbol
doChange: change change isRemoveChanges ifTrue: [ ^self removeKey: change symbol ifAbsent: [ nil ] ]. ( self createAt: change symbol forChange: change) doChange: change. self removeIfEmptySymbol: change symbol
doClassChange: change change isRemoveChanges ifTrue: [ ^self removeKey: change classSymbol ifAbsent: [ nil ] ]. ( self createForClassAt: change classSymbol ) doChange: change. self removeIfEmptySymbol: change classSymbol
doNameSpaceChange: change change isRemoveChanges ifTrue: [ ^self removeKey: change nameSpaceSymbol ifAbsent: [ nil ] ]. ( self createForNameSpaceAt: change nameSpaceSymbol ) doChange: change. self removeIfEmptySymbol: change nameSpaceSymbol
doSubdefChange: change | symbol | symbol := change classSymbol == nil ifFalse: [ change classSymbol ] ifTrue: [ change nameSpaceSymbol ]. (self createAt: symbol forChange: change) doSubdefChange: change. self removeIfEmptySymbol: symbol
noChanges self become: self class new
overriddenClass: aClass ( self createForClassAt: aClass absoluteSymbol ) doChangeType: #override. self removeIfEmptySymbol: aClass absoluteSymbol
overriddenNameSpace: aNameSpace ( self createForNameSpaceAt: aNameSpace absoluteSymbol ) doChangeType: #override. self removeIfEmptySymbol: aNameSpace absoluteSymbol
overriddenSelector: selector class: aClass | symbol change | symbol := aClass instanceBehavior absoluteSymbol. change := Change new class: aClass; selector: selector; override; yourself. ( self createAt: symbol forChange: change ) doSubdefChange: change. self removeIfEmptySymbol: symbol
overriddenStatic: dataKey in: anOwner | symbol change | symbol := anOwner absoluteSymbol. change := Change new actual: anOwner; dataKey: dataKey; override; yourself. ( self createAt: symbol forChange: change ) doSubdefChange: change. self removeIfEmptySymbol: symbol
reflection "Answer a XChangeSet that is the reflection of the receiver." | cs | cs := self class new. self keysAndValuesDo: [ :key :changes | cs at: key put: changes reflection ]. self otherOrNil == nil ifFalse: [ self otherOrNil do: [ :change | cs addOtherChange: change ]. ]. self propertiesOrNil == nil ifFalse: [ self propertiesOrNil do: [ :change | cs addPropertyChange: change ]. ]. ^cs.
</methods> <methods> Store.XChangeSet <category>consistency checking</category>
checkConsistencyInPackage: pkg on: aStream | printBlock | printBlock := [ :string | aStream nextPutAll: (#changeSetForPackage << #packages >> 'change set for package <1p> notes <2s>' expandMacrosWith: pkg with: string). aStream cr ]. self keysAndValuesDo: [ :symbol :cc | | obj | obj := symbol asStrictReference valueOrDo: [nil]. cc isNonDestructivelyModified ifTrue: [ obj isNil ifTrue: [ printBlock value: ((#modificationForSomethingNotInTheSystem << #packages >> 'a modification for "<1s>" which is not in the system') expandMacrosWith: symbol) ]. ( pkg includesSymbol: symbol ) ifFalse: [ printBlock value: ((#modificationForSomethingNotInThePackage << #packages >> 'a modification for "<1s>" which is not in the package') expandMacrosWith: symbol) ] ]. ( cc isDefinitionRemoved or: [cc isRemoved and: [cc isAdded not]] ) ifTrue: [ ( pkg includesSymbol: symbol ) ifTrue: [ printBlock value: ((#removeOperationForSomethingInThePackage << #packages >> 'a remove/remove definition for class "<1s>" still in the package') expandMacrosWith: symbol)] ]. cc isForClass ifTrue: [ #( false true ) do: [ :meta | | cls | cls := obj isNil ifTrue: [ nil ] ifFalse: [ meta ifTrue: [ obj class ] ifFalse: [ obj ] ]. ( cc modifiedSelectorsMeta: meta ) do: [ :selector | ( cls isNil or: [ (cls compiledMethodAt: selector ifAbsent: [nil]) isNil] ) ifTrue: [ printBlock value: ((#addChangeForMissingMethod << #packages >> 'an add/change for method <1s>%><2s>" which is not in the system') expandMacrosWith: symbol with: selector) ]. ( pkg includesSelector: selector classSymbol: symbol meta: meta ) ifFalse: [ printBlock value: ((#addChangeForMispackagedMethod << #packages >> 'an add/change for method <1s>%><2s>" which is not in the package') expandMacrosWith: symbol with: selector) ] ]. ( cc removedSelectorsMeta: meta ) do: [ :selector | ( pkg includesSelector: selector classSymbol: symbol meta: meta ) ifTrue: [ printBlock value: ((#removeForMethodStillInPackage << #packages >> 'a remove for method <1s>%><2s>" which is still in the package') expandMacrosWith: symbol with: selector) ] ] ] ]. cc modifiedDataKeys do: [ :dataKey | ( pkg includesDataKey: dataKey ownerSymbol: symbol ) ifFalse: [ printBlock value: ((#addChangeForDataNotInPackage << #packages >> 'an add/change for data <1s>:<2s>" which is not in the package') expandMacrosWith: symbol with: dataKey) ] ]. cc removedDataKeys do: [ :dataKey | ( pkg includesDataKey: dataKey ownerSymbol: symbol ) ifTrue: [ printBlock value: ((#removeForDataStillInPackage << #packages >> ' a remove for data <1s>:<2s>" which is still in the package') expandMacrosWith: symbol with: dataKey) ] ] ]
makeConsistentForPackage: pkg "Resolve references to non-existent things: - adds are removed altogether - changes are changed to removes." self keysAndValuesDo: [ :symbol :cc | | obj | obj := symbol asStrictReference valueOrDo: [ cc isAdded ifTrue: [ self removeKey: symbol ]. cc isChanged ifTrue: [ cc remove ]. nil. ]. cc isForClass ifTrue: [ #( false true ) do: [ :meta | | cls | cls := obj isNil ifTrue: [ nil ] ifFalse: [ meta ifTrue: [ obj class ] ifFalse: [ obj ] ]. ( cc modifiedSelectorsMeta: meta ) do: [ :selector | ( cls isNil or: [ ( cls compiledMethodAt: selector ifAbsent: [ nil ] ) == nil ] ) ifTrue: [ | change | change := Change new class: cls; selector: selector; remove. self doSubdefChange: change. ]. ]. ] ] ].
</methods> <methods> Store.XChangeSet <category>public-lists</category>
affectedClassNamesMeta: meta "Answer a collection of class names that ????" | names | names := OrderedCollection new. self keysAndValuesDo: [ :classSymbol :changes | changes isForClass ifTrue: [ ( ( changes isClassModifiedMeta: meta ) or: [ meta and: [ changes isAdded ] ] ) ifTrue: [ ( changes isRemoved or: [ changes isDefinitionRemoved ] ) ifFalse: [ names add: classSymbol asString ] ] ] ]. ^names
affectedNameSpaceNames "Answer a collection of namespace names whose definition is changed, but not removed." | names | names := OrderedCollection new. self keysAndValuesDo: [ :symbol :changes | ( changes isForNameSpace & changes isDefinitionChanged ) ifTrue: [ (changes isRemoved or: [ changes isDefinitionRemoved ] ) ifFalse: [ names add: symbol asString ] ] ]. ^names
changedClasses "Answer a collection of the changed or edited classes, not including removed classes." | classes | classes := OrderedCollection new. self keysAndValuesDo: [:classSymbol :changes | | class | changes isForClass ifTrue: [ class := classSymbol asStrictReference valueOrDo: [ nil ]. class notNil ifTrue: [ (changes isModifiedMeta: false) ifTrue: [classes add: class]. (changes isModifiedMeta: true) ifTrue: [classes add: class class] ] ]. ]. ^classes
changedMessageList "Answer an array that identifies the methods that have been changed. Each entry is a String containing the class name and method selector." | messageList | messageList := SortedCollection new. self keysAndValuesDo: [ :classSymbol :cc | | className | cc isForClass ifTrue: [ className := classSymbol asString, ' '. ( cc modifiedSelectorsMeta: false ) do: [ :selector | messageList add: className , selector ]. className := classSymbol fullMetaName, ' '. ( cc modifiedSelectorsMeta: true ) do: [ :selector | messageList add: className , selector ] ]. ]. ^messageList asArray
changedNameSpaces "Answer a collection of the changed or edited namespaces, not including removed NameSpaces." | nameSpaces | nameSpaces := OrderedCollection new. self keysAndValuesDo: [: symbol :changes | | ns | changes isForNameSpace ifTrue: [ ns := symbol asStrictReference valueOrDo: [ nil ]. ns notNil ifTrue: [ nameSpaces add: ns]. ]. ]. ^nameSpaces
modifiedDataKeysFor: aClassOrNameSpace "Answer a collection of all methods added or changed for a class." | cc | cc := self at: aClassOrNameSpace absoluteSymbol. cc isForClass ifFalse: [ ^#( ) ]. ^cc modifiedDataKeys
modifiedDatumDescriptors | dataItems | dataItems := OrderedCollection new. self keysAndValuesDo: [ :symbol :cc | cc modifiedDataKeys do: [ :dataKey | dataItems add: ( cc isForNameSpace ifTrue: [ DatumDescriptor fromDataKey: dataKey nameSpaceName: symbol asString ] ifFalse: [ DatumDescriptor fromDataKey: dataKey className: symbol asString ] ) ]. ]. ^dataItems
modifiedMethodDescriptors "Answer a collection of all methods added or changed." | methods | methods := Set new. self keysAndValuesDo: [:classSymbol :cc | | className | cc isForClass ifTrue: [ className := classSymbol asString. (cc modifiedSelectorsMeta: false) do: [ :selector | methods add: (MethodDescriptor fromSelector: selector className: className meta: false ) ]. (cc modifiedSelectorsMeta: true) do: [:selector | methods add: (MethodDescriptor fromSelector: selector className: className meta: true ) ] ] ]. ^methods asOrderedCollection
modifiedSelectorsFor: aClass "Answer a collection of all methods added or changed for a class." | cc | cc := self at: aClass absoluteSymbol. cc isForClass ifFalse: [ ^#( ) ]. ^cc modifiedSelectorsMeta: aClass isMeta.
removedClassOrDefinitionNames "Answer a collection of removed class names" | names | names := OrderedCollection new. self keysAndValuesDo: [ :classSymbol :cc | cc isForClass and: [ ( cc isRemoved or: [ cc isDefinitionRemoved ] ) ifTrue: [ names add: classSymbol asString ] ] ]. ^names
removedDatumDescriptors | dataItems | dataItems := OrderedCollection new. self keysAndValuesDo: [ :symbol :cc | cc removedDataKeys do: [ :dataKey | dataItems add: ( cc isForNameSpace ifTrue: [ DatumDescriptor fromDataKey: dataKey nameSpaceName: symbol asString ] ifFalse: [ DatumDescriptor fromDataKey: dataKey className: symbol asString ] ) ]. ]. ^dataItems
removedMethodDescriptors | methods | methods := OrderedCollection new. self keysAndValuesDo: [ :classSymbol :cc | | className | cc isForClass ifTrue: [ className := classSymbol asString. ( cc removedSelectorsMeta: false ) do: [ :selector | methods add: ( MethodDescriptor fromSelector: selector className: className meta: false ) ]. ( cc removedSelectorsMeta: true ) do: [ :selector | methods add: ( MethodDescriptor fromSelector: selector className: className meta: true ) ] ] ]. ^methods
removedNames "Answer a collection of removed class and namespace names" | names | names := OrderedCollection new. self keysAndValuesDo: [ :symbol :cc | ( cc isRemoved or: [ cc isDefinitionRemoved ] ) ifTrue: [ names add: symbol ] ]. ^names
removedNameSpaceOrDefinitionNames "Answer a collection of removed class names" | names | names := OrderedCollection new. self keysAndValuesDo: [ :symbol :cc | cc isForNameSpace and: [ ( cc isRemoved or: [ cc isDefinitionRemoved ] ) ifTrue: [ names add: symbol asString ] ] ]. ^names
reorganizedClassNames "Answer a collection of reorganized class names" | names | names := OrderedCollection new. self keysAndValuesDo: [ :classSymbol :cc | cc isForClass ifTrue: [ ( cc isClassReorganizedMeta: false ) ifTrue: [ names add: classSymbol asString ]. ( cc isClassReorganizedMeta: true ) ifTrue: [ names add: classSymbol fullMetaName ] ]. ]. ^names
</methods> <methods> Store.XChangeSet <category>public-printing</category>
itemCount ^self inject: 1 into: [ :cnt :change | cnt + change itemCount ].
printOn: aStream "Append to the argument aStream a sequence of characters that identifies the receiver." self putStatsOn: aStream
</methods> <methods> Store.XChangeSet <category>public-testing</category>
forgetDataChange: dataKey owner: owner | res | res := ( self at: owner absoluteSymbol ifAbsent: [ ^false ] ) forgetDataChange: dataKey. self removeIfEmptySymbol: owner absoluteSymbol. ^res
forgetMethodChange: selector class: class | res sym | res := ( self at: ( sym := class instanceBehavior absoluteSymbol ) ifAbsent: [ ^false ] ) forgetMethodChange: selector meta: class isMeta. self removeIfEmptySymbol: sym. ^res
forgetTag: aTag "Remove the change represented by aTag." | cc | cc := self at: aTag fullClassName ifAbsent: [ ^self ]. "Already forgotten" cc forgetTag: aTag. self removeIfEmptySymbol: aTag fullClassName
hasChangeForClassOrNameSpaceSymbol: aSymbol ^self includesKey: aSymbol asSymbol
hasChangeForClassOrNameSpaceSymbol: aSymbol defType: defType ^( self at: aSymbol asSymbol ifAbsent: [ ^false ] ) isDefTypeModified: defType
isClassModifiedClassSymbol: classSymbol meta: meta ^(self at: classSymbol ifAbsent: [^false]) isClassModifiedMeta: meta
isDataKeyModified: dataKey ownerSymbol: ownerSymbol ^( ( self at: ownerSymbol asSymbol ifAbsent: [ ^false ] ) modifiedDataKeys ) includes: dataKey
isEmpty ^( super isEmpty and: [ self otherOrNil size == 0 ] ) and: [ self propertiesOrNil size == 0 ].
isMainChangeSet ^false
isSelectorModified: selector classSymbol: classSymbol meta: meta ^( ( self at: classSymbol ifAbsent: [ ^false ] ) modifiedSelectorsMeta: meta ) includes: selector
notEmpty ^self isEmpty not
otherChangesInclude: aChange ^self otherOrNil isNil ifTrue: [false] ifFalse: [self other includes: aChange]
</methods> <methods> Store.XChangeSet <category>private</category>
createAt: symbol forChange: change ^self at: symbol ifAbsentPut: [ ( change isForClass ifTrue: [ self class classChangeClass ] ifFalse: [ self class nameSpaceChangeClass ] ) symbol: symbol ]
createForClassAt: classSymbol ^self at: classSymbol ifAbsentPut: [ self class classChangeClass symbol: classSymbol ]
createForClassAt: oldSymbol andMoveTo: newSymbol "For renaming/relocating classes. Create the change at the original name and then move it." | cc | cc := self createForClassAt: oldSymbol. cc renameOldSymbol: oldSymbol. self at: newSymbol put: cc. self removeKey: oldSymbol.
createForNameSpaceAt: symbol ^self at: symbol ifAbsentPut: [ self class nameSpaceChangeClass symbol: symbol ]
other other isNil ifTrue: [other := IdentitySet new]. ^other
otherOrNil ^other
properties properties == nil ifTrue: [ properties := IdentitySet new ]. ^properties
propertiesOrNil ^properties
removeIfEmptySymbol: symbol ( self at: symbol ifAbsent: [^self] ) isModified ifFalse: [ self removeKey: symbol ]
</methods> <methods> Store.XChangeSet <category>user interface</category>
inspectorClass ^ChangeSetInspector
</methods> <methods> Store.XChangeSet <category>private-fileIn/Out</category>
statsFor: description selector: selector on: stream "Print out the receivers changes for changes that evaluate a selector true. Write nothing if not changes, otherwise use description as header." | coll | coll := self select: [ :chng | chng perform: selector ]. coll isEmpty ifFalse: [ stream nextPutAll: description; cr. coll do: [ :chng | stream tab; nextPutAll: chng symbol; cr ]. stream cr. ].
</methods> <methods> Store.XChangeSet <category>public-fileIn/Out</category>
putStatsOn: stream "Write out all the changes the receiver knows about." | coll | self isEmpty ifTrue: [^stream nextPutAll: (#anEmptyChangeSet << #packages >> 'an Empty ChangeSet') asString.]. self statsFor: (#AddedC << #packages >> 'Added: ') asString selector: #isAdded on: stream. ( coll := self select: [ :chng | chng isRenamed ] ) isEmpty ifFalse: [ stream cr; nextPutAll: (#RenamedC << #packages >> 'Renamed: ') asString; cr. coll do: [ :chng | stream tab; nextPutAll: ((#x1sBecame2p << #packages >> '<1s><t>became<t><2p>') expandMacrosWith: chng oldName with: chng symbol); cr ] ]. self statsFor: (#RedefinedC << #packages >> 'Redefined: ') asString selector: #isDefinitionChanged on: stream. self statsFor: (#CommentChangedC << #packages >> 'Comment changed: ') asString selector: #isCommented on: stream. self statsFor: (#RemovedDefinitionC << #packages >> 'Removed Definition:') asString selector: #isDefinitionRemoved on: stream. self statsFor: (#RemovedC << #packages >> 'Removed:') asString selector: #isRemoved on: stream. self statsFor: (#ReOrganizedCChangedC << #packages >> 'ReOrganized: changed: ') asString selector: #isReorganized on: stream. self statsFor: (#RemovedDefinitionC << #packages >> 'Removed Definition:') asString selector: #isDefinitionRemoved on: stream. stream nextPutAll: (#SubdefChangesC << #packages >> 'Subdef changes:') asString; cr. self keysAndValuesDo: [:symbol :cc | cc isForClass ifTrue: [ (cc areMethodsModifiedMeta: false) ifTrue: [stream tab; nextPutAll: symbol; cr. cc putMethodStatsMeta: false on: stream. stream cr]. (cc areMethodsModifiedMeta: true) ifTrue: [stream tab; nextPutAll: symbol; nextPutAll: ' class'; cr. cc putMethodStatsMeta: true on: stream. stream cr] ]. cc isDataModified ifTrue: [ stream tab; nextPutAll: symbol; cr. cc putDataStatsOn: stream. stream cr. ]. ]. self otherOrNil notNil ifTrue: [ stream nextPutAll: (#OtherChangesC << #packages >> 'Other changes: ') asString; cr. self other do: [:othChg | stream tab; print: othChg; cr] ]. self propertiesOrNil == nil ifFalse: [ stream nextPutAll: (#PropertyChangesC << #packages >> 'Property changes: ') asString; cr. self properties do: [:prop | stream tab; print: prop; cr ] ]
</methods> <methods> Store.XChangeSet class <category>accessing</category>
classChangeClass ^ClassChanges
current "Answer the current change set" CurrentSet == nil ifTrue: [ self newChanges: self new ]. ^CurrentSet.
nameSpaceChangeClass ^NameSpaceChanges
newChanges: aChangeSet "Change the current change set." ChangeSet removeDependent: CurrentSet. CurrentSet := aChangeSet. ChangeSet addDependent: aChangeSet.
noChanges self current noChanges.
</methods> <methods> Store.XChangeSet class <category>initialization/finalization</category>
obsolete super obsolete. CurrentSet notNil ifTrue: [ ChangeSet removeDependent: CurrentSet ]
</methods> <methods> Store.XMainChangeSet <category>public-method changes</category>
addSelector: selector class: class toPackage: pkg "Put a new selector into aPackage." "Note- trusts that the selector is in fact, new. (Can't really verify it anyway)" | change | change := Change new class: class; selector: selector; add. pkg doSubdefChange: change. self doSubdefChange: change.
changeSelector: selector class: class toPackage: pkg "Put a modified selector into aPackage." | change currPkg | change := Change new class: class; selector: selector. currPkg := Registry containingPackageForSelector: selector class: class. ( currPkg ~~ nil and: [ currPkg ~= pkg ] ) ifTrue: [ currPkg doSubdefChange: change remove ]. pkg doSubdefChange: ( currPkg = pkg ifTrue: [ change change ] ifFalse: [ change add ] ). self doSubdefChange: change change.
correctSelector: selector class: class toPackage: pkg "Used only when converting Parcels. Put a added selector into aPackage where it has accidently been appropiated by the original class owner." | change currPkg | change := Change new class: class; selector: selector. currPkg := Registry containingPackageForSelector: selector class: class. ( currPkg ~~ nil and: [ currPkg ~= pkg ] ) ifTrue: [ currPkg relinquishSelector: selector class: class ]. pkg doSubdefChange: change add. self doSubdefChange: change add.
removeSelector: selector class: class | pkg change | change := Change new class: class; selector: selector; remove. pkg := Registry containingPackageForSelector: selector class: class. pkg isNil ifFalse: [ pkg doSubdefChange: change ]. self doSubdefChange: change.
removeSelector: selector class: class fromPackage: aPackage | change | change := Change new class: class; selector: selector; remove. aPackage isNil ifFalse: [ aPackage doSubdefChange: change ]. self doSubdefChange: change.
removeSelectorChanges: selector class: class | pkg change | change := (Change new) class: class; selector: selector; removeChanges. pkg := Registry quickContainingPackageForSelector: selector classSymbol: change symbol meta: class isMeta. pkg isNil ifFalse: [ pkg doSubdefChange: change ]. self doSubdefChange: change
</methods> <methods> Store.XMainChangeSet <category>public-data changes</category>
addDataKey: dataKey class: class package: newPkg | change | change := Change new class: class; dataKey: dataKey. newPkg == nil ifFalse: [ newPkg doSubdefChange: change add ]. self doSubdefChange: change add
addDataKey: dataKey nameSpace: namespace package: newPkg | change | change := Change new nameSpace: namespace; dataKey: dataKey. newPkg == nil ifFalse: [ newPkg doSubdefChange: change add ]. self doSubdefChange: change add
changeDataKey: dataKey class: class self changeDataKey: dataKey class: class package: ( Registry packageForDataKey: dataKey classSymbol: class absoluteSymbol ).
changeDataKey: dataKey class: class package: pkg | change currPkg | ( change := Change new ) class: class; dataKey: dataKey. currPkg := Registry containingPackageForDataKey: dataKey class: class. (currPkg notNil and: [currPkg ~= pkg]) ifTrue: [currPkg doSubdefChange: change remove]. pkg doSubdefChange: ( currPkg = pkg ifTrue: [change change] ifFalse: [change add] ). self doSubdefChange: change change
changeDataKey: dataKey nameSpace: namespace self changeDataKey: dataKey nameSpace: namespace package: ( Registry packageForDataKey: dataKey nameSpaceSymbol: namespace absoluteSymbol ).
changeDataKey: dataKey nameSpace: namespace package: pkg | change currPkg | ( change := Change new ) nameSpace: namespace ; dataKey: dataKey. currPkg := Registry containingPackageForDataKey: dataKey nameSpace: namespace. (currPkg notNil and: [currPkg ~= pkg]) ifTrue: [currPkg doSubdefChange: change remove]. pkg doSubdefChange: ( currPkg = pkg ifTrue: [change change] ifFalse: [change add] ). self doSubdefChange: change change
relocateBinding: binding from: currentOwner to: newOwner "Include indication that a variable binding has been moved." | change pkg | ( change := Change new ) actual: currentOwner; dataKey: binding key. pkg := Registry containingPackageForDataKey: binding key symbol: currentOwner absoluteSymbol. pkg == nil ifTrue: [ pkg := Registry packageForDataKey: binding key owner: newOwner ] ifFalse: [ ( change := Change new ) actual: currentOwner; dataKey: binding key. pkg doSubdefChange: change remove. ]. pkg == nil ifTrue: [ ^self ]. ( change := Change new ) actual: newOwner; dataKey: binding key. pkg doSubdefChange: change add. self doSubdefChange: change change.
removeBinding: binding in: owner owner isBehavior ifTrue: [ self removeDataKey: binding key class: owner ] ifFalse: [ self removeDataKey: binding key nameSpace: owner ].
removeChangesDataKey: dataKey class: class | pkg change | change := (Change new) class: class; dataKey: dataKey; removeChanges. pkg := Registry containingPackageForDataKey: dataKey symbol: class absoluteSymbol. pkg isNil ifFalse: [pkg doSubdefChange: change]. self doSubdefChange: change
removeDataKey: dataKey class: class | pkg change | change := (Change new) class: class; dataKey: dataKey; remove. pkg := Registry containingPackageForDataKey: dataKey symbol: class absoluteSymbol. pkg isNil ifFalse: [pkg doSubdefChange: change]. self doSubdefChange: change
removeDataKey: dataKey class: class from: aPackage | change | change := (Change new) class: class; dataKey: dataKey; remove. aPackage isNil ifFalse: [ aPackage doSubdefChange: change]. self doSubdefChange: change
removeDataKey: dataKey nameSpace: namespace | pkg change | change := (Change new) nameSpace: namespace; dataKey: dataKey; remove. pkg := Registry containingPackageForDataKey: dataKey symbol: namespace absoluteSymbol. pkg isNil ifFalse: [ pkg doSubdefChange: change ]. self doSubdefChange: change
removeDataKey: dataKey nameSpace: namespace from: aPackage | change | change := (Change new) nameSpace: namespace; dataKey: dataKey; remove. aPackage isNil ifFalse: [ aPackage doSubdefChange: change ]. self doSubdefChange: change
renameBinding: binding in: owner as: newName "Include indication that a variable binding has been renamed." | change pkg | pkg := Registry containingPackageForDataKey: binding key symbol: owner absoluteSymbol. pkg == nil ifTrue: [ pkg := Registry packageForDataKey: newName asSymbol owner: owner ] ifFalse: [ ( change := Change new ) actual: owner; dataKey: binding key. pkg doSubdefChange: change remove. ]. pkg == nil ifTrue: [ ^self ]. ( change := Change new ) actual: owner; dataKey: newName asSymbol. pkg doSubdefChange: change add. self doSubdefChange: change change.
</methods> <methods> Store.XMainChangeSet <category>public-fileIn/Out</category>
putStatsOn: stream "Write out all the changes the receiver knows about." self isEmpty ifTrue: [ ^stream nextPutAll: (#anEmptyChangeSet << #packages >> 'an Empty ChangeSet') asString. ]. self reorganizeSystem isEmpty ifFalse: [ stream nextPutAll: (#Reorganized << #packages >> 'Reorganized ...') asString; cr. self reorganizeSystem asSortedCollection do: [ :sym | stream tab; nextPutAll: sym; cr ]. stream cr. ]. super putStatsOn: stream
</methods> <methods> Store.XMainChangeSet <category>public-other changes</category>
addDoIt: smalltalkExpression "When filing out changes, append this string to the file." specialDoIts isNil ifTrue: [specialDoIts := OrderedCollection new]. specialDoIts add: smalltalkExpression.
addPatch: aPatchID "Record that a system patch has been applied" self needsMoreWork. " ChangeSet new addPatch: aPatchID " "duplicated - ds"
removeDoIt: smalltalkExpression "When filing out changes, append this string to the file." specialDoIts remove: smalltalkExpression ifAbsent: []
reorganizeClassData: class "Include indication that a class was reorganized (i.e. data protocol change)." "At the moment, we don't distinguish between instance, class or data' reorgs." self reorganizeClass: class.
reorganizeSystem "Include indication that the system classes were reorganized." reorganizeSystem == nil ifTrue: [ reorganizeSystem := IdentitySet new ]. ^reorganizeSystem.
</methods> <methods> Store.XMainChangeSet <category>public-testing</category>
isEmpty ^super isEmpty and: [ reorganizeSystem == nil and: [specialDoIts size == 0 ] ]
isMainChangeSet ^true
</methods> <methods> Store.XMainChangeSet <category>public-package movement</category>
moveClassDefinition: class from: oldPackage toPackage: newPackage "Move just the definition of class from its current package to newPackage." oldPackage = newPackage ifFalse: [ oldPackage notNil ifTrue: [ oldPackage doClassChange: ( Change new removeDefinition class: class ). ChangeSet component: oldPackage definition: class change: #removed. SourceFileManager default component: oldPackage definition: class change: #removed. ]. newPackage doClassChange: ( Change new add class: class ). newPackage isLoading ifFalse: [ ChangeSet component: newPackage definition: class change: #added. SourceFileManager default component: newPackage definition: class change: #added. ] ].
moveClassDefinition: class toPackage: newPackage "Move just the definition of class from its current package to newPackage." | pkg | pkg := Registry containingPackageForClass: class. self moveClassDefinition: class from: pkg toPackage: newPackage.
moveClassModel: aModel to: bPackage "Move what part of a class that is contained in a model to bPackage." aModel hasDefinition ifTrue: [ self moveClassDefinition: aModel actualClass from: aModel package toPackage: bPackage ]. aModel classAndSelectorDo: [ :cls :selector | self moveSelector: selector class: cls toPackage: bPackage ]. aModel classAndDataKeyDo: [ :cls :datakey | self moveDataKey: datakey class: cls toPackage: bPackage ].
moveClassName: aClassName from: aPackage to: bPackage "Move what part of a class that is contained in aPackage to bPackage." | model | bPackage == aPackage ifTrue: [ ^self ]. model := aPackage classModelAtClassName: aClassName ifAbsent: [ ^self ]. model hasDefinition ifTrue: [ self moveClassDefinition: model actualClass toPackage: bPackage ]. model classAndSelectorDo: [ :cls :selector | self moveSelector: selector class: cls toPackage: bPackage ]. model classAndDataKeyDo: [ :cls :dataKey | self moveDataKey: dataKey class: cls toPackage: bPackage ]
moveDataKey: dataKey class: class toPackage: newPackage | pkg | pkg := Registry containingPackageForDataKey: dataKey class: class. pkg = newPackage ifFalse: [ pkg notNil ifTrue: [ pkg doSubdefChange: ( ( Change new remove ) dataKey: dataKey; class: class ). ChangeSet component: pkg definition: class static: dataKey change: #removed. SourceFileManager default component: pkg definition: class static: dataKey change: #removed. ]. newPackage doSubdefChange: ( ( Change new add) dataKey: dataKey; class: class ). newPackage isLoading ifFalse: [ ChangeSet component: newPackage definition: class static: dataKey change: #added. SourceFileManager default component: newPackage definition: class static: dataKey change: #added. ] ]
moveDataKey: dataKey nameSpace: nameSpace toPackage: newPackage | pkg | pkg := Registry containingPackageForDataKey: dataKey nameSpace: nameSpace. pkg = newPackage ifFalse: [ pkg notNil ifTrue: [ pkg doSubdefChange: ( (Change new remove ) dataKey: dataKey; nameSpace: nameSpace ). ChangeSet component: pkg definition: nameSpace static: dataKey change: #removed. SourceFileManager default component: pkg definition: nameSpace static: dataKey change: #removed. ]. newPackage doSubdefChange: ( ( Change new add ) dataKey: dataKey; nameSpace: nameSpace ). newPackage isLoading ifFalse: [ ChangeSet component: newPackage definition: nameSpace static: dataKey change: #added. SourceFileManager default component: newPackage definition: nameSpace static: dataKey change: #added. ] ]
moveDataKey: dataKey owner: anOwner toPackage: newPackage anOwner isBehavior ifTrue: [ ^self moveDataKey: dataKey class: anOwner toPackage: newPackage ]. anOwner isNameSpace ifTrue: [ ^self moveDataKey: dataKey nameSpace: anOwner toPackage: newPackage ]. self error: (#UnexpectedOwner << #packages >> 'Unexpected owner.')
moveDefinition: classOrNameSpace toPackage: newPackage "Move just the definition of class or namespace from its current package to newPackage." classOrNameSpace isForNameSpace ifTrue: [ self moveNameSpaceDefinition: classOrNameSpace toPackage: newPackage ] ifFalse: [ self moveClassDefinition: classOrNameSpace toPackage: newPackage ]
moveNameSpaceDefinition: namespace from: oldPackage toPackage: newPackage "Move just the definition of 'namespace' from its oldPackage to newPackage." oldPackage = newPackage ifFalse: [ oldPackage notNil ifTrue: [ oldPackage doNameSpaceChange: ( Change new removeDefinition nameSpace: namespace ). ChangeSet component: oldPackage definition: namespace change: #removed. SourceFileManager default component: oldPackage definition: namespace change: #removed. ]. newPackage doNameSpaceChange: ( Change new add nameSpace: namespace ). newPackage isLoading ifFalse: [ ChangeSet component: newPackage definition: namespace change: #added. SourceFileManager default component: newPackage definition: namespace change: #added. ] ]
moveNameSpaceDefinition: namespace toPackage: newPackage "Move just the definition of 'namespace' from its current package to newPackage." | pkg | pkg := Registry containingPackageForNameSpace: namespace. self moveNameSpaceDefinition: namespace from: pkg toPackage: newPackage
moveNameSpaceModel: model to: bPackage "Move the definition and whatever other parts of a namespace that is contained in aModel to bPackage." model hasDefinition ifTrue: [ self moveNameSpaceDefinition: model nameSpace from: model package toPackage: bPackage ]. model nameSpaceAndDataKeyDo: [ :ns :dataKey | self moveDataKey: dataKey nameSpace: ns toPackage: bPackage ]
moveObject: aDefinedObject from: aPackage to: bPackage "Move what part of a class/namespace that is contained in aPackage to bPackage." | model | model := aPackage modelAtName: aDefinedObject absoluteName ifAbsent: [ aDefinedObject isBehavior ifTrue: [ self moveUnpackagedInWholeClass: aDefinedObject toPackage: bPackage ] ifFalse: [ self moveUnpackagedInWholeNameSpace: aDefinedObject toPackage: bPackage ]. ^self ]. model isClassModel ifTrue: [ self moveClassModel: model to: bPackage ] ifFalse: [ self moveNameSpaceModel: model to: bPackage ].
moveSelector: selector class: class fromPackage: oldPackage | pkg | pkg := Registry containingPackageForSelector: selector class: class. pkg = oldPackage ifFalse: [ ^self ]. "already been moved" self moveSelector: selector class: class toPackage: ( Registry nullPackage ).
moveSelector: selector class: class toPackage: newPackage | pkg | pkg := Registry containingPackageForSelector: selector class: class. pkg = newPackage ifFalse: [ pkg notNil ifTrue: [ pkg doSubdefChange: (Change new remove selector: selector; class: class ). ChangeSet component: pkg definition: class selector: selector change: #removed. SourceFileManager default component: pkg definition: class selector: selector change: #removed. ]. newPackage doSubdefChange: ( Change new add selector: selector; class: class ). newPackage isLoading ifFalse: [ ChangeSet component: newPackage definition: class selector: selector change: #added. SourceFileManager default component: newPackage definition: class selector: selector change: #added. ] ].
moveSelectors: selectors class: class toPackage: newPackage | pkg | selectors do: [ :sel | pkg := Registry containingPackageForSelector: sel class: class. pkg = newPackage ifFalse: [ pkg notNil ifTrue: [ pkg doSubdefChange: ( Change new remove selector: sel; class: class ). ChangeSet component: pkg definition: class selector: sel change: #removed. SourceFileManager default component: pkg definition: class selector: sel change: #removed. ]. newPackage doSubdefChange: ( Change new add selector: sel; class: class ). newPackage isLoading ifFalse: [ ChangeSet component: pkg definition: class selector: sel change: #added. SourceFileManager default component: pkg definition: class selector: sel change: #added. ] ] ].
moveUnpackagedClassDefinition: class toPackage: newPackage "Move just the definition of 'class' from its current package to 'newPackage'." | pkg | pkg := Registry containingPackageForClass: class. pkg isNil ifTrue: [newPackage doClassChange: (Change new add class: class)]
moveUnpackagedDataKey: dataKey nameSpace: namespace toPackage: newPackage | pkg | pkg := Registry containingPackageForDataKey: dataKey nameSpace: namespace. pkg isNil ifTrue: [ newPackage doSubdefChange: ( (Change new add) dataKey: dataKey; nameSpace: namespace ) ]
moveUnpackagedInWholeClass: class toPackage: newPackage "Move the definition of 'class' and all its methods from its current package to 'newPackage'." class selectors do: [:selector | self moveUnpackagedSelector: selector class: class toPackage: newPackage]. class class selectors do: [:selector | self moveUnpackagedSelector: selector class: class class toPackage: newPackage]. self moveUnpackagedClassDefinition: class toPackage: newPackage.
moveUnpackagedInWholeNameSpace: namespace toPackage: newPackage "Move the definition of namespace and all its methods from its current package to 'newPackage'." namespace bindingsDo: [ : binding | ( binding isForGeneral ) ifTrue: [ self moveUnpackagedDataKey: binding key nameSpace: namespace toPackage: newPackage ] ]. self moveUnpackagedNameSpaceDefinition: namespace toPackage: newPackage.
moveUnpackagedNameSpaceDefinition: namespace toPackage: newPackage "Move just the definition of namespace from its current package to 'newPackage'." | pkg | pkg := Registry containingPackageForNameSpace: namespace. pkg isNil ifTrue: [ newPackage doNameSpaceChange: ( Change new add nameSpace: namespace ) ]
moveUnpackagedSelector: selector class: class toPackage: newPackage | pkg | pkg := Registry containingPackageForSelector: selector class: class. pkg isNil ifTrue: [newPackage doSubdefChange: (Change new add selector: selector; class: class)]
moveWholeClass: class toPackage: newPackage "Move the definition of 'class' and all its methods from its current package to 'newPackage'." | cls | cls := class instanceBehavior. cls selectors do: [ :selector | self moveSelector: selector class: cls toPackage: newPackage ]. cls class selectors do: [ :selector | self moveSelector: selector class: cls class toPackage: newPackage ]. cls dataKeys do: [ :dataKey | self moveDataKey: dataKey class: cls toPackage: newPackage ]. self moveClassDefinition: cls toPackage: newPackage.
moveWholeNameSpace: namespace toPackage: newPackage "Move the definition of 'namespace' and all its methods from its current package to 'newPackage'." namespace dataBindings do: [ :binding | self moveDataKey: binding key nameSpace: namespace toPackage: newPackage ]. self moveNameSpaceDefinition: namespace toPackage: newPackage.
moveWholeObject: object toPackage: newPackage "Move the definition of a class/namespace and it's contents from its current package to newPackage." object isBehavior ifTrue: [ ^self moveWholeClass: object toPackage: newPackage ]. ( object isNameSpace ) ifTrue: [ ^self moveWholeNameSpace: object toPackage: newPackage ].
</methods> <methods> Store.XMainChangeSet <category>events</category>
changeSelector: selector class: class documentation: documentation self changeSelector: selector class: class
changeSelector: selector class: class protocol: protocol self changeSelector: selector class: class
packageFromAttributes: attributes "Private- Check attributes for a package and answer it or nil." | pname | pname := ( SystemUtils makeAttributesDictionary: attributes ) at: #package ifAbsent: [ ^nil ]. ^Registry packageNamedOrCreate: pname.
reorganizeClass: class | pkg change | change := (Change new) class: class; reorganize. pkg := Registry containingPackageForClassSymbol: class instanceBehavior absoluteSymbol. pkg isNil ifFalse: [pkg doClassChange: change]. self doClassChange: change.
update: anAspect with: arguments from: anObject "ChangeSet changes- reexecute here." "Transcript show: anAspect; tab; show: arguments printString; cr." anAspect isSymbol ifFalse: [^nil]. ^[ self perform: anAspect withArguments: arguments ] on: MessageNotUnderstood do: [ :e | e message selector == anAspect ifTrue: [ ^nil ] ifFalse: [ e pass ] ]
</methods> <methods> Store.XMainChangeSet <category>public-namespace changes</category>
addNameSpace: nameSpace toPackage: pkg "Add a newly created namespace to a package." "Note, pkg cannot be nil." | change currPkg | change := Change new nameSpace: nameSpace . currPkg := Registry containingPackageForNameSpace: nameSpace. "currPkg should be nil. This is just in case code." ( currPkg ~~ nil and: [ currPkg ~= pkg ] ) ifTrue: [ currPkg doNameSpaceChange: change removeDefinition ]. self moveUnpackagedInWholeNameSpace: nameSpace toPackage: pkg. self doNameSpaceChange: change add.
addNameSpaceDefinition: nameSpace toPackage: pkg "Add a newly created namespace to a package." "Note, pkg cannot be nil." | change currPkg | change := Change new nameSpace: nameSpace . currPkg := Registry containingPackageForNameSpace: nameSpace. "currPkg should be nil. This is just in case code." ( currPkg ~~ nil and: [ currPkg ~= pkg ] ) ifTrue: [ currPkg doNameSpaceChange: change removeDefinition ]. pkg doNameSpaceChange: change add.
changeNameSpace: namespace toPackage: pkg "Put a modifed namespace to a package." "Note, pkg cannot be nil." | change currPkg | change := Change new nameSpace: namespace. currPkg := Registry containingPackageForNameSpace: namespace. ( currPkg notNil and: [currPkg ~= pkg]) ifTrue: [ currPkg doNameSpaceChange: change removeDefinition ]. pkg doNameSpaceChange: ( currPkg = pkg ifTrue: [ change change ] ifFalse: [ change add ] ). self doNameSpaceChange: change change.
commentNameSpace: namespace | pkg change | change := (Change new) nameSpace: namespace; comment. pkg := Registry containingPackageForNameSpace: namespace. pkg isNil ifFalse: [pkg doNameSpaceChange: change]. self doNameSpaceChange: change.
component: component property: property value: value component addPropertyChange: property.
component: component renamedTo: aString component addOtherChange: #name
relocateNameSpace: namespace from: parent to: newParent "Include indication that a nameSpace has been moved." self renameNameSpace: namespace asAbsoluteSymbol: ( BindingReference fullNameFrom: newParent absoluteName name: namespace name ) asSymbol.
removeNameSpace: namespace "This is subtle, packages need to know about whole namespace removes as an atomic act - then they translate to bit by bit remove. At the main level, we do our own bit by bit translation - taking into account that the original name may have been different." | change nameSpaceSymbol cc | Registry packagesContainingNameSpace: namespace do: [ :pkg | pkg doNameSpaceChange: ( Change new remove nameSpace: namespace ) ]. nameSpaceSymbol := namespace absoluteSymbol. cc := self createForNameSpaceAt: nameSpaceSymbol. cc isRenamed ifTrue: [ nameSpaceSymbol := cc oldName. self at: nameSpaceSymbol put: cc. self removeKey: namespace absoluteSymbol ]. change := Change new remove nameSpaceSymbol: nameSpaceSymbol. self doNameSpaceChange: change. namespace dataBindings do: [ :binding | self doSubdefChange: (change dataKey: binding key ) ]
renameNameSpace: namespace as: newName "Include indication that a nameSpace has been renamed." self renameNameSpace: namespace asAbsoluteSymbol: ( BindingReference newName: newName from: namespace absoluteName ) asSymbol.
reorganizeNameSpace: namespace self reorganizeSystem add: namespace absoluteSymbol. " | pkg change | change := (TT_Change new) nameSpace: namespace; reorganize. pkg := TT_Registry containingPackageForSymbol: namespace absoluteSymbol. pkg isNil ifFalse: [pkg doNameSpaceChange: change]. self doNameSpaceChange: change. "
</methods> <methods> Store.XMainChangeSet <category>public-class changes</category>
addClass: class toPackage: pkg "Add a newly created class to a package." "Note, pkg cannot be nil." | change currPkg | change := Change new class: class. "currPkg should be nil.... but we check just in case." currPkg := Registry containingPackageForClass: class. ( currPkg ~~ nil and: [ currPkg ~= pkg ] ) ifTrue: [ currPkg doClassChange: change removeDefinition ]. self moveUnpackagedInWholeClass: class toPackage: pkg. self doClassChange: change add.
addClassDefinition: class toPackage: pkg "Add a newly created class to a package." "Note, pkg cannot be nil." | change currPkg | change := Change new class: class. "currPkg should be nil.... but we check just in case." currPkg := Registry containingPackageForClass: class. ( currPkg ~~ nil and: [ currPkg ~= pkg ] ) ifTrue: [ currPkg doClassChange: change removeDefinition ]. pkg doClassChange: change add.
changeClass: class toPackage: pkg "Put a modifed class to a package." "Note, pkg cannot be nil." | change currPkg | change := Change new class: class. currPkg := Registry containingPackageForClass: class. ( currPkg ~~ nil and: [ currPkg ~= pkg ] ) ifTrue: [ currPkg doClassChange: change removeDefinition ]. pkg doClassChange: ( currPkg = pkg ifTrue: [ change change ] ifFalse: [ change add ] ). self doClassChange: change change.
changeDefinitionClass: cls "Mark a changed class definition. If it doesn't exist, it's already been changed." | change currPkg | change := Change new class: cls. change change. currPkg := Registry containingPackageForClass: cls. currPkg == nil ifTrue: [ ^nil ]. currPkg doClassChange: change. self doClassChange: change.
commentClass: class | pkg change | change := (Change new) class: class; comment. pkg := Registry containingPackageForClass: class. pkg isNil ifFalse: [pkg doClassChange: change]. self doClassChange: change.
relocateClass: class from: nameSpace to: newNameSpace "Since a class may have extensions in various packages we must iterate over all packages containing the class." self renameClass: class asAbsoluteSymbol: ( BindingReference fullNameFrom: newNameSpace absoluteName name: class name ) asSymbol.
removeChangesPropagatingClass: class | change | change := (Change new) class: class; removeChanges. Registry packagesContainingClass: class do: [:pkg | pkg doClassChange: change]. self doClassChange: change
removeClass: class "This is subtle, packages need to know about whole class removes as an atomic act - then they translate to bit by bit remove. At the main level, we do our own bit by bit translation - taking into account that the original name may have been different." | change classSymbol cc | Registry packagesContainingClass: class do: [:pkg | pkg doClassChange: (Change new remove class: class)]. classSymbol := class absoluteSymbol. cc := self createForClassAt: classSymbol. cc isRenamed ifTrue: [classSymbol := cc oldName. self at: classSymbol put: cc. self removeKey: class absoluteSymbol]. change := Change new remove classSymbol: classSymbol. self doClassChange: change. class selectors do: [:selector | self doSubdefChange: (change selector: selector; meta: false)]. class class selectors do: [:selector | self doSubdefChange: (change selector: selector; meta: true)]. class dataKeys do: [:dataKey | self doSubdefChange: (change dataKey: dataKey)].
removeClass: class from: package "Remove the class definition from package. Assumes it has/will be moved to another package." | change classSymbol | package doClassChange: ( Change new remove class: class ). classSymbol := class absoluteSymbol. change := Change new remove classSymbol: classSymbol. self doClassChange: change.
removeClassChanges: class "Remove all memory of changes associated with this class and its metaclass." self doClassChange: ((Change new) class: class; removeChanges)
renameClass: class as: newName "Since a class may have extensions in various packages we must iterate over all packages containing the class." self renameClass: class asAbsoluteSymbol: ( BindingReference newName: newName from: class absoluteName ) asSymbol.
</methods> <methods> Store.XMainChangeSet <category>private- cascade changes</category>
cascadeRelocateNameSpace: namespace to: newEnvironmentSymbol "Private- newEnvironmentSymbol is the about to be renamed/relocated enviornment of namespace. Cascade to all contained namespaces and classes models." | newSymbol | newSymbol := BindingReference fullNameFrom: newEnvironmentSymbol name: namespace name. Registry packagesContainingNameSpace: namespace do: [ :pkg | pkg renameNameSpaceSymbol: namespace absoluteSymbol as: newSymbol ]. namespace classes do: [ :cls | Registry packagesContainingClass: cls do: [ :pkg | pkg renameClassSymbol: cls absoluteSymbol as: ( BindingReference fullNameFrom: newSymbol name: cls name ). ]. cls allSubclasses do: [ :sub | self changeDefinitionClass: sub ]. ]. namespace nameSpaces do: [ :ns | self cascadeRelocateNameSpace: ns to: newSymbol ].
renameClass: class asAbsoluteSymbol: newSymbol "Since a class may have extensions in various packages we must iterate over all packages containing the class." | oldSymbol | oldSymbol := class absoluteSymbol. Registry packagesContainingClassSymbol: oldSymbol do: [:pkg | pkg renameClassSymbol: oldSymbol as: newSymbol ]. class subclasses do: [ :cls | ( Registry packageForClass: cls ) doClassChange: ( (Change new) class: cls; change ) ]. self createForClassAt: oldSymbol andMoveTo: newSymbol.
renameNameSpace: namespace asAbsoluteSymbol: newSymbol "Since a NameSpace may have extensions in various packages we must iterate over all packages containing the namespace." | oldSymbol cc | oldSymbol := namespace absoluteSymbol. Registry packagesContainingNameSpace: namespace do: [:pkg | pkg renameNameSpaceSymbol: oldSymbol as: newSymbol ]. namespace classes do: [ :cls | | newClassSym | newClassSym := ( BindingReference fullNameFrom: newSymbol name: cls name ) asSymbol. Registry packagesContainingClass: cls do: [ :pkg | pkg renameClassSymbol: cls absoluteSymbol as: newClassSym ]. cls allSubclasses do: [ :sub | self changeDefinitionClass: sub ]. ]. namespace nameSpaces do: [ :ns | self cascadeRelocateNameSpace: ns to: newSymbol ]. cc := self createForNameSpaceAt: oldSymbol. cc renameOldSymbol: oldSymbol. self at: newSymbol put: cc. self removeKey: oldSymbol.
</methods> <methods> Store.XMainChangeSet <category>private-fileIn/Out</category>
fileOutSpecialOn: fileManager "Write out any special changes the receiver knows about." super fileOutSpecialOn: fileManager. self reorganizeSystem isEmpty ifFalse: [self reorganizeSystem do: [ :envstr | | ns | ns := envstr asStrictReference valueOrDo: [ nil ]. ns == nil ifFalse: [ fileManager reorganizeNameSpace: ns. ] ] ]. specialDoIts size > 0 ifTrue: [specialDoIts do: [:expression | fileManager storeExpression: expression]]
</methods> <methods> Store.XMainChangeSet <category>events-parcels</category>
installedClasses: classList toPackage: aPackage classList do: [ :cls | self addClassDefinition: cls toPackage: aPackage. ].
installedMethods: list toPackage: aPackage list do: [ :mir | self changeSelector: mir selector class: mir mclass classObject toPackage: aPackage ]
installedNameSpaces: list toPackage: aPackage list do: [ :ns | self addNameSpaceDefinition: ns toPackage: aPackage. ].
installedOverrideMethods: list toPackage: aPackage list do: [ :mir | self changeSelector: mir selector class: mir mclass classObject toPackage: aPackage ].
</methods> <methods> Store.XMainChangeSet <category>db phantoms</category>
addRemoveClass: className package: aPackage "Adds a remove class change to aPackage, for the case of an unloadable definition." aPackage doClassChange: ( Change new removeDefinition className: className meta: false ).
addRemoveNameSpace: aName package: aPackage "Adds a remove namespace change to aPackage, for the case of an unloadable definition." aPackage doNameSpaceChange: ( Change new removeDefinition nameSpaceSymbol: aName asSymbol ).
addRemoveSelector: selector className: className meta: meta package: aPackage "Adds a remove selector change to aPackage, for the case of an unloadable definition." aPackage doSubdefChange: ( Change new remove selector: selector; className: className meta: meta ).
addRemoveStatic: key ownerName: ownerName isInNameSpace: aBoolean package: aPackage "Adds a remove static change to aPackage, for the case of an unloadable definition." | change | change := Change new remove dataKey: key. aBoolean ifTrue: [ change classSymbol: ownerName asSymbol ] ifFalse: [ change nameSpaceSymbol: ownerName asSymbol ]. aPackage doSubdefChange: change.
</methods> <methods> Store.XMainChangeSet class <category>utilities</category>
ignoreChangesWhile: aBlock "Code changes that occur during the execution of aBlock are not recorded in any change set. " ^ChangeSet ignoreChangesWhile: aBlock
ignoreMainChangesWhile: aBlock "Code changes that occur during the execution of aBlock are not recorded in the current change set. But propagation of changes from the MainChangeSet to packages are still carried." | currentCS | currentCS := XChangeSet current. [ XChangeSet newChanges: XMainChangeSet new. aBlock value ] ensure: [ XChangeSet newChanges: currentCS ]
</methods> <methods> Store.XMainChangeSet class <category>initialize</category>
initialize self newChanges: self new.
</methods> <methods> Store.BundleStructureChange <category>fileIn/Out</category>
fileIn "File-in the receiver - ie. make the change to the system." self createComponent structure: structure.
fileOutOn: aSourceFile aSourceFile bundleNamed: componentName structure: structure
</methods> <methods> Store.BundleStructureChange <category>testing</category>
isStructureTag ^true
sameAsSystem "Return true if the receiver represents an object that is the same as the system." | bundle | ( bundle := self component ) == nil ifTrue: [ ^false ]. ^structure = bundle structure
</methods> <methods> Store.BundleStructureChange <category>accessing</category>
component: aBundle "Extract relevant information from aCodeComponent." super component: aBundle. structure := aBundle structure.
componentType ^#bundle
name "Answer the name which should appear in the list view." nil == name ifTrue: [ name := self description ]. ^name
parameters "Return the parameters used for the 'same as' test" ^super parameters asOrderedCollection add: structure; asArray.
structure ^structure
structure: anArray structure := anArray.
structureString: aString structure := Compiler evaluate: aString
systemText "Answer the text displayed by the receiver." | comp | ( comp := self component ) == nil ifTrue: [ ^(#doesNotExist << #packages >> 'does not exist') asString ]. ^self text: comp structure
text "Answer the text displayed by the receiver." ^self text: structure
text: aStructure "Answer the text displayed by the receiver with aStructure." | stream | stream := ( String new: 100 ) writeStream. stream nextPutAll: ((#x1sStructureC << #packages >> '<1s> structure: ') expandMacrosWith: componentName); cr. aStructure do: [ :array | stream tab; nextPutAll: array storeString; cr ]. ^stream contents
type "Answer the sub-type of this kind of change." ^#structure
</methods> <methods> Store.BundleStructureChange <category>store</category>
doChangeTo: aChangeSet "Perfrom the reciever's change onto aChangeSet." "Used in converting ChangeSet changes to Store changes." aChangeSet addOtherChange: BundleModel structureMark.
</methods> <methods> Store.BundleStructureChange <category>printing</category>
description ^((#x1sStructureChanged << #packages >> '<1s> structure changed') expandMacrosWith: super description)
printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: (#structureChanged << #packages >> '<1s> structure changed' expandMacrosWith: componentName); nextPut: $)
</methods> <methods> Store.BundleStructureChange <category>converting</category>
sourceTextForImage | comp | comp := self component. ^comp == nil ifTrue: [ nil ] ifFalse: [ comp structure ]
</methods> <methods> Store.PundleForParcel <category>initialization</category>
from: aPundle saveLinks: saveLinks name := aPundle name. properties := aPundle propertiesForFileOut. saveLinks ifTrue: [ properties at: #dbTrace put: aPundle dbTrace; at: #dbIdentifier put: aPundle dbIdentifier; at: #printStringCache put: aPundle printStringCache ].
</methods> <methods> Store.PundleForParcel <category>private</category>
asPundle: relink "Convert the receiver into a pundle. Called on parcel load. Answer the converted pundle" | pundle | pundle := self pundleInImage. pundle startLoad. [ relink ifTrue: [ pundle restoreLinksFrom: properties ]. self removeLinks: properties. pundle properties: properties. ] ensure: [ pundle endLoad ]. ^pundle.
removeLinks: propertyDictionary "Remove the database links before coping them over." propertyDictionary removeKey: #databaseId ifAbsent: nil; removeKey: #dbIdentifier ifAbsent: nil; removeKey: #dbTrace ifAbsent: nil.
updates: updates fromParcel: aParcel relink: relink "Update the pundle in the image from a parcel." | pundle | pundle := self pundleInImage. pundle properties: properties. relink ifFalse: [ self removeLinks: pundle properties ]. ^pundle.
</methods> <methods> Store.PundleForParcel <category>accessing</category>
dbIdentifier | dbid | ^( dbid := properties at: #dbIdentifier ifAbsent: [ properties at: #databaseId ifAbsent: [ nil ] ] ) == nil ifFalse: [ dbid asSymbol ].
properties ^properties
</methods> <methods> Store.PundleForParcel <category>conversion</category>
convert "Convert the receiver into a pundle. Called on parcel load. Answer the converted pundle" | pundle relink | relink := self dbIdentifier ~~ nil. pundle := self asPundle: relink. ^pundle
installContentsUsing: aCodeReader "Install the pundle contents through aCodeReader" self subclassResponsibility
installUsing: aCodeReader "Install the receiver ordered using aCodeReader." "This is assumed to be sent to the outermost pundle, and the the actions are being run for the parcel itself." self installContentsUsing: aCodeReader.
updates: updates fromParcel: aParcel "A parcel has been updated- update the receiver's image model." | pundle relink | relink := self dbIdentifier ~~ nil. pundle := self updates: updates fromParcel: aParcel relink: relink. ^pundle
</methods> <methods> Store.PundleForParcel class <category>instance creation</category>
classForPundle: aPundle ^aPundle isPackage ifTrue: [ PackageForParcel ] ifFalse: [ BundleForParcel ]
from: aPundle saveLinks: saveLinks ^( self classForPundle: aPundle ) new from: aPundle saveLinks: saveLinks
</methods> <methods> Store.ComponentDescription <category>comparing</category>
= anObject self class == anObject class ifFalse: [ ^false ]. ^self describesSameAs: anObject
hash ^self isPackage hash bitXor: self componentName hash
</methods> <methods> Store.ComponentDescription <category>testing</category>
describesBundleNamed: aString "Answer true if the description refers to a bundle named aString." ^false
describesComponent: aPundle "Answer true if my description matches exactly aPundle" "NOTE: assumes aPundle is the image version of the receiver." | info | aPundle == nil ifTrue: [ ^false ]. id == nil ifTrue: [ ^true ]. ( info := aPundle databaseInformationFor: dbIdentifier ) == nil ifTrue: [ ^false ]. ^info dbTrace = id
describesPackageNamed: aString "Answer true if the description refers to a package named aString." ^false
exactLoadedComponent "Find if a bundle with my id is loaded into the image." self subclassResponsibility
isBundle ^false
isPackage ^false
loadedComponent "Find if a component fulfilling my description is loaded into the image. My subclasses should answer this message" self subclassResponsibility
</methods> <methods> Store.ComponentDescription <category>printing</category>
printOn: aStream aStream nextPutAll: self class name asString. aStream nextPutAll: ' ('. componentName == nil ifFalse: [ aStream nextPutAll: componentName ]. aStream nextPut: $ . id == nil ifFalse: [ id printOn: aStream ]. dbIdentifier == nil ifFalse: [ aStream nextPutAll: ':', dbIdentifier ]. aStream nextPut: $).
</methods> <methods> Store.ComponentDescription <category>accessing</category>
component "Find a component named componentName and answer it." ^self subclassResponsibility
component: aLoadedComponent "Set the name of the component" componentName := aLoadedComponent name. dbIdentifier := aLoadedComponent dbIdentifier. id := aLoadedComponent isLoaded ifTrue: [ aLoadedComponent dbTrace ] ifFalse: [ aLoadedComponent primaryKey ].
componentName "Answer a component name" componentName == nil ifTrue: [ self setName ]. ^componentName
componentName: aString "Set a component name" componentName := aString
dbComponent "Find a component named componentName and answer it." ^self subclassResponsibility
dbIdentifier ^dbIdentifier
dbIdentifier: aSymbol "Set the database identifier." dbIdentifier := aSymbol == nil ifFalse: [ aSymbol asSymbol ]
hasSetVersion "A description describes a particular version of a component if the id field is set." ^id notNil
id ^id
id: aValue id := aValue
name "Answer a component name" ^self componentName
</methods> <methods> Store.ComponentDescription <category>private</category>
setName | comp | comp := self loadedComponent. comp notNil ifTrue: [self component: comp]
</methods> <methods> Store.PackageDescription <category>testing</category>
describesPackageNamed: aString "Answer true if the description referes to a package named aString" ^self componentName = aString
describesSameAs: aComponentDescr "Answer true if aComponentDescr referes to a package named the same as my bundle" ^aComponentDescr isPackage and: [ self describesPackageNamed: aComponentDescr name ].
isPackage ^true
</methods> <methods> Store.PackageDescription <category>accessing</category>
component "Find a component named componentName and answer it." ^componentName isNil ifTrue: [nil] ifFalse: [Registry packageNamed: componentName]
createComponent "Return the component with my componentName create it if needed." componentName isNil ifTrue: [ ^nil ]. ^Registry packageNamedOrCreate: componentName.
</methods> <methods> Store.PackageDescription <category>private</category>
leafItems "My component is a leaf item." | comp | comp := self component. ^comp isNil ifTrue: [#()] ifFalse: [Array with: comp]
</methods> <methods> Store.DatabaseConnectionInformation <category>accessing</category>
dbIdentifier ^dbIdentifier
dbIdentifier: aSymbol dbIdentifier := aSymbol asSymbol
manager ^Registry
pundle ^pundle
pundle: aPundle ^pundle := aPundle
</methods> <methods> Store.DatabaseConnectionInformation <category>testing</category>
isInCurrentDatabase "The only time that DbRegistry might be defined and still be nil is if StoreBase is being loaded into the image for the first time. So, the following check is simply to prevent walkbacks while loading StoreBase." ^#{Store.DbRegistry} ifDefinedDo: [:registry | registry notNil and: [registry dbIdentifier = self dbIdentifier]] elseDo: [false]
shouldTrackChanges ^#{Store.DbRegistry} isDefined
</methods> <methods> Store.DatabaseConnectionInformation <category>initialization</category>
initializeContentsFrom: anInfo "pass"
</methods> <methods> Store.DatabaseConnectionInformation class <category>instance creation</category>
dbIdentifier: aSymbol "Answer an instance of the receiver for a database." ^self new dbIdentifier: aSymbol asSymbol; yourself.
</methods> <methods> Store.DatabaseConnectionBundleInformation <category>initialization</category>
initialize self initializeContents
initializeContents contentDescriptions := List new.
initializeContentsFrom: aBundleConnectionInformation "Set up the initial contents from an existing dbconnection." contentDescriptions := ( aBundleConnectionInformation contentDescriptions collect: [ :desc | desc copy id: nil; dbIdentifier: dbIdentifier; yourself ] ) asList. #{Store.DbRegistry} ifDefinedDo: [ :reg | fileDescriptions := aBundleConnectionInformation fileDescriptions collect: [ :desc | desc copy dbTrace: nil; yourself ]. ].
</methods> <methods> Store.DatabaseConnectionBundleInformation <category>accessing</category>
contentDescriptions "Answer a collection of pundle descriptions." ^contentDescriptions
contentDescriptions: aCollection contentDescriptions := aCollection asList
</methods> <methods> Store.DatabaseConnectionBundleInformation <category>actions</category>
addComponentDescription: aComponentDescription "Add aComponentDescription to the contents" ( contentDescriptions includes: aComponentDescription ) ifTrue: [ ^false ]. contentDescriptions add: aComponentDescription. self shouldTrackChanges ifTrue: [ self addOtherChange: pundle structureMark ]. Registry changedBundleStructure: self pundle. ^true
adjustComponents "Ensure all components are named." contentDescriptions do: [ :desc | desc setName ].
component: aComponent beingRenamedTo: aString "aComponent is about to be renamed to aString. Ensure that the component description that the receiver has for aComponent has its componentName set appropriately. Because this method is only invoked by the bundle that encloses aComponent, it is an error condition if a match can not be made. " | matchingDescription | matchingDescription := contentDescriptions detect: [:description | description name = aComponent name and: [description isPackage = aComponent isPackage]] ifNone: [nil]. matchingDescription isNil ifTrue: [^self error: #NoMatchingComponentDescription << #packages >> 'No matching component description']. matchingDescription componentName: aString. self shouldTrackChanges ifTrue: [self addOtherChange: pundle structureMark]
containedItems: aCollectionOfComponents "Set my contents to be aCollectionOfComponents." "Note: consolidated, so #addedComponent event registered only once. The component is ignored anyway and this it is also used for removals." | saved mark | saved := contentDescriptions. mark := false. self initializeContents. aCollectionOfComponents do: [ :cmpt | | desc | desc := cmpt asDescription. ( contentDescriptions includes: desc ) ifFalse: [ contentDescriptions add: desc. ( saved includes: desc ) ifFalse: [ mark := true ]. ] ]. saved do: [ :desc | ( aCollectionOfComponents contains: [ :cmpt | cmpt asDescription = desc ] ) ifFalse: [ mark := true ] ]. ( self shouldTrackChanges and: [ mark or: [ ( saved = contentDescriptions ) not ] ] ) ifTrue: [ self addOtherChange: pundle structureMark ]. Registry changedBundleStructure: self pundle.
removeComponentDescription: aComponentDescription "Remove aComponentDescription from the receiver's contents" contentDescriptions remove: aComponentDescription ifAbsent: nil. self shouldTrackChanges ifTrue: [ self addOtherChange: pundle structureMark ]. Registry changedBundleStructure: self pundle.
removeNonexistentComponents contentDescriptions copy do: [ :descr | descr == nil ifFalse: [ descr component == nil ifTrue: [ self removeComponentDescription: descr ] ] ].
removeNonexistentComponentsRecursive contentDescriptions copy do: [ :descr | | comp | descr == nil ifFalse: [ ( comp := descr component ) == nil ifTrue: [ self removeComponentDescription: descr ] ifFalse: [ comp isBundle ifTrue: [ comp removeNonexistentComponentsRecursive ] ] ] ].
</methods> <methods> Store.DatabaseConnectionBundleInformation class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Store.UnloadedObjectError class <category>private</category>
baseMessage ^'model references non-loaded '
</methods> <methods> Store.UnloadedObjectError class <category>instance creation</category>
class: aClassName ^self new messageText: ((#nonLoadedClass1s << #packages >> 'model references non-loaded class <1s>') expandMacrosWith: aClassName).
nameSpace: aName ^self new messageText: ((#nonLoadedNameSpace2s << #packages >> 'model references non-loaded name space <1s>') expandMacrosWith: aName)
</methods> <methods> Store.UnloadedObjectError class <category>testing</category>
mayResume ^true
</methods> <methods> Store.BasicPackagePolicy <category>private-method-package assignment</category>
newMethodUseClass newMethodUseClass isNil ifTrue: [newMethodUseClass := true]. ^newMethodUseClass
newMethodUseClass: aBoolean newMethodUseClass := aBoolean
newMethodUseClassIfCurrentSame newMethodUseClassIfCurrentSame isNil ifTrue: [newMethodUseClassIfCurrentSame := false]. ^newMethodUseClassIfCurrentSame
newMethodUseClassIfCurrentSame: aBoolean newMethodUseClassIfCurrentSame := aBoolean
newMethodUseClassIfNoCurrent newMethodUseClassIfNoCurrent isNil ifTrue: [newMethodUseClassIfNoCurrent := false]. ^newMethodUseClassIfNoCurrent
newMethodUseClassIfNoCurrent: aBoolean newMethodUseClassIfNoCurrent := aBoolean
newMethodUseCurrent newMethodUseCurrent isNil ifTrue: [newMethodUseCurrent := true]. ^newMethodUseCurrent
newMethodUseCurrent: aBoolean newMethodUseCurrent := aBoolean
</methods> <methods> Store.BasicPackagePolicy <category>private-class-package assignment</category>
newClassUseCurrent newClassUseCurrent isNil ifTrue: [newClassUseCurrent := true]. ^newClassUseCurrent
newClassUseCurrent: aBoolean newClassUseCurrent := aBoolean
newNameSpaceUseCurrent newNameSpaceUseCurrent isNil ifTrue: [newNameSpaceUseCurrent := true]. ^newNameSpaceUseCurrent
newNameSpaceUseCurrent: aBoolean newNameSpaceUseCurrent := aBoolean
</methods> <methods> Store.BasicPackagePolicy <category>private-datum-package assignment</category>
newDatumUseClass newDatumUseClass isNil ifTrue: [newDatumUseClass := true]. ^newDatumUseClass
newDatumUseClass: aBoolean newDatumUseClass := aBoolean
newDatumUseClassIfCurrentSame newDatumUseClassIfCurrentSame isNil ifTrue: [newDatumUseClassIfCurrentSame := false]. ^newDatumUseClassIfCurrentSame
newDatumUseClassIfCurrentSame: aBoolean newDatumUseClassIfCurrentSame := aBoolean
newDatumUseClassIfNoCurrent newDatumUseClassIfNoCurrent isNil ifTrue: [newDatumUseClassIfNoCurrent := false]. ^newDatumUseClassIfNoCurrent
newDatumUseClassIfNoCurrent: aBoolean newDatumUseClassIfNoCurrent := aBoolean
newDatumUseCurrent newDatumUseCurrent isNil ifTrue: [newDatumUseCurrent := true]. ^newDatumUseCurrent
newDatumUseCurrent: aBoolean newDatumUseCurrent := aBoolean
</methods> <methods> Store.BasicPackagePolicy <category>testing</category>
checkForFirst "Answer true if we need to ask if okay to modify the first time." ^self packageIsForced not & self warnOnFirstModification
isTemporary ^false
packageIsForced "Answer true if we are in a force package block." ^alwaysUse ~~ nil
</methods> <methods> Store.BasicPackagePolicy <category>accessing</category>
forcedPackage ^alwaysUse
parentPackageFor: aPackage "Decide if we ask for the parent version from the database or just assume that trace is OK. Default implementation just returns the parent of aPackage" ^aPackage tracePackage
warnOnFirstModification warnOnFirstModification == nil ifTrue: [ warnOnFirstModification := true ]. ^#{Store.DbRgistry} isDefined & warnOnFirstModification
warnOnFirstModification: aBoolean warnOnFirstModification := aBoolean
</methods> <methods> Store.BasicPackagePolicy <category>package assignment</category>
forceNullPackageWhile: aBlock "This method puts everything into the null package when. It overrides current policy settings." ^self forcePackage: self nullPackage while: aBlock
forcePackage: aPackage while: aBlock "This method designates aPackage to be used whenever a new definition is created. It overrides current policy settings." | old retVal | old := alwaysUse. [ alwaysUse := aPackage. retVal := aBlock value ] ensure: [ alwaysUse := old ]. ^retVal.
packageForClassSymbol: classSymbol "Return the package that this class should be placed in. Nil if none can be determined." | pkg | alwaysUse notNil ifTrue: [^alwaysUse]. pkg := Registry containingPackageForClassSymbol: classSymbol. pkg isNil ifTrue: [pkg := self packageForNewClassSymbol: classSymbol]. ^pkg
packageForDataKey: dataKey classSymbol: classSymbol "Return the package that this data should be placed in. Nil if none can be determined." | pkg | alwaysUse notNil ifTrue: [^alwaysUse]. pkg := Registry containingPackageForDataKey: dataKey symbol: classSymbol. pkg isNil ifTrue: [pkg := self packageForNewDataKey: dataKey classSymbol: classSymbol]. ^pkg
packageForDataKey: dataKey nameSpaceSymbol: nameSpaceSymbol "Return the package that this data should be placed in. Nil if none can be determined." | pkg | alwaysUse notNil ifTrue: [ ^alwaysUse ]. pkg := Registry containingPackageForDataKey: dataKey symbol: nameSpaceSymbol . pkg isNil ifTrue: [pkg := self packageForNewDataKey: dataKey nameSpaceSymbol: nameSpaceSymbol ]. ^pkg
packageForNameSpaceSymbol: nameSpaceSymbol "Return the package that this class should be placed in. Nil if none can be determined." | pkg | alwaysUse notNil ifTrue: [ ^alwaysUse ]. pkg := Registry containingPackageForNameSpaceSymbol: nameSpaceSymbol. pkg isNil ifTrue: [pkg := self packageForNewNameSpaceSymbol: nameSpaceSymbol]. ^pkg
packageForNewClassSymbol: classSymbol "Return the package that this class should be placed in. The nullPackage if none can be determined." alwaysUse notNil ifTrue: [ ^alwaysUse ]. ^self newClassUseCurrent ifTrue: [ Registry currentPackage ] ifFalse: [ PackageChooser chooseOrAdd: classSymbol onCancelDo: [ ^Registry nullPackage ] ]
packageForNewDataKey: dataKey classSymbol: classSymbol "Return the package that this datum should be placed in. Nil if none can be determined." alwaysUse notNil ifTrue: [^alwaysUse]. (self newDatumUseCurrent and: [Registry isCurrentNull not]) ifTrue: [^Registry currentPackage]. self newDatumUseClass ifTrue: [ | clpkg | clpkg := Registry containingPackageForClassSymbol: classSymbol. ( self newDatumUseClassIfCurrentSame not or: [ Registry isCurrentNull ifTrue: [ self newDatumUseClassIfNoCurrent ] ifFalse: [ Registry currentPackage == clpkg ] ] ) ifTrue: [ ^self validatePackage: clpkg description: classSymbol, '.', dataKey ]. ^PackageChooser chooseOrAdd: classSymbol, '.', dataKey withDefault: clpkg onCancelDo: [ ^Registry nullPackage ] ]. ^PackageChooser chooseOrAdd: classSymbol, '.', dataKey onCancelDo: [ ^Registry nullPackage ].
packageForNewDataKey: dataKey nameSpaceSymbol: nameSpaceSymbol "Return the package that this datum should be placed in. Nil if none can be determined." alwaysUse notNil ifTrue: [ ^alwaysUse ]. (self newDatumUseCurrent and: [Registry isCurrentNull not]) ifTrue: [^Registry currentPackage]. self newDatumUseClass ifTrue: [ | clpkg | clpkg := Registry containingPackageForNameSpaceSymbol: nameSpaceSymbol. ( self newDatumUseClassIfCurrentSame not or: [ Registry isCurrentNull ifTrue: [ self newDatumUseClassIfNoCurrent ] ifFalse: [ Registry currentPackage == clpkg ] ] ) ifTrue: [ ^self validatePackage: clpkg description: nameSpaceSymbol, '.', dataKey ]. ^PackageChooser chooseOrAdd: nameSpaceSymbol, '.', dataKey withDefault: clpkg onCancelDo: [ ^Registry nullPackage ] ]. ^PackageChooser chooseOrAdd: nameSpaceSymbol, '.', dataKey onCancelDo: [ ^Registry nullPackage ].
packageForNewNameSpaceSymbol: nameSpaceSymbol "Return the package that this namespace should be placed in. Nil if none can be determined." alwaysUse notNil ifTrue: [ ^alwaysUse ]. ^self newNameSpaceUseCurrent ifTrue: [ Registry currentPackage ] ifFalse: [ PackageChooser chooseOrAdd:nameSpaceSymbol onCancelDo: [ Registry nullPackage ] ]
packageForNewSelector: selector classSymbol: classSymbol meta: isMeta "Return the package that this method should be placed in. Nil if none can be determined." | clpkg | alwaysUse notNil ifTrue: [ ^alwaysUse ]. ( self newMethodUseCurrent and: [ Registry isCurrentNull not ] ) ifTrue: [ ^Registry currentPackage ]. clpkg := Registry containingPackageForClassSymbol: classSymbol. self newMethodUseClass ifTrue: [ ( self newMethodUseClassIfCurrentSame not or: [ Registry isCurrentNull ifTrue: [ self newMethodUseClassIfNoCurrent ] ifFalse: [ Registry currentPackage == clpkg ] ] ) ifTrue: [ ^self validatePackage: clpkg description: classSymbol, '>>', selector ]. ]. ^PackageChooser chooseOrAdd: classSymbol, '>>', selector withDefault: clpkg onCancelDo: [ ^Registry nullPackage ]
packageForSelector: selector classSymbol: classSymbol meta: isMeta "Return the package that this method should be placed in." | pkg | alwaysUse notNil ifTrue: [^alwaysUse]. pkg := Registry containingPackageForSelector: selector classSymbol: classSymbol meta: isMeta. pkg == nil ifTrue: [ pkg := self packageForNewSelector: selector classSymbol: classSymbol meta: isMeta ]. ^pkg
</methods> <methods> Store.BasicPackagePolicy <category>private</category>
nullPackage ^Registry nullPackage
validatePackage: aPackage description: aString aPackage hasBeenModifiedSomewhere ifTrue: [ ^aPackage ]. ^self checkForFirst ifTrue: [ self warnOnFirstModificationOfPackage: aPackage description: aString ] ifFalse: [ aPackage ].
warnOnFirstModificationOfPackage: aPackageModel description: aString "Display warning and answer appropiate package to use." | msg | msg := (#WarnModifiedPackage << #packages >> 'Do you want to add <1s> to the previously unchanged package, <2s><ntttttt>OK to continue?'). ^( Dialog confirm: ( msg expandMacrosWith: aString with: aPackageModel name ) ) ifTrue: [ aPackageModel ] ifFalse: [ PackageChooser chooseOrAdd: aString withDefault: nil onCancelDo: [ Registry nullPackage ] ].
</methods> <methods> Store.PackageForParcel <category>private</category>
asPundle: relink "Convert the receiver into a pundle. Called on parcel load. Answer the converted pundle" | pkg | pkg := super asPundle: relink. pkg startLoad. [ contents do: [ :model | model addToPackage: pkg ]. pkg cleanse: false; markNotModified. ] ensure: [ pkg endLoad ]. ^pkg.
pundleInImage "Answer the image version of the receiver. Creates one if it doesn't exist." ^Registry packageNamedOrCreate: name.
updates: updates fromParcel: aParcel relink: relink "Update the pundle in the image from a parcel." "Luckily, removes and overrides are handled outside this." | pkg | pkg := super updates: updates fromParcel: aParcel relink: relink. contents do: [ :model | model updates: updates package: pkg ]. pkg cleanse: false; markNotModified. ^pkg.
</methods> <methods> Store.PackageForParcel <category>initialization</category>
from: aPackage saveLinks: saveLinks super from: aPackage saveLinks: saveLinks. contents := OrderedCollection new. aPackage modelsDo: [ :model | contents add: ( ModelForParcel from: model ) ].
</methods> <methods> Store.PackageForParcel <category>accessing</category>
definedClasses "Answer the receiver's defined classes." ^( contents select: [ :m | m isForClass & m hasDefinition ] ) collect: [ :m | m object ]
definedNameSpaces "Answer the receiver's defined namespaces." ^( contents select: [ :m | m isForNameSpace & m hasDefinition ] ) collect: [ :m | m object ]
extendedClasses "Answer the receiver's extended classes." ^( contents select: [ :m | m isForClass & m hasDefinition not ] ) collect: [ :m | m object ]
</methods> <methods> Store.PackageForParcel <category>conversion</category>
installContentsUsing: aCodeReader "Install the pundle contents through aCodeReader" aCodeReader installNameSpacesInSystem: self definedNameSpaces. aCodeReader installClassesInSystem: self definedClasses.
</methods> <methods> Store.Model <category>testing</category>
existsInImage ^true
isClassModel ^false
isExtension ^false
isForClass ^false
isForData ^false
isForGeneral ^false
isForMethod ^false
isForNameSpace ^false
isLoaded ^self existsInImage
isNameSpaceModel ^false
</methods> <methods> Store.DefNameSpaceModel <category>testing</category>
hasDefinition ^true
isEmpty "Is this class model holding onto nothing?" "We have a definition so we cannot be." ^false
isExtension ^false
isForNameSpace ^true
isNameSpaceModel ^true
</methods> <methods> Store.DefNameSpaceModel <category>private</category>
systemDataKeys ^self actual dataKeys
</methods> <methods> Store.DefNameSpaceModel <category>data accessing</category>
addDataKey: aDataKey "It's not our problem to track data." "Well.... it is under a very special circumstance. When a parcel is loading and my package overrode this class, some of my subdefs were put into the original classes' package and we have to reclaim them." | pkg owner | owner := self actual. ( pkg := Registry containingPackageForDataKey: aDataKey symbol: owner absoluteSymbol ) = self package ifTrue: [ ^nil ]. "ok, its already ours" pkg == nil ifTrue: [ ^nil ]. pkg relinquishDataKey: aDataKey owner: owner.
dataKeys ^self systemDataKeys select: [ :selector | self quickIncludesDataKey: selector ]
dataKeysDo: aBlock self dataKeys do: aBlock
datumDescriptorForDataKey: dataKey ^DatumDescriptor fromDataKey: dataKey nameSpaceName: self absoluteName.
datumDescriptors | nsname | nsname := self absoluteName. ^self dataKeys asSortedCollection asOrderedCollection collect: [ :dataKey | DatumDescriptor fromDataKey: dataKey nameSpaceName: nsname ]
includesDataKey: dataKey ^[ ( ( Registry quickContainingPackageForDataKey: dataKey symbol: self fullName asSymbol ) == package ) and: [ self actual includesDataKey: dataKey ] ] on: UnloadedObjectError do: [: exp | exp return: false ].
nameSpaceAndDataKeyDo: aBlock "For each pair of the namespace and its datakeys, evaluate aBlock." | actual | actual := self nameSpace. self dataKeys do: [ :dataKey | aBlock value: actual value: dataKey].
nameSpaceNameAndDataKeyDo: aBlock "For each pair of the namespace and its selectors and the meta class and its selectors evaluate aBlock." | nsName | nsName := self fullName. self dataKeys do: [ :dataKey | aBlock value: nsName value: dataKey ].
ownerDataKeyPairs | pairs | pairs := OrderedCollection new. self nameSpaceAndDataKeyDo: [ :ns :dataKey | pairs add: ( Array with: ns with: dataKey ) ]. ^pairs
protocols ^( self datumDescriptors collect: [ :d | d protocol ] ) asSet asOrderedCollection.
quickIncludesDataKey: dataKey "For when you know dataKey is loaded" ^( Registry quickContainingPackageForDataKey: dataKey symbol: self fullName asSymbol ) == package
removeDataKey: dataKey "It isn't our problem to track this stuff" "well... maybe if we were overridden"
</methods> <methods> Store.DefNameSpaceModel <category>accessing</category>
absoluteName ^BindingReference fullNameFrom: self environmentString name: name
absoluteSymbol ^self absoluteName asSymbol
actual ^self nameSpace
asDescription ^NameSpaceDescriptor fromModel: self
environment ^self environmentString asStrictReference valueOrDo: [ nil ]
environmentString ^environmentString
environmentString: aString environmentString := aString
fileOutObjectType "Answer a symbol that represents the type of the receiver." ^#namespace
fullName ^BindingReference fullNameFrom: self environmentString name: name
fullName: aString "Extract environment and name." | qual | qual := aString asStrictReference. environmentString := qual finalNameSpaceName. name := qual simpleName.
fullSymbol: aSymbol self fullName: aSymbol asString
name ^name
name: aString ^name
nameSpace ^self fullName asStrictReference valueOrDo: [ ( UnloadedObjectError nameSpace: self fullName ) raiseSignal. nil.]
package ^package
package: ourPackage package := ourPackage
</methods> <methods> Store.DefNameSpaceModel <category>printing</category>
displayString ^self name
printOn: aStream aStream nextPutAll: 'NSM:'. aStream nextPutAll: self fullName. aStream nextPutAll: ':'. aStream nextPutAll: self package name.
</methods> <methods> Store.DefNameSpaceModel <category>initialize-release</category>
cloneFrom: aNameSpaceModel "Copy all our data from another namespace model" aNameSpaceModel dataKeysDo: [ :key | self addDataKey: key ].
</methods> <methods> Store.DefNameSpaceModel <category>browser support</category>
binding ^self " | ref | ^( ref := self fullName asQualifiedReference ) isDefined ifTrue: [ ref binding ] ifFalse: [ nil ]. "
containingPackages "Answer all the packges that contain the definition for the receiver, including overriden." ^Registry allContainingPackagesForClassOrNameSpace: self actual
value ^self fullName asStrictReference valueOrDo: [ nil ].
valueOrDo: aBlock ^self fullName asStrictReference valueOrDo: aBlock.
</methods> <methods> Store.DefNameSpaceModel <category>private-unloading</category>
unloadAllDataKeys "Before unloading the receiver- Unload all the receiver's data keys from the system." | actual | actual := self valueOrDo: [ ^self ]. self dataKeys do: [ :key | Override unloadDataKey: key in: actual from: package ].
</methods> <methods> Store.DefNameSpaceModel <category>consistency checking</category>
checkConsistencyOn: aStream | pmodel pkg ns | pmodel := self package modelAtSymbol: self absoluteSymbol ifAbsent: [ nil ]. pmodel == nil ifTrue: [ aStream nextPutAll: ((#x1sNotInPackage << #packages >> 'namespace model <1s>" not in package "<2p>" it references. ') expandMacrosWith: self absoluteSymbol with: self package). ^self. ]. pmodel == self ifFalse: [ aStream nextPutAll: ((#namespaceModelDifferentThanInPackage << #packages >> 'namespace model <1s>" is not the same as in package "<2p>" it references. ') expandMacrosWith: self absoluteSymbol with: self package). ^self ]. ( pkg := Registry packageNamed: self package name ) == nil ifTrue: [ aStream nextPutAll: ((#x1sRefersToPackageNotLoaded << #packages >> 'namespace model <1s>" refers to package "<2p>" which is not loaded') expandMacrosWith: self absoluteSymbol with: self package). ^self. ]. pkg == self package ifFalse: [ aStream nextPutAll: ((#x1sRefersToPackageDifferentThenLoaded << #packages >> 'namespace model <1s>" refers to package "<2p>" which is different from the loaded package') expandMacrosWith: self absoluteSymbol with: self package). ^self. ]. ( ns := self nameSpace ) == nil ifTrue: [ aStream nextPutAll: ((#x1sInPackage << #packages >> 'namespace model <1s>" in package "<2p>" refers to non-loaded namespace') expandMacrosWith: self absoluteSymbol with: self package). ^self. ]. self isExtension ifTrue: [ self dataKeys do: [ :key | ( ns includesDataKey:key ) ifFalse: [ aStream nextPutAll: (#namespace << #packages >> 'namespace "<1p>" in package "<2p>" refers to non-loaded datakey "<3s>"' expandMacrosWith: ns with: self package with: key). aStream cr ] ] ].
</methods> <methods> Store.DefNameSpaceModel class <category>instance creation</category>
package: ourPackage fullSymbol: aSymbol ^self new package: ourPackage; fullSymbol: aSymbol.
</methods> <methods> Store.PseudoRecord <category>testing</category>
isDataModel "Is this a Bernstein data model?" ^true
isExtension ^false
</methods> <methods> Store.PseudoRecord <category>comparing</category>
sameAs: aThing | thing | thing := aThing isDataModel "Munched for browser support-DS" ifFalse: [ aThing absoluteName ] ifTrue: [ aThing ]. thing isString ifTrue: [ ^self absoluteName = thing ]. ^thing sameAsImThing: self
</methods> <methods> Store.PseudoRecord <category>printing</category>
itemString ^self fullName , self versionString
versionString ^(#parenImage << #packages >> '(image)') asString
</methods> <methods> Store.PseudoRecord <category>accessing</category>
asDescriptor ^self
myClass "Give a class name answer a class." | cls | cls := self fullClassName asClassNameOnly asStrictReference valueOrDo: [ ^nil ]. self isMeta ifTrue: [ cls := cls class ]. ^cls
</methods> <methods> Store.PseudoRecord <category>accessing browser</category>
primaryKey ^0
version ^(#image << #packages >> 'image') asString
</methods> <methods> Store.PseudoRecord <category>merge</category>
loadCommentFor: aClass "Load the receiver's comment." "Already in the image, so no action required."
loadDefinition: aString logged: logFlag "Load the receiver into the image by compiling it's definition." "Already in the image, so no action required."
</methods> <methods> Store.PseudoRecord class <category>instance creation</category>
fromModel: aModel ^aModel isForClass ifTrue: [ ClassDescriptor fromModel: aModel ] ifFalse: [ NameSpaceDescriptor fromModel: aModel ].
</methods> <methods> Store.NameSpaceDescriptor <category>accessing</category>
absoluteName ^fullName
absoluteSymbol ^fullName asSymbol
actual ^ self nameSpace
comment | nspace | ^( nspace := self nameSpace) isNil ifTrue: [ ''] ifFalse: [ nspace comment ]
definition | nspace | ^( nspace := self nameSpace) isNil ifTrue: [ '' ] ifFalse: [ nspace definition ]
environment "Answer the environment of the NameSpace. nil if it doesn't exist in the image." ^self fullName asStrictReference ifDefinedDo: [ :ns | ns environment ]
existsInImage "Answer true if the receiver is a valid description of an existing method." ^self nameSpace isNil not
fullName ^fullName
fullName: aString fullName := aString
myClass "Give a class name answer a class." self shouldNotImplement
name ^( self fullName tokensBasedOn: $. ) last
nameSpace ^self fullName asStrictReference valueOrDo: [ nil ]
symbol ^self absoluteSymbol
textRepresentationForTag: aTag ^aTag isCommentTag ifTrue: [ self comment ] ifFalse: [ self definition ]
xmlDefinition | nspace | ^( nspace := self nameSpace) isNil ifTrue: [ '' ] ifFalse: [ nspace xmlDefinition ]
</methods> <methods> Store.NameSpaceDescriptor <category>comparing</category>
<= aNameSpaceDescriptor ^self fullName <= aNameSpaceDescriptor fullName
= aThing ^self sameAs: aThing
comparesTo: anObject "Answer true if anObject could be another version of the receiver." ( self objectIsForSelf: anObject ) ifFalse: [ ^false ]. ^anObject absoluteName = self absoluteName.
hash ^self fullName hash
objectIsForSelf: anObject "Answer true if anObject represents the same kind of thing as the reciever." ^anObject isForNameSpace
sameAsImThing: aNameSpace ^aNameSpace absoluteName = self absoluteName
</methods> <methods> Store.NameSpaceDescriptor <category>browser support</category>
asNameSpace ^self actual asNameSpace
asString ^self simpleName
binding ^self " | ref | ^( ref := self fullName asQualifiedReference ) isDefined ifTrue: [ ref binding ] ifFalse: [ nil ]. "
classifySymbol: varName under: protocol ^self value classifySymbol: varName under: protocol
containingPackages "Answer all the packges that contain the definition for the receiver, including overriden." ^Registry allContainingPackagesForClassOrNameSpace: self actual
isDefined "Answer wheter the receiver exists in the image. aka #isDefined for bindings." self valueOrDo: [ ^false ]. ^true.
organization ^self value organization
renameCategory: oldCategory to: newCategory ^self value renameCategory: oldCategory to: newCategory
simpleName ^self fullName asStrictReference simpleName
value ^self fullName asStrictReference value
valueOrDo: aBlock ^self fullName asStrictReference valueOrDo: aBlock
</methods> <methods> Store.NameSpaceDescriptor <category>testing</category>
isForNameSpace ^true
</methods> <methods> Store.NameSpaceDescriptor <category>printing</category>
displayString ^self name
printOn: aStream aStream nextPutAll: self class name, '(', ( SystemUtils convertAbsoluteNameToFull: fullName ) , ')'.
</methods> <methods> Store.NameSpaceDescriptor <category>filing out</category>
fileOutSourceOn: aStream "File the receiver out on aSourceFileManager." self actual == nil ifFalse: [ self actual fileOutSourceOn: aStream ].
</methods> <methods> Store.NameSpaceDescriptor class <category>instance creation</category>
fromModel: aNameSpaceModel ^self fullName: aNameSpaceModel absoluteName
fullName: aName ^self new fullName: aName; yourself.
</methods> <methods> Store.BundleForParcel <category>initialization</category>
from: aBundle saveLinks: saveLinks super from: aBundle saveLinks: saveLinks. contents := OrderedCollection new. aBundle containedItems do: [ :pundle | contents add: ( PundleForParcel from: pundle saveLinks: saveLinks ) ].
</methods> <methods> Store.BundleForParcel <category>private</category>
asPundle: relink "Convert the receiver into a pundle. Called on parcel load. Answer the converted pundle" | bundle | bundle := super asPundle: relink. bundle startLoad. [ bundle containedItems: ( contents collect: [ :pun | pun asPundle: relink ] ). bundle markNotModified. ] ensure: [ bundle endLoad ]. ^bundle.
pundleInImage "Answer the image version of the receiver. Creates one if it doesn't exist." ^Registry bundleNamedOrCreate: name.
updates: updates fromParcel: aParcel relink: relink "Update the pundle in the image from a parcel." | bundle | bundle := super updates: updates fromParcel: aParcel relink: relink. bundle containedItems: ( contents collect: [ :pun | pun updates: updates fromParcel: aParcel relink: relink ] ). bundle markNotModified. ^bundle.
</methods> <methods> Store.BundleForParcel <category>conversion</category>
installContentsUsing: aCodeReader "Install the pundle contents through aCodeReader" contents do: [ :pundle | pundle runPreRead; runPreLoad; installContentsUsing: aCodeReader; runPostLoad ].
</methods> <methods> Store.Change <category>change types</category>
add type := #add
change type := #change
comment type := #comment
override type := #override.
remove type := #remove
removeChanges type := #removeChanges
removeDefinition type := #removeDefinition. meta := false.
reorganize type := #reorganize
</methods> <methods> Store.Change <category>testing</category>
isAdd ^type == #add
isChange ^type == #change
isClassChange ^classSymbol notNil & subdef isNil
isComment ^type == #comment
isComponentChange ^false
isDataChange ^subdef = #dataKey
isForClass ^classSymbol notNil
isForNameSpace ^nameSpaceSymbol notNil
isMethodChange ^subdef = #selector
isNameSpaceChange ^nameSpaceSymbol notNil & subdef isNil
isRemove ^type == #remove
isRemoveChanges ^type == #removeChanges
isRemoveDefinition ^type == #removeDefinition
isReorganize ^type == #reorganize
</methods> <methods> Store.Change <category>accessing</category>
actual: aClassOrNameSpace "Set the actual object - a class or namespace." aClassOrNameSpace isBehavior ifTrue: [ self class: aClassOrNameSpace ] ifFalse: [ self nameSpace: aClassOrNameSpace ].
class: class classSymbol := class absoluteName asClassNameOnly asSymbol. meta := class isMeta
className: aClassName meta: isMeta classSymbol := aClassName asSymbol. self meta: isMeta.
classSymbol ^classSymbol
classSymbol: aClassSymbol aClassSymbol namesMetaClass ifTrue: [ classSymbol := aClassSymbol classNameOnly asSymbol. self meta: true ] ifFalse: [ classSymbol := aClassSymbol asSymbol. self meta: false. ]
dataKey subdef == #dataKey ifFalse: [self error: (#wrongRetrivalType << #packages >> 'wrong retrival type')]. ^key asSymbol
dataKey: dataKey key := dataKey asSymbol. subdef := #dataKey. meta := false.
fullClassSymbol ^classSymbol
index ^subdef == #selector ifTrue: [self meta ifTrue: [2] ifFalse: [1]] ifFalse: [subdef == #dataKey ifTrue: [3] ifFalse: [0]]
key ^key
meta meta isNil ifTrue: [^false]. ^meta
meta: isMeta meta := isMeta
nameSpace: namespace nameSpaceSymbol := namespace absoluteSymbol.
nameSpaceSymbol ^nameSpaceSymbol
nameSpaceSymbol: aNameSpaceSymbol nameSpaceSymbol := aNameSpaceSymbol asSymbol.
selector subdef == #selector ifFalse: [self error: (#wrongRetrivalType << #packages >> 'wrong retrival type')]. ^key
selector: selector key := selector. subdef := #selector
symbol ^classSymbol == nil ifFalse: [ classSymbol ] ifTrue: [ nameSpaceSymbol ]
type ^type
type: aSymbol type := aSymbol
typeWithMeta self meta ifFalse: [^type]. type == #comment ifTrue: [^#commentMeta]. type == #reorganize ifTrue: [^#reorganizeMeta]. type == #change ifTrue: [^#changeMeta]. ^type
</methods> <methods> Store.Change <category>printing</category>
printOn: aStream aStream nextPutAll: type. aStream nextPutAll: ' '. self classSymbol == nil ifFalse: [ aStream nextPutAll: self classSymbol ]. self nameSpaceSymbol == nil ifFalse: [ aStream nextPutAll: self nameSpaceSymbol ]. self meta ifTrue: [aStream nextPutAll: ' class']. self isMethodChange ifTrue: [aStream nextPutAll: ' >> ', key]. self isDataChange ifTrue: [aStream nextPutAll: ' : ', key].
</methods> <methods> Store.ComponentRelatedChange <category>accessing</category>
tag: aTag tag := aTag
</methods> <methods> Store.ComponentRelatedChange <category>testing</category>
isClassChange ^false
isComponentChange ^true
</methods> <methods> Store.NameSpaceChanges <category>changes</category>
doChange: change super doChangeType: change type.
doSubdefChange: change self subdefChanges: self alterDataChanges changeType: change type key: change key
</methods> <methods> Store.NameSpaceChanges <category>testing</category>
isCommented ^self defChangesIncludes: #comment
isDefinitionChanged ^self defChangesIncludes: #change
isForNameSpace ^true
isNonDestructivelyModified ( self getDefChangesIfNone: [ ^false ] ) do: [ :changeType | ( #( #add #change #reorganize #comment ) includes: changeType ) ifTrue: [ ^true ] ]. ^false
isReorganized ^self defChangesIncludes: #reorganize
</methods> <methods> Store.DatumDescriptor <category>printing</category>
displayString ^SystemUtils convertAbsoluteNameToFull: self name
itemString ^self name , self versionString
printOn: aStream aStream nextPutAll: self fullName.
versionString ^''
</methods> <methods> Store.DatumDescriptor <category>testing</category>
isForData ^true
isForGeneral ^true
isInClass ^className ~~ nil
isInNameSpace ^nameSpaceName ~~ nil
</methods> <methods> Store.DatumDescriptor <category>accessing browser</category>
name ^self dataKey asString
</methods> <methods> Store.DatumDescriptor <category>accessing</category>
absoluteName ^self fullName
absoluteOwnerName ^self environmentString
binding | ns | ^( ns := self nameSpace ) == nil ifTrue: [ nil ] ifFalse: [ ns bindingFor: dataKey ]
className ^className
className: aString className := aString
containingPackages "Answer all the packges that contain the definition for the receiver, including overriden." | owner | ( owner := self owner ) == nil ifTrue: [ ^OrderedCollection new ]. ^Registry allContainingPackagesForDataKey: dataKey owner: owner.
dataKey ^dataKey asSymbol
dataKey: aValue dataKey := aValue asSymbol
definition | ns | ^( ns := self nameSpace ) == nil ifTrue: [ '' ] ifFalse: [ ns definitionOf: dataKey ifAbsent: [ '' ] ]
environmentString ^nameSpaceName == nil ifTrue: [ className ] ifFalse: [ nameSpaceName ]
fullClassName ^className
fullName ^self environmentString, '.', dataKey.
key ^self dataKey
nameSpace "Answer the nameSpace the receiver belongs in. May be a class' namespace." ^( self environmentString asStrictReference valueOrDo: [ ^nil ] ) asNameSpace
nameSpaceName ^nameSpaceName
nameSpaceName: aString nameSpaceName := aString
owner "Answer the thing the receiver belongs in." "Is a NameSpace, or a class'" ^self environmentString asStrictReference valueOrDo: [ nil ]
ownerName ^nameSpaceName == nil ifTrue: [ className ] ifFalse: [ nameSpaceName ]
protocol ^self nameSpace organization categoryOfElement: self dataKey
protocol: aValue "data does not have a protocol." "no-op"
protocolName | name | ^( name := self protocol ) == nil ifTrue: [ (#unknown << #packages >> 'unknown') asString ] ifFalse: [ name ]
sourceCode "fake it" ^self textRepresentation
textRepresentation | namespace | ( namespace := self nameSpace ) isNil ifTrue: [ ^'' ] ifFalse: [^( namespace definitionOf: dataKey ifAbsent: [ '' ] ) ]
xmlDefinition (self nameSpace includesKey: dataKey) ifFalse: [^nil]. ^(BindingReference simpleName: dataKey in: self nameSpace namedReferent) xmlDefinition
</methods> <methods> Store.DatumDescriptor <category>private-testing</category>
existsInImage "Answer if the receiver is a valid description of data." ^self fullName asStrictReference isDefined
</methods> <methods> Store.DatumDescriptor <category>comparing</category>
= aThing ^self sameAs: aThing
hash ^self nameSpaceName hash + self dataKey hash
sameAs: aDatum ^aDatum sameAsImThing: self
sameAsImThing: aDatum | res | self debugVersionOnly. res := ( self nameSpaceName = aDatum nameSpaceName and: [ self className = aDatum className ] ) and: [ self dataKey = aDatum dataKey ]. ^res
</methods> <methods> Store.DatumDescriptor <category>private</category>
fileOutOn: aSourceCodeStream | env str | str := ((#NoSouceForC1s << #packages >> 'No souce for: <1s>') expandMacrosWith: self fullName). ( env := self nameSpace ) == nil ifTrue: [ ^Dialog warn: str ]. ( env asNameSpace includesKey: dataKey ) ifFalse: [^Dialog warn: str]. aSourceCodeStream storeObjectDefinition: (env asNameSpace fullyQualifiedReferenceOf: dataKey). self fullName asStrictReference fileOutInitializerOn: aSourceCodeStream.
loadSrcIntoPackage: imPkg confirm: aBoolean "Do nothing since I'm already in the image."
</methods> <methods> Store.DatumDescriptor <category>bogus</category>
forDbPackage "Answer an array with a first element being a namespace and second being a dataKey. This method is used for the DB package creation." ^Array with: self nameSpace with: dataKey
</methods> <methods> Store.DatumDescriptor class <category>instance creation</category>
fromDataKey: dataKey class: aClass ^self fromDataKey: dataKey className: aClass absoluteName.
fromDataKey: dataKey className: aName ^self new dataKey: dataKey; className: aName; yourself.
fromDataKey: dataKey nameSpace: namespace ^self fromDataKey: dataKey nameSpaceName: namespace absoluteName.
fromDataKey: dataKey nameSpaceName: nameSpaceName ^self new dataKey: dataKey; nameSpaceName: nameSpaceName; yourself.
fromDataKey: dataKey owner: anOwner ^anOwner isBehavior ifTrue: [ self fromDataKey: dataKey class: anOwner ] ifFalse: [ self fromDataKey: dataKey nameSpace: anOwner ].
</methods> <methods> Store.Access <category>initialize-release</category>
cloneFrom: previous self publishPolicy: previous publishPolicy. self ownershipPolicy: previous ownershipPolicy. self blessingPolicy: previous blessingPolicy. self mergePolicy: previous mergePolicy. self packagePolicy: previous packagePolicy. self versionPolicy: previous versionPolicy. self prerequisitePolicy: previous prerequisitePolicy.
</methods> <methods> Store.Access <category>accessing</category>
blessingPolicy ^blessingPolicy == nil ifTrue: [ blessingPolicy := self class defaultBlessingPolicy ] ifFalse: [ blessingPolicy ]
blessingPolicy: aPolicy blessingPolicy := aPolicy
mergePolicy ^mergePolicy == nil ifTrue: [ mergePolicy := self class defaultMergePolicy ] ifFalse: [ mergePolicy ]
mergePolicy: aPolicy mergePolicy := aPolicy
ownershipPolicy ^ownershipPolicy == nil ifTrue: [ ownershipPolicy := self class defaultOwnershipPolicy ] ifFalse: [ ownershipPolicy ]
ownershipPolicy: aPolicy ownershipPolicy := aPolicy
packagePolicy ^packagePolicy == nil ifTrue: [ packagePolicy := self class defaultPackagePolicy ] ifFalse: [ packagePolicy ]
packagePolicy: aPolicy packagePolicy := aPolicy
prerequisitePolicy ^prerequisitePolicy == nil ifTrue: [ prerequisitePolicy := self class defaultPrerequisitePolicy ] ifFalse: [ prerequisitePolicy ]
prerequisitePolicy: aPolicy prerequisitePolicy := aPolicy
publishPolicy ^publishPolicy == nil ifTrue: [ publishPolicy := self class defaultPublishPolicy ] ifFalse: [ publishPolicy ]
publishPolicy: aPolicy publishPolicy := aPolicy
versionPolicy ^versionPolicy == nil ifTrue: [ versionPolicy := self class defaultVersionPolicy ] ifFalse: [ versionPolicy ]
versionPolicy: aPolicy versionPolicy := aPolicy
</methods> <methods> Store.Access class <category>class initialization</category>
initialize "Need only be executed on first installation or on change in definition." "self initialize" Policies == nil ifTrue: [ Policies := self new. self setDefaultPolicies ] ifFalse: [ Policies := self new cloneFrom: Policies ]
</methods> <methods> Store.Access class <category>defaults</category>
defaultBlessingPolicy ^#{BasicBlessingPolicy} ifDefinedDo: [ :cls | cls new ].
defaultMergePolicy ^#{BasicMergePolicy} ifDefinedDo: [ :cls | cls new ].
defaultOwnershipPolicy ^#{BasicOwnershipPolicy} ifDefinedDo: [ :cls | cls new ].
defaultPackagePolicy ^#{BasicPackagePolicy} ifDefinedDo: [ :cls | cls new ].
defaultPrerequisitePolicy ^#{BasicPrerequisitePolicy} ifDefinedDo: [ :cls | cls new ].
defaultPublishPolicy ^#{BasicPublishPolicy} ifDefinedDo: [ :cls | cls new ].
defaultVersionPolicy ^#{BranchingVersionPolicy} ifDefinedDo: [ :cls | cls new ].
setDefaultPolicies "self setDefaultPolicies" Policies blessingPolicy: self defaultBlessingPolicy. Policies publishPolicy: self defaultPublishPolicy. Policies mergePolicy: self defaultMergePolicy. Policies ownershipPolicy: self defaultOwnershipPolicy. Policies packagePolicy: self defaultPackagePolicy. Policies versionPolicy: self defaultVersionPolicy. Policies prerequisitePolicy: self defaultPrerequisitePolicy.
</methods> <methods> Store.ModelForParcel <category>initialization</category>
from: aModel object := aModel actual. hasDefinition := aModel hasDefinition. data := aModel dataKeys.
</methods> <methods> Store.ModelForParcel <category>testing</category>
hasDefinition ^hasDefinition
isForClass ^false
isForNameSpace ^false
</methods> <methods> Store.ModelForParcel <category>private</category>
isDataKey: key in: aCollection "Answer true if aClass>>selector is in a Collection of parcel updates." | binding | binding := object bindingFor: key. ^aCollection includes: binding.
isObjectIn: aCollection "Answer true if the receiver's class or namespace is in aCollection." ^aCollection includes: object
</methods> <methods> Store.ModelForParcel <category>accessing</category>
data "Answer the receiver's static data keys." ^data
object "Answer the object that receiver represents. Note that this may be a 'shadow' object in a partially loaded Parcel." ^object
</methods> <methods> Store.ModelForParcel class <category>instance creation</category>
classForModel: aModel ^aModel isForNameSpace ifTrue: [ NameSpaceForParcel ] ifFalse: [ ClassForParcel ]
from: aModel ^( self classForModel: aModel ) new from: aModel
</methods> <methods> Store.NameSpaceForParcel <category>conversion</category>
addToPackage: aPackage "Add the receiver to aPackage" | cset | cset := XChangeSet current. hasDefinition ifTrue: [ cset addNameSpaceDefinition: object toPackage: aPackage ]. data do: [ :key | cset changeDataKey: key nameSpace: object package: aPackage ].
updates: updates package: aPackage "Update aPackage after parcel update." | cset | cset :=XChangeSet current. self hasDefinition ifTrue: [ ( ( updates at: #changed ) includes: object ) ifTrue: [ cset changeNameSpace: object toPackage: aPackage ]. ( ( updates at: #added ) includes: object ) ifTrue: [ cset addNameSpace: object toPackage: aPackage ]. ]. self processDataUpdates: updates package: aPackage.
</methods> <methods> Store.NameSpaceForParcel <category>testing</category>
isForNameSpace ^true
</methods> <methods> Store.NameSpaceForParcel <category>private</category>
processDataUpdates: updates package: aPackage | cset | cset :=XChangeSet current. data do: [ :key | ( self isDataKey: key in: ( updates at: #added ) ) ifTrue: [ cset addDataKey: key nameSpace: object package: aPackage ]. ( self isDataKey: key in: ( updates at: #changed ) ) ifTrue: [ cset changeDataKey: key nameSpace: object package: aPackage ]. ].
</methods> <methods> Store.ExtensionNameSpaceModel <category>testing</category>
hasDefinition ^false
isEmpty "Is this model holding onto nothing?" ^data size = 0
isExtension ^true
</methods> <methods> Store.ExtensionNameSpaceModel <category>data accessing</category>
addDataKey: aDataKey self privateData add: aDataKey
dataKeys ^data == nil ifTrue: [ IdentitySet new ] ifFalse: [ data ]
includesDataKey: dataKey ^self dataKeys includes: dataKey
quickIncludesDataKey: dataKey ^self includesDataKey: dataKey
removeDataKey: dataKey super removeDataKey: dataKey. data == nil ifTrue: [ ^self ]. self privateData remove: dataKey ifAbsent: [ ]
</methods> <methods> Store.ExtensionNameSpaceModel <category>private</category>
privateData "Answer dataKeys defined by the receiver. Initialize the set if empty." data isNil ifTrue: [ data := IdentitySet new ]. ^data
</methods> <methods> Store.PackageChooser <category>initialize-release</category>
initialize | list pkgs | super initialize. pkgs := Registry allPackagesWithNull asSortedCollection: [ :p1 :p2 | p1 name < p2 name ]. list := pkgs collect: [ :pk | pk name ]. sequence := SelectionInList new. sequence list: list. self cancel onChangeSend: #userCanceled to: self
</methods> <methods> Store.PackageChooser <category>accessing</category>
objectName: aString objectName := aString
selectedPackageOrNil ^self accept value ifTrue: [| sel | (sel := sequence selection) notNil ifTrue: [Registry packageNamed: sel] ifFalse: [nil]] ifFalse: [nil]
</methods> <methods> Store.PackageChooser <category>aspects</category>
dialogHeader ^objectName== nil ifTrue: [ Registry currentPackage name ] "ifTrue: [ 'Choose a Package' ]" ifFalse: [ objectName ].
labelFor: aSymbol ^self perform: aSymbol
packageList ^sequence
</methods> <methods> Store.PackageChooser <category>private-accessing</category>
defaultPackage: aPkg defaultPackage := aPkg
onCancelDo: aBlock onCancelDo := aBlock
withAdd: aBoolean withAdd := aBoolean
</methods> <methods> Store.PackageChooser <category>private-actions</category>
addNewPackage | newPkg | sequence selection: nil. (newPkg := self addPackage) notNil ifTrue: [sequence list add: newPkg name. sequence selection: newPkg name. self accept value: true]
addPackage ^SmalltalkWorkbench requestNewPackageName ifNotNil: [:name | PackageModel named: name]
dClickAccept self accept value: true
userCanceled onCancelDo value
</methods> <methods> Store.PackageChooser <category>interface opening</category>
openFrom: aSpec "Open a dialog based on aSpec" | okButton | self allButOpenFrom: aSpec. withAdd ifFalse: [(self builder componentAt: #addButton) beInvisible]. okButton := self builder componentAt: #OKbutton. sequence selectionHolder compute: [:x | x isNil ifTrue: [okButton disable] ifFalse: [okButton enable]]. sequence selection: (defaultPackage isNil ifTrue: [nil] ifFalse: [defaultPackage name]). builder openDialog. ^accept value
</methods> <methods> Store.PackageChooser class <category>interface opening</category>
choose "Prompt the user to choose a package. He can pick one form the list, or cancel operation in whichcase a block is executed. Answer the selected package or nil." "self choose" ^self chooseOnCancelDo: [nil].
chooseOnCancelDo: cancelBlock "Prompt the user to choose a package. He can pick one form the list or cancel operation in whichcase a block is executed. Answer the selected package or nil." "self chooseOnCancelDo: [nil]" | defPkg | defPkg := Registry isCurrentNull ifTrue: [nil] ifFalse: [Registry currentPackage]. ^self openWithDefault: defPkg withAdd: false onCancel: cancelBlock
chooseOrAdd "Prompt the user to choose a package. He can pick one form the list, create a new one or cancel operation in which case a block is executed. Answer the selected package or nil." "self chooseOrAdd" ^self chooseOrAddOnCancelDo: [nil].
chooseOrAdd: objectName noCancelWithDefault: defPackage "Prompt the user to choose a package. He can pick one form the list, or create a new one. Answer the selected package." "self chooseOrAddNoCancel" ^self openWithDefault: defPackage objectName: objectName withAdd: true onCancel: nil
chooseOrAdd: objectName onCancelDo: cancelBlock "Prompt the user to choose a package. He can pick one form the list or cancel operation in whichcase a block is executed. Answer the selected package or nil." "self chooseOrAdd: 'TestClass' onCancelDo: [Transcript show: 'canceled';cr]" | defPkg | defPkg := Registry isCurrentNull ifTrue: [nil] ifFalse: [Registry currentPackage]. ^self openWithDefault: defPkg objectName: objectName withAdd: true onCancel: cancelBlock
chooseOrAdd: objectName withDefault: defPackage onCancelDo: aBlock "Prompt the user to choose a package. He can pick one form the list, or create a new one. Answer the selected package." "self chooseOrAddNoCancel" ^self openWithDefault: defPackage objectName: objectName withAdd: true onCancel: aBlock
chooseOrAddNoCancel "Prompt the user to choose a package. He can pick one form the list, or create a new one. Answer the selected package." "self chooseOrAddNoCancel" ^self chooseOrAddOnCancelDo: nil
chooseOrAddNoCancel: objectName "Prompt the user to choose a package. He can pick one form the list, or create a new one. Answer the selected package." "self chooseOrAddNoCancel" ^self chooseOrAdd: objectName onCancelDo: nil
chooseOrAddOnCancelDo: cancelBlock "Prompt the user to choose a package. He can pick one form the list or cancel operation in whichcase a block is executed. Answer the selected package or nil." "self chooseOrAddOnCancelDo: [Transcript show: 'canceled';cr]" | defPkg | defPkg := Registry isCurrentNull ifTrue: [nil] ifFalse: [Registry currentPackage]. ^self openWithDefault: defPkg withAdd: true onCancel: cancelBlock
openWithDefault: aDefaultPackage objectName: objectName withAdd: aBoolean onCancel: cancelBlock | interface | interface := cancelBlock isNil ifTrue: [ #windowSpecNoCancel ] ifFalse: [ #windowSpec ]. ^self new withAdd: aBoolean; onCancelDo: cancelBlock; objectName: objectName; defaultPackage: aDefaultPackage; openInterface: interface; selectedPackageOrNil
openWithDefault: aDefaultPackage withAdd: aBoolean onCancel: cancelBlock | baby | baby := self new. baby withAdd: aBoolean; onCancelDo: cancelBlock; defaultPackage: aDefaultPackage. baby openInterface: (cancelBlock isNil ifTrue: [#windowSpecNoCancel] ifFalse: [#windowSpec]). ^baby selectedPackageOrNil
</methods> <methods> Store.BundleDescription <category>testing</category>
describesBundleNamed: aString "Answer true if the description refers to a bundle named aString" ^self componentName = aString
describesSameAs: aComponentDescr "Answer true if aComponentDescr refers to a bundle named the same as my bundle" ^aComponentDescr isBundle and: [ self describesBundleNamed: aComponentDescr name ].
exactLoadedComponent "Find if a bundle with my id is loaded into the image." id isNil ifTrue: [^nil]. Registry bundlesDo: [ :bndl | bndl dbTrace = id ifTrue: [ ^bndl hasBeenModified ifTrue: [ nil ] ifFalse: [ bndl ] ] ]. ^nil
isBundle ^true
loadedComponent "Find if a bundle fullfilling my description is loaded into the image." componentName == nil ifFalse: [ ^Registry bundleNamed: componentName ]. id isNil ifTrue: [ ^nil ]. Registry bundlesDo: [ :bndl | bndl dbTrace = id ifTrue: [ ^bndl hasBeenModified ifTrue: [ nil ] ifFalse: [ bndl ] ] ]. ^nil
</methods> <methods> Store.BundleDescription <category>accessing</category>
component "Find a component named componentName and answer it." ^componentName == nil ifTrue: [ nil ] ifFalse: [ Registry bundleNamed: componentName ]
createComponent "Return the component with my componentName create it if needed." | bun | componentName isNil ifTrue: [^nil]. bun := Registry bundleNamed: componentName. bun notNil ifTrue: [^bun]. ^BundleModel named: componentName
</methods> <methods> Store.BundleDescription <category>private</category>
leafItems "Answer a list of packages contianed in my bundle and in bundles contained by my bundle." | comp | comp := self component. ^comp isNil ifTrue: [#()] ifFalse: [comp leafItems]
</methods> <methods> Store.ClassForParcel <category>initialization</category>
from: aModel super from: aModel. selectors := aModel selectorsMeta: false. metaSelectors := aModel selectorsMeta: true.
</methods> <methods> Store.ClassForParcel <category>conversion</category>
addToPackage: aPackage ( object isKindOf: AbsentClassImport ) ifTrue: [ ^self ]. hasDefinition ifTrue: [ XChangeSet current addClassDefinition: object toPackage: aPackage ]. self addAllSubDefsTo: aPackage.
updates: updates package: aPackage "Update aPackage after parcel update." | cset | ( object isKindOf: AbsentClassImport ) ifTrue: [ ^self ]. cset :=XChangeSet current. self hasDefinition ifTrue: [ ( self isObjectIn: ( updates at: #added ) ) ifTrue: [ ^self addToPackage: aPackage ]. ( self isObjectIn: ( updates at: #changed ) ) ifTrue: [ cset changeClass: object toPackage: aPackage ]. ]. ( self isObjectIn: ( updates at: #added ) ) ifTrue: [ ^self addAllSubDefsTo: aPackage ]. self processSelectors: selectors class: object updates: updates package: aPackage. self processSelectors: metaSelectors class: object class updates: updates package: aPackage. self processDataUpdates: updates package: aPackage.
</methods> <methods> Store.ClassForParcel <category>testing</category>
isForClass ^true
</methods> <methods> Store.ClassForParcel <category>accessing</category>
selectorsMeta: isMeta ^isMeta ifTrue: [ metaSelectors ] ifFalse: [ selectors ]
</methods> <methods> Store.ClassForParcel <category>private</category>
addAllSubDefsTo: aPackage | cset | cset :=XChangeSet current. selectors do: [ :selector | ( Override isOverriddenSelector: selector class: object ) ifTrue: [ cset changeSelector: selector class: object toPackage: aPackage ] ifFalse: [ cset addSelector: selector class: object toPackage: aPackage ] ]. metaSelectors do: [ :selector | ( Override isOverriddenSelector: selector class: object class ) ifTrue: [ cset changeSelector: selector class: object class toPackage: aPackage ] ifFalse: [ cset addSelector: selector class: object class toPackage: aPackage ] ]. data do: [ :key | cset changeDataKey: key class: object package: aPackage ].
isSelector: selector class: aClass in: aCollection "Answer true if aClass>>selector is in a Collection of parcel updates." ^aCollection contains: [ :thing | ( ( thing class = MethodInstallationRecord ) and: [ thing selector = selector ] ) and: [ thing implementingClass = aClass ] ]
processDataUpdates: updates package: aPackage | cset | cset :=XChangeSet current. data do: [ :key | ( self isDataKey: key in: ( updates at: #added ) ) ifTrue: [ cset addDataKey: key class: object package: aPackage ]. ( self isSelector: key class: object in: ( updates at: #changed ) ) ifTrue: [ cset changeDataKey: key class: object package: aPackage ]. ].
processSelectors: aCollection class: aClass updates: updates package: aPackage | cset | cset :=XChangeSet current. aCollection do: [ :selector | ( self isSelector: selector class: aClass in: ( updates at: #added ) ) ifTrue: [ cset addSelector: selector class: object toPackage: aPackage ]. ( self isSelector: selector class: aClass in: ( updates at: #changed ) ) ifTrue: [ cset changeSelector: selector class: aClass toPackage: aPackage ]. ].
processSelectors: aCollection updates: updates package: aPackage | cset | cset :=XChangeSet current. aCollection do: [ :selector | ( self isSelector: selector class: object in: ( updates at: #added ) ) ifTrue: [ cset addSelector: selector class: object toPackage: aPackage ]. ( self isSelector: selector class: object in: ( updates at: #changed ) ) ifTrue: [ cset changeSelector: selector class: object toPackage: aPackage ]. ].
</methods> <methods> Store.DefClassModel <category>testing</category>
existsInImage ^fullClassSymbol asStrictReference isDefined
hasDefinition ^true
isClassModel ^true
isEmpty "Is this class model holding onto nothing?" "We have a definition so we cannot be." ^false
isExtension ^false
isForClass ^true
</methods> <methods> Store.DefClassModel <category>consistency checking</category>
checkConsistencyOn: aStream | pcm pkg class | pcm := self package classModelAtClassSymbol: self fullClassSymbol ifAbsent: [nil]. pcm isNil ifTrue: [aStream nextPutAll: ((#classModelNotInPackage << #packages >> 'class model "<1s>" not in package "<2p>" it references: ') expandMacrosWith: self fullClassSymbol with: self package). ^aStream cr]. pcm == self ifFalse: [aStream nextPutAll: ((#classModelDifferentThanInPackage << #packages >> 'class model "<1s>" is not the same as in package "<2p>" it references: ') expandMacrosWith: self fullClassSymbol with: self package). ^aStream cr]. pkg := Registry packageNamed: self package name. pkg isNil ifTrue: [aStream nextPutAll: ((#classModelRefersToUnloadedPackage << #packages >> 'class model "<1s>" refers to package "<2p>" which is not loaded') expandMacrosWith: self fullClassSymbol with: self package). ^aStream cr]. pkg == self package ifFalse: [aStream nextPutAll: ((#classModelRefersToDifferentPackage << #packages >> 'class model "<1s>" refers to package "<2p>" which is different from the loaded package') expandMacrosWith: self fullClassSymbol with: self package). ^aStream cr]. class := self fullClassSymbol asStrictReference valueOrDo: [nil]. class isNil ifTrue: ["class printOn: aStream.aStream cr." aStream nextPutAll: ((#classModelRefersToNonloadedClass << #packages >> 'class model "<1s>" in package "<2p>" refers to non-loaded class') expandMacrosWith: self fullClassSymbol with: self package). ^aStream cr]. self isExtension ifTrue: [ self classAndSelectorDo: [:cls :sel | cls compiledMethodAt: sel ifAbsent: [aStream nextPutAll: (#classModelRefersToNonloadedSelector << #packages >> 'class "<1p>" in package "<2p>" refers to non-loaded selector "<3s>"' expandMacrosWith: cls with: self package with: sel). aStream cr ] ]. self dataKeys do: [ :key | ( class asNameSpace includesDataKey:key ) ifFalse: [ aStream nextPutAll: (#namespaceRefersToNonloadedDataKey << #packages >> 'namespace "<1p>" in package "<2p>" refers to non-loaded datakey "<3s>"' expandMacrosWith: class with: self package with: key). aStream cr ] ] ].
</methods> <methods> Store.DefClassModel <category>printing</category>
displayString ^self name
printOn: aStream aStream nextPutAll: 'CM:'. aStream nextPutAll: self fullName. aStream nextPutAll: ':'. aStream nextPutAll: self package name.
</methods> <methods> Store.DefClassModel <category>accessing</category>
asDescription ^ClassDescriptor fromModel: self
cloneFrom: aClassModel "Copy all our selectors and data from another class model" "We don't care about selectors or data"
fileOutObjectType ^#class
name ^self fullName asStrictReference simpleName
package ^package
package: ourPackage package := ourPackage
</methods> <methods> Store.DefClassModel <category>private</category>
systemDataKeys ^( self actualClassMeta: false ) dataKeys
systemSelectorsMeta: isMeta ^(self actualClassMeta: isMeta) selectors
</methods> <methods> Store.DefClassModel <category>class accessing</category>
absoluteName ^self fullName
absoluteSymbol ^fullClassSymbol
actual ^self actualClass
actualClass ^self actualClassMeta: false
actualClassMeta: isMeta | class | class := fullClassSymbol asStrictReference valueOrDo: [ ( UnloadedObjectError class: fullClassSymbol ) raiseSignal. ^nil ]. ^isMeta ifTrue: [ class class ] ifFalse: [ class ]
classNameMeta: isMeta ^fullClassSymbol asString, (isMeta ifTrue: [' class'] ifFalse: [''])
fullClassSymbol ^fullClassSymbol
fullClassSymbol: aSymbol fullClassSymbol := aSymbol
fullName ^fullClassSymbol asString
fullName: aString ^fullClassSymbol := aString asSymbol
fullSymbol: aSymbol fullClassSymbol := aSymbol
</methods> <methods> Store.DefClassModel <category>data accessing</category>
addDataKey: aDataKey "It's not our problem to track data." "Well.... it is under a very special circumstance. When a parcel is loading and my package overrode this class, some of my subdefs were put into the original classes' package and we have to reclaim them." | pkg owner | owner := self actual. ( pkg := Registry containingPackageForDataKey: aDataKey symbol: owner absoluteSymbol ) = self package ifTrue: [ ^nil ]. "ok, its already ours" pkg == nil ifTrue: [ ^nil ]. pkg relinquishDataKey: aDataKey owner: owner.
classAndDataKeyDo: aBlock "For each pair of the class and its datakeys, evaluate aBlock." | actual | actual := self actualClass. self dataKeys copy do: [ :dataKey | aBlock value: actual value: dataKey].
dataKeys ^self systemDataKeys select: [ :selector | self quickIncludesDataKey: selector ]
dataKeysDo: aBlock self dataKeys do: aBlock
datumDescriptorForDataKey: dataKey ^DatumDescriptor fromDataKey: dataKey className: self absoluteName. " ^( self dataKeys includes: dataKey ) ifTrue: [ DatumDescriptor fromDataKey: dataKey className: self absoluteName ] ifFalse: [ nil ] "
datumDescriptors | clsname | clsname := self absoluteName. ^self dataKeys asSortedCollection asOrderedCollection collect: [ :dataKey | DatumDescriptor fromDataKey: dataKey className: clsname ]
includesDataKey: dataKey ^[ ( ( Registry quickContainingPackageForDataKey: dataKey symbol: fullClassSymbol ) == package ) and: [ ( self actualClassMeta: false) includesDataKey: dataKey ] ] on: UnloadedObjectError do: [: exp | exp return: false ].
ownerDataKeyPairs | pairs | pairs := OrderedCollection new. self classAndDataKeyDo: [ :cls :dataKey | pairs add: ( Array with: cls with: dataKey ) ]. ^pairs
protocols ^( self datumDescriptors collect: [ :d | d protocol ] ) asSet asOrderedCollection.
quickIncludesDataKey: dataKey "For when you know dataKey is loaded" ^( Registry quickContainingPackageForDataKey: dataKey symbol: fullClassSymbol ) == package
removeDataKey: dataKey "It isn't our problem to track this stuff" "well... maybe if we were overridden"
</methods> <methods> Store.DefClassModel <category>selector accessing</category>
addSelector: aSelector meta: isMeta "It's not our problem to track selectors." "Well.... it is under a very special circumstance. When a parcel is loading and my package overrode this class, some of my selectors were put into the original classes' package and we have to reclaim them." | pkg cls | cls := self actualClassMeta: isMeta. ( pkg := Registry containingPackageForSelector: aSelector class: cls ) = self package ifTrue: [ ^nil ]. "ok, its already ours" pkg == nil ifTrue: [ ^nil ]. pkg relinquishSelector: aSelector class: cls.
classAndSelectorDo: aBlock "For each pair of the class and its selectors and the meta class and its selectors evaluate aBlock." | actual | actual := self actualClassMeta: false. (self selectorsMeta: false) copy do: [:selector | aBlock value: actual value: selector]. actual := self actualClassMeta: true. (self selectorsMeta: true) copy do: [:selector | aBlock value: actual value: selector]
classNameAndSelectorDo: aBlock "For each pair of the class and its selectors and the meta class and its selectors evaluate aBlock." | className | className := self classNameMeta: false. (self selectorsMeta: false) do: [:selector | aBlock value: className value: selector]. className := self classNameMeta: true. (self selectorsMeta: true) do: [:selector | aBlock value: className value: selector]
classSelectorPairs | pairs | pairs := OrderedCollection new. self classAndSelectorDo: [:class :selector| pairs add: (Array with: class with: selector)]. ^pairs
compiledMethods | comp | comp := OrderedCollection new. self classAndSelectorDo: [:class :selector| comp add: (class compiledMethodAt: selector)]. ^comp
includesSelector: aSelector meta: isMeta ^[ ((Registry quickContainingPackageForSelector: aSelector classSymbol: fullClassSymbol meta: isMeta) == package) and: [(self actualClassMeta: isMeta) includesSelector: aSelector] ] on: UnloadedObjectError do: [: exp | exp return: false ].
methodDescriptorForSelector: aSelector meta: isMeta "Answer a method descriptor for aSelector." "Shouldn't be asking if you don't know it's there." ^MethodDescriptor fromSelector: aSelector className: self absoluteName meta: isMeta
methods ^( self methodsMeta: true ), ( self methodsMeta: false )
methodsForProtocol: aProtocolName meta: isMeta | actual | actual := self actualClassMeta: isMeta. ^( ( actual organization listAtCategoryNamed: aProtocolName) select: [ :selector | self quickIncludesSelector: selector meta: isMeta ] ) asSortedCollection asOrderedCollection collect: [:sel | MethodDescriptor fromSelector: sel className: actual absoluteName meta: isMeta ]
methodsMeta: isMeta | cname | cname := self classNameMeta: isMeta. ^(self selectorsMeta: isMeta) asSortedCollection asOrderedCollection collect: [:sel| MethodDescriptor fromSelector: sel className: cname meta: isMeta ]
protocolsMeta: isMeta | actual | actual := self actualClassMeta: isMeta . ^actual organization categories select: [:proto | ((actual organization listAtCategoryNamed: proto) detect: [:selector | self quickIncludesSelector: selector meta: isMeta] ifNone: [nil]) notNil]
quickIncludesSelector: aSelector meta: isMeta "For when you know 'aSelector' is loaded" ^(Registry quickContainingPackageForSelector: aSelector classSymbol: fullClassSymbol meta: isMeta) == package
removeSelector: aSelector meta: isMeta "It isn't our problem to track this stuff" "well... maybe if we were overridden"
selectorsMeta: isMeta ^( self systemSelectorsMeta: isMeta ) select: [:selector | self quickIncludesSelector: selector meta: isMeta ]
</methods> <methods> Store.DefClassModel <category>browser support</category>
binding ^self " | ref | ^( ref := self fullName asQualifiedReference ) isDefined ifTrue: [ ref binding ] ifFalse: [ nil ]. "
containingPackages "Answer all the packges that contain the definition for the receiver, including overriden." ^Registry allContainingPackagesForClassOrNameSpace: self actual
selectors ^self actual selectors
value "Implemented by any subclass wanting to be displayed in a browser" ^self actualClass
</methods> <methods> Store.DefClassModel <category>private-unloading</category>
unloadAllDataKeys "Before unloading the receiver- Unload all the receiver's data keys from the system." | actual | actual := self actual. self dataKeys do: [ :key | Override unloadDataKey: key in: actual from: package ].
unloadAllSelectors | affectedClasses | affectedClasses := Set new. self existsInImage ifFalse: [ ^affectedClasses ]. "validation" self classSelectorPairs do: [ :pair | Override unloadSelector: pair last class: pair first from: package. affectedClasses add: pair first. ]. ^affectedClasses
</methods> <methods> Store.DefClassModel class <category>instance creation</category>
package: ourPackage fullClassSymbol: aClassSymbol ^self new package: ourPackage; fullClassSymbol: aClassSymbol.
package: ourPackage fullSymbol: aClassSymbol ^self new package: ourPackage; fullClassSymbol: aClassSymbol.
</methods> <methods> Store.ClassDescriptor <category>comparing</category>
<= aClassDescriptor ^self absoluteName <= aClassDescriptor absoluteName
= aThing ^self sameAs: aThing
comparesTo: anObject "Answer true if anObject could be another version of the receiver." ( self objectIsForSelf: anObject ) ifFalse: [ ^false ]. anObject isMeta = self isMeta ifFalse: [ ^false ]. ^anObject absoluteName asClassNameOnly = self absoluteName.
hash ^self fullName hash
objectIsForSelf: anObject "Answer true if anObject represents the same kind of thing as the reciever." ^anObject isForClass
sameAsImThing: aClass ^aClass absoluteName = self absoluteName
sameName: aString "Answer true if aString is the same name as the receiver." | string | string := aString namesMetaClass ifTrue: [ self isMeta ifFalse: [ ^false ]. aString classNameOnly ] ifFalse: [ self isMeta ifTrue: [ ^false ]. aString ]. ^string = self absoluteName
</methods> <methods> Store.ClassDescriptor <category>accessing</category>
absoluteName ^self fullClassName
absoluteSymbol ^self absoluteName asSymbol
actual "Answer the class in the image that the reciever represents. nil if none." ^self fullClassName asStrictReference ifDefinedDo: [ :cls | self isMeta ifTrue: [ cls class ] ifFalse: [ cls ]. ].
classNameWithMeta ^meta ifTrue: [ self fullClassName fullMetaName ] ifFalse: [ self fullClassName ].
comment | cl | (cl := self myClass) isNil ifTrue: [ ^'' ] ifFalse: [ ^cl instanceBehavior comment ]
definition | cl | (cl := self myClass) isNil ifTrue: [^''] ifFalse: [^cl definition]
environment ^self actual environment
existsInImage ^( self myClass == nil ) not
fullClassName ^self fullName
fullClassName: aString aString namesMetaClass ifTrue: [ self meta: true ]. fullClassName := aString asClassNameOnly
fullName ^fullClassName isNil ifTrue: [''] ifFalse: [fullClassName]
meta: aBoolean meta := aBoolean
name "Answer the receiver's simple name." ^cachedName isNil ifTrue: [cachedName := (self fullName tokensBasedOn: $.) last] ifFalse: [cachedName]
realname ^self fullName
superclass "Answer the superclass of the receiver in the image. nil if none." | cls | ^( cls := self actual ) == nil ifFalse: [ cls superclass ]
symbol ^self absoluteSymbol
textRepresentationForTag: aTag ^aTag isClassCommentTag ifTrue: [ self comment ] ifFalse: [ self definition ]
xmlDefinition | cl | (cl := self myClass) isNil ifTrue: [^''] ifFalse: [^cl xmlDefinition]
</methods> <methods> Store.ClassDescriptor <category>testing</category>
isForClass ^true
isMeta ^meta
</methods> <methods> Store.ClassDescriptor <category>browser support</category>
asNameSpace ^self actual asNameSpace
asString ^self simpleName
binding "Answer a binding for the class in the system if it exists, otherwise just answer the receiver (which pretends to be a binding)." | ref | ^( ref := self fullName asStrictReference ) isDefined ifTrue: [ ref binding ] ifFalse: [ self ]. " ^self "
classifySymbol: varName under: protocol ^self value classifySymbol: varName under: protocol
containingPackages "Answer all the packges that contain the definition for the receiver, including overriden." ^Registry allContainingPackagesForClassOrNameSpace: self actual
organization ^self value organization
renameCategory: oldCategory to: newCategory ^self value renameCategory: oldCategory to: newCategory
reorganize self actual reorganize
selectors ^self actual selectors
simpleName ^self name
value "Implemented by any subclass wanting to be displayed in a browser" ^self myClass
valueOrDo: aBlock "Implemented by any subclass wanting to be displayed in a browser" ^self myClass
withAllSuperclasses ^self actual withAllSuperclasses
</methods> <methods> Store.ClassDescriptor <category>printing</category>
displayString ^meta ifTrue: [ self name fullMetaName ] ifFalse: [ self name ]
instanceBehavior "Give a class name answer a class." ^self fullClassName asStrictReference valueOrDo: [ nil ]
printOn: aStream aStream nextPutAll: self class name, '(', ( SystemUtils convertAbsoluteNameToFull: fullClassName ) , ')'.
</methods> <methods> Store.ClassDescriptor <category>filing out</category>
fileOutSourceOn: aStream "File the receiver out on aSourceFileManager." self actual == nil ifFalse: [ self actual fileOutSourceOn: aStream ].
</methods> <methods> Store.ClassDescriptor class <category>instance creation</category>
fromModel: aClassModel ^self fullName: aClassModel absoluteName meta: false "aClassModel isMeta."
fullName: aName meta: aBoolean ^self new fullClassName: aName; meta: aBoolean; yourself.
</methods> <methods> Store.ClassExtensionDescriptor <category>testing</category>
isExtension ^true
</methods> <methods> Store.ClassExtensionDescriptor <category>accessing</category>
definition ^super definition. " ^'This class is not defined in this package'"
xmlDefinition ^super xmlDefinition. " ^'This class is not defined in this package'"
</methods> <methods> Store.ClassExtensionDescriptor <category>printing</category>
itemString ^self name
</methods> <methods> Store.PublishAsParcelDialog <category>interface opening</category>
postOpenWith: aBuilder "This message is sent by the builder after it has opened a completed window." ( pundle hasBeenModified & pundle isBundle ) ifTrue: [ Dialog warn: ( (#PundleHasUnpublishedChanges << #packages >> '<1s> has unpublished changes. Database links cannot be saved.') expandMacrosWith: pundle name ) ]. ( pundle isBundle and: [ pundle allContainedItems contains: [ :p | p properties keys contains: [ :k | CodeComponent binaryActions includes: k ] ] ] ) ifTrue: [ Dialog warn: (#SubPundlesAlsoHaveActions << #packages >> 'Sub-components have actions that won''t be executed during parcel load.') ]. ( self builder componentAt: #parcelSave ) isEnabled: false. ( self builder componentAt: #parcelDirectory ) isEnabled: true. ( self builder componentAt: #bundleStructure ) isEnabled: pundle isBundle. self bundleStructureChanged.
</methods> <methods> Store.PublishAsParcelDialog <category>aspects</category>
bundleStructure bundleStructure == nil ifTrue: [ bundleStructure := false asValue ]. ^bundleStructure
bundleStructureChanged "Enable the database links depending on wheter the structure will be saved." ( self builder componentAt: #databaseLinks ) isEnabled: ( self bundleStructure value & pundle hasBeenModified not ). databaseLinks value: ( databaseLinks value & bundleStructure value ).
databaseLinks databaseLinks == nil ifTrue: [ databaseLinks := false asValue ]. ^databaseLinks
helpAction | sh | sh := SimpleHelp helpString: self class parcelHelp. sh class openOn: sh
parcelBackup parcelBackup == nil ifTrue: [ parcelBackup := false asValue ]. ^parcelBackup
parcelDirectory parcelDirectory == nil ifTrue: [ parcelDirectory := ( PundleAccess parcelDirectory asFilename construct: pundle parcelName ) asString asValue. ]. ^parcelDirectory
parcelHideSource parcelHideSource == nil ifTrue: [ parcelHideSource := false asValue ]. ^parcelHideSource
parcelOverwrite parcelOverwrite == nil ifTrue: [ parcelOverwrite := false asValue ]. ^parcelOverwrite
parcelPadded parcelPadded == nil ifTrue: [ parcelPadded := false asValue ]. ^parcelPadded
parcelRepublish parcelRepublish == nil ifTrue: [ parcelRepublish := false asValue ]. ^parcelRepublish
parcelSave parcelSave == nil ifTrue: [ parcelSave := true asValue ]. ^parcelSave
parcelSaveSource parcelSaveSource == nil ifTrue: [ parcelSaveSource := true asValue ]. ^parcelSaveSource
parcelSaveSourceChanged "Enable/disable the subcheck boxes depending on sources." | save | save := self parcelSaveSource value & ( self parcelSave value ). self parcelSaveSourceDetails do: [ :sym | self enableComponentAt: sym enable: save ]. self parcelRepublish value: ( self parcelRepublish value & save ). self enableComponentAt: #parcelRepublish enable: save.
parcelSaveSourceDetails ^#( parcelHideSource parcelPadded )
pundle: aPundle "aPundle will be the pundle that is going to be used for creating the parcel. Consult aPundle (or any of its contained items if aPundle is a bundle) has a sourceIndex. If so, then make sure we force the republish flag to be true. Check to see if the padded property (see the class comment for SourceFileManager) for aPundle is either true, false or absent (which we treat as false) and set the aspect for padded appropriately." | hasSourceIndex | pundle := aPundle. hasSourceIndex := (aPundle propertyAt: #sourceIndex) notNil. aPundle isBundle ifTrue: [hasSourceIndex := hasSourceIndex or: [aPundle allContainedItems anySatisfy: [:each | (each propertyAt: #sourceIndex) notNil]]]. self parcelRepublish value: hasSourceIndex. self parcelPadded value: (aPundle propertyAt: #padded ifAbsent: false)
validateParcelSaveString "Check wheter save as parcel should be enabled. Answer the message if not, an empty string if okay" | existing | ( existing := pundle relatedParcel ) == nil ifFalse: [ existing hasUninstalledCode ifTrue: [ ^(#uninstalledCode << #dialogs >> 'Parcel has uninstalled code.<n>Saving will lose it.'). ] ]. pundle hasCodeOverridden ifTrue: [ ^#parcelCodeOverridden << #dialogs >> 'Parcel has code overridden by other parcels.<n>Saving would save the override, not the overridden code.<n>Operation cancelled.'. ]. ^String new
</methods> <methods> Store.PublishAsParcelDialog <category>private</category>
enableComponentAt: aSymbol enable: aBoolean | comp | ( comp := self builder componentAt: aSymbol ) == nil ifFalse: [ comp isEnabled: aBoolean ]
validateParcelOptions | filename | ( ( filename := self basePath , Parcel fileExtension ) asFilename exists and: [ self parcelOverwrite value not ] ) ifTrue: [ ( Dialog confirm: ( (#OKtoOverwriteParcelQ << #packages >> '<n><1s> exists: <n><n>Overwrite files?<n>') expandMacrosWith: filename ) ) ifTrue: [ self parcelOverwrite value: true ] ifFalse: [ ^false ]. ]. ^true
</methods> <methods> Store.PublishAsParcelDialog <category>events</category>
requestForWindowClose "The ApplicationWindow's controller is checking to see if the application is in a state that can be closed." self validateParcelOptions ifFalse: [ ^false ]. ^super requestForWindowClose
</methods> <methods> Store.PublishAsParcelDialog <category>accessing</category>
basePath "Return the base path of the filename for the parcel to be saved." ^( Filename expandEnvironmentIn: ( self parcelDirectory value ) ) asString
options "Answer a dictionary containing all the possible options that are used when saving a parcel. These properties are instructions that determine how the parcel will be saved (for example, with or without source). One of the options, #padded, is passed along to the newly created parcel and assigned into its properties dictionary. For #padded, we only want to add it to the dictionary being returned if the client user this dialog has set it to true. Otherwise, we do not want to add this property because the absence of the #padded conveys the same information to the system as if it is there with a value of false. Also, by only adding this property if the user wants it added we prevent unnecessary modifications to the package." | optionsDictionary | optionsDictionary := Dictionary new. optionsDictionary at: #parcelSave put: self parcelSave value; at: #databaseLinks put: self databaseLinks value; at: #bundleStructure put: self bundleStructure value; at: #parcelDirectory put: self parcelDirectory value; at: #parcelRepublish put: self parcelRepublish value; at: #parcelBackup put: self parcelBackup value; at: #parcelOverwrite put: self parcelOverwrite value; at: #parcelSaveSource put: self parcelSaveSource value; at: #parcelHideSource put: self parcelHideSource value. self parcelPadded value ifTrue: [pundle propertyAt: #padded put: true]. ^optionsDictionary.
</methods> <methods> Store.PublishAsParcelDialog class <category>interface opening</category>
publishAsParcel: aPundle "Open a dialog for package/bundle parcel publishing." "self publishAsParcel: ( Registry packageNamed: 'Store-UI' )" | dialog filename | aPundle hasCodeOverridden ifTrue: [ ^Dialog warn: (#NoParcelWithOverrides << #packages >> 'Parcels cannot be saved with overrides.') ]. ( aPundle relatedParcel ~~ nil and: [ aPundle relatedParcel hasUninstalledCode ] ) ifTrue: [ ^Dialog warn: (#NoParcelWithUninstalled << #packages >> 'Parcels cannot be saved with uninstalled code.') ]. dialog := self new. dialog pundle: aPundle. dialog open. dialog accept value ifFalse: [ ^nil ]. filename := Filename named: ( dialog parcelDirectory value ). aPundle saveAsParcel: filename saveStructure: dialog bundleStructure value saveLinks: dialog databaseLinks value parcelOptions: dialog options.
</methods> <methods> Store.PublishAsParcelDialog class <category>dummy</category>
parcelWarningMessage "We don't need this here, but it's in the dialog we're borrowing from PublishPundleDialog" ^''
</methods> <methods> Store.PublishAsParcelDialog class <category>help</category>
parcelHelp ^(#parcelHelp << #packages >> ' The parcel will be saved in the Parcel Path + .pcl, the sources in Parcel Path +.pst. Include Bundle Structure if you would like the bundle to be recreated when loading the parcel into a Store image. Saving Database Links will hook the components to a particular database. This saves the loader from needing to reconcile source before publishing a new version to the same database. Save source file will create the parcel sources (.pst) file. Hide sources on load will not effect the current image, but will supress sources when it is loaded into a another image. This is for deployment parcels and should not be used during development. Select republish to save with sources to a parcel that is currently loaded to the same file name. Republishing does not hide sources. Republishing will invalidate other images that point to the original file. ') asString
</methods> <methods> Store.PundleAccess <category>namespace model</category>
addNameSpaceModel: nameSpaceModel self addModel: nameSpaceModel named: nameSpaceModel absoluteSymbol
containingPackageForNameSpace: namespace ^self containingPackageForSymbol: namespace absoluteSymbol
nameSpaceModelsForNameSpaceName: aFullSymbol do: aBlock self modelsForSymbol: aFullSymbol do: aBlock
</methods> <methods> Store.PundleAccess <category>class model</category>
addClassModel: cm self addModel: cm named: cm absoluteName.
classModelsForClassSymbol: aClassSymbol do: aBlock self modelsForSymbol: aClassSymbol do: aBlock
defClassModelForClassSymbol: aFullSymbol ^self defModelForSymbol: aFullSymbol
defNameSpaceModelForNameSpaceSymbol: aFullSymbol ^self defModelForSymbol: aFullSymbol
extensionClassModelsForClassSymbol: aClassSymbol | cms | cms := modelDictionary at: aClassSymbol ifAbsent: [^#()]. ^cms size > 1 ifTrue: [cms copyFrom: 2 to: cms size] ifFalse: [#()]
extensionModelsForSymbol: aSymbol "Answer all extenstion models for aSymbol or an empty colleciton if none." | models | models := modelDictionary at: aSymbol ifAbsent: [ ^#() ]. ^models size > 1 ifTrue: [ models copyFrom: 2 to: models size ] ifFalse: [#() ]
packagesContaining: aClassOrNameSpace "Answer a collection of packages that contain some methods/statics for aClassOrNameSpace. The first package contains the definition." "Store.Registry packagesContaining: Object class" | symbol | symbol := aClassOrNameSpace isBehavior ifTrue: [ aClassOrNameSpace instanceBehavior absoluteSymbol ] ifFalse: [ aClassOrNameSpace absoluteSymbol ]. ^( self modelsForSymbol: symbol ) collect: [ :model | model package ]
packagesContaining: aClassOrNameSpace do: aBlock "Evaluate aBlock for each packages that contain some methods/statics for aClassOrNameSpace." "Store.Registry packagesContaining: Object class do: [ :pkg | Transcript show: pkg name; tab ]" | symbol | symbol := aClassOrNameSpace isBehavior ifTrue: [ aClassOrNameSpace instanceBehavior absoluteSymbol ] ifFalse: [ aClassOrNameSpace absoluteSymbol ]. self modelsForSymbol: symbol do: [ :model | aBlock value: model package ]
packagesContainingClass: aClass do: aBlock "Evaluate aBlock for each packages that contain some methods/statics for aClass." self classModelsForClassSymbol: aClass instanceBehavior absoluteSymbol do: [:cm | aBlock value: cm package]
packagesContainingClassSymbol: classSymbol do: aBlock self classModelsForClassSymbol: classSymbol do: [:cm | aBlock value: cm package]
packagesContainingNameSpace: namespace do: aBlock self modelsForSymbol: namespace absoluteSymbol do: [ :model | aBlock value: model package ]
quickContainingClassModelForSelector: aSelector classSymbol: aClassSymbol meta: isMeta "If there are extensions check them for the selector. Otherwise use the class' model do not ask the class' model if it includes the selector or there will be infinite recursion." | cms | cms := modelDictionary at: aClassSymbol ifAbsent: [ ^nil ]. cms size > 1 ifTrue: [ 2 to: cms size do: [ :index | | cm | cm := cms at: index. ( cm includesSelector: aSelector meta: isMeta ) ifTrue: [ ^cm ] ]. ]. ^cms first
quickContainingModelForDataKey: datakey symbol: aSymbol "If there are extensions check them for the datakey. Otherwise use the class' model. Do not ask the def model if it includes the datakey or there will be infinite recursion." | models | models := modelDictionary at: aSymbol ifAbsent: [ ^nil ]. models size > 1 ifTrue: [ 2 to: models size do: [ :index | | model | model := models at: index. ( model includesDataKey: datakey ) ifTrue: [ ^model ] ]. ]. ^models first
removeClassModel: cm self removeModel: cm named: cm absoluteSymbol
</methods> <methods> Store.PundleAccess <category>private model accessing</category>
addModel: model self addModel: model named: model absoluteSymbol.
addModel: aModel named: aFullSymbol "private- generic for looking up in model dictionaries" "took out a couple 'snafus'. They can mess the image up." | models symbol | symbol := aFullSymbol asSymbol. models := modelDictionary at: symbol ifAbsentPut: [ Array new: 1 ]. aModel isExtension "means there should be at least a defmodel there" ifTrue: [ modelDictionary at: symbol put: ( models copyWith: aModel ) ] ifFalse: [ ( models first isNil ) ifFalse: [ self notify: (#SnafuAddModelToNonEmpty << #packages >> 'Model snafu: adding a def model to non-empty') ]. models at: 1 put: aModel. ].
definitionModels ^( modelDictionary collect: [ :list | list first ] ) reject: [ :m | m == nil ]
defModelForSymbol: aFullSymbol ^( modelDictionary at: aFullSymbol ifAbsent: [ ^nil ] ) first
modelKeys ^modelDictionary keys
modelsForSymbol: aFullSymbol "Answer a list of def/extenstion models for aFullSymbol" ^( modelDictionary at: aFullSymbol ifAbsent: [ ^#() ] ) reject: [ :m | m == nil ]
modelsForSymbol: aFullSymbol do: aBlock "Perform aBlock for every def/extenstion model for aFullSymbol" | models | models := modelDictionary at: aFullSymbol ifAbsent: [ ^self ]. models do: [ :model | model == nil ifFalse: [ aBlock value: model ] ].
removeModel: model named: fullSymbol "Removes all mention of the class/namespace represented by model from the registry." "Newer version is more forgiving, so we can use it cleaning up." | models | models := modelDictionary at: fullSymbol ifAbsent: [ ^self ]. model isExtension ifTrue: [ | index | index := models indexOf: model ifAbsent: [ ^self ]. index = 1 ifTrue: [self notify: (#ClassModelSnafu << #packages >> 'Class model snafu')]. models size = 2 ifTrue: [ models first isNil ifTrue: [ modelDictionary removeKey: fullSymbol ] ifFalse: [ modelDictionary at: fullSymbol put: ( models copyWithout: model ) ] ] ifFalse: [ modelDictionary at: fullSymbol put: ( models copyWithout: model ) ] ] ifFalse: [ model = models first ifTrue: [ models size == 1 ifTrue: [ modelDictionary removeKey: fullSymbol ] ifFalse: [ models at: 1 put: nil ] ] ifFalse: [ models first isNil ifTrue: [ ^self ] ifFalse: [self halt: (#SnafuRemovedWrongOne << #packages >> 'Model snafu - attempt to remove the wrong one') ] ] ]
</methods> <methods> Store.PundleAccess <category>private-image delivery</category>
createTableOfContents "Registry createTableOfContents" | aStream fName | fName := Dialog requestNewFileName: (#RequestTOCfileName << #packages >> 'Write the package table of contents to:') default: 'toc'. fName isEmpty ifTrue: [^self]. aStream := fName asFilename writeStream. [Registry tableOfContentsOn: aStream] ensure: [aStream close]. fName := Dialog requestNewFileName: (#RequestTOBCfileName << #packages >> 'Write the bundle table of contents to:') default: 'tobc'. fName isEmpty ifTrue: [^self]. aStream := fName asFilename writeStream. [Registry tableOfBundleContentsOn: aStream] valueNowOrOnUnwindDo: [aStream close]
</methods> <methods> Store.PundleAccess <category>utility</category>
repairForMethodsInZeroOrMultiplePackages "Registry repairForMethodsInZeroOrMultiplePackages" Transcript cr; show: (#CheckingMultiplePackagesOrNone << #packages >> 'Checking/repairing methods in multiple packages or no package'). Object allSubclassesDo: [:class | class selectors do: [:selector | | pkgs cnt | cnt := 0. pkgs := self whatPackagesContainSelector: selector class: class. pkgs size > 1 ifTrue: [Transcript show: class printString , '>>' , selector asString , ' --> ' , pkgs asArray printString; cr] ifFalse: [(pkgs size < 1 or: [pkgs first name = '(none)']) ifTrue: [cnt := cnt + 1. XChangeSet current moveSelector: selector class: class toPackage: (self containingPackageForClass: class)]]. cnt > 0 ifTrue: [Transcript cr; show: ((#MovingMethodsToNewPackage << #packages >> 'Moved <1s> methods in class <2s> to <3s>') expandMacrosWith: cnt printString with: class printString with: (self containingPackageForClass: class) name)]]]. Transcript cr; show: (#Done << #packages >> 'Done.'); cr.
</methods> <methods> Store.PundleAccess <category>consistency checking</category>
checkConsistencyOn: aStream "| strm | strm := WriteStream on: String new. Registry checkConsistencyOn: strm. Transcript show: strm contents; cr" | checkSize | checkSize := [ ( aStream size > 1000 ) ifTrue: [ ^aStream nextPutAll: '.......' ] ]. self cleanseModels. self checkModelsOn: aStream . checkSize value. self checkPackagesOn: aStream. checkSize value. self checkForNameSpaceAndDataInZeroOrMultiplePackagesOn: aStream. checkSize value. self checkForClassesAndMethodsInZeroOrMultiplePackagesOn: aStream
checkForClassesAndMethodsInZeroOrMultiplePackagesOn: aStream Root allClasses do: [ :class | ( self containingPackageForClass: class ) == nil ifTrue: [ class isMeta ifFalse: [ aStream nextPutAll: ((#x1sUnpackaged << #packages >> '<1s> - Unpackaged') expandMacrosWith: class printString); cr ] ] ifFalse: [ | cms | cms := self extensionClassModelsForClassSymbol: class absoluteSymbol. cms size >= 2 ifTrue: [ class selectors do: [ :selector | | pkgs | pkgs := OrderedCollection new. cms do: [ :cm | ( cm includesSelector: selector meta: class isMeta ) ifTrue: [ pkgs add: cm package ] ]. pkgs size > 1 ifTrue: [ aStream nextPutAll: ((#x1s2sInPackages3s << #packages >> '<1s>%>%><2s> in packages <3s>') expandMacrosWith: class printString with: selector asString with: pkgs asArray printString); cr ] ] ]. class dataKeys do: [ :key | | pkgs | pkgs := OrderedCollection new. cms do: [ :cm | ( cm includesDataKey: key ) ifTrue: [ pkgs add: cm package ] ]. pkgs size > 1 ifTrue: [ aStream nextPutAll: ((#x1sDot2sInPackages3s << #packages >> '<1s>.<2s> in packages <3s>') expandMacrosWith: class printString with: key asString with: pkgs asArray printString); cr ] ] ] ]
checkForNameSpaceAndDataInZeroOrMultiplePackagesOn: aStream Root allNameSpaces do: [ :ns | ( self containingPackageForNameSpace: ns ) == nil ifTrue: [ aStream nextPutAll: ((#x1sUnpackaged << #packages >> '<1s> - Unpackaged') expandMacrosWith: ns printString); cr ] ifFalse: [ | models | models := self extensionModelsForSymbol: ns absoluteSymbol. models size >= 2 ifTrue: [ ns dataKeys do: [ :key | | pkgs | pkgs := OrderedCollection new. models do: [ :model | ( model includesDataKey: key ) ifTrue: [ pkgs add: model package ] ]. pkgs size > 1 ifTrue: [ aStream nextPutAll: ((#x1sdot2sInPackages3s << #packages >> '<1s>.<2s> in packages <3s>') expandMacrosWith: ns printString with: key asString with: ns asArray printString); cr ] ] ] ] ]
checkModel: model symbol: symbol isExtension: isExtension on: aStream model absoluteName asSymbol == symbol ifFalse: [aStream nextPutAll: ((#modelDictEntryWrongName << #packages >> 'model dictionary entry "<1s>" includes model "<2p>" with different name') expandMacrosWith: symbol with: model classSymbol). aStream cr] ifTrue: [model isExtension ~~ isExtension ifTrue: [aStream nextPutAll: ((#modelDictWrongSlot << #packages >> 'model dictionary wrong slot "<1s>" in package "<2p>"') expandMacrosWith: symbol with: model package). aStream cr] ifFalse: [model checkConsistencyOn: aStream ]]
checkModels: models for: aSymbol on: aStream "Private- subroutine for #checkClassModelsOn: Check that a model collection is correct. Registered in a package, that the class to class models dictionary is in proper form, that the class models themselves are correct (refer the existent classes and methods, etc)." | instSelectors metaSelectors dataKeys forClass | aSymbol isSymbol ifFalse: [ ^aStream nextPutAll: ((#modelKeyNotSymbol << #packages >> 'model dictionary key not a symbol: <1s>') expandMacrosWith: aSymbol); cr ]. models isNil ifTrue: [ ^aStream nextPutAll: ((#modelEntryNil << #packages >> 'model dictionary entry is nil: <1s>') expandMacrosWith: aSymbol); cr ]. models size = 0 ifTrue: [ ^aStream nextPutAll: ((#modelEntryZeroSize << #packages >> 'class model dictionary entry is zero size: <1s>') expandMacrosWith: aSymbol); cr. ]. models first isNil ifTrue: [aStream nextPutAll: ((#x1sIsNotInAPackage << #packages >> '<1s> is not in a package') expandMacrosWith: aSymbol); cr ] ifFalse: [ models first isClassModel ifTrue: [ self checkModel: models first symbol: aSymbol isExtension: false on: aStream. forClass := true. ] ifFalse: [ self checkNameSpaceModel: models first symbol: aSymbol isExtension: false on: aStream. forClass := false. ]. ]. "Check extension models" instSelectors := IdentitySet new. metaSelectors := IdentitySet new. dataKeys := IdentitySet new. 2 to: models size do: [ :index | | model | ( model := models at: index ) == nil ifTrue: [ aStream nextPutAll: ((#modelExtensionsNil << #packages >> 'model dictionary extension is nil: <1s>') expandMacrosWith: aSymbol). aStream cr] ifFalse: [ model isClassModel ifFalse: [ | newData | forClass == true ifTrue: [ aStream nextPutAll: ((#x1sBothClassAndNamespace << #packages >> '<1s> has both class and namespace models.') expandMacrosWith: aSymbol); cr ]. forClass := false. newData := model dataKeys. newData do: [ :dataKey | (dataKeys includes: dataKey) ifTrue: [aStream nextPutAll: ((#dataInMultiplePackages << #packages >> 'data <1s>:<2s> is in another package besides <3p>') expandMacrosWith: aSymbol with: dataKey with: model package). aStream cr]. self checkNameSpaceModel: model symbol: aSymbol isExtension: true on: aStream ]. dataKeys addAll: newData. ] ifTrue: [ | newInst newMeta | forClass := true. newInst := model selectorsMeta: false. newMeta := model selectorsMeta: true. newInst do: [ :selector | (instSelectors includes: selector) ifTrue: [aStream nextPutAll: ((#methodInMultiplePackages << #packages >> 'method <1s>%><2s> is in another package besides <3p>') expandMacrosWith: aSymbol with: selector with: model package). aStream cr] ]. instSelectors addAll: newInst. newMeta do: [:selector | (metaSelectors includes: selector) ifTrue: [aStream nextPutAll: ((#metaMethodInMultiplePackages << #packages >> 'method <1s> class%><2s> is in another package besides <3p>') expandMacrosWith: aSymbol with: selector with: model package). aStream cr] ]. metaSelectors addAll: newMeta. ] ] ].
checkModelsOn: aStream "Check that all models are in their package, that these packages are registered, that the class to class models dictionary is in proper form, that the class models themselves are correct (refer the existent classes and methods, etc)." "| strm | strm := WriteStream on: String new. TT_Registry checkClassModelsOn: strm. Transcript show: strm contents; cr" modelDictionary keysAndValuesDo: [ :symbol :models | self checkModels: models for: symbol on: aStream ].
checkNameSpaceModel: model symbol: nsSymbol isExtension: isExtension on: aStream model absoluteName asSymbol == nsSymbol ifFalse: [aStream nextPutAll: ((#namespaceModelHasClassNameWrong << #packages >> 'namespace model dictionary entry "<1s>" includes class model "<2p>" with different name') expandMacrosWith: nsSymbol with: model symbol). aStream cr] ifTrue: [model isExtension ~~ isExtension ifTrue: [aStream nextPutAll: ((#namespaceModelWrongSlot << #packages >> 'namespace model dictionary wrong slot "<1s>" in package "<2p>"') expandMacrosWith: nsSymbol with: model package). aStream cr] ifFalse: [model checkConsistencyOn: aStream ]]
checkPackagesOn: aStream packages keys do: [ :key | key isSymbol ifTrue: [ aStream nextPutAll: ((#PackageShouldBeString << #packages >> 'Package: <1s> is a symbol, not a string).') expandMacrosWith: key) ] ]. bundles keys do: [ :key | key isSymbol ifTrue: [ aStream nextPutAll: ((#BundleShouldBeString << #packages >> 'Bundle: <1s> is a symbol, not a string).') expandMacrosWith: key) ] ]. self packagesDo: [:pkg | pkg checkConsistencyOn: aStream ].
cleanseModels "Check that all models exist - remove non-existant models and dispaly a warning." self cleanseModels: true
cleanseModels: warn "Check that all models exist - remove non-existant models and display a warning if warn is true." | real | modelDictionary values copy do: [ :models | models first == nil ifTrue: [ [ real := ( models at: 2 ) actual ] on: UnloadedObjectError do: [ :x | modelDictionary removeKey: models second absoluteSymbol ]. real == nil ifFalse: [ modelDictionary removeKey: ( models at: 2 ) absoluteSymbol. 2 to: models size do: [ :index | | model | model := models at: index. model fullClassSymbol: real absoluteSymbol. self addModel: model ]. ]. ] ifFalse: [ [ models first actual ] on: UnloadedObjectError do: [ :x | warn ifTrue: [ Dialog warn: ((#RemovingNonexistantC1s << #packages >> 'Removing non-existant: <1s>') expandMacrosWith: models first absoluteName) ]. modelDictionary removeKey: models first absoluteSymbol. ] ]. ].
whatPackagesContainDatum: aDataKey classOrNameSpace: owner | pkgs | pkgs := OrderedCollection new. self modelsForSymbol: owner absoluteSymbol do: [ :model | ( model includesDataKey: aDataKey ) ifTrue: [ pkgs add: model package ] ]. ^pkgs
whatPackagesContainSelector: aSelector class: aClass | pkgs | pkgs := OrderedCollection new. self classModelsForClassSymbol: aClass absoluteName asClassNameOnly asSymbol do: [ :cm | ( cm includesSelector: aSelector meta: aClass isMeta ) ifTrue: [ pkgs add: cm package ] ]. ^pkgs
</methods> <methods> Store.PundleAccess <category>initialize-release</category>
cloneFrom: aPA "| pa | pa := PundleAccess new. pa cloneFrom: Registry. Registry := pa " aPA packagesDo: [ :pkg | packages at: pkg name put: pkg. pkg modelsDo: [ :cm | self addClassModel: cm ] ]. aPA bundlesDo: [ :pkg | bundles at: pkg name put: pkg ].
initialize bundles := Dictionary new. packages := Dictionary new. modelDictionary := IdentityDictionary new. "When creating the null package, it is important to workaround PundleModel class>>#named:, otherwise the null package will be added to the list of packages." nullPackage := (PackageModel new) name: self nullPackageName; comment: 'This "package" is a special package that holds all code (classes, methods, shares, namespaces) that does not show up in a normal package. It is generated automatically. Removing it will remove the code contained in it, but the package itself never goes away. It can serve as a temporary "scratch space" to try quick throw away work before creating a normal package.'; yourself. currentPackage := nullPackage. self addDependent: self
</methods> <methods> Store.PundleAccess <category>pundle model private access</category>
privateRegisterPundle: aPundleModel "Private access for loaded pundles to register themselves on creation." ( aPundleModel isBundle ifTrue: [ bundles ] ifFalse: [ packages ] ) at: aPundleModel name put: aPundleModel. self changed: #addedPundle with: aPundleModel. ChangeSet createdComponent: aPundleModel. SourceFileManager default createdComponent: aPundleModel.
</methods> <methods> Store.PundleAccess <category>table of contents</category>
executeCompleteTableOfContentsNamed: aString "Hook up a parcel to the database. aString is a path and name without an extension." | filename | filename := aString, '.toc'. filename asFilename exists ifTrue: [ self executeTableOfContentsFromFile: filename ]. filename := aString, '.tobc'. filename asFilename exists ifTrue: [ self executeTableOfBundleContentsFromFile: filename ]. #{PundleParentMap} ifDefinedDo: [ :ppm | filename := aString, '.tbl'. filename asFilename exists ifTrue: [ ppm readParentsAndReconnectFromFile: filename ]. ].
executeTableOfBundleContents: aTC ^aTC isSequenceable ifTrue: [aTC first createComponent containedItems: (aTC last collect: [:desc | self executeTableOfBundleContents: desc])] ifFalse: [aTC createComponent]
executeTableOfBundleContentsFromFile: aString "Registry executeTableOfBundleContentsFromFile: 'TOBC'" | strm tc | [strm := aString asFilename readStream. tc := self tableOfBundleContentsFrom: strm] ensure: [strm close]. tc do: [:tci | self executeTableOfBundleContents: tci]
executeTableOfContents: aTC aTC keysAndValuesDo: [ :pkgName :tags | | pkg | pkg := self packageNamedOrCreate: pkgName. tags do: [ :tag | tag moveToPackage: pkg ifNotLoaded: [ ] ] ]
executeTableOfContentsFromFile: aString "Registry executeTableOfContentsFromFile: 'TOC'" | strm tc | [strm := aString asFilename readStream. tc := self tableOfContentsFrom: strm] ensure: [strm close]. self executeTableOfContents: tc
tableOfBundleContents "Registry tableOfBundleContents" | strm | strm := WriteStream on: (String new: 400000). self tableOfBundleContentsOn: strm. ^strm contents
tableOfBundleContentsFrom: aStream ^self tobcComponentsFrom: aStream
tableOfBundleContentsOn: aStream self bundlesDo: [:bun | bun tableOfBundleContentsOn: aStream]
tableOfBundleContentsOnFile: aString "Registry tableOfBundleContentsOnFile: 'TOBC'" | strm | strm := aString asFilename writeStream. self tableOfBundleContentsOn: strm. strm close.
tableOfContents "Registry tableOfContents" | strm | strm := WriteStream on: (String new: 400000). self tableOfContentsOn: strm. ^strm contents
tableOfContentsBundleContentsFrom: aStream | itemNames | itemNames := OrderedCollection new. [| kind desc | aStream skipSeparators. kind := aStream next. desc := kind = $" ifTrue: [PackageDescription new] ifFalse: [kind = $@ ifTrue: [BundleDescription new] ifFalse: [kind = $; ifTrue: [^itemNames] ifFalse: [self error: (#ExpectedQuoteForPackageName << #packages >> 'Malformed quote for package name expected')]]]. desc componentName: (aStream upTo: $"). itemNames add: desc] repeat
tableOfContentsFrom: aStream | dict | dict := Dictionary new. [aStream skipSeparators. aStream atEnd] whileFalse: [| pkgTags pkgName | aStream next = $" ifFalse: [self error: (#ExpectedQuoteForPackageName << #packages >> 'Malformed quote for package name expected')]. pkgName := aStream upTo: $". pkgTags := self tableOfContentsTagsFrom: aStream. dict at: pkgName put: pkgTags]. ^dict
tableOfContentsOn: aStream self packagesDo: [:pkg | pkg tableOfContentsOn: aStream]
tableOfContentsOnFile: aString "Registry tableOfContentsOnFile: 'TOC'" | strm | strm := aString asFilename writeStream. self tableOfContentsOn: strm. strm close.
tobcBundleFrom: aStream | desc comps | aStream next = $@ ifFalse: [self error: (#ExpectedAtSign << #packages >> 'Expected at-sign to begin bundle name')]. desc := BundleDescription new. desc componentName: (aStream upTo: $"). comps := self tobcComponentsFrom: aStream. aStream next = $; ifFalse: [self error: (#ExpectedSemicolon << #packages >> 'Expected semi-colon to end bundle description')]. ^Array with: desc with: comps
tobcComponentFrom: aStream aStream peek = $" ifTrue: [^self tobcPackageFrom: aStream]. aStream peek = $@ ifTrue: [^self tobcBundleFrom: aStream]. self error: (#ExpectedAtSignOrQuote << #packages >> 'Expected at-sign or quote to begin component')
tobcComponentsFrom: aStream | comps | comps := OrderedCollection new. [aStream skipSeparators. (aStream atEnd or: [aStream peek = $;]) ifTrue: [^comps]. comps add: (self tobcComponentFrom: aStream)] repeat
tobcPackageFrom: aStream | desc | aStream next = $" ifFalse: [self error: (#ExpectedQuoteBeforePackageName << #packages >> 'Expected quote to begin package name')]. desc := PackageDescription new. desc componentName: (aStream upTo: $"). ^desc
</methods> <methods> Store.PundleAccess <category>definition lookup</category>
allContainingPackagesForClassOrNameSpace: aClassOrNameSpace "Answer all the packges that contain the definition for a class or namespace, including overriden." "Returns an Array, since a class can have its methods in several packages, or even its definition in several packages via overrides." | coll pkg overs | (pkg := self containingPackageForSymbol: aClassOrNameSpace absoluteSymbol) == nil ifTrue: [^#()]. (overs := Override overridesForClassOrNameSpace: aClassOrNameSpace) == nil ifTrue: [^Array with: pkg]. coll := OrderedCollection with: pkg. overs do: [:over | (pkg := over package) == nil ifFalse: [coll add: pkg]]. ^coll
allContainingPackagesForDataKey: key owner: aClassOrNamespace "Answer all the packges that contain the definition for aClassOrNamespace.key, including overriden." "Returns an Array, since a class can have its methods in several packages, or even its definition in several packages via overrides." | coll pkg overs | (pkg := self containingPackageForDataKey: key symbol: aClassOrNamespace absoluteSymbol) == nil ifTrue: [^#()]. (overs := Override overridesForDataKey: key in: aClassOrNamespace) == nil ifTrue: [^Array with: pkg]. coll := OrderedCollection with: pkg. overs do: [:over | (pkg := over package) == nil ifFalse: [coll add: pkg]]. ^coll
allContainingPackagesForSelector: selector class: aClass "Answer all the packges that contain the definition for aClass>>selector, including overriden." "Returns an Array, since a class can have its methods in several packages, or even its definition in several packages via overrides." | coll pkg overs | (pkg := self containingPackageForSelector: selector class: aClass) == nil ifTrue: [^#()]. (overs := Override overridesForSelector: selector class: aClass) == nil ifTrue: [^Array with: pkg]. coll := OrderedCollection with: pkg. overs do: [:over | (pkg := over package) == nil ifFalse: [coll add: pkg]]. ^coll
containingPackageForClass: aClass ^self containingPackageForClassSymbol: aClass instanceBehavior absoluteSymbol
containingPackageForClassName: aClassName ^self containingPackageForClassSymbol: aClassName asClassNameOnly asSymbol
containingPackageForClassNamed: aClassName ^self containingPackageForClassSymbol: aClassName asClassNameOnly asSymbol
containingPackageForClassSymbol: aClassSymbol | cm | cm := self defClassModelForClassSymbol: aClassSymbol. ^cm isNil ifTrue: [nil] ifFalse: [cm package]
containingPackageForDataKey: dataKey class: aClass ^self containingPackageForDataKey: dataKey symbol: aClass absoluteSymbol
containingPackageForDataKey: dataKey nameSpace: aNameSpace ^self containingPackageForDataKey: dataKey symbol: aNameSpace absoluteSymbol
containingPackageForDataKey: dataKey symbol: aSymbol ( self modelsForSymbol: aSymbol ) do: [ :model | ( model includesDataKey: dataKey ) ifTrue: [ ^model package ] ]. ^nil
containingPackageForNameSpaceSymbol: aNameSpaceSymbol | model | model := self defNameSpaceModelForNameSpaceSymbol: aNameSpaceSymbol. ^model isNil ifTrue: [nil] ifFalse: [model package]
containingPackageForSelector: aSelector class: aClass "Answer the current package for aClass>>aSelector, nil if none." "HACK- check for proxy class....." | symbol | symbol := aClass isBehavior ifTrue: [ aClass instanceBehavior absoluteSymbol ] ifFalse: [ aClass absoluteName asSymbol ]. ^self containingPackageForSelector: aSelector classSymbol: symbol meta: aClass isMeta
containingPackageForSelector: aSelector className: aClassName meta: isMeta ^self containingPackageForSelector: aSelector classSymbol: aClassName asClassNameOnly asSymbol meta: isMeta
containingPackageForSelector: aSelector classSymbol: aClassSymbol meta: isMeta "Check to see if it is in an extension, otherwise check if it is really in the definition class model." | cm | cm := self quickContainingClassModelForSelector: aSelector classSymbol: aClassSymbol meta: isMeta. ^cm == nil ifTrue: [ nil ] ifFalse: [ cm package ]
containingPackageForSymbol: aSymbol | model | model := self defModelForSymbol: aSymbol. ^model isNil ifTrue: [ nil ] ifFalse: [ model package ]
packageForClass: class "Return the package that this class is in (or should be placed in). Nil if none can be determined." ^self packageForClassSymbol: class absoluteSymbol.
packageForClassSymbol: classSymbol ^Policies packagePolicy packageForClassSymbol: classSymbol
packageForDataKey: dataKey classSymbol: classSymbol ^Policies packagePolicy packageForDataKey: dataKey classSymbol: classSymbol
packageForDataKey: dataKey nameSpaceSymbol: nameSpaceSymbol ^Policies packagePolicy packageForDataKey: dataKey nameSpaceSymbol: nameSpaceSymbol
packageForDataKey: dataKey owner: aClassOrNameSpace | symbol | symbol := aClassOrNameSpace absoluteSymbol. ^aClassOrNameSpace isBehavior ifTrue: [ self packageForDataKey: dataKey classSymbol: symbol ] ifFalse: [ self packageForDataKey: dataKey nameSpaceSymbol: symbol ].
packageForNameSpace: namespace "Return the package that this namespace is in (or should be placed in). Nil if none can be determined." ^self packageForNameSpaceSymbol: namespace absoluteSymbol.
packageForNameSpaceSymbol: nameSpaceSymbol ^Policies isNil ifTrue: [nil] ifFalse: [Policies packagePolicy packageForNameSpaceSymbol: nameSpaceSymbol]
packageForNewDataKey: dataKey classSymbol: classSymbol ^Policies packagePolicy packageForNewDataKey: dataKey classSymbol: classSymbol
packageForNewDataKey: dataKey nameSpaceSymbol: nameSpaceSymbol ^Policies packagePolicy packageForNewDataKey: dataKey nameSpaceSymbol: nameSpaceSymbol
packageForNewSelector: selector classSymbol: classSymbol meta: isMeta ^Policies packagePolicy packageForNewSelector: selector classSymbol: classSymbol meta: isMeta
packageForSelector: selector classSymbol: classSymbol meta: isMeta ^Policies packagePolicy packageForSelector: selector classSymbol: classSymbol meta: isMeta
quickContainingPackageForDataKey: dataKey symbol: aSymbol "If there are extensions check them for the selector. Otherwise use the class' package Do not ask the class' package if it includes the datakey or there will be infinite recursion." "This will be wrong if a dataKey is not loaded." | cm | cm := self quickContainingModelForDataKey: dataKey symbol: aSymbol. ^cm == nil ifTrue: [ Registry nullPackage ] ifFalse: [ cm package ]
quickContainingPackageForSelector: aSelector class: aClass ^self quickContainingPackageForSelector: aSelector classSymbol: (aClass isMeta ifTrue: [aClass soleInstance] ifFalse: [aClass]) name asSymbol meta: aClass isMeta
quickContainingPackageForSelector: aSelector classSymbol: aClassSymbol meta: isMeta "If there are extensions check them for the selector. Otherwise use the class' package do not ask the class' package if it includes the selector or there will be infinite recursion." "This will be wrong if 'aSelector' is not loaded." | cm | cm := self quickContainingClassModelForSelector: aSelector classSymbol: aClassSymbol meta: isMeta. ^cm == nil ifTrue: [ Registry nullPackage ] ifFalse: [ cm package ]
</methods> <methods> Store.PundleAccess <category>updating</category>
adjustPrerequisitesFor: aString renamedTo: bString "Look at every loaded package and adjust the prerequisites to point to the new name." ( Dialog confirm: ( (#ChangePrereqRefsQ << #packages >> 'Change prerequisite references from <1s> to <2s>?') expandMacrosWith: aString with: bString ) ) ifFalse: [ ^self ]. self allPundles do: [ :pun | pun deploymentPrerequisites do: [ :req | req first = aString ifTrue: [ req at: 1 put: bString ]. ]. pun developmentPrerequisites do: [ :req | ( req at: 2 ) = aString ifTrue: [ req at: 2 put: bString ]. ] ].
blessingChangedForPundle: aPundle self changed: #pundleBlessing with: aPundle
changedBundleStructure: aBundle containedItemsCache := nil. self changed: #changedBundleStructure with: aBundle. ChangeSet bundleStructure: aBundle. SourceFileManager default bundleStructure: aBundle.
modificationChangedForPundle: aPundle self changed: #pundleModificationStatus with: aPundle. (self allEnclosingBundlesFor: aPundle) do: [:p | self changed: #pundleModificationStatus with: p]
traceChangedForComponent: aCodeComponent self changed: #pundleTrace with: aCodeComponent
</methods> <methods> Store.PundleAccess <category>parcel support</category>
checkPrerequisite: aPundle requiredVersion: reqVersion codeReader: codeReader "Validate the existense of a pundle as a prerequisite. Answer true if acceptable version is already loaded" ^aPundle == nil ifTrue: [ false ] ifFalse: [ codeReader checkPrerequisiteNamed: aPundle name withVersion: aPundle traceVersion requiredVersion: reqVersion ].
checkPrerequisiteNamed: reqName requiredVersion: reqVersion codeReader: codeReader "Validate the existense of a pundle as a prerequisite. Answer true if acceptable version is already loaded" | pundle | pundle := self bundleNamed: reqName. pundle == nil ifTrue: [ pundle := self packageNamed: reqName ]. ^pundle == nil ifTrue: [ false ] ifFalse: [ codeReader checkPrerequisiteNamed: reqName withVersion: pundle traceVersion requiredVersion: reqVersion ].
parcel: aParcel added: aThing to: aPackage "aThing has been changed - reflect the update in aPackage." aThing isNameSpace ifTrue: [ ^XChangeSet current moveWholeNameSpace: aThing toPackage: aPackage ]. aThing isBehavior ifTrue: [ ^XChangeSet current moveWholeClass: aThing toPackage: aPackage ]. aThing isVariableBinding ifTrue: [ aParcel definedBindings keysAndValuesDo: [ :env :keySet | ( ( keySet includes: aThing key ) and: [ ( env asNameSpace bindingFor: aThing key ) = aThing ] ) ifTrue: [ ^XChangeSet current addBinding: aThing in: env ]. ] ]. aThing class == MethodInstallationRecord ifTrue: [ ^XChangeSet current addSelector: aThing selector class: aThing implementingClass toPackage: aPackage ]. Dialog warn: ( (#UnknownParcelChange << #packages >> 'Unknown parcel change (<1s>)<n> in <2s>') expandMacrosWith: aThing printString with: aPackage name ).
parcel: aParcel change: aThing to: aPackage "aThing has been changed - reflect the update in aPackage." aThing isNameSpace ifTrue: [ ^XChangeSet current changeNameSpace: aThing toPackage: aPackage ]. aThing isBehavior ifTrue: [ ^XChangeSet current changeClass: aThing toPackage: aPackage ]. aThing isVariableBinding ifTrue: [ ^aParcel definedBindings keysAndValuesDo: [ :env :keySet | ( keySet includes: aThing key ) ifTrue: [ XChangeSet current changeBinding: ( env asNameSpace bindingFor: aThing key ) in: env ]. ] ]. aThing class == MethodInstallationRecord ifTrue: [ ^XChangeSet current changeSelector: aThing selector class: aThing implementingClass toPackage: aPackage ]. Dialog warn: ( (#UnknownParcelChange << #packages >> 'Unknown parcel change (<1s>)<n> in <2s>') expandMacrosWith: aThing printString with: aPackage name ).
parcel: aParcel toPackageNamed: aString "A parcel has been loaded, now create a matching package for that parcel. The name of this package <aString> will either be the name of the parcel or if the #packageName property is set in the parcel that name will be used. That decision has already been made by the time this method is called. One of the subtle side-effects of this method is that the new package has its #packageName property set right away to prevent future confusion in case this package is published to a database and then again as a parcel. If the parcel contains any database links, those will be restored. We restoreLinksFrom the parcel's properties into the package for the stored db links and before we leave, we do NOT mark converted if already published somewhere." | package | package := Registry packageNamedOrCreate: aString. package startLoad. [self registerParcel: aParcel to: package. aParcel propertyAt: #packageName put: aString. package propertyAt: #packageName put: aString. package propertyAt: #parcelName put: aParcel name. package restoreLinksFrom: aParcel properties. package resetUninstalledStateFrom: aParcel. package removeTransientProperties. package markNotModified] ensure: [package endLoad]. (aParcel properties includesKey: #dbTrace) ifFalse: [package addOtherChange: #convertedParcel]. Override equateComponent: aParcel with: package
parcel: aParcel updates: updates to: aPackage "aParcel has been updated - reflect updates in its related package. Be careful to maintain the same installation order as the CodeReader. Note that the overrides have already been handled" | changedThings addedThings | addedThings := ( updates at: #added ). changedThings := ( updates at: #changed ). ( addedThings select: [ :thing | thing isNameSpace ] ) do: [ :aNameSpace | self parcel: aParcel change: aNameSpace to: aPackage ]. ( addedThings select: [ :thing | thing isBehavior ] ) do: [ :aClass | self parcel: aParcel change: aClass to: aPackage ]. ( addedThings select: [ :thing | thing isVariableBinding ] ) do: [ :aBinding | self parcel: aParcel change: aBinding to: aPackage ]. ( changedThings select: [ :thing | thing isNameSpace ] ) do: [ :aNameSpace | self parcel: aParcel change: aNameSpace to: aPackage ]. ( changedThings select: [ :thing | thing isBehavior ] ) do: [ :aClass | self parcel: aParcel change: aClass to: aPackage ]. ( changedThings select: [ :thing | thing isVariableBinding ] ) do: [ :aBinding | self parcel: aParcel change: aBinding to: aPackage ]. ( addedThings select: [ :ea | ea class == MethodInstallationRecord ] ) do: [ :thing | self parcel: aParcel change: thing to: aPackage ]. ( changedThings select: [ :ea | ea class == MethodInstallationRecord ] ) do: [ :thing | self parcel: aParcel added: thing to: aPackage ]. "Takes care of removals - which can't be found to remove anyway." aPackage cleanse: false.
parcelToBundle: aParcel "Convert aParcel to a bundle - assumes was saved as a bundle and that prereqs reflect bundle contents." "setup database links if they exist." | bundle | [ bundle := ( aParcel propertyAt: #bundleStructure ) convert ] on: StoreWarning do: [ :ex | ex resume ]. "may be duplicate adds - okay" aParcel propertyAt: #bundleStructure put: nil. "Ensure that the sourceIndex gets copied over." bundle propertyAt: #sourceIndex put: (aParcel propertyAt: #sourceIndex). bundle allContainedItems do: [:each | each propertyAt: #sourceIndex put: (aParcel propertyAt: #sourceIndex)]. ^bundle.
parcelToPundle: aParcel "Convert aParcel to a pundle - setup database links if they exist. Handle updates if package exists." | string | ( aParcel propertyAt: #bundleStructure ) == nil ifFalse: [ ^self parcelToBundle: aParcel ]. ( string := aParcel propertyAt: #packageName ) == nil ifFalse: [ ^self parcel: aParcel toPackageNamed: string ]. ^self parcel: aParcel toPackageNamed: aParcel name.
parcelUpdated: aParcel updates: updates "A parcel has been updated. Update the related package(s)" ( aParcel propertyAt: #bundleStructure ) == nil ifTrue: [ self updatePackageFromParcel: aParcel updates: updates ] ifFalse: [ self updateBundleFromParcel: aParcel updates: updates ].
registerParcel: aParcel to: aPackage "Generate update events for the contents of a parcel - put everything in aPackage." | cset | "addXDefinition handles new/and existing" cset := XChangeSet current. aParcel definedNameSpaces do: [ :ns | cset addNameSpaceDefinition: ns toPackage: aPackage ]. aParcel definedClasses do: [ :cls | cset addClassDefinition: cls toPackage: aPackage ]. aParcel classesAndSelectorsDo: [ :cls :selectors | | hasClass | hasClass := aPackage includesClass: cls instanceBehavior. selectors do: [ :selector | ( Override isOverriddenSelector: selector class: cls ) ifTrue: [ cset changeSelector: selector class: cls toPackage: aPackage ] ifFalse: [ "special case for overridden class defs - its selectors have been stolen by the original class" hasClass ifTrue: [ cset correctSelector: selector class: cls toPackage: aPackage ] ifFalse: [ cset addSelector: selector class: cls toPackage: aPackage ] ] ] ]. aParcel definedBindingsDo: [ :binding :env | ( Override isOverriddenStatic: binding key in: env ) ifTrue: [ env isBehavior ifTrue: [ cset changeDataKey: binding key class: env package: aPackage ] ifFalse: [ cset changeDataKey: binding key nameSpace: env package: aPackage ] ] ifFalse: [ env isBehavior ifTrue: [ cset addDataKey: binding key class: env package: aPackage ] ifFalse: [ cset addDataKey: binding key nameSpace: env package: aPackage ] ] ]. aPackage restoreLinksFrom: aParcel properties. "special case stored db links." aPackage copyPropertiesFrom: aParcel properties.
update: anAspect with: anArgument "Handle parcel update" anAspect == #parcelLoaded ifTrue: [ ^self parcelToPundle: anArgument ]. anAspect == #parcelUpdated ifTrue: [ ^self parcelUpdated: anArgument first updates: anArgument last ]. ( #( #parcelInstalledClasses #parcelInstalledNameSpaces #parcelInstalledMethods #installedOverrideMethods ) includes: anAspect ) ifTrue: [ | parcel pkg cset | parcel := anArgument first. ( pkg := parcel relatedPackage ) == nil ifTrue: [ ^self ]. cset := XChangeSet current. anAspect == #parcelInstalledClasses ifTrue: [ cset installedClasses: anArgument last toPackage: pkg ]. anAspect == #parcelInstalledNameSpaces ifTrue: [ cset installedNameSpaces: anArgument last toPackage: pkg ]. anAspect == #parcelInstalledMethods ifTrue: [ cset installedMethods: anArgument last toPackage: pkg ]. anAspect == #installedOverrideMethods ifTrue: [ cset installedOverrideMethods: anArgument last toPackage: pkg ]. pkg resetUninstalledStateFrom: parcel. ^self ]. containedItemsCache := nil. super update: anAspect with: anArgument.
updateBundleFromParcel: aParcel updates: updates "Update a bundle from aParcel's updates." | bundle | [ bundle := ( aParcel propertyAt: #bundleStructure ) updates: updates fromParcel: aParcel ] on: StoreWarning do: [ :ex | ex resume ]. "may be duplicate adds - okay" ^bundle.
updatePackageFromParcel: aParcel updates: updates "aParcel has been updated - reflect updates in it's related package." | pkg | ( pkg := aParcel relatedPackage ) == nil ifTrue: [ ^self ]. self parcel: aParcel updates: updates to: pkg.
</methods> <methods> Store.PundleAccess <category>overrides</category>
componentDefiningClass: aClass ^( self containingPackageForClass: aClass ) "asDescription"
componentDefiningNameSpace: aNameSpace ^( self containingPackageForNameSpace: aNameSpace ) "asDescription"
componentDefiningSelector: selector class: aClass ^( self containingPackageForSelector: selector class: aClass ) "asDescription"
componentDefiningStatic: aStaticBinding in: aNameSpace ^( self containingPackageForDataKey: aStaticBinding key symbol: aNameSpace absoluteSymbol ) "asDescription"
</methods> <methods> Store.PundleAccess <category>fileout</category>
installCallBacksForFileout "Add the package property to all fileouts." "Store.Registry installCallBacksForFileout " "HACK- for handling class proxies" SourceFileFormat attributeFor: #package compute: [ :obj | | pkg | pkg := obj isBindingReference ifTrue: [ ( obj isKindOf: Kernel.ChangeSupportClassProxy ) ifTrue: [ self containingPackageForSymbol: obj absoluteSymbol ] ifFalse: [ self containingPackageForDataKey: obj simpleName symbol: obj environment absoluteSymbol ] ] ifFalse: [ self containingPackageForSymbol: obj absoluteSymbol ]. pkg == nil ifFalse: [ pkg name ]. ]. SourceFileFormat attributeForMethods: #package compute: [ :cls :selector | | pkg | ( pkg := self containingPackageForSelector: selector class: cls ) == nil ifTrue: [ nil] ifFalse: [ pkg name ]. ]
removeCallBacksForFileout "Add the package property to all fileouts." SourceFileFormat removeAttributeFor: #package.
</methods> <methods> Store.PundleAccess <category>accessing-package</category>
allPackages "Answer a collection of all the loaded packages." ^packages values
allPackagesWithNull | pkgs | pkgs := OrderedCollection new: packages size + 1. packages do: [:pkg | pkgs addLast: pkg]. ( pkgs includes: self nullPackage ) ifFalse: [ pkgs addFirst: self nullPackage ]. ^pkgs
isPackageLoaded: aName ^packages includesKey: aName asString
packageNamed: aName "Answer a PackageModel for the named package, or nil if it doesn't exist." aName == nil ifTrue: [^nil]. ^packages at: aName asString ifAbsent: [aName = self nullPackageName ifTrue: [self nullPackage] ifFalse: [nil]]
packageNamedOrCreate: aName ^packages at: aName asString ifAbsent: [ aName = self nullPackageName ifTrue: [ self nullPackage ] ifFalse: [ PackageModel named: aName ] ]
packagesDo: aBlock "Execute 'aBlock' for each package loaded. Access this way to keep 'packages' private." packages do: aBlock
removePackage: aPackage "Unload aPackage and remove it from the package list. Answer true if operation succeeds." aPackage isNil ifFalse: [ self currentPackage = aPackage ifTrue: [self currentPackage: self nullPackage]. packages removeKey: aPackage name ifAbsent: [^false]. self changed: #removedPundle with: aPackage. ( self enclosingComponentsFor: aPackage ) do: [ :comp | comp removeComponent: aPackage asDescription ]. ^true ]. ^false
</methods> <methods> Store.PundleAccess <category>accessing-bundle</category>
allBundles "Answer a collection of all the loaded bundles." ^bundles values
allBundlesWithNewerInDB "Answer a collection of packages with newer published versions." "Store.Registry allBundlesWithNewerInDB" | coll | coll := OrderedCollection new. bundles do: [ :bundle | | versions trace | trace := bundle dbTrace. versions := trace == nil ifTrue: [ bundle class databaseClass allVersionsWithName: bundle name ] ifFalse: [ bundle class databaseClass allVersionsWithName: bundle name after: trace ]. coll addAll: versions. ]. ^coll
allEnclosingBundlesFor: aComponent "Answer a collection of bundles that contain aComponent, all bundles that contain those bundles, etc." | findAncestors hasBeenDone | "deal with potential circular containment structure" hasBeenDone := Set new. findAncestors := [:aPundle | (hasBeenDone includes: aPundle) ifTrue: [#()] ifFalse: [ | collectedAncestors parents| hasBeenDone add: aPundle. parents := self enclosingComponentsFor: aPundle. collectedAncestors := Set new addAll: parents; yourself. parents do: [:aParent | collectedAncestors addAll: (findAncestors value: aParent)]. collectedAncestors]]. ^findAncestors value: aComponent.
anyContainedItems "Answer a collection of components." ^self containedItems
bundleNamed: aName "Answer a BundleModel for the named bundle, or nil if it doesn't exist." ^bundles at: aName asString ifAbsent: [nil]
bundleNamedOrCreate: aName ^bundles at: aName asString ifAbsent: [ BundleModel named: aName ]
bundlesDo: aBlock "Execute 'aBlock' for each bundle loaded. Access this way to keep 'bundles' private." bundles do: aBlock
containedItems "Answer a collection of top level components." ^containedItemsCache isNil ifTrue: [ | blist plist enclosedItems | enclosedItems := IdentitySet new. self allBundles do: [ :bundle | enclosedItems addAll: bundle allContainedItems ]. blist := ( self allBundles reject: [ :pkg | enclosedItems includes: pkg ] ) asSortedCollection: [ :a :b | a name < b name ]. plist := ( self allPackages reject: [ :pkg | enclosedItems includes: pkg ] ) asSortedCollection: [ :a :b | a name < b name ]. containedItemsCache := blist asOrderedCollection, plist. ] ifFalse: [ containedItemsCache ]
enclosingComponentsFor: aComponent "Answer a collection of bundles that contian aComponent." | answer | answer := OrderedCollection new. bundles do: [ :aBundle | ( aBundle containsItem: aComponent ) ifTrue: [ answer add: aBundle ] ]. ^answer
isBundleLoaded: aName ^bundles includesKey: aName asString
isLeaf ^false
pundleNamed: aName "Answer a bundle or a package named aName" | pundle | ( pundle := self bundleNamed: aName ) == nil ifTrue: [ pundle := self packageNamed: aName ]. ^pundle.
removeBundle: aBundle "Unload aBundle and remove it from the bundle list. Answer true if operation succeeds." aBundle == nil ifTrue: [ ^false ]. bundles removeKey: aBundle name ifAbsent: [ ^false ]. self changed: #removedPundle with: aBundle. ( self enclosingComponentsFor: aBundle ) do: [ :comp | comp removeComponent: aBundle asDescription ]. ^true.
</methods> <methods> Store.PundleAccess <category>accessing-current/null package</category>
currentPackage ^currentPackage
currentPackage: aPkg "Set the current default package" | newCurrentPackage | newCurrentPackage := aPkg isNil ifTrue: [self nullPackage] ifFalse: [aPkg]. currentPackage == newCurrentPackage ifFalse: [currentPackage := newCurrentPackage. self changed: #currentPackage with: currentPackage]
isCurrentNull currentPackage isNil ifTrue: [^true]. ^currentPackage name = self nullPackageName
nullPackage "TT_Registry nullPackage" ^nullPackage
nullPackageName ^'(none)'
</methods> <methods> Store.PundleAccess <category>accessing-pundle</category>
allPundles "Answer a collection of all the loaded packages and bundles." | all | all := OrderedCollection new: self size. packages do: [:value | all add: value]. bundles do: [:value | all add: value]. ^all
allPundlesSorted "Answer a collection of all the loaded packages and bundles. Bundles go first in alphabetical order followed by packages." | all sorted | sorted := SortedCollection sortBlock: [:x :y | x name < y name]. all := OrderedCollection new: self size. bundles do: [:value | sorted add: value]. all addAll: sorted. sorted := SortedCollection sortBlock: [:x :y | x name < y name]. packages do: [:value | sorted add: value]. all addAll: sorted. ^all
renamePundle: aPundle to: aString "Renames a pundle - assumes user already knows this will lose pundle history." | dict old | aPundle name = self nullPackageName ifTrue: [ ^Dialog warn: (#CannotRenameNullPackage << #packages >> 'Cannot rename the null package.') ]. aPundle enclosingComponents do: [ :bundle | bundle component: aPundle beingRenamedTo: aString ]. ( dict := aPundle isBundle ifTrue: [ bundles ] ifFalse: [ packages ] ) removeKey: aPundle name. old := aPundle name. aPundle name: aString. dict at: aString put:aPundle. self adjustPrerequisitesFor: old renamedTo: aString. self changed: #renamedPundle with: aPundle.
</methods> <methods> Store.PundleAccess <category>deprecated</category>
allContainingPackagesForClass: aClass ^self allContainingPackagesForClassOrNameSpace: aClass
</methods> <methods> Store.PundleAccess class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Store.PundleAccess class <category>package partitioning</category>
createBaseBundle "Creates the system bundle from the tobc file created with: ( Store.Registry bundleNamed: 'Base VisualWorks' ) tableOfBundleContentsOnFile: 'Base VisualWorks.tobc' " | filename | filename := ( Filename fromComponents: ( Array with: '$(VISUALWORKS)' with: 'tocs' with: 'Base VisualWorks.tobc' ) ) asResolvedString. filename asFilename exists ifTrue: [ Registry executeTableOfBundleContentsFromFile: filename ].
createStoreBundle: storeParcel "Creates the system bundle from the tobc file created with: ( Store.Registry bundleNamed: 'StoreBase' ) completeTableOfContentsNamed: 'Store' "
moveCategory: cat in: aNameSpace toPackageName: pkgName "Private- For initially partitioning the image (without namespaces)." ( aNameSpace organization listAtCategoryNamed: cat ) do: [ :classSymbol | self moveClassSymbol: ( aNameSpace absoluteName, '.', classSymbol ) asSymbol toPackageName: pkgName ]
moveClassSymbol: classSymbol toPackageName: pkgName | pkg | pkg := Registry packageNamedOrCreate: pkgName. Transcript cr; show: ((#Moving1sInto2s << #packages >> 'Moving <1s> into <2s>') expandMacrosWith: classSymbol with: pkgName). XChangeSet current moveWholeClass: classSymbol asStrictReference value toPackage: pkg
moveUnpackagedCategory: cat in: aNameSpace toPackageName: pkgName "Private- For initially partitioning the image (without namespaces)." " Transcript show: 'Moving ' , cat , ' into ' , pkgName; cr. " ( aNameSpace organization listAtCategoryNamed: cat asSymbol ) do: [ :symbol | self moveUnpackagedSymbol: aNameSpace absoluteSymbol, '.', symbol toPackageName: pkgName ]
moveUnpackagedClassDataIntoPackages "self moveUnpackagedClassDataIntoPackages" Root withAllNameSpaces do: [ : ns | ns dataBindings do: [ :binding | ( Registry containingPackageForDataKey: binding key nameSpace: ns ) == nil ifTrue: [ ( Registry defNameSpaceModelForNameSpaceSymbol: ( ns absoluteName asSymbol ) ) addDataKey: binding key. ]. ] ].
moveUnpackagedSymbol: symbol toPackageName: pkgName | pkg object | pkg := Registry packageNamedOrCreate: pkgName. " Transcript show: 'Moving ' , symbol , ' into ' , pkgName; cr. " object := symbol asStrictReference valueOrDo: [ self error ]. object isBehavior ifTrue: [ XChangeSet current moveUnpackagedInWholeClass: object toPackage: pkg ] ifFalse: [ ( object isNameSpace ) ifTrue: [ XChangeSet current moveUnpackagedInWholeNameSpace: object toPackage: pkg ] ]
moveUnpackagedToNullPackage "Move any unpackaged anything into the NullPackage." "self moveUnpackagedToNullPackage" | pkg | pkg := Registry nullPackage. Root withAllNameSpacesDo: [ :ns | ( Registry defNameSpaceModelForNameSpaceSymbol: ns absoluteSymbol ) == nil ifTrue: [ XChangeSet current moveUnpackagedInWholeNameSpace: ns toPackage: pkg ]. ns classes do: [ :cls | ( Registry defClassModelForClassSymbol: cls absoluteSymbol ) == nil ifTrue: [ XChangeSet current moveUnpackagedInWholeClass: cls toPackage: pkg ] ] ].
splitIntoPackages "Private- For initially partitioning the image (w/out namespaces)." "PundleAccess splitIntoPackages" Root withAllNameSpacesDo: [ :ns | ns organization categories do: [ :cat | | pkgName | pkgName := cat asString copyFrom: 1 to: (cat indexOf: $- ifAbsent: [cat size + 1] ) - 1. self moveCategory: cat in: ns toPackageName: pkgName ] ].
splitUnpackagedIntoPackagesAndBundles "self splitUnpackagedIntoPackagesAndBundles" | bundle currentGroupName | currentGroupName := ''. Root withAllNameSpacesDo: [ :ns | ns organization categories do: [ :sym | | pkgName tmp index cat | cat := sym asString. index := ( cat indexOf: $- ifAbsent: [ cat size + 1] ) - 1. tmp := cat asString copyFrom: 1 to: index. index >= cat size ifTrue: [ self moveUnpackagedCategory: cat in: ns toPackageName: cat ] ifFalse: [ pkgName := cat. "cat copyFrom: ( index + 2 ) to: cat size." ( currentGroupName = tmp ) ifFalse: [ currentGroupName := tmp. bundle := ( currentGroupName indexOfSubCollection: 'Store' startingAt: 1 ) == 1 ifFalse: [ Registry bundleNamedOrCreate: currentGroupName ]. ]. self moveUnpackagedCategory: cat in: ns toPackageName: pkgName. bundle == nil ifFalse: [ bundle addItem: ( Registry packageNamed: pkgName ) ]. ]. ]. ]. self moveUnpackagedClassDataIntoPackages
unloadEmptyPackages "DANGER unprotected unloads" "self unloadEmptyPackages" Registry allPackages copy do: [:pkg | pkg isCompletelyEmpty ifTrue: [pkg doUnloadFromImage]]. Registry allBundles copy do: [ :bundle | bundle removeNonexistentComponents. bundle isCompletelyEmpty ifTrue: [ bundle doUnloadFromImage ] ]
</methods> <methods> Store.PundleAccess class <category>parcel load/unload/save</category>
addImports "Add specific imports to base NameSpaces." self storeImports do: [ :import | UI addImport: import. Tools addImport: import. ].
packageOverridden "Assigns overridden code to the base packages. This uses the cateogory names from the overridden definition as the package name. Known limitation: code already overriden by user parcels before Store was installed." Override overridesDo: [ :over | | pkg | pkg := Registry packageNamed: over packageFromCategoryName. ( over sources includes: pkg ) ifFalse: [ over sources add: ( Registry packageNamed: over packageFromCategoryName ) ] ]
removeImports "Remove imports added to base NameSpaces during parcel load." self storeImports do: [ :import | UI removeImport: import. Tools removeImport: import ].
storeImports "Answer an array of specific imports to base NameSpaces." "self storeImports" ^#( #Policies #Registry #DbRegistry #PackageChooser ) collect: [ :symbol | | import | import := SpecificNameSpaceImport path: ( Array with: #Store with: symbol ). import private: true. import. ].
</methods> <methods> Store.PundleAccess class <category>class initialization</category>
initialize "Need only be executed on first installation or on change in definition." "Retrieve old pundle information from old version of PundleAccess if available." "PundleAccess initialize" | old | old := Registry. Registry := self new. old == nil ifFalse: [ [ Registry cloneFrom: old. ( Parcel dependents includes: old ) ifTrue: [ Parcel removeDependent: old ]. Override unregisterSourceManager: old. old removeCallBacksForFileout. Override registerSourceManager: Registry. ( Parcel dependents includes: Store.Registry ) ifFalse: [ Parcel addDependent: Store.Registry ]. Registry installCallBacksForFileout. ] on: Error do: [ :ex | Dialog warn: ((#ErrorReinitializingImageModel << #packages >> 'Error %<<1s>%> reinitializing the image model.<n>See PundleAccess%>initilialize') expandMacrosWith: ex description). Registry := old. ex return. ] ].
</methods> <methods> Store.PundleAccess class <category>accessing</category>
parcelDirectory ^ParcelDirectory
parcelDirectory: logicalFilename ParcelDirectory := logicalFilename
</methods> <methods> Store.ExtensionClassModel <category>selector accessing</category>
addSelector: aSelector meta: isMeta (self privateWritableSelectorsMeta: isMeta) add: aSelector
includesSelector: aSelector meta: isMeta ^(self selectorsMeta: isMeta) includes: aSelector
quickIncludesSelector: aSelector meta: isMeta ^(self selectorsMeta: isMeta) includes: aSelector
removeSelector: aSelector meta: isMeta super removeSelector: aSelector meta: isMeta. (self privateWritableSelectorsMeta: isMeta) remove: aSelector ifAbsent: []
selectorsMeta: isMeta ^isMeta ifTrue: [metaSelectors isNil ifTrue: [#()] ifFalse: [metaSelectors]] ifFalse: [selectors isNil ifTrue: [#()] ifFalse: [selectors]]
</methods> <methods> Store.ExtensionClassModel <category>data accessing</category>
addDataKey: aDataKey self privateData add: aDataKey
dataKeys ^data == nil ifTrue: [ IdentitySet new ] ifFalse: [ data ]
includesDataKey: dataKey ^self dataKeys includes: dataKey
quickIncludesDataKey: dataKey ^self includesDataKey: dataKey
removeDataKey: dataKey super removeDataKey: dataKey. data == nil ifTrue: [ ^self ]. self privateData remove: dataKey ifAbsent: [ ]
</methods> <methods> Store.ExtensionClassModel <category>testing</category>
hasDefinition ^false
isEmpty "Is this class model holding onto nothing?" ^( selectors size = 0 ) & ( metaSelectors size = 0 ) & ( data size = 0 )
isExtension ^true
</methods> <methods> Store.ExtensionClassModel <category>printing</category>
printOn: aStream aStream nextPutAll: 'CM-EXT:'. aStream nextPutAll: self fullName. aStream nextPutAll: ':'. aStream nextPutAll: self package name.
</methods> <methods> Store.ExtensionClassModel <category>private</category>
cloneFrom: aClassModel "Copy all our selectors and data from another class model" | keys | super cloneFrom: aClassModel. #( true false ) do: [:isMeta | ( aClassModel selectorsMeta: isMeta ) do: [ :sel | self addSelector: sel meta: isMeta ] ]. data := ( keys := aClassModel dataKeys ) isEmpty ifTrue: [ nil ] ifFalse: [ keys ].
privateData "Answer dataKeys defined by the receiver. Initialize the set if empty." data isNil ifTrue: [ data := IdentitySet new ]. ^data
privateWritableSelectorsMeta: isMeta "Return the list of selectors, depending on which subclass this may be the list of present or absent selector. If the list is empty initialize it first" ^isMeta ifTrue: [metaSelectors isNil ifTrue: [metaSelectors := IdentitySet new]. metaSelectors] ifFalse: [selectors isNil ifTrue: [selectors := IdentitySet new]. selectors]
</methods> <methods> Store.PundleModel <category>printing</category>
itemString | nameAndVersion env | nameAndVersion := self name , self versionString. env := self environment. ^env isNil ifTrue: [nameAndVersion] ifFalse: [ |envName | envName := 'Environment: ', self environment fullName. nameAndVersion , (String with: Character cr with: Character tab), envName].
printStringCache "Answer the db printString for the current connection versioin, nil if none." | info | ^( info := self databaseInformation ) == nil ifFalse: [ info versionString ].
printStringCache: aString self databaseInformationOrCreate versionString: aString
textForItem "Descriptive text for the browser text window." | stream dbId | stream := TextStream on: ( String new: 80 ). stream nextPutAll: self name; cr. #{DbRegistry} ifDefinedDo: [ :reg | dbId := reg dbIdentifier. self databaseInformationsDo: [ :info | | id | id := info dbIdentifier. id = dbId ifTrue: [ stream emphasis: #bold ]. id == nil ifTrue: [ id := '' ]. stream tab; nextPutAll: ( id, info versionString, ( ( self hasBeenModifiedIn: id ) ifTrue: [ '*' ] ifFalse: [ '=' ] ) ). stream emphasis: #normal. stream cr. ]. ]. ^stream contents
traceVersion "Answer a string describing a version of my trace pundle appropiate for version comparisons." | info | ^self shouldTrackChanges ifTrue: [ ( info := self databaseInformation ) == nil ifTrue: [ '' ] ifFalse: [ info traceVersion ] ] ifFalse: [ self version ].
versionString self shouldTrackChanges ifFalse: [ ^'' ]. ^self traceVersionString , ( self hasBeenModified ifTrue: [ '*' ] ifFalse: [ '=' ] )
</methods> <methods> Store.PundleModel <category>public-change set access</category>
markNotModified self shouldTrackChanges ifTrue: [ self emptyChangeSet ]
</methods> <methods> Store.PundleModel <category>testing</category>
hasBeenModifiedSomewhere "Answer true if the receiver has been modified within any database." | traceableInfos | ^self isImageDatabaseEnabled ifFalse: [self hasBeenModified] ifTrue: [traceableInfos := self databaseInformations select: [:each | each hasTrace]. traceableInfos isEmpty ifTrue: [self hasBeenModified] ifFalse: [self hasBeenModified or: [(traceableInfos anySatisfy: [:each | each isChangeSetEmpty]) not]]]
isImageDatabaseEnabled ^#{Store.DbRegistry} isDefined
shouldTrackChanges ^#{Store.DBAccess} isDefined
</methods> <methods> Store.PundleModel <category>initialization</category>
initialize super initialize. dbInfo := IdentityDictionary new: 2.
</methods> <methods> Store.PundleModel <category>accessing</category>
databaseInformationClass ^DatabaseConnectionInformation
dbIdentifier "Answer the db identifier for the current connection, nil if none." | info | ^( info := self databaseInformation ) == nil ifFalse: [ info dbIdentifier ].
dbIdentifier: dbIdentifier "Set the database identifier." self databaseInformationForOrCreate: dbIdentifier
dbTrace "Answer the db parent id for the current connection, nil if none." | info | ^( info := self databaseInformation ) == nil ifFalse: [ info dbTrace ].
getImagePundle ^self
markReadOnly readonly := true.
name: aString super name: aString asString.
parcelName "Answer the parcel name, or receiver's name if absent." ^self propertyAt: #parcelName ifAbsent: [ self name ].
parcelName: aString "Answer the parcel name, or receiver's name if absent." ^self propertyAt: #parcelName put: aString
pundleListIcon ^ListIconLibrary visualFor: self pundleListIconKey
raiseMismatchedSignal self class mismatchedDatabaseSignal signalWith: self.
relatedParcel "Answer the receiver's coresponding parcel, nil if none" ^Parcel parcelNamed: self parcelName
renameTo: aString "Rename the receiver. If it has been published, this will disconnect it from previous versions." Registry renamePundle: self to: aString.
silentProperties: aDictionary ( properties contentsEquals: aDictionary ) ifTrue: [ ^self ]. properties := IdentityDictionary new. self startLoad. [ self copyPropertiesFrom: aDictionary ] ensure: [ self endLoad ].
unmarkReadOnly readonly := false.
version ^(#image << #packages >> 'image') asString
</methods> <methods> Store.PundleModel <category>private</category>
asDescription ^( self descriptionClass new ) componentName: self name; yourself.
cleanse "Cleanse the component. Remove any class or method definitions that are no longer in the system, including the postLoadMethod."
selectIconKeyDefault: defaultKey modified: modifiedKey noDBdefault: ndDefaultKey modified: ndModified ^(self isImageDatabaseEnabled not or: [self isInCurrentDatabase]) ifTrue: [self hasBeenModifiedSomewhere ifTrue: [modifiedKey] ifFalse: [defaultKey]] ifFalse: [self hasBeenModifiedSomewhere ifTrue: [ndModified] ifFalse: [ndDefaultKey]]
sortCategories: categories with: orderedCategories "Answer a collection that is categories sorted according to the image." | list | list := OrderedCollection new: categories size. orderedCategories do: [ :cat | ( categories includes: cat ) ifTrue: [ list add: cat ] ]. ^list.
</methods> <methods> Store.PundleModel <category>private-db management</category>
addOtherChange: mark self updateAfterDo: [ self changeSetsDo: [ :cs | cs addOtherChange: mark ] ]
addPropertyChange: mark self updateAfterDo: [ self changeSetsDo: [ :cs | cs addPropertyChange: mark ] ]
changeSetsDo: aBlock "Evaluate aBlock for all of the receiver's changeSets (ie. for all database connections). If there are no changesets, create an unnamed one" self shouldTrackChanges ifTrue: [ dbInfo isEmpty ifTrue: [ self databaseInformationForOrCreate: self noDbSymbol ]. dbInfo values do: [ :info | aBlock value: info changeSet ]. ].
databaseInformation | dbid | dbid := self noDbSymbol. #{Store.DbRegistry} ifDefinedDo: [:registry | "The only time that DbRegistry might be defined and still be nil is if StoreBase is being loaded into the image for the first time. So, the following check is simply to prevent walkbacks while loading StoreBase." dbid := registry isNil ifTrue: [nil] ifFalse: [registry dbIdentifier]]. ^dbInfo at: dbid ifAbsent: nil
databaseInformationFor: aDatabaseId "Answer a DatabaseInformationConnection for the receiver and the specified database" ^dbInfo at: aDatabaseId ifAbsent: nil
databaseInformationForOrCreate: aDatabaseId "Answer a DatabaseInformationConnection for the receiver and the specified database" | dbid | dbid := aDatabaseId == nil ifTrue: [ self noDbSymbol ] ifFalse: [ aDatabaseId asSymbol ]. ^dbInfo at: dbid ifAbsentPut: [ ( self databaseInformationClass dbIdentifier: dbid ) pundle: self ; initializeContentsFrom: self; yourself ].
databaseInformationOrCreate "Answer a DatabaseInformationConnection for the receiver and the current/last database or create a new one and set it up." | dbid | ( dbid := #{DbRegistry} ifDefinedDo: [ :reg | reg dbIdentifier ] ) == nil ifTrue: [ dbid := dbInfo isEmpty ifTrue: [ self noDbSymbol ] ifFalse: [ dbInfo values first dbIdentifier ] ]. ^dbInfo at: dbid ifAbsentPut: [ ( self databaseInformationClass dbIdentifier: dbid ) pundle: self; initializeContentsFrom: self; yourself ].
databaseInformations "Private- Answer the dictionary of databaseConnectionInformations." ^dbInfo
databaseInformationsDo: aBlock "Evaluate aBlock for all all database connections." dbInfo == nil ifFalse: [ dbInfo do: aBlock ].
noDbSymbol ^'' asSymbol
updateAfterDo: aBlock | changeSetState | changeSetState := self hasBeenModified. aBlock value. changeSetState = self hasBeenModified ifFalse: [ Registry modificationChangedForPundle: self ]
</methods> <methods> Store.PundleModel <category>browser support</category>
value "Implemented by any subclass wanting to be displayed in a browser." ^self
</methods> <methods> Store.PundleModel <category>parcel support</category>
asParcel "Convert the receiver to a parcel." ^self asParcel: self name.
asParcel: string "Convert the receiver to a parcel named string. Does not remove anything from existing parcels." | parcel | ( parcel := Parcel parcelNamed: string ) == nil ifTrue: [ parcel := Parcel createParcelNamed: string ]. self copyContentsToParcel: parcel. parcel properties: self propertiesForSave. ^parcel.
cleanseRelatedParcel "If there is a related parcel to this pundle, cleanse it. This helps keep the parcel void of any obsolete definitions. If the parcel is empty the side-effect (yuck) is to ask the user if they want to destroy it." | parcel | ( parcel := self relatedParcel ) == nil ifTrue: [ ^self ]. parcel cleanse. parcel isEmpty ifTrue: [ Parcel destroyParcelNamed: parcel name ]
copyPropertiesFrom: aPropertyDictionary "Move the relevant properties to the receiver. Uses accessors where possible." "NOTE: maybe should to get property list from class" self restoreLinksFrom: aPropertyDictionary. "special case stored db links." super copyPropertiesFrom: aPropertyDictionary
notInParcel: aParcel "Answer a string listing things contained in the receiver but not in a Parcel." | stream | stream := ( String new: 100 ) writeStream. stream nextPutAll: (#ClassesC << #packages >> 'Classes:') asString; cr. self definedClassesNotInParcel: aParcel on: stream. stream cr; nextPutAll: (#MethodsC << #packages >> 'Methods:') asString; cr. self methodsNotInParcel: aParcel on: stream. stream cr; nextPutAll: (#NameSpacesC << #packages >> 'NameSpaces:') asString; cr. self definedNameSpacesNotInParcel: aParcel on: stream. stream cr; nextPutAll: (#DataC << #packages >> 'Data:') asString; cr. self dataNotInParcel: aParcel on: stream. ^stream contents.
putStoredPropertiesIn: aDictionary "Put any PundleModel-specific properties into aDictionary for Parcel publishing." aDictionary at: #name put: self parcelName.
resetUninstalledStateFrom: aParcel "A parcel has changed in some way, recheck and set the uninstalled properties and the read-only flag" aParcel hasUninstalledCode ifTrue: [ self markReadOnly ] ifFalse: [ self unmarkReadOnly ]. "These serve no purpose in Store" self propertyAt: #uninstalledClasses put: nil. self propertyAt: #uninstalledMethods put: nil. self propertyAt: #uninstalledBindings put: nil.
restoreLinksFrom: propertyDictionary "Called when restoring database links after parcel load." | dbid | #{Store.DbRegistry} isDefined ifTrue: [ dbid := propertyDictionary at: #dbIdentifier ifAbsent: [ propertyDictionary at: #databaseId ifAbsent: nil ]. dbid == nil ifFalse: [ ( self databaseInformationForOrCreate: dbid ) dbTrace: ( propertyDictionary at: #dbTrace ifAbsent: nil ); versionString: ( propertyDictionary at: #printStringCache ifAbsent: nil ); emptyChangeSet. dbInfo removeKey: self noDbSymbol ifAbsent: nil. "now we be connected" ]. ]. "Remove the properties, which don't belong here any more so that Parcels are not inadvertantly saved with stale package information." propertyDictionary removeKey: #databaseId ifAbsent: nil; removeKey: #dbIdentifier ifAbsent: nil; removeKey: #dbTrace ifAbsent: nil; removeKey: #printStringCache ifAbsent: nil.
</methods> <methods> Store.PundleModel <category>private-file out</category>
fileOutChangedPropertiesForDb: dbid on: aFileManager "File out only changed, saveable properties to aFileManager." | changed props cs | ( ( cs := self changeSetFor: dbid ) == nil or: [ cs propertiesOrNil == nil ] ) ifTrue: [ ^self ]. props := self propertiesForFileOut. changed := IdentityDictionary new. cs properties do: [ :symbol | ( props includesKey: symbol ) ifTrue: [ changed at: symbol put: ( props at: symbol ) ] ]. changed size == 0 ifTrue: [ ^self ]. self fileOutProperties: changed on: aFileManager
</methods> <methods> Store.PundleModel <category>private-load/unload</category>
assertNotLoaded: nameString ifFail: aBlock "Check if the receiver is already loaded and if so, raise the parcelAlreadyLoadedSignal. If the handler returns false, indicating the load should be aborted, and then raise the abortedActionSignal and return its value through aBlock." self needsMoreWork
assertSelfIsSameComponentAs: parcelName ifFail: aBlock "For updating from binary (i.e. parcel)" parcelName ~= self parcelName ifTrue: [ ^aBlock value: ( self class abortedActionSignal raiseRequestWith: ( Array with: self with: self name with: #updateWrongComponent << #dialogs >> 'Attempt to update different component') errorString: #loadAborted << #dialogs >> 'Parcel load aborted') ]
prerequisiteProviderFrom: aCodeReaderOrNil ^Registry
recordPackageContentsFrom: aCodeReader "Override to suppress unnecessary duplicate add warnings." [super recordPackageContentsFrom: aCodeReader] on: Store.StoreWarning do: [ :ex | ex resume ]
unloadLogged: log ( self unloadFromImage and: [ #{Store.DbRegistry} isDefined ] ) ifTrue: [ ChangeSet unloadComponent: self. SourceFileManager default unloadComponent: self. ].
</methods> <methods> Store.PundleModel <category>fileIn/Out</category>
fileOut "Ask for the file name and file out the content of the pundle into it." | fileName | fileName := Dialog requestNewFileName: #FileOutOnC << #packages >> 'File out on:' default: self name , '.st'. fileName isEmpty ifTrue: [^nil]. self fileOutOnFileNamed: fileName
fileOutOnFileNamed: fileName | stream | stream := SourceCodeStream write: fileName. [Notice showNotice: (#FilingOut1s << #packages >> 'Filing out <1s>' expandMacrosWith: name) complete: self itemCount while: [stream timeStamp. stream deferInitializations. self fileOutOn: stream. stream finishInitializations] title: #Store << #packages >> 'Store'] ensure: [stream close]
</methods> <methods> Store.PundleModel <category>deprecated/backward compatiblity</category>
databaseInfomation "This is deprecated, but preserves the old mis-spelling for backward compatibility. Use databaseInformation instead." ^self databaseInformation.
databaseInfomationForOrCreate: aDatabaseId "This is deprecated, but preserves the old mis-spelling for backward compatibility. Use databaseInformationForOrCreate: instead." ^self databaseInformationForOrCreate: aDatabaseId.
databaseInfomationOrCreate "This is deprecated, but preserves the old mis-spelling for backward compatibility. Use databaseInformationOrCreate instead." ^self databaseInformationOrCreate.
</methods> <methods> Store.PundleModel class <category>class initialization</category>
initialize "self initialize" EmergencyUnloadSignal := Object errorSignal newSignal notifierString: (#CannotLoadAComponent << #packages >> 'Cannot load a component'); nameClass: self message: #emergencyUnloadSignal.
</methods> <methods> Store.PundleModel class <category>utility</category>
selectDatabaseFor: pundles "Display a list of existing db names and answer the user's choice." | dbs | ( dbs := self allDatabasesFor: pundles ) size == 0 ifTrue: [ ^nil ]. dbs size == 1 ifTrue: [ ^dbs first ]. ^Dialog choose: (#ForWhichDatabase << #packages >> 'For which database?') fromList: dbs values: dbs lines: dbs size + 1 cancel: nil
selectDatabasesFor: pundles prompt: aString "Display a list of existing db names and answer the user's choices." "self selectDatabasesFor: ( Store.Registry bundleNamed: 'StoreBase' ) leafItems prompt: 'which?'" | dbs | ( dbs := self allDatabasesFor: pundles ) size == 0 ifTrue: [ Dialog warn: (#NothingToSelect << #packages >> 'Nothing to select'). ^nil ]. dbs size == 1 ifTrue: [ ^dbs ]. ^SimpleDialog new chooseMultiple: aString fromList: dbs values: dbs buttons: #() values: #() lines: dbs size + 1 cancel: [ nil ] for: Dialog defaultParentWindow
</methods> <methods> Store.PundleModel class <category>instance creation</category>
illegalCharacters "Answer a list of characters that should not be in a package name because of possibly illiegal directory names that can be constructed from the packagename." "Using this as the most restrictive list of chars" ^PCFilename badEightDotThreeCharacterList copyWithout: Character space
named: aString "The ONLY legitimate method for creating new pundles." | newPundle | newPundle := super named: aString. Registry notNil ifTrue: [ Registry privateRegisterPundle: newPundle ]. ^newPundle
validateName: proposedComponentName "Answer true if proposedComponentName does not contain any illegal characters that might be used as a directory name." | badChars | badChars := self illegalCharacters. ^(proposedComponentName contains: [:char | badChars includes: char]) not
</methods> <methods> Store.BundleModel <category>printing</category>
classDescription "Answer a string for describing the class." ^(#Bundle << #packages >> 'Bundle') asString
describeContents | strm | strm := WriteStream on: String new. self describeContentsOn: strm level: 0. ^strm contents
describeContentsOn: aStream level: aDepth self containedItems do: [:pun | aDepth timesRepeat: [aStream tab]. aStream nextPutAll: (pun stringKey: #()). pun hasBeenModified ifTrue: [aStream nextPut: $*]. aStream cr. pun isBundle ifTrue: [pun describeContentsOn: aStream level: aDepth + 1]]
displayString "Answer the string to be displayed for a bundle in a Bundle list." | stream | stream := WriteStream on: ( String new: 32 ). stream nextPutAll: self name. self hasBeenModified ifTrue: [ stream nextPutAll: ' *' ]. self hasExtensions ifTrue: [ stream nextPutAll: ' +' ]. ^stream contents
printOn: aStream aStream nextPut: ${; nextPutAll: (name isNil ifTrue: [(#unnamed << #packages >> '*unnamed*') asString] ifFalse: [name]); nextPut: $}.
storeOn: aStream name storeOn: aStream. aStream tab. aStream cr. self contentDescriptions do: [ :pr | aStream nextPut: $C; tab. pr storeOn: aStream. aStream cr ]. aStream nextPut: $E; cr.
</methods> <methods> Store.BundleModel <category>private-file out</category>
createOrFindExpression "Answer a string that when evaluated will instantiate the receiver - creating, if neccessary." ^'( Store.Registry bundleNamedOrCreate: ', self name printString, ' ) '.
fileOutOn: aFileManager "File out the bundle on aFileManager." aFileManager addComment: ((#Bundle1s << #packages >> 'Bundle <1s>') expandMacrosWith: self itemString). ( ( UISettings preferenceFor: #fileoutOption ) == #never ) ifFalse: [ self fileOutPropertiesOn: aFileManager ]. self containedItems do: [ :comp | comp fileOutOn: aFileManager ]. aFileManager bundleStructure: self.
</methods> <methods> Store.BundleModel <category>unloading</category>
preUnloadChecksFromBundle: aBundle | bundles bnames bundle components | bundles := Registry enclosingComponentsFor: self. aBundle notNil ifTrue: [ bundles remove: aBundle ifAbsent: nil. components := aBundle allContainedItems select: [ :c | c isBundle ]. bundles copy do: [ :b | ( components includes: b ) ifTrue: [ bundles remove: b ] ] ]. bnames := bundles collect: [ :b | b name ]. (self unloadProblemsQuery: bnames header: ((#UnloadingPackageWillModifySomeBundles << #packages >> 'The package to be unloaded, "<1s>", is contained in the bundles<2s>listed below. Proceeding will modify these bundles.') expandMacrosWith: self name with: (String with: Character cr))) ifFalse: [^false]. bundle := aBundle == nil ifTrue: [ self ] ifFalse: [ aBundle ]. self contents reverseDo: [ :comp | comp notNil ifTrue: [ ( comp runPreUnloadFrom: bundle ) ifFalse: [ ^false ] ] ]. ^true
unloadFromImage "I'm being ask to disappear from the image. Run rear guard code for all of my components and if all goes well obey the order. Answer true if I can fulfill the wish." ObjectMemory globalGarbageCollect. #{Store.DbRegistry} ifDefinedDo: [ :reg | ( self runPreUnloadFrom: nil ) ifFalse: [ ^false ]. ]. ^self doUnloadFromImage
unloadLogged: log self unloadFromImage ifTrue: [ ChangeSet unloadComponent: self. SourceFileManager default unloadComponent: self. ].
</methods> <methods> Store.BundleModel <category>private-change set access</category>
structureMark "Answer the symbol used to indicate that the bundle structure has been modified." ^self class structureMark
</methods> <methods> Store.BundleModel <category>public-change set access</category>
inspectChangeSet "Attempt to describe the changes to the bundle at a high level." "Could do better." | stream | stream := WriteStream on: String new. self hasBeenModified ifFalse: [stream nextPutAll: (#BundleHasNotBeenChanged << #packages >> 'There are no changes to this bundle or its components') asString] ifTrue: [| modPuns | modPuns := OrderedCollection new. self contentDescriptions do: [ :descrip | descrip hasBeenModified ifTrue: [ modPuns add: descrip component ] ]. modPuns size > 0 ifTrue: [stream nextPutAll: (#SomeBundleComponentsHaveChanged << #packages >> 'The following bundle components have been<n>modified (see component for details):') expandMacros; cr. modPuns do: [:item | stream tab; nextPutAll: item name; cr]. stream cr]. self isChangeSetEmpty ifFalse: [stream nextPutAll: self changeSet printString]]. Dialog warn: stream contents
</methods> <methods> Store.BundleModel <category>accessing-browser</category>
allClasses "Answer a collection of class descriptors. The collection contains descriptors for classes that are defined in the package and extention descriptors for classes for which only data is defined" | classes | classes := Set new. self leafItems do: [ :pkg | classes addAll: pkg allClasses ]. ^classes
allMetaclasses "Answer a collection of class descriptors. The collection contains descriptors for classes that are defined in the package and extention descriptors for classes for which only data is defined" | classes | classes := Set new. self leafItems do: [ :pkg | classes addAll: pkg allMetaclasses ]. ^classes
allNameSpaces "Answer a collection of namespace descriptors. The collection contains descriptors for namespaces that are defined in the package and extention descriptors for namespaces for which only data is defined" | namespaces | namespaces := Set new. self leafItems do: [ :pkg | namespaces addAll: pkg allNameSpaces ]. ^namespaces.
dataForNamed: aFullName "Answer a collection of datum descriptors." | set | set := Set new. self leafItems do: [ :pkg | set addAll: ( pkg dataForNamed: aFullName ) ]. ^set asOrderedCollection
dataForNamed: aFullName andProtocol: aSymbol "Answer a collection of datum descriptors." | set | set := Set new. self leafItems do: [ :pkg | set addAll: ( pkg dataForNamed: aFullName andProtocol: aSymbol) ]. ^set asOrderedCollection
includesDataKey: dataKey ownerName: aName "Answer wheter the reciver contains aName.dataKey." self leafItems detect: [ :pkg | pkg includesDataKey: dataKey ownerName: aName ] ifNone: [ ^false ]. ^true
includesDefinitionOf: aName "Answer wheter the reciver contains something represented by aName." self leafItems detect: [ :pkg | pkg includesDefinitionOf: aName ] ifNone: [ ^false ]. ^true
includesMethod: aMethodDescriptor ^self includesSelector: aMethodDescriptor selector className: aMethodDescriptor className meta: aMethodDescriptor isMeta
includesSelector: selector class: aClass ^self includesSelector: selector className: aClass instanceBehavior absoluteName meta: aClass isMeta
includesSelector: selector className: className meta: isMeta "Answer wheter the reciver contains className>>aSelector." self leafItems detect: [ :pkg | pkg includesSelector: selector className: className meta: isMeta ] ifNone: [ ^false ]. ^true
methodsForClassNamed: cName andProtocol: protocolName meta: isMeta "Answer a collection of method descriptors." | set | set := Set new. self leafItems do: [ :pkg | set addAll: ( pkg methodsForClassNamed: cName andProtocol: protocolName meta: isMeta ) ]. ^set asOrderedCollection
methodsForClassNamed: aClassName meta: isMeta "Answer a collection of methods." | set | set := Set new. self leafItems do: [ :pkg | set addAll: ( pkg methodsForClassNamed: aClassName meta: isMeta ) ]. ^set asSortedCollection: [:x :y | x name < y name]
protocolsForClassNamed: aClassName meta: isMeta "Answer a collection of protocols." | set | set := Set new. self leafItems do: [ :pkg | set addAll: ( pkg protocolsForClassNamed: aClassName meta: isMeta ) ]. ^set
protocolsForDataIn: anObject | set | set := Set new. self leafItems do: [ :pkg | set addAll: ( pkg protocolsForDataIn: anObject ) ]. ^set asSortedCollection
</methods> <methods> Store.BundleModel <category>accessing</category>
addItem: aPundle "Create a bundle or a package description and add it to the content of the bundle. Leave the id field not set." self addComponent: aPundle asDescription
allContainedItems "Returns a recursive collection of all components contained in the BundleModel." | coll component | coll := OrderedCollection new. self contentDescriptions do: [ :descr | ( component := descr component ) notNil ifTrue: [ coll add: component. component isBundle ifTrue: [ coll addAll: component allContainedItems ]. ] ]. ^coll
allItems "Answer a list of pundles contianed in this bundle and in bundles contained by this bundle. The list preserves the bundle order. Put this bundle as a last item on the list." | items | items := OrderedCollection new. self containedItems do: [ :item | item isBundle ifTrue: [ items addAll: item allItems ] ifFalse: [ items add: item ] ]. items add: self. ^items
anyContainedItems "Answer a recursive collection of components." | coll component descs | coll := OrderedCollection new. ( descs := self contentDescriptions ) isEmpty ifTrue: [ descs := self anyContentDescriptions ]. descs do: [ :descr | ( component := descr component ) notNil ifTrue: [ coll add: component] ]. ^coll
databaseInformationClass ^DatabaseConnectionBundleInformation
descriptionsAndLevels "Answer a list of pairs. The first element contains a descriptions the second the level on which the description was found." | coll | coll := OrderedCollection new. self contentDescriptions do: [:descr | coll addAll: descr descriptionsAndLevels]. ^coll
itemCount "Answer a count of work to be done." ^self contents inject: 1 into: [ :sz :pun | sz + pun itemCount ]
leafDescriptions "Answer the package descriptions at the leaves." "Answer a list of PackageDescriptions." ^self uniqueDescriptionsAndLevels collect: [:a | a at: 1]
leafItems "Answer a list of packages contianed in this bundle and in bundles contained by this bundle." | items | items := OrderedCollection new. self contentDescriptions do: [ :descr | items addAll: descr leafItems]. ^items
pundleListIconKey ^self selectIconKeyDefault: #bundle modified: #modifiedBundle noDBdefault: #bundleNoDB modified: #modifiedBundleNoDB
structure "Answer an array that reflects the receiver's contents in the form: #( #( #package name ) #( #bundle name ) .... )" | answer | answer := OrderedCollection new: self contentDescriptions size. self contentDescriptions do: [ :cd | cd isPackage ifTrue: [ answer add: ( Array with: #package with: cd name ) ] ifFalse: [ answer add: ( Array with: #bundle with: cd name ) ]. ]. ^answer asArray
structure: anArray "Set the receivers contents based on an array in the form: #( #( #package name ) #( #bundle name ) .... )" | components | anArray == nil ifTrue: [ ^self containedItems: #() ]. components := OrderedCollection new: anArray size. anArray do: [ :array | | pundle | pundle := ( array first == #package ) ifTrue: [ Registry packageNamed: array last ] ifFalse: [ Registry bundleNamed: array last ]. pundle == nil ifTrue: [ | error | error := (#CannotAdd1sTo2s << #packages >> 'Cannot add <1s> to <2s><ntt>Continue?') expandMacrosWith: array first with: name. ( Dialog confirm: error ) ifFalse: [ ^self ]. ] ifFalse: [ components add: pundle ]. ]. self containedItems: components.
traceBundle ^self parentRecord
uniqueDescriptionsAndLevels "Just like description and levels but remove components that are present more then one time." | coll present | present := IdentitySet new. coll := self descriptionsAndLevels. coll := coll select: [:pair | | descr comp | descr := pair at: 1. comp := descr component. comp isNil ifTrue: [false] ifFalse: [| res | res := present includes: comp. present add: comp. res not]]. ^coll
</methods> <methods> Store.BundleModel <category>table of contents</category>
tableOfBundleContentsOn: aStream self tableOfBundleContentsOn: aStream level: 0
tableOfBundleContentsOn: aStream level: aLevel aLevel timesRepeat: [aStream tab]. aStream nextPut: $@; nextPutAll: self name; nextPut: $"; cr. self containedItems do: [:pun | pun tableOfBundleContentsOn: aStream level: (aLevel + 1)]. (aLevel + 1) timesRepeat: [aStream tab]. aStream nextPut: $; ; cr
tableOfBundleContentsOnFile: aString | strm | strm := aString asFilename writeStream. self tableOfBundleContentsOn: strm. strm close.
tableOfContentsOn: aStream self leafItems do: [ :pkg | pkg tableOfContentsOn: aStream ]
tableOfContentsOnFile: aString | strm | strm := aString asFilename writeStream. self tableOfContentsOn: strm. strm close.
</methods> <methods> Store.BundleModel <category>private-validation</category>
removeNonexistentComponents self databaseInformationsDo: [ :info | info removeNonexistentComponents ].
validateLoadOrder "Examines NameSpace/Class prereqs to ensure that content list is in a valid order. Answers a string of errors, or an empty string." ^self validateLoadOrder: self leafItems.
validateLoadOrder: list "Examines NameSpace/Class prereqs to ensure that content list is in a valid order. Answers a string of errors, or an empty string." ^self class validateLoadOrder: list
</methods> <methods> Store.BundleModel <category>private</category>
descriptionClass ^BundleDescription
dialogForException: ex "Ask if a user wants to proceed with loading this bundle after an error occurred while loading one of the components." ^Dialog choose: ((#ProblemOccurredWhatNowQ << #packages >> 'The following problem occurred while loading <1s> bundle:<nn><2s><nn>You can ignore the problem and continue loading the bundle<n>or you can abort the operation and unload already loaded <n>bundles and packages.<n>') expandMacrosWith: self name with: ex errorString) labels: (Array with: (#Ignore << #packages >> 'Ignore') with: (#Abort << #packages >> 'Abort')) values: #(#ignore #abort) default: #abort
doUnloadFromImage "The difference between unloadFromImage and this method is that this method does not run the rearguard code and does not ask for rearguard of the components." | components | components := self contents. components reverseDo: [ :comp | comp notNil ifTrue: [ comp unloadFromGroup: self ] ]. self runPostUnload. Registry removeBundle: self. self cleanseRelatedParcel. ^true
manager ^Registry
pundlesNotIn: anImageBundle or: parentBundle "Answer a collection of pundles that I contain but that are not in anImageBundle. The comparison is done based on names of the items." | notIn | notIn := OrderedCollection new. self contentDescriptions do: [ :descr | ( ( anImageBundle containsDescription: descr ) or: [ parentBundle ~~ nil and: [ parentBundle containsDescription: descr ] ] ) ifFalse: [ notIn add: descr component ] ]. ^notIn
removeComponent: aComponentDescription self databaseInformationsDo: [ :info | info removeComponentDescription: aComponentDescription ].
</methods> <methods> Store.BundleModel <category>queries</category>
definedBindings "Answer a dictionary of bindings (NameSpace/Class to datakey) contained in the receiver." "Note- duplicates Parcel format." | bindings | bindings := IdentityDictionary new. self leafItems do: [ :pkg | pkg definedBindings keysAndValuesDo: [ :owner :keys | ( bindings at: owner ifAbsentPut: [ Set new ] ) addAll: keys. ]. ]. ^bindings
definedClasses "Answer a collection of all Classes whose definition is contained in the receiver." | list | list := OrderedCollection new. self leafItems do: [ :pkg | list addAll: pkg definedClasses ]. ^list
definedClassesExcludedSelectors "Answer an IdentityDictionary of Class -> <Set of selectors>" "Parcel compatibility." | coll | coll := IdentityDictionary new. self leafItems do: [ :pkg | pkg definedClassesExcludedSelectors keysAndValuesDo: [ :cls :selectors | | cname | cname := cls instanceBehavior absoluteName. selectors do: [ :selector | ( self includesSelector: selector className: cname meta: cls isMeta ) ifFalse: [ ( coll at: cls ifAbsentPut: [ Set new ] ) add: selector ]. ]. ]. ]. ^coll
definedNameSpaces "Answer a collection of all NameSpaces whose definition is contained in the receiver." | list | list := OrderedCollection new. self leafItems do: [ :pkg | list addAll: pkg definedNameSpaces ]. ^list
definedObjects "Parcel compatibility" ^self definedNameSpaces
extensionMethods "Answer an IdentitySet of CompiledMethods" "Parcel compatibility." | list classes | list := OrderedCollection new. self leafItems do: [ :pkg | list addAll: pkg extensionMethods ]. classes := self definedClasses. ^list reject: [ :cm | classes includes: cm mclass instanceBehavior ].
</methods> <methods> Store.BundleModel <category>parcel support</category>
copyContentsToParcel: parcel self leafItems do: [ :pkg | pkg copyContentsToParcel: parcel ].
dataNotInParcel: aParcel on: aStream "Write owner.dataKey contained in the receiver but not in a Parcel." self leafItems do: [ :pkg | pkg dataNotInParcel: aParcel on: aStream ].
definedClassesNotInParcel: aParcel "Answer a string listing class names contained in the receiver but not in a Parcel." | stream | stream := ( String new: 100 ) writeStream. self definedClassesNotInParcel: aParcel on: stream. ^stream contents.
definedClassesNotInParcel: aParcel on: aStream "Write class names contained in the receiver but not in a Parcel." self leafItems do: [ :pkg | pkg definedClassesNotInParcel: aParcel on: aStream ].
definedNameSpacesNotInParcel: aParcel "Answer a string listing class names contained in the receiver but not in a Parcel." | stream | stream := ( String new: 100 ) writeStream. self definedNameSpacesNotInParcel: aParcel on: stream. ^stream contents.
definedNameSpacesNotInParcel: aParcel on: aStream "Write class names contained in the receiver but not in a Parcel." self leafItems do: [ :pkg | pkg definedNameSpacesNotInParcel: aParcel on: aStream ].
methodsNotInParcel: aParcel on: aStream "Write method>>selectors contained in the receiver but not in a Parcel." self leafItems do: [ :pkg | pkg methodsNotInParcel: aParcel on: aStream ].
namedObjects ^Dictionary new.
saveAsParcel: fullPathName saveStructure: saveStructure saveLinks: saveLinks "Save the receiver as a parcel -without creating the parcel in the image. fullPathName is a directory/parcelName with no extension. If saveStructure is true, fill in the bundleStructure property with bundle/package contents. If saveLinks is true, save the db links for every component." | dir link pname | link := saveLinks. ( saveLinks & self hasBeenModified ) ifTrue: [ ( Dialog confirm: ( (#UnpublishedModificationsMeanNoDBLinks << #packages >> '<t><1s> has unpublished modifications.<n>This means that database links will not be included.<ntttt>Continue?') expandMacrosWith: name ) ) ifFalse: [ ^self ]. link := false. ]. pname := fullPathName tail. dir := fullPathName directory. dir exists ifFalse: [ ( Dialog confirm: ( (#CreateDirectory1s << #packages >> 'Create directory <1s>?') expandMacrosWith: dir asString ) ) ifFalse: [ ^self ]. dir makeDirectory. ]. properties at: #bundleName put: self name; at: #parcelName put: pname. saveStructure ifTrue: [ properties at: #bundleStructure put: ( PundleForParcel from: self saveLinks: link ) ]. [ self parcelOutTo: ( dir construct: ( pname, '.pcl' ) ) asString sourceFileName: ( dir construct: ( pname, '.pst' ) ) asString. ] ensure: [ properties removeKey: #bundleStructure ifAbsent: [ ]; removeKey: #bundleName ifAbsent: [ ]. ].
saveAsParcel: aFilename saveStructure: saveStructureBoolean saveLinks: saveLinksBoolean parcelOptions: aDictionary "Save the receiver as a parcel -without creating the parcel in the image. fullPathName is a directory/parcelName with no extension. If saveStructure is true, fill in the bundleStructure property with bundle/package contents. If saveLinks is true and saveStructure is true, then save the db links in the properties." | parcelDirectory shouldSaveLinks parcelName | shouldSaveLinks := saveLinksBoolean. saveLinksBoolean & self hasBeenModified ifTrue: [(Dialog confirm: (#UnpublishedModificationsMeanNoDBLinks << #packages >> '<t><1s> has unpublished modifications.<n>This means that database links will not be included.<ntttt>Continue?' expandMacrosWith: name)) ifFalse: [^self]. shouldSaveLinks := false]. parcelName := aFilename tail. parcelDirectory := aFilename directory. parcelDirectory exists ifFalse: [(Dialog confirm: (#CreateDirectory1s << #packages >> 'Create directory <1s>?' expandMacrosWith: parcelDirectory asString)) ifFalse: [^self]. parcelDirectory makeDirectory]. properties at: #bundleName put: self name; at: #parcelName put: parcelName. saveStructureBoolean ifTrue: [properties at: #bundleStructure put: (PundleForParcel from: self saveLinks: shouldSaveLinks)]. [self parcelOutTo: (parcelDirectory construct: parcelName , '.pcl') asString sourceFileName: (parcelDirectory construct: parcelName , '.pst') asString parcelOptions: aDictionary] ensure: [properties removeKey: #bundleStructure ifAbsent: [nil]; removeKey: #bundleName ifAbsent: [nil]]
</methods> <methods> Store.BundleModel <category>content management</category>
addComponent: aComponentDescription "Add a component to the receiver." | changed | changed := false. self databaseInfomationOrCreate. "force there to be at least one" self databaseInformationsDo: [ : info | changed := ( info addComponentDescription: aComponentDescription ) | changed. ]. changed & self shouldTrackChanges ifTrue: [ self addOtherChange: self structureMark. Registry changedBundleStructure: self. ].
allContentCollectionsDo: aBlock "Evaluate aBlock for all of the receiver's contents (ie. for all database connections)." dbInfo values do: [ :info | aBlock value: info contentDescriptions ].
anyContentDescriptions "Answer a collection of pundle descriptors for any database connection" dbInfo isEmpty ifTrue: [ ^#( ) ]. dbInfo size > 1 ifTrue: [ dbInfo removeKey: self noDbSymbol ifAbsent: nil ]. ^dbInfo values first contentDescriptions collect: [ :desc | desc copy id: nil; dbIdentifier: nil; yourself ].
component: aComponent beingRenamedTo: aString "Called by the registry which is about to rename a component contained in the receiver. Since it may be owned by other bundles as well, we are only updating internal information." self databaseInformationsDo: [ :info | info component: aComponent beingRenamedTo: aString ].
containedItems "Answer a collection of components." ^self contents asList reject: [ :c | c == nil ]
containedItems: aCollectionOfComponents "Set my contents to be aCollectionOfComponents." dbInfo isEmpty ifTrue: [ self databaseInformationForOrCreate: self noDbSymbol ]. self databaseInformationsDo: [ :info | info containedItems: aCollectionOfComponents ].
contentDescriptions "Answer a collection of pundle descriptors for the current/last database connection" | dbinfo | ^( dbinfo := self databaseInformation ) == nil ifTrue: [ self anyContentDescriptions ] ifFalse: [ dbinfo contentDescriptions ].
contentDescriptionsFor: aDatabaseId "Answer a collection of pundle descriptors for the specified database connection" | dbinfo | ^( dbinfo := self databaseInformationFor: aDatabaseId ) == nil ifTrue: [ #( ) ] ifFalse: [ dbinfo contentDescriptions ].
contents "Answer a collection of sub-components contained in the bundle" ^self contentDescriptions collect: [ :desc | desc component ]
</methods> <methods> Store.BundleModel <category>testing</category>
containsDescription: aDescr "Answer true if I or my sub-components contain aDescr ." self contentDescriptions do: [ :descr | ( ( descr describesSameAs: aDescr ) or: [ descr isBundle and: [ descr component containsDescription: aDescr ] ] ) ifTrue: [ ^true ] ]. ^false
containsItem: aPundle "Answer true if I contain aPundle." ^self contentDescriptions contains: [:aDescr | aPundle sameAsDescribedBy: aDescr ].
hasBeenModified "Answer true if the receiver or a subcomponent has been modified." ^self shouldTrackChanges and: [ self hasItselfBeenModified or: [ ( self contentDescriptions detect: [ :c | c hasBeenModified ] ifNone: [ nil ] ) ~~ nil ] ].
hasBeenModifiedIn: aDatabaseId "Answer true if the receiver or a subcomponent has been modified within a database." ^( super hasBeenModifiedIn: aDatabaseId ) or: [ ( self containedItems detect: [ :c | c hasBeenModifiedIn: aDatabaseId ] ifNone: [ nil ] ) ~~ nil ]
hasCodeOverridden "Answer true if the receiver has definitions overriden by other components." ^self leafItems contains: [ :pkg | pkg hasCodeOverridden ]
hasExtensions "Check if any of my components have been modifed." ^self leafItems contains: [:descr | descr hasExtensions]
isBundle ^true
isEmpty "Answer true if I do not contain any definitions. This method is used to distinguish newly created bundles from the existing ones." ^dbInfo isEmpty or: [ dbInfo values first contentDescriptions isEmpty ].
isLeaf ^self isEmpty
overridesSelf "Answer true if any of the receiver's contents override another." | subs | self hasCodeOverridden ifFalse: [ ^false ]. ( subs := self leafItems ) do: [ :pundle | pundle overrides do: [ :over | ( ( over getSources: over object ) contains: [ :current | subs includes: current ] ) ifTrue: [ ^true ] ] ]. ^false
</methods> <methods> Store.BundleModel <category>initialize-release</category>
setContentsFromDB: aDBBundle self databaseInformationOrCreate contentDescriptions: ( aDBBundle containedItems collect: [ :each | each asComponentDescription ] ). self databaseInformation fileDescriptions: ( aDBBundle files collect: [ :each | each asComponentDescription ] ). dbInfo removeKey: self noDbSymbol ifAbsent: nil. "now we be connected"
</methods> <methods> Store.BundleModel <category>private-repository storage</category>
fileContent "Convert my file descriptions into a collection of database components." ^self fileDescriptions collect: [ :each | each asDBDescription ]
</methods> <methods> Store.BundleModel <category>utilities-repository</category>
cleanUpOverrides self allContainedItems do: [ :each | each cleanUpOverrides ]
</methods> <methods> Store.BundleModel class <category>constants</category>
bundleIcon ^BundleIcon ifNil: [BundleIcon := ListIconLibrary visualFor: #bundle]
componentType "Answer a symbol representing the class of the receiver." ^#bundle
descriptionString "Answer a string for error messages." ^(#bundle << #packages >> 'bundle') asString
fileMark "Answer the symbol used to indicate that an external file has been added/removed/modified." "Should really be a real Change" ^#externalFile
structureMark "Answer the symbol used to indicate that the bundle structure has been modified." ^#bundleStructure
</methods> <methods> Store.BundleModel class <category>validation</category>
validateLoadOrder: packages "Examines NameSpace/Class prereqs to ensure that content list is in a valid order. Answer a string with errors, an empty string if none." | errorStream list count | list := OrderedCollection new: packages size. packages do: [ :pkg | pkg isPackage ifTrue: [ list add: pkg ] ifFalse: [ list addAll: pkg leafItems ] ]. errorStream := ( String new: 200 ) writeStream. count := 0. Cursor wait showWhile: [ 1 to: list size do: [ :index | | pkg prereqs | count >= 25 ifTrue: [ ^errorStream contents, '....more....' ]. "enough is enough" pkg := list at: index. prereqs := OrderedCollection new: 100. pkg definedClasses do: [ :cls | prereqs addAll: cls prerequisitesForLoading ]. pkg definedNameSpaces do: [ :ns | prereqs addAll: ns prerequisitesForLoading ]. prereqs addAll: ( pkg classesExtendedInPackage collect: [ :cm | cm actual ] ). prereqs addAll: ( pkg nameSpacesExtendedInPackage collect: [ :cm | cm actual ] ). prereqs := prereqs reject: [ :obj | obj isExternalDictionary ]. "can't check for it ...." 1 to: index do: [ :j | prereqs := prereqs reject: [ :obj | ( list at: j ) includesDefinitionOf: obj absoluteName ] ]. ( index + 1 ) to: list size do: [ :j | | bpkg | prereqs detect: [ :obj | ( ( bpkg := list at: j ) includesDefinitionOf: obj absoluteName ) ifFalse: [ false ] ifTrue: [ errorStream nextPutAll: pkg name, ' depends on ', obj name, ' in ', bpkg name; cr. count := count + 1. true ]. ] ifNone: [ ]. ] ] ]. ^errorStream contents.
</methods> <methods> Store.PackageModel <category>testing</category>
definesClass: aClass ^(self classModelAtClass: aClass ifAbsent: [^false]) hasDefinition
extendsClass: aClass ^(self classModelAtClass: aClass ifAbsent: [ ^false ] ) isExtension
hasBeenModified "Answer true if the receiver has been modified or has no dbTrace." ^self shouldTrackChanges and: [ self hasItselfBeenModified or: [ ( self dbTraceFor: self dbIdentifier ) == nil ] ].
hasDataKey: aSymbol in: aClassOrNameSpace "Answer true if the receiver owns the definition for aClassOrNameSpace.aSymbol, even if it has been overridden." ^( self includesDataKey: aSymbol owner: aClassOrNameSpace ) or: [ Override isOverriddenStatic: aSymbol in: aClassOrNameSpace in: self ]
hasDefinitionFor: aClassOrNameSpace "Answer true if the receiver owns the definition for aClassOrNameSpace, even if it has been overridden." ^( self includesSymbol: aClassOrNameSpace absoluteSymbol ) or: [ Override isOverriddenClassOrNameSpace: aClassOrNameSpace in: self ]
hasExtensions "Answer true if the receiver extends a class/namespace not in the package." models == nil ifTrue: [ ^false ]. ^( models detect: [ :model | model hasDefinition not ] ifNone: [ nil ] ) notNil
hasSelector: aSelector in: aClass "Answer true if the receiver owns the definition for aClass>>aSelector, even if it has been overridden." ^( self includesSelector: aSelector class: aClass ) or: [ Override isOverriddenSelector: aSelector class: aClass in: self ]
hasUninstalledCode "Borrowed from parcel. Currently only valid if there was a binary load." ^( ( properties at: #uninstalledClasses ifAbsent: nil ) size ~= 0 or: [ ( properties at: #uninstalledMethods ifAbsent: nil ) size ~= 0 ] ) or: [ ( properties at: #uninstalledBindings ifAbsent: nil ) size ~= 0 ]
includesClass: aClass ^(self classModelAtClass: aClass ifAbsent: [^false]) hasDefinition
includesClassNamed: anAbsoluteClassName "Answer true if the receiver owns a definition for anAbsoluteClassName, even if overridden." ( self classModelAtClassName: anAbsoluteClassName ifAbsent: [ ^self isClassOrNameSpaceNameOverridden: anAbsoluteClassName ] ) ifNotNil: [ :model | ^model hasDefinition ifTrue: [ true ] ifFalse: [ self isClassOrNameSpaceNameOverridden: anAbsoluteClassName ] ].
includesClassSymbol: aClassSymbol ^(self classModelAtClassSymbol: aClassSymbol ifAbsent: [^false]) hasDefinition
includesDataKey: dataKey nameSpace: namespace ^( self modelAtSymbol: namespace absoluteSymbol ifAbsent: [ ^false ] ) includesDataKey: dataKey
includesDataKey: dataKey nameSpaceName: aNameSpaceName ^( self modelAtName: aNameSpaceName ifAbsent: [ ^false ] ) includesDataKey: dataKey
includesDataKey: dataKey nameSpaceSymbol: nameSpaceSymbol ^(self modelAtSymbol: nameSpaceSymbol ifAbsent: [ ^false ] ) includesDataKey: dataKey
includesDataKey: dataKey owner: owner ^self includesDataKey: dataKey ownerSymbol: owner absoluteSymbol
includesDataKey: dataKey ownerName: aName ^( self modelAtName: aName ifAbsent: [ ^false ] ) includesDataKey: dataKey
includesDataKey: dataKey ownerSymbol: symbol ^( self modelAtSymbol: symbol ifAbsent: [ ^false ] ) includesDataKey: dataKey
includesDatum: aDataDescriptor "Answer true if the receiver contains a definition of aDataDescriptor. Since this is for package comparisons, include overrides." ^( self includesDataKey: aDataDescriptor dataKey ownerName: aDataDescriptor absoluteOwnerName ) or: [ Override isOverriddenStatic: aDataDescriptor dataKey in: aDataDescriptor owner in: self ]
includesMethod: aMethodDescriptor "Answer true if the receiver contains a definition of aMethodDescriptor. Since this is for package comparisons, include overrides." ^( self includesSelector: aMethodDescriptor selector className: aMethodDescriptor className asClassNameOnly meta: aMethodDescriptor isMeta ) or: [ Override isOverriddenSelector: aMethodDescriptor selector class: aMethodDescriptor implementingClass in: self ]
includesNameSpaceNamed: anAbsoluteName "Answer true if the receiver owns a definition for anAbsoluteName, even if overridden." ( self modelAtName: anAbsoluteName ifAbsent: [ ^self isClassOrNameSpaceNameOverridden: anAbsoluteName ] ) ifNotNil: [ :model | ^model hasDefinition ifTrue: [ true ] ifFalse: [ self isClassOrNameSpaceNameOverridden: anAbsoluteName ] ].
includesSelector: aSelector class: aClass ^(self classModelAtClass: aClass ifAbsent: [^false]) includesSelector: aSelector meta: aClass isMeta
includesSelector: aSelector className: aClassName meta: isMeta ^( self classModelAtClassName: aClassName ifAbsent: [ ^false ] ) includesSelector: aSelector meta: isMeta
includesSelector: aSelector classSymbol: aClassSymbol meta: isMeta ^(self classModelAtClassSymbol: aClassSymbol ifAbsent: [^false]) includesSelector: aSelector meta: isMeta
includesSymbol: aSymbol ^( self modelAtSymbol: aSymbol ifAbsent: [ ^false ] ) hasDefinition
isEmpty "Answer true if I do not contain any definitions. This method is used to distinguish newly created packages from the existing ones." ^models isEmpty
isLeaf ^true
isNullPackage ^name = Registry nullPackageName
isPackage ^true
</methods> <methods> Store.PackageModel <category>private-model</category>
addFullSymbol: fullSymbol "Add namespace/class." | model | model := self modelAtFullSymbol: fullSymbol hasDefinition: true. model hasDefinition ifFalse: [ self installModelAtFullSymbol: fullSymbol hasDefinition: true ]
addModel: classOrNameSpaceModel "Add a classOrNameSpaceModel to the package." models at: classOrNameSpaceModel absoluteSymbol put: classOrNameSpaceModel. Registry addModel: classOrNameSpaceModel.
addStatic: staticKey to: aClassOrNameSpace "Add aClassOrNameSpace.staticKey to the receiver." self addDataKey: staticKey symbol: aClassOrNameSpace absoluteSymbol .
definedModels models == nil ifTrue: [^OrderedCollection new]. ^(models select: [:model | model hasDefinition]) asOrderedCollection
descriptorClassFor: aSymbol ^aSymbol asStrictReference value isBehavior ifTrue: [ ClassDescriptor ] ifFalse:[ NameSpaceDescriptor ]
descriptorClassFor: aSymbol hasDefinition: hasDefinition ^aSymbol asStrictReference value isBehavior ifTrue: [ hasDefinition ifTrue: [ ClassDescriptor ] ifFalse: [ ClassExtensionDescriptor ] ] ifFalse: [ hasDefinition ifTrue: [ NameSpaceDescriptor ] ifFalse: [ NameSpaceExtensionDescriptor ] ]
extendedModels models == nil ifTrue: [^OrderedCollection new: 1]. ^(models reject: [:cm | cm hasDefinition]) asOrderedCollection
includesDefinitionOf: aName ^( self modelAtSymbol: aName asSymbol ifAbsent: [ ^false ] ) hasDefinition
installModelAtFullSymbol: aSymbol hasDefinition: hasDefinition "This is the ONLY place new models are created." "Cloning must occur before installation." | newModel oldModel | newModel := ( self modelClassFor: aSymbol hasDefinition: hasDefinition ) package: self fullSymbol: aSymbol. ( oldModel := self modelAtSymbol: aSymbol ifAbsent: [ nil ] ) notNil ifTrue: [ newModel cloneFrom: oldModel. self removeModel: oldModel ]. self addModel: newModel. ^newModel
modelAtFullSymbol: fullSymbol hasDefinition: hasDefinition "Return the namespace/class model for the fully qualified symbol. If one does not exist create one. 'hasDefinition' is a hint that it is known that the namespace/class's definition is in this package." ^models at: fullSymbol ifAbsent: [ self installModelAtFullSymbol: fullSymbol hasDefinition: hasDefinition ].
modelAtName: string ifAbsent: absentBlock ^models at: string asSymbol ifAbsent: absentBlock.
modelAtSymbol: symbol ifAbsent: absentBlock ^models at: symbol ifAbsent: absentBlock.
modelClassFor: aSymbol hasDefinition: hasDefinition ^aSymbol asStrictReference value isBehavior ifTrue: [ hasDefinition ifTrue: [ DefClassModel ] ifFalse: [ ExtensionClassModel ] ] ifFalse: [ hasDefinition ifTrue: [ DefNameSpaceModel ] ifFalse: [ ExtensionNameSpaceModel ] ]
modelsDo: aBlock models == nil ifTrue: [ ^self ]. models do: aBlock
removeDataKey: dataKey ownerSymbol: symbol "remove the data from package." ( self modelAtSymbol: symbol ifAbsent: [ ^self ] ) removeDataKey: dataKey
removeModel: model models removeKey: model absoluteSymbol ifAbsent: nil. Registry removeModel: model named: model absoluteSymbol
removeStatic: staticKey from: aClassOrNameSpace "Remove aClassOrNameSpace.staticKey from the receiver." self removeDataKey: staticKey ownerSymbol: aClassOrNameSpace absoluteSymbol
</methods> <methods> Store.PackageModel <category>private-class model</category>
addClassModel: classModel "Add a classModel to the package." self addModel: classModel
classModelAtClass: aClass hasDefinition: hasDefinition "Return the class model for the class 'aClass'. If one does not exist create one. 'hasDefinition' is a hint that it is known that the class's definition is in this package." | class | class := aClass isMeta ifTrue: [aClass soleInstance] ifFalse: [aClass]. ^self modelAtFullSymbol: class absoluteSymbol hasDefinition: hasDefinition
classModelAtClass: aClass ifAbsent: absentBlock ^self classModelAtClassSymbol: aClass instanceBehavior absoluteSymbol ifAbsent: absentBlock.
classModelAtClassName: className hasDefinition: hasDefinition "Return the class model for the class 'aClass'. If one does not exist create one. 'hasDefinition' is a hint that it is known that the class's definition is in this package." ^self classModelAtClassSymbol: className asClassNameOnly asSymbol hasDefinition: hasDefinition
classModelAtClassName: aClassName ifAbsent: absentBlock | model | model := self classModelAtClassSymbol: aClassName asClassNameOnly asSymbol ifAbsent: absentBlock. ^model isForClass ifTrue: [ model ] ifFalse: [ absentBlock value ]
classModelAtClassNamed: aClassName ifAbsent: absentBlock ^self classModelAtClassSymbol: aClassName asClassNameOnly asSymbol ifAbsent: absentBlock
classModelAtClassSymbol: fullClassSymbol hasDefinition: hasDefinition "Return the class model for the class 'aClass'. If one does not exist create one. 'hasDefinition' is a hint that it is known that the class's definition is in this package." ^models at: fullClassSymbol ifAbsent: [ self installClassModelAtFullClassSymbol: fullClassSymbol hasDefinition: hasDefinition ].
classModelAtClassSymbol: classSymbol ifAbsent: absentBlock ^models at: classSymbol ifAbsent: absentBlock.
classModels models == nil ifTrue: [^OrderedCollection new]. ^(models select: [:model | model isClassModel]) asOrderedCollection
classModelsDo: aBlock models == nil ifTrue: [ ^self ]. models do: [ :model | model isClassModel ifTrue: [ aBlock value: model ] ]
definedClassModels models == nil ifTrue: [^OrderedCollection new]. ^(self classModels select: [:cm | cm hasDefinition]) asOrderedCollection
extendedClassModels models == nil ifTrue: [^OrderedCollection new: 1]. ^(self classModels reject: [:cm | cm hasDefinition]) asOrderedCollection
extendedNameSpaceModels models == nil ifTrue: [^OrderedCollection new: 1]. ^(self nameSpaceModels reject: [:model | model hasDefinition]) asOrderedCollection
installClassModelAtFullClassSymbol: aClassSymbol hasDefinition: hasDefinition "This is the ONLY place new class models are created." "Cloning must occur before installation." | newCm oldCm | newCm := (hasDefinition ifTrue: [DefClassModel] ifFalse: [ExtensionClassModel]) package: self fullClassSymbol: aClassSymbol. oldCm := self classModelAtClassSymbol: aClassSymbol ifAbsent: [ nil ]. oldCm notNil ifTrue: [ newCm cloneFrom: oldCm. self removeClassModel: oldCm ]. self addClassModel: newCm. ^newCm
removeClassModel: cm self removeModel: cm
removeWholeSymbol: symbol "Remove a definition model and all methods/datakeys defined wherein This methods removes both class and metaclass." self removeModel: ( self modelAtSymbol: symbol ifAbsent: [ ^self ] )
renameClassModel: cm as: newName self removeClassModel: cm. cm className: newName. self addClassModel: cm
renameModel: cm as: newName self removeModel: cm. cm fullName: newName. self addModel: cm
</methods> <methods> Store.PackageModel <category>private-namespace model</category>
addObject: aNameSpace "This is for polymorphism with Parcels." aNameSpace isNameSpace ifFalse: [self error: #invalidObjectType << #dialogs >> 'invalid object type']. XChangeSet current addNameSpaceDefinition: aNameSpace toPackage: self
dataForNameSpaceName: nameSpaceName ^( self modelAtSymbol: nameSpaceName ifAbsent: [ ^ OrderedCollection new: 0 ] ) dataKeys asOrderedCollection
definedNameSpaceModels models == nil ifTrue: [^OrderedCollection new]. ^(self nameSpaceModels select: [:model | model hasDefinition]) asOrderedCollection
nameSpaceModels models == nil ifTrue: [ ^OrderedCollection new ]. ^models select: [ :model | model isNameSpaceModel ]
nameSpaceModelsDo: aBlock models == nil ifTrue: [ ^self ]. models do: [ :model | model isNameSpaceModel ifTrue: [ aBlock value: model ] ]
removeDefinitionFullNameSpaceSymbol: symbol "Remove a namespace definition." | model | model := self modelAtSymbol: symbol ifAbsent: [ ^self ]. model hasDefinition ifTrue: [ model := self installModelAtFullSymbol: model absoluteSymbol hasDefinition: false ]. model isEmpty ifTrue: [ self removeModel: model ]
</methods> <methods> Store.PackageModel <category>private-class model changes</category>
addClass: class "Add a class to myself." XChangeSet current addClassDefinition: class toPackage: self
addDataKey: dataKey symbol: symbol "add the data into package." ( self modelAtFullSymbol: symbol hasDefinition: false ) addDataKey: dataKey
addFullClassSymbol: fullClassSymbol "Add class." | cm | cm := self modelAtFullSymbol: fullClassSymbol hasDefinition: true. cm hasDefinition ifFalse: [self installClassModelAtFullClassSymbol: cm fullClassSymbol hasDefinition: true. self recompileMethodsFor: cm].
addName: dataKey in: anObject "For parcel compatibility during binary loading." (Override isOverriddenStatic: dataKey in: anObject) ifTrue: [anObject isBehavior ifTrue: [XChangeSet current changeDataKey: dataKey class: anObject package: self] ifFalse: [XChangeSet current changeDataKey: dataKey nameSpace: anObject package: self]] ifFalse: [anObject isBehavior ifTrue: [XChangeSet current addDataKey: dataKey class: anObject package: self] ifFalse: [XChangeSet current addDataKey: dataKey nameSpace: anObject package: self]]
addSelector: aSymbol class: aBehavior "Add the selector aSymbol for aBehavior to myself." "Used during binary load." (Override isOverriddenSelector: aSymbol class: aBehavior) ifTrue: [XChangeSet current changeSelector: aSymbol class: aBehavior toPackage: self] ifFalse: [XChangeSet current addSelector: aSymbol class: aBehavior toPackage: self]
addSelector: aSymbol fullClassSymbol: fullClassSymbol meta: meta "add the method into package." (self modelAtFullSymbol: fullClassSymbol hasDefinition: false) addSelector: aSymbol meta: meta
addSelector: selector toClass: aClass "Add aClass>>selector to the receiver." XChangeSet current moveSelector: selector class: aClass toPackage: self
addSelectors: aCollection forClass: aBehavior "Add all of the selectors for aBehavior in aCollection to myself." aCollection do: [:selector | self addSelector: selector class: aBehavior]
markModificationAsRemoves: aCollectionOfDefinitions "Give a collection of modification modify the package change set to contian removes of all definitons." | cs tags | cs := self changeSet. tags := aCollectionOfDefinitions collect: [:mod| mod tag]. tags := tags reject: [:tag | tag isCommentTag or: [tag isClassTag and: [tag isMeta]]]. tags do: [ :tag | | removeChange | removeChange := tag asChange. tag isClassTag | tag isNameSpaceTag ifTrue: [ removeChange removeDefinition. cs doChange: removeChange ] ifFalse: [ tag isComponentTag ifTrue: [ removeChange remove ] ifFalse: [ tag isSubdefTag ifTrue: [ removeChange meta: tag isMeta. removeChange remove. tag isDataTag ifTrue: [ removeChange dataKey: tag dataKey ]. tag isMethodTag ifTrue: [ removeChange selector: tag selector ]. cs doSubdefChange: removeChange ] ifFalse: [ self error: (#WrongModificationType << #packages >> 'Wrong modification type.') ] ] ] ]
removeDefinitionFullClassSymbol: classSymbol "Remove a class definition." | cm | cm := self classModelAtClassSymbol: classSymbol ifAbsent: [ | symbol obj | symbol := ('* class' match: classSymbol) ifTrue: [classSymbol asClassNameOnly] ifFalse: [classSymbol]. obj := symbol asQualifiedReference ifDefinedDo: [ :value | value ] elseDo: [ ^self ]. ^Override removeOverridesForClassOrNameSpaceDefinition: obj in: self]. cm hasDefinition ifTrue: [ cm := self installClassModelAtFullClassSymbol: cm fullClassSymbol hasDefinition: false ]. cm isEmpty ifTrue: [ self removeClassModel: cm ] ifFalse: ["There are methods left which are now extensions" self recompileMethodsFor: cm].
removeWholeClassSymbol: classSymbol "Remove a class definition and all methods defined in a class. This methods removes both class and metaclass." self removeClassModel: (self classModelAtClassSymbol: classSymbol ifAbsent: [^self])
</methods> <methods> Store.PackageModel <category>printing</category>
classDescription "Answer a string for describing the class." ^(#Package << #packages >> 'Package') asString
displayString "Answer the string to be displayed for a package in a Package list." | stream | stream := WriteStream on: ( String new: 32 ). stream nextPutAll: self name. self hasBeenModified ifTrue: [ stream nextPutAll: ' *' ]. self hasExtensions ifTrue: [ stream nextPutAll: ' +' ]. self hasCodeOverridden ifTrue: [ stream nextPutAll: ' -' ]. ^stream contents
printOn: aStream aStream nextPut: $[; nextPutAll: (name isNil ifTrue: [(#unnamed << #packages >> '*unnamed*') asString] ifFalse: [name]); nextPut: $].
</methods> <methods> Store.PackageModel <category>private-descriptors</category>
affectedClassNamesMeta: meta "Answer a collection of changed class name symbols." "Note that this is only called when comparing dbs, so the changeset must have already been validated." ^self isChangeSetEmpty ifTrue: [OrderedCollection new] ifFalse: [self changeSet affectedClassNamesMeta: meta]
affectedNameSpaceNames "Answer a collection of changed namespace name symbols." "Note that this is only called when comparing dbs, so the changeset must have already been validated." ^self isChangeSetEmpty ifTrue: [ OrderedCollection new ] ifFalse: [ self changeSet affectedNameSpaceNames ]
modifiedAndReorganizedMethodDescriptors | methods | self isChangeSetEmpty ifTrue: [^OrderedCollection new]. methods := self changeSet modifiedMethodDescriptors. methods addAll: self reorganizedMethodDescriptors. ^methods asSet asOrderedCollection
modifiedDatumDescriptors ^self isChangeSetEmpty ifTrue: [OrderedCollection new] ifFalse: [self changeSet modifiedDatumDescriptors]
removedClassOrDefinitionNames "Answer a collection of class names that have been removed from the receiver." ^self isChangeSetEmpty ifTrue: [ Array new ] ifFalse: [ self changeSet removedClassOrDefinitionNames ]
removedDatumDescriptors ^self isChangeSetEmpty ifTrue: [Array new] ifFalse: [self changeSet removedDatumDescriptors]
removedMethodDescriptors ^self isChangeSetEmpty ifTrue: [Array new] ifFalse: [self changeSet removedMethodDescriptors]
removedNameSpaceOrDefinitionNames ^self isChangeSetEmpty ifTrue: [Array new] ifFalse: [self changeSet removedNameSpaceOrDefinitionNames]
</methods> <methods> Store.PackageModel <category>queries</category>
definedBindings "Answer a dictionary of bindings (NameSpace/Class to datakey) contained in the receiver." "Note- duplicates Parcel format." | bindings keys | bindings := IdentityDictionary new. self modelsDo: [ :model | ( keys := model dataKeys ) size > 0 ifTrue: [ bindings at: model actual put: ( IdentitySet withAll: keys ) ] ]. ^bindings.
definedBindingsFor: aClassOrNameSpace "Answer an Array of bindings." ^( self modelAtName: aClassOrNameSpace absoluteName ifAbsent: [ ^#() ] ) dataKeys collect: [ :key | aClassOrNameSpace bindingFor: key ]
definedClasses "Answer a collection of all Classes whose definition is contained in the receiver." ^self classesDefinedInPackage collect: [ :each | each actual ].
definedClassesDo: aBlock self classModelsDo: [ :model | model hasDefinition ifTrue: [ aBlock value: model actual ] ].
definedNameSpaces "Answer a collection of all NameSpaces whose definition is contained in the receiver." ^self nameSpacesDefinedInPackage collect: [ :each | each nameSpace ].
definedObjectsDo: aBlock ^self definedNameSpaces do: aBlock
definedSelectorsFor: aBehavior "Answer an Array of selectors." ^( self modelAtName: aBehavior absoluteName asClassNameOnly ifAbsent: [ ^#() ] ) selectorsMeta: aBehavior isMeta
definesClassOrNameSpace: aClassOrNameSpace ^self includesSymbol: aClassOrNameSpace absoluteName asSymbol
definesName: key in: nameSpace ^self includesDataKey: key owner: nameSpace
definesObject: aNameSpace | theNameSpacesAbsoluteName | theNameSpacesAbsoluteName := aNameSpace absoluteName. self nameSpaceModelsDo: [:model | (model hasDefinition and: [model absoluteName = theNameSpacesAbsoluteName]) ifTrue: [^true]]. ^false
definesSelector: aSelector forClass: aBehavior | model | model := self classModelAtClassSymbol: aBehavior instanceBehavior absoluteSymbol ifAbsent: nil. ^model ~~ nil and: [model includesSelector: aSelector meta: aBehavior isMeta]
</methods> <methods> Store.PackageModel <category>accessing browser</category>
allClasses "Return a Collection of ClassDescriptor objects for all classes that are defined in the package and extension descriptors for classes for which only methods are defined." | list overs | list := self classesDefinedInPackage, self classesExtendedInPackage. overs := ( ( Override overridesForComponent: self ) select: [ : over | ( over isForClass | over isForMethod ) | ( over isForGeneral and: [ over owner isForClass ] ) ] ) collect: [ :over | over asPseudoRecord ]. ( list := list asSet ) addAll: overs. ^list asOrderedCollection
allMetaclasses "Answer a collection of class names. The collection contains names for classes that are defined in the package and names of classes for which methods are defined" | list overs | list := self metaclassesDefinedInPackage, self metaclassesExtendedInPackage. overs := ( ( Override overridesForComponent: self ) select: [ : over | over isForClass ] ) collect: [ :over | over asPseudoRecord meta: true ]. list addAll: overs asSet asOrderedCollection. ^list
allNameSpaces "Returns a Set of NameSpaceDescriptor objects for all for name spaces that are defined in the package and extension descriptors for name spaces for which only data is defined." | list overs | list := self nameSpacesDefinedInPackage, self nameSpacesExtendedInPackage. overs := ( ( Override overridesForComponent: self ) select: [ : over | over isForNameSpace | ( over isForGeneral and: [ over owner isForNameSpace ] ) ] ) collect: [ :over | over asPseudoRecord ]. ( list := list asSet ) addAll: overs. ^list asOrderedCollection
</methods> <methods> Store.PackageModel <category>consistency checking</category>
makeConsistent self isChangeSetEmpty ifFalse: [ self changeSet makeConsistentForPackage: self ].
</methods> <methods> Store.PackageModel <category>private-file out</category>
createOrFindExpression "Answer a string that when evaluated will instantiate the receiver - creating, if neccessary." ^'( Store.Registry packageNamedOrCreate: ', self name printString, ' ) '.
fileOutChangesForDb: dbid on: aFileManager within: aBundle | info commentString | ( info := self databaseInformationFor: dbid ) == nil ifTrue: [ ^self ]. info isChangeSetEmpty ifTrue: [ ^self ]. commentString := ((#PackageChangesFor1s << #packages >> 'Package Changes for <1s>') expandMacrosWith: self itemString). MessageNotification raiseSignal: commentString. aFileManager addComment: commentString. ( ( UISettings preferenceFor: #fileoutOption ) == #never ) ifFalse: [ aFileManager sourceFormatter attributeFor: #package compute: [ : obj | self name ]; attributeForMethods: #package compute: [ :cls :sel | self name ]. self fileOutChangedPropertiesForDb: dbid on: aFileManager. ]. info changeSet fileOutOn: aFileManager within: aBundle.
fileOutClassesOn: aFileManager "New classes or classes with new definitions." | cset | cset := self classesDefinedInPackage collect: [ :each | each myClass ]. cset := cset reject: [ :c | c == nil ]. cset addAll: self overriddenClasses. cset := SystemUtils sortForLoading: cset. cset do: [ :each | each fileOutDefinitionOn: aFileManager. each fileOutCommentOn: aFileManager. IncrementNotification raiseSignal. ].
fileOutDataOn: aFileManager "File-out data for every namespace/class. Order is not important." self modelsDo: [ :model | model datumDescriptors do: [ :dd | dd fileOutOn: aFileManager. aFileManager cr. IncrementNotification raiseSignal. ]. aFileManager cr. ]. self overriddenStatics do: [ :dd | dd fileOutOn: aFileManager. aFileManager cr. ].
fileOutMethodsOn: aFileManager "First group methods by class and protocol and the ask aFileManager to do the job class by class" | toFileOut byClass byProtocol | toFileOut := Dictionary new. self methods do: [ :each | byClass := toFileOut at: each implementingClass ifAbsent: [ Dictionary new ]. byProtocol := byClass at: each protocolName ifAbsent: [ Set new ]. byProtocol add: each. byClass at: each protocolName put: byProtocol. toFileOut at: each implementingClass put: byClass. ( each selector = #initialize and: [ each implementingClass isMeta] ) ifTrue: [ aFileManager initializeThisClass: each implementingClass instanceBehavior ] ]. ( self sortForFileout: toFileOut keys ) do: [ :cls | | dict | dict := toFileOut at: cls. aFileManager fileOutTTMessages: dict for: cls fullName logging: false. aFileManager cr. IncrementNotification signalWith: ( dict inject: 0 into: [ :s :c | s + c size ] ) ].
fileOutNameSpacesOn: aFileManager "New namespaces or namespaces with new definitions." | cset | cset := self nameSpacesDefinedInPackage collect: [ :each | each nameSpace ]. cset addAll: self overriddenNameSpaces. cset size > 0 ifFalse: [ ^self ]. cset := SystemUtils sortForLoading: cset. cset do: [ :each | each fileOutDefinitionOn: aFileManager. each fileOutCommentOn: aFileManager. IncrementNotification raiseSignal. ].
fileOutOn: aFileManager "File out package on aFileManager" | commentString | commentString := ((#Package1s << #packages >> 'Package <1s>') expandMacrosWith: self itemString). MessageNotification raiseSignal: commentString. aFileManager addComment: commentString. ( ( UISettings preferenceFor: #fileoutOption ) == #never ) ifFalse: [ aFileManager sourceFormatter attributeFor: #package compute: [:obj | self name ]; attributeForMethods: #package compute: [:cls :sel | self name ]. self fileOutPropertiesOn: aFileManager. ]. self fileOutNameSpacesOn: aFileManager. self fileOutClassesOn: aFileManager. self fileOutDataOn: aFileManager. self fileOutMethodsOn: aFileManager. IncrementNotification raiseSignal. aFileManager cr
sortForFileout: classes "Sort classes based on package inclusion in addition to normal sort." | in out | in := OrderedCollection new. out := OrderedCollection new. ( SystemUtils metaclassesFirst: ( SystemUtils sortForLoading: classes ) ) do: [ :cls | ( self includesDefinitionOf: cls instanceBehavior absoluteName ) ifTrue: [ in add: cls ] ifFalse: [ out add: cls ]. ]. ^in, out
</methods> <methods> Store.PackageModel <category>initialize-release</category>
initialize super initialize. models := IdentityDictionary new.
release models notNil ifTrue: [ models copy do: [ :model | self removeModel: model ] ]. models := IdentityDictionary new. Registry removePackage: self
</methods> <methods> Store.PackageModel <category>unloading</category>
preUnloadChecks "Do checks for uses of classes in package." ObjectMemory globalGarbageCollect. ^self preUnloadChecksFromBundle: nil
preUnloadChecksFromBundle: aBundle | probSubclass probExtensions bundles bndls | probSubclass := Set new. probExtensions := Set new. bundles := Set new. bndls := Registry enclosingComponentsFor: self. aBundle notNil ifTrue: [ bndls remove: aBundle ifAbsent: [ aBundle allContainedItems do: [ :b | bndls remove: b ifAbsent: [] ] ]. ]. bndls do: [:bndl | ( bndl = aBundle ) ifFalse: [ bundles add: bndl name ] ]. self classModelsDo: [ :cm | | pkgClass | pkgClass := [ cm actualClass ] on: UnloadedObjectError do: [ :e | Warning raiseSignal: e description. e return: nil ]. ( ( pkgClass ~~ nil and: [ cm hasDefinition ] ) and: [ ( Override isOverriddenClassOrNameSpace: cm actual ) not ] ) ifTrue: [ pkgClass allSubclasses , (Array with: pkgClass) do: [ :sclass | | scm | scm := self classModelAtClass: sclass ifAbsent: [ nil ]. ( ( scm isNil or: [ scm isExtension ] ) and: [ ( aBundle notNil and: [aBundle definedClasses includes: sclass] ) not ] ) ifTrue: [ probSubclass add: ((#ancestorIsToBeUnloaded << #packages >> '<1s> (its ancestor <2s> is in the package to be unloaded)') expandMacrosWith: sclass name with: cm name) ] ifFalse: [ ( Registry extensionClassModelsForClassSymbol: sclass absoluteSymbol ) do: [ :ecm | ecm classNameAndSelectorDo: [ :className :selector | ( aBundle == nil or: [ ( aBundle leafItems includes: ecm package ) not ] ) ifTrue: [ probExtensions add: ((#methodIsExtension << #packages >> '<1s>%>%><2s> (an extension in package "<3s>")') expandMacrosWith: className with: selector with: ecm package name) ] ] ] ]. ] ] ]. (self unloadProblemsQuery: bundles header: ((#UnloadingPackageWillModifyBundles << #packages >> 'The package to be unloaded, "<1s>", is contained in the bundles<n>listed below. Proceeding will modify these bundles.') expandMacrosWith: self name)) ifFalse: [^false]. (self unloadProblemsQuery: probSubclass header: ((#UnloadingPackageWillRemoveClasses << #packages >> 'Proceeding will remove the following classes which are not in "<1s>", the package to be unloaded:') expandMacrosWith: self name)) ifFalse: [^false]. (self unloadProblemsQuery: probExtensions header: ((#UnloadingPackageWillRemoveMethods << #packages >> 'Proceeding will remove the following methods which are not in <n>"<1s>", the package to be unloaded:') expandMacrosWith: self name)) ifFalse: [^false]. ^self shouldTrackChanges ifTrue: [ self checkChangeSet ] ifFalse: [ true ].
preUnloadChecksThorough "Do extensive check for uses of classes in package." " ******* out of date, but keep for logic ************ | problems cmeths | problems := SortedCollection new. Cursor execute showWhile: [classes do: [:className | | classAssoc classSym | classSym := className asSymbol. classAssoc := Smalltalk associationAt: classSym. classAssoc value subclasses do: [:class | (self includesClassNamed: class name asString) ifFalse: [problems add: class name , ' is a subclass of ' , className]]. Smalltalk allBehaviorsDo: [:class | (self includesClassNamed: class name) ifFalse: [| list | list := class whichSelectorsReferTo: classAssoc. list size > 0 ifTrue: [list do: [:sel | (self includesSelector: sel class: class) ifFalse: [problems add: class name , '>>' , sel , ' uses ' , className]]]]]. cmeths := classToSelectors at: classSym ifAbsent: [Set new]. classAssoc value selectors do: [:sel | (cmeths includes: sel) ifFalse: [problems add: className , '>>' , sel , ' is an extension from ' , (PackageModel containingPackageForSelector: sel class: classAssoc value) name]]]]. ^self unloadProblemsQuery: problems ********************* "
runRearguard "Check if this package can be safetly unloaded from the image." ^true
systemRemoveSelector: aSymbol fromClass: aClass "Remove the message whose selector is aSymbol from the method dictionary of the receiver, if it is there. Answer nil otherwise." "RGF 8/5/94 Bernstein: Based on 'ClassDescription>>removeSelector:' and 'Behavior>>removeSelector:'. Changed to remove write to changes file. Notification of change set also removed." (aClass includesSelector: aSymbol) ifFalse: [^nil]. aClass removeSelectorSimply: aSymbol. aClass organization removeElement: aSymbol.
unloadFromImage "Remove content of a package from the image. Answer true if the operation has succeeded." self cleanse. Cursor execute showWhile: [ self runPreUnload ifFalse: [ ^false ]. self preUnloadChecks ifFalse: [ ^false ]. self doUnloadFromImage]. ^true
unloadLogged: log self unloadFromImage ifTrue: [ ChangeSet unloadComponent: self. SourceFileManager default unloadComponent: self. ].
unloadSourceSafely (properties at: #sourceIndex ifAbsent: nil) ifNotNil: [:sourceIndex | (SourceFileManager default) rescueOrphanedSourcesAt: sourceIndex excluding: Set new; discardSourceAt: sourceIndex]
</methods> <methods> Store.PackageModel <category>accessing</category>
actualClassInPackageNamed: aClassName ^(self classModelAtClassName: aClassName ifAbsent: [^nil]) actualClass
allDefinedClasses "Answer a collection of classes that are defined in the receiver including those overridden." | list overs | list := self classesDefinedInPackage collect: [ :cd | cd actual ]. overs := ( ( Override overridesForComponent: self ) select: [ : over | over isForClass ] ) collect: [ :over | over object ]. ( list := list asSet ) addAll: overs. list remove: nil ifAbsent: nil. ^list asOrderedCollection
classInPackageNamed: aClassName ^(self includesClassNamed: aClassName) ifTrue: [ClassDescriptor fullName: aClassName meta: false] ifFalse: [nil]
classInPackageNamed: aClassName meta: aBoolean ^(self includesClassNamed: aClassName) ifTrue: [ClassDescriptor fullName: aClassName meta: aBoolean] ifFalse: [nil]
data "Returns a Collection of DatumDescriptor objects, for every shared variable defined in the package. These may be either shared variables that belong to a name space, or to a class." | dd | dd := OrderedCollection new. self nameSpaceModelsDo: [:cm | dd addAll: cm datumDescriptors]. self classModelsDo: [:cm | dd addAll: cm datumDescriptors]. ^dd
dataAsArray "Answer a collection of DatumDescriptors." "This method is used for the DB package creation." ^self data addAll: self overriddenStatics; yourself.
dataInstances "Returns the actual instances associated to the class/key pairs" ^self data collect: [:dd | dd fullName asStrictReference valueOrDo: [nil]]
dataWithSource "For the image model this is the same as data." ^self dataAsArray.
environmentFor: aStoreMethod ^aStoreMethod environment isNil ifTrue: [self environmentFor: aStoreMethod selector in: aStoreMethod implementingClass] ifFalse: [aStoreMethod environment valueOrDo: [nil]]
environmentFor: aSelector in: aClass "Return the environment for the method in question. If we should not define its scope, return nil" (self includesDefinitionOf: aClass instanceBehavior absoluteName) ifTrue: [^nil]. aClass compiledMethodAt: aSelector ifAbsent: [^self environment]. ^self environment.
inPackageNamed: aName "Answer a descriptor for the class/namespace aName" ^( self includesDefinitionOf: aName) ifTrue: [ ( self descriptorClassFor: aName ) fullName: aName ] ifFalse: [ nil ]
itemCount "Answer a count of work to be done. For now, count yourself + models." ^self methods size + self data size + models size + 1.
methods "Returns a Collection of MethodDescriptor objects, for every method defined in the package." | meth | meth := OrderedCollection new. self classModelsDo: [:cm | meth addAll: (cm methodsMeta: false). meth addAll: (cm methodsMeta: true)]. meth addAll: self overriddenMethods. ^meth
methodsAsArray "Answer a collection of method descriptors and overridden methods." "This method is used for the DB package creation." ^self methods
methodsWithSource "For image model same as methods since sources are already loaded." "Only called during package comparison, so includes overrridden methods" ^self methodsAsArray.
nameSpaceInPackageNamed: aName ^( self includesNameSpaceNamed: aName ) ifTrue: [ NameSpaceDescriptor fullName: aName ] ifFalse: [ nil ]
pundleListIconKey ^self selectIconKeyDefault: #package modified: #modifiedPackage noDBdefault: #packageNoDB modified: #modifiedPackageNoDB
removeMethodDescriptor: aMethod "Remove aMethod from a collection of methods defined in the package." | cm | cm := self classModelAtClassName: aMethod className ifAbsent: [^self]. cm removeSelector: aMethod selector meta: aMethod className namesMetaClass. cm isEmpty ifTrue: [self removeClassModel: cm] .
</methods> <methods> Store.PackageModel <category>private-differences calculation</category>
classesNamed: aSetOfNames "Convert aSetOfnames into a collection of ClassDescriptor or ClassExtensionDescriptors." | names selected | names := aSetOfNames copy. selected := SortedCollection sortBlock: [:x :y | x name < y name]. self classesDefinedInPackage do: [ :cl | (names includes: cl absoluteName) ifTrue: [ names remove: cl absoluteName. selected add: cl ] ]. self metaclassesDefinedInPackage do: [ :cl | (names includes: cl absoluteName, ' class') ifTrue: [names remove: cl absoluteName, ' class'. selected add: cl] ]. names do: [ :nm| selected add: ( ClassExtensionDescriptor fullName: nm meta: false ) ]. ^selected
modificationsFor: dbid "Answer my content as a collection of modifications." ^self basicModificationsFor: dbid
nameSpacesNamed: aSetOfNames "Convert aSetOfnames into a collection of NameSpaceDescriptor or NameSpacesExtensionDescriptors." | names selected | names := aSetOfNames copy. selected := SortedCollection sortBlock: [:x :y | x name < y name]. self nameSpacesDefinedInPackage do: [ :ns | (names includes: ns absoluteName) ifTrue: [ names remove: ns absoluteName. selected add: ns ] ]. names do: [:nm| selected add: ((NameSpaceExtensionDescriptor new) fullName: nm; yourself)]. ^selected
</methods> <methods> Store.PackageModel <category>private</category>
checkUndeclared self cleanse. ( models includesKey: Undeclared absoluteSymbol ) ifFalse: [ ^true ]. Undeclared purgeUnusedBindings. ^( models at: Undeclared absoluteSymbol ifAbsent: [ ^true ] ) dataKeys isEmpty
cleanse "Cleanse the component. Remove any class or method definitions that are no longer in the system, including the postLoadMethod." self cleanse: true.
cleanse: warn "Cleanse the component. Remove any class or method definitions that are no longer in the system, including the postLoadMethod." | warnBlock | warnBlock := [ :str | warn ifTrue: [ Transcript show: ((#nRemovingNonexistant1s << #packages >> '<n>Removing non-existant <1s>') expandMacrosWith: str) ] ]. models keys do: [ :key | key asStrictReference isDefined ifFalse: [ warnBlock value: key. models removeKey: key. ]. ]. self extendedClassModels do: [ :model | model classAndSelectorDo: [ :cls :selector | cls compiledMethodAt: selector ifAbsent: [ warnBlock value: ((#x1s2s << #packages >> '<1s>%>%><2s>') expandMacrosWith: cls fullName with: selector). model removeSelector: selector meta: cls isMeta ] ]. model classAndDataKeyDo: [ :cls :key | ( cls includesDataKey: key ) ifFalse: [ warnBlock value: (cls fullName, '.', key). model removeDataKey: key ] ] ]. self extendedNameSpaceModels do: [ :model | model nameSpaceAndDataKeyDo: [ :ns :key | ( ns includesDataKey: key ) ifFalse: [ warnBlock value: (ns fullName, '.', key). model removeDataKey: key ] ] ]. models copy do: [ :m | m isEmpty ifTrue: [ self removeModel: m ] ]
descriptionClass ^PackageDescription
doUnloadDefinitionsFromImage "Remove the receiver'ss defined classes and namespaces from the image. Answer true if the operation has succeeded." | mlist | mlist := [ self definedModels collect: [:cm | cm actual ] ] on: UnloadedObjectError do: [ :e | Warning raiseSignal: e description. e resume ]. mlist := SystemUtils sortForLoading: ( mlist reject: [ :cm | cm == nil ] ). mlist reverseDo: [ :obj | | change | change := Change new removeChanges actual: obj. Override unloadClassOrNameSpace: obj from: self. XChangeSet current doChange: change ]. ^true
doUnloadExtensionsFromImage "Remove the class/namespace extensions of a package from the image. Answer true if the operation has succeeded." | affectedClasses | affectedClasses := Set new. XMainChangeSet ignoreMainChangesWhile: [ self extendedModels do: [ :model | model unloadAllDataKeys. model isForClass ifTrue: [ affectedClasses addAll: ( model unloadAllSelectors) ]. ] ]. affectedClasses do: [ :aClass | aClass instanceMethodsChanged ]. ^true
doUnloadFromImage "Remove content of a package from the image. Answer true if the operation has succeeded." Transcript cr; show: ((#UnloadingPackageC1s << #packages >> 'Unloading package: <1s>') expandMacrosWith: self name printString). self doUnloadExtensionsFromImage. self doUnloadDefinitionsFromImage. self doUnloadExtensionsFromImage. "in case classes were restored and we now own extensions." self release. Smalltalk organization removeEmptyCategories. Override removeOverridesForComponent: self. Override cleanseLists. self runPostUnload. self cleanseRelatedParcel. self unloadSourceSafely. ^true
manager ^Registry
relinquishDataKey: aDataKey owner: aClassOrNameSpace "Called only during parcel loading. Remove the selector without marking anything modified." ( self modelAtName: aClassOrNameSpace absoluteName ifAbsent: [ ^nil ] ) removeDataKey: aDataKey
relinquishSelector: aSelector class: aClass "Called only during parcel loading. Remove the selector without marking anything modified." ( self modelAtName: aClass instanceBehavior absoluteName ifAbsent: [ ^nil ] ) removeSelector: aSelector meta: aClass isMeta
removeEmptyModels models copy do: [ :model | model isEmpty ifTrue: [ self removeModel: model ] ]
removeEmptyProtocols self classModelsDo: [:cm | (cm selectorsMeta: false) isNil ifFalse: [cm actualClass organization removeEmptyCategories]. (cm selectorsMeta: true) isNil ifFalse: [cm actualClass class organization removeEmptyCategories]]
unloadSource | sourceIndex | ((sourceIndex := properties at: #sourceIndex ifAbsent: nil) notNil) ifTrue: [SourceFileManager default discardSourceAt: sourceIndex]
</methods> <methods> Store.PackageModel <category>table of contents</category>
tableOfBundleContentsOn: aStream level: aLevel aLevel timesRepeat: [aStream tab]. aStream nextPut: $"; nextPutAll: self name; nextPut: $"; cr.
tableOfContentsOn: aStream aStream nextPut: $"; nextPutAll: self name; nextPut: $"; cr. self modelsDo: [ :model | | mname | mname := model absoluteName. model hasDefinition ifTrue: [ aStream tab. model isForNameSpace ifTrue: [ aStream nextPut: $! ]. aStream nextPutAll: mname; cr ]. model isForClass ifTrue: [ ( model selectorsMeta: false ) do: [ :selector | aStream tab; tab; nextPutAll: mname; nextPutAll: '>'; nextPutAll: selector; cr ]. ( model selectorsMeta: true ) do: [ :selector | aStream tab; tab; nextPut: $%; nextPutAll: mname; nextPutAll: '>'; nextPutAll: selector; cr ] ]. model dataKeys do: [ :dataKey | aStream tab; tab; nextPutAll: mname; nextPutAll: '@'; nextPutAll: dataKey; cr. ] ]. aStream tab; nextPutAll: ';'; cr
tableOfContentsOnFile: aString | strm | strm := aString asFilename writeStream. self tableOfContentsOn: strm. strm close.
</methods> <methods> Store.PackageModel <category>main change set access</category>
doClassChange: change self updateAfterDo: [ | classSymbol | classSymbol := change fullClassSymbol. change isRemove ifTrue: [ self removeAllChangeSetClassSymbol: classSymbol. self removeWholeClassSymbol: classSymbol ] ifFalse: [ self changeSetsDo: [ :cs | cs doClassChange: change ]. change isRemoveDefinition ifTrue: [ self removeDefinitionFullClassSymbol: classSymbol ]. change isAdd ifTrue: [ self addFullClassSymbol: classSymbol ] ] ]
doNameSpaceChange: change "Apply the change to the receiver." self updateAfterDo: [ | nsSymbol | nsSymbol := change nameSpaceSymbol. change isRemove ifTrue: [ self removeAllChangeSetNameSpaceSymbol: nsSymbol. self removeWholeSymbol: nsSymbol ] ifFalse: [ self changeSetsDo: [ :cs | cs doNameSpaceChange: change ]. change isRemoveDefinition ifTrue: [ self removeDefinitionFullNameSpaceSymbol: nsSymbol ]. change isAdd ifTrue: [ self addFullSymbol: nsSymbol ] ] ]
doSubdefChange: change "Apply the method/static change to the receiver." self updateAfterDo: [ | symbol | self changeSetsDo: [ :cs | cs doSubdefChange: change ]. symbol := change symbol. change isRemove ifTrue: [ | model | model := self modelAtSymbol: symbol ifAbsent: [^self]. change isMethodChange ifTrue: [ model removeSelector: change selector meta: change meta ] ifFalse: [ model removeDataKey: change dataKey ]. model isEmpty ifTrue: [ self removeModel: model ] ] ifFalse: [ change isAdd ifTrue: [ change isMethodChange ifTrue: [ self addSelector: change selector fullClassSymbol: symbol meta: change meta ] ifFalse: [ self addDataKey: change dataKey symbol: symbol ] ] ] ]
removeAllChangeSetClassSymbol: classSymbol "Propagate the removal of everything in this class which is not in another package to the package change sets." | cm | cm := self classModelAtClassSymbol: classSymbol ifAbsent: [ ^self ]. self updateAfterDo: [ | change | change := ( Change new ) classSymbol: classSymbol. cm hasDefinition ifTrue: [ self changeSetsDo: [ :cs | cs doChange: change remove "Definition" ] ]. change remove. ( cm selectorsMeta: false ) do: [ :selector | self changeSetsDo: [ :cs | cs doSubdefChange: ( change selector: selector; meta: false ) ] ]. ( cm selectorsMeta: true ) do: [ :selector | self changeSetsDo: [ :cs | cs doSubdefChange: ( change selector: selector; meta: true ) ] ]. cm dataKeys do: [ :key | self changeSetsDo: [ :cs | cs doSubdefChange: ( change dataKey: key ) ] ] ]
removeAllChangeSetNameSpaceSymbol: nsSymbol "Propagate the removal of everything in this namesapce which is not in another package to the package change sets." | model | model := self modelAtSymbol: nsSymbol ifAbsent: [ ^self ]. self updateAfterDo: [ | change | change := (Change new) nameSpaceSymbol: nsSymbol. model hasDefinition ifTrue: [ self changeSetsDo: [ :cs | cs doNameSpaceChange: change remove "Definition" ] ]. change remove. ( model dataKeys ) do: [ :dataKey | self changeSetsDo: [ :cs | cs doSubdefChange: (change dataKey: dataKey) ] ]. ]
renameAllChangeSetClassSymbol: oldSymbol to: newSymbol "Propagate the removal of everything in this class which is not in another package to the package change sets." | cm | cm := self classModelAtClassSymbol: oldSymbol ifAbsent: [ ^self ]. self updateAfterDo: [ | removeChange addChange | removeChange := Change new classSymbol: oldSymbol. addChange := Change new classSymbol: newSymbol. addChange add. cm hasDefinition ifTrue: [ self changeSetsDo: [ :cs | cs doChange: removeChange removeDefinition. cs doChange: addChange ] ]. removeChange remove. cm dataKeys do: [ :dataKey | self changeSetsDo: [ :cs | cs doSubdefChange: ( removeChange dataKey: dataKey ). cs doSubdefChange: ( addChange dataKey: dataKey ) ] ]. ( cm selectorsMeta: false ) do: [ :selector | self changeSetsDo: [ :cs | cs doSubdefChange: ( removeChange selector: selector; meta: false ). cs doSubdefChange: ( addChange selector: selector; meta: false ) ] ]. ( cm selectorsMeta: true ) do: [ :selector | self changeSetsDo: [ :cs | cs doSubdefChange: ( removeChange selector: selector; meta: true ). cs doSubdefChange: ( addChange selector: selector; meta: true ) ] ] ]
renameAllChangeSetNameSpaceSymbol: oldSymbol to: newSymbol "Propagate the removal of everything in this namespace which is not in another package to the package change sets." | model | model := self modelAtSymbol: oldSymbol ifAbsent: [ ^self ]. self updateAfterDo: [ | removeChange addChange | removeChange := Change new nameSpaceSymbol: oldSymbol. addChange := Change new nameSpaceSymbol: newSymbol. addChange add. model hasDefinition ifTrue: [ self changeSetsDo: [ :cs | cs doChange: removeChange removeDefinition. cs doChange: addChange ] ]. removeChange remove. model dataKeys do: [ :dataKey | self changeSetsDo: [ :cs | cs doSubdefChange: (removeChange dataKey: dataKey). cs doSubdefChange: (addChange dataKey: dataKey) ] ]. ]
renameClassSymbol: oldClassSymbol as: newClassSymbol | cm | cm := self classModelAtClassSymbol: oldClassSymbol ifAbsent: [^self]. self renameAllChangeSetClassSymbol: oldClassSymbol to: newClassSymbol. self renameModel: cm as: newClassSymbol.
renameNameSpaceSymbol: oldNameSpaceSymbol as: newNameSpaceSymbol | model | model := self modelAtSymbol: oldNameSpaceSymbol ifAbsent: [ ^self ]. self renameAllChangeSetNameSpaceSymbol: oldNameSpaceSymbol to: newNameSpaceSymbol. self renameModel: model as: newNameSpaceSymbol.
</methods> <methods> Store.PackageModel <category>parcel support</category>
copyContentsToParcel: parcel self definedClassModels do: [ :cm | parcel addClass: cm actual ]. self definedNameSpaceModels do: [ :nsm | parcel addNameSpace: nsm actual ]. self classModels do: [ :cm | cm classAndSelectorDo: [ :cls :selector | parcel addSelector: selector class: cls ] ]. self modelsDo: [ :model | model dataKeys do: [ :key | parcel addName: key in: model actual ] ]
dataNotInParcel: aParcel on: aStream "Write method>>selectors contained in the receiver but not in a Parcel." self modelsDo: [ :model | model dataKeys do: [ :key | ( aParcel definesName: key in: model actual ) ifFalse: [ aStream nextPutAll: ( model name, '.', key ); cr ] ] ].
definedClassesExcludedSelectors "Answer an IdentityDictionary of Class -> <Set of selectors>" "Parcel compatibility." | coll selectors | coll := IdentityDictionary new. self definedClasses do: [ :cls | ( Registry extensionClassModelsForClassSymbol: cls absoluteSymbol ) do: [ : exm | ( selectors := exm selectorsMeta: false ) isEmpty ifFalse: [ ( coll at: cls ifAbsentPut: [ Set new ] ) addAll: selectors ]. ( selectors := exm selectorsMeta: true ) isEmpty ifFalse: [ ( coll at: cls class ifAbsentPut: [ Set new ] ) addAll: selectors ]. ] ]. ^coll
definedClassesNotInParcel: aParcel on: aStream "Write classes whose definition is contained in the receiver but not in a Parcel." | pclasses | pclasses := aParcel definedClasses. self definedClassModels do: [ :model | ( pclasses includes: model actual ) ifFalse: [ aStream nextPutAll: model name; cr ] ].
definedNameSpacesNotInParcel: aParcel on: aStream "Write namespaces whose definition is contained in the receiver but not in a Parcel." self definedNameSpaceModels do: [ :model | ( aParcel definedObjects includes: model actual ) ifFalse: [ aStream nextPutAll: model name; cr ] ].
definedObjects "Parcel compatibility" ^self definedNameSpaces
extensionMethods "Answer an IdentitySet of CompiledMethods" "Parcel compatibility." | coll | coll := OrderedCollection new. self extendedModels do: [ :model | model isForClass ifTrue: [ model methods do: [ :md | coll add: md method ] ] ]. ^coll reject: [ :cm | cm == nil ].
extensionsDo: aBlock "Evaluate aBlock with MethodDefinitions for all defined extension methods" "Parcel compatibility." | cls | self extendedClassModels do: [ :model | cls := model actual. ( model selectorsMeta: true ) do: [ :selector | aBlock value: cls class value: selector ]. ( model selectorsMeta: false ) do: [ :selector | aBlock value: cls value: selector ]. ]
methodsFor: aClass do: aBlock "Evaluate aBlock with MethodDefinitions for all defined methods on this class" | classModel cls | classModel := aClass isBehavior ifTrue: [self classModelAtClass: aClass ifAbsent: [^self]] ifFalse: [aClass "if not a class assume it's a model"]. cls := classModel actual. (classModel selectorsMeta: true) do: [:selector | aBlock value: cls class value: selector]. (classModel selectorsMeta: false) do: [:selector | aBlock value: cls value: selector]
methodsNotInParcel: aParcel on: aStream "Write method>>selectors contained in the receiver but not in a Parcel." self classModels do: [ :model | model classAndSelectorDo: [ :cls :sel | ( aParcel definesSelector: sel forClass: cls ) ifFalse: [ aStream nextPutAll: ( cls name, '>>', sel ); cr ] ] ].
namedObjects ^Dictionary new.
putStoredPropertiesIn: aDictionary "Put any PundleModel-specific properties into aDictionary for Parcel publishing." super putStoredPropertiesIn: aDictionary. aDictionary at: #packageName put: name; at: #dbTrace put: self dbTrace; at: #dbIdentifier put: self dbIdentifier; at: #printStringCache put: self printStringCache.
saveAsParcel: fullPathName saveStructure: saveStructure saveLinks: saveLinks "Save the receiver as a parcel -without creating the parcel in the image. fullPathName is a directory/parcelName with no extension. If saveStructure is meaningless for packages If saveLinks is true, save the db link." | dir pname | pname := fullPathName tail. dir := fullPathName directory. dir exists ifFalse: [ ( Dialog confirm: ( (#CreateDirectory1s << #packages >> 'Create directory <1s>?') expandMacrosWith: dir asString ) ) ifFalse: [ ^self ]. dir makeDirectory. ]. properties at: #packageName put: name. self parcelOutTo: ( dir construct: ( pname, '.pcl' ) ) asString sourceFileName: ( dir construct: ( pname, '.pst' ) ) asString.
saveAsParcel: aFilename saveStructure: unusedBoolean saveLinks: alsoUnusedBoolean parcelOptions: aDictionary "Save the receiver as a parcel -without creating the parcel in the image. fullPathName is a directory/parcelName with no extension. saveStructure and save links is meaningless for packages with this method" | parcelDirectory parcelName | parcelName := aFilename tail. parcelDirectory := aFilename directory. parcelDirectory exists ifFalse: [(Dialog confirm: (#CreateDirectory1s << #packages >> 'Create directory <1s>?' expandMacrosWith: parcelDirectory asString)) ifFalse: [^self]. parcelDirectory makeDirectory]. properties at: #packageName put: name. self parcelOutTo: (parcelDirectory construct: parcelName , '.pcl') asString sourceFileName: (parcelDirectory construct: parcelName , '.pst') asString parcelOptions: aDictionary
</methods> <methods> Store.PackageModel <category>overrides</category>
cleanUpOverrides self overrides copy do: [ :over | | obj | ( obj := over object ) == nil ifFalse: [ ( ( over getSources: obj ) includes: self ) ifTrue: [ over silentlyRemove ] ]. ].
comparesTo: aCodeComponent "Answer true if the receiver is some version of aCodeComponent." ^aCodeComponent isPackage and: [ name = aCodeComponent name ].
overriddenClass: aClass "The class definition has been redefined for another package." ".... the new definition has just been installed..." self changeSetsDo: [ :cs | cs overriddenClass: aClass ].
overriddenNameSpace: aNameSpace "The nameSpace definition has been redefined for another package." ".... the new definition has just been installed ...." self changeSetsDo: [ :cs | cs overriddenNameSpace: aNameSpace ].
overriddenSelector: selector class: aClass "aClass>>selector has been redefined for another package." self changeSetsDo: [ :cs | cs overriddenSelector: selector class: aClass ].
overriddenStatic: key in: aNameSpace "aNameSpace.key defintion has been redefined for another package." self changeSetsDo: [ :cs | cs overriddenStatic: key in: aNameSpace ].
reinstalledClass: aClass "A previously overriden class definition has been restored." XChangeSet current moveClassDefinition: aClass toPackage: self.
reinstalledNameSpace: aNameSpace "A previously overriden namespace definition has been restored." XChangeSet current moveNameSpaceDefinition: aNameSpace toPackage: self.
reinstalledSelector: selector class: aClass "A previously overriden namespace definition has been restored." XChangeSet current moveSelector: selector class: aClass toPackage: self. self changeSetsDo: [ :cs | cs forgetMethodChange: selector class: aClass ]
reinstalledStatic: aStaticKey in: aNameSpace "A previously static definition has been restored." XChangeSet current moveDataKey: aStaticKey owner: aNameSpace toPackage: self. self changeSetsDo: [ :cs | cs forgetDataChange: aStaticKey owner: aNameSpace ]
removeOverriddenClass: aClass "Remove only the class definition that has been overridden by another component." "Record in changeset" self doClassChange: ( Change new class: aClass; removeDefinition ).
removeOverriddenNameSpace: aNameSpace "Remove only the namespace definition that has been overridden by another component." "Record in changeset" self doNameSpaceChange: ( Change new nameSpace: aNameSpace; removeDefinition ).
removeOverriddenSelector: selector class: aClass "Remove a selector that was overridden by another component." "Record in changeset" self doSubdefChange: ( Change new class: aClass; selector: selector; remove ).
removeOverriddenStatic: symbol nameSpace: aNameSpace "Remove only the static that has been overridden by another component." "Record in changeset" self doSubdefChange: ( Change new actual: aNameSpace; dataKey: symbol; remove ).
</methods> <methods> Store.PackageModel <category>change set conversion</category>
conversionPackage "Answer a copy of the receiver suitable for publishing change fragments." ^( self class new ) name: name; copyPropertiesFrom: properties; copyModels: models; dbIdentifier: self dbIdentifier; dbTrace: self dbTrace; yourself.
copyModels: modelDictionary "Deep copy the modelDictionary into the receiver." "Meant for internal use only." models := IdentityDictionary new. modelDictionary keysAndValuesDo: [ :key :value | models at: key put: value copy ].
</methods> <methods> Store.PackageModel <category>private-loading/unloading</category>
removeClass: aClass unloaded: aBoolean "Remove a class from the receiver. aBoolean is true means that the class was removed from the system. If false, an override was reinstalled." aBoolean ifTrue: [ self removeClass: aClass ].
removeNameSpace: aNameSpace unloaded: aBoolean "Remove a namespace from the receiver. aBoolean is true means that the namespace was removed from the system. If false, an override was reinstalled." aBoolean ifTrue: [ self removeNameSpace: aNameSpace ].
</methods> <methods> Store.PackageModel <category>editing</category>
addClasses: classes classes do: [:aClass | self addClass: aClass]
addEntiretyOfClass: class "Add a class and all its methods to myself." XChangeSet current moveWholeClass: class toPackage: self
addSelector: aSymbol forClass: aBehavior "Used during binary load." self addSelector: aSymbol class: aBehavior
removeName: aSymbol in: aNameSpace XChangeSet current removeDataKey: aSymbol nameSpace: aNameSpace
removeSelector: aSelector forClass: aBehavior XMainChangeSet current removeSelector: aSelector class: aBehavior fromPackage: self.
</methods> <methods> Store.PackageModel <category>change management</category>
removeClass: aClass XChangeSet current removeClass: aClass from: self
removeNameSpace: aNameSpace (Registry containingPackageForNameSpace: aNameSpace) = self ifFalse: [^self]. XChangeSet current removeNameSpace: aNameSpace
</methods> <methods> Store.PackageModel <category>private-load/unload</category>
queryLoaded: nameString ifLoadedAndOK: updateBlock ifFail: failBlock "Check if the receiver is already loaded and if so, take whatever error actions are required and evaluate aBlock with the error value, which will probably be derived from some exception handler. By default there's nothing to do. With StORE ." | oldPackage | oldPackage := Registry packageNamed: nameString. (oldPackage isNil or: [oldPackage isEmpty]) ifTrue: [^self]. ^(Parcel parcelAlreadyLoadedSignal raiseRequestWith: nameString) ifTrue: [updateBlock value: oldPackage] ifFalse: [failBlock value: (self class abortedActionSignal raiseRequestWith: (Array with: self with: nameString with: #packageAlreadyLoaded << #dialogs >> 'Package already loaded') errorString: #packageLoadAborted << #dialogs >> 'Package load aborted')]
unloadProblemsQuery: aProblemSet header: aHeader | problemsStream problems indent | aProblemSet size = 0 ifTrue: [^true]. problemsStream := WriteStream on: String new. problemsStream nextPutAll: aHeader; cr. problems := aProblemSet asSortedCollection. problems isEmpty ifTrue: [^true]. indent := ' '. problems size < 20 ifTrue: [problems do: [:prob| problemsStream nextPutAll: indent. problemsStream nextPutAll: prob. problemsStream cr]] ifFalse: [1 to: 14 do: [:inx| problemsStream nextPutAll: indent. problemsStream nextPutAll: (problems at: inx). problemsStream cr]. problemsStream nextPutAll: '...'; cr]. problemsStream nextPutAll: 'Proceed?'. ^Warning raiseSignal: problemsStream contents
</methods> <methods> Store.PackageModel <category>accessing-browser</category>
allClassNames "Answer a collection of class names. The collection contains names for classes that are defined in the package and names of classes for which methods are defined" | defined extended | defined := self definedClassModels collect: [:cm | cm absoluteName]. extended := self extendedClassModels collect: [:cm | cm absoluteName]. ^defined asSortedCollection asOrderedCollection , extended asSortedCollection asOrderedCollection
allMetaclassNames "Answer a collection of metaclass names. The collection contains names for classes that are defined in the package and names of classes for which methods are defined" | defined extended | defined := self definedClassModels collect: [:cm | cm className , ' class']. extended := self extendedClassModels collect: [:cm | cm className , ' class']. ^defined asSortedCollection asOrderedCollection , extended asSortedCollection asOrderedCollection
allMethodsBut: oldCollection "Answer an array. The first element has collection of methods that are defined in the backage but not in oldCollection. The second has method defined in oldColection but not in the package." | coll newColl oldMethod | coll := oldCollection copy. newColl := List new. self methods do: [:method | oldMethod := coll detect: [:each | each sameAs: method] ifNone: [nil]. oldMethod isNil ifTrue: [newColl add: method] ifFalse: [coll remove: oldMethod]]. ^Array with: newColl with: coll
allNameSpaceNames "Answer a collection of class names. The collection contains names for classes that are defined in the package and names of classes for which methods are defined" | defined extended | defined := self definedNameSpaceModels collect: [ :model | model absoluteName]. extended := self extendedNameSpaceModels collect: [ :model | model absoluteName]. ^defined asSortedCollection asOrderedCollection , extended asSortedCollection asOrderedCollection
classesDefinedInPackage "Answer a collection of class descriptors. The collection contains descriptors only for classes that are defined in the package." ^( self definedClassModels collect: [:cm | ClassDescriptor fromModel: cm ] ) asOrderedCollection
classesExtendedInPackage "Answer a collection of class descriptors. The collection contains descriptors only for classes that are extended (not defined) in the package." ^( self extendedClassModels collect: [:cm | ClassExtensionDescriptor fromModel: cm ] ) asOrderedCollection
classesWithSource "Answer a collection of ClassDescriptors for the receiver. This also includes any class definitions that are overridden by any other packages in the system." ^self classesDefinedInPackage addAll: ( ( Override overridesForComponent: self ) select: [ :over | over isForClass ] ); yourself.
dataForNamed: aFullName "Answer a collection of datum descriptors." ^( self modelAtName: aFullName asClassNameOnly ifAbsent: [ ^Array new ] ) datumDescriptors
dataForNamed: aFullName andProtocol: aSymbol "Answer a collection of datum descriptors." ^( self modelAtName: aFullName asClassNameOnly ifAbsent: [^Array new] ) datumDescriptors select: [ :dd | dd protocolName asSymbol = aSymbol ]
datum: dataKey forOwnerNamed: aFullName ^( self modelAtSymbol: aFullName ifAbsent: [ ^nil ] ) datumDescriptorForDataKey: dataKey.
metaclassesDefinedInPackage "Answer a collection of class descriptors. The collection contains descriptors only for metaclasses that are defined in the package." ^( self definedClassModels collect: [:cm | ClassDescriptor fullName: cm absoluteName meta: true ] ) asSortedCollection asOrderedCollection
metaclassesExtendedInPackage "Answer a collection of class descriptors. The collection contains descriptors only for metaclasses that are extended (not defined) in the package." ^( self extendedClassModels collect: [:cm | ClassExtensionDescriptor fullName: cm absoluteName meta: true ] ) asSortedCollection asOrderedCollection
method: aSelector forClassNamed: aClassName meta: isMeta "Answer a method with selector aSelector defined in the class named aClassName." ^( self modelAtSymbol: aClassName asClassNameOnly asSymbol ifAbsent: [ ^aClassName asQualifiedReference ifDefinedDo: [ :cls | Override overrideForSelector: aSelector class: (isMeta ifTrue: [cls class] ifFalse: [cls]) in: self ] ] ) methodDescriptorForSelector: aSelector meta: isMeta.
methodsForClassNamed: aClassName andProtocol: aProtocolName meta: isMeta "Answer a collection of method descriptors." ^(self classModelAtClassName: aClassName ifAbsent: [^Array new]) methodsForProtocol: aProtocolName meta: isMeta
methodsForClassNamed: aClassName meta: isMeta "Answer a collection of method descriptors." ^(self classModelAtClassName: aClassName ifAbsent: [^Array new]) methodsMeta: isMeta
nameSpacesDefinedInPackage "Answer a collection of namespace descriptors. The collection contains descriptors only for NameSpaces that are defined in the package." ^( self definedNameSpaceModels collect: [:model | NameSpaceDescriptor fromModel: model ] ) asSortedCollection asOrderedCollection
nameSpacesExtendedInPackage "Answer a collection of namespace descriptors. The collection contains descriptors only for namespaces that are extended (not defined) in the package." ^( self extendedNameSpaceModels collect: [:cm | NameSpaceExtensionDescriptor fromModel: cm ] ) asSortedCollection asOrderedCollection
nameSpacesWithSource "For image model same as defined NameSpace." ^self nameSpacesDefinedInPackage.
packageClasses "Answer a collection of classes defined in the package." "For pubishing ONLY. Includes overridden class defs." ^(self definedClassModels asArray collect: [:cm | cm actualClass]) , self overriddenClasses
packageNameSpaces "Answer a collection of NameSpaces defined in the package." "For pubishing ONLY. Includes overridden class defs." ^( self definedNameSpaceModels collect: [ :model | model nameSpace ] ) addAll: self overriddenNameSpaces; yourself
protocolsForClassNamed: aClassName meta: isMeta | model list cls | model := self classModelAtClassName: aClassName ifAbsent: [ ^Array new ]. cls := model actual. isMeta ifTrue: [ cls := cls class ]. list := model protocolsMeta: isMeta. ^self sortCategories: list with: cls organization categories.
protocolsForDataIn: anOwner ^( self modelAtName: anOwner absoluteSymbol ifAbsent: [ ^#() ] ) protocols
protocolsForNameSpaceNamed: aName | model | model := self modelAtName: aName asSymbol ifAbsent: [ ^#() ]. ^self sortCategories: model protocols with: model actual organization categories.
</methods> <methods> Store.PackageModel <category>accessing-fake</category>
allContainedItems "Answer a collection of components." ^#( ) "don't got none."
anyContainedItems "Answer a collection of components." ^#() "don't got none."
containedItems "Answer a collection of components." ^#() "don't got none."
</methods> <methods> Store.PackageModel <category>private-testing</category>
isClassOrNameSpaceNameOverridden: absoluteClassOrNameSpaceName ^absoluteClassOrNameSpaceName asQualifiedReference ifDefinedDo: [:cls | (Override isOverriddenClassOrNameSpace: cls in: self)] elseDo: [false]
</methods> <methods> Store.PackageModel <category>changes</category>
recompileExtensions "Our compilation scope has changed. Recompile any extension methods which may be affected" self extensionsDo: [:eachClass :eachSelector | eachClass recompile: eachSelector in: (self environmentFor: eachSelector in: eachClass) ].
recompileMethodsFor: aClass "Our compilation scope has changed. Recompile any methods which may be affected." | environment realClass | realClass := aClass isBehavior ifTrue: [aClass instanceBehavior] ifFalse: [aClass actualClass instanceBehavior]. environment := (self includesDefinitionOf: realClass absoluteName) ifTrue: [nil] ifFalse: [self environment]. self methodsFor: aClass do: [:eachClass :eachSelector | | localEnvironment| localEnvironment := environment. eachClass recompile: eachSelector in: localEnvironment].
</methods> <methods> Store.PackageModel class <category>private</category>
emptyFrom: aPublishedPackage "Create a new EMPTY package using aPublishedPackage. In order to make the package change set reflect this situation convert the contents of aPublishedPackage into removes. Answer a collection of modifications." | imPkg mods | imPkg := self named: aPublishedPackage name. imPkg dbTrace: aPublishedPackage primaryKey. mods := aPublishedPackage modificationsFor: aPublishedPackage dbIdentifier. imPkg markModificationAsRemoves: mods. ^mods
</methods> <methods> Store.PackageModel class <category>constants</category>
componentType "Answer a symbol representing the class of the receiver." ^#package
descriptionString "Answer a string for error messages." ^(#package << #packages >> 'package') asString
packageIcon ^PackageIcon ifNil: [PackageIcon := ListIconLibrary visualFor: #package]
</methods> <methods> Store.MethodDescriptor <category>printing</category>
asMethodString | string | string := ( SystemUtils convertAbsoluteNameToFull: self className ), ' '. self isMeta ifTrue: [ string := string, 'class ' ]. ^string, self itemString.
displayString ^self itemString
itemString ^self name , self versionString
printOn: aStream aStream nextPutAll: self classNameWithMeta; nextPutAll: '>>'; nextPutAll: self protocolName; nextPutAll: '>>'; nextPutAll: selector asString.
versionString ^''
</methods> <methods> Store.MethodDescriptor <category>accessing browser</category>
asString ^self name.
name ^self selector asString
</methods> <methods> Store.MethodDescriptor <category>accessing</category>
absoluteClassName ^fullClassName
className ^fullClassName
classNameWithMeta ^self isMeta ifTrue: [ self fullClassName fullMetaName] ifFalse: [ self fullClassName ].
containingPackages "Answer all the packges that contain the definition for the receiver, including overriden." | cls | ( cls := self implementingClass ) == nil ifTrue: [ ^OrderedCollection new ]. ^Registry allContainingPackagesForSelector: selector class: cls.
definition ^self sourceCode
fullClassName ^fullClassName
fullClassName: aString aString namesMetaClass ifTrue: [ self notify: #InvalidClassName << #packages >> 'Invalid class name' ]. fullClassName := aString
fullName ^fullClassName, '>>', self name
implementingClass ^self myClass
meta: aBoolean meta := aBoolean
method | cls | ( cls := self myClass ) == nil ifTrue: [ ^nil ]. ^cls compiledMethodAt: selector ifAbsent: [ nil ]
methodSources | mClass | ^[ ( mClass := self myClass ) isNil ifTrue: [ MethodSourceCollection source: (#NonexistentClass << #packages >> 'Non-existent class') asString ] ifFalse: [ mClass methodSourcesAt: selector ] ] on: KeyNotFoundError do: [ :e | e return: (MethodSourceCollection source: (#SourceUnavailable << #packages >> 'Source unavailable.') asString) ].
myClass | cls | cls := self fullClassName asStrictReference valueOrDo: [ ^nil ]. ^self isMeta ifTrue: [ cls class ] ifFalse: [ cls ].
owner | cls | cls := self fullClassName asStrictReference valueOrDo: [ ^nil ]. ^self isMeta ifTrue: [ cls class ] ifFalse: [ cls ].
ownerName ^fullClassName
protocol "Do lazy evaluation of protocol name, since method may not have been installed in class when a change is registered." protocol isNil ifTrue: [self protocol: (self classFromClassName organization categoryOfElement: selector)]. ^protocol
protocol: aValue protocol := aValue
protocolName self protocol isNil ifTrue: [^'']. ^self protocol asString
selector ^selector
selector: aValue selector := aValue
sourceCode | mClass | ^[ ( mClass := self myClass ) isNil ifTrue: [ (#NonexistentClass << #packages >> 'Non-existent class') asString ] ifFalse: [ ( mClass sourceCodeAt: selector ) ifNil: [ (#SourceUnavailable << #packages >> 'Source unavailable.') asString ] ] ] on: KeyNotFoundError do: [ :e | e return: (#SourceUnavailable << #packages >> 'Source unavailable.') asString ].
stDocumentation ^self compiledMethod stDocumentation
stDocumentation: docString " self compiledMethod stDocumentation: docString "
</methods> <methods> Store.MethodDescriptor <category>testing</category>
hasMethod ^self method notNil
isForMethod ^true
isMeta ^meta
</methods> <methods> Store.MethodDescriptor <category>private-testing</category>
existsInImage "Answer true if the receiver is a valid description of an existing method." | class prot | ( class := self myClass ) == nil ifTrue: [ ^false ]. prot := class organization categoryOfElement: self selector. prot isNil ifTrue: [ ^false ]. prot ~= self protocol ifTrue: [ ^false ]. ^true
</methods> <methods> Store.MethodDescriptor <category>comparing</category>
= aThing ^self sameAs: aThing
comparesTo: anObject "Answer true if anObject could be another version of the receiver." ( self objectIsForSelf: anObject ) ifFalse: [ ^false ]. ^( anObject selector = selector ) and: [ anObject classNameWithMeta = self classNameWithMeta ]
hash ^self fullClassName hash + self selector hash
objectIsForSelf: anObject "Answer true if anObject represents the same kind of thing as the reciever." ^anObject isForMethod
sameAs: aMethod "Browsers are only interested in the selector...." aMethod isSymbol ifTrue: [ ^selector == aMethod ]. ((aMethod respondsTo: #isForData) and: [aMethod isForData]) ifTrue: [ ^false ]. ^aMethod sameAsImThing: self
sameAsImThing: aMethod ((aMethod respondsTo: #isForData) and: [aMethod isForData]) ifTrue: [ ^false ]. ^self classNameWithMeta = aMethod classNameWithMeta and: [ self selector = aMethod selector ].
</methods> <methods> Store.MethodDescriptor <category>private</category>
classFromClassName "className is either a class name or a class name followed by ' class'. Answer the class or metaclass it names. Changed to use meta var- DS" | class | class := fullClassName asStrictReference valueOrDo: [ self error: (#CannotFindClass << #packages >> 'Cannot find class'). ^nil ]. ^meta ifTrue: [ class class ] ifFalse: [ class ]
compiledMethod "Answer the compiled method" | mclass | mclass := self myClass. mclass isNil ifTrue: [self error: (#MethodRefersToBogusClass << #packages >> 'Method refers to non existing class'). ^self]. ^mclass compiledMethodAt: self selector.
fileOutOn: aSourceCodeStream | d | d := Dictionary new. d at: self protocol put: ( Set with: self ). aSourceCodeStream fileOutTTMessages: d for: self classNameWithMeta logging: false.
loadAsNew "Do nothing since I'm already in the image." ^true
loadAsNewIn: imgPackage "Do nothing since I'm already in the image." ^true
loadSrcIntoPackage: imPkg confirm: aBoolean "Do nothing since I'm already in the image."
</methods> <methods> Store.MethodDescriptor <category>bogus</category>
forDbPackage "Answer an array with a first element being a class and second being a selector. This method is used for the DB package creation." ^Array with: self myClass with: selector
</methods> <methods> Store.MethodDescriptor <category>utils</category>
isMetaclassMethod "Answer true if the class is meta class" ^meta
</methods> <methods> Store.MethodDescriptor class <category>instance creation</category>
fromSelector: aSelector class: class ^self new selector: aSelector; protocol: (class organization categoryOfElement: aSelector); fullClassName: class absoluteName asClassNameOnly; meta: class isMeta; yourself.
fromSelector: aSelector className: className meta: boolean ^self new selector: aSelector; fullClassName: className asClassNameOnly; meta: boolean; yourself
</methods> <methods> Kernel.ChunkSourceFileFormat <category>code component support</category>
bundleNamed: name structure: structure on: aStream "Add the changing of a bundle structure event on a stream. " aStream nextChunkPut: ( '#{Store.Registry} ifDefinedDo:<nt>[ :reg |<n> ( reg bundleNamedOrCreate: <1s> ) structure: <2s>]' expandMacrosWith: name with: structure storeString printString ); cr.
</methods> <methods> Core.String <category>private-store</category>
classNameOnly "Answer a part of receiver that contains the class name. Note that this methos assumes that the reciver holds the metaclass name" ^self copyFrom: 1 to: self size - 6
</methods> <methods> Kernel.GeneralNameSpace <category>store data</category>
dataAt: aDataKey put: data "Install a data value. Answer true if ok" self at: aDataKey put: data. ^true
</methods> <methods> Core.Class <category>store data</category>
dataAt: aDataKey ifAbsent: aBlock "Look up data value " ^self asNameSpace dataAt: aDataKey ifAbsent: aBlock
</methods> <methods> Kernel.Override <category>store</category>
packageName ^( self sources detect: [ :s | s isPackage ] ifNone: [ ^nil ] ) name
</methods> <methods> Kernel.GeneralNameSpace <category>store utils</category>
absoluteSymbol "Answer an environment independant (and therefore truely unique) symbol" ^self absoluteReference asSymbol
</methods> <methods> Tools.CategorizedSelectionModule class <category>private</category>
classesInPundle: aPundleOrNil ^aPundleOrNil isNil ifTrue: [Array new] ifFalse: [aPundleOrNil definedClasses asSortedCollection: [:a :b | a name < b name]]
</methods> <methods> Kernel.OverridenStatic <category>store</category>
absoluteName ^self owner absoluteName, '.', self key
</methods> <methods> Kernel.OverridenMethod <category>store</category>
absoluteClassName ^self implementingClass absoluteName
</methods> <methods> Tools.TreeItemHolder class <category>instance creation-store</category>
withStorePundleTree ^(self on: Store.Registry) childrenBlock: [:object | object containedItems]; yourself
</methods> <methods> Core.Class <category>store data</category>
dataKeys "Answer the receiver's data." ^( self classPool isEmpty ) ifTrue: [ #() ] ifFalse: [ self classPool keys ].
unloadDataKey: dataKey "unload a data value. Answer nil if unable." ^self asNameSpace unloadDataKey: dataKey
</methods> <methods> Kernel.GeneralNameSpace <category>store data</category>
dataAt: aDataKey ifAbsent: aBlock "look up a data value- " ^self at: aDataKey ifAbsent: aBlock
</methods> <methods> Kernel.OverridenNameSpace <category>store</category>
asPseudoRecord "Answer a store psuedo record representing the image version of the class/namespace part of the receiver." ^Store.PseudoRecord fromModel: self
</methods> <methods> Kernel.OverridenClass <category>accessing</category>
absoluteName "Answers the overriden object's absouteName." ^self environment absoluteName, '.', self name.
</methods> <methods> Kernel.OverridenNameSpace <category>store</category>
absoluteName "Answers the overriden object's absouteName." ^self environment absoluteName, '.', self name.
</methods> <methods> Kernel.ChangeSet <category>component change management</category>
bundleStructure: aBundle "Include indication or the changing of a bundle structure event. " self addComponentChange: ( Store.BundleStructureChange new component: aBundle; yourself )
</methods> <methods> Tools.DefinitionCreationDialog <category>validation</category>
validatePackageIfFails: aBlock self isPackageProvided ifFalse: [aBlock value: #PackageNameIsRequired << #dialogs >> 'The package name is required']. (Store.Registry packageNamed: self packageModule value trimBlanks) isNil ifTrue: [aBlock value: #NoSuchPackage << #dialogs >> 'There is no such package']
</methods> <methods> Kernel.GeneralNameSpace <category>store data</category>
dataAt: aDataKey "Answer text for aDataKey" ^self dataAt: aDataKey ifAbsent: [ nil ]
</methods> <methods> Kernel.AbsentClassImport <category>accessing</category>
classNameWithMeta ^self isMeta ifTrue: [ self absoluteName, ' class' ] ifFalse: [ self absoluteName ].
</methods> <methods> Tools.EntryWithPasteButtonModule class <category>private</category>
selectPackage ^(IncrementalSearchDialog selectPackage: #PackageC << #labels >> 'Package:') ifNotNil: [:package | package name]
</methods> <methods> Kernel.OverridenClass <category>testing</category>
isMeta ^self name namesMetaClass
</methods> <methods> Kernel.ChangeSet class <category>component change management</category>
bundleStructure: aBundle "Include indication that aBundle's structure has changed." self changed: #bundleStructure: with: ( Array with: aBundle )
</methods> <methods> Kernel.OverridenStatic <category>store</category>
isInClass ^self owner isBehavior
</methods> <methods> Tools.IncrementalSearchModule class <category>instance creation-predefined</category>
forPackageSelection "Answer a module that allows to select a package with search by a partial name." "self forPackageSelection open" ^self forPackageSelection: #FindC << #labels >> 'Find:'
</methods> <methods> XML.SourceScannerNodeBuilder <category>scanning-code components</category>
scan_bundle_structure: anElement self doChange: ( Store.BundleStructureChange new componentName: ( self getString: 'name' from: anElement default: '' ); structureString: ( self getString: 'structure' from: anElement default: '' ); yourself ).
</methods> <methods> Kernel.XMLSourceFileFormat <category>code component support</category>
bundleNamed: name structure: structure on: aStream "Save the bundle structure on a Stream." self checkForWrite: aStream. aStream cr; cr. self on: aStream tag: 'bundle-structure' do: [:xml :str | str cr. xml on: str tag: 'name' value: name. str space. xml on: str tag: 'structure' value: structure storeString. str cr]
</methods> <methods> Kernel.OverridenMethod <category>store</category>
classNameWithMeta ^self absoluteClassName
</methods> <methods> Kernel.OverridenStatic <category>store</category>
absoluteOwnerName ^self owner absoluteName
</methods> <methods> Tools.TreeSelectionModule class <category>instance creation-predefined</category>
forStoreBundlesAndPackages ^TreeSelectionModule new rootHolder: TreeItemHolder withStorePundleTree; iconSelector: #toolListIcon; showRoot: false; expandableRoots: true; preExpandTo: 0
</methods> <methods> Kernel.ChunkSourceFileFormat <category>code component support</category>
bundleStructure: aBundle on: aStream "Add the loading of a package/bundle event on a stream. " self bundleNamed: aBundle name structure: aBundle structure on: aStream
</methods> <methods> Kernel.Override class <category>management</category>
removeOverridesForClassOrNameSpaceDefinition: aClassOrNameSpace in: aComponent "Remove the override for a class or namespace definition in aComponent." | override | override := ( self overriddenClassesAndNameSpaces at: aClassOrNameSpace ifAbsent: [ ^self ] ) detect: [ :over | over includesSource: aComponent ] ifNone: [ ^self ]. override purge
</methods> <methods> Kernel.GeneralNameSpace <category>store data</category>
unloadDataKey: dataKey "unload a data value. Answer nil if unable." self dataAt: dataKey ifAbsent: [ ^nil ]. self removeKey: dataKey.
</methods> <methods> Kernel.GeneralBindingReference <category>store</category>
finalNameSpaceName | list | ( list := self path asOrderedCollection ) removeLast. ^( self class path: list ) asString.
</methods> <methods> Kernel.OverridenClass <category>accessing</category>
superclass ^( self argumentForKeyWord: 'superclass' ) value
</methods> <methods> Core.Class <category>store data</category>
datumDescriptors "Answer a collection of DatumDescriptors for the recievers dataKeys." ^self dataKeys asSortedCollection asOrderedCollection collect: [ :dataKey | Store.DatumDescriptor fromDataKey: dataKey className: self absoluteName ]
</methods> <methods> Kernel.Override <category>store</category>
definition ^self text
</methods> <methods> Kernel.OverridenMethod <category>store</category>
asPseudoRecord "Answer a store psuedo record representing the image version of the class/namespace part of the receiver." ^Store.ClassDescriptor fullName: self owner absoluteName meta: self isMeta
</methods> <methods> Tools.DefinitionCreationDialog <category>private-validation</category>
isPackageProvided | name | name := packageModule value. ^name notNil and: [name trimBlanks notEmpty]
</methods> <methods> Kernel.OverridenMethod <category>store</category>
sourceCode ^self text
</methods> <methods> Tools.IncrementalSearchDialog class <category>dialog opening-predefined</category>
selectPackage: aUserMessageOrString "self selectPackage: 'Find package:' " | dialog | dialog := self new module: (IncrementalSearchModule forPackageSelection: aUserMessageOrString). ^dialog select
</methods> <methods> Kernel.NameSpaceOfClass <category>store utils</category>
dataBindings "All class bindings are for data - right?" ^bindings asList
</methods> <methods> Core.Class <category>store data</category>
dataAt: aDataKey "Answer text for aDataKey" ^self asNameSpace dataAt: aDataKey ifAbsent: [ nil ]
</methods> <methods> Kernel.OverridenClass <category>store</category>
asPseudoRecord "Answer a store psuedo record representing the image version of the class/namespace part of the receiver." ^Store.PseudoRecord fromModel: self
</methods> <methods> Kernel.Parcel <category>store</category>
asPackageNamed: packageNameString "Answer a package that duplicates the receiver." "Currently, does not remove from an existing package." | pkg | packageNameString isEmpty ifTrue: [ ^nil ]. ( ( Store.Registry packageNamed: packageNameString ) == nil ) ifFalse: [ ^self asPackageNamed: ( Dialog request: ((#PackageAlreadyExists << #packages >> 'Package <1s> already exists.<n>Confirm. ') expandMacrosWith: packageNameString) initialAnswer: packageNameString onCancel: [ ^nil ] ) ]. pkg := Store.Registry packageNamedOrCreate: packageNameString. [ pkg startLoad. self moveContentsTo: pkg. pkg copyPropertiesFrom: self properties. pkg comment: (self commentOrNil == nil ifTrue: [((#PackageConvertedFromParcel << #packages >> 'Converted from parcel: <1s> <2s>') expandMacrosWith: self name with: self versionString)] ifFalse: [self comment]). pkg resetUninstalledStateFrom: self. pkg markNotModified. ( properties includesKey: #dbTrace ) ifFalse: [ pkg addOtherChange: #convertedParcel ]. "not if linked to db" Override equateComponent: pkg with: self. ] ensure: [ pkg endLoad ]. ^pkg
</methods> <methods> Core.String <category>private-store</category>
fullMetaName "Add ' class' to the receiver" ^self, ' class'
</methods> <methods> Kernel.SourceFileManager <category>file out code components support</category>
bundleStructure: aBundle "Add the changing of a bundle structure event on a stream. " self noTargetForWrites ifFalse: [self targetFormatter bundleStructure: aBundle on: self targetFile. self endOfChunk]
bundleNamed: name structure: structure "Add the changing of a bundle structure event on a stream. " self noTargetForWrites ifFalse: [self targetFormatter bundleNamed: name structure: structure on: self targetFile. self endOfChunk]
</methods> <methods> Kernel.Parcel <category>store</category>
checkPrerequisiteNamed: prerequisiteName withVersion: prerequisiteVersionString requiredVersion: requiredVersionString "Answer if the version of the prerequisite prerequisiteName is acceptable. Callback for prerequiste loading" | blk | ( blk := self versionSelectionBlock ) == nil ifTrue: [ ^true ]. ^blk value: prerequisiteName value: prerequisiteVersionString value: requiredVersionString
</methods> <methods> Kernel.GeneralNameSpace <category>store data</category>
dataKeys | list | list := List new. bindings do: [ :i | i isForGeneral ifTrue: [ list add: i key ] ]. ^list
</methods> <methods> Tools.DefinitionCreationDialog <category>accessing</category>
packageOrDo: aBlock | name | name := self packageModule value. ^(Store.Registry packageNamed: name) ifNil: [aBlock value]
</methods> <methods> Kernel.Parcel <category>store</category>
asDBRecord "Convert receiver into a DBRecord ready for installation into database." |record| record := self classOfDbRecord from: self. self parcelOutToDb: record. ^record
</methods> <methods> Tools.IncrementalSearchModule class <category>instance creation-predefined</category>
forPackageSelection: prompt "Answer a module that allows to select a package with search by a partial name." | instance | instance := self new. instance firstLabel: prompt; secondLabel: #PackagesC << #labels >> 'Packages:'; searchBlock: [:string | self findPackagesMatching: string]; objectToStringBlock: [:package | package name]; iconBlock: [:package | package == Store.Registry nullPackage ifTrue: [nil] ifFalse: [package toolListIcon]]. ^instance
</methods> <methods> Kernel.GeneralNameSpace <category>store utils</category>
dataBindings | list | list := List new. bindings do: [ :i | i isForGeneral ifTrue: [ list add: i ] ]. ^list
</methods> <methods> Tools.CategorizedSelectionModule class <category>instance creation-predefined</category>
forClassesByPackage "self forClassesByPackage open" ^self new categoryModule: TreeSelectionModule forStoreBundlesAndPackages itemModule: ListSelectionModule forClasses itemBlock: [:pundle | self classesInPundle: pundle]
</methods> <methods> Kernel.OverridenStatic <category>accessing</category>
protocol ^self argumentForKeyWord: 'category'
</methods> <methods> Kernel.SourceFileFormat <category>code component support</category>
bundleNamed: name structure: structure on: aStream "Add the changing of a bundle structure event on a stream. " ^self subclassResponsibility
</methods> <methods> Kernel.OverridenStatic <category>accessing</category>
binding ^self object
</methods> <methods> Kernel.AbsentClassImport <category>accessing</category>
absoluteName "HACK. Since #fullName is relative to Smalltak, we have to force it to be relative to nil for Store." ^( self fullName indexOfSubCollection: 'Root' startingAt: 1 ) == 1 ifTrue: [ self fullName ] ifFalse: [ 'Root.Smalltalk.', self fullName ].
</methods> <methods> XML.SourceNodeBuilder <category>compiling-code components</category>
compile_bundle_structure: anElement | reg bundle string | reg := #{Store.Registry} valueOrDo: [ ^nil ]. string := self getString: 'name' from: anElement default: ''. string isEmpty ifTrue: [ ^nil ]. bundle := reg bundleNamedOrCreate: string. string := self getString: 'structure' from: anElement default: ''. bundle structure: ( Compiler evaluate: string ).
</methods> <methods> Kernel.GeneralNameSpace <category>store data</category>
datumDescriptors "Answer a collection of DatumDescriptors for the recievers dataKeys." ^self dataKeys asSortedCollection asOrderedCollection collect: [ :dataKey | Store.DatumDescriptor fromDataKey: dataKey nameSpaceName: self absoluteName ]
</methods> <methods> Kernel.OverridenStatic <category>store</category>
asPseudoRecord "Answer a store psuedo record representing the image version of the class/namespace part of the receiver." | object | object := self owner. ^object isBehavior ifTrue: [ Store.ClassExtensionDescriptor fullName: object absoluteName meta: false ] ifFalse: [ Store.NameSpaceExtensionDescriptor fullName: object absoluteName ]
</methods> <methods> Kernel.Parcel <category>store</category>
asPackage "Answer a package that duplicates the receiver." ^self asPackageNamed: self name.
copyPropertiesTo: pkg "Move the receiver's properties to pkg. Where possible, use accessors." "May have to do a little editing." properties keysAndValuesDo: [ :key : value | [ pkg perform: ( key, ':' ) asSymbol with: value ] on: MessageNotUnderstood do: [ :e | pkg propertyAt: key put: value. e return ] ]
</methods> <methods> Kernel.GeneralNameSpace <category>store data</category>
includesDataKey: dataKey "is this one of the data items." ^self includesKey: dataKey
</methods> <methods> Kernel.XMLSourceFileFormat <category>code component support</category>
bundleStructure: aBundle on: aStream "Save the bundle structure on a Stream." self bundleNamed: aBundle name structure: aBundle structure on: aStream
</methods> <methods> Core.String <category>private-store</category>
asClassNameOnly "Check if the string names meta class and strip the postfix class." ^self namesMetaClass ifTrue: [self classNameOnly] ifFalse: [self copy]
</methods> <methods> Core.Metaclass <category>team tools</category>
absoluteSymbol ^self absoluteName asSymbol
</methods> <methods> Kernel.OverridenStatic <category>store</category>
dataKey ^self key
</methods> <methods> Kernel.BindingReference class <category>tt_utilities</category>
fullNameFrom: aPath name: aString ^( aPath == nil or: [ aPath isEmpty ] ) ifTrue: [ aString asString ] ifFalse: [ ( aPath asQualifiedReference append: aString ) asString ]
</methods> <methods> Kernel.Override <category>store</category>
asPseudoRecord "Answer a store psuedo record representing the image version of the class/namespace part of the receiver." self subclassResponsibility
package "Answer the overriden package, nil if none." ^self sources detect: [ :s | s isPackage ] ifNone: [ nil ].
</methods> <methods> Core.Class <category>store data</category>
includesDataKey: dataKey "is this one of the data items." "should check the class vars." ^self asNameSpace includesKey: dataKey
dataAt: aDataKey put: data "Install a data value. Answer true if ok" self asNameSpace dataAt: aDataKey put: data. ^true
</methods> <methods> Core.String <category>private-store</category>
namesMetaClass "Answer true if the string contains the word class." ^self size > 6 and: [(self copyFrom: self size - 5 to: self size) = ' class']
</methods> <methods> Core.ClassDescription <category>store</category>
methodDescriptors ^self selectors asSortedCollection asOrderedCollection collect: [ :sel | Store.MethodDescriptor fromSelector: sel className: self absoluteName meta: self isMeta ]
</methods> <methods> Core.Class <category>store tools</category>
absoluteSymbol "Answer an environment independant (and therefore truely unique) name" ^(self fullyQualifiedReferenceFrom: nil) asSymbol
</methods> <methods> Kernel.OverridenMethod <category>store</category>
protocolName | p | ^( p := self protocol ) == nil ifTrue: [ ClassOrganizer defaultProtocol ] ifFalse: [ p ]
</methods> <methods> Tools.EntryWithPasteButtonModule class <category>instance creation</category>
forPackages ^self new pasteBlock: [self selectPackage]; yourself
</methods> <methods> Kernel.BindingReference class <category>tt_utilities</category>
newName: newName from: oldQualifiedName | path | path := self parseString: oldQualifiedName. path at: path size put: newName. ^( self path: path ) asString
</methods> <methods> Tools.IncrementalSearchModule class <category>private</category>
findPackagesMatching: aString | pattern packages | pattern := aString trimBlanks, '*'. packages := Store.Registry allPackages. packages := packages copyWith: Store.Registry nullPackage. ^(packages select: [:each | pattern match: each name]) asSortedCollection: [:a :b | a name < b name]
</methods> <methods> Kernel.OverridenStatic <category>store</category>
sourceCode ^self text
</methods> <methods> Store.PackageChooser class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #(#{Kernel.UserMessage} #key: #ChooseAPackage #defaultString: 'Choose a Package' #catalogID: #packages) #min: #(#{Point} 199 275 ) #bounds: #(#{Rectangle} 288 163 665 588 ) ) #component: #(#{SpecCollection} #collection: #( #(#{SequenceViewSpec} #layout: #(#{LayoutFrame} 5 0 40 0 -12 1 -52 1 ) #flags: 15 #model: #packageList #callbacksSpec: #(#{UIEventCallbackSubSpec} #doubleClickSelector: #dClickAccept ) ) #(#{ActionButtonSpec} #layout: #(#{LayoutOrigin} 0 0.774536 0 0.898823 ) #name: #cancelButton #model: #cancel #label: #(#{Kernel.UserMessage} #key: #Cancel #defaultString: 'Cancel' #catalogID: #packages) #defaultable: true ) #(#{ActionButtonSpec} #layout: #(#{LayoutOrigin} 5 0 -43 1 ) #name: #OKbutton #model: #accept #label: #(#{Kernel.UserMessage} #key: #OK #defaultString: 'OK' #catalogID: #packages) #isDefault: true #defaultable: true ) #(#{ActionButtonSpec} #layout: #(#{AlignmentOrigin} 0 0.453581 -43 1 0.5 0 ) #name: #addButton #model: #addNewPackage #label: #(#{Kernel.UserMessage} #key: #Add #defaultString: 'Add' #catalogID: #packages) #defaultable: true ) #(#{LabelSpec} #layout: #(#{AlignmentOrigin} 0 0.5 9 0 0.5 0 ) #label: #dialogHeader ) ) ) )
windowSpecNoCancel "UIPainter new openOnClass: self andSelector: #windowSpecNoCancel" <resource: #canvas> ^#(#{FullSpec} #window: #(#{WindowSpec} #label: #(#{Kernel.UserMessage} #key: #ChooseAPackage #defaultString: 'Choose a Package' #catalogID: #packages) #min: #(#{Point} 199 275 ) #bounds: #(#{Rectangle} 373 204 768 625 ) ) #component: #(#{SpecCollection} #collection: #( #(#{SequenceViewSpec} #layout: #(#{LayoutFrame} 5 0 40 0 -5 1 -50 1 ) #flags: 15 #model: #packageList #callbacksSpec: #(#{UIEventCallbackSubSpec} #doubleClickSelector: #dClickAccept ) ) #(#{ActionButtonSpec} #layout: #(#{LayoutOrigin} 25 0 -43 1 ) #name: #OKbutton #model: #accept #label: #(#{Kernel.UserMessage} #key: #OK #defaultString: 'OK' #catalogID: #packages) #isDefault: true #defaultable: true ) #(#{ActionButtonSpec} #layout: #(#{LayoutOrigin} 0 0.728495 0 0.900709 ) #name: #addButton #model: #addNewPackage #label: #(#{Kernel.UserMessage} #key: #Add #defaultString: 'Add' #catalogID: #packages) #defaultable: true ) #(#{LabelSpec} #layout: #(#{AlignmentOrigin} 0 0.5 9 0 0.5 0 ) #label: #dialogHeader ) ) ) )
</methods> <methods> Store.PublishAsParcelDialog class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{Kernel.UserMessage} #key: #Publish #defaultString: 'Publish' #catalogID: #packages) #min: #(#{Core.Point} 40 20 ) #bounds: #(#{Graphics.Rectangle} 489 157 961 637 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.LayoutFrame} 4 0 5 0 -4 1 -39 1 ) #label: #(#{Kernel.UserMessage} #key: #ParcelOptions #defaultString: 'Parcel options' #catalogID: #packages) ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 11 80 ) #name: #parcelWarningMessage #colors: #(#{UI.LookPreferences} #setForegroundColor: #(#ColorValue #red ) ) #label: #parcelWarningMessage ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 11 25 ) #name: #parcelSave #model: #parcelSave #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #parcelSaveChanged ) #label: #(#{Kernel.UserMessage} #key: #PublishParcel #defaultString: 'Publish Parcel' #catalogID: #packages) ) #(#{UI.CompositeSpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 0 3 ) #label: #(#{Kernel.UserMessage} #key: #ParcelPathC #defaultString: 'Parcel Path:' #catalogID: #packages) ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 100 0 0 0 0 1 25 0 ) #name: #parcelDirectory #flags: 40 #model: #parcelDirectory ) ) #compositeSpec: #(#{UI.CompositeSpec} #layout: #(#{Graphics.LayoutFrame} 11 0 50 0 -11 1 75 0 ) ) ) #(#{UI.CompositeSpecCollection} #collection: #( #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0 0 0.0 0 1.0 0 1.0 ) #label: #(#{Kernel.UserMessage} #key: #StoreOptions #defaultString: 'Store options' #catalogID: #packages) ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0787037 0 0.253333 ) #name: #bundleStructure #model: #bundleStructure #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #bundleStructureChanged ) #label: #(#{Kernel.UserMessage} #key: #IncludeBundleStructure #defaultString: 'Include bundle structure' #catalogID: #packages) ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.174699 0 0.537634 ) #name: #databaseLinks #model: #databaseLinks #label: #(#{Kernel.UserMessage} #key: #WithDatabaseLinks #defaultString: 'With database links' #catalogID: #packages) ) ) #compositeSpec: #(#{UI.CompositeSpec} #layout: #(#{Graphics.LayoutFrame} 15 0 0 0.333333 -5 0.5 75 0.333333 ) ) ) #(#{UI.CompositeSpecCollection} #collection: #( #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0 0 0.0 0 1.0 0 1.0 ) #label: #(#{Kernel.UserMessage} #key: #SourceOptions #defaultString: 'Source options' #catalogID: #packages) ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0722892 0 0.198276 ) #name: #parcelSaveSource #model: #parcelSaveSource #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #parcelSaveSourceChanged ) #label: #(#{Kernel.UserMessage} #key: #SaveSourceFile #defaultString: 'Save source file' #catalogID: #packages) ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.174699 0 0.422414 ) #name: #parcelHideSource #model: #parcelHideSource #label: #(#{Kernel.UserMessage} #key: #HideSourceOnLoad #defaultString: 'Hide source on load' #catalogID: #packages) ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.174699 0 0.681034 ) #name: #parcelPadded #model: #parcelPadded #label: #(#{Kernel.UserMessage} #key: #PadSource #defaultString: 'Pad source' #catalogID: #packages) ) ) #compositeSpec: #(#{UI.CompositeSpec} #layout: #(#{Graphics.LayoutFrame} 15 0 0 0.583333 -5 0.5 80 0.583333 ) ) ) #(#{UI.CompositeSpecCollection} #collection: #( #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.0 0 0.0 0 1.0 0 1.0 ) #label: #(#{Kernel.UserMessage} #key: #MiscellaeonousOptions #defaultString: 'Miscellaeonous Options' #catalogID: #packages) ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0843373 0 0.2 ) #name: #parcelRepublish #model: #parcelRepublish #label: #(#{Kernel.UserMessage} #key: #Republish #defaultString: 'Republish' #catalogID: #packages) ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0843373 0 0.448 ) #name: #parcelBackup #model: #parcelBackup #label: #(#{Kernel.UserMessage} #key: #Backup #defaultString: 'Backup' #catalogID: #packages) ) #(#{UI.CheckBoxSpec} #layout: #(#{Graphics.LayoutOrigin} 0 0.0843373 0 0.712 ) #name: #parcelOverwrite #model: #parcelOverwrite #label: #(#{Kernel.UserMessage} #key: #OverwriteExistingFiles #defaultString: 'Overwrite existing files' #catalogID: #packages) ) ) #compositeSpec: #(#{UI.CompositeSpec} #layout: #(#{Graphics.LayoutFrame} 5 0.5 0 0.583333 -15 1 80 0.583333 ) ) ) #(#{UI.ActionButtonSpec} #layout: #(#{UI.AlignmentOrigin} 10 0 -5 1 0 1 ) #model: #accept #label: #(#{Kernel.UserMessage} #key: #Publish #defaultString: 'Publish' #catalogID: #packages) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{UI.AlignmentOrigin} 0 0.5 -5 1 0.5 1 ) #model: #cancel #label: #(#{Kernel.UserMessage} #key: #Cancel #defaultString: 'Cancel' #catalogID: #packages) #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{UI.AlignmentOrigin} -10 1 -5 1 1 1 ) #model: #helpAction #label: #(#{Kernel.UserMessage} #key: #Help #defaultString: 'Help' #catalogID: #packages) #defaultable: true ) ) ) )
</methods> <methods> Tools.SelectClassDialog <category>pages</category>
installByPackagePage <page: 2 label: #(#ByPackage #labels 'By Package')> | module | module := (CategorizedSelectionModule forClassesByPackage) showLabels: true; firstLabel: #PackagesC << #labels >> 'Packages:'; secondLabel: #ClassesC << #labels >> 'Classes:'; yourself. module itemModule when: #doubleClick evaluate: [self accept value: true]. self installPage: module
</methods> <initialize> Store.XMainChangeSet </initialize> <initialize> Store.Access </initialize> <initialize> Store.PundleAccess </initialize> <initialize> Store.PundleModel </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>SourceFileFormat</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none objectProperties methodProperties <imports></imports> <category>Kernel-Support</category> <attributes> <package>Kernel-Support</package> </attributes> </class> <class> <name>Model</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none dependents <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>CodeComponent</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none name properties <imports></imports> <category>System-Code Components</category> <attributes> <package>System-Code Components</package> </attributes> </class> <class> <name>Parcel</name> <environment>Kernel</environment> <super>Kernel.CodeComponent</super> <private>false</private> none definedObjects definedClasses definedBindings classSelectors namedObjects dirty loaded parcels classParcelMap parcelFileInfoCache parcelFileDirectoryCache dependents <imports></imports> <category>System-Code Components</category> <attributes> <package>System-Code Components</package> </attributes> </class> <class> <name>SimpleDialog</name> <environment>UI</environment> <super>UI.ApplicationModel</super> <private>false</private> none close accept cancel preBuildBlock postBuildBlock postOpenBlock escapeIsCancel parentView <imports></imports> <category>Interface-Dialogs</category> <attributes> <package>Interface-Dialogs</package> </attributes> </class> <class> <name>GeneralBindingReference</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none path cache <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>AbsentClassImport</name> <environment>Kernel</environment> <super>Core.Magnitude</super> <private>false</private> none name isMeta format instanceVariables dummyBehavior dummyClassPool <imports> Core.Behavior.* </imports> <category>System-Code Storage</category> <attributes> <package>System-Code Storage</package> </attributes> </class> <class> <name>ClassDescription</name> <environment>Core</environment> <super>Core.Behavior</super> <private>false</private> none instanceVariables organization <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Metaclass</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none thisClass <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Class</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none name classPool environment <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>Error</name> <environment>Core</environment> <super>Core.Exception</super> <private>false</private> none <imports></imports> <category>Kernel-Exception Handling</category> <attributes> <package>Kernel-Exception Handling</package> </attributes> </class> <class> <name>IdentityDictionary</name> <environment>Core</environment> <super>Core.Dictionary</super> <private>false</private> objects valueArray <imports></imports> <category>Collections-Unordered</category> <attributes> <package>Collections-Unordered</package> </attributes> </class> <class> <name>Override</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none sources definition <imports></imports> <category>System-Overrides</category> <attributes> <package>System-Overrides</package> </attributes> </class> <class> <name>OverridenNameSpace</name> <environment>Kernel</environment> <super>Kernel.Override</super> <private>false</private> none comment documentation <imports></imports> <category>System-Overrides</category> <attributes> <package>System-Overrides</package> </attributes> </class> <class> <name>SourceNodeBuilder</name> <environment>XML</environment> <super>XML.XMLNodeBuilder</super> <private>false</private> none selectors <imports></imports> <category>XML-Source Code</category> <attributes> <package>XML-source</package> </attributes> </class> <class> <name>ChangeSet</name> <environment>Kernel</environment> <super>UI.Model</super> <private>false</private> none objectChanges objectRemoves componentChanges specialDoIts initializationOrder dependents <imports></imports> <category>System-Changes</category> <attributes> <package>System-Changes</package> </attributes> </class> <class> <name>SourceFileManager</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none files names writableIndices openIndices currentTarget isPadding sourceFormatters sourceToCopy <imports></imports> <category>Kernel-Support</category> <attributes> <package>Kernel-Support</package> </attributes> </class> <class> <name>String</name> <environment>Core</environment> <super>Core.CharacterArray</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>GeneralNameSpace</name> <environment>Kernel</environment> <super>Core.KeyedCollection</super> <private>false</private> none organization bindings specificImports generalImports <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>NameSpaceOfClass</name> <environment>Kernel</environment> <super>Kernel.GeneralNameSpace</super> <private>false</private> none owner <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>ChunkSourceFileFormat</name> <environment>Kernel</environment> <super>Kernel.SourceFileFormat</super> <private>false</private> none <imports></imports> <category>Kernel-Support</category> <attributes> <package>Kernel-Support</package> </attributes> </class> <class> <name>ComponentChange</name> <environment>Kernel</environment> <super>Kernel.Change</super> <private>false</private> none componentType componentName <imports></imports> <category>System-Code Component Changes</category> <attributes> <package>System-Code Component Changes</package> </attributes> </class> <class> <name>OverridenStatic</name> <environment>Kernel</environment> <super>Kernel.Override</super> <private>false</private> objects <imports></imports> <category>System-Overrides</category> <attributes> <package>System-Overrides</package> </attributes> </class> <class> <name>XMLSourceFileFormat</name> <environment>Kernel</environment> <super>Kernel.SourceFileFormat</super> <private>false</private> none state docName cachedFile cachedParser <imports> private XML.* </imports> <category>Kernel-Support</category> <attributes> <package>XML-source</package> </attributes> </class> <class> <name>SourceScannerNodeBuilder</name> <environment>XML</environment> <super>XML.XMLNodeBuilder</super> <private>false</private> none selectors currentFile currentPosition positions changeBlock <imports></imports> <category>XML-Source Code</category> <attributes> <package>XML-source</package> </attributes> </class> <class> <name>OverridenMethod</name> <environment>Kernel</environment> <super>Kernel.Override</super> <private>false</private> none selector protocol instVarNames <imports></imports> <category>System-Overrides</category> <attributes> <package>System-Overrides</package> </attributes> </class> <class> <name>DefinitionCreationDialog</name> <environment>Tools</environment> <super>UI.SimpleDialog</super> <private>false</private> none packageModule namespaceModule nameHolder privateHolder importsHolder <imports> private Refactory.Browser.Navigator </imports> <category>Tools-Programming</category> <attributes> <package>Tools-Programming</package> </attributes> </class> <class> <name>Warning</name> <environment>Core</environment> <super>Core.Exception</super> <private>false</private> none <imports></imports> <category>Kernel-Exception Handling</category> <attributes> <package>Kernel-Exception Handling</package> </attributes> </class> <class> <name>SelectClassDialog</name> <environment>Tools</environment> <super>UI.SimpleDialog</super> <private>false</private> none tabListHolder pageSubCanvas selectionHolder windowLabel <imports></imports> <category>Tools-Dialogs</category> <attributes> <package>Tools-Dialogs</package> </attributes> </class> <class> <name>OverridenClass</name> <environment>Kernel</environment> <super>Kernel.Override</super> <private>false</private> objects comment documentation <imports></imports> <category>System-Overrides</category> <attributes> <package>System-Overrides</package> </attributes> </class>