The Trunk: Morphic-dtl.258.mcz

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

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

Name: Morphic-dtl.258
Author: dtl
Time: 29 November 2009, 7:23:21 am
UUID: a4165410-fe21-4742-8a12-42b2049b84bb
Ancestors: Morphic-ar.257

Remove all remaining explicit MVC and Morphic dependencies (hopefully) from class Project.

=============== Diff against Morphic-ar.257 ===============

Item was added:
+ ----- Method: MorphicProject>>currentStack (in category 'project parameters') -----
+ currentStack
+ "Answer the current stack of the current project.  Called basically as a bail-out when we can't find the stack in the owner chain of a morph, probably because it is on a background that is not currently installed.  This method will always return a stack that is in the world, or nil if no stack is found in the world.  Of course it would be nice to have multiple stacks concurrently open in the same world, but at the moment that is problematical."
+
+ | aStack curStack |
+
+ curStack := self projectParameterAt: #CurrentStack.
+ curStack ifNotNil: [curStack isInWorld ifTrue: [^ curStack]].
+
+ (aStack := world findA: StackMorph) ifNotNil:
+ [self currentStack: aStack].
+ ^ aStack!

Item was added:
+ ----- Method: MorphicProject>>loadFromServer: (in category 'file in/out') -----
+ loadFromServer: newerAutomatically
+ "If a newer version of me is on the server, load it."
+ | pair resp server |
+ self assureIntegerVersion.
+
+ self isCurrentProject ifTrue: ["exit, then do the command"
+ ^ self armsLengthCommand: #loadFromServer withDescription: 'Loading' translated
+ ].
+ server := self tryToFindAServerWithMe ifNil: [^ nil].
+ pair := self class mostRecent: self name onServer: server.
+ pair first ifNil: [^ self inform: ('can''t find file on server for {1}' translated format: {self name})].
+ self currentVersionNumber > pair second ifTrue: [
+ ^ self inform: ('That server has an older version of the project.' translated)].
+ version = (Project parseProjectFileName: pair first) second ifTrue: [
+ resp := (UIManager default chooseFrom:
+ (Array with: 'Reload anyway' translated
+ with: 'Cancel' translated withCRs)
+ title:  'The only changes are the ones you made here.' translated).
+ resp ~= 1 ifTrue: [^ nil]
+ ] ifFalse: [
+ newerAutomatically ifFalse: [
+ resp := (UIManager default
+ chooseFrom: #('Load it' 'Cancel')
+ title:  'A newer version exists on the server.').
+ resp ~= 1 ifTrue: [^ nil]
+ ].
+ ].
+
+ "let's avoid renaming the loaded change set since it will be replacing ours"
+ self projectParameters at: #loadingNewerVersion put: true.
+
+ ComplexProgressIndicator new
+ targetMorph: nil;
+ historyCategory: 'project loading';
+ withProgressDo: [
+ ProjectLoading
+ installRemoteNamed: pair first
+ from: server
+ named: self name
+ in: parentProject
+ ]
+ !

