Bert Freudenberg uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-bf.522.mcz

==================== Summary ====================

Name: System-bf.522
Author: bf
Time: 11 April 2013, 3:29:35.918 pm
UUID: a0a9a561-1330-4df9-b47f-30d1e542c825
Ancestors: System-eem.521

* make project loading work

=============== Diff against System-eem.521 ===============

Item was changed:
  ----- Method: Project>>okToChange (in category 'release') -----
  okToChange
  	"Answer whether the window in which the project is housed can be dismissed -- which is destructive. We never clobber a project without confirmation"
  
+ 	| ok is list |
  	self subProjects size  >0 ifTrue:
  		[self inform: 
  ('The project {1}
  contains sub-projects.  You must remove these
  explicitly before removing their parent.' translated format:{self name}).
  		^ false].
+ 	ok := world isMorph not and: [world scheduledControllers size <= 1].
+ 	ok ifFalse: [self isMorphic ifTrue:
+ 		[self parent == CurrentProject 
+ 			ifFalse: [^ true]]].  "view from elsewhere.  just delete it."
+ 	ok := (self confirm:
+ ('Really delete the icon
+ and remove the project
+ {1} from Etoys?
+ (file will still be saved on disk)' translated format:{self name printString})).
+ 		
+ 	ok ifFalse: [^ false].
- 	self parent == CurrentProject 
- 			ifFalse: [^ true].  "view from elsewhere.  just delete it."
- 	(self confirm:
- ('Really delete the project
- {1}
- and all its windows?' translated format:{self name}))
- 		ifFalse: [^ false].
  
+ 	world isMorph ifTrue:
+ 		[Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass |
+ 			world submorphs do:   "special release for wonderlands"
+ 						[:m | (m isKindOf: aClass)
+ 								and: [m getWonderland release]]].
+ 			"Remove Player classes and metaclasses owned by project"
+ 			is := ImageSegment new arrayOfRoots: (Array with: self).
+ 			(list := is rootsIncludingPlayers) ifNotNil:
+ 				[list do: [:playerCls | 
+ 					(playerCls respondsTo: #isMeta) ifTrue:
+ 						[playerCls isMeta ifFalse:
+ 							[playerCls removeFromSystemUnlogged]]]]].
- 	self prepareForDelete.
  
  	self removeChangeSetIfPossible.
  	"do this last since it will render project inaccessible to #allProjects and their ilk"
  	ProjectHistory forget: self.
  	Project deletingProject: self.
  	^ true
  !

Item was changed:
  ----- Method: Project>>restoreReferences (in category 'file in/out') -----
  restoreReferences
- 	
- 	"I just came in from an exported segment.  Take all my players that were in References, and reinstall them."
  
+ 	| refs newPool |
+ 	refs := world valueOfProperty: #References ifAbsent: [nil].
+ 	(refs isMemberOf: OrderedCollection) ifTrue: [
+ 		world removeProperty: #References.
+ 		newPool := world referencePool.
+ 		refs do: [:assoc | newPool add: assoc].
+ 	].
+ !
- 	"*** Note that (world valueOfProperty: #References) is temporary during loading and is not the same as the global References dictionary (in Smalltalk)."
- 	(world valueOfProperty: #References ifAbsent: [#()]) do: [:assoc | | key newKey extName | "just came in"
- 		key := assoc key.
- 		(References includesKey: key) 
- 			ifTrue: ["must rename" 
- 				extName := assoc value externalName.	"what user sees"
- 				(References at: key) == assoc value ifTrue: [
- 					self error: 'why is this object already present?'].
- 				newKey := assoc value uniqueNameForReference.
- 				References removeKey: newKey.
- 				assoc key: newKey.
- 				References add: assoc.	"use the known association"
- 
- 				Preferences universalTiles
- 					ifTrue: [assoc value renameTo: newKey] 	"change names in scripts"
- 					ifFalse: [(assoc value renameInternal: extName)	"keep externalName the same"
- 								ifNil: [assoc value renameTo: newKey]].
- 									"rename Project itself.  Ignore others"
- 				]
- 			ifFalse: [References add: assoc]].
- 	world removeProperty: #References.!

Item was changed:
  ----- Method: SmalltalkImage>>zapAllOtherProjects (in category 'shrinking') -----
  zapAllOtherProjects 
  	"Smalltalk zapAllOtherProjects"
  "Note: as of this writing, the only reliable way to get rid of all but the current project is te execute the following, one line at a time...
  		Smalltalk zapAllOtherProjects.
  		ProjectHistory currentHistory initialize.
  		Smalltalk garbageCollect.
  		Project rebuildAllProjects.
  "
  
  	
  	Project allInstancesDo: [:p | p setParent: nil].
  	Project current setParent: Project current.
  	Project current isMorphic ifTrue: [ScheduledControllers := nil].
  	TheWorldMenu allInstancesDo: [:m | 1 to: m class instSize do: [:i | m instVarAt: i put: nil]].
  	ChangeSet classPool at: #AllChangeSets put: nil.
  	Project classPool at: #AllProjects put: nil.
  	ProjectHistory currentHistory initialize.
+ 	CommandHistory resetAllHistory.
  	ChangeSet initialize.
  	Project rebuildAllProjects.  "Does a GC"
  	Project allProjects size > 1 ifTrue: [Project allProjects inspect]!

Item was changed:
  ----- Method: SmartRefStream>>initKnownRenames (in category 'read write') -----
  initKnownRenames
  	renamed
+ 		at: #FlasherMorph put: #Flasher;
+ 		at: #AlansTextPlusMorph put: #TextPlusMorph;
+ 		at: #Project put: #MorphicProject;
+ 		at: #Presenter put: #EtoysPresenter;
+ 		yourself!
- 		at: #FlasherMorph put: #Flasher!

Item was changed:
  ----- Method: SmartRefStream>>mapClass:origName: (in category 'import image segment') -----
  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"
  
  	"Allow mapping from old to new string names"
  	(newName == #ByteString and:[originalName == #String]) ifTrue:[^newClass].
  	(newName == #WideString and:[originalName == #MultiString]) ifTrue:[^newClass].
  	(newName == #WideSymbol and:[originalName == #MultiSymbol]) ifTrue:[^newClass].
  
+ 	"Variable classes are not handled fully. This one is fine. --bf"
+ 	newName == #MethodContext ifTrue: [^newClass].
+ 
  	fakeClass := Object subclass: ('Fake37', originalName) asSymbol
  		instanceVariableNames: oldInstVars allButFirst
  		classVariableNames: ''
  		poolDictionaries: ''
  		category: 'Obsolete'.
  	ChangeSet current removeClassChanges: fakeClass name.	"reduce clutter"
  	^ fakeClass
  !