The Trunk: System-dtl.979.mcz

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

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

Name: System-dtl.979
Author: dtl
Time: 24 November 2017, 6:12:53.864262 pm
UUID: 7572e3df-ab0e-4ad2-a89b-ee101e2a821c
Ancestors: System-dtl.978

Remove unnecessary references to global World.

=============== Diff against System-dtl.978 ===============

Item was changed:
  ----- Method: NativeImageSegment>>copySmartRootsExport: (in category 'read/write segment') -----
  copySmartRootsExport: rootArray
  "Use SmartRefStream to find the object.  Make them all roots.  Create the segment in memory.  Project should be in first five objects in rootArray."
+ | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world |
- | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy |
 
  "self halt."
+ world := Project current world.
  symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers,
  so they will be in outPointers"
 
  dummy := ReferenceStream on: (DummyStream on: nil).
  "Write to a fake Stream, not a file"
  "Collect all objects"
  dummy insideASegment: true. "So Uniclasses will be traced"
  dummy rootObject: rootArray. "inform him about the root"
  dummy nextPut: rootArray.
  (proj :=dummy project) ifNotNil: [self dependentsSave: dummy].
  allClasses := SmartRefStream new uniClassInstVarsRefs: dummy.
  "catalog the extra objects in UniClass inst vars.  Put into dummy"
  allClasses do: [:cls |
  dummy references at: cls class put: false. "put Player5 class in roots"
  dummy blockers removeKey: cls class ifAbsent: []].
  "refs := dummy references."
  arrayOfRoots := self smartFillRoots: dummy. "guaranteed none repeat"
  self savePlayerReferences: dummy references. "for shared References table"
  replacements := dummy blockers.
  dummy project "recompute it" ifNil: [self error: 'lost the project!!'].
  dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project'].
  dummy := nil. "Allow dummy to be GC'ed below (bytesLeft)."
  naughtyBlocks := arrayOfRoots select: [ :each |
  each isContext and: [each hasInstVarRef]].
 
  "since the caller switched ActiveWorld, put the real one back temporarily"
  naughtyBlocks isEmpty ifFalse: [
+ world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo |
- World becomeActiveDuring: [World firstHand becomeActiveDuring: [ | goodToGo |
  goodToGo := (UIManager default
  chooseFrom: #('keep going' 'stop and take a look')
  title:
  'Some block(s) which reference instance variables
  are included in this segment. These may fail when
  the segment is loaded if the class has been reshaped.
  What would you like to do?') = 1.
  goodToGo ifFalse: [
  naughtyBlocks inspect.
  self error: 'Here are the bad blocks'].
  ]].
  ].
  "Creation of the segment happens here"
 
  "try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)"
  sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024.
  self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true.
  segSize := segment size.
  [(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse:
  [arrayOfRoots := newRoots.
  self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
  "with methods pointed at from outside"
  [(newRoots := self rootsIncludingBlocks) == nil] whileFalse:
  [arrayOfRoots := newRoots.
  self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
  "with methods, blocks from outPointers"
  1 to: outPointers size do: [:ii | | outPointer |
  outPointer := outPointers at: ii.
  (outPointer isBlock
  or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil].
  "substitute new object in outPointers"
  (replacements includesKey: outPointer) ifTrue:
  [outPointers at: ii put: (replacements at: outPointer)]].
  proj ifNotNil: [self dependentsCancel: proj].
  symbolHolder. "hold onto symbolHolder until the last."!

Item was changed:
  ----- Method: Preferences class>>loadPreferencesFrom: (in category 'initialization - save/load') -----
  loadPreferencesFrom: aFile
  | stream params dict desktopColor |
  stream := ReferenceStream fileNamed: aFile.
  params := stream next.
  self assert: (params isKindOf: IdentityDictionary).
  params removeKey: #PersonalDictionaryOfPreferences.
  dict := stream next.
  self assert: (dict isKindOf: IdentityDictionary).
  desktopColor := stream next.
  stream close.
  dict keysAndValuesDo:
  [:key :value | (self preferenceAt: key ifAbsent: [nil]) ifNotNil:
  [:pref | [pref preferenceValue: value preferenceValue] on: Error do: [ : err | "Ignore preferences which may not be supported anymore."]]].
  params keysAndValuesDo: [ :key :value | self setParameter: key to: value ].
  Smalltalk isMorphic
+ ifTrue: [ Project current world fillStyle: desktopColor ]
- ifTrue: [ World fillStyle: desktopColor ]
  ifFalse: [ self desktopColor: desktopColor. ScheduledControllers updateGray ]!

Item was changed:
  ----- Method: Preferences class>>mouseOverHalosChanged (in category 'updating - system') -----
  mouseOverHalosChanged
+ Project current world wantsMouseOverHalos: self mouseOverHalos!
- World wantsMouseOverHalos: self mouseOverHalos!

Item was changed:
  ----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') -----
  validateProjectNameIfOK: aBlock
 
  | details |
 
  details := world valueOfProperty: #ProjectDetails.
  details ifNotNil: ["ensure project info matches real project name"
  details at: 'projectname' put: self name.
  ].
  self doWeWantToRename ifFalse: [^ aBlock value: details].
  (Smalltalk at: #EToyProjectDetailsMorph) ifNotNil: [:etpdm |
  etpdm
  getFullInfoFor: self
  ifValid: [:d |
+ Project current world displayWorldSafely.
- World displayWorldSafely.
  aBlock value: d
  ]
  expandedFormat: false]
  !

Item was changed:
  ----- Method: ProjectLauncher>>hideSplashMorph (in category 'running') -----
  hideSplashMorph
  SplashMorph ifNil:[^self].
  self showSplash
  ifFalse: [^self].
  SplashMorph delete.
+ Project current world submorphs do:[:m| m visible: true]. "show all"
- World submorphs do:[:m| m visible: true]. "show all"
  !

Item was changed:
  ----- Method: ProjectLauncher>>prepareForLogin (in category 'eToy login') -----
  prepareForLogin
  "Prepare for login - e.g., hide everything so only the login morph is visible."
+ | world |
+ world := Project current world.
+ world submorphsDo:[:m|
- World submorphsDo:[:m|
  m isLocked ifFalse:[m hide]]. "hide all those guys"
+ world displayWorldSafely.
- World displayWorldSafely.
  !

Item was changed:
  ----- Method: ProjectLauncher>>proceedWithLogin (in category 'eToy login') -----
  proceedWithLogin
  eToyAuthentificationServer := nil.
+ Project current world submorphsDo:[:m| m show].
- World submorphsDo:[:m| m show].
  WorldState addDeferredUIMessage: [self startUpAfterLogin].!

Item was changed:
  ----- Method: ProjectLauncher>>showSplashMorph (in category 'running') -----
  showSplashMorph
+ | world |
  SplashMorph ifNil:[^self].
  self showSplash
  ifFalse: [^self].
+ world := Project current world.
+ world submorphs do:[:m| m visible: false]. "hide all"
+ world addMorphCentered: SplashMorph.
+ world displayWorldSafely.!
- World submorphs do:[:m| m visible: false]. "hide all"
- World addMorphCentered: SplashMorph.
- World displayWorldSafely.!

Item was changed:
  ----- Method: ResourceManager>>loadCachedResources (in category 'loading') -----
  loadCachedResources
  "Load all the resources that we have cached locally"
  self class reloadCachedResources.
  self prioritizedUnloadedResources do:[:loc|
  self class lookupCachedResource: loc urlString ifPresentDo:[:stream|
  | resource |
  resource := resourceMap at: loc ifAbsent:[nil].
  self installResource: resource
  from: stream
  locator: loc.
  (resource isForm) ifTrue:[
  self formChangedReminder value.
+ Project current world displayWorldSafely].
- World displayWorldSafely].
  ].
  ].!

Item was changed:
  ----- Method: SARInstaller>>fileInMCVersion:withBootstrap: (in category 'private') -----
  fileInMCVersion: member withBootstrap: mcBootstrap
  "This will use the MCBootstrapLoader to load a (non-compressed) Monticello file (.mc or .mcv)"
  | newCS |
  self class withCurrentChangeSetNamed: member localFileName
  do: [ :cs |
  newCS := cs.
  mcBootstrap loadStream: member contentStream ascii ].
 
  newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ].
 
+ Project current world doOneCycle.
- World doOneCycle.
 
  self installed: member.!

Item was changed:
  ----- Method: SARInstaller>>fileInMonticelloPackageNamed: (in category 'client services') -----
  fileInMonticelloPackageNamed: memberName
  "This is to be used from preamble/postscript code to file in zip
  members as Monticello packages (.mc)."
 
  | member file mcPackagePanel mcRevisionInfo mcSnapshot mcFilePackageManager mcPackage mcBootstrap newCS |
 
  mcPackagePanel := Smalltalk at: #MCPackagePanel ifAbsent: [ ].
  mcRevisionInfo := Smalltalk at: #MCRevisionInfo ifAbsent: [ ].
  mcSnapshot := Smalltalk at: #MCSnapshot ifAbsent: [ ].
  mcFilePackageManager := Smalltalk at: #MCFilePackageManager ifAbsent: [ ].
  mcPackage := Smalltalk at: #MCPackage ifAbsent: [ ].
  member := self memberNamed: memberName.
  member ifNil: [ ^self errorNoSuchMember: memberName ].
 
  "We are missing MCInstaller, Monticello and/or MonticelloCVS.
  If the bootstrap is present, use it. Otherwise interact with the user."
  ({ mcPackagePanel. mcRevisionInfo. mcSnapshot. mcFilePackageManager. mcPackage } includes: nil)
  ifTrue: [
  mcBootstrap := self getMCBootstrapLoaderClass.
  mcBootstrap ifNotNil: [ ^self fileInMCVersion: member withBootstrap: mcBootstrap ].
 
  (self confirm: ('Monticello support is not installed, but must be to load member named ', memberName, '.
  Load it from SqueakMap?'))
  ifTrue: [ self class loadMonticello; loadMonticelloCVS.
  ^self fileInMonticelloPackageNamed: memberName ]
  ifFalse: [ ^false ] ].
 
  member extractToFileNamed: member localFileName inDirectory: self directory.
  file := (Smalltalk at: #MCFile)
  name: member localFileName
  directory: self directory.
 
  self class withCurrentChangeSetNamed: file name do: [ :cs | | snapshot info |
  newCS := cs.
  file readStreamDo: [ :stream |
  info := mcRevisionInfo readFrom: stream nextChunk.
  snapshot := mcSnapshot fromStream: stream ].
  snapshot install.
  (mcFilePackageManager forPackage:
  (mcPackage named: info packageName))
  file: file
  ].
 
  newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ].
 
  mcPackagePanel allSubInstancesDo: [ :ea | ea refresh ].
+ Project current world doOneCycle.
- World doOneCycle.
 
  self installed: member.
  !

Item was changed:
  ----- Method: SARInstaller>>fileInMonticelloVersionNamed: (in category 'client services') -----
  fileInMonticelloVersionNamed: memberName
  "This is to be used from preamble/postscript code to file in zip
  members as Monticello version (.mcv) files."
 
  | member newCS mcMcvReader |
  mcMcvReader := Smalltalk at: #MCMcvReader ifAbsent: [].
  member := self memberNamed: memberName.
  member ifNil: [^self errorNoSuchMember: memberName].
 
  "If we don't have Monticello, offer to get it."
  mcMcvReader ifNil:  [
  (self confirm: 'Monticello is not installed, but must be to load member named ', memberName , '.
  Load it from SqueakMap?')
  ifTrue:  [ self class loadMonticello.
  ^self fileInMonticelloVersionNamed: memberName]
  ifFalse: [^false]].
 
  self class withCurrentChangeSetNamed: member localFileName
  do:
  [:cs |
  newCS := cs.
  (mcMcvReader versionFromStream: member contentStream ascii) load ].
  newCS isEmpty ifTrue: [ChangeSet removeChangeSet: newCS].
+ Project current world doOneCycle.
- World doOneCycle.
  self installed: member!

Item was changed:
  ----- Method: SARInstaller>>fileInMonticelloZipVersionNamed: (in category 'client services') -----
  fileInMonticelloZipVersionNamed: memberName
  "This is to be used from preamble/postscript code to file in zip
  members as Monticello version (.mcz) files."
 
  | member mczInstaller newCS mcMczReader |
  mcMczReader := Smalltalk at: #MCMczReader ifAbsent: [].
  mczInstaller := Smalltalk at: #MczInstaller ifAbsent: [].
  member := self memberNamed: memberName.
  member ifNil: [^self errorNoSuchMember: memberName].
 
  "If we don't have Monticello, but have the bootstrap, use it silently."
  mcMczReader ifNil:  [
  mczInstaller ifNotNil: [ ^mczInstaller installStream: member contentStream ].
  (self confirm: 'Monticello is not installed, but must be to load member named ', memberName , '.
  Load it from SqueakMap?')
  ifTrue:  [ self class loadMonticello.
  ^self fileInMonticelloZipVersionNamed: memberName]
  ifFalse: [^false]].
 
  self class withCurrentChangeSetNamed: member localFileName
  do:
  [:cs |
  newCS := cs.
  (mcMczReader versionFromStream: member contentStream) load ].
  newCS isEmpty ifTrue: [ChangeSet removeChangeSet: newCS].
+ Project current world doOneCycle.
- World doOneCycle.
  self installed: member!

Item was changed:
  ----- Method: SARInstaller>>fileInTrueTypeFontNamed: (in category 'client services') -----
  fileInTrueTypeFontNamed: memberOrName
 
  | member description |
  member := self memberNamed: memberOrName.
  member ifNil: [^self errorNoSuchMember: memberOrName].
 
  description := TTFontDescription addFromTTStream: member contentStream.
  TTCFont newTextStyleFromTT: description.
 
+ Project current world doOneCycle.
- World doOneCycle.
  self installed: member!

Item was changed:
  ----- Method: SmalltalkImage>>shrinkAndCleanDesktop (in category 'shrinking') -----
  shrinkAndCleanDesktop
+ | world |
+ world := Project current world.
+ world removeAllMorphs.
- World removeAllMorphs.
  self shrink.
  MorphicProject defaultFill: (Color gray: 0.9).
+ world color: (Color gray: 0.9)!
- World color: (Color gray: 0.9)!