Item was added:
+ ----- Method: MorphicProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category 'file in/out') -----
+ exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory
+ "Store my project out on the disk as an *exported* ImageSegment.  All outPointers will be in a form that can be resolved in the target image.  Name it <project name>.extSeg.  What do we do about subProjects, especially if they are out as local image segments?  Force them to come in?
+ Player classes are included automatically."
+
+ | is str ans revertSeg roots holder |
+ self flag: #toRemove.
+ self halt.  "unused"
+ "world == World ifTrue: [^ false]."
+ "self inform: 'Can''t send the current world out'."
+ world ifNil: [^ false].  world presenter ifNil: [^ false].
+
+ Utilities emptyScrapsBook.
+ world currentHand pasteBuffer: nil.  "don't write the paste buffer."
+ world currentHand mouseOverHandler initialize.  "forget about any references here"
+ "Display checkCurrentHandForObjectToPaste."
+ Command initialize.
+ world clearCommandHistory.
+ world fullReleaseCachedState; releaseViewers.
+ world cleanseStepList.
+ world localFlapTabs size = world flapTabs size ifFalse: [
+ self error: 'Still holding onto Global flaps'].
+ world releaseSqueakPages.
+ ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false]).
+ holder := Project allProjects. "force them in to outPointers, where DiskProxys are made"
+
+ "Just export me, not my previous version"
+ revertSeg := self projectParameters at: #revertToMe ifAbsent: [nil].
+ self projectParameters removeKey: #revertToMe ifAbsent: [].
+
+ roots := OrderedCollection new.
+ roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail.
+ roots add: world activeHand; addAll: classList; addAll: (classList collect: [:cls | cls class]).
+
+ roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail"
+
+ catList do: [:sysCat |
+ (SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb |
+ roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]].
+
+ is := ImageSegment new copySmartRootsExport: roots asArray.
+ "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"
+
+ is state = #tooBig ifTrue: [^ false].
+
+ str := ''.
+ "considered legal to save a project that has never been entered"
+ (is outPointers includes: world) ifTrue: [
+ str := str, '\Project''s own world is not in the segment.' withCRs].
+ str isEmpty ifFalse: [
+ ans := (UIManager default
+ chooseFrom: #('Do not write file' 'Write file anyway' 'Debug')
+ title: str).
+ ans = 1 ifTrue: [
+ revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
+ ^ false].
+ ans = 3 ifTrue: [self halt: 'Segment not written']].
+
+ is writeForExportWithSources: aFileName inDirectory: aDirectory.
+ revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
+ holder.
+ world flapTabs do: [:ft |
+ (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
+ is arrayOfRoots do: [:obj |
+ obj class == ScriptEditorMorph ifTrue: [obj unhibernate]].
+ ^ true
+ !

Item was added:
+ ----- Method: MorphicProject>>storeOnServerWithProgressInfoOn: (in category 'file in/out') -----
+ storeOnServerWithProgressInfoOn: aMorphOrNil
+
+ "Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."
+
+ ComplexProgressIndicator new
+ targetMorph: aMorphOrNil;
+ historyCategory: 'project storing';
+ withProgressDo: [self storeOnServerInnards]
+ !

Item was added:
+ ----- Method: MorphicProject>>setPaletteFor: (in category 'language') -----
+ setPaletteFor: aLanguageSymbol
+ | prototype formKey form |
+
+ self flag: #toRemove. "check if this method still used by Etoys"
+ prototype := PaintBoxMorph prototype.
+ formKey := ('offPalette' , aLanguageSymbol) asSymbol.
+ form := Imports default imports
+ at: formKey
+ ifAbsent: [Imports default imports
+ at: #offPaletteEnglish
+ ifAbsent: []].
+ form isNil ifFalse: [prototype loadOffForm: form].
+ formKey := ('pressedPalette' , aLanguageSymbol) asSymbol.
+ form := Imports default imports
+ at: formKey
+ ifAbsent: [Imports default imports
+ at: #pressedPaletteEnglish
+ ifAbsent: []].
+ form isNil ifFalse: [prototype loadPressedForm: form].
+ !

Item was added:
+ ----- 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 str |
+ (World == 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"
+ World 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. "
+ Utilities emptyScrapsBook.
+ World checkCurrentHandForObjectToPaste2.
+
+ is := ImageSegment new copyFromRootsLocalFileFor:
+ (Array with: world presenter with: 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].
+ false ifTrue: [
+ str := String streamContents: [:strm |
+ strm nextPutAll: 'Only a tiny part of the project got into the segment'.
+ strm nextPutAll: '\These are pointed to from the outside:' withCRs.
+ is outPointers do: [:out |
+ (out class == Presenter) | (out class == ScriptEditorMorph) ifTrue: [
+ strm cr. out printOn: strm.
+ self systemNavigation
+ browseAllObjectReferencesTo: out
+ except: (Array with: is outPointers)
+ ifNone: [:obj | ]].
+ (is arrayOfRoots includes: out class) ifTrue: [strm cr. out printOn: strm.
+ self systemNavigation
+ browseAllObjectReferencesTo: out
+ except: (Array with: is outPointers)
+ ifNone: [:obj | ]]]].
+ self inform: str.
+ ^ is inspect].
+
+ is extract.
+ "is instVarAt: 2 put: is segment clone." "different memory"
+ !

Item was added:
+ ----- Method: MorphicProject>>storeSegment (in category 'file in/out') -----
+ storeSegment
+ "Store my project out on the disk as an ImageSegment.  Keep the outPointers in memory.  Name it <project name>.seg.  *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***"
+
+ | is sizeHint |
+ (World == world) ifTrue: [^ false].
+ "self inform: 'Can''t send the current world out'."
+ world isInMemory ifFalse: [^ false].  "already done"
+ world ifNil: [^ false].  world presenter ifNil: [^ false].
+
+ Utilities emptyScrapsBook.
+ World checkCurrentHandForObjectToPaste.
+ world releaseSqueakPages.
+ sizeHint := self projectParameters at: #segmentSize ifAbsent: [0].
+
+ is := ImageSegment new copyFromRootsLocalFileFor:
+ (Array with: world presenter with: world) "world, and all Players"
+ sizeHint: sizeHint.
+
+ is state = #tooBig ifTrue: [^ false].
+ is segment size < 2000 ifTrue: ["debugging"
+ Transcript show: self name, ' only ', is segment size printString,
+ 'bytes in Segment.'; cr].
+ self projectParameters at: #segmentSize put: is segment size.
+ is extract; writeToFile: self name.
+ ^ true
+ !

Item was added:
+ ----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') -----
+ exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName
+ directory: aDirectory
+ "Store my project out on the disk as an *exported*
+ ImageSegment.  All outPointers will be in a form that can be resolved
+ in the target image.  Name it <project name>.extSeg.  Whatdo we do
+ about subProjects, especially if they are out as local image
+ segments?  Force them to come in?
+ Player classes are included automatically."
+
+ | is str ans revertSeg roots holder collector fd mgr stacks |
+
+ "Files out a changeSet first, so that a project can contain
+ its own classes"
+ world ifNil: [^ false].  world presenter ifNil: [^ false].
+
+ Utilities emptyScrapsBook.
+ world currentHand pasteBuffer: nil.  "don't write the paste buffer."
+ world currentHand mouseOverHandler initialize.  "forget about any
+ references here"
+ "Display checkCurrentHandForObjectToPaste."
+ Command initialize.
+ world clearCommandHistory.
+ world fullReleaseCachedState; releaseViewers.
+ world cleanseStepList.
+ world localFlapTabs size = world flapTabs size ifFalse: [
+ self error: 'Still holding onto Global flaps'].
+ world releaseSqueakPages.
+ ScriptEditorMorph writingUniversalTiles: (self projectParameterAt:
+ #universalTiles ifAbsent: [false]).
+ holder := Project allProjects. "force them in to outPointers, where
+ DiskProxys are made"
+
+ "Just export me, not my previous version"
+ revertSeg := self projectParameters at: #revertToMe ifAbsent: [nil].
+ self projectParameters removeKey: #revertToMe ifAbsent: [].
+
+ roots := OrderedCollection new.
+ roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail.
+ roots add: world activeHand.
+
+ "; addAll: classList; addAll: (classList collect: [:cls | cls class])"
+
+ roots := roots reject: [ :x | x isNil]. "early saves may not have
+ active hand or thumbnail"
+
+ fd := aDirectory directoryNamed: self resourceDirectoryName.
+ fd assureExistence.
+ "Clean up resource references before writing out"
+ mgr := self resourceManager.
+ self resourceManager: nil.
+ ResourceCollector current: ResourceCollector new.
+ ResourceCollector current localDirectory: fd.
+ ResourceCollector current baseUrl: self resourceUrl.
+ ResourceCollector current initializeFrom: mgr.
+ ProgressNotification signal: '2:findingResources' extra:
+ '(collecting resources...)' translated.
+ "Must activate old world because this is run at #armsLength.
+ Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
+ will not be captured correctly if referenced from blocks or user code."
+ world becomeActiveDuring:[
+ is := ImageSegment new copySmartRootsExport: roots asArray.
+ "old way was (is := ImageSegment new
+ copyFromRootsForExport: roots asArray)"
+ ].
+ self resourceManager: mgr.
+ collector := ResourceCollector current.
+ ResourceCollector current: nil.
+ ProgressNotification signal: '2:foundResources' extra: ''.
+ is state = #tooBig ifTrue: [
+ collector replaceAll.
+ ^ false].
+
+ str := ''.
+ "considered legal to save a project that has never been entered"
+ (is outPointers includes: world) ifTrue: [
+ str := str, '\Project''s own world is not in the segment.' translated withCRs].
+ str isEmpty ifFalse: [
+ ans := UIManager default chooseFrom: {
+ 'Do not write file' translated.
+ 'Write file anyway' translated.
+ 'Debug' translated.
+ } title: str.
+ ans = 1 ifTrue: [
+ revertSeg ifNotNil: [projectParameters at:
+ #revertToMe put: revertSeg].
+ collector replaceAll.
+ ^ false].
+ ans = 3 ifTrue: [
+ collector replaceAll.
+ self halt: 'Segment not written' translated]].
+ stacks := is findStacks.
+
+ is
+ writeForExportWithSources: aFileName
+ inDirectory: fd
+ changeSet: aChangeSetOrNil.
+ SecurityManager default signFile: aFileName directory: fd.
+ "Compress all files and update check sums"
+ collector forgetObsolete.
+ self storeResourceList: collector in: fd.
+ self storeHtmlPageIn: fd.
+ self storeManifestFileIn: fd.
+ self writeStackText: stacks in: fd registerIn: collector.
+ "local proj.005.myStack.t"
+ self compressFilesIn: fd to: aFileName in: aDirectory
+ resources: collector.
+ "also deletes the resource directory"
+ "Now update everything that we know about"
+ mgr updateResourcesFrom: collector.
+
+ revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
+ holder.
+
+ collector replaceAll.
+
+ world flapTabs do: [:ft |
+ (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
+ is arrayOfRoots do: [:obj |
+ obj class == ScriptEditorMorph ifTrue: [obj unhibernate]].
+ ^ true
+ !

Item was added:
+ ----- Method: MorphicProject>>chooseNaturalLanguage (in category 'language') -----
+ chooseNaturalLanguage
+ "Put up a menu allowing the user to choose the natural language for the project"
+
+ | aMenu availableLanguages |
+ aMenu := MenuMorph new defaultTarget: self.
+ aMenu addTitle: 'choose language' translated.
+ aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed.  It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system.  Each project has its own private language choice' translated.
+ Preferences noviceMode
+ ifFalse:[aMenu addStayUpItem].
+
+ availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs
+ asSortedCollection:[:x :y | x displayName < y displayName].
+
+ availableLanguages do:
+ [:localeID |
+ aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector:  #switchAndInstallFontToID: argumentList: {localeID}].
+ aMenu popUpInWorld
+
+ "Project current chooseNaturalLanguage"!

Item was added:
+ ----- Method: MorphicProject>>storeOnServerWithProgressInfo (in category 'file in/out') -----
+ storeOnServerWithProgressInfo
+
+ "Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."
+
+ ComplexProgressIndicator new
+ targetMorph: nil;
+ historyCategory: 'project storing';
+ withProgressDo: [self storeOnServerInnards]
+ !