The Trunk: Morphic-dtl.224.mcz

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

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

Name: Morphic-dtl.224
Author: dtl
Time: 9 November 2009, 9:05:46 am
UUID: 17310e17-0eba-47f0-8a65-56eded9e452d
Ancestors: Morphic-nice.223

Continue factoring Project into MVCProject and MorphicProject. Add method category 'enter' for methods associated with entering one project from another, including MVC-Morphic transition. Project>>enter: revert:saveForRevert: is significantly modified. Changes are in packages System, Morphic, and ST-80.

=============== Diff against Morphic-nice.223 ===============

Item was added:
+ ----- Method: MorphicProject>>finalEnterActions (in category 'enter') -----
+ finalEnterActions
+ "Perform the final actions necessary as the receiver project is entered"
+
+ | navigator armsLengthCmd navType thingsToUnhibernate fixBlock |
+
+ 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 anySatisfy:[:each|
+ each isMorph and:[each hasProperty: #needsLayoutFixed]])
+ ifTrue:[fixBlock := self displayFontProgress].
+ thingsToUnhibernate do: [:each | each unhibernate].
+ world removeProperty: #thingsToUnhibernate.
+
+ fixBlock ifNotNil:[
+ fixBlock value.
+ world fullRepaintNeeded.
+ ].
+
+ 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>>finalExitActions (in category 'enter') -----
+ finalExitActions
+
+ (world findA: ProjectNavigationMorph)
+ ifNotNilDo: [:navigator | navigator retractIfAppropriate]!

Item was added:
+ ----- 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]].
+ ^ Sensor cursorPoint "default result"!

Item was added:
+ ----- 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 ifPresentAndInMemory:
+ [:playerClass | playerClass allSubInstancesDo:
+ [:player | player pause]]]
+ !

Item was added:
+ ----- Method: MorphicProject>>assureNavigatorPresenceMatchesPreference (in category 'menu messages') -----
+ assureNavigatorPresenceMatchesPreference
+ "Make sure that the current project conforms to the presence/absence of the navigator"
+
+ | navigator navType wantIt |
+ wantIt :=  Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator].
+ navType := ProjectNavigationMorph preferredNavigator.
+ navigator := world findA: navType.
+ wantIt
+ ifFalse:
+ [navigator ifNotNil: [navigator delete]]
+ ifTrue:
+ [navigator isNil ifTrue:
+ [(navigator := navType new)
+ bottomLeft: world bottomLeft;
+ openInWorld: world]]!

Item was added:
+ ----- Method: MorphicProject>>scheduleProcessForEnter: (in category 'enter') -----
+ scheduleProcessForEnter: showZoom
+ "Complete the enter: by launching a new process"
+
+ self finalEnterActions.
+ world repairEmbeddedWorlds.
+ world triggerEvent: #aboutToEnterWorld.
+ Project spawnNewProcessAndTerminateOld: true
+ !

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: MorphicProject>>pauseEventRecorder (in category 'enter') -----
+ pauseEventRecorder
+ "Suspend any event recorder, and return it if found"
+
+ ^World pauseEventRecorder!

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

Item was added:
+ ----- Method: MorphicProject>>isIncompletelyLoaded (in category 'enter') -----
+ isIncompletelyLoaded
+ "Answer true if project is incomplete and should be loaded from server "
+
+ (world isKindOf: StringMorph)
+ ifTrue: [self inform: 'This project is not all here. I will try to load a complete version.' translated.
+ ^ true].
+ ^ false!

Item was added:
+ ----- Method: MorphicProject>>armsLengthCommand:withDescription: (in category 'file in/out') -----
+ armsLengthCommand: aCommand withDescription: aString
+ | tempProject foolingForm tempCanvas bbox crossHatchColor stride |
+ "Set things up so that this aCommand is sent to self as a message
+ after jumping to the parentProject.  For things that can't be executed
+ while in this project, such as saveAs, loadFromServer, storeOnServer.  See
+ ProjectViewMorph step."
+
+ world borderWidth: 0. "get rid of the silly default border"
+ tempProject := MorphicProject new.
+ foolingForm := world imageForm. "make them think they never left"
+ tempCanvas := foolingForm getCanvas.
+ bbox := foolingForm boundingBox.
+ crossHatchColor := Color yellow alpha: 0.3.
+ stride := 20.
+ 10 to: bbox width by: stride do: [ :x |
+ tempCanvas fillRectangle: (x@0 extent: 1@bbox height) fillStyle: crossHatchColor.
+ ].
+ 10 to: bbox height by: stride do: [ :y |
+ tempCanvas fillRectangle: (0@y extent: bbox width@1) fillStyle: crossHatchColor.
+ ].
+
+ tempProject world color: (InfiniteForm with: foolingForm).
+ tempProject projectParameters
+ at: #armsLengthCmd
+ put: (
+ DoCommandOnceMorph new
+ addText: aString;
+ actionBlock: [
+ self doArmsLengthCommand: aCommand.
+ ] fixTemps
+ ).
+ tempProject projectParameters
+ at: #deleteWhenEnteringNewProject
+ put: true.
+ tempProject enter
+ !

Item was added:
+ ----- Method: MorphicProject>>navigatorFlapVisible (in category 'flaps support') -----
+ navigatorFlapVisible
+ "Answer whether a Navigator flap is visible"
+
+ self flag: #toRemove. "unreferenced in image, check eToys"
+ ^ (Flaps sharedFlapsAllowed and:
+ [self flapsSuppressed not]) and:
+ [self isFlapIDEnabled: 'Navigator' translated]!