Here is an updated version of the modules prototype from a couple of weeks
ago. (File into 3.1a-4332 in the given order, or strange bugs may happen. I
have tested it to some extent and it worked for me...)

Much following Les' suggestion, this is as yet a "weak modules" scheme that
partitions the system into modules but still leaves the critical name lookup
mechanisms in place (e.g. #Smalltalk). Still, the changes are irreversible,
mostly because the SystemOrganizer is replaced by an object that simulates
system categories from module paths. (The path is the location of a module
within the virtual module hierarchy, and serves to uniquely identify every
module in every squeaker's project. Hans-Martin's original modularity
posting is worth re-reading, some ideas are virtually identical to this
system.) 

There are some instructions in the preamble of the first change set, and the
class comments that are there provide some meat as well. Otherwise, the
basic concepts follow the proposal that I posted earlier. I recommend the
package browser, even though there's some serious slowness in it now, that
anyone is welcome to fix. :-)

The most powerful piece in there so far is the mechanism for refactoring the
image to eventually yield easy shrinking/growing of customized images.
People who want to experiment with creating e.g. a really minimal headless
image could more or less start right away. There are also some quite
powerful tools for finding and analyzing the ill-formed dependencies that
now hinder easy growing/shrinking. In the last minute I included a very
crude prototype of DeltaModule. It will serve as to give an idea of how to
handle upstream definitions, but its details shouldn't be considered final
at all. You can try

self collectUpstreamMethodsOutside: self

in the Module explorer on e.g. the Morphic or EToy modules, and afterward
look at the contents of the new submodule Deltas. (MVC: 72 delta modules!)

Ideally I would now provide a list of things that are made better by this
system, but as they mostly don't work yet, I'll wait to advertise them until
the proof is really in the pudding. The class comment of DeltaModule does
give a few hints however. Right now the best feature is how small it all is.
:-)

If the effort is justified there definitely will be documentation, right now
I'll gladly ask questions that come up rather than trying to anticipate what
you want to know. (My email capacity will be a little smaller from Thursday
until Tuesday though.)

Have fun,
Henrik

-------------- next part --------------
'From Squeak3.1alpha of 7 March 2001 [latest update: #4332] on 12 September 2001 at 10:32:22 pm'!
"Change Set:		Modules core
Date:			12 September 2001
Author:			Henrik Gedenryd

This is the start for a Module system, based on Dan Ingalls' Environments code. The core is in the category System-Modules, it is rather small.

Note that this is for now a 'weak' module scheme that allows the standard scheme using #Smalltalk to continue working like before.

After filing in all change sets, in the Explorer that opens on the module hierarchy, try:

Module convertSystemOrganizationToModules.

(Note that this is installs 'weak modules' and is irreversible.) Then

	FromVersion0p0000to0001 run

This applies a first set of refactorings of the system, based on a reusable framework for applying (and contributing!!) refactorings.

You can also try

Module root declareExternalRefs

Now look at the externalModuleRefs of various modules (use the opened Explorer).

Then try the messages in the ModuleExplorer on different modules. Use exploreIt or printIt to get the results that are returned from them.
"!

Object subclass: #Module
	instanceVariableNames: 'name version parentModule submodules externalModules definedNames exportedNames annotations repository activeChangeSet '
	classVariableNames: 'RootModule SmalltalkModule '
	poolDictionaries: ''
	category: 'System-Modules'!

!Module commentStamp: '<historical>' prior: 0!
This is the Dog Days prototype for a Module and Repository system for Squeak. It was hacked up in an afternoon. The Swedish term RštmŒnad is really more suitable than the English "Dog Days".



