'From Squeak3.2alpha of 8 October 2001 [latest update: #4461] on 31 October 2001 at 4:09:10 pm'! "Change Set: ModulesPostOopsla Date: 31 October 2001 Author: Henrik Gedenryd This change set contains various changes that have been made since the OOPSLA version at Oct 15. Note that this file was hand-edited."! Class subclass: #DeltaClass instanceVariableNames: 'deltaForMetaOrNonMeta ' classVariableNames: '' poolDictionaries: '' category: 'Language-Modules'! Object subclass: #Module instanceVariableNames: 'version parentModule neighborModules definedNames exportedNames repository ' classVariableNames: 'Annotations OutOfScopeCache RootModule SmalltalkModule TargetModule ' poolDictionaries: '' category: 'Language-Modules'! !Module commentStamp: '' prior: 0! All "neighbor modules"--external modules, submodules, module parameters, delta modules--are held in an OrderedCollection to strictly define the order of lookup for names defined outside this module. Note that the annotations dictionary can hold annotations for any object in the system: classes, individual methods, etc. "The period between 23 July and 23 August is nicknamed 'RūtmŌnad' - literally 'rotting month', but also referred to as 'dog days', when food rots quicker than usual (...) In damp, warm weather, bacteria thrive. If you hurt yourself, the wound is more likely to become infected than usual. In the old days, this particular month was known as a time when anything could happen. People thought for instance that calves could be born with two heads. Such strange occurences became known as 'rotting-month events'." ! ]style[(838 58 1)f1,f1Rhttp://www.inv.se/svefa/tradition/engtrad/engrotmanad.html;,f1! !DeltaModule commentStamp: '' prior: 0! The mojo of this class is that it unifies a number of different functionalities (once complete): - A DeltaModule is relative to another module (a defined version of it), hence Delta. It should be able to define any modifications w r t a base module Unlike change sets, it should not record the changes, but define the final state, it just does it in a diff-format for efficiency. Hence, it still provides an exact definition of a module but in relative format. It is meant to subsume change sets while being more rigorous and also module-aware. - When loaded into the image, it can still be activated or not. Ie. its differences wrt the base may be installed into the base module or not. - (De)activation can be done atomically (like isolatedProjects), and separate from code loading. - Class extensions Deltas are meant to be used for holding class extensions (things like String>>asUrl or Object>>isDraggableMorph). - De/activate yields a form of "layers" for handling package conflicts. - DeltaModules (and regular Modules) should subsume the PackageBrowser, as a package can be read into the image, edited, etc. without being installed and active, the usual tools should handle it. In the long run, the design goal of DeltaModules and -classes should be to use a minimal amount of memory to represent differences w r t the base, while being virtually indistinguishable from a normal module/class, at least in terms of usability.! Object subclass: #ModuleInstaller instanceVariableNames: 'startModuleRef operation createdModules downloadedModules loadedModules activatedModules progressIndicator progressValue ' classVariableNames: '' poolDictionaries: '' category: 'Language-Modules-Repositories'! ModuleRefactorer subclass: #FromVersion0p0002to0003 instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Language-Modules-Refactorings'! Model subclass: #Project instanceVariableNames: 'world changeSet transcript parentProject previousProject displayDepth viewSize thumbnail nextProject guards projectParameters isolatedHead inForce version urlList module lastDirectory lastSavedAtSeconds projectPreferenceFlagDictionary resourceManager ' classVariableNames: 'AllProjects CurrentProject GoalFreePercent GoalNotMoreThan UIProcess ' poolDictionaries: '' category: 'Technology-Support'! Object subclass: #Repository instanceVariableNames: 'module directory isStandalone isAbstract ' classVariableNames: '' poolDictionaries: '' category: 'Language-Modules-Repositories'! !Applescript class methodsFor: 'initialize-release' stamp: 'hg 10/31/2001 16:16'! unload Smalltalk removeFromStartUpList: self. ApplescriptGeneric _ nil.! ! !Browser methodsFor: 'class list' stamp: 'hg 10/31/2001 13:09'! selectedClass "Answer the class that is currently selected. Answer nil if no selection exists." | name | (name _ self selectedClassName) ifNil: [^ nil]. ^Module root allDefinitionsFor: name onlyExported: false detect: [:value :module | (value isKindOf: Class) and: [ self selectedSystemCategoryName = module simulatedCategory]]! ! !ClassDescription methodsFor: 'organization' stamp: 'hg 10/28/2001 12:29'! selectorsForCategory: aSymbol ^ (aSymbol asString = ClassOrganizer allCategory) ifTrue: [ self organization allMethodSelectors ] ifFalse: [ self organization listAtCategoryNamed: aSymbol ]. ! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'hg 10/28/2001 12:30'! fileOutCategory: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex "File a description of the receiver's category, aString, onto aFileStream. If moveSource, is true, then set the method source pointer to the new file position. Note when this method is called with moveSource=true, it is condensing the .sources file, and should only write one preamble per method category." aFileStream cr. "Overridden to preserve author stamps in sources file regardless" (self selectorsForCategory: aSymbol) do: [:sel | self printMethodChunk: sel withPreamble: true on: aFileStream moveSource: moveSource toFile: fileIndex]. ^ self! ! !Class methodsFor: 'initialize-release' stamp: 'hg 10/30/2001 13:37'! activate "Sent when a (Delta)Module holding the class is activated. Does nothing, but may be overridden in Metaclasses." ^self! ! !Class methodsFor: 'initialize-release' stamp: 'hg 10/30/2001 13:38'! deactivate "Sent when a (Delta)Module holding the class is deactivated. Does nothing, but may be overridden in Metaclasses." ^self! ! !Class methodsFor: 'initialize-release' stamp: 'hg 10/30/2001 13:55'! unload "Sent when a (Delta)Module holding the class is unloaded. Does nothing, but may be overridden in Metaclasses." ^self! ! !Class methodsFor: 'copying' stamp: 'hg 10/29/2001 20:36'! copy | newClass | newClass _ self class copy new superclass: superclass methodDict: self methodDict copy format: format name: name organization: self organization copy instVarNames: instanceVariables copy classPool: classPool copy sharedPools: sharedPools. "need to manually copy all instVars not covered by the above" newClass module: module. Class instSize+1 to: self class instSize do: [:offset | newClass instVarAt: offset put: (self instVarAt: offset)]. ^ newClass! ! !Class methodsFor: 'compiling' stamp: 'hg 10/29/2001 12:56'! lenientScopeHas: varName ifTrue: assocBlock "the standard mode when working with code for now. Allows unrestricted use of global names." (self strongScopeHas: varName ifTrue: assocBlock) ifTrue: [^true]. "Look it up in Smalltalk to allow references to all global names (except modules)." Module smalltalk associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]. ^false ! ! !Class methodsFor: 'compiling' stamp: 'hg 10/29/2001 12:59'! scopeHas: varName ifTrue: assocBlock ^ Preferences lenientScopeForGlobals ifTrue: [self lenientScopeHas: varName ifTrue: assocBlock] ifFalse: [Preferences strongModules ifTrue: [self strongScopeHas: varName ifTrue: assocBlock] ifFalse: [self weakScopeHas: varName ifTrue: assocBlock]]! ! !Class methodsFor: 'compiling' stamp: 'hg 10/29/2001 11:52'! scopeModule "answer the module in which to look up the global names used in my methods" ^self module! ! !Class methodsFor: 'compiling' stamp: 'hg 10/29/2001 11:58'! strongScopeHas: varName ifTrue: assocBlock "Like the regular scopeHas but this one always uses the lookup rules for strong modularity. Use this to e.g. check code from modularity point of view when under weak modules scheme. " self definesName: varName lookInSuper: true ifTrue: [:a | assocBlock value: a. ^ true]. "Next ask home module to look up name." self scopeModule associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]. ^false! ! !Class methodsFor: 'compiling' stamp: 'hg 10/30/2001 13:19'! weakScopeHas: varName ifTrue: assocBlock "Like the regular scopeHas but this one always uses the lookup rules for weak modularity. I.e. see all names exported from all external and submodules. " | assoc | self definesName: varName lookInSuper: true ifTrue: [:a | assocBlock value: a. ^ true]. "Next ask home module to look up name. Treat all neighbors as imported. " assoc _ self scopeModule localAssocFor: varName ifAbsent: [ "look in all external and submodules." self scopeModule neighborModules do: [:mod | mod exportedAssocFor: varName ifPresent: [:a :m | assocBlock value: a. ^ true]]. nil]. assoc ifNotNil: [assocBlock value: assoc. ^true]. "Finally look it up globally. This is a compatibility patch for now. Look it up this way instead of in Smalltalk to test multiple name definitions. Commented out or analysis of global references will always find names. " "Module root associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]." ^false! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 19:08'! addSelector: selector withMethod: compiledMethod "override to use DeltaAssociations" self redefineSelector: selector withMethod: compiledMethod previousVersion: nil ! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 12:41'! baseClass | nonMeta | nonMeta _ self module baseModule definitionFor: self theNonMetaClass name ifAbsent: [^nil]. ^self isMeta ifFalse: [nonMeta] ifTrue: [nonMeta class]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 21:36'! definesName: varName lookInSuper: lookInSuper ifTrue: assocBlock "preliminary, should take DeltaModule neighbor changes into account" ^self baseClass definesName: varName lookInSuper: lookInSuper ifTrue: assocBlock! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 12:05'! deltaForMetaclass ^self isMeta ifTrue: [self error: 'I am already a delta on a metaclass'] ifFalse: [self metaOrNonMeta]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 19:53'! derivedBaseClassWhenActive: shouldBeActive "return an instance of my baseClass where my changes have been (de)activated. Install if shouldBeActive is true, otherwise uninstall changes. Handle both class and metaclass. This method should get more sophisticated over time to handle (de)activating 1. method additions, removals and modifications (handled now) 2. class var additions (removals ?) 3. inst var additions (removals ?) -- how handle existing instances? 4. deeper class format changes, e.g. changed superclass The hard part of 3-4 is to handle converting existing instances." | after | after _ self baseClass copy. self installMethodChangesIntoClass: after asActive: shouldBeActive. self deltaForMetaclass installMethodChangesIntoClass: after class asActive: shouldBeActive. ^Array with: after with: after class! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 12:34'! fileOutContentsOn: aFileStream moveSource: moveSource toFile: fileIndex super fileOutContentsOn: aFileStream moveSource: moveSource toFile: fileIndex. self fileOutMethodRemovalsOn: aFileStream ! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 12:34'! fileOutMethodRemovalsOn: aStream | removals | removals _ self removedSelectors. removals isEmpty ifFalse: [ aStream nextChunkPut: self name, ' undefinedSelectors: ', removals asSortedCollection asArray literalPrintString, '.'; cr]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/29/2001 15:53'! initializeDelta "clean out methods and categories. Use regular dictionaries to allow for DeltaAssociations" methodDict _ Dictionary new. self zapOrganization! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 19:39'! installMethodChangesIntoClass: classOrMeta asActive: shouldBeActive | value selector | self methodDict associationsDo: [:deltaAssoc | value _ deltaAssoc valueWhenActive: shouldBeActive. selector _ deltaAssoc key. value ifNil: [classOrMeta removeSelectorUnlogged: selector] ifNotNil: [ classOrMeta addSelector: selector withMethod: value. classOrMeta organization classify: selector under: (self organization categoryOfElement: selector)]]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 19:59'! isMeta ^name isNil! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 21:42'! lenientScopeHas: varName ifTrue: assocBlock "preliminary, should take DeltaModule neighbor changes into account" ^self baseClass lenientScopeHas: varName ifTrue: assocBlock! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 20:46'! metaOrNonMeta ^deltaForMetaOrNonMeta! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 20:07'! metaOrNonMeta: aDeltaClass deltaForMetaOrNonMeta _ aDeltaClass! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 21:40'! module ^self isMeta ifFalse: [module] ifTrue: [self theNonMetaClass module]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 12:41'! name ^self isMeta ifTrue: [self theNonMetaClass name, ' class'] ifFalse: [name]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/27/2001 14:01'! nonTrivial "Answer whether the receiver has any methods or instance variables." ^ self instVarNames size > 0 or: [self methodDict size > 0]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 12:44'! printOn: aStream aStream nextPutAll: self name, ' DeltaClass'! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 19:07'! redefineSelector: selector withMethod: methodOrNil previousVersion: oldMethodOrNil self methodDict add: (DeltaAssociation key: selector value: methodOrNil previousValue: oldMethodOrNil)! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 12:32'! removedSelectors ^self methodDict select: [:cm | cm isNil]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 20:44'! scopeHas: varName ifTrue: assocBlock "preliminary, should take DeltaModule neighbor changes into account" ^self baseClass scopeHas: varName ifTrue: assocBlock! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 12:31'! selectorsForCategory: aSymbol ^ (super selectorsForCategory: aSymbol) difference: self removedSelectors! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 20:44'! strongScopeHas: varName ifTrue: assocBlock "preliminary, should take DeltaModule neighbor changes into account" ^self baseClass strongScopeHas: varName ifTrue: assocBlock! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 19:56'! theNonMetaClass ^self isMeta ifFalse: [self] ifTrue: [self metaOrNonMeta]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 19:12'! undefinedSelectors: selectors selectors do: [:sel | self redefineSelector: sel withMethod: nil previousVersion: (self baseClass compiledMethodAt: sel)]! ! !DeltaClass methodsFor: 'as yet unclassified' stamp: 'hg 10/28/2001 20:44'! weakScopeHas: varName ifTrue: assocBlock "preliminary, should take DeltaModule neighbor changes into account" ^self baseClass weakScopeHas: varName ifTrue: assocBlock! ! !DeltaClass class methodsFor: 'as yet unclassified' stamp: 'hg 10/30/2001 11:29'! checkClasses "self checkClasses" Module root deepSubmodulesDo: [:m | m == Module smalltalk ifFalse: [ m allClassesDo: [:cl | cl class theNonMetaClass == cl ifFalse: [Transcript space; show: cl module path; space; show: cl]]]].! ! !DeltaClass class methodsFor: 'as yet unclassified' stamp: 'hg 10/30/2001 11:24'! checkModuleInClasses "self checkModuleInClasses" Module root deepSubmodulesDo: [:m | m == Module smalltalk ifFalse: [ m allClassesDo: [:cl | cl module == m ifFalse: [Transcript space; show: cl]]]].! ! !DeltaClass class methodsFor: 'as yet unclassified' stamp: 'hg 10/30/2001 11:38'! fixClasses "self fixClasses" Module root deepSubmodulesDo: [:m | m == Module smalltalk ifFalse: [ m allClassesDo: [:cl | cl class theNonMetaClass == cl ifFalse: [ Transcript space; show: cl. cl class silentlyReplaceInstanceWith: cl]]]]. ! ! !DeltaClass class methodsFor: 'as yet unclassified' stamp: 'hg 10/30/2001 11:24'! fixModuleInClasses "self fixModuleInClasses" Module root deepSubmodulesDo: [:m | m == Module smalltalk ifFalse: [ m allClassesDo: [:cl | cl module == m ifFalse: [ Transcript space; show: cl. cl module: m]]]].! ! !DeltaClass class methodsFor: 'as yet unclassified' stamp: 'hg 10/25/2001 18:54'! on: baseClass inDeltaModule: deltaModule "return the object used to represent the regular class baseClass in a DeltaModule. For now use simplest possible copy of the original class, with its own copy of the meta class, for maximum compatibility." | delta copy metaDelta | copy _ baseClass copy. delta _ copy as: self. metaDelta _ copy class as: self. delta initializeDelta; metaOrNonMeta: metaDelta. metaDelta initializeDelta; metaOrNonMeta: delta. delta module: deltaModule. ^delta! ! !Encoder methodsFor: 'private' stamp: 'hg 10/29/2001 12:59'! lookupInPools: varName ifFound: assocBlock ^class scopeHas: varName ifTrue: assocBlock! ! !Metaclass methodsFor: 'private' stamp: 'hg 10/30/2001 11:37'! silentlyReplaceInstanceWith: newInstance thisClass _ newInstance.! ! !ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 10/31/2001 13:09'! categoryOfElement: c "old-style use, we know that c is the name of a class" Module root allDefinitionsFor: c onlyExported: false detect: [:value :mod | (value isKindOf: Class) ifTrue: [^mod simulatedCategory]]. ^nil! ! !ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 10/31/2001 13:10'! numberOfCategoryOfElement: name "Answer the index of the category with which the argument, name, is associated." | categoryName | Module root allDefinitionsFor: name onlyExported: false detect: [:value :module | (value isKindOf: Class) ifTrue: [ categoryName _ module simulatedCategory. self categories withIndexDo: [:cat :index | cat = categoryName ifTrue: [^index]]]]. ^0! ! !Module methodsFor: 'accessing' stamp: 'hg 10/28/2001 18:06'! annotationAt: aString ^self class annotationFor: self at: aString! ! !Module methodsFor: 'accessing' stamp: 'hg 10/28/2001 18:09'! annotationAt: aString ifAbsent: aBlock ^self class annotationFor: self at: aString ifAbsent: aBlock! ! !Module methodsFor: 'accessing' stamp: 'hg 10/28/2001 18:09'! annotationAt: aString put: value ^self class annotationFor: self at: aString put: value! ! !Module methodsFor: 'accessing' stamp: 'hg 10/28/2001 20:48'! annotations ^self class annotationsFor: self! ! !Module methodsFor: 'accessing' stamp: 'hg 10/29/2001 16:11'! repository "If I don't have an explicit repository, create an implicit one on request." ^repository ifNil: [Repository on: self]! ! !Module methodsFor: 'testing' stamp: 'hg 10/31/2001 13:15'! shouldExportSubmodules "should submodules be exported by default?" ^false! ! !Module methodsFor: 'changing defined names' stamp: 'hg 10/31/2001 13:10'! validateName: aString forValue: anObject "Validate the name for a new binding" | oldAssoc defModule | aString first isUppercase ifFalse:[ self error: 'The name must be capitalized'. ^false]. oldAssoc _ self localAssocFor: aString ifAbsent:[nil]. oldAssoc ifNil: [ "check if name already used in a different module" Module root allDefinitionsFor: aString onlyExported: false detect: [:v :m | defModule _ m. true]. defModule ifNotNil: [ self notify: 'The name ', aString asText allBold, ' is already defined in module ', defModule pathAsMessages, '.\Proceed will create a second definition with this name.' withCRs]] ifNotNil: [ "don't protest if e.g. the new value is a new class and the old value was a class too" (oldAssoc value isKindOf: anObject class) ifFalse: [ self notify: 'The name ', aString asText allBold, ' is already used in module ', self pathAsMessages, '!!\Proceed will store over it.' withCRs]]. ^true! ! !Module methodsFor: 'module definition protocol' stamp: 'hg 10/24/2001 20:11'! submodule: mod name: submoduleName version: versionOrNil importNames: shouldImport "use this message to declare a submodule of this module" | ref submodule | submodule _ mod ifNil: [Module new]. submodule version: submodule verbatimVersion parentModule: self. ref _ SubmoduleReference new name: submoduleName version: versionOrNil module: submodule import: shouldImport. self addNeighborModule: ref export: self shouldExportSubmodules. ^submodule ! ! !Module methodsFor: 'changing module composition' stamp: 'hg 10/29/2001 19:25'! addNeighborModule: moduleReference export: shouldExport (self hasNeighborModule: moduleReference module) ifTrue: [ self error: 'Neighbor module ', moduleReference module pathAsMessages, ' already exists.']. moduleReference isModuleResolved & moduleReference importNames ifTrue: [ self checkImportForCircularity: moduleReference module]. moduleReference hasAlias ifTrue: [ self defineName: moduleReference name as: moduleReference module export: shouldExport]. self addNeighborModuleRef: moduleReference. ! ! !Module methodsFor: 'changing module composition' stamp: 'hg 10/30/2001 18:58'! cleanOutModule "Removing a module from the image ought to be as easy as removing from parent, but it ain't for compatibility reasons. Do other necessary things here." | classes | "classes have special removal needs" classes _ OrderedCollection new. self allClassesDo: [:cl | classes add: cl]. (ChangeSet superclassOrder: classes) reversed do: [:cl | cl removeFromSystem]. "under weak modules you must clear the names (from Smalltalk)" Preferences strongModules ifFalse: [ self definedNames keys do: [:name | self removeName: name]]. parentModule _ nil ! ! !Module methodsFor: 'change sets' stamp: 'hg 10/30/2001 09:43'! changes "this was pre-DeltaModules and is now obsolete" ^Smalltalk changes! ! !Module methodsFor: 'change sets' stamp: 'hg 10/30/2001 09:43'! changes: cs "this was pre-DeltaModules and is now obsolete" ^self! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 10/27/2001 14:55'! classDefinitionFor: class "return a string with a message that defines the given variable in this module. ClassBuilder adds class to the module by itself." ^(class modularDefinition: false), 'self'! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 10/29/2001 19:35'! definition "Answer a String that builds the definition of the receiver as messages to it (don't print the receiver)." | aStream | aStream _ WriteStream on: (String new: 300). "Keep flag: messages with used selectors here so that this code will be updated if the selectors are changed." self flag: #version: . aStream "nextPutAll: self class name, ' new';" crtab; nextPutAll:'version: '; print: self verbatimVersion. self neighborDefinitionsOn: aStream. aStream nextPut: $; ; crtab; nextPutAll: 'yourself. '. ^ aStream contents! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 10/27/2001 14:09'! neighborDefinitionsOn: aStream self neighborModuleRefs do: [:ref | aStream nextPut: $;; crtab. ref storeOn: aStream]. ! ! !Module methodsFor: 'user interface' stamp: 'hg 10/29/2001 17:45'! moduleExplorerContents | list | list _ OrderedCollection new. list add: (ModuleExplorerWrapper with: self neighborModuleRefs name: 'neighbor modules' model: self); add: (ModuleExplorerWrapper with: self definedNames name: 'defined names' model: self); add: (ModuleExplorerWrapper with: self exportedNames name: 'exported names' model: self). repository ifNotNil: [ list add: (ModuleExplorerWrapper with: self repository name: 'repository' model: self)]. self verbatimVersion ifNotNil: [ list add: (ModuleExplorerWrapper with: self verbatimVersion name: 'version' model: self)]. self annotations associationsDo: [:assoc | list _ list copyWith: (ModuleExplorerWrapper with: assoc value name: assoc key model: assoc)]. ^list ! ! !Module methodsFor: 'code analysis' stamp: 'hg 10/30/2001 17:06'! deepIncomingRefsFromOutside: module "(Module fromPath: #(EToy Experimental)) localUniqueMessagesToOutside: (Module fromPath: #(EToy))" | refs insideModules n total | refs _ IdentityDictionary new. insideModules _ IdentitySet new. module deepSubmodulesDo: [:mod | insideModules add: mod]. self deepSubmodulesDo: [:mod | mod definedNames keysAndValuesDo: [:key :value | (value isKindOf: Module) ifTrue: [ "Transcript show: 'References to Module name ', key, ' ignored.';cr"] ifFalse: [refs at: key put: Set new]]]. total _ 0. self class root deepClassesDo: [:cl | total _ total + 1]. 'Locating outside references to global definitions ...' displayProgressAt: Sensor cursorPoint from: 0 to: total during: [:bar | n _ 0. self class root deepClassesDo: [:cl | bar value: (n_ n+1). (insideModules includes: cl module) ifFalse: [ cl selectorsAndMethodsDo: [:sel :cm | cm literals do: [:lit | (lit respondsTo: #key) ifTrue: [ refs at: lit key ifPresent: [:set | set add: (MethodReference new setStandardClass: cl methodSymbol: sel)]]]]]]]. refs copy keysAndValuesDo: [:key :value | value isEmpty ifTrue: [refs removeKey: key]]. ^refs! ! !Module methodsFor: 'code analysis' stamp: 'hg 10/30/2001 13:23'! localUnresolvedRefs "all unresolved global references from code in this Module" "(Module fromPath: #(Morphic)) localUnresolvedRefs" | lits list allClasses found | list _ OrderedCollection new. allClasses _ OrderedCollection new. self allClassesDo: [:cls | allClasses addLast: cls; addLast: cls class]. allClasses do: [:cl | cl methodDict keysAndValuesDo: [:sel :cm | lits _ cm literals. found _ lits detect: [:lit | lit isVariableBinding and: [(lit value == cl or: [ self scopedLookup: lit key inClass: cl cachedIn: OutOfScopeCache]) not]] ifNone: [nil]. found ifNotNil: [ list add: ( MethodReference new setStandardClass: cl methodSymbol: sel)]]. "check if class definition uses unresolved global name (as superclass)" (cl isMeta or: [self scopedLookup: cl superclass name inClass: cl cachedIn: OutOfScopeCache]) ifFalse: [ list add: ( MethodReference new setStandardClass: cl methodSymbol: #classCreationMessage)]]. ^list! ! !Module methodsFor: 'system conversion' stamp: 'hg 10/29/2001 15:51'! defineClassExtensionsOutside: homeModule "Collect class extensions from this module as DeltaModules of this module. Class extensions are here detected as methods outside this module that contain references to global names defined by this module (note that this finds far from all eligible methods). Find all such methods in all classes outside homeModule, then add to this module DeltaModules with classes referring to those methods. This does not at all affect the actual classes or methods." | incoming deltaModule deltaClass method n | incoming _ self deepIncomingRefsFromOutside: homeModule. Smalltalk newChanges: (ChangeSet basicNewNamed: self name, 'Reorganization', Time now printString). ChangeSorter initialize. 'Collecting extension methods ...' displayProgressAt: Sensor cursorPoint from: 0 to: incoming size during: [:bar | n _ 0. incoming keysAndValuesDo: [:key :upstreamMethodRefs | bar value: (n _ n + 1). upstreamMethodRefs do: [:mref | deltaModule _ self deltaModuleForBase: mref actualClass module forceCreate: true asActive: true. deltaClass _ deltaModule deltaClassFor: mref actualClass forceCreate: true. method _ mref actualClass compiledMethodAt: mref methodSymbol. deltaClass addSelector: mref methodSymbol withMethod: method]]]. ^incoming! ! !DeltaModule methodsFor: 'testing' stamp: 'hg 10/25/2001 18:08'! isDeltaClass: class | theNonMetaClass | theNonMetaClass _ class isMeta ifTrue: [class theNonMetaClass] ifFalse: [class]. self definitionFor: theNonMetaClass name ifAbsent: [^false]. self baseModule definitionFor: theNonMetaClass name ifAbsent: [^false]. ^true! ! !DeltaModule methodsFor: 'accessing' stamp: 'hg 10/25/2001 18:20'! name ^(self baseModule pathAsMessages, ' Delta') asSymbol ! ! !DeltaModule methodsFor: 'initializing' stamp: 'hg 10/28/2001 19:01'! baseModule: base parentModule: parent baseModule _ base. parentModule _ parent. self markAsActive: false.! ! !DeltaModule methodsFor: 'changing defined names' stamp: 'hg 10/9/2001 13:25'! addAssoc: assoc export: exportIt "by default add DeltaAssociation with previousValue = nil" ^super addAssoc: (assoc as: DeltaAssociation) export: exportIt ! ! !DeltaModule methodsFor: 'fileIn/Out' stamp: 'hg 10/25/2001 21:09'! classDefinitionFor: class "return a string with a message that defines the given class in this module. Use minimal definition for delta classes for now, since they can only contain method changes for now." ^(self isDeltaClass: class) ifFalse: [super classDefinitionFor: class] ifTrue: [ 'self deltaClassFor: self baseModule ', class name]! ! !DeltaModule methodsFor: 'fileIn/Out' stamp: 'hg 10/28/2001 20:28'! fileOutMethodsOn: aStream moveSource: moveSource toFile: fileIndex self allClassesDo: [:class | class fileOutContentsOn: aStream moveSource: moveSource toFile: fileIndex. class deltaForMetaclass nonTrivial ifTrue: [ class deltaForMetaclass fileOutContentsOn: aStream moveSource: moveSource toFile: fileIndex]]! ! !DeltaModule methodsFor: 'fileIn/Out' stamp: 'hg 10/27/2001 14:17'! neighborDefinitionsOn: aStream "store the changes that I make realtive to base. not the final implementaiton yet" self changedNeighborModuleRefs do: [:ref | aStream nextPut: $;; crtab. ref storeOn: aStream.]! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/25/2001 18:54'! deltaClassFor: baseClass | deltaClass | deltaClass _ DeltaClass on: baseClass inDeltaModule: self. self redefineName: baseClass name as: deltaClass export: true. (self definedNames associationAt: baseClass name) previousValue: deltaClass. ^deltaClass. ! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/25/2001 18:32'! deltaClassFor: baseClassOrMeta forceCreate: create | baseClass deltaClass assoc | baseClass _ baseClassOrMeta theNonMetaClass. baseClass module == self baseModule ifFalse: [ self error: baseClass name, ' is not defined in my base module']. assoc _ self localAssocFor: baseClass name ifAbsent: [ ^create ifTrue: [self deltaClassFor: baseClass]]. deltaClass _ assoc value. (deltaClass isKindOf: Class) ifFalse: [ self error: assoc key, ' is not a class']. ^baseClassOrMeta isMeta ifFalse: [deltaClass] ifTrue: [deltaClass deltaForMetaclass]! ! !DeltaModule methodsFor: 'de/activating' stamp: 'hg 10/25/2001 19:52'! switchDeltaClasses: shouldBeActive | preSwitchObjects postSwitchObjects | preSwitchObjects _ OrderedCollection new. postSwitchObjects _ OrderedCollection new. self deltaClassesDo: [:deltaClass | preSwitchObjects add: deltaClass baseClass; add: deltaClass baseClass class. postSwitchObjects addAll: (deltaClass derivedBaseClassWhenActive: shouldBeActive)]. ^Array with: preSwitchObjects with: postSwitchObjects! ! !Module class methodsFor: 'class initialization' stamp: 'hg 10/29/2001 12:10'! initialize "Module initialize" self createModularClassDefinitionsPreference. self createStrongModulesPreference. self resetWeakModules. self initializeAnnotations. RootModule _ VirtualRootModule setup. SmalltalkModule _ TransitionalSmalltalkModule setup. ! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 10/24/2001 20:12'! fromPath: modulePath forceCreate: force "return the module with the given path" "don't be case sensitive but preserve given case when creating names" | subref | ^modulePath inject: self root into: [:mod :localName | subref _ mod neighborModuleRefs detect: [:ref | ref isSubmodule and: [ref isModuleResolved and: [ ref name asLowercase = localName asLowercase]]] ifNone: [nil]. subref ifNotNil: [subref module] ifNil: [force ifFalse: [^nil] ifTrue: [mod submodule: nil name: localName version: nil importNames: false]]]! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 10/29/2001 12:10'! root ^RootModule! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 10/29/2001 12:10'! smalltalk "return the module whose dictionary is Smalltalk. use this method instead of hardcoding references to Smalltalk" ^SmalltalkModule! ! !Module class methodsFor: 'fileIn/Out' stamp: 'hg 10/29/2001 12:15'! scopeModule "semi-unclean hook to direct name lookup in fileIns to the right module" ^TargetModule ifNil: [super scopeModule]! ! !Module class methodsFor: 'fileIn/Out' stamp: 'hg 10/29/2001 12:15'! scopeModuleInstance: aModule TargetModule _ aModule! ! !Module class methodsFor: 'system conversion' stamp: 'hg 10/24/2001 20:13'! generateSubmodules: moduleList for: mod "a utility method, see Module>>topLevelModuleList" | modName submods submod | moduleList do: [:item | item class == Array ifFalse: [modName _ item. submods _ #()] ifTrue: [modName _ item first. submods _ item second]. submod _ mod localAssocFor: modName ifAbsent: [ mod submodule: nil name: modName version: nil importNames: false]. self generateSubmodules: submods for: submod].! ! !Module class methodsFor: 'annotations' stamp: 'hg 10/28/2001 20:47'! annotationFor: object at: key ^(Annotations at: object ifAbsent: [nil]) doIfNotNil: [:dictForObject | dictForObject at: key]! ! !Module class methodsFor: 'annotations' stamp: 'hg 10/28/2001 20:47'! annotationFor: object at: key ifAbsent: aBlock ^(Annotations at: object ifAbsent: [^aBlock value]) at: key ifAbsent: aBlock! ! !Module class methodsFor: 'annotations' stamp: 'hg 10/28/2001 20:49'! annotationFor: object at: key put: value "Note that this can hold annotations for any object in the system: classes, individual methods, etc." ^(Annotations at: object ifAbsentPut: [Dictionary new]) at: key put: value! ! !Module class methodsFor: 'annotations' stamp: 'hg 10/28/2001 20:47'! annotationsFor: key ^Annotations at: key ifAbsent: [Dictionary new]! ! !Module class methodsFor: 'annotations' stamp: 'hg 10/28/2001 20:47'! initializeAnnotations Annotations _ WeakKeyDictionary new.! ! !ModuleExplorer methodsFor: 'as yet unclassified' stamp: 'hg 10/29/2001 15:52'! trash "some example expressions to try" ^'NOTE: You may close this window at any time. will get a new one "try these on some modules (cmd-p / cmd-I)..." self declareExternalRefs. self viewDeepUnresolvedRefs. self path self deepIncomingRefsFromOutside: self self deepIncomingRefsFromOutside: parentModule self deepUniqueMessagesToOutside: self self defineClassExtensionsOutside: self self repository cache ensureUpload self repository cache loadModuleContents self repository loadModuleContents self repository directory url ' ! ! !ModuleInstaller methodsFor: 'initialize-reset' stamp: 'hg 10/28/2001 16:02'! clearActivatedModules activatedModules _ OrderedCollection new. ! ! !ModuleInstaller methodsFor: 'initialize-reset' stamp: 'hg 10/28/2001 16:03'! clearCreatedModules createdModules _ OrderedCollection new! ! !ModuleInstaller methodsFor: 'initialize-reset' stamp: 'hg 10/28/2001 16:04'! clearDownloadedModules downloadedModules _ OrderedCollection new! ! !ModuleInstaller methodsFor: 'initialize-reset' stamp: 'hg 10/28/2001 16:04'! clearLoadedModules loadedModules _ OrderedCollection new! ! !ModuleInstaller methodsFor: 'initialize-reset' stamp: 'hg 10/28/2001 16:04'! initialize self clearLoadedModules. self clearCreatedModules. self clearDownloadedModules. self clearLoadedModules. self clearActivatedModules. ! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 10/30/2001 20:58'! removeModule: module "Remove module from the module hierarchy" module parentModule removeNeighborModule: module. module cleanOutModule! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 10/30/2001 20:59'! removeModules: modulesToRemove self ensureNoUsersOf: modulesToRemove. modulesToRemove do: [:module | self removeModule: module].! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 10/30/2001 20:59'! reverseDefinedModules self removeModules: createdModules reversed. self clearCreatedModules ! ! !ModuleInstaller methodsFor: '(un)loading' stamp: 'hg 10/28/2001 16:28'! reverseLoadedModules self unloadModules: loadedModules reversed. self clearLoadedModules ! ! !ModuleInstaller methodsFor: '(un)loading' stamp: 'hg 10/28/2001 18:14'! unloadModule self unloadModule: self startModule ! ! !ModuleInstaller methodsFor: '(un)loading' stamp: 'hg 10/30/2001 19:00'! unloadModule: module "Remove module from the image. This ought to be as easy as removing from parent, but it ain't for compatibility reasons" module deepSubmodulesBottomUpDo: [:mod | mod allClassesDo: [:cl | (cl class includesSelector: #unload) ifTrue: [ self note: 'Unloading class ', cl name, '.'. cl unload]]. mod parentModule removeNeighborModule: mod. mod cleanOutModule]! ! !ModuleInstaller methodsFor: '(un)loading' stamp: 'hg 10/28/2001 16:26'! unloadModules: modulesToUnload self ensureNoUsersOf: modulesToUnload. modulesToUnload do: [:module | self unloadModule: module]. self clearLoadedModules ! ! !ModuleInstaller methodsFor: 'public' stamp: 'hg 10/28/2001 17:26'! fullyInstallModule "carry out all actions necessary to fully instate the module" self gracefullyExecute: [ self ensureAllModulesDefined. self preserveUninstallInformation. self identifyConflicts. self ensureAllModulesInRepository. self ensureAllModulesLoaded. self ensureAllModulesActive. self initializeLoadedModules]! ! !ModuleInstaller methodsFor: 'public' stamp: 'hg 10/30/2001 20:56'! fullyUninstallModule "carry out all actions necessary to fully remove all effects of this installation" self gracefullyExecute: [ self reverseActivatedModules. self reverseLoadedModules. self reverseDefinedModules]! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/30/2001 13:44'! activate: beActive classesIn: module | selector | selector _ beActive ifTrue: [#activate] ifFalse: [#deactivate]. module allClassesDo: [:cl | (cl class includesSelector: selector) ifTrue: [ cl perform: selector]]! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/30/2001 14:03'! deactivateModule self deactivateModules: self startModule deepSubmodules ! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/28/2001 16:09'! deactivateModules: modules | allModulesToDeactivate | allModulesToDeactivate _ self modulesToDeactivate: modules. self ensureNoUsersOf: allModulesToDeactivate. allModulesToDeactivate isEmpty ifFalse: [ self phase: 'Preparing to deactivate modules.' progressTotal: allModulesToDeactivate size. self switchModules: allModulesToDeactivate beActive: false. self note: 'Modules now deactivated.'] ifTrue: [ self note: 'No modules to deactivate.']! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/30/2001 22:31'! ensureAllModulesActive "Ensure that all necessary modules are active. Note that this is not symmetric with ensureDeactivate, external, non-submodules may be activated." | modulesToActivate | modulesToActivate _ self allModulesNeededBy: self startModule exceptForNeedsOf: #(). modulesToActivate _ modulesToActivate reject: [:module | module isActive]. self halt phase: 'Preparing to activate all needed modules.' progressTotal: modulesToActivate size. self switchModules: modulesToActivate beActive: true. activatedModules _ modulesToActivate. self note: 'All the needed modules active.'. ! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/28/2001 17:54'! reverseActivatedModules self deactivateModules: activatedModules. self clearActivatedModules. ! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 10/30/2001 13:45'! switchModules: modules beActive: beActive "Switch the activation status of all given modules" | before after beforeAndAfter | before _ OrderedCollection new. after _ OrderedCollection new. modules do: [:mod | self progressAdd: 1. beforeAndAfter _ mod switchActiveStatePhase1: beActive. beforeAndAfter ifNotNil: [ before addAll: beforeAndAfter first. after addAll: beforeAndAfter second]]. "the critical step:" self note: 'Switching...'. self atomicallySwitch: before to: after. modules do: [:mod | mod markAsActive: beActive. self activate: beActive classesIn: mod]. ^after! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 10/25/2001 19:45'! atomicallySwitch: preSwitchObjects to: postSwitchObjects "Make a quick and safe atomic switch between before- and after-versions of affected objects." postSwitchObjects size = postSwitchObjects size ifFalse: [ self error: 'Different sizes of pre- and post-version arrays.']. preSwitchObjects asArray elementsForwardIdentityTo: postSwitchObjects asArray. self class flushCache. ^true ! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 10/28/2001 17:52'! cleanup "Erase everything except my information about what is needed in order to undo this installation." progressIndicator _ progressValue _ nil! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 10/28/2001 17:52'! done "wrap things up here" self cleanup! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 10/28/2001 15:44'! gracefullyExecute: aBlock "wrap the execution of the block in progress notification and error handling routines" self showProgressDuring: [ [[aBlock value. self done] on: Warning do: [:ex | ex resume: true] ] on: Error do: [:ex | [ex signal] ensure: [ self revertGracefullyToStableState. self done] ]]! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 10/28/2001 17:28'! preserveUninstallInformation "store this object among module's annotations, I hold the information about what is needed in order to undo this installation. Don't store over an existing record (in which case the module has already been installed anyway!!)." self startModule annotationAt: #installerHistory ifAbsent: [ self startModule annotationAt: #installerHistory put: self]! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 10/28/2001 16:39'! revertGracefullyToStableState self notify: 'Operation failed, select Proceed to perform recovery.'. self fullyUninstallModule! ! !ModuleInstaller class methodsFor: 'start operations' stamp: 'hg 10/28/2001 18:13'! deactivate: mod ^self do: #deactivateModule forModule: mod! ! !ModuleInstaller class methodsFor: 'start operations' stamp: 'hg 10/28/2001 15:51'! fullyInstallFromPath: pathAndVersion ^self do: #fullyInstallModule forModuleRef: (ModuleReference onPath: pathAndVersion)! ! !ModuleInstaller class methodsFor: 'start operations' stamp: 'hg 10/28/2001 17:54'! fullyUninstall: aModule | installerObject | installerObject _ aModule annotationAt: #installerHistory. installerObject ifNil: [self error: 'The module has no installation history.']. installerObject perform: #fullyUninstallModule! ! !ModuleInstaller class methodsFor: 'start operations' stamp: 'hg 10/28/2001 18:13'! unload: mod ^self do: #unloadModule forModule: mod! ! !ModuleRefactorer methodsFor: 'versions' stamp: 'hg 10/29/2001 16:42'! ensurePrerequisiteVersions "simple default: just increment the version for #(Squeak), ie. the version of the Squeak standard class library" Module squeak version = self fromVersion ifFalse: [ self error: 'These refactorings should only be applied to version ', self fromVersion printString, ' of the Squeak modules'].! ! !ModuleRefactorer methodsFor: 'moving modules' stamp: 'hg 10/28/2001 20:33'! moveModule: mod toPath: path | ref afterParentPath afterParent | (Module fromPath: path forceCreate: false) ifNotNil: [ self error: 'Module at target path already exists']. ref _ mod parentModule removeNeighborModule: mod. afterParentPath _ path allButLast. afterParent _ Module fromPath: afterParentPath forceCreate: true. ^afterParent submodule: mod name: path last version: ref specifiedVersion importNames: ref importNames! ! !ModuleRefactorer methodsFor: 'moving modules' stamp: 'hg 10/28/2001 20:34'! moveModules | moveList | moveList _ self newPlacesForModules. moveList pairsDo: [:before :after | (Module fromPath: before forceCreate: false) doIfNotNil: [:mod | self moveModule: mod toPath: after]]. ! ! !FromVersion0p0002to0003 methodsFor: 'versions' stamp: 'hg 10/29/2001 15:57'! fromVersion ^0.0002! ! !FromVersion0p0002to0003 methodsFor: 'moving modules' stamp: 'hg 10/29/2001 17:07'! newPlacesForBalloon "Move constants pool back to Balloon so that VMConstruction can be unloaded" "For each module, list pairs of its path before and after moving it." "FromVersion0p0002to0003 new moveModule: Module @ #() toPath: #()" ^#( #(Squeak VMConstruction Plugins Balloon Simulation Constants) #(Squeak Media Balloon Drawing Constants) #(Squeak VMConstruction B3DSimulator) #(Squeak Media Balloon3D B3DSimulator) ). ! ! !FromVersion0p0002to0003 methodsFor: 'moving modules' stamp: 'hg 10/30/2001 18:14'! newPlacesForGraphics "Split into Core and Library" "For each module, list pairs of its path before and after moving it." ^#( #(Squeak Media Graphics Primitives) #(Squeak Media Graphics Core Primitives) #(Squeak Media Graphics DisplayObjects) #(Squeak Media Graphics Core DisplayObjects) #(Squeak Media Graphics Text) #(Squeak Media Graphics Core Text) #(Squeak Media Graphics) #(Squeak Media Graphics Library) #(Squeak Media Graphics Transformations) #(Squeak Media Graphics Library Transformations) #(Squeak Media Graphics Files) #(Squeak Media Graphics Library Files) #(Squeak Media Graphics FXBlt) #(Squeak Media Graphics Library FXBlt) #(Squeak Media Graphics External) #(Squeak Media Graphics Library External) #(Squeak Media Graphics Tools) #(Squeak Media Graphics Library Tools) ). ! ! !FromVersion0p0002to0003 methodsFor: 'moving modules' stamp: 'hg 10/29/2001 18:19'! newPlacesForModules "For each module, list pairs of its path before and after moving it." ^self newPlacesForBalloon, self newPlacesForPlugins. ! ! !FromVersion0p0002to0003 methodsFor: 'moving modules' stamp: 'hg 10/29/2001 18:53'! newPlacesForPlugins "For each module, list pairs of its path before and after moving it." "FromVersion0p0002to0003 new moveModule: Module @ #() toPath: #()" ^#( #(Squeak VMConstruction AppleScript) #(Squeak VMConstruction Plugins AppleScript) #(Squeak VMConstruction TestPlugins) #(Squeak VMConstruction Plugins Test) ). ! ! !FromVersion0p0002to0003 methodsFor: 'repositories' stamp: 'hg 10/29/2001 17:48'! installRepositories "Make sure that top-level modules get abstract repositories." Module root repository beAbstract. Module root submodulesDo: [:mod | mod repository beAbstract]. #( #(Squeak Language) #(Squeak Technology) #(Squeak Media)) do: [:path | (Module @ path) repository beAbstract]. self repositoriesForVMConstruction! ! !FromVersion0p0002to0003 methodsFor: 'repositories' stamp: 'hg 10/29/2001 18:32'! repositoriesForVMConstruction "Make sure that top-level modules get abstract repositories." Module @ #(Squeak VMConstruction) submodulesDo: [:mod | mod repository beStandalone]. (Module @ #(Squeak VMConstruction Plugins Balloon)) repository beStandalone. (Module @ #(Squeak VMConstruction Plugins Balloon3D)) repository beStandalone. ! ! !FromVersion0p0002to0003 methodsFor: 'moving definitions' stamp: 'hg 10/29/2001 17:09'! refactorBalloonClasses self transferBindingsNamedIn: #(BalloonEdgeData BalloonFillData) from: Module @ #(Squeak VMConstruction Plugins Balloon Simulation) to: Module @ #(Squeak Media Balloon Drawing). ! ! !FromVersion0p0002to0003 methodsFor: 'moving definitions' stamp: 'hg 10/30/2001 16:36'! refactorPluginClasses self transferBindingsNamedIn: #(KlattSynthesizerPlugin) from: Module @ #(Squeak VMConstruction Plugins) to: Module @ #(Squeak VMConstruction Plugins Sound). self transferBindingsNamedIn: #(FooPlugin2 LargeIntegersTest TIPTestPlugin TestInterpreterPlugin FlippyArrayPlugin2 ) from: Module @ #(Squeak VMConstruction Plugins) to: Module @ #(Squeak VMConstruction Plugins Test). self transferBindingsNamedIn: #(FilePluginSimulator) from: Module @ #(Squeak VMConstruction Plugins) to: Module @ #(Squeak VMConstruction Plugins IO). self transferBindingsNamedIn: #(IntegerPokerPlugin) from: Module @ #(Squeak Network Library ObjectSocket) to: Module @ #(Squeak VMConstruction Plugins IO). ! ! !ModuleReference methodsFor: 'resolving' stamp: 'hg 10/29/2001 19:19'! acceptAnyVersion ^specifiedVersion isNil! ! !ModuleReference methodsFor: 'resolving' stamp: 'hg 10/29/2001 19:20'! findModuleFromPathAndVersion "this is just preliminary" ^Module @ self specifiedPath doIfNotNil: [:mod | (self acceptAnyVersion or: [self versionIdenticalTo: mod version]) ifTrue: [self resolvedModule: mod]]! ! !ModuleReference methodsFor: 'resolving' stamp: 'hg 10/29/2001 19:18'! versionIdenticalTo: aVersion "avoid float rounding errors" | roundTo | roundTo _ self class module minimalVersionIncrease. ^(specifiedVersion roundUpTo: roundTo) = (aVersion roundUpTo: roundTo) ! ! !Project methodsFor: 'accessing' stamp: 'hg 10/28/2001 15:28'! module ^ module! ! !Project methodsFor: 'isolation layers' stamp: 'hg 10/30/2001 09:42'! beIsolated "Establish an isolation layer at this project. This requires clearing the current changeSet or installing a new one." isolatedHead ifTrue: [^ self error: 'Already isolated']. self isCurrentProject ifFalse: [^ self inform: 'Must be in this project to isolate it'.]. changeSet isEmpty ifFalse: [changeSet _ ChangeSorter newChangeSet]. changeSet beIsolationSetFor: self. isolatedHead _ true. inForce _ true. "environment _ Environment new setName: self name outerEnvt: Smalltalk." ! ! !Repository methodsFor: 'initializing' stamp: 'hg 10/29/2001 16:15'! implicitOn: aModule "set me up as an implicit (non-standalone) repository for the given module" "do not make aModule refer to me, instead create me on demand" "sanity check" self isImplicit ifFalse: [ self error: 'I don''t qualify as the kind of repository I should have been']! ! !Repository methodsFor: 'initializing' stamp: 'hg 10/29/2001 17:34'! on: aModule "set me up as a repository for the given module" module _ aModule. ^(self parentRepository isNil or: [self parentRepository isAbstract]) ifTrue: [self beStandalone] ifFalse: [self implicitOn: aModule]! ! !Repository methodsFor: 'initializing' stamp: 'hg 10/29/2001 16:38'! standaloneOn: aModule "set me up as a proper standalone repository for the given module" self on: aModule. self beStandalone. ! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/29/2001 18:41'! compositeContentsOn: aStream "take various measures to ensure that necessary preconditions are met." | n | self standaloneCheck. self ensurePreconditionsForUpload. 'Uploading module ', self module pathAsMessages, ' into repository...' displayProgressAt: Sensor cursorPoint from: 0 to: self compositeModules size during: [:bar | n _ 0. aStream timeStamp; cr; cr. self compositeModules do: [:mod | mod = self module ifFalse: [ aStream cr; cr; nextChunkPut: '#nextCompositeModule'; cr; nextChunkPut: (self prefixForModule: mod); cr; cr]. mod repository contentsOn: aStream. bar value: (n_ n+1). aStream flush]]! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 10/29/2001 12:21'! fileIn: aStream into: topModule chunkBlock: aBlock "load a file holding code to be evaluated with module as receiver" | isCategory value targetModule string | targetModule _ topModule. "make name lookup be done in the scope of the target module" Module scopeModuleInstance: targetModule. 'Filing in module ', topModule pathAsMessages, '...' displayProgressAt: Sensor cursorPoint from: 0 to: aStream size during: [:bar | [aStream atEnd] whileFalse: [ bar value: aStream position. aStream skipSeparators. [ isCategory _ aStream peekFor: $!!. string _ aStream nextChunk. value _ Compiler evaluate: string for: targetModule logged: false. "tag indicating that new (composite) module should receive definitions, followed by expression defining the new receiver" value = #nextCompositeModule ifTrue: [ targetModule allClassesDo: [ :cl | cl removeSelectorSimply: #DoIt; removeSelectorSimply: #DoItIn:]. Module scopeModuleInstance: topModule. targetModule _ Compiler evaluate: aStream nextChunk for: topModule logged: false. Module scopeModuleInstance: targetModule] ifFalse: [ aBlock value: value value: aStream value: isCategory] ] on: Warning do: [ :ex | ex resume: true]. aStream skipStyleChunk]. aStream close]. Module scopeModuleInstance: nil. topModule class removeSelectorSimply: #DoIt; removeSelectorSimply: #DoItIn:. ! ! !Repository methodsFor: 'testing' stamp: 'hg 10/29/2001 16:09'! isAbstract "An abstract module/repository is one where there are no actual module contents, like abstract classes have no instances. Some examples are the root, Squeak, People and so on. " ^isAbstract = true "allow nil here for false"! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/29/2001 17:35'! ensureDeepUpload "take various measures to ensure that necessary preconditions are met." self standaloneCheck. self module deepSubmodulesDo: [:mod | mod repository isStandalone ifTrue: [ mod repository ensurePreconditionsForUpload. mod repository storeModuleComposite]] ! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/10/2001 19:31'! ensureUpload "take various measures to ensure that necessary preconditions are met." self standaloneCheck. self ensurePreconditionsForUpload. self storeModuleComposite ! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 10/25/2001 19:09'! loadModuleContentsInto: mod "self notify: 'Warning: You are about to load the contents of module ', mod pathAsMessages asText allBold, ' from the repository. Any unsaved contents in this module will be lost.'." Smalltalk newChanges: (ChangeSet basicNewNamed: 'Load ', mod pathAsMessages). self namesOfContentsFiles do: [:name | self fileIn: (self oldStreamNamed: name) into: mod chunkBlock: [:result :stream :isCategory | "Class category chunk followed by method definition" isCategory ifTrue: [result scanFrom: stream]]]. Smalltalk newChanges: (ChangeSet basicNewNamed: 'PostLoading'). ChangeSorter initialize. "answer the modules that were loaded" ^self compositeModules ! ! !Repository methodsFor: 'system conversion' stamp: 'hg 10/25/2001 19:09'! importChangesFrom: aStream into: mod | deltaModule deltaClass resultWithinModule | Smalltalk newChanges: (ChangeSet basicNewNamed: 'Import Changes into ', mod pathAsMessages, ' ', Time now printString). ChangeSorter initialize. self fileIn: aStream into: mod chunkBlock: [:result :stream :isCategory | isCategory ifTrue: [ (result isKindOf: ClassCategoryReader) ifTrue: [ resultWithinModule _ mod path = (result targetClass module path first: mod path size). resultWithinModule ifFalse: [ deltaModule _ mod deltaModuleForBase: result targetClass module forceCreate: true asActive: false. deltaClass _ deltaModule deltaClassFor: result targetClass forceCreate: true. result setClass: deltaClass]]. "Class category chunk followed by method definition" result scanFrom: stream]]. Smalltalk newChanges: (ChangeSet basicNewNamed: 'PostImport ', Time now printString). ChangeSorter initialize. ! ! !Repository methodsFor: 'repository variants' stamp: 'hg 10/29/2001 17:28'! beAbstract "first make sure I am stored with module so abstractness is preserved" self ensureBeingPreserved. isAbstract _ true! ! !Repository methodsFor: 'repository variants' stamp: 'hg 10/29/2001 17:27'! beStandalone isStandalone _ true. self ensureBeingPreserved. "sanity check" self isStandalone ifFalse: [ self error: 'I don''t qualify as the kind of repository I should have been']! ! !Repository methodsFor: 'repository variants' stamp: 'hg 10/29/2001 16:21'! canBeComposite ^(self isImplicit | self isAbstract) not ! ! !Repository methodsFor: 'repository variants' stamp: 'hg 10/29/2001 16:21'! compositeModules "Return those modules that should be stored in this repository." | all | self canBeComposite ifFalse: [^#()]. all _ OrderedCollection new. self module deepSubmodulesDo: [:mod | mod repository standaloneRepository = self module repository ifTrue: [all add: mod]. mod deltaModules do: [:delta | delta repository standaloneRepository = self module repository ifTrue: [all add: delta]]]. ^all! ! !Repository methodsFor: 'repository variants' stamp: 'hg 10/29/2001 17:26'! ensureBeingPreserved self module verbatimRepository ifNil: [self module repository: self]! ! !Repository methodsFor: 'checksums' stamp: 'hg 10/30/2001 10:50'! checksum "return a checksum for this module. A work in progress" | mods primes i | mods _ self module deepSubmodules. primes _ Integer primesUpTo: 3000. i _ 1. ^mods inject: 0 into: [:sum :mod | sum * (primes at: i) bitXor: mod repository localChecksum ]! ! !Repository methodsFor: 'checksums' stamp: 'hg 10/29/2001 20:08'! localChecksum "return a checksum for this module. A work in progress" ^self module definedNames size * 97 + self module exportedNames size * 89 + self module neighborModules size * 83! ! !FileRepository methodsFor: 'accessing' stamp: 'hg 10/29/2001 17:33'! parentRepository ^super parentRepository doIfNotNil: [:parent | parent cache]! ! !FileRepository methodsFor: 'initializing' stamp: 'hg 10/29/2001 17:30'! cacheOn: aModule directory: dir "set me up as a local cache repository for the given module" self on: aModule. self directory: dir! ! !FileRepository methodsFor: 'up- and downloading' stamp: 'hg 10/29/2001 17:59'! ensureDeepUpload "confessed ugly hack" | isCache rep | isCache _ self module repository ~= self. self standaloneCheck. self module deepSubmodulesDo: [:mod | rep _ isCache ifFalse: [mod repository] ifTrue: [mod repository cache]. rep isStandalone ifTrue: [ rep ensurePreconditionsForUpload. rep storeModuleComposite]] ! ! !Repository class methodsFor: 'instance creation' stamp: 'hg 10/29/2001 16:11'! on: aModule "return a repository for the given module" ^aModule parentModule repository subrepositorySpecies new on: aModule! ! !Repository class methodsFor: 'fileIn/Out' stamp: 'hg 10/28/2001 12:58'! importChangesFromFileNamed: fileName intoModuleAt: importRootPath | homeModule aStream | homeModule _ Module fromPath: importRootPath forceCreate: true. aStream _ FileStream fileNamed: fileName. homeModule repository importChangesFrom: aStream into: homeModule. ^homeModule! ! !SubmoduleReference methodsFor: 'printing' stamp: 'hg 10/24/2001 20:14'! storeOn: aStream "write a message string that will create myself if sent to a module" "Keep flag: messages with used selectors here so that this code will be updated if the selectors are changed." self flag: #submodule:name:version:importNames: . aStream nextPutAll: 'submodule: nil'; nextPutAll: ' name: '; print: self name; nextPutAll: ' version: '; print: specifiedVersion; nextPutAll: ' importNames: '; print: self importNames. ! ! !TransitionalSmalltalkModule class methodsFor: 'class initialization' stamp: 'hg 10/24/2001 20:15'! setup "install instance of me as Smalltalk submodule of Root" ^Module root submodule: nil name: #OldstyleSmalltalk version: nil importNames: false. ! ! !VirtualRootModule methodsFor: 'name queries' stamp: 'hg 10/31/2001 13:08'! allDefinitionsFor: aString onlyExported: onlyExported detect: aBlock "look up all definitions for the given symbol in all modules. If found, evaluate aBlock for the defined value and defining module. Terminate lookup and return defined value if block returns true. This method is meant for handling the possibility of multiple definitions by the same name, which arises whenever a search for an unqualified global name is done." | assoc found | self deepSubmodulesDo: [:mod | assoc _ onlyExported ifFalse: [mod localAssocFor: aString ifAbsent: [nil]] ifTrue: [mod localExportedAssocFor: aString ifAbsent: [nil]]. assoc ifNotNil: [ found _ aBlock value: assoc value value: mod. found == true ifTrue: [^assoc value]]]. ^nil! ! !VirtualRootModule methodsFor: 'name queries' stamp: 'hg 10/31/2001 12:50'! allDuplicateDefinitions | all | all _ Bag new. (self allModules remove: Module smalltalk; yourself) do: [:mod | all addAll: mod definedNames keys]. ^all asSet reject: [:key | (all occurrencesOf: key) = 1]! ! !VirtualRootModule methodsFor: 'name queries' stamp: 'hg 10/31/2001 13:05'! allDuplicateExports | all | all _ Bag new. (self allModules remove: Module smalltalk; yourself) do: [:mod | all addAll: mod exportedNames keys]. ^all asSet reject: [:key | (all occurrencesOf: key) = 1]! ! !VirtualRootModule methodsFor: 'name queries' stamp: 'hg 10/31/2001 13:10'! moduleDefining: varName "search all modules in the system. assume name is not for a module" ^self allDefinitionsFor: varName onlyExported: false detect: [:value :module | (value isKindOf: Module) ifFalse: [^module]]. ! ! !VirtualRootModule methodsFor: 'name queries' stamp: 'hg 10/31/2001 13:11'! modulesDefining: varName "Answer a dictionary of module->value pairs. Searc all modules in the system." | defs | defs _ Dictionary new. self allDefinitionsFor: varName onlyExported: false detect: [:value :module | module == Module smalltalk ifFalse: [defs at: module put: value]]. ^defs ! ! !VirtualRootModule methodsFor: 'name queries' stamp: 'hg 10/31/2001 13:11'! modulesExporting: varName "Answer a dictionary of module->value pairs. Search all modules in the system." | defs | defs _ Dictionary new. self allDefinitionsFor: varName onlyExported: true detect: [:value :module | defs at: module put: value]. ^defs ! ! !VirtualRootRepository methodsFor: 'initializing' stamp: 'hg 10/16/2001 17:36'! cache ^self cacheSpecies new cacheOn: self module directory: self defaultCacheDirectory; beStandalone; yourself! ! !VirtualRootRepository methodsFor: 'initializing' stamp: 'hg 10/16/2001 17:36'! initialize self standaloneOn: Module root. self directory: self defaultServer. " self setCache"! ! !Wonderland class methodsFor: 'actor prototype mgmt' stamp: 'hg 10/30/2001 16:49'! unload self removeActorPrototypesFromSystem! ! VirtualRootModule removeSelector: #allDefinitionsFor:detect:! VirtualRootModule removeSelector: #modulesDefining:withInclusions:! Repository class removeSelector: #implicitOn:! Project removeSelector: #environment! ModuleInstaller class removeSelector: #fullyActivateFromPath:! ModuleInstaller removeSelector: #ensureDeactivate! ModuleInstaller removeSelector: #ensureModuleInCache:! ModuleInstaller removeSelector: #ensureUnload! ModuleInstaller removeSelector: #fullyActivateModule! ModuleInstaller removeSelector: #modulesToDeactivate! ModuleInstaller removeSelector: #modulesToUnload! !ModuleInstaller reorganize! ('initialize-reset' clearActivatedModules clearCreatedModules clearDownloadedModules clearLoadedModules do:forModuleRef: initialize) ('accessing' operation startModule) ('graph computation' allModulesNeededBy:exceptForNeedsOf: directlyNeededModulesFor: directlyReachableModulesFor:) ('defining modules' ensureAllModulesDefined ensureAllReachableModulesResolved: ensureModuleResolved: refsToScanFrom: removeModule: removeModules: reverseDefinedModules willLoadModule:) ('resolving conflicts' identifyConflicts) ('downloading modules' ensureAllModulesInRepository ensureModuleInRepository:) ('(un)loading' ensureAllModulesLoaded ensureContentsLoadedForModule: initializeLoadedModules loadContentsForModule: modulesToLoad modulesToLoadFor: reverseLoadedModules safeLoadingOrder: unloadModule unloadModule: unloadModules:) ('public' fullyInstallModule fullyUninstallModule) ('(de)activating' activate:classesIn: deactivateModule deactivateModules: ensureAllModulesActive modulesToDeactivate: reverseActivatedModules switchModules:beActive:) ('utilities' atomicallySwitch:to: cleanup deepSubmodules done ensureNoUsersOf: gracefullyExecute: preserveUninstallInformation revertGracefullyToStableState) ('user interface' note: phase:progressTotal: progressAdd: showProgressDuring:) ! DeltaModule removeSelector: #baseClassFor:! DeltaModule removeSelector: #baseClassForDelta:asActive:! DeltaModule removeSelector: #defineMethodRemovals:forDeltaClass:on:! DeltaModule removeSelector: #defineSelector:asMethod:previousVersion:inClass:! DeltaModule removeSelector: #deltaRepresentationForClass:! DeltaModule removeSelector: #fixDeltaRepresentations! DeltaModule removeSelector: #initializeClassDelta:! DeltaModule removeSelector: #undefinedSelectors:forDeltaClass:! Module removeSelector: #addSubmoduleNamed:importNames:! Module removeSelector: #collectUpstreamMethodsOutside:! Module removeSelector: #hardRemoveModule! Module removeSelector: #localIncomingRefsFromOutside:! "Postscript:" Module initializeAnnotations. FromVersion0p0002to0003 run !