The Trunk: Morphic-mt.1142.mcz

Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1142.mcz

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

Name: Morphic-mt.1142
Author: mt
Time: 9 May 2016, 1:42:29.674729 pm
UUID: 25a7ae8a-a714-2f47-9f51-683b0d4f13c4
Ancestors: Morphic-mt.1141

Update according to the projects refactoring in System-mt.827

=============== Diff against Morphic-mt.1141 ===============

Item was added:
+ ----- Method: MorphicProject class>>releaseProjectReferences: (in category 'utilities') -----
+ releaseProjectReferences: outgoingProject
+ "Iterate over all project-view morphs, wherever they may be located. Also consider image segments."
+
+ ImageSegment allSubInstancesDo: [:seg |
+ seg ifOutPointer: outgoingProject thenAllObjectsDo: [:obj |
+ (obj isKindOf: ProjectViewMorph) ifTrue: [
+ obj owner isSystemWindow
+ ifTrue: [obj owner model: nil; delete].
+ obj abandon]]].
+
+ ProjectViewMorph allSubInstancesDo: [:p |
+ p owner isSystemWindow ifTrue: [p owner model: nil; delete].
+ p project == outgoingProject ifTrue: [p abandon]].!

Item was added:
+ ----- Method: MorphicProject class>>unloadMorphic (in category 'shrinking') -----
+ unloadMorphic
+ "MorphicProject unloadMorphic"
+
+ Project current isMorphic ifTrue: [
+ ^ Error signal: 'You can only unload Morphic from within another kind of project.'].
+
+ MorphicProject removeProjectsFromSystem.
+
+ #(ActiveHand ActiveWorld ActiveEvent World) do: [:ea |
+ Smalltalk globals removeKey: ea].
+
+ { 'ToolBuilder-Morphic' . 'MorphicTests' . 'MorphicExtras' . 'Morphic' }
+ do: [ :package | (MCPackage named: package) unload ].
+
+ !

Item was added:
+ ----- Method: MorphicProject>>addProject: (in category 'subprojects') -----
+ addProject: project
+
+ | view |
+ super addProject: project.
+
+ view := Preferences projectViewsInWindows
+ ifTrue: [ProjectViewMorph newProjectViewInAWindowFor: project]
+ ifFalse: [ProjectViewMorph on: project].
+
+ "Do not use #openInWorld: because SystemWindow does things with real-estate manager, which depends on too much global state."
+ self world
+ addMorph: view;
+ startSteppingSubmorphsOf: view.!

Item was removed:
- ----- Method: MorphicProject>>defaultBackgroundColor (in category 'initialize') -----
- defaultBackgroundColor
- ^ Preferences uniformWindowColor!

Item was added:
+ ----- Method: MorphicProject>>deletingProject: (in category 'release') -----
+ deletingProject: outgoingProject
+
+ (self world submorphs
+ select: [:m | m isSystemWindow and: [m model == outgoingProject]]
+ thenCollect: [:window | window paneMorphs first])
+ do: [:projectViewMorph |
+ projectViewMorph owner "window" model: nil; delete.
+ projectViewMorph abandon].
+
+ super deletingProject: outgoingProject.!

Item was removed:
- ----- Method: MorphicProject>>displaySizeChanged (in category 'display') -----
- displaySizeChanged
- "Inform the current project that its display size has changed"
- world restoreMorphicDisplay.
- world repositionFlapsAfterScreenSizeChange.!

