'From etoys4.0 of 9 October 2008 [latest update: #2266] on 8 September 2009 at 1:49:23 pm'!
"Change Set:		ProjectDAV-yo
Date:			8 September 2009
Author:			Yoshiki Ohshima

A stub for adding webdav in the dialog."!

DAVServerDirectory subclass: #DAVMultiUserServerDirectory
	instanceVariableNames: 'setupSelector useDefaultAccount loggedIn'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DAVServerDirectory'!
FileList subclass: #FileList2
	instanceVariableNames: 'showDirsInFileList currentDirectorySelected fileSelectionBlock dirSelectionBlock optionalButtonSpecs modalView directoryChangeBlock ok triedLogin '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-FileList'!
ProjectLoading class
	instanceVariableNames: 'worldLoading '!

!DAVClient methodsFor: 'public protocol' stamp: 'yo 8/3/2009 19:37'!
quit

	self close.
! !

!DAVClient methodsFor: 'private protocol' stamp: 'yo 8/6/2009 15:50'!
isRetryNeeded
	self lastResponse isEmpty
		ifTrue: [self error: 'no content'.
			^ true].
	((lastHeader includesKey: 'connection')
			and: [(lastHeader at: 'connection')
					= 'close'])
		ifTrue: [self close.
			self ensureConnection].
	self lastResponseCode first = $2
		ifTrue: [^ false].
	self lastResponseCode = '401'
		ifTrue: [self askNamePasswordIfNecessary.
			self password isEmptyOrNil ifTrue: [^false].
			^ (HTTPLoginFailedException protocolInstance: self)
				signal: self lastResponse].
	(self lastResponseCode first = $3
			and: [lastHeader includesKey: 'location'])
		ifTrue: [self openUrl: (lastHeader at: 'location') asUrl.
			^ true].
	self lastResponseCode first = $5
		ifTrue: [self inform: ('An Internal Server Error Occured ({1})' translated format: {self lastResponseCode printString}).
			^ true].
	(ProtocolClientError protocolInstance: self)
		signal: self lastResponse.
	^ false! !

!DAVClient methodsFor: 'private protocol' stamp: 'yo 11/17/2006 15:31'!
method: method header: aDictionary body: aStringOrByteArray 
	"(self openUrl: 'http://localhost:8080/svn/' asUrl) method: 'GET' header: Dictionary new body: ''"
	| body |
	self askNamePasswordIfNecessary.
	[self
		sendRequest: method
		header: aDictionary
		body: aStringOrByteArray.
	body := self receiveResponse.
	self isRetryNeeded] whileTrue.
	^ body! !

!DAVClient methodsFor: 'private' stamp: 'yo 8/6/2009 18:15'!
askName

	self user: (FillInTheBlankMorph
					request: 'User account name?'
					initialAnswer: (self user ifNil: [''])
					onCancelReturn: nil).
	Utilities authorName: self user.
! !

!DAVClient methodsFor: 'private' stamp: 'yo 8/6/2009 18:16'!
askNamePassword

	self askName.
	self askPassword.
! !

!DAVClient methodsFor: 'private' stamp: 'yo 8/6/2009 19:44'!
askNamePasswordIfNecessary
	lastHeader ifNil: [^ true].
	(self user isNil or: [self password isNil]) ifFalse: [^ true].
	self askNamePassword.
! !

!DAVClient methodsFor: 'private' stamp: 'yo 8/6/2009 18:16'!
askPassword

	self password: (FillInTheBlank  requestPassword: 'Password?').
	^ true! !


!DAVServerDirectory methodsFor: 'file directory' stamp: 'yo 8/6/2009 20:12'!
createDirectory: localName 
	| url |
	url := ('http://', self server , '/' , self directory , '/' , localName) asUrl.
	self setUserAndPassIn: url.
	DAVClient openUrl: url while: [ :c | c mkcol]! !

!DAVServerDirectory methodsFor: 'file directory' stamp: 'yo 8/6/2009 20:12'!
deleteDirectory: fullName 
	| url |
	url := (self server , '/' , self directory , '/' , fullName , '/') asUrl.
	self setUserAndPassIn: url.
	DAVClient openUrl: url while: [ :c | c delete]! !

