David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-dtl.821.mcz

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

Name: System-dtl.821
Author: dtl
Time: 30 April 2016, 7:56:17.264854 pm
UUID: d67cc3f2-58db-4b26-8926-c28b9faf67ac
Ancestors: System-cmm.820

Let SmalltalkImage>>zapMVCprojects delegate to MVCProject.

Let SmalltalkImage>>zapAllOtherProjects delegate to Project current.

Add Project>>removeAllOtherProjects based on zapAllOtherProjects, and make it work for images containing various combinations of MVC and Morphic projects.

Change Project class>>deletingProject: to look for project views (child projects) that need to be closed in MVC projects. This method could do with some additional refactoring to remove the Smalltalk at:ifAbsent: tests.

=============== Diff against System-cmm.820 ===============

Item was changed:
  ----- Method: Project class>>deletingProject: (in category 'utilities') -----
  deletingProject: outgoingProject
  
+ 	| pvmClass pvControllerClass |
- 	| pvmClass |
  	pvmClass := Smalltalk at: #ProjectViewMorph ifAbsent: [nil].
+ 	pvControllerClass := Smalltalk at: #ProjectController ifAbsent: [nil].
  	ImageSegment allSubInstancesDo: [:seg |
  		seg ifOutPointer: outgoingProject thenAllObjectsDo: [:obj |
  			(obj isKindOf: pvmClass) ifTrue: [obj deletingProject: outgoingProject.  obj abandon].
  			(obj isKindOf: Project) ifTrue: [obj deletingProject: outgoingProject]]].
  	self allProjects do: [:p | p deletingProject: outgoingProject].	"ones that are in"
  	pvmClass ifNotNil: [
  		pvmClass allSubInstancesDo: [:p | 
  			p deletingProject: outgoingProject.
  			p project == outgoingProject ifTrue: [p abandon]]].
+ 	pvControllerClass ifNotNil: [
+ 		pvControllerClass allInstancesDo: [ :pvc |
+ 			((pvc model parent isNil or: [pvc model parent == Project current]) and: [pvc model == outgoingProject])
+ 				ifTrue: [ pvc closeAndUnscheduleNoTerminate ]]].
  	AllProjects := self allProjects copyWithout: outgoingProject.!

Item was added:
+ ----- Method: Project>>removeAllOtherProjects (in category 'shrinking') -----
+ removeAllOtherProjects
+ 	"Remove all other projects from the system, and set the current project as the root
+ 	project. This method was originally implemented as SmalltalkImage>>zapAllOtherProjects
+ 	in earlier versions of Squeak."
+ 
+ 	"Project current removeAllOtherProjects"
+ 	
+ 	Project allSubInstancesDo: [:p | p setParent: nil].
+ 	Project current setParent: Project current.
+ 	ScheduledControllers == Project current world ifFalse: [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 allSubInstancesDo: [:p |
+ 		p == Project current ifFalse: [Project deletingProject: p]].
+ 	^Project current.
+ !

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 current removeAllOtherProjects
+ !
- 	
- 	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: SmalltalkImage>>zapMVCprojects (in category 'shrinking') -----
  zapMVCprojects
  	"Smalltalk zapMVCprojects"
- 	
  
+ 	(Smalltalk classNamed: #MVCProject)
+ 		ifNotNilDo: [:mvc | mvc removeProjectsFromSystem]
+ !
- 	self flag: #bob. "zapping projects"
- 
- 	Smalltalk garbageCollect.
- 	"So allInstances is precise"
- 	Project
- 		allSubInstancesDo: [:proj | | window | proj isTopProject
- 				ifTrue: [proj isMorphic
- 						ifFalse: ["Root project is MVC -- we must become the root"
- 							Project current setParent: Project current.]]
- 				ifFalse: [proj parent isMorphic
- 						ifFalse: [proj isMorphic
- 								ifTrue: ["Remove Morphic projects from MVC 
- 									views "
- 									"... and add them back here."
- 									window := (SystemWindow labelled: proj name)
- 												model: proj.
- 									window
- 										addMorph: (ProjectViewMorph on: proj)
- 										frame: (0 @ 0 corner: 1.0 @ 1.0).
- 									window openInWorld.
- 									proj setParent: Project current]].
- 					proj isMorphic
- 						ifFalse: ["Remove MVC projects from Morphic views"
- 							Project deletingProject: proj]]]!