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]]]!