[squeak-dev] The Trunk: Morphic-mt.1142.mczcommits at source.squeak.org commits at source.squeak.orgMon May 9 11:43:08 UTC 2016
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 }!
More information about the Squeak-dev mailing list |