Chris Muller uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-cmm.586.mcz
==================== Summary ====================
Name: System-cmm.586 Author: cmm Time: 31 August 2013, 3:29:01.755 pm UUID: bbffd13c-e516-462d-ac89-e3880a28c382 Ancestors: System-fbs.585
- Remove modal confirmation pop-up buried in system code. If this is necessary it should be invoked from calling code. - Factor SmalltalkImage>>#unloadAllKnownPackages into several smaller methods to allow more deliberate shrinking. - Remove method referring to undefined "ScrapsBook".
=============== Diff against System-fbs.585 ===============
Item was changed: ----- Method: SmalltalkImage>>cleanUp:except: (in category 'housekeeping') ----- + cleanUp: aggressive except: exclusions - cleanUp: aggressive except: exclusions "Clean up. When aggressive is true, this will destroy projects, change sets, etc. Leave out any classes specifically listed in exclusions." - "Smalltalk cleanUp: true except: {Project. ChangeSet}" + "Find all classes implementing #cleanUp or cleanUp:" + | classes | + classes := Smalltalk allClasses select: + [ : eachClass | (eachClass class includesSelector: #cleanUp) or: + [ (eachClass class includesSelector: #cleanUp:) and: [ (exclusions includes: eachClass) not ] ] ]. + "Arrange classes in superclass order, superclasses before subclasses, so that specific cleanup (like MethodDictionary compaction) will run after generic superclass cleanup (HashedCollection rehashing). Otherwise generic superclass cleanup might undo specific one (in this case rehashing will undo a good bit of MD compaction)." + (ChangeSet superclassOrder: classes) + do: [ : aClass | aClass cleanUp: aggressive ] + displayingProgress: [ : aClass | 'Cleaning up in ' , aClass name ]! - - ^self cleanUp: aggressive except: exclusions confirming: aggressive!
Item was removed: - ----- Method: SmalltalkImage>>cleanUp:except:confirming: (in category 'housekeeping') ----- - cleanUp: aggressive except: exclusions confirming: aBool - "Clean up. When aggressive is true, this will destroy projects, change sets, etc. - Leave out any classes specifically listed in exclusions." - - "Smalltalk cleanUp: true except: {Project. ChangeSet}" - - | classes | - aBool ifTrue:[ - "Give the user a chance to bail" - (self confirm: 'Cleanup will destroy projects, change sets and more. - Are you sure you want to proceed?') ifFalse:[^self]. - ]. - - "Find all classes implementing #cleanUp or cleanUp:" - classes := Smalltalk allClasses select:[:aClass| - (aClass class includesSelector: #cleanUp) - or:[aClass class includesSelector: #cleanUp:] - ]. - - "Leave out the classes in the exclusion set" - classes := classes reject:[:aClass| exclusions includes: aClass]. - - "Arrange classes in superclass order, superclasses before subclasses. - This will ensure that specific cleanup (like MethodDictionary compaction) - will run after generic superclass cleanup (HashedCollection rehashing). - Otherwise generic superclass cleanup might undo specific one (in this - case rehashing will undo a good bit of MD compaction)." - classes := ChangeSet superclassOrder: classes. - - "Run the cleanup code" - classes - do:[:aClass| aClass cleanUp: aggressive] - displayingProgress:[:aClass| 'Cleaning up in ', aClass name].!
Item was added: + ----- Method: SmalltalkImage>>cleanUpEtoys (in category 'shrinking') ----- + cleanUpEtoys + StandardScriptingSystem removeUnreferencedPlayers. + Project removeAllButCurrent. + #('Morphic-UserObjects' 'EToy-UserObjects' 'Morphic-Imported' ) do: + [ : each | SystemOrganization removeSystemCategory: each ]. + World dumpPresenter. + Presenter defaultPresenterClass: nil. + Preferences removePreference: #allowEtoyUserCustomEvents. + !
Item was added: + ----- Method: SmalltalkImage>>removeChangeSets (in category 'shrinking') ----- + removeChangeSets + ChangeSet removeChangeSetsNamedSuchThat: + [ : each | (each == ChangeSet current) not ]. + ChangeSet current + clear ; + name: 'Unnamed1'!
Item was added: + ----- Method: SmalltalkImage>>shrink (in category 'shrinking') ----- + shrink + "Clean up everything we know how to clean up that can be restored." + "Prepare unloading" + self zapMVCprojects. + Flaps disableGlobalFlaps: false. + self cleanUpEtoys. + "Yeow, why turn off listening for system changes?" + self + at: #ServiceRegistry + ifPresent: [ : aClass | SystemChangeNotifier uniqueInstance noMoreNotificationsFor: aClass ]. + self unloadReloadablePackages. + "Post-unload cleanup" + SmalltalkImage cleanUp. + MCWorkingCopy flushObsoletePackageInfos. + "aggressive cleanUp" + SystemOrganization removeSystemCategory: 'UserObjects'. + ScheduledControllers := nil. + SystemOrganization removeEmptyCategories. + StandardScriptingSystem initialize. + "aggressive cleanUp" + self removeChangeSets. + self + at: #Browser + ifPresent: + [ : br | br initialize ]. + DebuggerMethodMap voidMapCache. + DataStream initialize. + Smalltalk garbageCollect!
Item was added: + ----- Method: SmalltalkImage>>shrinkAndCleanDesktop (in category 'shrinking') ----- + shrinkAndCleanDesktop + World removeAllMorphs. + self shrink. + MorphicProject defaultFill: (Color gray: 0.9). + World color: (Color gray: 0.9)!
Item was removed: - ----- Method: SmalltalkImage>>unloadAllKnownPackages (in category 'shrinking') ----- - unloadAllKnownPackages - "Unload all packages we know how to unload and reload" - - "Prepare unloading" - Smalltalk zapMVCprojects. - Flaps disableGlobalFlaps: false. - StandardScriptingSystem removeUnreferencedPlayers. - Project removeAllButCurrent. - #('Morphic-UserObjects' 'EToy-UserObjects' 'Morphic-Imported' ) - do: [:each | SystemOrganization removeSystemCategory: each]. - Smalltalk at: #ServiceRegistry ifPresent:[:aClass| - SystemChangeNotifier uniqueInstance - noMoreNotificationsFor: aClass. - ]. - World removeAllMorphs. - - "Go unloading" - #( 'ReleaseBuilder' 'ScriptLoader' - '311Deprecated' '39Deprecated' - 'Universes' 'SMLoader' 'SMBase' 'Installer-Core' - 'VersionNumberTests' 'VersionNumber' - 'Services-Base' 'PreferenceBrowser' 'Nebraska' - 'ToolBuilder-MVC' 'ST80Tools' 'ST80Tests' 'ST80' - 'CompressionTests' - 'CollectionsTests' 'GraphicsTests' 'KernelTests' 'MorphicTests' - 'MultilingualTests' 'NetworkTests' 'ToolsTests' 'TraitsTests' - 'SystemChangeNotification-Tests' 'FlexibleVocabularies' - 'EToys' 'Protocols' 'XML-Parser' 'Tests' 'SUnitGUI' - 'Help-Squeak' 'HelpSystem' 'SystemReporter' - ) do: [:pkgName| - (MCPackage named: pkgName) unload. - MCMcmUpdater disableUpdatesOfPackage: pkgName. - ]. - "Traits use custom unload" - Smalltalk at: #Trait ifPresent:[:aClass| aClass unloadTraits]. - - "Post-unload cleanup" - SmalltalkImage cleanUp. - MCWorkingCopy flushObsoletePackageInfos. "aggressive cleanUp" - SystemOrganization removeSystemCategory: 'UserObjects'. - Presenter defaultPresenterClass: nil. - World dumpPresenter. - ScheduledControllers := nil. - Preferences removePreference: #allowEtoyUserCustomEvents. - SystemOrganization removeEmptyCategories. - StandardScriptingSystem initialize. "aggressive cleanUp" - ChangeSet removeChangeSetsNamedSuchThat:[:cs | (cs == ChangeSet current) not]. - ChangeSet current clear. - ChangeSet current name: 'Unnamed1'. - Smalltalk at: #Browser ifPresent:[:br| br initialize]. - DebuggerMethodMap voidMapCache. - DataStream initialize. - - Smalltalk garbageCollect. - MorphicProject defaultFill: (Color gray: 0.9). - World color: (Color gray: 0.9). - !
Item was added: + ----- Method: SmalltalkImage>>unloadReloadablePackages (in category 'shrinking') ----- + unloadReloadablePackages + "Unload packages which can be reloaded." + #('ReleaseBuilder' 'ScriptLoader' '311Deprecated' '39Deprecated' 'Universes' 'SMLoader' 'SMBase' 'VersionNumberTests' 'VersionNumber' 'Services-Base' 'PreferenceBrowser' 'Nebraska' 'ToolBuilder-MVC' 'ST80Tools' 'ST80Tests' 'ST80' 'CompressionTests' 'CollectionsTests' 'GraphicsTests' 'KernelTests' 'MorphicTests' 'MultilingualTests' 'NetworkTests' 'ToolsTests' 'TraitsTests' 'SystemChangeNotification-Tests' 'FlexibleVocabularies' 'EToys' 'Protocols' 'XML-Parser' 'Tests' 'SUnitGUI' 'Help-Squeak' 'HelpSystem' 'SystemReporter' ) do: [ : pkgName | Installer mc unload: pkgName ]. + "Traits use custom unload" + self + at: #Trait + ifPresent: [ : aClass | aClass unloadTraits ]!
Item was removed: - ----- Method: Utilities class>>cleanUp: (in category 'class initialization') ----- - cleanUp: agressive - "Nuke the scraps book when cleaning aggressively" - - agressive ifTrue:[ScrapsBook := nil].!