Item was removed:
- ----- Method: MorphicProject>>finalEnterActions (in category 'enter') -----
- finalEnterActions
- "Perform the final actions necessary as the receiver project is entered"
-
- | navigator armsLengthCmd navType thingsToUnhibernate |
-
- self initializeMenus.
- self projectParameters
- at: #projectsToBeDeleted
- ifPresent: [ :projectsToBeDeleted |
- self removeParameter: #projectsToBeDeleted.
- projectsToBeDeleted do: [ :each |
- Project deletingProject: each.
- each removeChangeSetIfPossible]].
-
- Locale switchAndInstallFontToID: self localeID.
-
- thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()].
- thingsToUnhibernate do: [:each | each unhibernate].
- world removeProperty: #thingsToUnhibernate.
-
- navType := ProjectNavigationMorph preferredNavigator.
- armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil].
- navigator := world findA: navType.
- (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue:
- [(navigator := navType new)
- bottomLeft: world bottomLeft;
- openInWorld: world].
- navigator notNil & armsLengthCmd notNil ifTrue:
- [navigator color: Color lightBlue].
- armsLengthCmd notNil ifTrue:
- [Preferences showFlapsWhenPublishing
- ifFalse:
- [self flapsSuppressed: true.
- navigator ifNotNil: [navigator visible: false]].
- armsLengthCmd openInWorld: world].
- world reformulateUpdatingMenus.
- world presenter positionStandardPlayer.
- self assureMainDockingBarPresenceMatchesPreference.
-
- WorldState addDeferredUIMessage: [self startResourceLoading].!

Item was added:
+ ----- Method: MorphicProject>>finalEnterActions: (in category 'enter') -----
+ finalEnterActions: leavingProject
+ "Perform the final actions necessary as the receiver project is entered"
+
+ | navigator armsLengthCmd navType thingsToUnhibernate |
+ World := world.  "Signifies Morphic"
+ world install.
+ world transferRemoteServerFrom: leavingProject world.
+ "(revertFlag | saveForRevert | forceRevert) ifFalse: [
+ (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [
+ self storeSomeSegment]]."
+
+ "Transfer event recorder to me."
+ leavingProject isMorphic ifTrue: [
+ leavingProject world pauseEventRecorder ifNotNil: [:rec |
+ rec resumeIn: world]].
+
+ world triggerOpeningScripts.
+
+
+ self initializeMenus.
+ self projectParameters
+ at: #projectsToBeDeleted
+ ifPresent: [ :projectsToBeDeleted |
+ self removeParameter: #projectsToBeDeleted.
+ projectsToBeDeleted do: [:each | each delete]].
+
+ Locale switchAndInstallFontToID: self localeID.
+
+ thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()].
+ thingsToUnhibernate do: [:each | each unhibernate].
+ world removeProperty: #thingsToUnhibernate.
+
+ navType := ProjectNavigationMorph preferredNavigator.
+ armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil].
+ navigator := world findA: navType.
+ (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue:
+ [(navigator := navType new)
+ bottomLeft: world bottomLeft;
+ openInWorld: world].
+ navigator notNil & armsLengthCmd notNil ifTrue:
+ [navigator color: Color lightBlue].
+ armsLengthCmd notNil ifTrue:
+ [Preferences showFlapsWhenPublishing
+ ifFalse:
+ [self flapsSuppressed: true.
+ navigator ifNotNil: [navigator visible: false]].
+ armsLengthCmd openInWorld: world].
+ world reformulateUpdatingMenus.
+ world presenter positionStandardPlayer.
+ self assureMainDockingBarPresenceMatchesPreference.
+
+ world repairEmbeddedWorlds.!

Item was removed:
- ----- Method: MorphicProject>>finalExitActions (in category 'enter') -----
- finalExitActions
-
- world sleep.
-
- (world findA: ProjectNavigationMorph)
- ifNotNil: [:navigator | navigator retractIfAppropriate].
-
- World := nil.
-
- ActiveWorld := ActiveHand := ActiveEvent := nil.
- Sensor flushAllButDandDEvents. "Will be reinstalled by World>>install"!

Item was added:
+ ----- Method: MorphicProject>>finalExitActions: (in category 'enter') -----
+ finalExitActions: enteringProject
+
+ world triggerClosingScripts.
+
+ "Pause sound players, subject to preference settings"
+ (world hasProperty: #letTheMusicPlay)
+ ifTrue: [world removeProperty: #letTheMusicPlay]
+ ifFalse: [SoundService stop].
+
+ world sleep.
+
+ (world findA: ProjectNavigationMorph)
+ ifNotNil: [:navigator | navigator retractIfAppropriate].
+
+ "Clean-up global state."
+ World := nil.
+ ActiveWorld := ActiveHand := ActiveEvent := nil.
+ Sensor flushAllButDandDEvents. !

Item was removed:
- ----- Method: MorphicProject>>handleFatalDrawingError: (in category 'utilities') -----
- handleFatalDrawingError: errMsg
- "Handle a fatal drawing error."
-
- Display deferUpdates: false. "Just in case"
- self primitiveError: errMsg
-
- "Hm... we should jump into a 'safe' worldState here, but how do we find it?!!"!

Item was changed:
  ----- Method: MorphicProject>>invalidate (in category 'display') -----
  invalidate
  "Invalidate the entire project so that a redraw will be forced later."
+ world restoreMorphicDisplay.!
- world fullRepaintNeeded.!

Item was added:
+ ----- Method: MorphicProject>>okToChange (in category 'release') -----
+ okToChange
+ "If the view is from somewhere else than the current project, just delete it."
+
+ ^ self parent ~~ Project current
+ or: [super okToChange]!

Item was removed:
- ----- Method: MorphicProject>>pauseEventRecorder (in category 'enter') -----
- pauseEventRecorder
- "Suspend any event recorder, and return it if found"
-
- ^ world pauseEventRecorder!

Item was removed:
- ----- Method: MorphicProject>>pauseSoundPlayers (in category 'enter') -----
- pauseSoundPlayers
- "Pause sound players, subject to preference settings"
-
- (world hasProperty: #letTheMusicPlay)
- ifTrue: [world removeProperty: #letTheMusicPlay]
- ifFalse: [Smalltalk at: #ScorePlayer ifPresent:
- [:playerClass | playerClass allSubInstancesDo:
- [:player | player pause]]]
- !

Item was removed:
- ----- Method: MorphicProject>>resetDisplay (in category 'display') -----
- resetDisplay
- "Bring the display to a usable state after handling primitiveError."
-
- world install "init hands and redisplay"!

Item was changed:
  ----- Method: MorphicProject>>restore (in category 'display') -----
  restore
+ "Display world safely. Catch all errors to avoid image freeze. We assume that the world will avoid drawing erroneous morphs twice"
+
+ | finished |
+ finished := false.
+
+ [finished] whileFalse: [
+ [world displayWorldSafely. finished := true]
+ on: Error do: [:err | world fullRepaintNeeded]].
- world fullDrawOn: Display getCanvas.
  !

Item was removed:
- ----- Method: MorphicProject>>restoreDisplay (in category 'display') -----
- restoreDisplay
- "Clear the screen to gray and then redisplay all the scheduled views."
-
- ^ world restoreMorphicDisplay
- !

Item was added:
+ ----- Method: MorphicProject>>resumeEventRecorder: (in category 'enter') -----
+ resumeEventRecorder: recorder
+
+ recorder ifNotNil: [:rec | rec resumeIn: world].!

Item was added:
+ ----- Method: MorphicProject>>scheduleProcessForEnter (in category 'enter') -----
+ scheduleProcessForEnter
+ "Complete the enter: by launching a new process"
+
+ self spawnNewProcess.!

Item was removed:
- ----- Method: MorphicProject>>scheduleProcessForEnter: (in category 'enter') -----
- scheduleProcessForEnter: showZoom
- "Complete the enter: by launching a new process"
-
- world repairEmbeddedWorlds.
- world triggerEvent: #aboutToEnterWorld.
- self spawnNewProcess.!

Item was removed:
- ----- Method: MorphicProject>>setWorldForEmergencyRecovery (in category 'enter') -----
- setWorldForEmergencyRecovery
- "Prepare world for enter with an absolute minimum of mechanism.
- An unrecoverable error has been detected in an isolated project."
-
- World := world.
- world install.
- world triggerOpeningScripts
- !

Item was removed:
- ----- Method: MorphicProject>>setWorldForEnterFrom:recorder: (in category 'enter') -----
- setWorldForEnterFrom: old recorder: recorderOrNil
- "Prepare world for enter."
-
- World := world.  "Signifies Morphic"
- world install.
- world transferRemoteServerFrom: old world.
- "(revertFlag | saveForRevert | forceRevert) ifFalse: [
- (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [
- self storeSomeSegment]]."
- recorderOrNil ifNotNil: [recorderOrNil resumeIn: world].
- world triggerOpeningScripts
- !

Item was changed:
+ ----- Method: MorphicProject>>subProjects (in category 'subprojects') -----
- ----- Method: MorphicProject>>subProjects (in category 'utilities') -----
  subProjects
  "Answer a list of all the subprojects  of the receiver. "
+
+ self flag: #fix. "mt: Collect other projects that have this as parent. See Project >> #allProjects"
  ^world submorphs
  select: [:m | (m isSystemWindow) and: [m model isKindOf: Project]]
  thenCollect: [:m | m model].!

Item was added:
+ ----- Method: MorphicProject>>suspendProcessForDebug (in category 'enter') -----
+ suspendProcessForDebug
+
+ | p |
+ self assert: Processor activeProcess == uiProcess.
+
+ p := uiProcess.
+ uiProcess := nil.
+ p suspend.!

Item was removed:
- ----- Method: MorphicProject>>triggerClosingScripts (in category 'enter') -----
- triggerClosingScripts
- "If any scripts must be run on closing, run them now"
-
- CurrentProject world triggerClosingScripts
- !

Item was changed:
  ----- Method: MorphicProject>>viewLocFor: (in category 'display') -----
  viewLocFor: exitedProject
  "Look for a view of the exitedProject, and return its center"
 
  world submorphsDo: [:v |
  (v isSystemWindow and: [v model == exitedProject])
  ifTrue: [^ v center]].
+ ^ super viewLocFor: exitedProject!
- ^ Sensor cursorPoint "default result"!

Item was removed:
- ----- Method: PasteUpMorph class>>shutDown (in category 'system startup') -----
- shutDown
-
- World ifNotNil:[
- World triggerEvent: #aboutToLeaveWorld.
- ].!

Item was removed:
- ----- Method: PasteUpMorph class>>startUp (in category 'system startup') -----
- startUp
-
- World ifNotNil:[
- World restoreMorphicDisplay.
- World triggerEvent: #aboutToEnterWorld.
- ].!

Item was changed:
  ----- Method: PasteUpMorph>>activeHand (in category 'structure') -----
  activeHand
 
+ ^ worldState
+ ifNotNil: [:ws | ws activeHand ifNil: [ws hands first]]
+ ifNil: [super activeHand]!
- ^ worldState ifNotNil: [worldState activeHand] ifNil: [super activeHand]!

Item was changed:
  ----- Method: PasteUpMorph>>install (in category 'world state') -----
  install
  owner := nil. "since we may have been inside another world previously"
  ActiveWorld := self.
  ActiveHand := self hands first. "default"
  ActiveEvent := nil.
  submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]].
  "Transcript that was in outPointers and then got deleted."
  self viewBox: Display boundingBox.
  Sensor flushAllButDandDEvents.
  worldState handsDo: [:h | h initForEvents].
  self installFlaps.
  self borderWidth: 0. "default"
  (Preferences showSecurityStatus
  and: [SecurityManager default isInRestrictedMode])
  ifTrue:
  [self
  borderWidth: 2;
  borderColor: Color red].
  self presenter allExtantPlayers do: [:player | player prepareToBeRunning].
+ SystemWindow noteTopWindowIn: self.!
- SystemWindow noteTopWindowIn: self.
- self displayWorldSafely!

Item was removed:
- ----- Method: PasteUpMorph>>restoreDisplay (in category 'world state') -----
- restoreDisplay
-
- World restoreMorphicDisplay. "I don't actually expect this to be called"!

Item was changed:
  ----- Method: PasteUpMorph>>restoreMorphicDisplay (in category 'world state') -----
  restoreMorphicDisplay
 
- DisplayScreen startUp.
-
  ThumbnailMorph recursionReset.
 
  self
  extent: Display extent;
  viewBox: Display boundingBox;
  handsDo: [:h | h visible: true; showTemporaryCursor: nil];
  restoreFlapsDisplay;
  restoreMainDockingBarDisplay;
  fullRepaintNeeded.
 
  WorldState
  addDeferredUIMessage: [Cursor normal show].
  !

Item was changed:
  ----- Method: Project class>>allMorphicProjects (in category '*Morphic-Support') -----
  allMorphicProjects
 
+ ^ self allProjects select: [:p | p isMorphic]!
- ^ self allProjects select: [:p | p world isMorph]!

Item was removed:
- ----- Method: ProjectViewMorph>>deletingProject: (in category 'events') -----
- deletingProject: aProject
- "My project is being deleted.  Delete me as well."
-
- self flag: #bob. "zapping projects"
-
-
- project == aProject ifTrue: [
- self owner isSystemWindow ifTrue: [self owner model: nil; delete].
- self delete].!

Item was changed:
  ----- Method: ProjectViewMorph>>ensureImageReady (in category 'drawing') -----
  ensureImageReady
 
  self isTheRealProjectPresent ifFalse: [^self].
  project thumbnail ifNil: [
  image fill: image boundingBox rule: Form over
+ fillColor: project color.
- fillColor: project defaultBackgroundColor.
  ^self
  ].
  project thumbnail ~~ lastProjectThumbnail ifTrue: ["scale thumbnail to fit my bounds"
  lastProjectThumbnail := project thumbnail.
  self updateImageFrom: lastProjectThumbnail.
  project thumbnail ifNotNil: [project thumbnail hibernate].
  image borderWidth: 1
  ].
 
 
  !

Item was changed:
  ----- Method: ProjectViewMorph>>expungeProject (in category 'as yet unclassified') -----
  expungeProject
+
  (self confirm: ('Do you really want to delete {1}
  and all its content?' translated format: {project name}))
  ifFalse: [^ self].
  owner isSystemWindow
  ifTrue: [owner model: nil;
  delete].
+
+ project delete.!
- ProjectHistory forget: project.
- Project deletingProject: project!

Item was changed:
  ----- Method: TheWorldMainDockingBar>>extrasMenuOn: (in category 'submenu - extras') -----
  extrasMenuOn: aDockingBar
 
  aDockingBar addItem: [ :it|
  it contents: 'Extras' translated;
  addSubMenu: [:menu|
  menu addItem:[:item|
  item
  contents: 'Recover Changes' translated;
  help: 'Recover changes after a crash' translated;
  icon: MenuIcons smallDocumentClockIcon;
  target: ChangeList;
  selector: #browseRecentLog].
  menu addLine.
  menu addItem:[:item|
  item
  contents: 'Window Colors' translated;
  help: 'Changes the window color scheme' translated;
  addSubMenu:[:submenu| self windowColorsOn: submenu]].
  menu addItem:[:item|
  item
  contents: 'Set Author Initials' translated;
  help: 'Sets the author initials' translated;
  icon: MenuIcons smallUserQuestionIcon;
  target: Utilities;
  selector: #setAuthorInitials].
  menu addItem:[:item|
  item
  contents: 'Restore Display (r)' translated;
  help: 'Redraws the entire display' translated;
+ target: Project current;
+ selector: #restoreDisplay].
- target: World;
- selector: #restoreMorphicDisplay].
  menu addItem:[:item|
  item
  contents: 'Rebuild Menus' translated;
  help: 'Rebuilds the menu bar' translated;
  target: TheWorldMainDockingBar;
  selector: #updateInstances].
  menu addLine.
  menu addItem:[:item|
  item
  contents: 'Start Profiler' translated;
  help: 'Starts the profiler' translated;
  icon: MenuIcons smallTimerIcon;
  target: self;
  selector: #startMessageTally].
  menu addItem:[:item|
  item
  contents: 'Collect Garbage' translated;
  help: 'Run the garbage collector and report space usage' translated;
  target: Utilities;
  selector: #garbageCollectAndReport].
  menu addItem:[:item|
  item
  contents: 'Purge Undo Records' translated;
  help: 'Save space by removing all the undo information remembered in all projects' translated;
  target: CommandHistory;
  selector: #resetAllHistory].
  menu addItem:[:item|
  item
  contents: 'VM statistics' translated;
  help: 'Virtual Machine information' translated;
  target: self;
  selector: #vmStatistics].
  menu addLine.
  menu addItem:[:item|
  item
  contents: 'Graphical Imports' translated;
  help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated;
  target: (Imports default);
  selector: #viewImages].
  menu addItem:[:item|
  item
  contents: 'Standard Graphics Library' translated;
  help: 'Lets you view and change the system''s standard library of graphics' translated;
  target: ScriptingSystem;
  selector: #inspectFormDictionary].
  menu addItem:[:item|
  item
  contents: 'Annotation Setup' translated;
  help: 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools' translated;
  target: Preferences;
  selector: #editAnnotations].
  menu addItem:[:item|
  item
  contents: 'Browse My Changes' translated;
  help: 'Browse all of my changes since the last time #condenseSources was run.' translated;
  target: SystemNavigation new;
  selector: #browseMyChanges].
  ] ]!

Item was changed:
  ----- Method: TheWorldMenu>>addRestoreDisplay: (in category 'construction') -----
  addRestoreDisplay: menu
  self
  fillIn: menu
  from: {
+ {'restore display (r)'. { Project current. #restoreDisplay }. 'repaint the screen -- useful for removing unwanted display artifacts, lingering cursors, etc.' }.
- {'restore display (r)'. { World. #restoreMorphicDisplay }. 'repaint the screen -- useful for removing unwanted display artifacts, lingering cursors, etc.' }.
  nil
  }!