"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'." <http://www.inv.se/svefa/tradition/engtrad/engrotmanad.html>!
]style[(709 58 1)f1,f1Rhttp://www.inv.se/svefa/tradition/engtrad/engrotmanad.html;,f1!

Object subclass: #ModuleRefactorer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!

!ModuleRefactorer commentStamp: '<historical>' prior: 0!
This class holds code for refactoring the modular image. All system categories from an older image will reside in the Squeak subtree #(Squeak <...>) in the new virtual module hierarchy.

Create subclasses of me, residing in the submodule Refactorings, that will take an image from one version of the Squeak module subtree to another. This is to allow the image to evolve in an orderly manner through successive refactorings, contributed by various Squeakers.!

Object subclass: #ModuleReference
	instanceVariableNames: 'module alias version importNames '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!

!ModuleReference commentStamp: '<historical>' prior: 0!
This class represents references to other modules in a module's definition.

module  Module -- the other module
alias  Symbol -- the name used for the module within the present module
importNames Boolean -- should the module's defined names be made available as if they were defined in the present module?!

ModuleReference subclass: #ModuleParameter
	instanceVariableNames: 'defaultModule '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!

!ModuleParameter commentStamp: '<historical>' prior: 0!
This class represents module parameters in a module's definition.

defaultModule  Module or nil -- a default module may be provided here!

Module subclass: #TransitionalSmalltalkModule
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!
Module subclass: #VirtualRootModule
	instanceVariableNames: 'cachedClassNames outOfScopeCache '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!

!VirtualRootModule commentStamp: '<historical>' prior: 0!
This is the special Module that is the virtual root of the whole Module hierarchy. This is based on the notion of a "virtual module hierarchy".

The idea is to use a single, shared "virtual" Module hierarchy for all Squeak modules, so that all Squeak modules will have unique "canonical" names. This does not mean that all modules need to physically reside in the same place (hence a "virtual" hierarchy). 

For instance, if Company X wants to set up its own private server which no one else can access, they can do so, but the module tree at this server will still have a special place in the virtual hierarchy. They get this place by simply reserving e.g. the Module #(com CompanyX) in the registry for the virtual hierarchy. Thus a top-level ModuleY that they develop will have the "canonical" name #(com CompanyX ModuleY) Hence there will not be a name clash if someone else develops a module having the name ModuleY.

This class also has the unrewarding role of superseding Smalltalk in the role of a global namespace. Thus old-style messages to Smalltalk in that role should be rerouted to the Root module. Even when global names haven't been moved into modules, there should be a Root module installed to handle things properly.!


!Class methodsFor: 'compiling' stamp: 'squeak 8/30/2001 18:23'!
definesName: varName lookInSuper: lookInSuper ifTrue: assocBlock
	"Look up the first argument, varName, in the the receiver. If it is there,
	pass the association to the second argument, assocBlock, and answer true."

	| assoc |
	"First look in classVar dictionary."
	(assoc _ self classPool associationAt: varName ifAbsent: []) == nil
		ifFalse: [assocBlock value: assoc.
				^ true].

	"Next look in shared pools."
	self sharedPools do: 
		[:pool | 
		assoc _ pool associationAt: varName ifAbsent: [
			"String key hack from Hypersqueak now used in Wonderland  **Eliminate this**"
			pool associationAt: varName asString ifAbsent: []].
		assoc ifNotNil: [
				assocBlock value: assoc.
				^true]].

	"Finally look higher up the superclass chain if appropriate, and fail at the end."
	(lookInSuper and: [superclass notNil])
		ifTrue: [^ superclass definesName: varName lookInSuper: true ifTrue: assocBlock].

	^false! !

!Class methodsFor: 'organization' stamp: 'squeak 9/10/2001 18:47'!
module

	^module ifNil: [Module smalltalk]! !

!Class methodsFor: 'organization' stamp: 'squeak 9/10/2001 18:47'!
module: aModule

	module _ aModule! !


!Dictionary methodsFor: 'simple caching' stamp: 'squeak 9/11/2001 15:03'!
addWillGrow
	"Keep array at least 1/4 free for decent hash behavior"
	^array size - tally - 2 < (array size // 4 max: 1)! !

!Dictionary methodsFor: 'simple caching' stamp: 'squeak 9/12/2001 15:49'!
at: key ifAbsentCache: aBlock 
	| slot assoc old |
	"Return the value at the given key. 
	If key is not included in the receiver, cache value by
	evaluating aBlock which should store into the cached association. 
	(This clunky solution to allow non-local returns from the ifAbsent... block.)"

	slot _ self findElementOrNil: key.
	(assoc _ array at: slot) ifNotNil: [^ assoc value].
	assoc _ key->nil.
	self addWillGrow 
		ifFalse: [self add: assoc]
		ifTrue: [
			"find a position to put anObject in. 
			 a simple strategy that was the best out of a few that were tried"
			[	slot _ slot - 1. 
				slot < 1 ifTrue: [slot _ array size].
				(array at: slot) isNil
			] whileTrue.

			old _ array at: slot.
			array at: slot put: assoc].
	aBlock value: assoc.
	"restore old value into cache if no value was returned"
	(assoc value isNil and: [old notNil]) ifTrue: [array at: slot put: old].
	^assoc value

" To calibrate the size of your cache, for different sizes graph either times or hit rates of a critical operation.
(20 to: 200 by: 40) collect: [:size |
	range _ 1000.
	nrOfAccessses _ 10000.
	cache _ IdentityDictionary new: size.
	distribution _ (1 to: range), ((1 to: range) collect: [:i | ((i / range) squared squared * range) asInteger]).
	accesses _ ((1 to: (nrOfAccessses/distribution size) truncated) 
					inject: #() into: [:all :i | all, distribution]) shuffled.
	misses _ 0.
	time _ MessageTally time: [
		accesses do: [:i |
			cache at: i ifAbsentCache: [:assoc | misses_misses+1]]].
	total _ accesses size.
	hitRate _ 1- (misses/total).
	{size. (hitRate roundTo: 1/1000) asFloat. (cache size/range roundTo: 1/1000) asFloat.
	(hitRate / (cache size/range) roundTo: 1/1000) asFloat. time}] "! !


!Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 18:25'!
annotationAt: aString

	^self annotations at: aString! !

!Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 19:29'!
annotationAt: aString put: value

	annotations _ self annotations at: aString put: value; yourself! !

!Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 19:22'!
annotations

	^annotations ifNil: [Dictionary new]! !

!Module methodsFor: 'accessing' stamp: 'hg 9/7/2001 16:14'!
classNames
	"Answer a SortedCollection of all class names."

	| names |
	names _ OrderedCollection new.
	self allClassesDo: [:cl | names add: cl name].
	^names asSortedCollection! !

!Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 18:26'!
definedNames

	^definedNames ifNil: [IdentityDictionary new]! !

!Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 18:52'!
exportedNames

	^exportedNames ifNil: [IdentityDictionary new]! !

!Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 18:40'!
externalModuleRefs

	^externalModules ifNil: [#()]! !

!Module methodsFor: 'accessing' stamp: 'squeak 8/20/2001 19:07'!
parentModule

	^parentModule! !

!Module methodsFor: 'accessing' stamp: 'squeak 9/8/2001 22:16'!
repository 

	^repository ifNil: [parentModule repository subrepositorySpecies on: self]! !

!Module methodsFor: 'accessing' stamp: 'hg 8/22/2001 21:56'!
repository: aRepository

	repository _ aRepository! !

!Module methodsFor: 'accessing' stamp: 'squeak 8/20/2001 17:01'!
species

	^Module! !

!Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 18:45'!
submoduleRefs

	^submodules ifNil: [#()]! !

!Module methodsFor: 'initializing' stamp: 'hg 9/3/2001 18:21'!
initialize

! !

!Module methodsFor: 'initializing' stamp: 'hg 9/10/2001 14:50'!
name: aString version: versionFloat parentModule: parent

	parentModule _ parent.
	name _ aString asSymbol.
	version _ versionFloat.	
! !

!Module methodsFor: 'module name and path' stamp: 'squeak 9/10/2001 12:22'!
longName
	"concatenate all the local names of the path"

	^self path inject: '' into: [:string :localName |
		string, localName]
! !

!Module methodsFor: 'module name and path' stamp: 'squeak 8/20/2001 18:02'!
name

	^ name ifNil: ['no name #' , self hash printString]! !

!Module methodsFor: 'module name and path' stamp: 'squeak 9/10/2001 12:28'!
path
	"Return my full path in the virtual Module hierarchy, without version.
	 Note that this is an Array of symbols. "

	^(parentModule 
		ifNotNil: [parentModule path]
		ifNil: [#('stray-Module')])
			 copyWith: self name! !

!Module methodsFor: 'module name and path' stamp: 'squeak 9/10/2001 19:29'!
pathAndVersion
	"Return my full path in the virtual Module hierarchy,
	 with the version last as a float.
	 Note that this is an Array of literals. "

	^self path copyWith: self version! !

!Module methodsFor: 'module name and path' stamp: 'squeak 9/10/2001 12:33'!
pathAsMessages
	"return the path as the source code for a sequence of messages to refer to me.
	eg. #(Morphic Cat1) --> 'Morphic Cat1'"

	^(self path inject: '' into: [:messages :sym | messages, sym, ' ']) allButLast.
! !

!Module methodsFor: 'module name and path' stamp: 'squeak 9/10/2001 12:25'!
qualifiedReferenceAsMessagesFor: aName
	"return a string with the messages that need to precede aName in a fully qualified reference to aName in this module" 

	| ref |
	ref _ nil.
	self associationFor: aName ifAbsent: [
		ref _ self refForModuleDefining: aName].
	^(ref isNil or: [ref importNames]) 
		ifTrue: ['']
		ifFalse: [
			ref hasAlias 
				ifFalse: [ref module pathAsMessages, ' ']
				ifTrue: [ref alias, ' ']]! !

!Module methodsFor: 'module name and path' stamp: 'squeak 9/11/2001 15:17'!
simulatedCategory
	"build a category from the path"

	| cat path |
	path _ self path.
	(path size > 1 and: [path first = Module squeak name]) 
		ifTrue: [path _ path allButFirst].
	cat _ path inject: '' into: [:catString : localName | catString, localName, '-'].
	^cat isEmpty ifTrue: [cat] ifFalse: [cat allButLast asString]! !

!Module methodsFor: 'accessing defined names' stamp: 'squeak 8/31/2001 13:02'!
associationFor: aString ifAbsent: aBlock

	self associationFor: aString ifPresent: [:assoc :mod | ^assoc].
	^aBlock value! !

!Module methodsFor: 'accessing defined names' stamp: 'hg 9/5/2001 18:46'!
associationFor: aString ifPresent: aBlock
	"look up definition for the given symbol, and proceed into imported modules.
	 If found, evaluate aBlock for assoc and defining module.
	 Use this message to look up names available to code defined inside this module."

	| assoc |
	assoc _ self localAssocFor: aString ifAbsent: [
		self importedAssocFor: aString ifPresent:
			[:ass :mod | aBlock value: ass value: mod. ^ass].
		^nil].
	aBlock value: assoc value: self.
	^assoc! !

!Module methodsFor: 'accessing defined names' stamp: 'squeak 8/31/2001 13:06'!
doesNotUnderstand: aMessage
	"emulate uppercase accessor messages for exports"

	self exportedAssocFor: aMessage selector 
		ifPresent: [:ass :mod | ^ass value].
	^super doesNotUnderstand: aMessage
	! !

!Module methodsFor: 'accessing defined names' stamp: 'hg 9/5/2001 18:47'!
exportedAssocFor: aString ifPresent: aBlock
	"look up definition for the given symbol, and proceed into imported modules.
	 If found, evaluate aBlock for assoc and defining module.
	 Use this message to look up names available from outside this module."

	| assoc |
	assoc _ self localExportedAssocFor: aString asSymbol ifAbsent: [
		self importedAssocFor: aString ifPresent:
			[:ass :mod | aBlock value: ass value: mod. ^ass].
		^nil].
	aBlock value: assoc value: self.
	^assoc! !

!Module methodsFor: 'accessing defined names' stamp: 'squeak 8/31/2001 11:45'!
importedAssocFor: aString ifPresent: aBlock

	self importedModulesDo: [:module |
		module exportedAssocFor: aString ifPresent: 
			[:ass :mod | aBlock value: ass value: mod. ^ass]].
	^nil! !

!Module methodsFor: 'accessing defined names' stamp: 'hg 9/5/2001 18:47'!
localAssocFor: aString ifAbsent: aBlock
	"look up assoc for the given name. only look locally in this module"

	^self definedNames associationAt: aString asSymbol ifAbsent: aBlock
	! !

!Module methodsFor: 'accessing defined names' stamp: 'hg 9/5/2001 18:49'!
localExportedAssocFor: aString ifAbsent: aBlock
	"look up assoc for the given name. only look at exported names defined in this module"

	^self exportedNames associationAt: aString asSymbol ifAbsent: aBlock
	! !

!Module methodsFor: 'changing defined names' stamp: 'hg 9/3/2001 18:57'!
addAssoc: assoc export: exportIt

	assoc key first isUppercase ifFalse: [self error: 'global names must be Capitalized'].
	definedNames _ self definedNames add: assoc; yourself.
	exportIt ifTrue: [self exportName: assoc key]
	! !

!Module methodsFor: 'changing defined names' stamp: 'squeak 9/10/2001 12:24'!
defineName: aString as: value export: exportIt

	self localAssocFor: aString ifAbsent: [
		^self redefineName: aString as: value export: exportIt].
	self error: 'Name #', aString, ' already defined in ', self pathAsMessages! !

!Module methodsFor: 'changing defined names' stamp: 'hg 9/3/2001 18:56'!
exportName: aString

	| assoc |
	self exportedNames associationAt: aString asSymbol ifAbsent: [
		assoc _ self definedNames associationAt: aString asSymbol.
		exportedNames _ self exportedNames add: assoc; yourself]! !

!Module methodsFor: 'changing defined names' stamp: 'squeak 9/8/2001 21:35'!
redefineName: aString as: value export: exportIt

	self addAssoc: (aString asSymbol)->value export: exportIt.
	"with weak modules, retain compatibility by also putting globals in Smalltalk"
		(Preferences strongModules not and: [Module smalltalk notNil
				and: [(value isKindOf: Module) not]]) ifTrue: [
			Module smalltalk redefineName: aString as: value export: false]! !

!Module methodsFor: 'changing defined names' stamp: 'hg 9/3/2001 18:32'!
removeName: aString

	self definedNames removeKey: aString asSymbol.
	self exportedNames removeKey: aString asSymbol ifAbsent: [].
! !

!Module methodsFor: 'module definition protocol' stamp: 'squeak 9/8/2001 22:30'!
externalModule: module alias: aString importNames: shouldImport
	"use this message to declare that this module depends on an external module"

	| ref symOrNil |
	symOrNil _ aString ifNotNil: [aString asSymbol].
	ref _ ModuleReference new alias: symOrNil module: module import: shouldImport.
	self addExternalModuleRef: ref.
	^module
! !

!Module methodsFor: 'module definition protocol' stamp: 'squeak 9/8/2001 22:32'!
parameterModuleWithDefault: moduleOrNil alias: moduleName importNames: shouldImport
	"use this message to declare a module parameter. Set its module value to the default."

	| ref |
	ref _ ModuleParameter new alias: moduleName asSymbol module: moduleOrNil import: shouldImport defaultModule: moduleOrNil.
	self addExternalModuleRef: ref.
	^moduleOrNil
! !

!Module methodsFor: 'module definition protocol' stamp: 'squeak 9/8/2001 22:32'!
submodule: submodule alias: submoduleName importNames: shouldImport
	"use this message to declare a submodule of this module"

	| sym ref |
	sym _ submoduleName ifNotNil: [submoduleName asSymbol].
	ref _ ModuleReference new alias: sym module: submodule import: shouldImport.
	shouldImport ifTrue: [self checkImportForCircularity: submodule].
	self defineName: ref name as: submodule export: self shouldExportSubmodules.
	self addSubmodule: ref.
	^submodule
! !

!Module methodsFor: 'module composition' stamp: 'hg 9/3/2001 18:30'!
allClassesDo: aBlock
	"Evaluate the argument, aBlock, for each class in this module."

	self definedNames valuesDo: [:value | 
		(value isKindOf: Class) ifTrue: [aBlock value: value]]
! !

!Module methodsFor: 'module composition' stamp: 'hg 9/3/2001 19:11'!
declaresExternalModule: module
	"is the given module among the external modules that this module uses/depends on?"

	^self externalModuleRefs anySatisfy: [:ref |
		(ref module notNil and: [ref module = module])]
! !

!Module methodsFor: 'module composition' stamp: 'squeak 8/30/2001 22:55'!
deepClassesDo: aBlock
	"evaluate aBlock for each class in my entire hierarchy of submodules"

	self deepSubmodulesDo: [:mod | 
		mod allClassesDo: [:class | aBlock value: class]]! !

!Module methodsFor: 'module composition' stamp: 'hg 9/3/2001 18:48'!
deepSubmodulesBottomUpDo: aBlock
	"evaluate aBlock for each module in my entire hierarchy of submodules"

	self submodulesDo: [:mod | mod deepSubmodulesBottomUpDo: aBlock].
	aBlock value: self.
! !

!Module methodsFor: 'module composition' stamp: 'hg 9/3/2001 18:48'!
deepSubmodulesDo: aBlock
	"evaluate aBlock for each module in my entire hierarchy of submodules"

	aBlock value: self.
	self submodulesDo: [:mod | mod deepSubmodulesDo: aBlock]! !

!Module methodsFor: 'module composition' stamp: 'hg 9/2/2001 13:39'!
importCreatesCircularity: module
	
	^module = self or: [module importedModules includes: self]! !

!Module methodsFor: 'module composition' stamp: 'hg 9/2/2001 12:39'!
importedModules
	
	| mods |
	mods _ OrderedCollection new.
	self importedModulesDo: [:mod | mods add: mod].
	^mods! !

!Module methodsFor: 'module composition' stamp: 'hg 9/3/2001 18:45'!
importedModulesDo: aBlock
	"iterate non-recursively over my included modules, in the correct order for name lookup" 

	self submoduleRefs do: [:ref | ref importNames ifTrue: [aBlock value: ref module]].
	self externalModuleRefs do: [:ref | ref importNames ifTrue: [aBlock value: ref module]].
! !

!Module methodsFor: 'module composition' stamp: 'hg 9/5/2001 20:09'!
refForModuleDefining: aName
	"answer the ModuleReference that gives this module access to the definition of aName"

	self submoduleRefs, self externalModuleRefs do: [:ref | 
		ref module exportedAssocFor: aName ifPresent: [:assoc :mod | ^ref]].
	^nil! !

!Module methodsFor: 'module composition' stamp: 'hg 9/3/2001 18:48'!
submoduleNamed: aString

	| ref |
	ref _ self submoduleRefs detect: [:aRef | aRef name = aString asSymbol] ifNone: [nil].
	^ref ifNotNil: [ref module]! !

!Module methodsFor: 'module composition' stamp: 'hg 9/3/2001 19:02'!
submodules

	^self submoduleRefs collect: [:ref | ref module]! !

!Module methodsFor: 'module composition' stamp: 'hg 9/3/2001 18:59'!
submodulesDo: aBlock

	^submodules ifNotNil: [submodules do: [:ref | aBlock value: ref module]]! !

!Module methodsFor: 'changing module composition' stamp: 'squeak 9/10/2001 12:24'!
addExternalModuleRef: moduleReference

	(self declaresExternalModule: moduleReference module) ifTrue: [
		self error: 'External module ', 
				moduleReference module pathAsMessages, ' already declared.'].
	moduleReference importNames & moduleReference module notNil ifTrue: [
		self checkImportForCircularity: moduleReference module].
	moduleReference hasAlias ifTrue: [
		self defineName: moduleReference alias as: moduleReference module 
			export: self shouldExportExternalModules].
	externalModules _ self externalModuleRefs copyWith: moduleReference.
! !

!Module methodsFor: 'changing module composition' stamp: 'squeak 9/10/2001 12:24'!
addSubmodule: moduleReference

	self submodulesDo: [:mod |
		mod = moduleReference module ifTrue: [
			self error: 'Submodule ', mod pathAsMessages, ' already declared.']].
	submodules _ self submoduleRefs copyWith: moduleReference.
! !

!Module methodsFor: 'changing module composition' stamp: 'hg 9/10/2001 14:51'!
addSubmoduleNamed: aString importNames: import
	"create and add a submodule"

	| submodule |
	submodule _ self species new name: aString version: nil parentModule: self.
	self submodule: submodule alias: nil importNames: import.
	^submodule
! !

!Module methodsFor: 'changing module composition' stamp: 'squeak 9/8/2001 22:31'!
ensureExternalModule: module

	(self declaresExternalModule: module) ifFalse: [
		self externalModule: module alias: nil importNames: false]! !

!Module methodsFor: 'changing module composition' stamp: 'hg 9/3/2001 19:19'!
moveSubmodule: moduleReference toBefore: anotherModuleReference

	submodules _ (self submoduleRefs asOrderedCollection 
						remove: moduleReference;
						add: moduleReference before: anotherModuleReference)
					asArray  
! !

!Module methodsFor: 'changing module composition' stamp: 'squeak 9/10/2001 10:24'!
removeModule

	self notYetImplemented ! !

!Module methodsFor: 'changing module composition' stamp: 'hg 9/3/2001 19:10'!
removeSubmodule: module
	"remove the module from me--do not finialize it, etc."

	| moduleReference |
	moduleReference _ self submoduleRefs detect: [:ref | ref module = module].
	submodules _ self submoduleRefs copyWithout: moduleReference.
	self removeName: moduleReference name.
	^moduleReference! !

!Module methodsFor: 'changing module composition' stamp: 'squeak 9/10/2001 10:22'!
shouldExportExternalModules
	"should external modules be exported by default?"
	
	^false! !

!Module methodsFor: 'changing module composition' stamp: 'squeak 9/10/2001 10:23'!
shouldExportSubmodules
	"should submodules be exported by default?
	You must export submodules to make them reachable from outside parent."

	^true! !

!Module methodsFor: 'version handling' stamp: 'hg 9/10/2001 14:58'!
incrementVersion
	"increment the version by one minimal unit"

	version _ version + self minimalVersionIncrease.
	^version! !

!Module methodsFor: 'version handling' stamp: 'hg 9/10/2001 14:56'!
minimalVersionIncrease
	"return the unit of the smallest version increase. One thousand per decimal version seems ok:"
	
	^0.0001! !

!Module methodsFor: 'version handling' stamp: 'squeak 9/10/2001 21:38'!
verbatimVersion

	^version! !

!Module methodsFor: 'version handling' stamp: 'squeak 9/10/2001 19:30'!
version
	"inherit version from parent if mine is nil"

	^version ifNil: [parentModule version]! !

!Module methodsFor: 'version handling' stamp: 'squeak 9/10/2001 19:38'!
version: aFloat
	
	version _ aFloat! !

!Module methodsFor: 'change sets' stamp: 'squeak 8/27/2001 21:53'!
changes
	"there is no longer a global active change set.
	All changes should be placed in the active change set of the module where the change belongs."

	^Preferences changeSetsPerModule
		ifTrue: [activeChangeSet ifNil: [self createChanges. activeChangeSet]]
		ifFalse: [Smalltalk changes]! !

!Module methodsFor: 'change sets' stamp: 'hg 8/21/2001 21:38'!
changes: cs

	activeChangeSet _ cs! !

!Module methodsFor: 'change sets' stamp: 'squeak 9/10/2001 12:24'!
createChanges
	"there is no longer a global active change set.
	All changes should be placed in the active change set of the module where the change belongs."

	self newChanges: (ChangeSet basicNewNamed: self pathAsMessages).! !

!Module methodsFor: 'change sets' stamp: 'hg 8/21/2001 21:37'!
newChanges: aChangeSet 
	"Set the module ChangeSet to be the argument, aChangeSet. " 

	self changes: aChangeSet	

"SystemDicitonary>>newChanges was:
Tell the current project that aChangeSet is now its change set.  When called from Project enter:, the setChangeSet: call is redundant but harmless; when called from code that changes the current-change-set from within a project, it's vital"

	"SystemChanges isolationSet: nil.
	SystemChanges _ aChangeSet.
	Smalltalk currentProjectDo:
		[:proj |
		proj setChangeSet: aChangeSet.
		aChangeSet isolationSet: proj isolationSet]"! !

!Module methodsFor: 'fileIn/Out' stamp: 'squeak 9/10/2001 21:39'!
definition
	"Answer a String that defines 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: #name:version:parentModule: .

	aStream nextPutAll: 
		'(', self class name, ' name: ', self name printString, 
		' version: ', self verbatimVersion printString, ' parentModule: nil)'.

	self submoduleRefs do: [:ref |
		aStream crtab. ref storeOn: aStream forSubmodule: true. aStream nextPut: $;].
	aStream cr.

	self externalModuleRefs do: [:ref |
		aStream crtab. ref storeOn: aStream forSubmodule: false. aStream nextPut: $;].

	aStream tab; nextPutAll: 'yourself.'.
	^ aStream contents! !

!Module methodsFor: 'fileIn/Out' stamp: 'squeak 9/10/2001 20:18'!
fullDefinitionOn: aStream
	"Write a complete definition of myself, with metainformation and a timestamp."

	aStream timeStamp; cr.

	aStream nextPutAll: self metaPrerequisites; cr.

	aStream nextPutAll: self definition; cr.! !

!Module methodsFor: 'fileIn/Out' stamp: 'squeak 9/10/2001 20:33'!
metaPrerequisites
	"Answer a string that lists the prerequisites for being able to understand (i.e. load) the definition of this module. This might be a special versioning scheme, repository implementation, or even a different module implementation."

	| aStream list |
	list _ 
		self class metaPrerequisites, 
		self repository class metaPrerequisites.
	list _ list asSet asSortedCollection.		"remove duplicates and sort"
	
	aStream _ WriteStream on: (String new: 100).
	aStream 
		tab; nextPutAll: '"These are the meta-prerequisites for being able to understand (i.e. load) the definition of this module. "'; cr; cr;
		nextPutAll: 'Module hierarchyVersion: ', Module root version printString, '.'; cr;
		nextPutAll: 'Module requiredMetaVersions: #('.
	list do: [:mod | 
		aStream crtab; nextPutAll: mod pathAndVersion literalPrintString].
	aStream nextPutAll: ').'.
	^aStream contents! !

!Module methodsFor: 'fileIn/Out' stamp: 'hg 9/10/2001 13:01'!
printOn: aStream
	"a simple pretty-printer"

	self path literalPrintOn: aStream! !

!Module methodsFor: 'fileIn/Out' stamp: 'hg 9/7/2001 19:35'!
storeOn: aStream
	"a simple pretty-printer"

	aStream nextPutAll: 'Module @ '.
	self printOn: aStream.! !

!Module methodsFor: 'code analysis' stamp: 'squeak 9/10/2001 12:27'!
viewDeepUnresolvedRefs  
	"Root viewDeepUnresolvedRefs"

	SystemDictionary new 
		browseMessageList: self deepUnresolvedRefs
		name: 'Unresolved Global References from ', self pathAsMessages 
		autoSelect: nil! !

!Module methodsFor: 'system conversion' stamp: 'squeak 9/10/2001 12:27'!
rewriteSourceForSelector: selector inClass: aClass
	"Rewrite the source code for the method in question so that all out-of-scope references are converted to explicit references to the defining module (which is added as an import of this module). This is done by parsing the source with a lenient parser able to find variables in any module.  Then the parse tree is consulted for the source code ranges of each reference that needs to be rewritten and the pattern to which it should be rewritten.  Note that assignments, which will take the form
	envt setValueOf: #GlobalName to: ...
may generate spurious message due to agglutination of keywords with the value expression."

	| code methodNode edits varName definingModule |

	code _ aClass sourceCodeAt: selector.
	methodNode _ Compiler new parse: code in: aClass notifying: nil.
	edits _ OrderedCollection new.
	methodNode encoder globalSourceRanges do:
		[:tuple |   "{ varName. srcRange. store }"
		(aClass scopeHas: (varName _ tuple first asSymbol) ifTrue: [:ignored]) ifFalse:
			["This is a remote global.  Add it as reference to be edited."
			edits addLast: { varName. tuple at: 2. tuple at: 3 }]].

	"Sort the edits by source position."
	edits _ edits asSortedCollection: [:a :b | a second first < b second first].
	edits reverseDo: [:edit | 
		varName _ edit first.
		"if name isn't defined in this module"
		(aClass scopeHas: varName ifTrue: [:ignore]) ifFalse: [
			"look in all modules in the system"
			definingModule _ Module root moduleDefining: varName.
			definingModule ifNotNil: [
				"ensure that defining module exports it"
				definingModule exportName: varName.

				self ensureExternalModule: definingModule. 

				"Replace access out of scope with a full-path remote reference"
				code _ code copyReplaceFrom: edit second first
							to: edit second last
							with: definingModule pathAsMessages, ' ' , varName]]].

	aClass compile: code classified: (aClass organization categoryOfElement: selector)! !

!Module methodsFor: 'compatibility' stamp: 'hg 9/3/2001 18:30'!
keyAtIdentityValue: value ifAbsent: exceptionBlock
	"Answer the key that is the external name for the argument.
	SystemDictionary compatibility."
 
	| key |
	^self definedNames keyAtIdentityValue: value ifAbsent: [
		self importedModulesDo: [:mod |
			key _ mod keyAtIdentityValue: value ifAbsent: [nil].
			key ifNotNil: [^key]].
		^exceptionBlock value]
	! !

!Module methodsFor: 'compatibility' stamp: 'hg 8/22/2001 22:16'!
organization

	^SystemOrganization ! !

!Module methodsFor: 'compatibility' stamp: 'hg 9/10/2001 16:09'!
removeClassFromSystem: aClass logged: aBool
	"Delete the class, aClass, from the system, but log the removal neither to the current change set nor to the changes log"
	aBool ifTrue:[
		aClass wantsChangeSetLogging ifTrue:
			[self changes noteRemovalOf: aClass].
		aClass acceptsLoggingOfCompilation ifTrue:
			[Smalltalk logChange:  self pathAsMessages, ' removeClassNamed: #', aClass name].
	].
	"self organization removeElement: aClass name."
	self class smalltalk removeFromStartUpList: aClass.
	self class smalltalk removeFromShutDownList: aClass.
	self removeName: aClass name.
	self class smalltalk flushClassNameCache
! !

!Module methodsFor: 'private' stamp: 'squeak 9/10/2001 12:24'!
checkImportForCircularity: module
	"check that adding the given module to my imported modules will not create an import circularity."

	(self importCreatesCircularity: module) ifTrue: [
		self error: 'Importing ', module pathAsMessages, 
			' into module ', self pathAsMessages,
			' would create a circular import']! !

!Module methodsFor: 'private' stamp: 'hg 9/3/2001 18:43'!
clearExternalModuleRefs

	externalModules _ nil! !


!Module class methodsFor: 'instance creation' stamp: 'hg 9/10/2001 14:48'!
name: aString version: versionFloat parentModule: aModule
	"create an instance of me"

	^self new name: aString version: versionFloat parentModule: aModule
! !

!Module class methodsFor: 'instance creation' stamp: 'squeak 9/12/2001 22:27'!
new

	^super new initialize! !

!Module class methodsFor: 'class initialization' stamp: 'hg 9/8/2001 20:30'!
createModularClassDefinitionsPreference
 
	Preferences	addPreference: #modularClassDefinitions
				category: #modules
				default: false
				balloonHelp: 'Specifies whether class definitions should contain their system category or their home module.'! !

!Module class methodsFor: 'class initialization' stamp: 'squeak 8/28/2001 23:03'!
createStrongModulesPreference

	Preferences	addPreference: #strongModules
				category: #modules
				default: false
				balloonHelp: 'If false, global definitions are placed into modules without disrupting the old-style system organization: all globals are still held in the global Smalltalk dictionary, out-of-scope references are not validated, and so on. This allows the analysis of a modularized system without disrupting existing tools and so on.'! !

!Module class methodsFor: 'class initialization' stamp: 'hg 9/10/2001 15:02'!
initialize
	"Module initialize"
	
	self createModularClassDefinitionsPreference.
	self createStrongModulesPreference.
	self resetWeakModules.
	RootModule _ VirtualRootModule setup.
	SmalltalkModule _ TransitionalSmalltalkModule setup.
! !

!Module class methodsFor: 'class initialization' stamp: 'squeak 8/30/2001 19:28'!
resetWeakModules
	"prepare system for change of regime"

	Preferences strongModules ifFalse: [
		Smalltalk allClassesDo: [:cl | cl module: nil]].! !

!Module class methodsFor: 'virtual hierarchy' stamp: 'hg 9/4/2001 19:36'!
@ fullPath
	"convenient form for accessing module from its path.
	Module @ #(Kernel Objects)"
	
	^self fromPath: fullPath ! !

!Module class methodsFor: 'virtual hierarchy' stamp: 'hg 8/21/2001 18:10'!
fromPath: modulePath
	"return the module with the given path"

	^self fromPath: modulePath forceCreate: false! !

!Module class methodsFor: 'virtual hierarchy' stamp: 'squeak 9/12/2001 13:22'!
fromPath: modulePath forceCreate: force
	"return the module with the given path"
	"don't be case sensitive but preserve given case when creating names"

	^modulePath inject: self root into: [:mod :localName |
		mod submodules 
			detect: [:sub | sub name asLowercase = localName asLowercase] 
			ifNone: [
				force
					ifFalse: [nil]	"nil returned to indicate that no module was found"
					ifTrue: [mod addSubmoduleNamed: localName importNames: false]]]! !

!Module class methodsFor: 'virtual hierarchy' stamp: 'squeak 9/10/2001 18:34'!
moduleForCategory: catString forceCreate: create
	"Return the module corresponding to the given system category"

	| mod |
	mod _ Module fromPath: (self pathFromCategory: catString) forceCreate: create.
	mod ifNil: [self error: 'No module for category ', catString].
	^ mod! !

!Module class methodsFor: 'virtual hierarchy' stamp: 'squeak 9/10/2001 18:32'!
pathFromCategory: catString
	"Module pathFromCategory:'Morphic-Demo'"
	"Convert a category name into a module path, taking dashes and spaces as level separators.
	 Put it under top-level module Squeak"

	| categoryPath alphaNumeric |
	(catString includes: $ ) ifTrue: [
		PopUpMenu confirm: 'Bad category name: ''', catString, '''. Module names should be proper symbols. OK to strip non-alphanumerical characters?' orCancel: [self halt]].
	alphaNumeric _ catString select: [:c | c isAlphaNumeric | (c = $-)].
	categoryPath _ alphaNumeric findTokens: '- '.
	^self squeak path , (categoryPath collect: [:str | str asSymbol])
! !

!Module class methodsFor: 'virtual hierarchy' stamp: 'hg 9/7/2001 19:31'!
root

	^RootModule! !

!Module class methodsFor: 'virtual hierarchy' stamp: 'squeak 8/30/2001 23:46'!
smalltalk
	"return the module whose dictionary is Smalltalk.
	use this method instead of hardcoding references to Smalltalk"

	^SmalltalkModule! !

!Module class methodsFor: 'virtual hierarchy' stamp: 'squeak 9/10/2001 17:52'!
squeak
	"return the module that holds all the Squeak system classes."

	^self @ #(Squeak)! !

!Module class methodsFor: 'fileIn/Out' stamp: 'squeak 9/10/2001 12:09'!
metaPrerequisites
	"Answer a lists of prerequisites for being able to understand (i.e. load) my instances. A prerequisite is simply given as a specific module and version."

	^Array with: self module! !

!Module class methodsFor: 'system conversion' stamp: 'squeak 9/11/2001 12:12'!
convertSystemOrganizationToModules
	"Module convertSystemOrganizationToModules."

	Preferences strongModules ifTrue: [
		^PopUpMenu inform:
'It is not recommended that you convert the system while the strongModules preference is true. Change it to false and then run this method again.'].

	"Fix non-conforming system category names"
	self fixProperCategoryNames.

	self resetWeakModules.
	
	self createTopLevels.
	
	self modulesFromSystemCategories.
	
	ModularSystemOrganizer install.

	Preferences enable: #browserShowsPackagePane.! !

!Module class methodsFor: 'system conversion' stamp: 'squeak 9/10/2001 21:13'!
modulesFromSystemCategories
	"this is run before dropping the old-style SystemOrganization"

	| mod refactorer |
	Module squeak version: 0.0.	"This creates version zero of the class library organization"

	refactorer _ self aRefactorer.
	SystemOrganization categories do:
		[:cat | 
			mod _ Module moduleForCategory: cat forceCreate: true.
			refactorer
				transferBindingsNamedIn: (SystemOrganization listAtCategoryNamed: cat)
				from: Module smalltalk to: mod.
		].! !


!ModuleRefactorer methodsFor: 'versions' stamp: 'hg 9/10/2001 15:54'!
fromVersion
	"return the version of the Squeak hierarch to start with"

	self subclassResponsibility ! !

!ModuleRefactorer methodsFor: 'versions' stamp: 'hg 9/10/2001 15:55'!
toVersion
	"return the resulting number of the resulting Squeak hierarchy"

	self subclassResponsibility ! !

!ModuleRefactorer methodsFor: 'test setup' stamp: 'hg 9/10/2001 15:49'!
createTopLevels

	self generateSubmodules: Module topLevelModuleList for: self root! !

!ModuleRefactorer methodsFor: 'public' stamp: 'squeak 9/10/2001 22:00'!
runRefactorings
	"Trigger the whole set of refactorings in this class."

	Preferences strongModules ifTrue: [
		Module smalltalk newChanges: 
			(ChangeSet basicNewNamed: self class name, ' Reorganization')].

	self moveModules.
	self moveGlobalsToModules.
	self installModuleDeclarations.
	self refactorClasses.
	self removeModules.

	Preferences strongModules 
		ifTrue: [
			Module root rewriteIndirectRefs.
			Module smalltalk newChanges: (ChangeSet basicNewNamed: 'PostReorganization').
			ChangeSorter initialize]

! !

!ModuleRefactorer methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 23:09'!
moveModules
	
	| moveList mod ref afterParentPath afterParent |
	moveList _ self newPlacesForModules.
	moveList pairsDo: [:before :after |
		mod _ Module fromPath: before forceCreate: false.
		mod ifNotNil: [
			ref _ mod parentModule removeSubmodule: mod.
			afterParentPath _ after allButLast.
			afterParent _ Module fromPath: afterParentPath forceCreate: true.
			mod name: after last version: mod verbatimVersion parentModule: afterParent.
			afterParent addSubmodule: ref]].
		! !

!ModuleRefactorer methodsFor: 'moving definitions' stamp: 'hg 9/10/2001 16:46'!
moveGlobalsToModules
	"move non-class globals from Smalltalk"
	
	self modulesForGlobals pairsDo: [:globalName :path |
		self transferBindingsNamedIn: (Array with: globalName) 
			from: Module smalltalk to: Module @ path]! !

!ModuleRefactorer methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 23:19'!
clearDeclaredModules
	"remove all module declarations everywhere"
	"Module clearDeclaredModules"

	Module root deepSubmodulesDo: [:mod | mod clearExternalModuleRefs]! !

!ModuleRefactorer methodsFor: 'external module declarations' stamp: 'hg 9/10/2001 15:49'!
copyDeclarationsFromParent: module

	module parentModule ifNotNil: [
		module parentModule externalModuleRefs do: [:ref |
			module addExternalModuleRef: ref]]
! !

!ModuleRefactorer methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 22:03'!
declarationsByDefault: mod

	self copyDeclarationsFromParent: mod.
	mod path size > 2 ifTrue: [mod importIntoParent].
! !

!ModuleRefactorer methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 23:34'!
installModuleDeclarations

	| installSelector name |

	self clearDeclaredModules.

	Module squeak deepSubmodulesDo: [:mod |
		name _ mod longName.
		name _ name copyFrom: 7 to: name size.
		installSelector _ ('declarationsFor', name, ':') asSymbol.
		(self respondsTo: installSelector) 
			ifFalse: [installSelector _ #declarationsByDefault:].
		self perform: installSelector with: mod]
! !

!ModuleRefactorer methodsFor: 'utilities' stamp: 'squeak 9/10/2001 18:52'!
transferBindingsNamedIn: nameList from: oldModule to: newModule

	| assoc |
	nameList do: [:aName |
		assoc _ oldModule localAssocFor: aName ifAbsent: [self error: 'name not found'].
		newModule addAssoc: assoc export: true.
		(assoc value isKindOf: Class) ifTrue: [assoc value module: newModule].
		oldModule removeName: aName]! !


!ModuleReference methodsFor: 'accessing' stamp: 'squeak 8/30/2001 23:37'!
alias

	^alias! !

!ModuleReference methodsFor: 'accessing' stamp: 'hg 9/1/2001 21:03'!
hasAlias

	^alias notNil! !

!ModuleReference methodsFor: 'accessing' stamp: 'squeak 8/30/2001 18:26'!
importNames

	^importNames! !

!ModuleReference methodsFor: 'accessing' stamp: 'squeak 8/30/2001 16:39'!
importNames: aBoolean

	importNames _ aBoolean! !

!ModuleReference methodsFor: 'accessing' stamp: 'squeak 8/30/2001 16:47'!
module

	^module! !

!ModuleReference methodsFor: 'accessing' stamp: 'hg 9/1/2001 21:12'!
name

	^self hasAlias 
		ifFalse: [self module name]
		ifTrue: [alias]! !

!ModuleReference methodsFor: 'initializing' stamp: 'hg 9/1/2001 21:00'!
alias: stringOrNil module: aModule import: import

	alias _ stringOrNil.
	module _ aModule.
	importNames _ import ! !

!ModuleReference methodsFor: 'printing' stamp: 'hg 9/1/2001 21:05'!
printOn: aStream

	self hasAlias ifTrue: [
		aStream nextPutAll: '#', alias, '->'].
	aStream nextPutAll: module printString.
	importNames ifTrue: [aStream nextPut: $*].! !

!ModuleReference methodsFor: 'printing' stamp: 'squeak 9/10/2001 21:05'!
storeOn: aStream forSubmodule: asSubmodule
	"write a message string that will create myself if sent to a module"

	| moduleType path |
	"Keep flag: messages with used selectors here so that this code will be updated if the selectors are changed."
	self flag: #submodule:alias:importNames: .
	self flag: #exportedModule:alias:importNames: .

	moduleType _ asSubmodule ifTrue: ['submodule'] ifFalse: ['externalModule'].
	path _ self specifiesVersion ifFalse: [self module path] ifTrue: [self module pathAndVersion].
	
	aStream 
		nextPutAll: moduleType, ': ', path literalPrintString; 
		nextPutAll: ' alias: '; print: self alias;
		nextPutAll: ' importNames: '; print: self importNames; nextPut: $;.
! !

!ModuleReference methodsFor: 'testing' stamp: 'squeak 9/10/2001 20:59'!
specifiesVersion
	"Do I specify a module version? Note that the module I hold will have a version in any case,"

	^version notNil! !


!ModuleParameter methodsFor: 'initializing' stamp: 'squeak 8/30/2001 16:04'!
alias: aString module: aModule import: import defaultModule: default

	self alias: aString module: aModule import: import.
	defaultModule _ default! !

!ModuleParameter methodsFor: 'accessing' stamp: 'squeak 8/31/2001 11:13'!
module
	"answer the module, or the default if none"

	^module ifNil: [defaultModule]! !


!TransitionalSmalltalkModule methodsFor: 'accessing defined names' stamp: 'squeak 9/11/2001 12:18'!
allClassesDo: aBlock
	"just expose exported classes, as other modules expose the others"

	self exportedNames valuesDo: [:value | 
		(value isKindOf: Class) ifTrue: [aBlock value: value]]
! !

!TransitionalSmalltalkModule methodsFor: 'compatibility' stamp: 'hg 9/3/2001 18:39'!
doesNotUnderstand: aMessage
	"signal and reroute messages to the SystemDictionary for backward compatibility"

	Transcript show: aMessage printString, 
		' from ', thisContext sender printString, '.'; cr.
	^self definedNames perform: aMessage selector withArguments: aMessage arguments ! !

!TransitionalSmalltalkModule methodsFor: 'compatibility' stamp: 'hg 8/31/2001 17:43'!
initialize
	"Set my name dictionaries to point to the old-style global dictionary Smalltalk"

	super initialize.
	definedNames _ Smalltalk.
	exportedNames _ IdentityDictionary newFrom: Smalltalk.
! !

!TransitionalSmalltalkModule methodsFor: 'code analysis' stamp: 'hg 9/2/2001 15:09'!
localUnresolvedRefs
	"Don't do this for Smalltalk"

	^#()! !

!TransitionalSmalltalkModule methodsFor: 'changing defined names' stamp: 'hg 9/7/2001 20:28'!
redefineName: aString as: value export: exportIt

	self addAssoc: (aString asSymbol)->value export: exportIt.
! !

!TransitionalSmalltalkModule methodsFor: 'changing defined names' stamp: 'hg 9/5/2001 20:35'!
removeName: aName
	"Under weakModules, exportedNames will only contain definitions that haven't been removed, 
	while Smalltalk (definedNames) is left untouched"

	Preferences strongModules 
		ifFalse: [self exportedNames removeKey: aName asSymbol ifAbsent: []]
		ifTrue: [super removeName: aName]! !


!TransitionalSmalltalkModule class methodsFor: 'class initialization' stamp: 'hg 9/10/2001 15:01'!
setup
	"install instance of me as Smalltalk submodule of Root"

	| instance |
	instance _ self new initialize.
	instance name: #OldstyleSmalltalk version: nil parentModule: Module root.
	Module fromPath: #(Squeak) forceCreate: true.
	Module root submodule: instance alias: nil importNames: false.
	^instance! !



!VirtualRootModule methodsFor: 'module name and path' stamp: 'hg 9/2/2001 16:55'!
longName

	^#Root! !

!VirtualRootModule methodsFor: 'module name and path' stamp: 'squeak 9/10/2001 12:29'!
path
	"I am the root of the virtual Module hierarchy.
	 Note that a path is an Array of literals. "

	^#()! !

!VirtualRootModule methodsFor: 'module name and path' stamp: 'squeak 9/10/2001 12:34'!
pathAsMessages
	"return the full path as the source code for a sequence of messages to refer to me.
	Names defined in the Root require no prefixing (at least for now)"

	^''! !

!VirtualRootModule methodsFor: 'initializing' stamp: 'squeak 9/12/2001 15:40'!
initialize

	super initialize.
	name _ #Root.
	"empirically, sizes above 100 yield diminishing speed gains for declareExternalRefs"
	outOfScopeCache _ IdentityDictionary new: 100. ! !

!VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 8/21/2001 21:57'!
allModules

	| all |
	all _ OrderedCollection with: self.
	self deepSubmodulesDo: [:mod | all add: mod].
	^all! !

!VirtualRootModule methodsFor: 'accessing defined names' stamp: 'squeak 8/28/2001 19:56'!
classNames
	"Answer a SortedCollection of all class names."

	^cachedClassNames ifNil: [cachedClassNames _ self computeClassNames asSortedCollection].
! !

!VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 9/7/2001 16:15'!
computeClassNames
	"Answer a SortedCollection of all class names."

	| names |
	names _ OrderedCollection new.
	self deepClassesDo: [:cl | names add: cl name].
	^names asSortedCollection! !

!VirtualRootModule methodsFor: 'accessing defined names' stamp: 'squeak 9/11/2001 18:32'!
importedAssocFor: aString ifPresent: aBlock
	"for efficiency, just look locally since all modules will be traversed anyway"
 
	| assoc pair |
	pair _ outOfScopeCache at: aString asSymbol ifAbsentCache: [:cachedAssoc |
		self importedModulesDo: [:module |
			assoc _ module localExportedAssocFor: aString ifAbsent: [nil]. 
			assoc ifNotNil: [
				cachedAssoc value: (Array with: assoc with: module).
				aBlock value: assoc value: module.
				^assoc]]. 
		nil].
	^pair ifNotNil: [
		aBlock value: pair first value: pair second.
		pair first]! !

!VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 8/21/2001 16:00'!
lenientScopeHas: varName ifTrue: assocBlock
	"Compatibility hack -- find things in all modules for now"
	| mod |
	mod _ self moduleDefining: varName.
	mod ifNotNil: [
		assocBlock value: (mod localAssocFor: varName ifAbsent: [nil]).
		^true].
	^ false! !

!VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 9/1/2001 19:12'!
moduleDefining: varName
	"search all modules in the system"
	
	self exportedAssocFor: varName ifPresent: [:assoc :mod | ^mod].
	^nil! !

!VirtualRootModule methodsFor: 'module composition' stamp: 'hg 9/7/2001 18:59'!
importedModulesDo: aBlock
	"iterate recursively over all modules in the hierarchy (except myself!!).
	This implements the special name semantics of the virtual root,
	which is that it has direct access to all exported names from all modules" 

	self submodulesDo: [:sub |
		sub deepSubmodulesBottomUpDo: aBlock]! !

!VirtualRootModule methodsFor: 'printing' stamp: 'hg 9/1/2001 19:39'!
printOn: aStream

	aStream nextPutAll: '(the Virtual Root Module)'! !

!VirtualRootModule methodsFor: 'private' stamp: 'hg 9/2/2001 12:31'!
checkImportForCircularity: module
	"don't do this because of the special import policy for root"

	^self! !

!VirtualRootModule methodsFor: 'private' stamp: 'squeak 9/12/2001 15:19'!
declareExternalRefs   
	"Module root declareExternalRefs"
	"For all classes in this module, identify all references to unresolved globals.
	For each of these, call another method to declare the global's defining module."

	| n refsList |
	refsList _ self deepUnresolvedRefs.

	MessageTally time: ['Declaring all external references in source code...'
		displayProgressAt: Sensor cursorPoint
		from: 0 to: refsList size
		during:
		[:bar | n _ 0.
		refsList do:
			[:ref | bar value: (n_ n+1).
			ref actualClass module 
				declareExternalRefsForSelector: ref methodSymbol 
				inClass: ref actualClass]]].
	^refsList size! !


!VirtualRootModule class methodsFor: 'instance creation' stamp: 'hg 8/22/2001 18:42'!
new

	^self error: 'There should only be one Root module'! !

!VirtualRootModule class methodsFor: 'instance creation' stamp: 'squeak 9/10/2001 19:33'!
setup
	"create the single instance"

	^super new 
		version: 0.0;
		yourself! !


!VirtualRootModule reorganize!
('module name and path' longName path pathAsMessages)
('initializing' initialize)
('accessing defined names' allModules classNames computeClassNames importedAssocFor:ifPresent: lenientScopeHas:ifTrue: moduleDefining:)
('module composition' importedModulesDo:)
('printing' printOn:)
('private' checkImportForCircularity: declareExternalRefs)
!


!ModuleRefactorer reorganize!
('versions' fromVersion toVersion)
('test setup' createTopLevels)
('public' runRefactorings)
('moving modules' modulesToRemove moveModules removeModules)
('moving definitions' modulesForGlobals moveGlobalsToModules refactorClasses)
('external module declarations' clearDeclaredModules copyDeclarationsFromParent: declarationsByDefault: installModuleDeclarations)
('utilities' transferBindingsNamedIn:from:to:)
!

Module initialize!

!Module class reorganize!
('instance creation' name:version:parentModule: new)
('class initialization' createModularClassDefinitionsPreference createStrongModulesPreference initialize resetWeakModules)
('virtual hierarchy' @ fromPath: fromPath:forceCreate: listForPackageBrowser moduleForCategory:forceCreate: pathFromCategory: root smalltalk squeak)
('fileIn/Out' metaPrerequisites)
('system conversion' aRefactorer convertSystemOrganizationToModules createTopLevels fixProperCategoryNames generateSubmodules:for: modulesFromSystemCategories properCategoryNames topLevelModuleList)
!


!Module reorganize!
('accessing' annotationAt: annotationAt:put: annotations classNames definedNames deltasPath exportedNames externalModuleRefs parentModule repository repository: species submoduleRefs)
('initializing' initialize name:version:parentModule:)
('module name and path' longName name path pathAndVersion pathAsMessages qualifiedReferenceAsMessagesFor: simulatedCategory)
('accessing defined names' associationFor:ifAbsent: associationFor:ifPresent: doesNotUnderstand: exportedAssocFor:ifPresent: importedAssocFor:ifPresent: localAssocFor:ifAbsent: localExportedAssocFor:ifAbsent:)
('changing defined names' addAssoc:export: defineName:as:export: exportName: redefineName:as:export: removeName:)
('module definition protocol' externalModule:alias:importNames: parameterModuleWithDefault:alias:importNames: submodule:alias:importNames:)
('module composition' allClassesDo: declaresExternalModule: deepClassesDo: deepSubmodulesBottomUpDo: deepSubmodulesDo: importCreatesCircularity: importedModules importedModulesDo: refForModuleDefining: submoduleNamed: submodules submodulesDo:)
('changing module composition' addExternalModuleRef: addSubmodule: addSubmoduleNamed:importNames: deltaModuleForBase:forceCreate: ensureExternalModule: moveSubmodule:toBefore: removeModule removeSubmodule: shouldExportExternalModules shouldExportSubmodules)
('version handling' incrementVersion minimalVersionIncrease verbatimVersion version version:)
('change sets' changes changes: createChanges newChanges:)
('fileIn/Out' definition fullDefinitionOn: metaPrerequisites printOn: storeOn:)
('user interface' explore moduleExplorerContents)
('code analysis' deepIncomingRefsFromOutside: deepUniqueMessagesToOutside: deepUnresolvedRefs localIncomingRefsFromOutside: localUnresolvedRefs setUnresolvedCount: viewDeepUnresolvedRefs)
('system conversion' collectUpstreamMethodsOutside: declareExternalRefs declareExternalRefsForSelector:inClass: importIntoParent rewriteIndirectRefs rewriteSourceForSelector:inClass:)
('compatibility' keyAtIdentityValue:ifAbsent: organization removeClassFromSystem:logged:)
('private' checkImportForCircularity: clearExternalModuleRefs)
('testing' isDeltaModule)
!

"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
!

-------------- next part --------------
'From Squeak3.1alpha of 7 March 2001 [latest update: #4332] on 12 September 2001 at 10:11:01 pm'!

!ObjectExplorer methodsFor: 'as yet unclassified' stamp: 'hg 9/7/2001 12:35'!
explorerFor: anObject
	| window listMorph |
	rootObject _ anObject.
	window _ (SystemWindow labelled: self label) model: self.
	window addMorph: (listMorph _ SimpleHierarchicalListMorph 
			on: self
			list: #getList
			selected: #getCurrentSelection
			changeSelected: #noteNewSelection:
			menu: #genericMenu:
			keystroke: nil)
		frame: (0 at 0 corner: 1 at 0.8).
	window addMorph: ((PluggableTextMorph on: self text: #trash accept: #trash:
				readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
					askBeforeDiscardingEdits: false)
		frame: (0 at 0.8 corner: 1 at 1).
	listMorph autoDeselect: false.
     ^ window! !

!ObjectExplorer methodsFor: 'as yet unclassified' stamp: 'hg 9/7/2001 12:12'!
label

	^ rootObject printStringLimitedTo: 32! !


!ObjectExplorerWrapper methodsFor: 'as yet unclassified' stamp: 'hg 9/7/2001 12:15'!
contents

	(item respondsTo: #explorerContents) ifTrue: [^item explorerContents].
	"For all others, show named vars first, then indexed vars"
	^(item class allInstVarNames asOrderedCollection withIndexCollect: [:each :index |
		self class
			with: (item instVarAt: index)
			name: each
			model: item]) ,
	((1 to: item basicSize) collect: [:index |
		self class
			with: (item basicAt: index)
			name: index printString
			model: item])! !

!ObjectExplorerWrapper methodsFor: 'converting' stamp: 'hg 9/7/2001 19:58'!
asString
	| explorerString string |
	explorerString _ 
		[item asExplorerString]
			on: Error 
			do: ['<error in asExplorerString: evaluate "' , itemName , ' asExplorerString" to debug>'].
	string _ (itemName ifNotNil: [itemName , ': '] ifNil: ['']) , explorerString.
	(string includes: Character cr)
		ifTrue: [^ string withSeparatorsCompacted].
	^ string! !


!SequenceableCollection methodsFor: 'explorer' stamp: 'hg 9/7/2001 12:01'!
explorerContents

	^self asOrderedCollection withIndexCollect: [:value :index |
		ObjectExplorerWrapper
			with: value
			name: index printString
			model: self]! !


!Set methodsFor: 'explorer' stamp: 'hg 9/7/2001 11:51'!
explorerContents 

	^self asOrderedCollection withIndexCollect: [:each :index |
		ObjectExplorerWrapper
			with: each
			name: index printString
			model: self]! !

!Set methodsFor: 'explorer' stamp: 'hg 9/7/2001 11:51'!
hasContentsInExplorer

	^self isEmpty not! !


!Dictionary methodsFor: 'user interface'!
explorerContents

	| contents |
	
	contents _ OrderedCollection new.
	self keysAndValuesDo: [:key :value |
		contents add: (ObjectExplorerWrapper
			with: value
			name: (key printString contractTo: 32)
			model: self)].
	^contents
! !


!SimpleHierarchicalListMorph methodsFor: 'events'!
expandAll
	(selectedMorph isNil
		or: [selectedMorph isExpanded])
		ifTrue: [^self].
	self expandAll: selectedMorph.
	self adjustSubmorphPositions! !

!SimpleHierarchicalListMorph methodsFor: 'events'!
expandAll: aMorph
	| allChildren |
	aMorph toggleExpandedState.
	allChildren _ OrderedCollection new: 10.
	aMorph recursiveAddTo: allChildren.
	allChildren do: [:each | 
		(each canExpand and: [each isExpanded not])
			ifTrue: [self expandAll: each]].
! !

-------------- next part --------------
'From Squeak3.1alpha of 7 March 2001 [latest update: #4332] on 12 September 2001 at 10:11:06 pm'!
"Change Set:		ModuleReorgTools
Date:			3 September 2001
Author:			Henrik Gedenryd

Code and tools for analyzing and reorganizing the system under the modules scheme to remove dependencies. Very much a work in progress."!

ObjectExplorer subclass: #ModuleExplorer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!
ObjectExplorerWrapper subclass: #ModuleExplorerWrapper
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!
ModuleRefactorer subclass: #FromVersion0p0000to0001
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules-Refactorings'!
Object subclass: #ModuleReference
	instanceVariableNames: 'module alias version importNames '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!

!MethodReference methodsFor: 'queries' stamp: 'hg 9/2/2001 22:05'!
printOn: aStream

	aStream nextPutAll: (self actualClass printString, '>>', self methodSymbol)! !

!MethodReference methodsFor: 'printing' stamp: 'hg 9/2/2001 22:18'!
moduleExplorerContents 

	^Array with: (
		ModuleExplorerWrapper 
					with: (self actualClass sourceCodeAt: self methodSelector)
					name: ''
					model: self)

	! !


!Module methodsFor: 'user interface' stamp: 'hg 9/2/2001 19:58'!
explore

	^ModuleExplorer new openExplorerFor: self! !

!Module methodsFor: 'user interface' stamp: 'squeak 9/8/2001 21:55'!
moduleExplorerContents

	| list value |
	list _ OrderedCollection new.
	list add: 
			(ModuleExplorerWrapper 
				with: self externalModuleRefs
				name: 'external modules'
				model: self);
		add: 
			(ModuleExplorerWrapper 
				with: self submoduleRefs
				name: 'submodules'
				model: self).
	#(definedNames exportedNames)
		do: [:each | 
			value _ self perform: each.
			value isEmpty ifFalse: [
				list add: 
					(ModuleExplorerWrapper 
						with: value
						name: each
						model: self)]].
	list add: 
			(ModuleExplorerWrapper 
				with: self repository
				name: 'repository'
				model: self).
	self annotations associationsDo: [:assoc |
		list _ list copyWith: 
			(ModuleExplorerWrapper 
					with: assoc value
					name: assoc key
					model: assoc)].
	^list
			! !

!Module methodsFor: 'code analysis' stamp: 'squeak 9/12/2001 16:51'!
deepIncomingRefsFromOutside: module 
	"all methods on the outside that are only reached by sends from within this 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 associationsDo: [:assoc | refs at: assoc 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 | 
							refs at: lit ifPresent: [:hits | hits 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 9/7/2001 18:00'!
deepUniqueMessagesToOutside: module 
	"all methods on the outside that are only reached by sends from within this Module"
	"(Module fromPath: #(EToy Experimental)) localUniqueMessagesToOutside: (Module fromPath: #(EToy))"

	| refs insideModules n selectors total all foreign |
	refs _ IdentityDictionary new.
	selectors _ IdentitySet new.
	insideModules _ IdentitySet new.
	module deepSubmodulesDo: [:mod | insideModules add: mod].
	total _ 0.
	self class root deepClassesDo: [:cl | total _ total + 1].

	self deepClassesDo: [:cl | 
		cl methodDict keysAndValuesDo: [:sel :cm | 
			cm messages do: [:lit | selectors add: lit]]].
	'Locating foreign methods ...'
		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 methodDict keysAndValuesDo: [:s :cm | 
						cm messages do: [:selector | 
							selectors remove: selector ifAbsent: []]]]]].
	selectors do: [:sel |
		all _ Smalltalk allImplementorsOf: sel.
		foreign _ all reject: [:mref | insideModules includes: mref actualClass module].
		foreign isEmpty ifFalse: [refs at: sel put: foreign]].

	^refs! !

!Module methodsFor: 'code analysis' stamp: 'hg 9/2/2001 18:48'!
deepUnresolvedRefs  

	| list n total localList |

	total _ 0.
	self deepSubmodulesDo: [:mod | total _ total + 1].
	list _ OrderedCollection new.
	'Locating methods with unresolved global references...'
		displayProgressAt: Sensor cursorPoint
		from: 0 to: total
		during:
		[:bar | n _ 0.
		self deepSubmodulesBottomUpDo: [:mod | 
			bar value: (n_ n+1).
			localList _ mod localUnresolvedRefs.
			list addAll: localList.
			mod setUnresolvedCount: localList size.]].

	^list asSortedCollection! !

!Module methodsFor: 'code analysis' stamp: 'hg 9/3/2001 14:14'!
localIncomingRefsFromOutside: module 
	"all references from outside to globals defined in this Module"
	"(Module fromPath: #(EToy Experimental)) localIncomingRefsFromOutside: (Module fromPath: #(EToy))"

	| refs all foreign insideModules |
	refs _ IdentityDictionary new.
	insideModules _ IdentitySet new.
	module deepSubmodulesDo: [:mod | insideModules add: mod].
	
	self definedNames associationsDo: [:assoc |
		all _ Smalltalk allCallsOn: assoc.
		foreign _ all select: [:mref | 
			(insideModules includes: mref actualClass module) not].
		refs at: assoc key put: foreign].

	^refs! !

!Module methodsFor: 'code analysis' stamp: 'hg 9/2/2001 18:47'!
localUnresolvedRefs  
	"all unresolved global references from code in this Module"
	"(Module fromPath: #(Morphic)) localUnresolvedRefs"

	| lits list foundOne allClasses |

	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.
			foundOne _ false.
			lits do:
				[:lit | lit isVariableBinding ifTrue:
					[(lit value == cl or: [cl strongScopeHas: lit key ifTrue: [:ignored]])
						ifFalse: [foundOne _ true]]].
			foundOne ifTrue: [
				list add: (
					MethodReference new
						setStandardClass: cl 
						methodSymbol: sel)]
			]].
	^list! !

!Module methodsFor: 'code analysis' stamp: 'hg 9/3/2001 19:26'!
setUnresolvedCount: localCount

	| subCounts |
	subCounts _ 0.
	self annotationAt: #localUnresolved put: localCount.
	self submodulesDo: [:mod | subCounts _ subCounts + (mod annotationAt: #deepUnresolved)].
	self annotationAt: #deepUnresolved put: subCounts + localCount.
! !

!Module methodsFor: 'code analysis' stamp: 'squeak 9/10/2001 12:27'!
viewDeepUnresolvedRefs  
	"Root viewDeepUnresolvedRefs"

	SystemDictionary new 
		browseMessageList: self deepUnresolvedRefs
		name: 'Unresolved Global References from ', self pathAsMessages 
		autoSelect: nil! !

!Module methodsFor: 'system conversion' stamp: 'hg 9/2/2001 15:05'!
declareExternalRefs   
	"Root declareExternalRefs"
	"For all classes in this module, identify all references to unresolved globals.
	For each of these, call another method to declare the global's defining module."

	| n refsList |
	refsList _ self deepUnresolvedRefs.

	'Declaring all external references in source code...'
		displayProgressAt: Sensor cursorPoint
		from: 0 to: refsList size
		during:
		[:bar | n _ 0.
		refsList do:
			[:ref | bar value: (n_ n+1).
			ref actualClass module declareExternalRefsForSelector: ref methodSymbol inClass: ref actualClass]].

	^refsList size! !

!Module methodsFor: 'system conversion' stamp: 'hg 9/2/2001 15:03'!
declareExternalRefsForSelector: selector inClass: aClass
	"for all unresolved globals in the method of the given selector and class, declare the global's defining module as one of my external modules"

	| varName definingModule cm lits |

	cm _ aClass compiledMethodAt: selector.
	lits _ cm literals.
	lits do: [:lit | 
		lit isVariableBinding ifTrue: [
			varName _ lit key.
			(lit value == aClass or: [aClass strongScopeHas: lit key ifTrue: [:ignored]]) ifFalse: [
				definingModule _ Module root moduleDefining: varName.
				definingModule ifNotNil: [
					"ensure that defining module exports it"
					"definingModule exportName: varName."

					self ensureExternalModule: definingModule]]]]
! !

!Module methodsFor: 'system conversion' stamp: 'squeak 8/30/2001 23:13'!
importIntoParent

	(self parentModule submoduleRefs detect: [:ref | ref module = self])
		importNames: true.
! !

!Module methodsFor: 'system conversion' stamp: 'squeak 8/30/2001 23:53'!
rewriteIndirectRefs   
	"Root rewriteIndirectRefs"
	"For all classes, identify all methods with references to globals outside their direct access path.
	For each of these, call another method to rewrite the source with proper references."

	| n refsList |

	"Allow compiler to compile refs to globals out of the direct reference path"
	Preferences enable: #lenientScopeForGlobals.

	refsList _ self deepIndirectRefs.

	'Updating indirect global references in source code...'
		displayProgressAt: Sensor cursorPoint
		from: 0 to: refsList size
		during:
		[:bar | n _ 0.
		refsList do:
			[:ref | bar value: (n_ n+1).
			self rewriteSourceForSelector: ref methodSymbol inClass: ref actualClass]].

	Preferences disable: #lenientScopeForGlobals.

! !

!Module methodsFor: 'system conversion' stamp: 'squeak 9/10/2001 12:27'!
rewriteSourceForSelector: selector inClass: aClass
	"Rewrite the source code for the method in question so that all out-of-scope references are converted to explicit references to the defining module (which is added as an import of this module). This is done by parsing the source with a lenient parser able to find variables in any module.  Then the parse tree is consulted for the source code ranges of each reference that needs to be rewritten and the pattern to which it should be rewritten.  Note that assignments, which will take the form
	envt setValueOf: #GlobalName to: ...
may generate spurious message due to agglutination of keywords with the value expression."

	| code methodNode edits varName definingModule |

	code _ aClass sourceCodeAt: selector.
	methodNode _ Compiler new parse: code in: aClass notifying: nil.
	edits _ OrderedCollection new.
	methodNode encoder globalSourceRanges do:
		[:tuple |   "{ varName. srcRange. store }"
		(aClass scopeHas: (varName _ tuple first asSymbol) ifTrue: [:ignored]) ifFalse:
			["This is a remote global.  Add it as reference to be edited."
			edits addLast: { varName. tuple at: 2. tuple at: 3 }]].

	"Sort the edits by source position."
	edits _ edits asSortedCollection: [:a :b | a second first < b second first].
	edits reverseDo: [:edit | 
		varName _ edit first.
		"if name isn't defined in this module"
		(aClass scopeHas: varName ifTrue: [:ignore]) ifFalse: [
			"look in all modules in the system"
			definingModule _ Module root moduleDefining: varName.
			definingModule ifNotNil: [
				"ensure that defining module exports it"
				definingModule exportName: varName.

				self ensureExternalModule: definingModule. 

				"Replace access out of scope with a full-path remote reference"
				code _ code copyReplaceFrom: edit second first
							to: edit second last
							with: definingModule pathAsMessages, ' ' , varName]]].

	aClass compile: code classified: (aClass organization categoryOfElement: selector)! !


!Module class methodsFor: 'system conversion' stamp: 'squeak 9/10/2001 18:01'!
aRefactorer

	^ModuleRefactorer new! !

!Module class methodsFor: 'system conversion' stamp: 'squeak 9/11/2001 12:12'!
convertSystemOrganizationToModules
	"Module convertSystemOrganizationToModules."

	Preferences strongModules ifTrue: [
		^PopUpMenu inform:
'It is not recommended that you convert the system while the strongModules preference is true. Change it to false and then run this method again.'].

	"Fix non-conforming system category names"
	self fixProperCategoryNames.

	self resetWeakModules.
	
	self createTopLevels.
	
	self modulesFromSystemCategories.
	
	ModularSystemOrganizer install.

	Preferences enable: #browserShowsPackagePane.! !

!Module class methodsFor: 'system conversion' stamp: 'hg 9/7/2001 17:58'!
createTopLevels

	self generateSubmodules: Module topLevelModuleList for: self root! !

!Module class methodsFor: 'system conversion' stamp: 'squeak 9/10/2001 18:16'!
fixProperCategoryNames
	"make category names suitable for conversion to hierarchical modules
	 remove spaces from specified list, the replace all spaces with dashes '-'"
	
	| pairs |
	pairs _ self properCategoryNames.
	pairs pairsDo: [:oldName :properName |
		SystemOrganization renameCategory: oldName toBe: properName].
	SystemOrganization categories do: [:cat |
		SystemOrganization 
			renameCategory: cat 
			toBe: (cat copyReplaceAll: ' ' with: '-' asTokens: false)].
! !

!Module class methodsFor: 'system conversion' stamp: 'squeak 9/10/2001 17:49'!
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].

		mod localAssocFor: modName ifAbsent: [
			mod addSubmoduleNamed: modName importNames: false].
		submod _ (mod associationFor: modName 
						ifAbsent: [self error: 'module not found']) value.
		self generateSubmodules: submods for: submod].! !

!Module class methodsFor: 'system conversion' stamp: 'squeak 9/10/2001 21:13'!
modulesFromSystemCategories
	"this is run before dropping the old-style SystemOrganization"

	| mod refactorer |
	Module squeak version: 0.0.	"This creates version zero of the class library organization"

	refactorer _ self aRefactorer.
	SystemOrganization categories do:
		[:cat | 
			mod _ Module moduleForCategory: cat forceCreate: true.
			refactorer
				transferBindingsNamedIn: (SystemOrganization listAtCategoryNamed: cat)
				from: Module smalltalk to: mod.
		].! !

!Module class methodsFor: 'system conversion' stamp: 'squeak 9/10/2001 18:05'!
properCategoryNames
	"Consider dashes ('-') and spaces to separate hierarchical levels in category names.
	Thus here remove all spaces from the insides of level names"
	^#(
		'Kernel-ST80 Remnants' 'Kernel-ST80Remnants'
		'Graphics-Display Objects' 'Graphics-DisplayObjects'
		'Speech-Phoneme Recognizer' 'Speech-PhonemeRecognizer'
		'Tools-File Contents Browser' 'Tools-FileContentsBrowser'
		'Tools-Process Browser' 'Tools-ProcessBrowser'
		'System-Digital Signatures' 'System-DigitalSignatures'
		'System-Object Storage' 'System-ObjectStorage'
		'System-Serial Port' 'System-SerialPort'
		'Network-EToy Communications' 'Network-EToyCommunications'
		'Network-TelNet WordNet' 'Network-TelNetWordNet'
		'Network-Web Browser' 'Network-WebBrowser'
		'Network-Mail Reader' 'Network-MailReader'
		'Network-IRC Chat' 'Network-IRCChat'
		'Network-Audio Chat' 'Network-AudioChat'
		'Network-Pluggable Web Server' 'Network-PluggableWebServer'
		'VMConstruction-Translation to C' 'VMConstruction-TranslationToC'
		'ST80-Pluggable Views' 'ST80-PluggableViews'
		'Morphic-Text Support' 'Morphic-TextSupport'
		'Morphic-Tile Scriptors' 'Morphic-TileScriptors'
		'Balloon3D-Demo Morphs' 'Balloon3D-DemoMorphs')! !

!Module class methodsFor: 'system conversion' stamp: 'squeak 9/10/2001 23:59'!
topLevelModuleList
	"return a list of names for the top level modules of the virtual hierarchy.
	 Items are either symbols or pairs of a symbol and a list of subitems.
	 Note that the hierarchy at the same time organizes modules inside the image,
	 organizes the contributions of the Squeak community wrt each other,
	 and provides a structure for repository storage of modules.
	 E.g. providing its path should be enough for downloading and installing any package."

	^#(
		(Squeak			"For official system frameworks. Everything in the old image under here."
			 ("MVC Morphic etc"))
		(Project 		"A place to reserve unique names for various projects."
			("e.g. Whisker"))
		(Org ()) (Com ()) "For organizations to reserve name spaces in"
		(People ())		"Allow for personal prefs & configuration stored on the net.
			 		 use people's method signature initials for names here"
		(Image 			"For holding various images and their configurations"
			(StandardRelease "SWT Headless PDA Squeakland etc"))
		(VM			"Compiled VMs and VM-related (platform-specific) sources"
			("Mac Windows Acorn Unix Cocoa etc"))
		(Temporary	())	"For throwaway modules, sandbox modules, etc., 
						may be held weakly or emptied e.g. on shutdown."
	)! !


!ModuleExplorer methodsFor: 'as yet unclassified' stamp: 'hg 9/7/2001 12:54'!
doItReceiver

	| selectedObject |
	currentSelection ifNil: [^rootObject].
	selectedObject _ currentSelection withoutListWrapper.
	^(selectedObject isKindOf: ModuleReference)
		ifTrue: [selectedObject module]
		ifFalse: [selectedObject]
! !

!ModuleExplorer methodsFor: 'as yet unclassified' stamp: 'hg 9/2/2001 19:57'!
getList

	^Array with: (ModuleExplorerWrapper with: rootObject name: 'top' model: self)
! !

!ModuleExplorer methodsFor: 'as yet unclassified' stamp: 'squeak 9/12/2001 21:36'!
trash
	"some example expressions to try"

	^'	"try these on some modules (cmd-p / cmd-I)"
Module convertSystemOrganizationToModules.
self declareExternalRefs.
self viewDeepUnresolvedRefs. 
self path
self deepIncomingRefsFromOutside: self 
self deepIncomingRefsFromOutside: parentModule
self deepUniqueMessagesToOutside: self
self collectUpstreamMethodsOutside: self'

! !


!ModuleExplorerWrapper methodsFor: 'as yet unclassified' stamp: 'hg 9/2/2001 19:43'!
contents
	
	^(item respondsTo: #moduleExplorerContents)
		ifTrue: [item moduleExplorerContents]
		ifFalse: [super contents]! !


!ModuleRefactorer methodsFor: 'public' stamp: 'squeak 9/10/2001 22:00'!
runRefactorings
	"Trigger the whole set of refactorings in this class."

	Preferences strongModules ifTrue: [
		Module smalltalk newChanges: 
			(ChangeSet basicNewNamed: self class name, ' Reorganization')].

	self moveModules.
	self moveGlobalsToModules.
	self installModuleDeclarations.
	self refactorClasses.
	self removeModules.

	Preferences strongModules 
		ifTrue: [
			Module root rewriteIndirectRefs.
			Module smalltalk newChanges: (ChangeSet basicNewNamed: 'PostReorganization').
			ChangeSorter initialize]

! !

!ModuleRefactorer methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 21:41'!
modulesToRemove
	"return a list of paths to modules to remove"

	^#()! !

!ModuleRefactorer methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 23:09'!
moveModules
	
	| moveList mod ref afterParentPath afterParent |
	moveList _ self newPlacesForModules.
	moveList pairsDo: [:before :after |
		mod _ Module fromPath: before forceCreate: false.
		mod ifNotNil: [
			ref _ mod parentModule removeSubmodule: mod.
			afterParentPath _ after allButLast.
			afterParent _ Module fromPath: afterParentPath forceCreate: true.
			mod name: after last version: mod verbatimVersion parentModule: afterParent.
			afterParent addSubmodule: ref]].
		! !

!ModuleRefactorer methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 21:43'!
removeModules
	"remove a list of modules. Note that this is done silently as it is assumed that you know what you are doing :-)"

	| removeList mod ref |
	removeList _ self modulesToRemove.
	removeList pairsDo: [:path |
		mod _ Module fromPath: path.
		ref _ mod parentModule removeSubmodule: mod].
	! !

!ModuleRefactorer methodsFor: 'moving definitions' stamp: 'squeak 9/10/2001 21:44'!
modulesForGlobals
	"system categories to associate Smalltalk globals with.
	Provided here as pairs of GlobalName ModulePath, e.g.
		Display 		#(Graphics DisplayObjects)				"
	
	^#()	"default: nothing to move"! !

!ModuleRefactorer methodsFor: 'moving definitions' stamp: 'squeak 9/10/2001 21:56'!
refactorClasses
	"refactor classes by running all my methods with selector 'refactor*Classes'"

	| reorgSelectors |
	reorgSelectors _ self class selectors select: [:selector | 
		(selector beginsWith: 'refactor') and: [selector endsWith: 'Classes']].
	reorgSelectors do: [:selector |
		self perform: selector]
! !

!ModuleRefactorer methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 23:19'!
clearDeclaredModules
	"remove all module declarations everywhere"
	"Module clearDeclaredModules"

	Module root deepSubmodulesDo: [:mod | mod clearExternalModuleRefs]! !

!ModuleRefactorer methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 22:03'!
declarationsByDefault: mod

	self copyDeclarationsFromParent: mod.
	mod path size > 2 ifTrue: [mod importIntoParent].
! !

!ModuleRefactorer methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 23:34'!
installModuleDeclarations

	| installSelector name |

	self clearDeclaredModules.

	Module squeak deepSubmodulesDo: [:mod |
		name _ mod longName.
		name _ name copyFrom: 7 to: name size.
		installSelector _ ('declarationsFor', name, ':') asSymbol.
		(self respondsTo: installSelector) 
			ifFalse: [installSelector _ #declarationsByDefault:].
		self perform: installSelector with: mod]
! !

!ModuleRefactorer methodsFor: 'utilities' stamp: 'squeak 9/10/2001 18:52'!
transferBindingsNamedIn: nameList from: oldModule to: newModule

	| assoc |
	nameList do: [:aName |
		assoc _ oldModule localAssocFor: aName ifAbsent: [self error: 'name not found'].
		newModule addAssoc: assoc export: true.
		(assoc value isKindOf: Class) ifTrue: [assoc value module: newModule].
		oldModule removeName: aName]! !


!FromVersion0p0000to0001 methodsFor: 'external module declarations' stamp: 'hg 9/10/2001 16:10'!
declarationsByDefault: mod

	self copyDeclarationsFromParent: mod.
	mod path size > 1 ifTrue: [mod importIntoParent].
! !

!FromVersion0p0000to0001 methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 23:22'!
declarationsForBalloon3D: mod

	self declarationsByDefault: mod.
	mod externalModule: (Module fromPath: #(Squeak Graphics)) alias: nil importNames: true.
! !

!FromVersion0p0000to0001 methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 23:22'!
declarationsForBalloon: mod

	self declarationsByDefault: mod.
	mod externalModule: (Module fromPath: #(Squeak Graphics)) alias: nil importNames: true.
! !

!FromVersion0p0000to0001 methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 23:22'!
declarationsForCollections: mod

	mod externalModule: (Module fromPath: #(Squeak Kernel)) alias: nil importNames: true.
! !

!FromVersion0p0000to0001 methodsFor: 'external module declarations' stamp: 'hg 9/10/2001 16:10'!
declarationsForKernel: module

	^self	"no default declarations"! !

!FromVersion0p0000to0001 methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 23:22'!
declarationsForMorphicEssenceKernel: mod

	self declarationsByDefault: mod.
	mod externalModule: (Module fromPath: #(Squeak Graphics)) alias: nil importNames: true.
	! !

!FromVersion0p0000to0001 methodsFor: 'external module declarations' stamp: 'squeak 9/10/2001 23:21'!
declarationsForRoot: mod
	"these will be copied down to all children who want them"
	
	mod externalModule: (Module fromPath: #(Squeak Kernel)) alias: nil importNames: true.
	mod externalModule: (Module fromPath: #(Squeak Collections)) alias: nil importNames: true.
! !

!FromVersion0p0000to0001 methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 21:41'!
modulesToRemove
	"return a list of paths to modules to remove"

	^#(
		#(Squeak ST80)
	)! !

!FromVersion0p0000to0001 methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 21:24'!
newPlacesForEToyModules
	"For each module, list pairs of its path before and after moving it."
	"The intention is that Morphic eventually should be strippable to a small core.
	 This is a rough first attempt at separating eToy from Morphic,
	 and more thought will need to go into how Morphic should be reorganized. 
	 Ideally eToy should be broken out by the people who developed it 
	 and who therefore understand its structure."
	
	^#(
		(Squeak Morphic Experimental) (Squeak EToy Experimental)
		(Squeak Morphic UserObjects) (Squeak EToy UserObjects)
		(Squeak Morphic GeeMail) (Squeak EToy GeeMail)
		(Squeak Morphic TileScriptors) (Squeak EToy TileScriptors)
		(Squeak Morphic Stacks) (Squeak EToy Stacks)
		(Squeak Morphic Navigators) (Squeak EToy Navigators)
		(Squeak Morphic Outliner) (Squeak EToy Outliner)
		(Squeak Morphic Imported) (Squeak EToy Imported)
		(Squeak Morphic Buttons) (Squeak EToy Buttons)
		(Squeak Morphic PartsBin) (Squeak EToy PartsBin)
		(Squeak Morphic Remote) (Squeak EToy Remote)
		(Squeak Morphic Flaps) (Squeak EToy Flaps)
		(Squeak Morphic Collaborative) (Squeak EToy Collaborative)
		(Squeak Morphic Scripting) (Squeak EToy Scripting)
		"Note that the whole tree is moved at once. These have already been moved:
		  (Squeak Morphic Scripting Support) (Squeak EToy Scripting Support)
		  (Squeak Morphic Scripting Tiles) (Squeak EToy Scripting Tiles)"
	)! !

!FromVersion0p0000to0001 methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 23:11'!
newPlacesForMVC
	"For each module, here are pairs of its path before and after moving it."
	"This is unfinished"

	^#(
		(Squeak ST80) (Squeak MVC)
		(Squeak Kernel ST80Remnants) (Squeak MVC FromKernel)
		(Squeak Tools Menus) (Squeak MVC Menus)
	)! !

!FromVersion0p0000to0001 methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 21:31'!
newPlacesForModules
	"For each module, list pairs of its path before and after moving it."
	
	^#(	"This is just a very sketchy beginning, much more needs to be done."
	) ,
	self newPlacesForMVC,
	self newPlacesForMorphicKernel,
	self newPlacesForMorphicLibrary,
	self newPlacesForMorphicApplications,
	self newPlacesForMorphicDemo,
	self newPlacesForEToyModules.
! !

!FromVersion0p0000to0001 methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 21:25'!
newPlacesForMorphicApplications
	"For each module, here are pairs of its path before and after moving it."
	"The intention is that Morphic eventually should be strippable to a small core.
	 More thought will need to go into how Morphic should be reorganized. 
	 "
	
	^#(
		(Squeak Morphic Books) (Squeak Morphic Applications Books)
		(Squeak Morphic PDA) (Squeak Morphic Applications PDA)
		(Squeak Morphic Media) (Squeak Morphic Applications Media)
	)! !

!FromVersion0p0000to0001 methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 21:26'!
newPlacesForMorphicDemo
	"For each module, here are pairs of its path before and after moving it."
	"The intention is that Morphic eventually should be strippable to a small core.
	 More thought will need to go into how Morphic should be reorganized. 
	 "
	
	^#(
		(Squeak Morphic Components) (Squeak Morphic Demo Components)
		(Squeak Morphic Games) (Squeak Morphic Demo Games)
	)! !

!FromVersion0p0000to0001 methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 21:28'!
newPlacesForMorphicKernel
	"For each such module, here are pairs of its path before and after moving it."
	"The intention is that Morphic eventually should be strippable to a small core.
	 More thought will need to go into how Morphic should be reorganized. 
	 "
	
	^#(
		(Squeak Morphic Kernel) (Squeak Morphic Core Foundation)
		(Squeak Morphic Basic) (Squeak Morphic Core Basic)
		(Squeak Morphic Worlds) (Squeak Morphic Core Worlds)
		(Squeak Morphic Support) (Squeak Morphic Core Support)
		(Squeak Morphic TextSupport) (Squeak Morphic Core TextSupport)
		(Squeak Morphic Events) (Squeak Morphic Core Events)
		(Squeak Morphic Layouts) (Squeak Morphic Core Layouts)
		(Squeak Morphic Undo) (Squeak Morphic Core Undo)
	)! !

!FromVersion0p0000to0001 methodsFor: 'moving modules' stamp: 'squeak 9/10/2001 21:30'!
newPlacesForMorphicLibrary
	"For each module, here are pairs of its path before and after moving it."
	"The intention is that Morphic eventually should be strippable to a small core.
	 More thought will need to go into how Morphic should be reorganized. 
	 "
	
	^#(
		(Squeak Morphic Widgets) (Squeak Morphic Library Widgets)
		(Squeak Morphic Models) (Squeak Morphic Library Models)
		(Squeak Morphic Windows) (Squeak Morphic Library Windows)
		(Squeak Morphic Menus) (Squeak Morphic Library Menus)
		(Squeak Morphic Palettes) (Squeak Morphic Library Palettes)
		(Squeak Morphic Postscript) (Squeak Morphic Library PostScript)
		(Squeak Genie) (Squeak Morphic Library Genie)
	)! !

!FromVersion0p0000to0001 methodsFor: 'moving definitions' stamp: 'squeak 9/10/2001 23:18'!
modulesForGlobals
	"modules to move Smalltalk globals to"
	
	^#(
		ActiveEvent	#(Squeak Morphic Core Events)
		ActiveHand	#(Squeak Morphic Core Foundation)
		ActiveWorld	#(Squeak Morphic Core Foundation)
		AliceConstants	#(Squeak Balloon3D Alice Cast)
		B3DEngineConstants	#(Squeak Balloon3D Engine)
		BalloonEngineConstants	#(Squeak Balloon Engine)
		Display	#(Squeak Graphics DisplayObjects)
		EventSensorConstants	#(Squeak Kernel Processes)
		FFIConstants	#(Squeak FFI Kernel)
		GZipConstants	#(Squeak System Compression)
		ImageImports	#(Squeak EToy Scripting)
		KlattResonatorIndices	#(Squeak Speech Klatt)
		Processor	#(Squeak Kernel Processes)
		References	#(Squeak EToy Scripting)
		ScheduledControllers	#(Squeak MVC FromKernel)
		ScriptingSystem	#(Squeak EToy Scripting)
		Sensor	#(Squeak Kernel Processes)
		SourceFiles	#(Squeak System Files)
		SystemOrganization	#(Squeak Kernel Classes)
		TextConstants	#(Squeak Collections Text)
		Transcript	#(Squeak Collections Streams)
		Undeclared	#(Squeak System Modules)
		WonderlandConstants	#(Squeak Balloon3D Wonderland Core)
		World	#(Squeak Morphic Core Foundation)
		ZipFileConstants	#(Squeak System Compression)
		ZipConstants	#(Squeak System Compression)
	)! !

!FromVersion0p0000to0001 methodsFor: 'moving definitions' stamp: 'squeak 9/10/2001 21:57'!
refactorGraphicsClasses
	"this one is merely just started"

	self transferBindingsNamedIn: #(TextPrinter TextLineInterval ) 
		from: Module @ #(Squeak Graphics Text) to: Module @ #(Squeak MVC Support)! !

!FromVersion0p0000to0001 methodsFor: 'moving definitions' stamp: 'squeak 9/10/2001 21:58'!
refactorMVCClasses

	self transferBindingsNamedIn: #(OneOnSwitch Button Switch) 
		from: Module @ #(Squeak MVC Menus) to: Module @ #(Squeak MVC Editors)
		! !

!FromVersion0p0000to0001 methodsFor: 'moving definitions' stamp: 'squeak 9/10/2001 21:59'!
refactorMorphicClasses

	"self transferBindingsNamedIn: #(NewParagraph TextLine) 
		from: Module @ #(Squeak Morphic Core TextSupport) to: Module @ #(Squeak Graphics Text)"! !


!ModuleRefactorer class methodsFor: 'public' stamp: 'squeak 9/10/2001 23:17'!
run
	"Trigger the whole set of refactorings in this class."

	self new runRefactorings! !


!ModuleReference methodsFor: 'printing' stamp: 'hg 9/7/2001 20:15'!
explorerContents

	^self module moduleExplorerContents 
! !


!FromVersion0p0000to0001 reorganize!
('public')
('external module declarations' declarationsByDefault: declarationsForBalloon3D: declarationsForBalloon: declarationsForCollections: declarationsForKernel: declarationsForMorphicEssenceKernel: declarationsForRoot:)
('moving modules' modulesToRemove newPlacesForEToyModules newPlacesForMVC newPlacesForModules newPlacesForMorphicApplications newPlacesForMorphicDemo newPlacesForMorphicKernel newPlacesForMorphicLibrary)
('moving definitions' modulesForGlobals refactorGraphicsClasses refactorMVCClasses refactorMorphicClasses)
!


!Module class reorganize!
('instance creation' name:version:parentModule:)
('class initialization' createModularClassDefinitionsPreference createStrongModulesPreference initialize resetWeakModules)
('virtual hierarchy' @ fromPath: fromPath:forceCreate: listForPackageBrowser moduleForCategory:forceCreate: pathFromCategory: root smalltalk squeak)
('fileIn/Out' metaPrerequisites)
('system conversion' aRefactorer convertSystemOrganizationToModules createTopLevels fixProperCategoryNames generateSubmodules:for: modulesFromSystemCategories properCategoryNames topLevelModuleList)
!

"Postscript:
Open a ModuleExplorer."

Module root explore!

-------------- next part --------------
'From Squeak3.1alpha of 7 March 2001 [latest update: #4332] on 12 September 2001 at 10:11:03 pm'!
Object subclass: #Repository
	instanceVariableNames: 'module localPath '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!
Repository subclass: #RemoteRepository
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!
RemoteRepository subclass: #HTTPRepository
	instanceVariableNames: 'url '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!
HTTPRepository subclass: #VirtualRootRepository
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!

!Repository methodsFor: 'accessing' stamp: 'squeak 8/20/2001 19:05'!
module

	^module! !

!Repository methodsFor: 'initializing' stamp: 'squeak 8/20/2001 16:40'!
initialize

	^self! !

!Repository methodsFor: 'initializing' stamp: 'squeak 8/20/2001 18:55'!
module: aModule

	module _ aModule! !

!Repository methodsFor: 'initializing' stamp: 'squeak 8/20/2001 18:52'!
subrepositorySpecies
	"return the default class to use as the repository for a submodule to my module."

	^self class! !

!Repository methodsFor: 'URLs' stamp: 'squeak 9/8/2001 22:10'!
localPath
	"return the path to the local cache for this repository"

	^localPath! !

!Repository methodsFor: 'URLs' stamp: 'squeak 9/8/2001 22:01'!
localUrl
	"return the url for the local cache for this repository"

	^self subclassResponsibility ! !

!Repository methodsFor: 'URLs' stamp: 'squeak 8/20/2001 19:09'!
parentRepository

	^self module parentModule 
		ifNotNil: [self module parentModule repository]! !

!Repository methodsFor: 'URLs' stamp: 'squeak 8/20/2001 19:04'!
relativeUrl
	"return the url of this repository relative to its parent"

	^self module name! !

!Repository methodsFor: 'URLs' stamp: 'squeak 8/20/2001 19:08'!
url
	"return the url of the location for this repository"

	| parentUrl myUrl |
	parentUrl _ self parentRepository urlObject.
	myUrl _ parentUrl path: (parentUrl path copyWith: self relativeUrl).
	^myUrl toText! !

!Repository methodsFor: 'URLs' stamp: 'squeak 8/20/2001 18:46'!
urlObject
	"return an URL object for the url of the location for this repository"

	^Url absoluteFromText: self url! !

!Repository methodsFor: 'file names' stamp: 'squeak 9/8/2001 22:47'!
moduleDefinitionName

	^'moduleDefinition.def'! !

!Repository methodsFor: 'user interface' stamp: 'squeak 9/8/2001 22:08'!
moduleExplorerContents

	| list |
	list _ OrderedCollection new.
	list add: 
			(ModuleExplorerWrapper 
				with: self localPath
				name: 'local'
				model: self);
		add: 
			(ModuleExplorerWrapper 
				with: self url
				name: 'URL'
				model: self).
	^list
			! !


!HTTPRepository methodsFor: 'URLs' stamp: 'hg 8/22/2001 21:54'!
isRelative
	"hack: relative if nil, otherwise url hold string"

	^url isNil! !

!HTTPRepository methodsFor: 'URLs' stamp: 'hg 8/22/2001 21:53'!
url
	"return the url of the location for this repository"

	| parentUrl myUrl |
	^self isRelative 
		ifTrue: [
			parentUrl _ self parentRepository urlObject.
			myUrl _ parentUrl path: (parentUrl path copyWith: self relativeUrl).
			myUrl toText]
		ifFalse: [
			url]! !

!HTTPRepository methodsFor: 'URLs' stamp: 'hg 8/22/2001 21:57'!
url: fullURLstring
	"set url to make this the root of an actual repository at this URL"

	url _ fullURLstring! !

!HTTPRepository methodsFor: 'fileIn/Out' stamp: 'squeak 9/8/2001 23:09'!
readModuleDefinition

	^HTTPLoader default retrieveContentsFor: self url, '/', self moduleDefinitionName! !


!Repository class methodsFor: 'instance creation' stamp: 'squeak 8/20/2001 16:38'!
new

	^super new initialize! !

!Repository class methodsFor: 'instance creation' stamp: 'squeak 8/20/2001 18:55'!
on: aModule
	"return an instance of me for the given module"

	^self new module: aModule! !

!Repository class methodsFor: 'repository hierarchy' stamp: 'hg 9/10/2001 15:12'!
root

	^Module root repository! !

!Repository class methodsFor: 'fileIn/Out' stamp: 'squeak 9/10/2001 12:12'!
metaPrerequisites
	"Answer the prerequisites for being able to load modules from this kind of repository. A prerequisite is simply given as a specific module and version."

	^Array with: self module! !


!VirtualRootRepository methodsFor: 'initializing' stamp: 'squeak 8/20/2001 18:57'!
subrepositorySpecies
	"return the default class to use as the repository for a submodule to my module."

	^self class superclass! !

!VirtualRootRepository methodsFor: 'URLs' stamp: 'squeak 9/8/2001 22:12'!
defaultLocalPath

	^'/repository'! !

!VirtualRootRepository methodsFor: 'URLs' stamp: 'squeak 9/8/2001 22:11'!
localPath

	^localPath ifNil: [self defaultLocalPath]! !

!VirtualRootRepository methodsFor: 'URLs' stamp: 'squeak 8/20/2001 18:37'!
url

	^'http://', self server, self path! !

!VirtualRootRepository methodsFor: 'SqueakFoundation registry server' stamp: 'squeak 9/8/2001 22:58'!
path

	^'/people/Henrik.Gedenryd/squeak/VirtualRoot'! !

!VirtualRootRepository methodsFor: 'SqueakFoundation registry server' stamp: 'squeak 9/8/2001 22:05'!
server

	^'lucs.lu.se'! !


!VirtualRootRepository class methodsFor: 'class initialization' stamp: 'squeak 9/8/2001 21:59'!
initialize

	Module root repository: self new! !

VirtualRootRepository initialize!
-------------- next part --------------
'From Squeak3.1alpha of 7 March 2001 [latest update: #4332] on 12 September 2001 at 10:11:29 pm'!
Module subclass: #DeltaModule
	instanceVariableNames: 'baseModule '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!

!DeltaModule commentStamp: 'squeak 9/12/2001 20:34' prior: 0!
The mojo of this class is that it unifies a number of different functionalities (once complete):

- It is relative to another module (a specific version of it), and only stores the differences wrt the original (hence Delta).
	It should not record the changes, but the final state, it just does it in a delta-format for efficiency.
	Hence, it still provides an exact definition of a module but in relative format.
	It is meant to subsume change sets.
- When loaded into the image, it can still be installed/active or not.
	Ie. its differences wrt the base may be installed into the base module or not. 
- (Un)Installation can be done atomically (like isolatedProjects), and separate from code loading.
- Upstream modifications
	Deltas are meant to be used for holding modifications to upstream classes (things like String>>asUrl or Object>>isDraggableMorph).
	Notice the lame unintentional joke in upstream/ÒdeltaÓ.
- Un/install yields a form of ÒlayersÓ for handling package conflicts.
- DeltaModules 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.!


!Module methodsFor: 'accessing' stamp: 'squeak 9/12/2001 21:41'!
deltasPath

	^self path copyWith: #Deltas! !

!Module methodsFor: 'changing module composition' stamp: 'squeak 9/12/2001 21:41'!
deltaModuleForBase: baseModule forceCreate: create
	"return the DeltaModule associated with this module that has the given base module. If not found, create one if asked to, otherwise return nil."

	| delta deltas |
	deltas _ Module fromPath: self deltasPath forceCreate: true.
	deltas submodulesDo: [:mod |
		(mod isDeltaModule and: [mod baseModule = baseModule])
			ifTrue: [^mod]].
	^create ifTrue: [
		delta _ DeltaModule baseModule: baseModule parentModule: deltas.
		deltas submodule: delta alias: nil importNames: false.
		delta]! !

!Module methodsFor: 'system conversion' stamp: 'squeak 9/12/2001 21:58'!
collectUpstreamMethodsOutside: homeModule
	"find all methods in all systemwide classes outside homeModule that contain references to names defined by this module, 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 upstream definitions ...'
		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.
				deltaClass _ deltaModule deltaClassFor: mref actualClass forceCreate: true.
				method _ mref actualClass compiledMethodAt: mref methodSymbol.
				deltaClass addSelector: mref methodSymbol withMethod: method]]].	
	^incoming! !

!Module methodsFor: 'testing' stamp: 'squeak 9/12/2001 20:11'!
isDeltaModule

	^false! !


!DeltaModule methodsFor: 'testing' stamp: 'squeak 9/12/2001 20:11'!
isDeltaModule

	^true! !

!DeltaModule methodsFor: 'accessing' stamp: 'squeak 9/12/2001 20:12'!
baseModule

	^baseModule! !

!DeltaModule methodsFor: 'accessing' stamp: 'squeak 9/12/2001 21:34'!
name

	^(self baseModule longName, 'Delta') asSymbol ! !

!DeltaModule methodsFor: 'initializing' stamp: 'squeak 9/12/2001 20:16'!
baseModule: base parentModule: parent

	baseModule _ base.
	parentModule _ parent! !

!DeltaModule methodsFor: 'changing defined names' stamp: 'squeak 9/12/2001 21:23'!
deltaClassFor: baseClassOrMeta forceCreate: create

	| baseClass deltaClass |
	baseClass _ baseClassOrMeta theNonMetaClass.
	baseClass module == self baseModule ifFalse: [
		self error: baseClass name, ' is not defined in my base module'].
	deltaClass _ (self localAssocFor: baseClass name ifAbsent: [
		^create ifTrue: [
			deltaClass _ baseClass newSubclass.
			self addAssoc: (baseClass name)->deltaClass export: true.
			deltaClass]]) value.
	(deltaClass isKindOf: Class) ifFalse: [
		self error: deltaClass name, ' is not a class'].
	^deltaClass.	! !

!DeltaModule methodsFor: 'user interface' stamp: 'squeak 9/12/2001 21:29'!
moduleExplorerContents

	^(Array with: 
			(ModuleExplorerWrapper 
				with: self baseModule
				name: 'base module'
				model: self))
		, super moduleExplorerContents ! !


!DeltaModule class methodsFor: 'instance creation' stamp: 'squeak 9/12/2001 20:16'!
baseModule: base parentModule: parent

	^self new baseModule: base parentModule: parent! !

-------------- next part --------------
'From Squeak3.1alpha of 7 March 2001 [latest update: #4332] on 12 September 2001 at 10:11:09 pm'!
"Change Set:		Modules-Compatibility
Date:			6 September 2001
Author:			Henrik Gedenryd

Make system compatible with modules, including weak/strong modules.

Preamble has a dirty hack to change instvar name without recompiling 1000+ classes"

Class setInstVarNames: (Class instVarNames copyReplaceAll: #('environment') with: #('module')).!

SystemOrganizer subclass: #ModularSystemOrganizer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Modules'!

!ModularSystemOrganizer commentStamp: '<historical>' prior: 0!
In a modular system, the entire system categories mechanism is subsumed by module paths. This class is a substitute for SystemOrganization that simulates system categories by computing them from module paths. 

Inquiring messages to this class are answered, but exceptions are raised for all messages that are sent to manipulate the system categories. 

The class SystemOrganization, the SystemOrganizer global and this class should eventually be removed, when the remaining code that uses them has been converted.!


!Array methodsFor: 'file in/out' stamp: 'squeak 9/10/2001 11:58'!
literalPrintOn: aStream
	"print array without #'s before symbols"

	aStream nextPutAll: '#('.
	self do: [:element | 
		(element respondsTo: #basicPrintOn:) 
			ifTrue: [element basicPrintOn: aStream]
			ifFalse: [aStream print: element].
		aStream space].
	self isEmpty ifFalse: [aStream skip: -1].
	aStream nextPut: $)! !

!Array methodsFor: 'file in/out' stamp: 'squeak 9/10/2001 12:00'!
literalPrintString

	| s |
	s _ WriteStream on: ''.
	self literalPrintOn: s.
	^s contents! !


!ClassBuilder methodsFor: 'class definition' stamp: 'hg 8/21/2001 13:57'!
class: oldClass instanceVariableNames: instVarString unsafe: unsafe
	"This is the basic initialization message to change the definition of
	an existing Metaclass"
	| instVars newClass |
	environ _ oldClass module.
	instVars _ Scanner new scanFieldNames: instVarString.
	unsafe ifFalse:[
		"Run validation checks so we know that we have a good chance for recompilation"
		(self validateInstvars: instVars from: oldClass forSuper: oldClass superclass) ifFalse:[^nil].
		(self validateSubclassFormat: oldClass typeOfClass from: oldClass forSuper: oldClass superclass extra: instVars size) ifFalse:[^nil]].
	"Create a template for the new class (will return oldClass when there is no change)"
	newClass _ self 
		newSubclassOf: oldClass superclass 
		type: oldClass typeOfClass
		instanceVariables: instVars
		from: oldClass
		unsafe: unsafe.

	newClass == nil ifTrue:[^nil]. "Some error"
	newClass _ self recompile: false from: oldClass to: newClass mutate: false.
	self doneCompiling: newClass.
	^newClass! !

!ClassBuilder methodsFor: 'class definition' stamp: 'hg 9/7/2001 15:36'!
name: className inModule: mod subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category
	"Define a new class in the given module"
	^self 
		name: className 
		inModule: mod 
		subclassOf: newSuper 
		type: type 
		instanceVariableNames: instVarString 
		classVariableNames: classVarString 
		poolDictionaries: poolString 
		category: category
		unsafe: false! !

!ClassBuilder methodsFor: 'class definition' stamp: 'squeak 9/12/2001 21:05'!
name: className inModule: moduleOrPath subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe
	"Define a new class in the given module. 
	If module is nil then this is an old-style creation message with no module supplied,
	and if category is nil then it is a new-style message.
	If unsafe is true do not run any validation checks.
	This facility is provided to implement important system changes."
	| oldClass newClass instVars classVars force assoc |
	environ _ moduleOrPath 
		ifNil: [self aReasonableModuleForCategory: category]
		ifNotNil:[
			(moduleOrPath isKindOf: Module)
				ifTrue: [moduleOrPath]
				ifFalse: [Module fromPath: moduleOrPath forceCreate: true]].
	instVars _ Scanner new scanFieldNames: instVarString.
	classVars _ (Scanner new scanFieldNames: classVarString) collect: [:x | x asSymbol].

	"Validate the proposed name"
	(unsafe or: [self validateClassName: className]) ifFalse:[^nil].

	assoc _ environ localAssocFor: className ifAbsent:[nil].
	oldClass _ assoc ifNotNil: [assoc value].
	oldClass isBehavior 
		ifFalse:[oldClass _ nil]. "Already checked in #validateClassName:"

	unsafe ifFalse:[
		"Run validation checks so we know that we have a good chance for recompilation"
		(self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil].
		(self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
		(self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
		(self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]].

	"Create a template for the new class (will return oldClass when there is no change)"
	newClass _ self 
		newSubclassOf: newSuper 
		type: type 
		instanceVariables: instVars
		from: oldClass
		unsafe: unsafe.

	newClass == nil ifTrue:[^nil]. "Some error"

	newClass == oldClass ifFalse:[newClass setName: className].

	"Install the class variables and pool dictionaries... "
	force _ (newClass declare: classVarString) | (newClass sharing: poolString).

	"support old-style classification somewhat ..."
	environ organization 
		classify: newClass name under: (category ifNil: [environ simulatedCategory]) asSymbol.
	newClass module: environ.

	"... recompile ..."
	newClass _ self recompile: force from: oldClass to: newClass mutate: false.

	[environ redefineName: newClass name as: newClass export: true]
			on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true].
	Smalltalk flushClassNameCache.

	self doneCompiling: newClass.
	^newClass
! !

!ClassBuilder methodsFor: 'class definition' stamp: 'hg 8/22/2001 18:57'!
recompile: force from: oldClass to: aClass mutate: forceMutation
	"Do the necessary recompilation after changine oldClass to newClass.
	If required (e.g., when oldClass ~~ newClass) mutate oldClass to newClass
	and all its subclasses. If forceMutation is true force a mutation even
	if oldClass and newClass are the same."
	| newClass |
	newClass _ aClass.

	oldClass == nil ifTrue:[
		"newClass has an empty method dictionary
		so we don't need to recompile"
		newClass module changes addClass: newClass.
		newClass superclass addSubclass: newClass.
		^newClass].

	(newClass == oldClass and:[force not and:[forceMutation not]]) ifTrue:[
		"No recompilation necessary but we might have added
		class vars or class pools so record the change"
		oldClass module changes changeClass: newClass from: oldClass.
		^newClass].

	currentClassIndex _ 0.
	maxClassIndex _ oldClass withAllSubclasses size.

	(oldClass == newClass and:[forceMutation not]) ifTrue:[
		oldClass module changes changeClass: newClass from: oldClass.
		"Recompile from newClass without mutating"
		self informUserDuring:[
			newClass isSystemDefined ifFalse:[progress _ nil].
			newClass withAllSubclassesDo:[:cl|
				self showProgressFor: cl.
				cl compileAll]].
		^newClass].
	"Recompile and mutate oldClass to newClass"
	self informUserDuring:[
		newClass isSystemDefined ifFalse:[progress _ nil].
		self showProgressFor: oldClass.
		newClass _ self reshapeClass: oldClass to: newClass super: newClass superclass.
		oldClass module changes changeClass: newClass from: oldClass.
		self mutate: oldClass to: newClass.
		"And do the magic become"
		self update: oldClass to: newClass.
	].
	^newClass! !

!ClassBuilder methodsFor: 'class definition' stamp: 'hg 9/7/2001 15:45'!
reshapeClass: aClass to: templateClass super: newSuper
	"Reshape the given class to the new super class.
	If templateClass is not nil then it defines the shape of the new class"
	| fmt newClass newMeta newSuperMeta oldMeta instVars oldClass |
	templateClass == nil
		ifTrue:[oldClass _ aClass]
		ifFalse:[oldClass _ templateClass].
	aClass becomeUncompact.
	"Compute the new format of the class"
	instVars _ instVarMap at: aClass name ifAbsent:[oldClass instVarNames].
	fmt _ self computeFormat: oldClass typeOfClass
				instSize: instVars size
				forSuper: newSuper
				ccIndex: 0."Known to be 0 since we uncompacted aClass first"
	fmt == nil ifTrue:[^nil].
	aClass isMeta ifFalse:["Create a new meta class"
		oldMeta _ aClass class.
		newMeta _ oldMeta clone.
		newSuperMeta _ newSuper ifNil:[Class] ifNotNil:[newSuper class].
		newMeta 
			superclass: newSuperMeta
			methodDictionary: MethodDictionary new
			format: (self computeFormat: oldMeta typeOfClass 
							instSize: oldMeta instVarNames size 
							forSuper: newSuperMeta
							ccIndex: 0);
			setInstVarNames: oldMeta instVarNames;
			organization: oldMeta organization.
		"Recompile the meta class"
		oldMeta hasMethods 
			ifTrue:[newMeta compileAllFrom: oldMeta].
		"Fix up meta class structure"
		oldMeta superclass addObsoleteSubclass: oldMeta.
		(oldMeta superclass subclasses includes: oldMeta) ifTrue:[
			oldMeta superclass removeSubclass: oldMeta.
			newMeta superclass addSubclass: newMeta].
		"And record the change so we can fix global refs later"
		self recordClass: oldMeta replacedBy: newMeta.
	].
	newClass _ newMeta == nil
		ifTrue:[oldClass clone]
		ifFalse:[newMeta adoptInstance: oldClass from: oldMeta].
	newClass
		superclass: newSuper
		methodDictionary: MethodDictionary new
		format: fmt;
		setInstVarNames: instVars;
		organization: aClass organization.

	"Recompile the new class"
	aClass hasMethods 
		ifTrue:[newClass compileAllFrom: aClass].

	"Export the new class into the environment"
	aClass isMeta ifFalse:[
		"Derefence super sends in the old class"
		self fixSuperSendsFrom: aClass.
		"Export the class"
		[environ redefineName: newClass name as: newClass export: true ]
			on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true].
		"And use the ST association in the new class"
		self fixSuperSendsTo: newClass].

	"Fix up the class hierarchy"
	(aClass superclass subclasses includes: aClass) ifTrue:[
		aClass superclass removeSubclass: aClass.
		newClass superclass addSubclass: newClass.
	].
	"And record the change"
	self recordClass: aClass replacedBy: newClass.

	^newClass
! !

!ClassBuilder methodsFor: 'validation' stamp: 'squeak 9/10/2001 12:23'!
validateClassName: aString
	"Validate the new class name"
	| oldAssoc defModule |
	aString first isUppercase ifFalse:[
		self error: 'Class names must be capitalized'.
		^false].
	oldAssoc _ environ localAssocFor: aString ifAbsent:[nil].
	oldAssoc 
		ifNil: [	
				"check if name already used in a different module"
			(defModule _ Module root moduleDefining: aString) 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: [
			(oldAssoc value isKindOf: Behavior) ifFalse:[
				self notify: 'The name ', aString asText allBold, 
							' is already used in module ', environ pathAsMessages,
							'!!\Proceed will store over it.' withCRs]].
	^true! !

!ClassBuilder methodsFor: 'private' stamp: 'hg 9/10/2001 16:57'!
aReasonableModuleForCategory: cat
	"Compatibility method for finding a reasonable home module for classes 
	defined in the old style, that is without specifying a module.
	Make a module from category name."

	^Module moduleForCategory: cat forceCreate: true! !

!ClassBuilder methodsFor: 'private' stamp: 'hg 8/22/2001 18:58'!
recordClass: oldClass replacedBy: newClass
	"Keep the changes up to date when we're moving instVars around"
	(instVarMap includesKey: oldClass name) ifTrue:[
		newClass module changes changeClass: newClass from: oldClass.
	].! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:32'!
superclass: newSuper
	subclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat 
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class."
	^self 
		name: t
		inModule: nil
		subclassOf: newSuper
		type: newSuper typeOfClass
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:52'!
superclass: newSuper
	subclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s module: mod
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class."
	^self 
		name: t
		inModule: mod
		subclassOf: newSuper
		type: newSuper typeOfClass
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: nil! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:51'!
superclass: aClass
	variableByteSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable byte-sized nonpointer variables."
	(aClass instSize > 0)
		ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
	(aClass isVariable and: [aClass isWords])
		ifTrue: [^self error: 'cannot make a byte subclass of a class with word fields'].
	(aClass isVariable and: [aClass isPointers])
		ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].

	^self 
		name: t
		inModule: nil
		subclassOf: aClass
		type: #bytes
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:53'!
superclass: aClass
	variableByteSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s module: mod
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable byte-sized nonpointer variables."
	(aClass instSize > 0)
		ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
	(aClass isVariable and: [aClass isWords])
		ifTrue: [^self error: 'cannot make a byte subclass of a class with word fields'].
	(aClass isVariable and: [aClass isPointers])
		ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].

	^self 
		name: t
		inModule: mod
		subclassOf: aClass
		type: #bytes
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: nil! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:51'!
superclass: aClass
	variableSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable pointer variables."
	aClass isBits 
		ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
	^self 
		name: t
		inModule: nil
		subclassOf: aClass
		type: #variable
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:53'!
superclass: aClass
	variableSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s module: mod
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable pointer variables."
	aClass isBits 
		ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
	^self 
		name: t
		inModule: mod
		subclassOf: aClass
		type: #variable
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: nil! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:51'!
superclass: aClass
	variableWordSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable word-sized nonpointer variables."
	(aClass instSize > 0)
		ifTrue: [^self error: 'cannot make a word subclass of a class with named fields'].
	(aClass isVariable and: [aClass isBytes])
		ifTrue: [^self error: 'cannot make a word subclass of a class with byte fields'].
	(aClass isVariable and: [aClass isPointers])
		ifTrue: [^self error: 'cannot make a word subclass of a class with pointer fields'].

	^self 
		name: t
		inModule: nil
		subclassOf: aClass
		type: #words
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:54'!
superclass: aClass
	variableWordSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s module: mod
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable word-sized nonpointer variables."
	(aClass instSize > 0)
		ifTrue: [^self error: 'cannot make a word subclass of a class with named fields'].
	(aClass isVariable and: [aClass isBytes])
		ifTrue: [^self error: 'cannot make a word subclass of a class with byte fields'].
	(aClass isVariable and: [aClass isPointers])
		ifTrue: [^self error: 'cannot make a word subclass of a class with pointer fields'].

	^self 
		name: t
		inModule: mod
		subclassOf: aClass
		type: #words
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: nil! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:51'!
superclass: aClass
	weakSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have weak indexable pointer variables."
	aClass isBits 
		ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
	^self 
		name: t
		inModule: nil
		subclassOf: aClass
		type: #weak
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !

!ClassBuilder methodsFor: 'public' stamp: 'hg 9/7/2001 15:54'!
superclass: aClass
	weakSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s module: mod
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver) in which the subclass is to 
	have weak indexable pointer variables."
	aClass isBits 
		ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
	^self 
		name: t
		inModule: mod
		subclassOf: aClass
		type: #weak
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: nil! !


!ClassDescription methodsFor: 'accessing' stamp: 'hg 8/21/2001 21:31'!
comment: aStringOrText
	"Set the receiver's comment to be the argument, aStringOrText."

	self theNonMetaClass classComment: aStringOrText.
	self module changes commentClass: self! !

!ClassDescription methodsFor: 'accessing' stamp: 'hg 8/21/2001 21:31'!
comment: aStringOrText stamp: aStamp
	"Set the receiver's comment to be the argument, aStringOrText."

	self theNonMetaClass classComment: aStringOrText stamp: aStamp.
	self module changes commentClass: self theNonMetaClass! !

!ClassDescription methodsFor: 'printing' stamp: 'hg 8/21/2001 14:14'!
sharedPoolsString
	"Answer a string of my shared pool names separated by spaces."

	| aStream |
	aStream _ WriteStream on: (String new: 100).
	self sharedPools do: [:x | aStream nextPutAll: (self module keyAtIdentityValue: x ifAbsent: ['private']); space].
	^ aStream contents! !

!ClassDescription methodsFor: 'method dictionary' stamp: 'hg 8/21/2001 21:31'!
removeSelector: selector 
	| priorMethod | 
	"Remove the message whose selector is given from the method 
	dictionary of the receiver, if it is there. Answer nil otherwise."

	(self methodDict includesKey: selector) ifFalse: [^ nil].
	priorMethod _ self compiledMethodAt: selector.
	self module changes removeSelector: selector class: self
		priorMethod: priorMethod
		lastMethodInfo: {priorMethod sourcePointer.
						(self whichCategoryIncludesSelector: selector)}.
	super removeSelector: selector.
	self organization removeElement: selector.
	self acceptsLoggingOfCompilation ifTrue:
		[Smalltalk logChange: self name , ' removeSelector: #' , selector]! !

!ClassDescription methodsFor: 'compiling' stamp: 'hg 9/7/2001 21:59'!
changes

	^self module changes! !

!ClassDescription methodsFor: 'compiling' stamp: 'hg 8/21/2001 21:30'!
compile: code notifying: requestor trailer: bytes 
		ifFail: failBlock
		elseSetSelectorAndNode: selAndNodeBlock
	"Intercept this message in order to remember system changes.
	 5/15/96 sw: modified so that if the class does not wish its methods logged in the changes file, then they also won't be accumulated in the current change set.
	7/12/96 sw: use wantsChangeSetLogging to determine whether to put in change set"

	| methodNode selector newMethod priorMethodOrNil |
	methodNode _ self compilerClass new
				compile: code
				in: self
				notifying: requestor
				ifFail: failBlock.
	selector _ methodNode selector.
	selAndNodeBlock value: selector value: methodNode.
	requestor ifNotNil:
		["Note this change for recent submissions list"
		Utilities noteMethodSubmission: selector forClass: self].
	methodNode encoder requestor: requestor.  "Why was this not preserved?"
	newMethod _ methodNode generate: bytes.
	priorMethodOrNil _ (self methodDict includesKey: selector)
		ifTrue: [self compiledMethodAt: selector]
		ifFalse: [nil].
	self module changes noteNewMethod: newMethod forClass: self
		selector: selector priorMethod: priorMethodOrNil.
	self addSelector: selector withMethod: newMethod.
	^ newMethod! !

!ClassDescription methodsFor: 'fileIn/Out' stamp: 'hg 8/21/2001 21:32'!
classComment: aString stamp: aStamp
	"Store the comment, aString or Text or RemoteString, associated with the class we are organizing.  Empty string gets stored only if had a non-empty one before."

	| ptr header file oldCommentRemoteStr |
	(aString isKindOf: RemoteString) ifTrue: [^ self organization classComment: aString].
	oldCommentRemoteStr _ self organization commentRemoteStr.
	(aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ organization classComment: nil].
		"never had a class comment, no need to write empty string out"

	ptr _ oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer].
	SourceFiles ifNotNil: [(file _ SourceFiles at: 2) ifNotNil: [
		file setToEnd; cr; nextPut: $!!.	"directly"
		"Should be saying (file command: 'H3') for HTML, but ignoring it here"
		header _ String streamContents: [:strm | strm nextPutAll: self name;
			nextPutAll: ' commentStamp: '.
			aStamp storeOn: strm.
			strm nextPutAll: ' prior: '; nextPutAll: ptr printString].
		file nextChunkPut: header]].
	self module changes commentClass: self.
	aStamp size > 0 ifTrue: [self commentStamp: aStamp].
	organization classComment: (RemoteString newString: aString onFileNumber: 2).
! !

!ClassDescription methodsFor: 'fileIn/Out' stamp: 'squeak 9/12/2001 15:06'!
definitionST80
	"Answer a String that defines the receiver."

	| aStream path |
	aStream _ WriteStream on: (String new: 300).
	superclass == nil
		ifTrue: [aStream nextPutAll: 'nil']
		ifFalse: [
			path _ 	Preferences modularClassDefinitions 
						ifTrue: [self module qualifiedReferenceAsMessagesFor: superclass name]
						ifFalse: [''].
				aStream nextPutAll: path , superclass name].
	aStream nextPutAll: self kindOfSubclass;
			store: self name.
	aStream cr; tab; nextPutAll: 'instanceVariableNames: ';
			store: self instanceVariablesString.
	aStream cr; tab; nextPutAll: 'classVariableNames: ';
			store: self classVariablesString.
	Preferences modularClassDefinitions 
		ifFalse: [
			aStream cr; tab; nextPutAll: 'poolDictionaries: ';
					store: self sharedPoolsString.
			aStream cr; tab; nextPutAll: 'category: ';
					store: (SystemOrganization categoryOfElement: self name) asString].
	^ aStream contents! !

!ClassDescription methodsFor: 'fileIn/Out' stamp: 'squeak 9/12/2001 15:06'!
definitionST80: isST80
	"Answer a String that defines the receiver."

	| aStream path |
	isST80 ifTrue: [^ self definitionST80].

	aStream _ WriteStream on: (String new: 300).
	superclass == nil
		ifTrue: [aStream nextPutAll: 'nil']
		ifFalse: [
			path _ 	Preferences modularClassDefinitions 
						ifTrue: [self module qualifiedReferenceAsMessagesFor: superclass name]
						ifFalse: [''].
				aStream nextPutAll: path , superclass name].
	aStream nextPutKeyword: self kindOfSubclass
			withArg: self name.
	aStream cr; tab; nextPutKeyword: 'instanceVariableNames: '
			withArg: self instanceVariablesString.
	aStream cr; tab; nextPutKeyword: 'classVariableNames: 'withArg: self classVariablesString.
	Preferences modularClassDefinitions 
		ifFalse: [
			aStream cr; tab; nextPutKeyword: 'poolDictionaries: '
					withArg: self sharedPoolsString.
			aStream cr; tab; nextPutAll: 'category: ';
					store: (SystemOrganization categoryOfElement: self name) asString].
	^ aStream contents! !

!ClassDescription methodsFor: 'fileIn/Out' stamp: 'hg 8/21/2001 21:31'!
reorganize
	"During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"

	self module changes reorganizeClass: self.
	^self organization! !


!Class methodsFor: 'initialize-release' stamp: 'hg 8/21/2001 13:34'!
removeFromSystem: logged
	"Forget the receiver from the Smalltalk global dictionary. Any existing 
	instances will refer to an obsolete version of the receiver."
	self superclass ifNotNil:[
		"If we have no superclass there's nothing to be remembered"
		self superclass addObsoleteSubclass: self].
	self module removeClassFromSystem: self logged: logged.
	self obsolete! !

!Class methodsFor: 'testing' stamp: 'hg 9/7/2001 15:11'!
isObsolete
	"Return true if the receiver is obsolete."
	^(self module localAssocFor: name ifAbsent:[nil]) ~~ self
! !

!Class methodsFor: 'instance variables' stamp: 'hg 9/7/2001 20:54'!
addInstVarName: aString
	"Add the argument, aString, as one of the receiver's instance variables."
	^(ClassBuilder new)
		name: self name
		inModule: self module
		subclassOf: superclass
		type: self typeOfClass
		instanceVariableNames: self instanceVariablesString , aString
		classVariableNames: self classVariablesString
		poolDictionaries: self sharedPoolsString
		category: nil
! !

!Class methodsFor: 'instance variables' stamp: 'hg 9/7/2001 20:54'!
removeInstVarName: aString 
	"Remove the argument, aString, as one of the receiver's instance variables."

	| newInstVarString |
	(self instVarNames includes: aString)
		ifFalse: [self error: aString , ' is not one of my instance variables'].
	newInstVarString _ ''.
	(self instVarNames copyWithout: aString) do: 
		[:varName | newInstVarString _ newInstVarString , ' ' , varName].
	^(ClassBuilder new)
		name: self name
		inModule: self module
		subclassOf: superclass
		type: self typeOfClass
		instanceVariableNames: newInstVarString
		classVariableNames: self classVariablesString
		poolDictionaries: self sharedPoolsString
		category: nil! !

!Class methodsFor: 'class variables' stamp: 'hg 8/21/2001 21:41'!
addClassVarName: aString 
	"Add the argument, aString, as a class variable of the receiver.
	Signal an error if the first character of aString is not capitalized,
	or if it is already a variable named in the class."
	| symbol |
	aString first isLowercase
		ifTrue: [^self error: aString, ' class variable name should be capitalized; proceed to include anyway.'].
	symbol _ aString asSymbol.
	self withAllSubclasses do: 
		[:subclass | 
		subclass scopeHas: symbol
			ifTrue: [:temp | 
					^ self error: aString 
						, ' is already used as a variable name in class ' 
						, subclass name]].
	classPool == nil ifTrue: [classPool _ Dictionary new].
	(classPool includesKey: symbol) ifFalse: 
		["Pick up any refs in Undeclared"
		self module changes changeClass: self from: self.
		classPool declare: symbol from: Undeclared]! !

!Class methodsFor: 'compiling' stamp: 'squeak 9/8/2001 21:38'!
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 module associationFor: varName ifPresent: [:a :mod |
		assocBlock value: a.
		^ true].
	
	^false! !

!Class methodsFor: 'subclass creation' stamp: 'hg 9/7/2001 16:02'!
subclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s module: mod
	"This is the new standard initialization message for creating a new class as a 
	subclass of an existing class (the receiver)."
	^(ClassBuilder new)
		superclass: self
		subclass: t
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		module: mod
! !

!Class methodsFor: 'fileIn/Out' stamp: 'hg 8/21/2001 21:41'!
removeFromChanges
	"References to the receiver, a class, and its metaclass should no longer be included in the system ChangeSet.
	7/18/96 sw: call removeClassAndMetaClassChanges:"

	self module changes removeClassAndMetaClassChanges: self! !

!Class methodsFor: 'organization' stamp: 'hg 9/6/2001 21:06'!
environment

	module isNil | Preferences strongModules not ifTrue: [^ super environment].
	^ module! !

!Class methodsFor: 'organization' stamp: 'hg 9/6/2001 21:07'!
environment: anEnvironment

	module _ anEnvironment! !


!DeepCopier methodsFor: 'like fullCopy' stamp: 'hg 9/8/2001 20:15'!
checkBasicClasses
	"Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it.  
	DeepCopier new checkVariables	"

	| str str2 objCls morphCls modelCls playerCls |
	str _ '|veryDeepCopyWith: or veryDeepInner: is out of date.'.
	(objCls _ self objInMemory: #Object) ifNotNil: [
		objCls instSize = 0 ifFalse: [self error: 
			'Many implementers of veryDeepCopyWith: are out of date']].
	(morphCls _ self objInMemory: #Morph) ifNotNil: [
		morphCls superclass == Object ifFalse: [self error: 'Morph', str].
		(morphCls instVarNames copyFrom: 1 to: 6) = #('bounds' 'owner' 'submorphs' 
				'fullBounds' 'color' 'extension') 
			ifFalse: [self error: 'Morph', str]].	"added ones are OK"

	str2 _ 'Player|copyUniClass and DeepCopier|mapUniClasses are out of date'.
	Behavior instVarNames = #('superclass' 'methodDict' 'format' )
		ifFalse: [self error: str2].
	ClassDescription instVarNames = #('instanceVariables' 'organization' )
		ifFalse: [self error: str2].
	Class instVarNames = #('subclasses' 'name' 'classPool' 'sharedPools' 'module' 'category' )
		ifFalse: [self error: str2].
	(modelCls _ self objInMemory: #Model) ifNotNil: [
		modelCls superclass == Object ifFalse: [self error: str2].
		modelCls class instVarNames = #() ifFalse: [self error: str2]].
	(playerCls _ self objInMemory: #Player) ifNotNil: [
		playerCls superclass == modelCls ifFalse: [self error: str2].
		playerCls class instVarNames = #('scripts' 'slotInfo')
			ifFalse: [self error: str2]].
! !


!Encoder methodsFor: 'private' stamp: 'hg 8/21/2001 15:49'!
lookupInPools: varName ifFound: assocBlock

	Symbol hasInterned: varName ifTrue:
		[:sym | (class scopeHas: sym ifTrue: assocBlock) ifTrue: [^ true].
		(Preferences valueOfFlag: #lenientScopeForGlobals)  "**Temporary**"
			ifTrue: [^ Module root lenientScopeHas: sym ifTrue: assocBlock]
			ifFalse: [^ false]].
	^ class scopeHas: varName ifTrue: assocBlock.  "Maybe a string in a pool  **Eliminate this**"! !


!HierarchicalUrl methodsFor: 'access' stamp: 'squeak 8/20/2001 19:28'!
path: anArray

	path _ (anArray size > 1 and: [anArray first = '']) 
		ifTrue: [anArray allButFirst]
		ifFalse: [anArray]! !


!ImageSegment methodsFor: 'read/write segment' stamp: 'hg 8/21/2001 14:15'!
rootsIncludingPlayers
	"Return a new roots array with more objects.  (Caller should store into rootArray.) Player (non-systemDefined) gets its class and metaclass put into the Roots array.  Then ask for the segment again."

| extras havePresenter players morphs env existing |
userRootCnt ifNil: [userRootCnt _ arrayOfRoots size].
extras _ OrderedCollection new.
arrayOfRoots do: [:root | 
	(root isKindOf: Presenter) ifTrue: [havePresenter _ root].
	(root isKindOf: PasteUpMorph) ifTrue: [
			root isWorldMorph ifTrue: [havePresenter _ root presenter]].
	(root isKindOf: Project) ifTrue: [havePresenter _ root world presenter]].
havePresenter ifNotNil: [
	havePresenter flushPlayerListCache.		"old and outside guys"
	morphs _ IdentitySet new: 400.
	havePresenter associatedMorph allMorphsAndBookPagesInto: morphs.
	players _ (morphs select: [:m | m player ~~ nil] 
				thenCollect: [:m | m player]) asArray.
	players _ players select: [:ap | (arrayOfRoots includes: ap class) not
		& (ap class isSystemDefined not)].
	extras addAll: (players collect: [:each | each class]).
	(env _ havePresenter world project module) ifNil: [
		extras addAll: (players collect: [:each | each class class])].
	extras addAll: morphs.	"Make then ALL roots!!"
	].
existing _ arrayOfRoots asIdentitySet.
extras _ extras reject: [ :each | existing includes: each].
extras isEmpty ifTrue: [^ nil].	"no change"
env 
	ifNil: ["old pre-module"
		havePresenter _ players _ morphs _ nil.
		^ arrayOfRoots, extras]	"will contain multiples of some, but reduced later"
	ifNotNil: [
		(env includesKey: #Object) ifTrue: [self error: 'only look in local env, not up chain'].
			"If get error, use a message other than includesKey:"
		extras do: [:cls | 
			(env includesKey: cls name) ifFalse: [
				env declare: cls name from: Smalltalk]].
		havePresenter _ players _ morphs _ env _ nil.
		^ arrayOfRoots, extras	"still need in roots in case outside pointers"
		]! !


!Metaclass methodsFor: 'accessing' stamp: 'hg 8/21/2001 14:15'!
module
	^thisClass module! !

!Metaclass methodsFor: 'compiling' stamp: 'squeak 8/30/2001 22:37'!
strongScopeHas: name ifTrue: assocBlock  

	^self scopeHas: name ifTrue: assocBlock! !


!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:01'!
addCategory: catString before: nextCategory
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:02'!
allMethodSelectors
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:52'!
categories: c
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:45'!
categoriesMatching: matchString

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:06'!
categoryFromUserWithPrompt: aPrompt

	self obsoleteMethod ! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:56'!
changeFromCategorySpecs: categorySpecs 

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:56'!
changeFromString: aString 

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:58'!
classComment
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:57'!
classComment: aString 
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:07'!
elementArray


	self obsoleteMethod ! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:43'!
fileOut

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:43'!
fileOutCategory: category on: aFileStream initializing: aBool

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:04'!
fileOutCommentOn: aFileStream moveSource: moveSource toFile: fileIndex
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:02'!
letUserReclassify: anElement
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:04'!
moveChangedCommentToFile: aFileStream numbered: fileIndex 
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:05'!
putCommentOnFile: aFileStream numbered: sourceIndex moveSource: moveSource forClass: aClass

	self notYetImplemented ! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:43'!
removeCategoriesMatching: matchString

	self obsoleteMethod ! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:02'!
removeCategory: cat 
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:59'!
removeElement: element 
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:59'!
removeEmptyCategories
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 20:32'!
removeMissingClasses
	"nothing stored"

	^self! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/10/2001 12:48'!
removeSystemCategory: category
	
	self obsoleteMethod ! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:02'!
renameCategory: oldCatString toBe: newCatString
	"nothing sending this message should be used any longer"

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:06'!
scanFrom: aStream

	self obsoleteMethod ! !

!ModularSystemOrganizer methodsFor: 'obsolete methods' stamp: 'hg 9/7/2001 21:07'!
setDefaultList: aSortedCollection

	self obsoleteMethod! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/10/2001 12:46'!
categories
	

	| c |
	c _ OrderedCollection new.
	Module root deepSubmodulesDo: [:m | c add: m simulatedCategory].
	^c allButFirst: self skipFirstNCategories! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/8/2001 19:37'!
categoryOfElement: c

	Module root associationFor: c ifPresent: [:assoc :mod | ^mod simulatedCategory].
	^nil! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/8/2001 20:07'!
classify: element under: heading suppressIfDefault: aBoolean
	"just do nothing"

	^self! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/7/2001 22:16'!
listAtCategoryNamed: cat

	| mod |
	mod _ (self moduleFromCategory: cat) ifNil: [^#()].
	^mod allClasses collect: [:cl | cl name]! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/10/2001 12:46'!
listAtCategoryNumber: anInteger 
	
	| index |
	index _ 0 - self skipFirstNCategories.
	Module root deepSubmodulesDo: [:m | 
		index _ index + 1.
		index = anInteger ifTrue: [^m classNames]]! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/7/2001 20:34'!
moduleFromCategory: cat

	^Module moduleForCategory: cat forceCreate: false! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/10/2001 12:47'!
numberOfCategoryOfElement: element 
	"Answer the index of the category with which the argument, element, is 
	associated."

	| index |
	index _ 0 - self skipFirstNCategories.
	Module root deepSubmodulesDo: [:m |
		index _ index + 1.
		m definedNames keysDo: [:key | key = element ifTrue: [^index]]].
	^0! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/7/2001 21:05'!
objectForDataStream: refStrm

	self notYetImplemented ! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/7/2001 22:26'!
obsoleteMethod

	self error: 'You cant do it this way with modules. Categories are computed from module paths.'! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/10/2001 12:46'!
skipFirstNCategories
	"use this to not return categories for e.g. the virtual root"

	^2! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 9/7/2001 20:39'!
superclassOrder: category 
	"Answer an OrderedCollection containing references to the classes in the 
	category whose name is the argument, category (a string). The classes 
	are ordered with superclasses first so they can be filed in."

	| list |
	list _  (self moduleFromCategory: category asSymbol) allClasses.
	^ChangeSet superclassOrder: list! !

!ModularSystemOrganizer methodsFor: 'fileIn/Out' stamp: 'hg 9/7/2001 21:04'!
printOn: aStream 
	

	aStream nextPutAll: 'A replacement for SystemOrganization for modular system';cr! !

!ModularSystemOrganizer methodsFor: 'fileIn/Out' stamp: 'hg 9/7/2001 21:04'!
printOnStream: aStream 
	

	aStream nextPutAll: 'A replacement for SystemOrganization for modular system'; cr! !


!ModularSystemOrganizer class methodsFor: 'instance creation' stamp: 'squeak 9/10/2001 18:24'!
install

	| instance |
	(PopUpMenu confirm: 'Remove old SystemOrganization? (All system browsers will be reset.)')
		ifFalse: [^self notify: 'Conversion to modules cannot proceed.'].

	instance _ self new.
	Smalltalk at: #SystemOrganization put: instance.
	Browser allSubInstancesDo: [:br | 
		br 	systemOrganizer: instance;
			updateSystemCategories].
	Smalltalk garbageCollect! !


!Module class methodsFor: 'virtual hierarchy' stamp: 'squeak 9/11/2001 11:58'!
listForPackageBrowser
	"return a list of module names to use in the extra pane of the Package Browser"

	| squeak rootList squeakList |
	squeak _ Module squeak name.
	rootList _ Module root submodules collect: [:mod | mod simulatedCategory].
	squeakList _ Module squeak submodules collect: [:mod | mod simulatedCategory].
	^(rootList copyUpTo: squeak),
	 (Array with: squeak),
	 squeakList,
	 (rootList copyAfter: squeak)
	! !


!Project methodsFor: 'accessing' stamp: 'hg 8/21/2001 13:33'!
module
	^ environment! !


!SmartRefStream methodsFor: 'import image segment' stamp: 'hg 8/21/2001 21:45'!
mapClass: newClass origName: originalName
	"See if instances changed shape.  If so, make a fake class for the old shape and return it.  Remember the original class name."

	| newName oldInstVars fakeClass |
	newClass isMeta ifTrue: [^ newClass].
	newName _ newClass name.
	(steady includes: newClass) & (newName == originalName) ifTrue: [^ newClass].
		"instances in the segment have the right shape"
	oldInstVars _ structures at: originalName ifAbsent: [
			self error: 'class is not in structures list'].	"Missing in object file"
	fakeClass _ Object subclass: ('Fake37', originalName) asSymbol
		instanceVariableNames: oldInstVars allButFirst
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Obsolete'.
	fakeClass module changes removeClassChanges: fakeClass name.	"reduce clutter"
	^ fakeClass
! !


!StringHolder methodsFor: 'message list menu' stamp: 'hg 8/21/2001 21:46'!
removeFromCurrentChanges
	"Tell the changes mgr to forget that the current msg was changed."

	self selectedClassOrMetaClass changes removeSelectorChanges: self selectedMessageName 
			class: self selectedClassOrMetaClass.
	self changed: #annotation! !


!CodeHolder methodsFor: 'commands' stamp: 'hg 8/21/2001 21:44'!
adoptMessageInCurrentChangeset
	"Add the receiver's method to the current change set if not already there"

	self setClassAndSelectorIn: [:cl :sel |
		cl ifNotNil:
			[cl module changes adoptSelector: sel forClass: cl.
			self changed: #annotation]]
! !


!Browser methodsFor: 'class functions' stamp: 'hg 9/7/2001 18:21'!
defineClass: defString notifying: aController  
	"The receiver's textual content is a request to define a new class. The
	source code is defString. If any errors occur in compilation, notify
	aController."
	| oldClass class newClassName defTokens keywdIx envt |
	oldClass _ self selectedClassOrMetaClass.
	defTokens _ defString findTokens: Character separators.
	"keywdIx _ defTokens findFirst: [:x | x beginsWith: 'category'].
	envt _ Module moduleForCategory: ((defTokens at: keywdIx+1) copyWithout: $') forceCreate: false."
	keywdIx _ defTokens findFirst: [:x | '*subclass*' match: x].
	newClassName _ (defTokens at: keywdIx+1) copyWithoutAll: '#()'.
	"((oldClass isNil or: [oldClass name asString ~= newClassName])
		and: [envt includesKeyOrAbove: newClassName asSymbol]) ifTrue:
			[""Attempting to define new class over existing one when
				not looking at the original one in this browser...""
			(self confirm: ((newClassName , ' is an existing class in this system.
Redefining it might cause serious problems.
Is this really what you want to do?') asText makeBoldFrom: 1 to: newClassName size))
				ifFalse: [^ false]]."
	"ar 8/29/1999: Use oldClass superclass for defining oldClass
	since oldClass superclass knows the definerClass of oldClass."
	oldClass ifNotNil:[oldClass _ oldClass superclass].
	class _ oldClass subclassDefinerClass
				evaluate: defString
				notifying: aController
				logged: true.
	(class isKindOf: Behavior)
		ifTrue: [self changed: #classList.
				self classListIndex: 
					(self classList indexOf: 
						((class isKindOf: Metaclass)
							ifTrue: [class soleInstance name]
							ifFalse: [class name])).
				self clearUserEditFlag; editClass.
				^ true]
		ifFalse: [^ false]! !

!Browser methodsFor: 'class list' stamp: 'hg 9/7/2001 19:18'!
selectedClass
	"Answer the class that is currently selected. Answer nil if no selection 
	exists."

	| name |
	(name _ self selectedClassName) ifNil: [^ nil].
	Module root associationFor: name ifPresent: [:assoc :module | ^assoc value].
	^nil! !

!Browser methodsFor: 'message category functions' stamp: 'hg 8/21/2001 21:42'!
alphabetizeMessageCategories
	classListIndex = 0 ifTrue: [^ false].
	self okToChange ifFalse: [^ false].
	self selectedClassOrMetaClass changes reorganizeClass: self selectedClassOrMetaClass.
	self classOrMetaClassOrganizer sortCategories.
	self clearUserEditFlag.
	self editClass.
	self classListIndex: classListIndex.
	^ true! !

!Browser methodsFor: 'message category functions' stamp: 'hg 8/21/2001 21:42'!
changeMessageCategories: aString 
	"The characters in aString represent an edited version of the the message 
	categories for the selected class. Update this information in the system 
	and inform any dependents that the categories have been changed. This 
	message is invoked because the user had issued the categories command 
	and edited the message categories. Then the user issued the accept 
	command."

	self selectedClassOrMetaClass changes reorganizeClass: self selectedClassOrMetaClass.
	self classOrMetaClassOrganizer changeFromString: aString.
	self clearUserEditFlag.
	self editClass.
	self classListIndex: classListIndex.
	^ true! !

!Browser methodsFor: 'message category functions' stamp: 'hg 8/21/2001 21:42'!
renameCategory
	"Prompt for a new category name and add it before the
	current selection, or at the end if no current selection"
	| oldIndex oldName newName |
	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	(oldIndex _ messageCategoryListIndex) = 0 ifTrue: [^ self].
	oldName _ self selectedMessageCategoryName.
	newName _ self
		request: 'Please type new category name'
		initialAnswer: oldName.
	newName isEmpty
		ifTrue: [^ self]
		ifFalse: [newName _ newName asSymbol].
	newName = oldName ifTrue: [^ self].
	self selectedClassOrMetaClass changes reorganizeClass: self selectedClassOrMetaClass.
	self classOrMetaClassOrganizer
		renameCategory: oldName
		toBe: newName.
	self classListIndex: classListIndex.
	self messageCategoryListIndex: oldIndex.
	self changed: #messageCategoryList.
! !

!Browser methodsFor: 'system category functions' stamp: 'hg 9/10/2001 15:12'!
potentialClassNames
	"Answer the names of all the classes that could be viewed in this browser.  This hook is provided so that HierarchyBrowsers can indicate their restricted subset.  For generic Browsers, the entire list of classes known to Smalltalk is provided, though of course that really only is accurate in the case of full system browsers."

	^ Module root classNames! !

!Browser methodsFor: 'system category functions' stamp: 'hg 9/7/2001 22:02'!
systemCategoryMenu: aMenu

^ aMenu labels:
'find class... (f)
recent classes... (r)
browse all
browse
"printOut
fileOut
reorganize
update
add item...
rename...
remove"' 
	lines: #(2 4" 6 8")
	selections:
		#(findClass recent browseAllClasses buildSystemCategoryBrowser
		"printOutSystemCategory fileOutSystemCategory
		editSystemCategories updateSystemCategories
		addSystemCategory renameSystemCategory removeSystemCategory" )! !


!PackagePaneBrowser methodsFor: 'initialize-release' stamp: 'squeak 9/11/2001 12:09'!
openAsMorphEditing: editString 
	"Create a pluggable version of all the views for a Browser, including 
	views and controllers."
	"PackagePaneBrowser openBrowser"

	| listHeight window |
	listHeight _ 0.4.
	(window _ SystemWindow labelled: 'later') model: self.
	window
		addMorph: (PluggableListMorph
				on: self
				list: #packageList
				selected: #packageListIndex
				changeSelected: #packageListIndex:
				menu: #packageMenu:
				keystroke: #packageListKey:from:)
		frame: (0 @ 0 extent: 0.20 @ listHeight).
	window
		addMorph: self buildMorphicSystemCatList
		frame: (0.20 @ 0 extent: 0.18 @ listHeight).
	self
		addClassAndSwitchesTo: window
		at: (0.38 @ 0 extent: 0.20 @ listHeight)
		plus: 0.
	window
		addMorph: self buildMorphicMessageCatList
		frame: (0.58 @ 0 extent: 0.18 @ listHeight).
	window
		addMorph: self buildMorphicMessageList
		frame: (0.76 @ 0 extent: 0.24 @ listHeight).
	self
		addLowerPanesTo: window
		at: (0 @ listHeight corner: 1 @ 1)
		with: editString.
	window setUpdatablePanesFrom: #(#packageList #systemCategoryList #classList #messageCategoryList #messageList ).
	^ window! !

!PackagePaneBrowser methodsFor: 'package list' stamp: 'squeak 9/11/2001 11:57'!
packageList
	"Answer a list of the packages in the current system organization."

	^Module listForPackageBrowser! !


!Symbol methodsFor: 'printing' stamp: 'squeak 9/10/2001 11:47'!
basicPrintOn: aStream 
	"print symbol without the #"

	(Scanner isLiteralSymbol: self)
		ifTrue: [aStream nextPutAll: self]
		ifFalse: [super storeOn: aStream]! !

!Symbol methodsFor: 'printing' stamp: 'squeak 9/10/2001 11:47'!
storeOn: aStream 

	aStream nextPut: $#.
	self basicPrintOn: aStream.! !


!SystemDictionary methodsFor: 'class names' stamp: 'hg 8/21/2001 21:52'!
removeClassFromSystem: aClass logged: aBool
	"Delete the class, aClass, from the system, but log the removal neither to the current change set nor to the changes log"
	aBool ifTrue:[
		aClass wantsChangeSetLogging ifTrue:
			[aClass module changes noteRemovalOf: aClass].
		aClass acceptsLoggingOfCompilation ifTrue:
			[Smalltalk logChange:  'Smalltalk removeClassNamed: #', aClass name].
	].
	SystemOrganization removeElement: aClass name.
	self removeFromStartUpList: aClass.
	self removeFromShutDownList: aClass.
	self removeKey: aClass name ifAbsent: [].
	self flushClassNameCache
! !

!SystemDictionary methodsFor: 'class names' stamp: 'hg 8/21/2001 21:51'!
renameClass: aClass as: newName 
	"Rename the class, aClass, to have the title newName."
	| oldref i |
	SystemOrganization classify: newName under: aClass category.
	SystemOrganization removeElement: aClass name.
	aClass module changes renameClass: aClass as: newName.
	oldref _ self associationAt: aClass name.
	self removeKey: aClass name.
	oldref key: newName.
	self add: oldref.  "Old association preserves old refs"
	(Array with: StartUpList with: ShutDownList) do:
		[:list |  i _ list indexOf: aClass name ifAbsent: [0].
		i > 0 ifTrue: [list at: i put: newName]].
	self flushClassNameCache! !


!UndefinedObject methodsFor: 'class hierarchy' stamp: 'hg 8/21/2001 13:34'!
module
	"Necessary to support disjoint class hierarchies."
	^Smalltalk! !

PackagePaneBrowser removeSelector: #selectedClass!
Browser removeSelector: #selectedEnvironment!

!ModularSystemOrganizer reorganize!
('obsolete methods' addCategory:before: allMethodSelectors categories: categoriesMatching: categoryFromUserWithPrompt: changeFromCategorySpecs: changeFromString: classComment classComment: elementArray fileOut fileOutCategory:on:initializing: fileOutCommentOn:moveSource:toFile: letUserReclassify: moveChangedCommentToFile:numbered: putCommentOnFile:numbered:moveSource:forClass: removeCategoriesMatching: removeCategory: removeElement: removeEmptyCategories removeMissingClasses removeSystemCategory: renameCategory:toBe: scanFrom: setDefaultList:)
('handled SysOrg methods' categories categoryOfElement: classify:under:suppressIfDefault: listAtCategoryNamed: listAtCategoryNumber: moduleFromCategory: numberOfCategoryOfElement: objectForDataStream: obsoleteMethod skipFirstNCategories superclassOrder:)
('fileIn/Out' printOn: printOnStream:)
!

ClassBuilder removeSelector: #name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:!
ClassBuilder removeSelector: #name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:unsafe:!
-------------- next part --------------
'From Squeak3.1alpha of 7 March 2001 [latest update: #4332] on 12 September 2001 at 10:11:13 pm'!
"Change Set:		Modules-2
Date:			6 September 2001
Author:			Henrik Gedenryd

Install sensitive methods that rely on others already being in place."!


!Behavior methodsFor: 'testing method dictionary' stamp: 'squeak 8/30/2001 18:43'!
scopeHas: name ifTrue: assocBlock 
	"If the argument name is a variable known to the receiver, then evaluate 
	the second argument, assocBlock."

	| assoc |
	(assoc _ Smalltalk associationAt: name ifAbsent: []) == nil
		ifFalse: [assocBlock value: assoc.
				^ true].

	^false! !


!Class methodsFor: 'compiling' stamp: 'squeak 8/31/2001 12:47'!
scopeHas: varName ifTrue: assocBlock
	"Look up the first argument, varName, in the context of the receiver. If it is there,
	pass the association to the second argument, assocBlock, and answer true.
	Do NOT look in superclasses' modules!!"

	self definesName: varName lookInSuper: true ifTrue: [:a |
		assocBlock value: a.
		^ true].
 
	"Next look in home module."
	Preferences strongModules ifTrue: [
		self module associationFor: varName ifPresent: [:a :mod |
			assocBlock value: a.
			^ true]].

	"Finally look it up in Smalltalk. This is a compatibility patch for now."
	Module smalltalk associationFor: varName ifPresent: [:a :mod |
		assocBlock value: a.
		^ true]. 

	^false
! !

!Class methodsFor: 'organization' stamp: 'squeak 9/10/2001 18:47'!
module

	^module ifNil: [Module smalltalk]! !

!Class methodsFor: 'organization' stamp: 'squeak 9/10/2001 18:47'!
module: aModule

	module _ aModule! !