'From Squeakland.396-Nihongo7.29 of 18 March 2005 [latest update: #98] on 24 June 2005 at 11:31:15 am'!
"Change Set:		showProjectSaveError
Date:			12 June 2005
Author:			Takashi Yamamiya

Make sure showing pre-debugger if an error happens during project saving."!


!Project methodsFor: 'file in/out' stamp: 'tak 6/12/2005 14:56'!
doArmsLengthCommand: aCommand

	"We are no longer the active project, so do it"

	[self perform: aCommand]
		ensure: [self enter: #specialReturn.	"re-enter me and forget the temp project"]

! !

!Project methodsFor: 'file in/out' stamp: 'tak 6/12/2005 14:57'!
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 |
	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"
	newName _ self versionedFileName.
	lastSavedAtSeconds _ Time totalSeconds.
	priorWorld _ ActiveWorld.
	self exportSegmentFileName: newName directory: localDirectory.
	ActiveWorld _ priorWorld.
	(localDirectory readOnlyFileNamed: newName) setFileTypeToObject; close.
	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: 'tak 6/24/2005 11:30'!
writeFileNamed: localFileName fromDirectory: localDirectory toServer: primaryServerDirectory

	| local resp gifFileName f |

	local _ localDirectory oldFileNamed: localFileName.
	resp _ primaryServerDirectory upLoadProject: local named: localFileName resourceUrl: self resourceUrl retry: false.
	local close.
	resp == true ifFalse: [
		"abandon resources that would've been stored with the project"
		self resourceManager abandonResourcesThat:
			[:loc| loc urlString beginsWith: self resourceUrl].
		self error: 'the primary server of this project seems to be down (',
							resp printString,')'. 
		^ self
	].

	gifFileName _ self name,'.gif'.
	localDirectory deleteFileNamed: gifFileName ifAbsent: [].
	local _ localDirectory fileNamed: gifFileName.
	thumbnail ifNil: [
		(thumbnail _ Form extent: 100@80) fillColor: Color orange
	] ifNotNil: [
		thumbnail unhibernate.
	].
	f _ thumbnail colorReduced.  "minimize depth"
	f depth > 8 ifTrue: [
		f _ thumbnail asFormOfDepth: 8
	].
	GIFReadWriter putForm: f onStream: local.
	local close.

	[local _ StandardFileStream readOnlyFileNamed: (localDirectory fullNameFor: gifFileName).
	(primaryServerDirectory isKindOf: FileDirectory)
		ifTrue: [primaryServerDirectory deleteFileNamed: gifFileName ifAbsent: []].
	resp _ primaryServerDirectory putFile: local named: gifFileName retry: false.
	] on: Error do: [:ex |].
	local close.

	primaryServerDirectory updateProjectInfoFor: self.
	primaryServerDirectory sleep.	"if ftp, close the connection"
! !