!DAVServerDirectory methodsFor: 'file directory' stamp: 'yo 8/6/2009 20:12'!
deleteFileNamed: fullName 
	| url |
	url := (self server , '/' , self directory , '/' , fullName) asUrl.
	self setUserAndPassIn: url.
	DAVClient openUrl: url while: [ :c | c delete]! !

!DAVServerDirectory methodsFor: 'file directory' stamp: 'yo 8/6/2009 21:30'!
entries
	"EntryCache -- a collection of {time. url. directory index}"
	| url now newCache found newEntry aUrl |
	url := (aUrl := self asUrl) toText.
	now := Time totalSeconds.
	"Last time should be 'now' +- 3 seconds. +3 is needed if this image move
	to another time zone."
	newCache := self class entryCache
				select: [:each | now - 3 < each first
						and: [each first < (now + 3)]].
	found := newCache
				detect: [:each | each second = url]
				ifNone: [].
	found
		ifNotNil: [^ found third].
	newEntry := self privateEntriesFor: aUrl.
	newCache add: {now. url. newEntry}.
	self class entryCache: newCache.
	^ newEntry! !

!DAVServerDirectory methodsFor: 'file directory' stamp: 'yo 8/6/2009 20:12'!
oldFileNamed: aName 
	| contents aUrl |
	aUrl :=  (self altUrl , '/' , aName) asUrl.
	self setUserAndPassIn: aUrl.
	contents := DAVClient
				openUrl: aUrl
				while: [:c | c get].
	^ (SwikiPseudoFileStream with: contents) reset; directory: self; localName: aName; yourself! !

!DAVServerDirectory methodsFor: 'file directory' stamp: 'yo 8/6/2009 20:12'!
putFile: fileStream named: fileNameOnServer 
	| fullURL dir |
	dir := self directory first = $/ ifTrue: [self directory allButFirst] ifFalse: [self directory].
	fullURL _ (self server , '/' , dir , '/' , fileNameOnServer encodeForHTTP) asUrl.
	self setUserAndPassIn: fullURL.
	fileStream binary.
	DAVClient openUrl: fullURL while: [ :c | c put: fileStream contents]
! !

!DAVServerDirectory methodsFor: 'svn protocol private' stamp: 'yo 8/6/2009 20:12'!
pathForRevision: aNumber forFileNamed: fullName 
	| location aUrl |
	location := (self asUrl newFromRelativeText: fullName) toText.
	aUrl _ location asUrl.
	self setUserAndPassIn: aUrl.
	DAVClient
		openUrl: aUrl
		while: [:connection | ^ self
				pathForClient: connection
				revision: aNumber
				forFileNamed: fullName]! !

!DAVServerDirectory methodsFor: 'svn protocol private' stamp: 'yo 8/6/2009 20:13'!
revisionsForFileNamed: fullName 
	| location newest aUrl |
	location _ (self asUrl newFromRelativeText: fullName) toText.
	newest _ self newestVersionForFileNamed: location.
	newest
		ifNil: [^ ''].
	aUrl := location asUrl.
	self setUserAndPassIn: aUrl.
	^ DAVClient
		openUrl: aUrl
		while: [:c | c
				logReportFrom: newest
				to: 1
				depth: 0]! !

!DAVServerDirectory methodsFor: 'private' stamp: 'yo 8/6/2009 20:11'!
setUserAndPassIn: aUrl

	aUrl username: self user.
	aUrl password: self password.
! !

!DAVServerDirectory methodsFor: 'accessing' stamp: 'yo 8/6/2009 20:14'!
asUrl
	| newUrl |
	newUrl _ ('http://' , self server , '/' , self directory, '/') asUrl.
	self setUserAndPassIn: newUrl.
	^ newUrl.
! !

