The Trunk: Morphic-dtl.1370.mcz

Am 20.11.2017 22:04:15 schrieb David T. Lewis <[hidden email]>:

I would like to ask for a double-check on the change that I did here for
Morph>>delete, which is now:

Morph>>delete
"Remove the receiver as a submorph of its owner and make its
new owner be nil."

self removeHalo.

self isInWorld ifTrue: [
self disableSubmorphFocusForHand: self activeHand.
self activeHand
releaseKeyboardFocus: self;
releaseMouseFocus: self].

owner ifNotNil: [
self privateDelete.
self player ifNotNil: [:player |
self isInWorld ifTrue: [
player noteDeletionOf: self fromWorld: self world]]].


I think I have it right, but breaking Morph>>delete would be a very bad
thing to do, so I would appreciate a second set of eyes on it.

Thanks,
Dave



On Mon, Nov 20, 2017 at 08:57:35PM +0000, [hidden email] wrote:
> 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@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"!
>
>