[Pkg] The Trunk: Morphic-dtl.224.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Nov 10 00:56:59 UTC 2009


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 at 0 extent: 1 at bbox height) fillStyle: crossHatchColor.
+ 	].
+ 	10 to: bbox height by: stride do: [ :y |
+ 		tempCanvas fillRectangle: (0 at y extent: bbox width at 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]!



More information about the Packages mailing list