[squeak-dev] The Trunk: Morphic-dtl.1370.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Nov 20 20:57:35 UTC 2017


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

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

Name: Morphic-dtl.1370
Author: dtl
Time: 20 November 2017, 3:57:16.432712 pm
UUID: c7def8b8-a7a4-4a98-8e18-f7781c42bfde
Ancestors: Morphic-dtl.1369

Remove remaining references to global World from package Morphic (not including extensions from other packages, e.g. Etoys).

Reorganize Morph>>delete to avoid dependence on global World, and call noteDeletionOf:fromWorld: only if the morph has a world (otherwise it must not be a costume, so the call is not required).

In finalEnterActions: and finalExitActions:, update World only if it is defined. This is to permit removal of the global for puposes of verifying that the system still works, but note that the intent is to retain the global definition both as a convenience and also for possible support of external packages that may contain references to well known globals.

=============== Diff against Morphic-dtl.1369 ===============

Item was changed:
  ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'as yet unclassified') -----
  backgroundWorldDisplay
  
+ 	| world |
  	self flag: #bob.		"really need a better way to do this"
  
  			"World displayWorldSafely."
  
  	"ugliness to try to track down a possible error"
  
+ 	world := Project current world.
+ 	[world displayWorld] ifError: [ :a :b |
- 
- 	[Project current world displayWorld] ifError: [ :a :b |
  		| f |
  		stageCompleted := 999.
  		f := FileDirectory default fileNamed: 'bob.errors'.
  		f nextPutAll: a printString,'  ',b printString; cr; cr.
+ 		f nextPutAll: 'worlds equal ',(formerWorld == world) printString; cr; cr.
- 		f nextPutAll: 'worlds equal ',(formerWorld == World) printString; cr; cr.
  		f nextPutAll: thisContext longStack; cr; cr.
  		f nextPutAll: formerProcess suspendedContext longStack; cr; cr.
  		f close. Beeper beep.
  	].
  !

Item was changed:
  ----- Method: ComplexProgressIndicator>>forkProgressWatcher (in category 'as yet unclassified') -----
  forkProgressWatcher
  
  	[
+ 	| currentWorld killTarget |
+ 		currentWorld := Project current world.
- 	| killTarget |
  		[stageCompleted < 999 and: 
  				[formerProject == Project current and: 
+ 				[formerWorld == currentWorld and: 
- 				[formerWorld == World and: 
  				[translucentMorph world notNil and:
  				[formerProcess suspendedContext notNil and: 
  				[Project uiProcess == formerProcess]]]]]] whileTrue: [
  
  			translucentMorph setProperty: #revealTimes toValue: 
  					{(Time millisecondClockValue - start max: 1). (estimate * newRatio max: 1)}.
  			translucentMorph changed.
  			translucentMorph owner addMorphInLayer: translucentMorph.
  			(Time millisecondClockValue - WorldState lastCycleTime) abs > 500 ifTrue: [
  				self backgroundWorldDisplay
  			].
  			(Delay forMilliseconds: 100) wait.
  		].
  		translucentMorph removeProperty: #revealTimes.
  		self loadingHistoryAt: 'total' add: (Time millisecondClockValue - start max: 1).
  		killTarget := targetMorph ifNotNil: [
  			targetMorph valueOfProperty: #deleteOnProgressCompletion
  		].
+ 		formerWorld == currentWorld ifTrue: [
- 		formerWorld == World ifTrue: [
  			translucentMorph delete.
  			killTarget ifNotNil: [killTarget delete].
  		] ifFalse: [
  			translucentMorph privateDeleteWithAbsolutelyNoSideEffects.
  			killTarget ifNotNil: [killTarget privateDeleteWithAbsolutelyNoSideEffects].
  		].
  	] forkAt: Processor lowIOPriority.!

Item was changed:
  ----- Method: ComplexProgressIndicator>>withProgressDo: (in category 'as yet unclassified') -----
  withProgressDo: aBlock
  
  	| safetyFactor totals trialRect delta targetOwner |
  
  	Smalltalk isMorphic ifFalse: [^aBlock value].
  	formerProject := Project current.
+ 	formerWorld := formerProject world.
- 	formerWorld := World.
  	formerProcess := Processor activeProcess.
  	targetMorph
  		ifNil: [targetMorph := ProgressTargetRequestNotification signal].
  	targetMorph ifNil: [
  		trialRect := Rectangle center: Sensor cursorPoint extent: 80 at 80.
  		delta := trialRect amountToTranslateWithin: formerWorld bounds.
  		trialRect := trialRect translateBy: delta.
  		translucentMorph := TranslucentProgessMorph new
  			opaqueBackgroundColor: Color white;
  			bounds: trialRect;
  			openInWorld: formerWorld.
  	] ifNotNil: [
  		targetOwner := targetMorph owner.
  		translucentMorph := TranslucentProgessMorph new
  			setProperty: #morphicLayerNumber toValue: targetMorph morphicLayerNumber - 0.1;
  			bounds: targetMorph boundsInWorld;
  			openInWorld: targetMorph world.
  	].
  	stageCompleted := 0.
  	safetyFactor := 1.1.	"better to guess high than low"
  	translucentMorph setProperty: #progressStageNumber toValue: 1.
  	translucentMorph hide.
  	targetOwner ifNotNil: [targetOwner hide].
  	totals := self loadingHistoryDataForKey: 'total'.
  	newRatio := 1.0.
  	estimate := totals size < 2 ifTrue: [
  		15000		"be a pessimist"
  	] ifFalse: [
  		(totals sum - totals max) / (totals size - 1 max: 1) * safetyFactor.
  	].
  	start := Time millisecondClockValue.
  	self forkProgressWatcher.
  
  	[
  		aBlock 
  			on: ProgressInitiationException
  			do: [ :ex | 
  				ex sendNotificationsTo: [ :min :max :curr |
  					"ignore this as it is inaccurate"
  				].
  			].
  	] on: ProgressNotification do: [ :note | | stageCompletedString |
  		translucentMorph show.
  		targetOwner ifNotNil: [targetOwner show].
  		note extraParam ifNotNil:[self addProgressDecoration: note extraParam].
  		stageCompletedString := (note messageText findTokens: ' ') first.
  		stageCompleted := (stageCompletedString copyUpTo: $:) asNumber.
  		cumulativeStageTime := Time millisecondClockValue - start max: 1.
  		prevData := self loadingHistoryDataForKey: stageCompletedString.
  		prevData isEmpty ifFalse: [
  			newRatio := (cumulativeStageTime / (prevData average max: 1)) asFloat.
  		].
  		self 
  			loadingHistoryAt: stageCompletedString 
  			add: cumulativeStageTime.
  		translucentMorph 
  			setProperty: #progressStageNumber 
  			toValue: stageCompleted + 1.
  		note resume.
  	].
  
  	stageCompleted := 999.	"we may or may not get here"
  
  !

Item was changed:
  ----- Method: FillInTheBlankMorph class>>requestPassword: (in category 'instance creation') -----
  requestPassword: queryString
  	"Create an instance of me whose question is queryString. Invoke it centered at the cursor, and answer the string the user accepts. Answer the empty string if the user cancels."
  	"use password font"
  	"FillInTheBlankMorph requestPassword: 'Password?'"
  
  	^ self
  		requestPassword: queryString
  		initialAnswer: ''
  		centerAt: Sensor cursorPoint
+ 		inWorld: Project current world
- 		inWorld: World
  		onCancelReturn: ''
  		acceptOnCR: true
  !

Item was changed:
  ----- Method: Morph>>delete (in category 'submorphs-add/remove') -----
  delete
  	"Remove the receiver as a submorph of its owner and make its 
  	new owner be nil."
  
- 	| aWorld |
  	self removeHalo.
  
  	self isInWorld ifTrue: [
  		self disableSubmorphFocusForHand: self activeHand.
  		self activeHand
  	  		releaseKeyboardFocus: self;
  			releaseMouseFocus: self].
  
+ 	owner ifNotNil: [
- 	"Preserve world reference for player notificaiton. See below."
- 	aWorld := self world ifNil: [World].
- 	
- 	owner ifNotNil:[
  		self privateDelete.
  		self player ifNotNil: [:player |
+ 			self isInWorld ifTrue: [
+ 				player noteDeletionOf: self fromWorld: self world]]].!
- 			player noteDeletionOf: self fromWorld: aWorld]].!

Item was added:
+ ----- Method: MorphicProject>>clearGlobalState (in category 'enter') -----
+ clearGlobalState
+ 	"Clean up global state. The global variables World, ActiveWorld, ActiveHand and ActiveEvent
+ 	provide convenient access to the state of the active project in Morphic. Clear their prior values
+ 	when leaving an active project. This method may be removed if the use of global state variables
+ 	is eliminated."
+ 
+ 	(Smalltalk at: #World ifAbsent: []) ifNotNil: [:w | w := nil]. "If global World is defined, clear it now"
+ 	ActiveWorld := ActiveHand := ActiveEvent := nil.
+ !

Item was changed:
  ----- Method: MorphicProject>>finalEnterActions: (in category 'enter') -----
  finalEnterActions: leavingProject
  	"Perform the final actions necessary as the receiver project is entered"
  
  	| navigator armsLengthCmd navType thingsToUnhibernate |
+ 	"If this image has a global World variable, update it now"
+ 	(Smalltalk at: #World ifAbsent: [])
+ 		ifNotNil: [:w | w := world].  "Signifies Morphic"
- 	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 changed:
  ----- 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].
+ 	self clearGlobalState.
- 
- 	"Clean-up global state."
- 	World := nil.
- 	ActiveWorld := ActiveHand := ActiveEvent := nil.
  	Sensor flushAllButDandDEvents. !

Item was changed:
  ----- Method: MorphicProject>>storeSegmentNoFile (in category 'file in/out') -----
  storeSegmentNoFile
  	"For testing.  Make an ImageSegment.  Keep the outPointers in memory.  Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)"
  
  	| is currentWorld |
  	currentWorld := Project current world.
  	(currentWorld == world) ifTrue: [^ self].		" inform: 'Can''t send the current world out'."
  	world isInMemory ifFalse: [^ self].  "already done"
  	world ifNil: [^ self].  world presenter ifNil: [^ self].
  
  	"Do this on project enter"
+ 	currentWorld flapTabs do: [:ft | ft referent adaptToWorld: currentWorld].
- 	currentWorld flapTabs do: [:ft | ft referent adaptToWorld: World].
  		"Hack to keep the Menu flap from pointing at my project"
  	"Preferences setPreference: #useGlobalFlaps toValue: false."
  	"Utilities globalFlapTabsIfAny do:
  		[:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: false].
  	Utilities clobberFlapTabList.	"
  	"project world deleteAllFlapArtifacts."
  	"self currentWorld deleteAllFlapArtifacts.	"
  	ScrapBook default emptyScrapBook.
  	currentWorld checkCurrentHandForObjectToPaste2.
  
  	is := ImageSegment
  			copyFromRootsLocalFileFor: {world presenter. world}	"world, and all Players"
  			sizeHint: 0.
  
  	is segment size < 800 ifTrue: ["debugging" 
  		Transcript show: self name, ' did not get enough objects'; cr.  ^ Beeper beep].
  
  	is extract.
  	"is instVarAt: 2 put: is segment clone."		"different memory"!



More information about the Squeak-dev mailing list