!DAVServerDirectory methodsFor: 'property access' stamp: 'yo 9/8/2009 10:56'!
parsePropertyResponse: response 
	"Answer a DirectoryEntry made from response xml"
	| childName directoryString propStats aDictionary mtime value dirFlag fileSize contentString unescaped |
	directoryString := self directory.
	directoryString first = $/
		ifFalse: [directoryString := '/' , directoryString].
	directoryString last = $/
		ifFalse: [directoryString := directoryString , '/'].

	contentString := (response elementUnqualifiedAt: 'href') contentString.
	unescaped := directoryString unescapePercents.
	contentString size < unescaped size
		ifTrue: [childName := '']
		ifFalse: [childName := contentString allButFirst: unescaped size].
	(childName isEmpty not
			and: [childName last = $/])
		ifTrue: [childName := childName allButLast].
	childName.
	propStats := response elements
				select: [:e | e localName = 'propstat'].
	aDictionary := Dictionary new.
	propStats
		do: [:propStat | (propStat elementUnqualifiedAt: 'prop') ifNotNilDo: [:x | x  elements
				do: [:propElement | 
					value := propElement elements isEmpty
								ifTrue: [propElement contentString]
								ifFalse: [propElement elements first localName].
					aDictionary at: propElement localName put: value]]].
	mtime := fileSize := 0.
	dirFlag := false.
	mtime := aDictionary
				at: #getlastmodified
				ifPresent: [:v | (TimeStamp
						fromString: (v allButFirst: 5)) asSeconds].
	dirFlag := aDictionary
				at: #resourcetype
				ifPresent: [:v | v = #collection].
	fileSize := aDictionary
				at: #getcontentlength
				ifPresent: [:v | v asNumber].
	^ DirectoryEntry
		name: childName unescapePercents
		creationTime: 0
		modificationTime: mtime
		isDirectory: dirFlag
		fileSize: fileSize! !

!DAVServerDirectory methodsFor: 'property access' stamp: 'yo 8/6/2009 20:12'!
privateEntries
	| location ret aUrl |
	location := 'http://' , self server , '/' , self directory , '/'.
	aUrl := location asUrl.
	self setUserAndPassIn: aUrl.
	client := DAVClient openUrl: aUrl.
	ret := [client propFind: #('getlastmodified' 'getcontentlength' 'resourcetype' )
				depth: 1
				label: nil]
		ensure: [client close].
	client lastResponseCode first = $2 ifFalse: [^ #()].
	^ self parseDirectoryEntries: ret readStream! !

!DAVServerDirectory methodsFor: 'property access' stamp: 'yo 8/6/2009 21:30'!
privateEntriesFor: aUrl
	| ret |
	client := DAVClient openUrl: aUrl.
	ret := [client propFind: #('getlastmodified' 'getcontentlength' 'resourcetype' )
				depth: 1
				label: nil]
		ensure: [client close].
	client lastResponseCode first = $2 ifFalse: [^ #()].
	^ self parseDirectoryEntries: ret readStream! !


!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 21:29'!
askName

	| ret |
	ret := FillInTheBlankMorph
					request: (useDefaultAccount ifTrue: [
						'User account name? (Cancel to stay with default name)'] ifFalse: ['User account name?'])
					initialAnswer: (user ifNil: [''])
					onCancelReturn: nil.
	(useDefaultAccount and: [ret isNil or: [ret = user]]) ifTrue: [^ false].
	self user: ret.
	passwordHolder := nil.
	Utilities authorName: user.
	^ true.
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 20:18'!
askNamePassword

	self askName ifTrue: [self askPassword]! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 19:49'!
askNamePasswordIfNecessary

	(self user isNil or: [self password isNil]) ifFalse: [^ true].
	self askNamePassword.
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 19:49'!
askPassword

	self password: (FillInTheBlank  requestPassword: 'Password?').
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 19:49'!
asServerFileNamed: aName

	| rFile |
	rFile _ self as: DAVServerFile.
	(aName includes: self pathNameDelimiter)
		ifTrue: [rFile fullPath: aName]
			"sets server, directory(path), fileName.  If relative, merge with self."
		ifFalse: [rFile fileName: aName].	"JUST a single NAME, already have the rest"
			"Mac files that include / in name, must encode it as %2F "
	^rFile
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 20:58'!
initialize

	super initialize.
	self setupSelector: #setupSharedDirectory:.
	useDefaultAccount := false.
	loggedIn := false.
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 21:08'!
password

	user ifNil: [passwordHolder := nil. (HTTPLoginFailedException protocolInstance: DAVClient new) signal. ^ self].
	passwordHolder ifNil: [passwordHolder _ Password new].
	^ passwordHolder passwordFor: self	"may ask the user"! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 21:05'!
setUserAndPassIn: aUrl

	aUrl username: self user.
	aUrl password: self password.
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 20:33'!
setupPersonalDirectory: aString

	aString ifNil: [^ self].
	directory := directory, '/', 'public/accounts/', aString.
	altURL := server,  directory.
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 15:08'!
setupSelector: aSymbol

	setupSelector := aSymbol
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 15:32'!
setupSharedDirectory: aString
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 15:10'!
setup: aString

	directory := directory, '/', 'public/accounts/', aString.
	altURL := server,  directory.
	client := nil.
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 19:51'!
useDefaultAccount: aBoolean

	useDefaultAccount := aBoolean.
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 9/8/2009 10:57'!
user

	| orig |
	orig := user.
	(useDefaultAccount not and: [user isNil]) ifTrue: [self askName ifFalse: [self user: orig]].
	^ user.
! !

!DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 20:48'!
user: aString

	super user: aString.
	self perform: setupSelector with: aString.
! !


!FileList2 methodsFor: 'initialize-release' stamp: 'yo 8/6/2009 21:35'!
initialize

	showDirsInFileList _ false.
	fileSelectionBlock _ [ :entry :myPattern |
		entry isDirectory ifTrue: [
			showDirsInFileList
		] ifFalse: [
			myPattern = '*' or: [myPattern match: entry name]
		]
	] fixTemps.
	dirSelectionBlock _ [ :dirName | true].
	triedLogin := false.! !

!FileList2 methodsFor: 'private' stamp: 'yo 8/6/2009 21:42'!
directoryNamesFor: item
	"item may be file directory or server directory"
	| entries |
	entries _ [item directoryNames] on: LoginFailedException do: [:ex | triedLogin ifFalse: [
		triedLogin := true. ^ self directoryNamesFor: item] ifTrue: [^ #()]].
	dirSelectionBlock ifNotNil:[entries _ entries select: dirSelectionBlock].
	^entries! !

!FileList2 methodsFor: 'private' stamp: 'yo 8/6/2009 21:42'!
setSelectedDirectoryTo: aFileDirectoryWrapper
	currentDirectorySelected _ aFileDirectoryWrapper.
	[self directory: aFileDirectoryWrapper withoutListWrapper] on: LoginFailedException do: [:ex | triedLogin ifFalse: [
		triedLogin := true. ^ self setSelectedDirectoryTo: aFileDirectoryWrapper] ifTrue: [^ self]].
	brevityState := #FileList.
	"self addPath: path."
	self changed: #fileList.
	self changed: #contents.
	self changed: #currentDirectorySelected.! !


!Morph methodsFor: 'WiW support' stamp: 'yo 8/3/2009 20:17'!
addMorphInLayer: aMorph centeredNear: aPoint
	"Add the given morph to this world, attempting to keep its center as close to the given point possible while also keeping the it entirely within the bounds of this world."

	| trialRect delta |
	trialRect _ Rectangle center: aPoint extent: aMorph fullBounds extent.
	delta _ trialRect amountToTranslateWithin: bounds.
	aMorph position: trialRect origin + delta.
	self addMorphInLayer: aMorph.
! !


!EToyProjectDetailsMorph methodsFor: 'as yet unclassified' stamp: 'yo 8/6/2009 16:34'!
copyOutDetails

	| newDetails user |

	newDetails _ Dictionary new.
	self fieldToDetailsMappings do: [ :each |
		namedFields at: each first ifPresent: [ :field |
			newDetails at: each second put: field contents string
		].
	].
	namedFields at: 'projectname' ifPresent: [ :field |
		newDetails at: 'projectname' put: field contents string withBlanksTrimmed.
	].
	namedFields at: 'author' ifPresent: [ :field |
		user := field contents string withBlanksTrimmed.
		newDetails at: 'projectauthor' put: user.
		user isEmpty ifTrue: [user := nil].
		Utilities authorName: user.
		theProject ifNotNil: [theProject forgetExistingURL].
	].

	^newDetails! !


!FillInTheBlankMorph class methodsFor: 'instance creation' stamp: 'yo 8/3/2009 19:57'!
request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean answerExtent: answerExtent
	"Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts.   If the user cancels, answer returnOnCancel."

	"FillInTheBlankMorph
		request: 'Type something, then type CR.'
		initialAnswer: 'yo ho ho!!' centerAt: Display center inWorld: ActiveWorld
		onCancelReturn: '*** Cancelled ***' acceptOnCR: true answerExtent: self defaultAnswerExtent"

	| aFillInTheBlankMorph |
	aFillInTheBlankMorph _ self new
		setQuery: queryString
		initialAnswer: defaultAnswer
		answerExtent: answerExtent
		acceptOnCR: acceptBoolean.
	aFillInTheBlankMorph responseUponCancel: returnOnCancel.
	aWorld addMorphInLayer: aFillInTheBlankMorph centeredNear: aPoint.
	aFillInTheBlankMorph layoutChanged.
	^ aFillInTheBlankMorph getUserResponse
! !

!FillInTheBlankMorph class methodsFor: 'instance creation' stamp: 'yo 8/3/2009 19:58'!
requestPassword: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean
	"Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts.   If the user cancels, answer returnOnCancel."
	"FillInTheBlankMorph
		request: 'Type something, then type CR.'
		initialAnswer: 'yo ho ho!!'
		centerAt: Display center"

	| aFillInTheBlankMorph |
	aFillInTheBlankMorph _ self new
		setPasswordQuery: queryString
		initialAnswer: defaultAnswer
		answerHeight: 50
		acceptOnCR: acceptBoolean.
	aFillInTheBlankMorph responseUponCancel: returnOnCancel.
	
	aWorld addMorphInLayer: aFillInTheBlankMorph centeredNear: aPoint.
	^ aFillInTheBlankMorph getUserResponse
! !

!FillInTheBlankMorph class methodsFor: 'instance creation' stamp: 'yo 8/3/2009 20:13'!
request: queryString initialAnswer: defaultAnswer onCancelReturn: cancelResponse
	"Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels."
	"FillInTheBlankMorph
		request: 'What is your favorite color?'
		initialAnswer: 'red, no blue. Ahhh!!'"

	^ self
		request: queryString
		initialAnswer: defaultAnswer
		centerAt: ActiveHand cursorPoint
		inWorld: ActiveWorld
		onCancelReturn: cancelResponse! !


!ProjectLoading class methodsFor: 'private' stamp: 'yo 9/8/2009 13:47'!
loadImageSegment: morphOrList  fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr

	| proj projectsToBeDeleted ef f |
	(f _ (Flaps globalFlapTabWithID: 'Navigator' translated)) ifNotNil: [f hideFlap].
	proj _ morphOrList arrayOfRoots
			detect: [:mm | mm isKindOf: Project]
			ifNone: [^ nil].
	numberOfFontSubstitutes > 0 ifTrue: [
		proj projectParameterAt: #substitutedFont put: substituteFont].
	ef := proj projectParameterAt: #eToysFont.
	(ef isNil or: [ef ~= substituteFont familySizeFace]) ifTrue: [
		proj projectParameterAt: #substitutedFont put: substituteFont.
	].
	proj projectParameters at: #MultiSymbolInWrongPlace put: false.
		"Yoshiki did not put MultiSymbols into outPointers in older images!!"
	morphOrList arrayOfRoots do: [:obj |
		obj fixUponLoad: proj seg: morphOrList "imageSegment"].
	(proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [
		morphOrList arrayOfRoots do: [:obj | (obj isKindOf: Set) ifTrue: [obj rehash]]].

	proj resourceManager: mgr.
	"proj versionFrom: preStream."
	proj lastDirectory: aDirectoryOrNil.
	CurrentProjectRefactoring currentBeParentTo: proj.
	projectsToBeDeleted _ OrderedCollection new.
	existingView == #none ifFalse: [
		self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted].
	ChangeSorter allChangeSets add: proj changeSet.
	Project current projectParameters
		at: #deleteWhenEnteringNewProject
		ifPresent: [ :ignored |
			projectsToBeDeleted add: Project current.
			Project current removeParameter: #deleteWhenEnteringNewProject.
		].
	projectsToBeDeleted isEmpty ifFalse: [
		proj projectParameters
			at: #projectsToBeDeleted
			put: projectsToBeDeleted.
	].
	proj removeParameter: #eToysFont.
	^ proj! !

!ProjectLoading class methodsFor: 'public' stamp: 'yo 9/8/2009 13:45'!
loadName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
withProjectView: existingView

	^ self loadName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
withProjectView: existingView clearOriginFlag: false.
! !

!ProjectLoading class methodsFor: 'public' stamp: 'yo 9/8/2009 13:44'!
loadName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
withProjectView: existingView clearOriginFlag: clearOriginFlag
	"Reconstitute a Morph from the selected file, presumed to be
represent a Morph saved via the SmartRefStream mechanism, and open it
in an appropriate Morphic world."

   	| morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict oldProject |
	(self checkStream: preStream) ifTrue: [^ self].
	ProgressNotification signal: '0.2'.
	archive _ preStream isZipArchive
		ifTrue:[ZipArchive new readFrom: preStream]
		ifFalse:[nil].
	manifests _ (archive membersMatching: '*manifest').
	(manifests size = 1 and: [((dict _ self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression'])
		ifTrue: [^ self loadSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView].
	morphOrList _ self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive.
	morphOrList ifNil: [^ self].
	ProgressNotification  signal: '0.4'.
	resultArray _ self fileInName: aFileName archive: archive morphOrList: morphOrList.
	anObject _ resultArray first.
	numberOfFontSubstitutes _ resultArray second.
	substituteFont _ resultArray third.
	mgr _ resultArray fourth.
	preStream close.
	ProgressNotification  signal: '0.7'.
		"the hard part is over"
	(anObject isKindOf: ImageSegment) ifTrue: [
		project _ self loadImageSegment: anObject
			fromDirectory: aDirectoryOrNil
			withProjectView: existingView
			numberOfFontSubstitutes: numberOfFontSubstitutes
			substituteFont: substituteFont
			mgr: mgr.
		oldProject := manifests isEmpty or: [((dict at: 'Squeak-Version') beginsWith: 'etoys') not].
		project projectParameterAt: #oldProject put: oldProject.
	clearOriginFlag ifTrue: [project forgetExistingURL].
	ProgressNotification  signal: '0.8'.
		^ project
	].! !

!ProjectLoading class methodsFor: 'public' stamp: 'yo 9/8/2009 13:45'!
openFromDirectory: aDirectory andFileName: aFileName 
	"Open the project with progress bar"
	| fileAndDir |
	shouldClearOrigin := (aDirectory isKindOf: DAVMultiUserServerDirectory) and: [aDirectory acceptsUploads not].
	self
		showProgressBarDuring: [ProgressNotification signal: '0'.
			fileAndDir := self bestAccessToFileName: aFileName andDirectory: aDirectory.
			self
				openName: aFileName
				stream: fileAndDir first
				fromDirectory: fileAndDir second
				withProjectView: nil
				clearOriginFlag: ((aDirectory isKindOf: DAVMultiUserServerDirectory) and: [aDirectory acceptsUploads not])]! !

!ProjectLoading class methodsFor: 'public' stamp: 'yo 9/8/2009 13:43'!
openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
withProjectView: existingView

	^ self openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
withProjectView: existingView clearOriginFlag: false.
! !

!ProjectLoading class methodsFor: 'public' stamp: 'yo 9/8/2009 13:43'!
openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
withProjectView: existingView clearOriginFlag: clearOriginFlag
	"Reconstitute a Morph from the selected file, presumed to
represent a Morph saved via the SmartRefStream mechanism, and open it
in an appropriate Morphic world."

   	| morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict oldProject |
	(self checkStream: preStream) ifTrue: [^ self].
	ProgressNotification signal: '0.2'.
	archive _ preStream isZipArchive
		ifTrue:[ZipArchive new readFrom: preStream]
		ifFalse:[nil].
	archive ifNotNil:[
	manifests _ (archive membersMatching: '*manifest').
	(manifests size = 1 and: [((dict _ self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression'])
		ifTrue: [^ self openSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView]].

	morphOrList _ self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive.
	morphOrList ifNil: [^ self].
	ProgressNotification  signal: '0.4'.
	resultArray _ self fileInName: aFileName archive: archive morphOrList: morphOrList.
	anObject _ resultArray first.
	numberOfFontSubstitutes _ resultArray second.
	substituteFont _ resultArray third.
	mgr _ resultArray fourth.
	preStream close.
	ProgressNotification  signal: '0.7'.
		"the hard part is over"
	(anObject isKindOf: ImageSegment) ifTrue: [
		project _ self loadImageSegment: anObject
			fromDirectory: aDirectoryOrNil
			withProjectView: existingView
			numberOfFontSubstitutes: numberOfFontSubstitutes
			substituteFont: substituteFont
			mgr: mgr.].
	(anObject isKindOf: ImageSegment) ifTrue: [
		oldProject := manifests isEmptyOrNil or: [((dict at: 'Squeak-Version') beginsWith: 'etoys') not].
		project projectParameterAt: #oldProject put: oldProject.
	clearOriginFlag ifTrue: [project forgetExistingURL].
	ProgressNotification  signal: '0.8'.
		^ project
			ifNil: [self inform: 'No project found in this file' translated]
			ifNotNil: [ProjectEntryNotification signal: project]].
	self loadSqueakPage: anObject! !

ProjectLoading class
	instanceVariableNames: 'worldLoading'!
FileList subclass: #FileList2
	instanceVariableNames: 'showDirsInFileList currentDirectorySelected fileSelectionBlock dirSelectionBlock optionalButtonSpecs modalView directoryChangeBlock ok triedLogin'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-FileList'!

!DAVServerDirectory reorganize!
('ServerFile' realUrl)
('squeaklets')
('file directory' asServerFileNamed: createDirectory: deleteDirectory: deleteFileNamed: entries fileExists: forceNewFileNamed: getOnly:from: localNameFor: newFileNamed: oldFileNamed: putFile:named:)
('svn protocol private' getBaselineCollection:location:forRevNumber:vcc: getBaselineRelativePath:location: getVersionControlledConfiguration:location: newestVersionForFileNamed: pathForClient:revision:forFileNamed: pathForRevision:forFileNamed: revisionObjectsForFileNamed:fromXML: revisionsForFileNamed:)
('private' findDirectoryEntries: findPreformattedItems: fullPath: nextAnchorTagFrom: parseDate: parsePreformattedRegion: parseSize: setUserAndPassIn:)
('accessing' asUrl directory: mimeTypesFor:)
('property access' parseDirectoryEntries: parsePropertyResponse: privateEntries privateEntriesFor:)
('up/download' getFileNamed: upLoadProject:members:retry: upLoadProject:named:resourceUrl:retry:)
('testing' isProjectSwiki isTypeHTTP)
('svn protocol' revisionObjectsForFileNamed: revisionsFor:do:)
!

"Postscript:
."
Utilities authorName: nil.

d _ DAVMultiUserServerDirectory on: 'http://squeakland.org/webdav/'.
d altUrl: 'http://squeakland.org/webdav/'.
d moniker: 'My Squeakland'.
d acceptsUploads: true.
d setupSelector: #setupPersonalDirectory:.
ServerDirectory inImageServers at: 'My Squeakland' put: d.

d _ DAVMultiUserServerDirectory on: 'http://squeakland.org/webdav/'.
d altUrl: 'http://squeakland.org/webdav/'.
d moniker: 'Squeakland Showcase'.
d user: 'etoys'.
d password: 'kaeuqs'.
d useDefaultAccount: true.
d acceptsUploads: false.
ServerDirectory inImageServers at: 'Squeakland Showcase' put: d.
!