'From etoys2.1 of 26 July 2007 [latest update: #1588] on 4 September 2007 at 2:22:35 pm'! "Change Set: noInteractionSaving Date: 4 September 2007 Author: Yoshiki Ohshima Add a way to save a project without any interaction. Also, remove the menu bar from the generated thumbnail."! !Project methodsFor: 'file in/out' stamp: 'yo 9/4/2007 12:16'! defaultFolderForAutoSaving ^ ServerDirectory servers at: SugarLauncher defaultDatastoreDirName ifAbsent: [^ FileDirectory default]. ! ! !Project methodsFor: 'file in/out' stamp: 'yo 9/4/2007 14:02'! exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction | exportChangeSet | "An experimental version to fileout a changeSet first so that a project can contain its own classes" self projectParameterAt: #eToysFont put: (Preferences standardEToysFont familySizeFace). "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it .extSeg. Player classes are included automatically." exportChangeSet _ nil. (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ noInteraction ifFalse: [ (self confirm: 'Would you like to include all the changes in the change set as part of this publishing operation?' translated) ifTrue: [ exportChangeSet _ changeSet ] ]. ]. Project publishInSexp ifTrue: [ ^ self exportSegmentInSexpWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction ]. ^ self exportSegmentWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction ! ! !Project methodsFor: 'file in/out' stamp: 'yo 9/4/2007 13:52'! exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction | fd sexp actualName | world ifNil: [^ false]. world presenter ifNil: [^ false]. Command initialize. world clearCommandHistory. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [ noInteraction ifTrue: [^ false]. self error: 'Still holding onto Global flaps']. fd _ aDirectory directoryNamed: self resourceDirectoryName. fd assureExistence. "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:[ sexp _ world sissScanObjectsAsEtoysProject. ]. (aFileName endsWith: '.pr') ifTrue: [ actualName _ (aFileName copyFrom: 1 to: aFileName size - 3), '.sexp'. ] ifFalse: [ actualName _ aFileName ]. self writeForExportInSexp: sexp withSources: actualName inDirectory: fd changeSet: aChangeSetOrNil. SecurityManager default signFile: actualName directory: fd. self storeHtmlPageIn: fd. self storeManifestFileIn: fd. self compressFilesIn: fd to: aFileName in: aDirectory. ^ true ! ! !Project methodsFor: 'file in/out' stamp: 'yo 9/4/2007 14:11'! exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction "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 .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 isMorph ifFalse: [ self projectParameters at: #isMVC put: true. ^ false]. "Only Morphic projects for now" 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: [ noInteraction ifTrue: [^ false]. 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 _ noInteraction ifTrue: [2] ifFalse: [(PopUpMenu labels: 'Do not write file Write file anyway Debug' translated) startUpWithCaption: str]. ans = 1 ifTrue: [ revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. collector replaceAll. ^ false]. ans = 3 ifTrue: [ collector replaceAll. self error: '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 ! ! !Project methodsFor: 'file in/out' stamp: 'yo 9/4/2007 14:17'! storeOnServerAssumingNameValid "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." world setProperty: #optimumExtentFromAuthor toValue: world extent. self isCurrentProject ifTrue: ["exit, then do the command" Flaps globalFlapTabsIfAny do: [:each | Flaps removeFlapTab: each keepInList: true]. ^ self armsLengthCommand: #storeOnServerAssumingNameValid withDescription: 'Publishing' translated ]. self storeOnServerWithProgressInfo. ! ! !Project methodsFor: 'file in/out' stamp: 'yo 9/4/2007 14:02'! storeOnServerInnards "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." | resp newName primaryServerDirectory serverVersionPair localDirectory localVersionPair myVersionNumber warning maxNumber suppliedPassword oldResourceUrl priorWorld myDepth | self assureIntegerVersion. "Find out what version" primaryServerDirectory _ self primaryServerIfNil: [ (primaryServerDirectory _ self findAFolderToStoreProjectIn) ifNil: [^self]. oldResourceUrl _ self resourceUrl. primaryServerDirectory == #localOnly ifTrue: [ self storeNewPrimaryURL: FileDirectory default url. nil ] ifFalse: [ self storeNewPrimaryURL: primaryServerDirectory downloadUrl. primaryServerDirectory ]. ]. localDirectory _ self squeakletDirectory. serverVersionPair _ self class mostRecent: self name onServer: primaryServerDirectory. localVersionPair _ self class mostRecent: self name onServer: localDirectory. maxNumber _ myVersionNumber _ self currentVersionNumber. ProgressNotification signal: '2:versionsDetected'. warning _ ''. myVersionNumber < serverVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) on the server' translated. maxNumber _ maxNumber max: serverVersionPair second. ]. myVersionNumber < localVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) in the local directory' translated. maxNumber _ maxNumber max: localVersionPair second. ]. "8 Nov 2000 - only check on the first attempt to publish" myVersionNumber = 0 ifTrue: [ warning isEmpty ifFalse: [ myVersionNumber = 0 ifTrue: [ warning _ warning,'\THIS PROJECT HAS NEVER BEEN SAVED' translated. ]. warning _ 'WARNING' translated, '\Project: ' translated, self name,warning. resp _ (PopUpMenu labels: 'Store anyway\Cancel' translated withCRs) startUpWithCaption: (warning, '\Please cancel, rename this project, and see what is there.' translated) withCRs. resp ~= 1 ifTrue: [^ nil] ]. ]. version _ self bumpVersion: maxNumber. oldResourceUrl ifNotNil: [self resourceManager adjustToNewServer: self resourceUrl from: oldResourceUrl]. "write locally - now zipped automatically" Display isVirtualScreen ifTrue: [ myDepth _ displayDepth. displayDepth _ DisplayScreen actualScreenDepth. ]. newName _ self versionedFileName. lastSavedAtSeconds _ Time totalSeconds. priorWorld _ ActiveWorld. self exportSegmentFileName: newName directory: localDirectory withoutInteraction: false. ActiveWorld _ priorWorld. (localDirectory readOnlyFileNamed: newName) setFileTypeToObject; close. Display isVirtualScreen ifTrue: [ displayDepth _ myDepth. ]. ProgressNotification signal: '4:localSaveComplete'. "3 is deep in export logic" primaryServerDirectory ifNotNil: [ suppliedPassword _ ''. Preferences passwordsOnPublish ifTrue: [ suppliedPassword _ FillInTheBlank requestPassword: 'Project password' translated ]. [ primaryServerDirectory writeProject: self inFileNamed: newName asFileName fromDirectory: localDirectory. ] on: ProjectPasswordNotification do: [ :ex | ex resume: (suppliedPassword ifNil: ['']) ]. ]. ProgressNotification signal: '9999 save complete'. "Later, store with same name on secondary servers. Still can be race conditions. All machines will go through the server list in the same order." "2 to: servers size do: [:aServer | aServer putFile: local named: newName]." ! ! !Project methodsFor: 'file in/out' stamp: 'yo 9/4/2007 14:16'! storeOnServerWithNoInteraction "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." | ret | world setProperty: #optimumExtentFromAuthor toValue: world extent. self isCurrentProject ifTrue: ["exit, then do the command" Flaps globalFlapTabsIfAny do: [:each | Flaps removeFlapTab: each keepInList: true]. ret _ self armsLengthCommand: #storeOnServerWithNoInteraction withDescription: 'Publishing' translated. ^ ret ]. [self storeOnServerWithNoInteractionInnards] on: Error do: [:ex | ^ false]. ^ true. ! ! !Project methodsFor: 'file in/out' stamp: 'yo 9/4/2007 14:03'! storeOnServerWithNoInteractionInnards "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." | newName primaryServerDirectory serverVersionPair localDirectory localVersionPair myVersionNumber warning maxNumber priorWorld myDepth | self assureIntegerVersion. "Find out what version" primaryServerDirectory _ self defaultFolderForAutoSaving ifNil: [^self]. localDirectory _ self squeakletDirectory. serverVersionPair _ self class mostRecent: self name onServer: primaryServerDirectory. localVersionPair _ self class mostRecent: self name onServer: localDirectory. maxNumber _ myVersionNumber _ self currentVersionNumber. ProgressNotification signal: '2:versionsDetected'. warning _ ''. myVersionNumber < serverVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) on the server' translated. maxNumber _ maxNumber max: serverVersionPair second. ]. myVersionNumber < localVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) in the local directory' translated. maxNumber _ maxNumber max: localVersionPair second. ]. version _ self bumpVersion: maxNumber. "write locally - now zipped automatically" Display isVirtualScreen ifTrue: [ myDepth _ displayDepth. displayDepth _ DisplayScreen actualScreenDepth. ]. newName _ self versionedFileName. lastSavedAtSeconds _ Time totalSeconds. priorWorld _ ActiveWorld. self exportSegmentFileName: newName directory: localDirectory withoutInteraction: true. ActiveWorld _ priorWorld. (localDirectory readOnlyFileNamed: newName) setFileTypeToObject; close. Display isVirtualScreen ifTrue: [ displayDepth _ myDepth. ]. ProgressNotification signal: '4:localSaveComplete'. "3 is deep in export logic" primaryServerDirectory ifNotNil: [ [ primaryServerDirectory writeProject: self inFileNamed: newName asFileName fromDirectory: localDirectory. ] on: ProjectPasswordNotification do: [ :ex | ex resume: '' ]. ]. ProgressNotification signal: '9999 save complete'. ! ! !SugarLauncher methodsFor: 'running' stamp: 'yo 9/4/2007 11:57'! startUp self class allInstances do: [:ea | ea shutDown]. Current := self. parameters at: 'ACTIVITY_ID' ifPresent: [ :activityId | process := [self runDBusService: 'org.laptop.Activity', activityId] forkAt: Processor userInterruptPriority named: 'Sugar DBus service'. ServerDirectory addServer: (SugarDatastoreDirectory mimetype: 'application/x-squeak-project' extension: '.pr') named: SugarLauncher defaultDatastoreDirName. parameters at: 'OBJECT_ID' ifPresent: [:id | ^self resumeJournalEntry: id]. self makeJournalEntry. ^self welcome: (parameters at: 'URI' ifAbsent: [''])]. parameters at: 'SUGARPIPE' ifPresent: [ :sugarPipe | ^process := [self fetchCommandsFrom: sugarPipe] forkAt: Processor userInterruptPriority named: 'Sugar Pipe handler']. self welcome: '' ! ! !SugarLauncher class methodsFor: 'utilities' stamp: 'yo 9/4/2007 11:56'! defaultDatastoreDirName ^ '[Projects in Journal]' ! ! Project removeSelector: #exportSegmentFileName:directory:! Project removeSelector: #exportSegmentInSexpWithChangeSet:fileName:directory:! Project removeSelector: #exportSegmentWithChangeSet:fileName:directory:!