[Pkg] Squeak3.10bc: Files-kph.24.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Sat Dec 13 04:46:34 UTC 2008


A new version of Files was added to project Squeak3.10bc:
http://www.squeaksource.com/310bc/Files-kph.24.mcz

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

Name: Files-kph.24
Author: kph
Time: 13 December 2008, 4:46:30 am
UUID: b7aa5676-0362-47fa-b047-322b9041821f
Ancestors: Files-edc.23

Saved from SystemVersion

==================== Snapshot ====================

SystemOrganization addCategory: #'Files-Directories'!
SystemOrganization addCategory: #'Files-Kernel'!
SystemOrganization addCategory: #'Files-System'!
SystemOrganization addCategory: #'Files-Tests'!

ReadWriteStream subclass: #CompressedSourceStream
	instanceVariableNames: 'segmentFile segmentSize nSegments segmentTable segmentIndex dirty endOfFile'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-System'!

!CompressedSourceStream commentStamp: 'di 11/3/2003 17:58' prior: 0!
I implement a file format that compresses segment by segment to allow incremental writing and browsing.  Note that the file can only be written at the end.

Structure:
segmentFile		The actual compressed file.
segmentSize		This is the quantum of compression.  The virtual file is sliced up
				into segments of this size.
nSegments		The maximum number of segments to which this file can be grown.
endOfFile		The user's endOfFile pointer.
segmentTable	When a file is open, this table holds the physical file positions
				of the compressed segments.
segmentIndex	Index of the most recently accessed segment.

Inherited from ReadWriteStream...
collection		The segment buffer, uncompressed
position			This is the position *local* to the current segment buffer
readLimit		ReadLimit for the current buffer
writeLimit		WriteLimit for the current buffer

Great care must be exercised to distinguish between the position relative to the segment buffer and the full file position (and, or course, the segment file position ;-).

The implementation defaults to a buffer size of 20k, and a max file size of 34MB (conveniently chosen to be greater than the current 33MB limit of source code pointers).  The format of the file is as follows:
	segmentSize		4 bytes
	nSegments		4 bytes
	endOfFile		4 bytes
	segmentTable	4 bytes * (nSegments+1)
	beginning of first compressed segment

It is possible to override the default allocation by sending the message #segmentSize:nSegments: immediately after opening a new file for writing, as follows:

	bigFile _ (CompressedSourceStream on: (FileStream newFileNamed: 'biggy.stc'))
			segmentSize: 50000 maxSize: 200000000

The difference between segment table entries reveals the size of each compressed segment.  When a file is being written, it may lack the final segment, but any flush, position:, or close will force a dirty segment to be written.!

----- Method: CompressedSourceStream class>>on: (in category 'as yet unclassified') -----
on: aFile
	^ self basicNew openOn: aFile!

----- Method: CompressedSourceStream>>atEnd (in category 'access') -----
atEnd

	position >= readLimit ifFalse: [^ false].  "more in segment"
	^ self position >= endOfFile  "more in file"!

----- Method: CompressedSourceStream>>binary (in category 'open/close') -----
binary
	self error: 'Compressed source files are ascii to the user (though binary underneath)'!

----- Method: CompressedSourceStream>>close (in category 'open/close') -----
close
	self flush.
	segmentFile close!

----- Method: CompressedSourceStream>>contentsOfEntireFile (in category 'access') -----
contentsOfEntireFile
	| contents |
	self position: 0.
	contents := self next: self size.
	self close.
	^ contents!

----- Method: CompressedSourceStream>>fileID (in category 'private') -----
fileID  "Only needed for OSProcess stuff"
	^ segmentFile fileID
!

----- Method: CompressedSourceStream>>firstSegmentLoc (in category 'private') -----
firstSegmentLoc
	"First segment follows 3 header words and segment table"
	^ (3 + nSegments+1) * 4!

----- Method: CompressedSourceStream>>flush (in category 'access') -----
flush
	dirty ifTrue:
		["Write buffer, compressed, to file, and also write the segment offset and eof"
		self writeSegment].!

----- Method: CompressedSourceStream>>next (in category 'access') -----
next
	<primitive: 65>
	position >= readLimit
		ifTrue: [^ (self next: 1) at: 1]
		ifFalse: [^ collection at: (position := position + 1)]!

----- Method: CompressedSourceStream>>next: (in category 'access') -----
next: n
	| str |
	n <= (readLimit - position) ifTrue:
		["All characters are available in buffer"
		str := collection copyFrom: position + 1 to: position + n.
		position := position + n.
		^ str].

	"Read limit could be segment boundary or real end of file"
	(readLimit + self segmentOffset) = endOfFile ifTrue:
		["Real end of file -- just return what's available"
		^ self next: readLimit - position].

	"Read rest of segment.  Then (after positioning) read what remains"
	str := self next: readLimit - position.
	self position: self position.
	^ str , (self next: n - str size)
!

----- Method: CompressedSourceStream>>nextPut: (in category 'access') -----
nextPut: char
	"Slow, but we don't often write, and then not a lot"
	self nextPutAll: char asString.
	^ char!

----- Method: CompressedSourceStream>>nextPutAll: (in category 'access') -----
nextPutAll: str
	| n nInSeg |
	n := str size.
	n <= (writeLimit - position) ifTrue:
		["All characters fit in buffer"
		collection replaceFrom: position + 1 to: position + n with: str.
		dirty := true.
		position := position + n.
		readLimit := readLimit max: position.
		endOfFile := endOfFile max: self position.
		^ str].

	"Write what fits in segment.  Then (after positioning) write what remains"
	nInSeg := writeLimit - position.
	nInSeg = 0
		ifTrue: [self position: self position.
				self nextPutAll: str]
		ifFalse: [self nextPutAll: (str first: nInSeg).
				self position: self position.
				self nextPutAll: (str allButFirst: nInSeg)]
	
!

----- Method: CompressedSourceStream>>openOn: (in category 'open/close') -----
openOn: aFile
	"Open the receiver."
	segmentFile := aFile.
	segmentFile binary.
	segmentFile size > 0
	ifTrue:
		[self readHeaderInfo.  "If file exists, then read the parameters"]
	ifFalse:
		[self segmentSize: 20000 maxSize: 34000000.  "Otherwise write default values"]!

----- Method: CompressedSourceStream>>openReadOnly (in category 'open/close') -----
openReadOnly

	segmentFile openReadOnly!

----- Method: CompressedSourceStream>>position (in category 'access') -----
position

	^ position + self segmentOffset!

----- Method: CompressedSourceStream>>position: (in category 'access') -----
position: newPosition
	| compressedBuffer newSegmentIndex |
	newPosition > endOfFile ifTrue:
		[self error: 'Attempt to position beyond the end of file'].
	newSegmentIndex := (newPosition // segmentSize) + 1.
	newSegmentIndex ~= segmentIndex ifTrue:
		[self flush.
		segmentIndex := newSegmentIndex.
		newSegmentIndex > nSegments ifTrue:
			[self error: 'file size limit exceeded'].
		segmentFile position: (segmentTable at: segmentIndex).
		(segmentTable at: segmentIndex+1) = 0
			ifTrue:
			[newPosition ~= endOfFile ifTrue:
				[self error: 'Internal logic error'].
			collection size = segmentSize ifFalse:
				[self error: 'Internal logic error'].
			"just leave garbage beyond end of file"]
			ifFalse:
			[compressedBuffer := segmentFile next: ((segmentTable at: segmentIndex+1) - (segmentTable at: segmentIndex)).
			collection :=  (GZipReadStream on: compressedBuffer) upToEnd asString].
		readLimit := collection size min: endOfFile - self segmentOffset].
	position := newPosition \\ segmentSize.
	!

----- Method: CompressedSourceStream>>readHeaderInfo (in category 'open/close') -----
readHeaderInfo
	| valid a b |
	segmentFile position: 0.
	segmentSize := segmentFile nextNumber: 4.
	nSegments := segmentFile nextNumber: 4.
	endOfFile := segmentFile nextNumber: 4.
	segmentFile size < (nSegments+1 + 3 * 4) ifTrue: "Check for reasonable segment info"
		[self error: 'This file is not in valid compressed source format'].
	segmentTable := (1 to: nSegments+1) collect: [:x | segmentFile nextNumber: 4].
	segmentTable first ~= self firstSegmentLoc ifTrue:
		[self error: 'This file is not in valid compressed source format'].
	valid := true.
	1 to: nSegments do:  "Check that segment offsets are ascending"
		[:i | a := segmentTable at: i.  b := segmentTable at: i+1.
		(a = 0 and: [b ~= 0]) ifTrue: [valid := false].
		(a ~= 0 and: [b ~= 0]) ifTrue: [b <= a ifTrue: [valid := false]]].
	valid ifFalse:
		[self error: 'This file is not in valid compressed source format'].
	dirty := false.
	self position: 0.!

----- Method: CompressedSourceStream>>readOnlyCopy (in category 'open/close') -----
readOnlyCopy

	^ self class on: segmentFile readOnlyCopy!

----- Method: CompressedSourceStream>>segmentOffset (in category 'private') -----
segmentOffset

	^ segmentIndex - 1 * segmentSize!

----- Method: CompressedSourceStream>>segmentSize:maxSize: (in category 'private') -----
segmentSize: segSize maxSize: maxSize
	"Note that this method can be called after the initial open, provided that no
	writing has yet taken place.  This is how to override the default segmentation."
	self size = 0 ifFalse: [self error: 'Cannot set parameters after the first write'].
	segmentFile position: 0.
	segmentFile nextNumber: 4 put: (segmentSize := segSize).
	segmentFile nextNumber: 4 put: (nSegments := maxSize // segSize + 2).
	segmentFile nextNumber: 4 put: (endOfFile := 0).
	segmentTable := Array new: nSegments+1 withAll: 0.
	segmentTable at: 1 put: self firstSegmentLoc.  "Loc of first segment, always."
	segmentTable do: [:i | segmentFile nextNumber: 4 put: i].
	segmentIndex := 1.
	collection := String new: segmentSize.
	writeLimit := segmentSize.
	readLimit := 0.
	position := 0.
	endOfFile := 0.
	self writeSegment.
!

----- Method: CompressedSourceStream>>size (in category 'access') -----
size
	^ endOfFile ifNil: [0]!

----- Method: CompressedSourceStream>>test (in category 'open/close') -----
test
	"FileDirectory default deleteFileNamed: 'test.stc'.
	(CompressedSourceStream on: (FileStream newFileNamed: 'test.stc')) fileOutChanges"

	"FileDirectory default deleteFileNamed: 'test2.stc'.
	((CompressedSourceStream on: (FileStream newFileNamed: 'test2.stc'))
		segmentSize: 100 nSegments: 1000) fileOutChanges"

	"FileDirectory default deleteFileNamed: 'test3.st'.
	(FileStream newFileNamed: 'test3.st') fileOutChanges"

	"(CompressedSourceStream on: (FileStream oldFileNamed: 'test.stc')) contentsOfEntireFile"
!

----- Method: CompressedSourceStream>>writeSegment (in category 'private') -----
writeSegment
	"The current segment must be the last in the file."
	| compressedSegment |
	segmentFile position: (segmentTable at: segmentIndex).
	compressedSegment := ByteArray streamContents:
		[:strm | (GZipWriteStream on: strm) nextPutAll: collection asByteArray; close].
	segmentFile nextPutAll: compressedSegment.
	segmentTable at: segmentIndex + 1 put: segmentFile position.

	segmentFile position: 2 * 4.
	segmentFile nextNumber: 4 put: endOfFile.
	segmentFile position: (segmentIndex + 3) * 4.
	segmentFile nextNumber: 4 put: (segmentTable at: segmentIndex + 1).
	dirty := false!

ReadWriteStream subclass: #FileStream
	instanceVariableNames: 'rwmode'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Kernel'!

!FileStream commentStamp: '<historical>' prior: 0!
I represent a Stream that accesses a FilePage from a File. One use for my instance is to access larger "virtual Strings" than can be stored contiguously in main memory. I restrict the objects stored and retrieved to be Integers or Characters. An end of file pointer terminates reading; it can be extended by writing past it, or the file can be explicitly truncated.
	
To use the file system for most applications, you typically create a FileStream. This is done by sending a message to a FileDirectory (file:, oldFile:, newFile:, rename:newName:) which creates an instance of me. Accesses to the file are then done via my instance.

*** On DOS, files cannot be shortened!!  ***  To overwrite a file with a shorter one, first delete the old file (FileDirectory deleteFilePath: 'Hard Disk:aFolder:dataFolder:foo') or (aFileDirectory deleteFileNamed: 'foo').  Then write your new shorter version.!

----- Method: FileStream class>>concreteStream (in category 'concrete classes') -----
concreteStream
	"Who should we really direct class queries to?  "
	^ MultiByteFileStream.
!

----- Method: FileStream class>>cs (in category 'file reader services') -----
cs

	^ 'cs' clone.
!

----- Method: FileStream class>>detectFile:do: (in category 'instance creation') -----
detectFile: aBlock do: anotherBlock
	
	| file |

	file := aBlock value.
	^ file 
		ifNil: [ nil ]
         ifNotNil: [ [anotherBlock value: file] ensure: [file close]]!

----- Method: FileStream class>>fileIn: (in category 'file reader services') -----
fileIn: fullName
	"File in the entire contents of the file specified by the name provided"

	| ff |
	fullName ifNil: [^ Beeper beep].
	ff := self readOnlyFileNamed: (GZipReadStream uncompressedFileName: fullName).
	ff fileIn.
!

----- Method: FileStream class>>fileNamed: (in category 'instance creation') -----
fileNamed: fileName 
	^ self concreteStream fileNamed: (self fullName: fileName)!

----- Method: FileStream class>>fileNamed:do: (in category 'instance creation') -----
fileNamed: fileName do: aBlock
	"Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})).  It's time Squeak had it, too.''
	
	Returns the result of aBlock."
	
	^ self detectFile: [ self fileNamed: fileName ] do: aBlock!

----- Method: FileStream class>>fileReaderServicesForFile:suffix: (in category 'file reader services') -----
fileReaderServicesForFile: fullName suffix: suffix
	"Answer services for the given file"

	^ ((self isSourceFileSuffix: suffix) or: [ suffix = '*' ])
		ifTrue:
			[{self serviceRemoveLineFeeds.
			self serviceFileIn}]
		ifFalse:
			[#()]!

----- Method: FileStream class>>forceNewFileNamed: (in category 'instance creation') -----
forceNewFileNamed: fileName
 	"Create a new file with the given name, and answer a stream opened for writing on that file. If the file already exists, delete it without asking before creating the new file."

	^self concreteStream forceNewFileNamed: fileName!

----- Method: FileStream class>>forceNewFileNamed:do: (in category 'instance creation') -----
forceNewFileNamed: fileName do: aBlock
	"Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})).  It's time Squeak had it, too.''
	
	Returns the result of aBlock."
	
	^ self detectFile: [ self forceNewFileNamed: fileName ] do: aBlock!

----- Method: FileStream class>>fullName: (in category 'instance creation') -----
fullName: fileName
	^ FileDirectory default fullNameFor: fileName!

----- Method: FileStream class>>httpPostDocument:args: (in category 'browser requests') -----
httpPostDocument: url args: argsDict
	| argString |
	argString := argsDict
		ifNotNil: [argString := HTTPSocket argString: argsDict]
		ifNil: [''].
	^self post: argString url: url , argString ifError: [self halt]!

----- Method: FileStream class>>httpPostMultipart:args: (in category 'browser requests') -----
httpPostMultipart: url args: argsDict
	| mimeBorder argsStream crLf fieldValue resultStream result |
	" do multipart/form-data encoding rather than x-www-urlencoded "

	crLf := String crlf.
	mimeBorder := '----squeak-', Time millisecondClockValue printString, '-stuff-----'.
	"encode the arguments dictionary"
	argsStream := WriteStream on: String new.
	argsDict associationsDo: [:assoc |
		assoc value do: [ :value |
		"print the boundary"
		argsStream nextPutAll: '--', mimeBorder, crLf.
		" check if it's a non-text field "
		argsStream nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'.
		(value isKindOf: MIMEDocument)
			ifFalse: [fieldValue := value]
			ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', crLf, 'Content-Type: ', value contentType.
				fieldValue := (value content
					ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile]
					ifNotNil: [value content]) asString].
" Transcript show: 'field=', key, '; value=', fieldValue; cr. "
		argsStream nextPutAll: crLf, crLf, fieldValue, crLf.
	]].
	argsStream nextPutAll: '--', mimeBorder, '--'.

	resultStream := self
		post: 
			('Content-type: multipart/form-data; boundary=', mimeBorder, crLf,
			'Content-length: ', argsStream contents size printString, crLf, crLf, 
			argsStream contents)
		url: url ifError: [^'Error in post ' url asString].
	"get the header of the reply"
	result := resultStream upToEnd.
	^MIMEDocument content: result!

----- Method: FileStream class>>initialize (in category 'initialize-release') -----
initialize

	FileList registerFileReader: self!

----- Method: FileStream class>>isAFileNamed: (in category 'instance creation') -----
isAFileNamed: fName
	"return whether a file exists with the given name"
	^self concreteStream isAFileNamed: (self fullName: fName)!

----- Method: FileStream class>>isSourceFileSuffix: (in category 'file reader services') -----
isSourceFileSuffix: suffix

	^ FileStream sourceFileSuffixes includes: suffix
!

----- Method: FileStream class>>multiCs (in category 'file reader services') -----
multiCs

	^ 'mcs' clone.
!

----- Method: FileStream class>>multiSt (in category 'file reader services') -----
multiSt

	^ 'mst' clone.
!

----- Method: FileStream class>>new (in category 'instance creation') -----
new
	^ self basicNew!

----- Method: FileStream class>>newFileNamed: (in category 'instance creation') -----
newFileNamed: fileName 
	^ self concreteStream newFileNamed: (self fullName: fileName)!

----- Method: FileStream class>>newFileNamed:do: (in category 'instance creation') -----
newFileNamed: fileName do: aBlock
	"Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})).  It's time Squeak had it, too.''
	
	Returns the result of aBlock."
	
	^ self detectFile: [ self newFileNamed: fileName ] do: aBlock!

----- Method: FileStream class>>oldFileNamed: (in category 'instance creation') -----
oldFileNamed: fileName 
	^ self concreteStream oldFileNamed: (self fullName: fileName)!

----- Method: FileStream class>>oldFileNamed:do: (in category 'instance creation') -----
oldFileNamed: fileName do: aBlock
	"Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})).  It's time Squeak had it, too.''
	
	Returns the result of aBlock."
	
	^ self detectFile: [ self oldFileNamed: fileName ] do: aBlock!

----- Method: FileStream class>>oldFileOrNoneNamed: (in category 'instance creation') -----
oldFileOrNoneNamed: fileName
	"If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil."

	| fullName |
	fullName := self fullName: fileName.
	(self concreteStream isAFileNamed: fullName)
		ifTrue: [^ self concreteStream readOnlyFileNamed: fullName]
		ifFalse: [^ nil].
!

----- Method: FileStream class>>post:target:url:ifError: (in category 'browser requests') -----
post: data target: target url: url ifError: errorBlock
	^self concreteStream new post: data target: target url: url ifError: errorBlock!

----- Method: FileStream class>>post:url:ifError: (in category 'browser requests') -----
post: data url: url ifError: errorBlock
	^self post: data target: nil url: url ifError: errorBlock!

----- Method: FileStream class>>readOnlyFileNamed: (in category 'instance creation') -----
readOnlyFileNamed: fileName 
	^ self concreteStream readOnlyFileNamed: (self fullName: fileName)!

----- Method: FileStream class>>readOnlyFileNamed:do: (in category 'instance creation') -----
readOnlyFileNamed: fileName do: aBlock
	"Avi Bryant says, ''This idiom is quite common in other languages that make heavy use of closures (i.e. Lisp (with-file 'foo' (f) ...) and Ruby (File.open('foo'){|f|...})).  It's time Squeak had it, too.''
	
	Returns the result of aBlock."
	
	^ self detectFile: [ self readOnlyFileNamed: fileName ] do: aBlock!

----- Method: FileStream class>>removeLineFeeds: (in category 'file reader services') -----
removeLineFeeds: fullName
	| fileContents |
	fileContents := ((FileStream readOnlyFileNamed: fullName) wantsLineEndConversion: true) contentsOfEntireFile.
	(FileStream newFileNamed: fullName) 
		nextPutAll: fileContents;
		close.!

----- Method: FileStream class>>requestDropStream: (in category 'dnd requests') -----
requestDropStream: dropIndex
	"Request a read-only stream for some file that was dropped onto Squeak"
	^self concreteStream new requestDropStream: dropIndex.!

----- Method: FileStream class>>requestURL:target: (in category 'browser requests') -----
requestURL: url target: target
	"FileStream requestURL:'http://isgwww.cs.uni-magdeburg.de/~raab' target: ':=blank' "
	^self concreteStream new requestURL: url target: target!

----- Method: FileStream class>>requestURLStream: (in category 'browser requests') -----
requestURLStream: url
	"FileStream requestURLStream:'http://isgwww.cs.uni-magdeburg.de/~raab'"
	^self concreteStream new requestURLStream: url!

----- Method: FileStream class>>requestURLStream:ifError: (in category 'browser requests') -----
requestURLStream: url ifError: errorBlock
	"FileStream requestURLStream:'http://isgwww.cs.uni-magdeburg.de/~raab'"
	^self concreteStream new requestURLStream: url ifError: errorBlock!

----- Method: FileStream class>>serviceFileIn (in category 'file reader services') -----
serviceFileIn
	"Answer a service for filing in an entire file"

	^ SimpleServiceEntry 
		provider: self 
		label: 'fileIn entire file'
		selector: #fileIn:
		description: 'file in the entire contents of the file, which is expected to contain Smalltalk code in fileout ("chunk") format'
		buttonLabel: 'filein'!

----- Method: FileStream class>>serviceRemoveLineFeeds (in category 'file reader services') -----
serviceRemoveLineFeeds
	"Answer a service for removing linefeeds from a file"

	^ FileModifyingSimpleServiceEntry
		provider: self 
		label: 'remove line feeds'
		selector: #removeLineFeeds:	
		description: 'remove line feeds in file'
		buttonLabel: 'remove lfs'!

----- Method: FileStream class>>services (in category 'file reader services') -----
services

	^ Array 
			with: self serviceRemoveLineFeeds
			with: self serviceFileIn
	!

----- Method: FileStream class>>sourceFileSuffixes (in category 'file reader services') -----
sourceFileSuffixes

	^ {FileStream st. FileStream cs. FileStream multiSt. FileStream multiCs} asSet asArray.

!

----- Method: FileStream class>>st (in category 'file reader services') -----
st

	^ 'st' clone.
!

----- Method: FileStream class>>unload (in category 'class initialization') -----
unload

	FileList unregisterFileReader: self !

----- Method: FileStream class>>writeSourceCodeFrom:baseName:isSt:useHtml: (in category 'file reader services') -----
writeSourceCodeFrom: aStream baseName: baseName isSt: stOrCsFlag useHtml: useHtml

	| extension converter f fileName |
	aStream contents isAsciiString ifTrue: [
		stOrCsFlag ifTrue: [
			extension := (FileDirectory dot, FileStream st).
		] ifFalse: [
			extension := (FileDirectory dot, FileStream cs).
		].
		converter := MacRomanTextConverter new.
	] ifFalse: [
		stOrCsFlag ifTrue: [
			extension := (FileDirectory dot, FileStream st "multiSt").
		] ifFalse: [
			extension := (FileDirectory dot, FileStream cs "multiCs").
		].
		converter := UTF8TextConverter new.
	].
	fileName := useHtml ifTrue: [baseName, '.html'] ifFalse: [baseName, extension].
	f := FileStream newFileNamed: fileName.
	f ifNil: [^ self error: 'Cannot open file'].
	(converter isMemberOf: UTF8TextConverter)
		ifTrue: [f binary.
			UTF8TextConverter writeBOMOn: f].
	f text.
	f converter: converter.
	f nextPutAll: aStream contents.
	f close.
!

----- Method: FileStream>>asBinaryOrTextStream (in category 'converting') -----
asBinaryOrTextStream
	"I can switch between binary and text data"

	^ self!

----- Method: FileStream>>asUrl (in category 'file accessing') -----
asUrl
	"Convert my path into a file:// type url - a FileUrl."
	
	^FileUrl pathParts: (self directory pathParts copyWith: self localName)!

----- Method: FileStream>>ascii (in category 'file modes') -----
ascii
	"Set this file to ascii (text) mode."

	self subclassResponsibility
!

----- Method: FileStream>>atEnd (in category 'testing') -----
atEnd
	"Answer true if the current position is >= the end of file position.
	 1/31/96 sw: subclassResponsibility"

	self subclassResponsibility!

----- Method: FileStream>>binary (in category 'file modes') -----
binary
	"Set this file to binary mode."

	self subclassResponsibility
!

----- Method: FileStream>>close (in category 'file open/close') -----
close
	"Close this file."

	self subclassResponsibility
!

----- Method: FileStream>>closed (in category 'file open/close') -----
closed
	"Answer true if this file is closed."

	self subclassResponsibility
!

----- Method: FileStream>>contents (in category 'accessing') -----
contents
	"Return the contents of the receiver. Do not close or otherwise touch the receiver. Return data in whatever mode the receiver is in (e.g., binary or text)."
	| s savePos |
	savePos := self position.
	self position: 0.
	s := self next: self size.
	self position: savePos.
	^s!

----- Method: FileStream>>contentsOfEntireFile (in category 'accessing') -----
contentsOfEntireFile
	"Read all of the contents of the receiver."

	| s binary |
	self readOnly.
	binary := self isBinary.
	self reset.	"erases knowledge of whether it is binary"
	binary ifTrue: [self binary].
	s := self next: self size.
	self close.
	^s!

----- Method: FileStream>>dataIsValid (in category 'remote file compatibility') -----
dataIsValid

	self flag: #bob.		"we needed this if a remote stream, but could be local as well"!

----- Method: FileStream>>directoryEntry (in category 'accessing') -----
directoryEntry
	^self directory entryAt: self localName!

----- Method: FileStream>>edit (in category 'editing') -----
edit
	"Create and schedule an editor on this file."

	FileList openEditorOn: self editString: nil.
!

----- Method: FileStream>>file (in category 'file accessing') -----
file
	"Answer the file for the page the receiver is streaming over.
	 1/31/96 sw: made subclass responsibility"

	self subclassResponsibility!

----- Method: FileStream>>fileIn (in category 'fileIn/Out') -----
fileIn
	"Guarantee that the receiver is readOnly before fileIn for efficiency and
	to eliminate remote sharing conflicts."

	self readOnly.
	self fileInAnnouncing: 'Loading ', self localName!

----- Method: FileStream>>fileInObjectAndCode (in category 'fileIn/Out') -----
fileInObjectAndCode
	"Read the file directly, do not use an RWBinaryOrTextStream."

	self text.
	^ super fileInObjectAndCode
!

----- Method: FileStream>>fileIntoNewChangeSet (in category 'fileIn/Out') -----
fileIntoNewChangeSet
	"File all of my contents into a new change set." 

	self readOnly.
	ChangesOrganizer newChangesFromStream: self named: (self localName)
!

----- Method: FileStream>>flush (in category 'file open/close') -----
flush
	"When writing, flush the current buffer out to disk."

	self subclassResponsibility
!

----- Method: FileStream>>localName (in category 'file accessing') -----
localName

	^ FileDirectory localNameFor: self name
!

----- Method: FileStream>>longPrintOn: (in category 'printing') -----
longPrintOn: aStream
	"Do nothing, so it will print short.  Called to print the error file.  If the error was in a file operation, we can't read the contents of that file.  Just print its name instead."
!

----- Method: FileStream>>longPrintOn:limitedTo:indent: (in category 'printing') -----
longPrintOn: aStream limitedTo: sizeLimit indent: indent

	"Do nothing, so it will print short.  Called to print the error file.  If the error was in a file operation, we can't read the contents of that file.  Just print its name instead."

	aStream cr!

----- Method: FileStream>>mimeTypes (in category 'accessing') -----
mimeTypes
	^FileDirectory default mimeTypesFor: self name.!

----- Method: FileStream>>name (in category 'file accessing') -----
name
	"Answer the name of the file for the page the receiver is streaming over.  1/31/96 sw: made subclassResponsibility"

	self subclassResponsibility!

----- Method: FileStream>>next (in category 'accessing') -----
next

	(position >= readLimit and: [self atEnd])
		ifTrue: [^nil]
		ifFalse: [^collection at: (position := position + 1)]!

----- Method: FileStream>>next: (in category 'accessing') -----
next: anInteger

	| newCollection howManyRead increment |
	newCollection := collection species new: anInteger.
	howManyRead := 0.
	[howManyRead < anInteger] whileTrue:
		[self atEnd ifTrue:
			[(howManyRead + 1) to: anInteger do: [:i | newCollection at: i put: (self next)].
			^newCollection].
		increment := (readLimit - position) min: (anInteger - howManyRead).
		newCollection replaceFrom: (howManyRead + 1)
			to: (howManyRead := howManyRead + increment)
			with: collection
			startingAt: (position + 1).
		position := position + increment].
	^newCollection!

----- Method: FileStream>>nextPut: (in category 'accessing') -----
nextPut: aByte
	"1/31/96 sw: subclassResponsibility"

	self subclassResponsibility!

----- Method: FileStream>>nextPutAll: (in category 'accessing') -----
nextPutAll: aCollection
	"1/31/96 sw: made subclass responsibility"

	self subclassResponsibility!

----- Method: FileStream>>position (in category 'positioning') -----
position
	"Answer the current character position in the file.
	 1/31/96 sw: subclassResponsibility"

	self subclassResponsibility!

----- Method: FileStream>>position: (in category 'positioning') -----
position: pos
	"Set the current character position in the file to pos.
	 1/31/96 sw: made subclassResponsibility"

	self subclassResponsibility!

----- Method: FileStream>>printOn: (in category 'printing') -----
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: ' on '.
	self file printOn: aStream!

----- Method: FileStream>>readOnly (in category 'file modes') -----
readOnly
	"Set this file's mode to read-only."

	self subclassResponsibility
!

----- Method: FileStream>>readOnlyStream (in category 'file modes') -----
readOnlyStream
	^self readOnly!

----- Method: FileStream>>readWrite (in category 'file modes') -----
readWrite
	"Set this file's mode to read-write."

	self subclassResponsibility
!

----- Method: FileStream>>reopen (in category 'file open/close') -----
reopen
	"Ensure that the receiver is open, re-open it if necessary."
	"Details: Files that were open when a snapshot occurs are no longer valid when the snapshot is resumed. This operation re-opens the file if that has happened."

	self subclassResponsibility
!

----- Method: FileStream>>reset (in category 'positioning') -----
reset
	"Set the current character position to the beginning of the file.
	 1/31/96 sw: subclassResponsibility"

	self subclassResponsibility!

----- Method: FileStream>>setToEnd (in category 'positioning') -----
setToEnd
	"Set the current character position to the end of the File. The same as
	self position: self size.  1/31/96 sw: made subclassResponsibility"

	self subclassResponsibility!

----- Method: FileStream>>size (in category 'accessing') -----
size
	"Answer the size of the file in characters.
	 1/31/96 sw: made subclass responsibility"

	self subclassResponsibility!

----- Method: FileStream>>skip: (in category 'positioning') -----
skip: n
	"Set the character position to n characters from the current position.
	Error if not enough characters left in the file
	1/31/96 sw: made subclassResponsibility."
 
	self subclassResponsibility!

----- Method: FileStream>>text (in category 'file modes') -----
text
	"Set this file to text (ascii) mode."

	self ascii.
!

----- Method: FileStream>>truncate: (in category 'positioning') -----
truncate: pos
	"Truncate file to pos"

	self subclassResponsibility!

----- Method: FileStream>>viewGZipContents (in category 'editing') -----
viewGZipContents
	"View the contents of a gzipped file"

	| stringContents |
	self binary.
	stringContents := self contentsOfEntireFile.
	Cursor wait showWhile: [stringContents := (GZipReadStream on: stringContents) upToEnd].
	stringContents := stringContents asString withSqueakLineEndings.

	Workspace new
		contents: stringContents;
		openLabel: 'Decompressed contents of: ', self localName!

FileStream subclass: #StandardFileStream
	instanceVariableNames: 'name fileID buffer1'
	classVariableNames: 'Registry'
	poolDictionaries: ''
	category: 'Files-Kernel'!

!StandardFileStream commentStamp: '<historical>' prior: 0!
Provides a simple, platform-independent, interface to a file system.  This initial version ignores issues of Directories etc.  The instance-variable fallbackStream at the moment holds an instance of HFSMacFileStream, to bridge us to the new world while in the old.  The instance variable rwmode, inherited from class PositionableStream, here is used to hold a Boolean -- true means opened for read-write, false means opened for read-only.  2/12/96 sw!

StandardFileStream subclass: #CrLfFileStream
	instanceVariableNames: 'lineEndConvention'
	classVariableNames: 'LookAheadCount LineEndDefault LineEndStrings CrLf Cr Lf'
	poolDictionaries: ''
	category: 'Files-Kernel'!

!CrLfFileStream commentStamp: 'ls 11/10/2002 13:32' prior: 0!
I am the same as a regular file stream, except that when I am in text mode, I will automatically convert line endings between the underlying platform's convention, and Squeak's convention of carriage-return only.  The goal is that Squeak text files can be treated as OS text files, and vice versa.

In binary mode, I behave identically to a StandardFileStream.

To enable CrLfFileStream as the default file stream class for an entire image, modify FileStream class concreteStream .


There are two caveats on programming with CrLfFileStream.

First, the choice of text mode versus binary mode affects which characters are visible in Squeak, and no longer just affects whether those characters are returned as Character's or as Integer's.  Thus the choice of mode needs to be made very carefully, and must be based on intent instead of convenience of representation.  The methods asString, asByteArray, asCharacter, and asInteger can be used to convert between character and integer representations.  (Arguably, file streams should accept either strings or characters in nextPut: and nextPutAll:, but that is not the case right now.)

Second, arithmetic on positions no longer works, because one character that Squeak sees (carriage return) could map to two characters in the underlying file (carriage return plus line feed, on MS Windows and MS DOS).  Comparison between positions still works.  (This caveat could perhaps be fixed by maintaining a map between Squeak positions and positions in the underlying file, but it is complicated.  Consider, for example, updates to the middle of the file.  Also, consider that text files are rarely updated in the middle of the file, and that general random access to a text file is rarely very useful.  If general random access with specific file counts is desired, then the file is starting to sound like a binary file instead of a text file.)

!

----- Method: CrLfFileStream class>>defaultToCR (in category 'class initialization') -----
defaultToCR
	"CrLfFileStream defaultToCR"
	LineEndDefault := #cr.!

----- Method: CrLfFileStream class>>defaultToCRLF (in category 'class initialization') -----
defaultToCRLF
	"CrLfFileStream defaultToCRLF"
	LineEndDefault := #crlf.!

----- Method: CrLfFileStream class>>defaultToLF (in category 'class initialization') -----
defaultToLF
	"CrLfFileStream defaultToLF"
	LineEndDefault := #lf.!

----- Method: CrLfFileStream class>>guessDefaultLineEndConvention (in category 'class initialization') -----
guessDefaultLineEndConvention
	"Lets try to guess the line end convention from what we know about the
	path name delimiter from FileDirectory."
	FileDirectory pathNameDelimiter = $:
		ifTrue: [^ self defaultToCR].
	FileDirectory pathNameDelimiter = $/
		ifTrue: [((SmalltalkImage current getSystemAttribute: 1002) beginsWith: 'darwin')
				ifTrue: [^ self defaultToCR]
				ifFalse: [^ self defaultToLF]].
	FileDirectory pathNameDelimiter = $\
		ifTrue: [^ self defaultToCRLF].
	"in case we don't know"
	^ self defaultToCR!

----- Method: CrLfFileStream class>>initialize (in category 'class initialization') -----
initialize
	"CrLfFileStream initialize"
	Cr := Character cr.
	Lf := Character lf.
	CrLf := String with: Cr with: Lf.
	LineEndStrings := Dictionary new.
	LineEndStrings at: #cr put: (String with: Character cr).
	LineEndStrings at: #lf put: (String with: Character lf).
	LineEndStrings at: #crlf put: (String with: Character cr with: Character lf).
	LookAheadCount := 2048.
	Smalltalk addToStartUpList: self.
	self startUp.!

----- Method: CrLfFileStream class>>new (in category 'class initialization') -----
new

	^ (MultiByteFileStream new) wantsLineEndConversion: true; yourself.

!

----- Method: CrLfFileStream class>>startUp (in category 'class initialization') -----
startUp
	self guessDefaultLineEndConvention!

----- Method: CrLfFileStream>>ascii (in category 'access') -----
ascii
	super ascii.
	self detectLineEndConvention!

----- Method: CrLfFileStream>>binary (in category 'access') -----
binary
	super binary.
	lineEndConvention := nil!

----- Method: CrLfFileStream>>convertStringFromCr: (in category 'private') -----
convertStringFromCr: aString 
	| inStream outStream |
	lineEndConvention ifNil: [^ aString].
	lineEndConvention == #cr ifTrue: [^ aString].
	lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Cr with: Lf].
	"lineEndConvention == #crlf"
	inStream := ReadStream on: aString.
	outStream := WriteStream on: (String new: aString size).
	[inStream atEnd]
		whileFalse: 
			[outStream nextPutAll: (inStream upTo: Cr).
			(inStream atEnd not or: [aString last = Cr])
				ifTrue: [outStream nextPutAll: CrLf]].
	^ outStream contents!

----- Method: CrLfFileStream>>convertStringToCr: (in category 'private') -----
convertStringToCr: aString 
	| inStream outStream |
	lineEndConvention ifNil: [^ aString].
	lineEndConvention == #cr ifTrue: [^ aString].
	lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Lf with: Cr].
	"lineEndConvention == #crlf"
	inStream := ReadStream on: aString.
	outStream := WriteStream on: (String new: aString size).
	[inStream atEnd]
		whileFalse: 
			[outStream nextPutAll: (inStream upTo: Cr).
			(inStream atEnd not or: [aString last = Cr])
				ifTrue: 
					[outStream nextPut: Cr.
					inStream peek = Lf ifTrue: [inStream next]]].
	^ outStream contents!

----- Method: CrLfFileStream>>detectLineEndConvention (in category 'access') -----
detectLineEndConvention
	"Detect the line end convention used in this stream. The result may be either #cr, #lf or #crlf."
	| char numRead pos |
	self isBinary ifTrue: [^ self error: 'Line end conventions are not used on binary streams'].
	lineEndConvention := LineEndDefault.
	"Default if nothing else found"
	numRead := 0.
	pos := super position.
	[super atEnd not and: [numRead < LookAheadCount]]
		whileTrue: 
			[char := super next.
			char = Lf
				ifTrue: 
					[super position: pos.
					^ lineEndConvention := #lf].
			char = Cr
				ifTrue: 
					[super peek = Lf
						ifTrue: [lineEndConvention := #crlf]
						ifFalse: [lineEndConvention := #cr].
					super position: pos.
					^ lineEndConvention].
			numRead := numRead + 1].
	super position: pos.
	^ lineEndConvention!

----- Method: CrLfFileStream>>lineEndConvention (in category 'access') -----
lineEndConvention

	^lineEndConvention!

----- Method: CrLfFileStream>>next (in category 'access') -----
next
    | char secondChar |
    char := super next.
    self isBinary ifTrue: [^char].
    char == Cr ifTrue:
        [secondChar := super next.
        secondChar ifNotNil: [secondChar == Lf ifFalse: [self skip: -1]].
        ^Cr].
    char == Lf ifTrue: [^Cr].
    ^char!

----- Method: CrLfFileStream>>next: (in category 'access') -----
next: n

		| string peekChar |
		string := super next: n.
		string size = 0 ifTrue: [ ^string ].
		self isBinary ifTrue: [ ^string ].

		"if we just read a CR, and the next character is an LF, then skip the LF"
		( string last = Character cr ) ifTrue: [
			peekChar := super next.		"super peek doesn't work because it relies on #next"
			peekChar ~= Character lf ifTrue: [
				super position: (super position - 1) ]. ].
 
		string := string withSqueakLineEndings.

		string size = n ifTrue: [ ^string ].

		"string shrunk due to embedded crlfs; make up the difference"
		^string, (self next: n - string size)!

----- Method: CrLfFileStream>>nextPut: (in category 'access') -----
nextPut: char 
	(lineEndConvention notNil and: [char = Cr])
		ifTrue: [super nextPutAll: (LineEndStrings at: lineEndConvention)]
		ifFalse: [super nextPut: char].
	^ char!

----- Method: CrLfFileStream>>nextPutAll: (in category 'access') -----
nextPutAll: aString 
	super nextPutAll: (self convertStringFromCr: aString).
	^ aString
!

----- Method: CrLfFileStream>>open:forWrite: (in category 'open/close') -----
open: aFileName forWrite: writeMode 
	"Open the receiver.  If writeMode is true, allow write, else access will be 
	read-only. "
	| result |
	result := super open: aFileName forWrite: writeMode.
	result ifNotNil: [self detectLineEndConvention].
	^ result!

----- Method: CrLfFileStream>>peek (in category 'access') -----
peek
	"Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil.  "
	| next pos |
	self atEnd ifTrue: [^ nil].
	pos := self position.
	next := self next.
	self position: pos.
	^ next!

----- Method: CrLfFileStream>>upTo: (in category 'access') -----
upTo: aCharacter
	| newStream char |
	newStream := WriteStream on: (String new: 100).
	[(char := self next) isNil or: [char == aCharacter]]
		whileFalse: [newStream nextPut: char].
	^ newStream contents
!

----- Method: CrLfFileStream>>verbatim: (in category 'access') -----
verbatim: aString 
	super verbatim: (self convertStringFromCr: aString).
	^ aString!

CrLfFileStream subclass: #HtmlFileStream
	instanceVariableNames: 'prevPreamble'
	classVariableNames: 'TabThing'
	poolDictionaries: ''
	category: 'Files-Kernel'!

!HtmlFileStream commentStamp: 'mk 8/30/2005 15:10' prior: 0!
The Class apes StandardFileStream, but converts the text to HTML before putting it out (primarily intended for printOut).  It can be invoked with

	((FileStream fileNamed: 'changes.html') asHtml) fileOutChanges

Use usual FileStream methods to put out text converted to
	HTML fairly approximating that text  (for best looks, use 
	method:, methodHeader:, methodBody:, for code);

verbatim: puts text out without conversion;

command: put out HTML items, such as <br>, supplying the brackets.

header: and trailer: put out an HTML wrapper (preamble and closing text)

nextPut does the actual conversion, nextPutAll: defers characters to nextPut.

The code is fairly dumb at present, doing a wooden straightforward conversion of the text without attempting to capture the style or fonts in which the original text was rendered.  Tabs are handled awkwardly, using &nbsp, so that probably only leading strings are working right.  Style sheets now permit us to do a much neater looking job if there is interest in improving the looks of things.

Example:
	Perform
		HtmlFileStream example1
	and then navigate your browser to file 'example1.html'!

----- Method: HtmlFileStream class>>example1 (in category 'examples') -----
example1
	"This example shows how HtmlFileStream class can be used for generating HTML file."

	| htmlFileStream |
	htmlFileStream := HtmlFileStream newFrom: (FileStream fileNamed: 'example1.html').
	htmlFileStream
		header;
		command: 'H1';
		nextPutAll: 'Hello, world!!';
		command: '/H1';
		trailer;
		close.!

----- Method: HtmlFileStream class>>initialize (in category 'class initialization') -----
initialize   "HtmlFileStream initialize"
	TabThing := '&nbsp;&nbsp;&nbsp;'

"I took Ted's suggestion to use &nbsp, which works far better for the HTML.  Style sheets provide an alternative, possibly better, solution since they permit finer-grain control of the HTML formatting, and thus would permit capturing the style in which text was originally rendered.  Internal tabbings would still get lost. 1/1/99 acg."!

----- Method: HtmlFileStream class>>newFrom: (in category 'instance creation') -----
newFrom: aFileStream
	"Answer an HtmlFileStream that is 'like' aFileStream.  As a side-effect, the surviving fileStream answered by this method replaces aFileStream on the finalization registry. 1/6/99 acg"

	|inst|
	inst := super newFrom: aFileStream.
	StandardFileStream unregister: aFileStream.
	HtmlFileStream register: inst.
	inst detectLineEndConvention.
	^inst
!

----- Method: HtmlFileStream>>command: (in category 'HTML') -----
command: aString
	"Append HTML commands directly without translation.  Caller should not include < or >.  Note that font change info comes through here!!  4/5/96 tk"

	(aString includes: $<) ifTrue: [self error: 'Do not put < or > in arg'].
		"We do the wrapping with <> here!!  Don't put it in aString."
	^ self verbatim: '<', aString, '>'!

----- Method: HtmlFileStream>>copyMethodChunkFrom: (in category 'fileIn/Out') -----
copyMethodChunkFrom: aStream
	"Overridden to bolden the first line (presumably a method header)"
	| terminator code firstLine |
	terminator := $!!.
	aStream skipSeparators.
	code := aStream upTo: terminator.
	firstLine := code copyUpTo: Character cr.
	firstLine size = code size
		ifTrue: [self nextPutAll: code]
		ifFalse: [self command: 'b'; nextPutAll: firstLine; command: '/b'.
				self nextPutAll: (code copyFrom: firstLine size + 1 to: code size)].
	self nextPut: terminator.
	[aStream peekFor: terminator] whileTrue:   "case of imbedded (doubled) terminators"
			[self nextPut: terminator;
				nextPutAll: (aStream upTo: terminator);
				nextPut: terminator]!

----- Method: HtmlFileStream>>header (in category 'read, write, position') -----
header
	"append the HTML header.  Be sure to call trailer after you put out the data.
	4/4/96 tk"
	| cr |
	cr := String with: Character cr.
	self command: 'HTML'; verbatim: cr.
	self command: 'HEAD'; verbatim: cr.
	self command: 'TITLE'.
	self nextPutAll: '"', self name, '"'.
	self command: '/TITLE'; verbatim: cr.
	self command: '/HEAD'; verbatim: cr.
	self command: 'BODY'; verbatim: cr.
!

----- Method: HtmlFileStream>>nextChunk (in category 'fileIn/Out') -----
nextChunk
	"Answer the contents of the receiver, up to the next terminator character (!!).  Imbedded terminators are doubled.  Undo and strip out all Html stuff in the stream and convert the characters back.  4/12/96 tk"
	| out char did rest |
	self skipSeparators.	"Absorb <...><...> also"
	out := WriteStream on: (String new: 500).
	[self atEnd] whileFalse: [
		self peek = $< ifTrue: [self unCommand].	"Absorb <...><...>"
		(char := self next) = $&
			ifTrue: [
				rest := self upTo: $;.
				did := out position.
				rest = 'lt' ifTrue: [out nextPut: $<].
				rest = 'gt' ifTrue: [out nextPut: $>].
				rest = 'amp' ifTrue: [out nextPut: $&].
				did = out position ifTrue: [
					self error: 'new HTML char encoding'.
					"Please add it to this code"]]
			ifFalse: [char = $!!	"terminator"
				ifTrue: [
					self peek = $!! ifFalse: [^ out contents].
					out nextPut: self next]	"pass on one $!!"
				ifFalse: [char asciiValue = 9
							ifTrue: [self next; next; next; next "TabThing"].
						out nextPut: char]]
		].
	^ out contents!

----- Method: HtmlFileStream>>nextPut: (in category 'read, write, position') -----
nextPut: char
	"Put a character on the file, but translate it first. 4/6/96 tk 1/1/98 acg"
	char = $< ifTrue: [^ super nextPutAll: '&lt;'].
	char = $> ifTrue: [^ super nextPutAll: '&gt;'].
	char = $& ifTrue: [^ super nextPutAll: '&amp;'].
	char asciiValue = 13 "return" 
		ifTrue: [self command: 'br'].
	char = $	"tab" 
		ifTrue: [self verbatim: TabThing. ^super nextPut: char].
	^ super nextPut: char!

----- Method: HtmlFileStream>>nextPutAll: (in category 'read, write, position') -----
nextPutAll: aString
	"Write the whole string, translating as we go. 4/6/96 tk"
	"Slow, but faster than using aString asHtml?"

	aString do: [:each | self nextPut: each].!

----- Method: HtmlFileStream>>skipSeparators (in category 'fileIn/Out') -----
skipSeparators
	"Bsides the normal spacers, also skip any <...>, html commands.
	4/12/96 tk"
	| did |
	[did := self position.
		super skipSeparators.
		self unCommand.	"Absorb <...><...>"
		did = self position] whileFalse.	"until no change"
!

----- Method: HtmlFileStream>>trailer (in category 'read, write, position') -----
trailer
	"append the HTML trailer.  Call this just before file close.
	4/4/96 tk"
	| cr |
	cr := String with: Character cr.
	self command: '/BODY'; verbatim: cr.
	self command: '/HTML'; verbatim: cr.
!

----- Method: HtmlFileStream>>verbatim: (in category 'read, write, position') -----
verbatim: aString
	"Put out the string without HTML conversion. 1/1/99 acg"

	super nextPutAll: aString

	"'super verbatim:' in the 2.3beta draft didn't perform as expected -- the code was printed with conversion.  In a sense, that wouldn't make sense either -- we don't want strictly verbatim printing, just printing without the HTML conversion (that is, skipping around just the nextPut: and nextPutAll: for just this Class).  If there were intermediate conversions (say, CRLF!!), we would want those to happen as advertised -- perhaps we should use a differently named selector, perhaps something like nextPutWithoutHTMLConversion:, so that verbatim isn't overridden?"!

----- Method: StandardFileStream class>>fileDoesNotExistUserHandling: (in category 'error handling') -----
fileDoesNotExistUserHandling: fullFileName

	| selection newName |
	selection := (PopUpMenu labels:
'create a new file
choose another name
cancel')
			startUpWithCaption: (FileDirectory localNameFor: fullFileName) , '
does not exist.'.
	selection = 1 ifTrue:
		[^ self new open: fullFileName forWrite: true].
	selection = 2 ifTrue:
		[ newName := FillInTheBlank request: 'Enter a new file name'
						initialAnswer:  fullFileName.
		^ self oldFileNamed:
			(self fullName: newName)].
	self halt!

----- Method: StandardFileStream class>>fileExistsUserHandling: (in category 'error handling') -----
fileExistsUserHandling: fullFileName
	| dir localName choice newName newFullFileName |
	dir := FileDirectory forFileName: fullFileName.
	localName := FileDirectory localNameFor: fullFileName.
	choice := (PopUpMenu
		labels:
'overwrite that file\choose another name\cancel' withCRs)
		startUpWithCaption: localName, '
already exists.'.

	choice = 1 ifTrue: [
		dir deleteFileNamed: localName
			ifAbsent: [self error: 'Could not delete the old version of that file'].
		^ self new open: fullFileName forWrite: true].

	choice = 2 ifTrue: [
		newName := FillInTheBlank request: 'Enter a new file name' initialAnswer: fullFileName.
		newFullFileName := self fullName: newName.
		^ self newFileNamed: newFullFileName].

	self error: 'Please close this to abort file opening'!

----- Method: StandardFileStream class>>fileNamed: (in category 'file creation') -----
fileNamed: fileName
	"Open a file with the given name for reading and writing. If the name has no directory part, then the file will be created in the default directory. If the file already exists, its prior contents may be modified or replaced, but the file will not be truncated on close."

	^ self new open: (self fullName: fileName) forWrite: true
!

----- Method: StandardFileStream class>>forceNewFileNamed: (in category 'file creation') -----
forceNewFileNamed: fileName 
	"Create a new file with the given name, and answer a stream opened 
	for writing on that file. If the file already exists, delete it without 
	asking before creating the new file."
	| dir localName fullName f |
	fullName := self fullName: fileName.
	(self isAFileNamed: fullName)
		ifFalse: [f := self new open: fullName forWrite: true.
			^ f isNil
				ifTrue: ["Failed to open the file"
					(FileDoesNotExistException fileName: fullName) signal]
				ifFalse: [f]].
	dir := FileDirectory forFileName: fullName.
	localName := FileDirectory localNameFor: fullName.
	dir
		deleteFileNamed: localName
		ifAbsent: [(CannotDeleteFileException new
			messageText: 'Could not delete the old version of file ' , fullName) signal].
	f := self new open: fullName forWrite: true.
	^ f isNil
		ifTrue: ["Failed to open the file"
			(FileDoesNotExistException fileName: fullName) signal]
		ifFalse: [f]!

----- Method: StandardFileStream class>>isAFileNamed: (in category 'file creation') -----
isAFileNamed: fileName
	"Answer true if a file of the given name exists."

	| f |
	f := self new open: fileName forWrite: false.
	f ifNil: [^ false].
	f close.
	^ true
!

----- Method: StandardFileStream class>>isRunningAsBrowserPlugin (in category 'browser requests') -----
isRunningAsBrowserPlugin
	self new waitBrowserReadyFor: 1000 ifFail: [^false].
	^true!

----- Method: StandardFileStream class>>newFileNamed: (in category 'file creation') -----
newFileNamed: fileName
 	"Create a new file with the given name, and answer a stream opened for writing on that file. If the file already exists, ask the user what to do."

	| fullName |
	fullName := self fullName: fileName.

	^(self isAFileNamed: fullName)
		ifTrue: ["file already exists:"
			(FileExistsException fileName: fullName fileClass: self) signal]
		ifFalse: [self new open: fullName forWrite: true]

!

----- Method: StandardFileStream class>>oldFileNamed: (in category 'file creation') -----
oldFileNamed: fileName
	"Open an existing file with the given name for reading and writing. If the name has no directory part, then the file will be created in the default directory. If the file already exists, its prior contents may be modified or replaced, but the file will not be truncated on close."

	| fullName |
	fullName := self fullName: fileName.

	^(self isAFileNamed: fullName)
		ifTrue: [self new open: fullName forWrite: true]
		ifFalse: ["File does not exist..."
			(FileDoesNotExistException fileName: fullName) signal]!

----- Method: StandardFileStream class>>privateCheckForBrowserPrimitives (in category 'browser requests') -----
privateCheckForBrowserPrimitives
	<primitive:'primitivePluginBrowserReady'>
	^false!

----- Method: StandardFileStream class>>readOnlyFileDoesNotExistUserHandling: (in category 'error handling') -----
readOnlyFileDoesNotExistUserHandling: fullFileName

	| dir files choices selection newName fileName |
	dir := FileDirectory forFileName: fullFileName.
	files := dir fileNames.
	fileName := FileDirectory localNameFor: fullFileName.
	choices := fileName correctAgainst: files.
	choices add: 'Choose another name'.
	choices add: 'Cancel'.
	selection := (PopUpMenu labelArray: choices lines: (Array with: 5) )
		startUpWithCaption: (FileDirectory localNameFor: fullFileName), '
does not exist.'.
	selection = choices size ifTrue:["cancel" ^ nil "should we raise another exception here?"].
	selection < (choices size - 1) ifTrue: [
		newName := (dir pathName , FileDirectory slash , (choices at: selection))].
	selection = (choices size - 1) ifTrue: [
		newName := FillInTheBlank 
							request: 'Enter a new file name' 
							initialAnswer: fileName].
	newName = '' ifFalse: [^ self readOnlyFileNamed: (self fullName: newName)].
	^ self error: 'Could not open a file'!

----- Method: StandardFileStream class>>readOnlyFileNamed: (in category 'file creation') -----
readOnlyFileNamed: fileName 
	"Open an existing file with the given name for reading."

	| fullName f |
	fullName := self fullName: fileName.
	f := self new open: fullName forWrite: false.
	^ f isNil
		ifFalse: [f]
		ifTrue: ["File does not exist..."
			((FileDoesNotExistException fileName: fullName) readOnly: true) signal].

	"StandardFileStream readOnlyFileNamed: 'kjsd.txt' "!

----- Method: StandardFileStream class>>register: (in category 'registry') -----
register: anObject
	WeakArray isFinalizationSupported ifFalse:[^anObject].
	self registry add: anObject!

----- Method: StandardFileStream class>>registry (in category 'registry') -----
registry
	WeakArray isFinalizationSupported ifFalse:[^nil].
	^Registry isNil
		ifTrue:[Registry := WeakRegistry new]
		ifFalse:[Registry].!

----- Method: StandardFileStream class>>retryWithGC:until:forFileNamed: (in category 'registry') -----
retryWithGC: execBlock until: testBlock forFileNamed: fullName
	"Re-implemented to only force GC if a file with the given name exists"
	| blockValue foundIt |
	blockValue := execBlock value.
	(testBlock value: blockValue) ifTrue:[^blockValue].
	"See if we have a file with the given name"
	foundIt := Registry keys "hold on strongly for now" 
		anySatisfy:[:file| file name sameAs: fullName].
	foundIt ifFalse:[^blockValue].
	Smalltalk garbageCollectMost.
	blockValue := execBlock value.
	(testBlock value: blockValue) ifTrue:[^blockValue].
	Smalltalk garbageCollect.
	^execBlock value.!

----- Method: StandardFileStream class>>unregister: (in category 'registry') -----
unregister: anObject
	WeakArray isFinalizationSupported ifFalse:[^anObject].
	self registry remove: anObject ifAbsent:[]!

----- Method: StandardFileStream>>actAsExecutor (in category 'finalization') -----
actAsExecutor
	super actAsExecutor.
	name := nil.!

----- Method: StandardFileStream>>asHtml (in category 'properties-setting') -----
asHtml
	"Convert me in to an HtmlFileStream. 4/11/96 tk"

	^ self as: HtmlFileStream 
!

----- Method: StandardFileStream>>ascii (in category 'properties-setting') -----
ascii
	"opposite of binary"
	buffer1 := String new: 1!

----- Method: StandardFileStream>>atEnd (in category 'read, write, position') -----
atEnd
	"Answer whether the receiver is at its end.  "
	^ self primAtEnd: fileID!

----- Method: StandardFileStream>>basicNext (in category 'read, write, position') -----
basicNext
	"Answer the next byte from this file, or nil if at the end of the file."

	| count |
	count := self primRead: fileID into: buffer1 startingAt: 1 count: 1.
	count = 1
		ifTrue: [^ buffer1 at: 1]
		ifFalse: [^ nil].
!

----- Method: StandardFileStream>>binary (in category 'properties-setting') -----
binary
	buffer1 := ByteArray new: 1!

----- Method: StandardFileStream>>close (in category 'open/close') -----
close
	"Close this file."

	fileID ifNotNil: [
		self primClose: fileID.
		self unregister.
		fileID := nil].
!

----- Method: StandardFileStream>>closed (in category 'open/close') -----
closed
	"Answer true if this file is closed."

	^ fileID isNil or: [(self primSizeNoError: fileID) isNil]
!

----- Method: StandardFileStream>>compressFile (in category 'read, write, position') -----
compressFile
	"Write a new file that has the data in me compressed in GZip format."
	| zipped buffer |

	self readOnly; binary.
	zipped := self directory newFileNamed: (self name, FileDirectory dot, 'gz').
	zipped binary; setFileTypeToObject.
		"Type and Creator not to be text, so can be enclosed in an email"
	zipped := GZipWriteStream on: zipped.
	buffer := ByteArray new: 50000.
	'Compressing ', self fullName displayProgressAt: Sensor cursorPoint
		from: 0 to: self size
		during: [:bar |
			[self atEnd] whileFalse: [
				bar value: self position.
				zipped nextPutAll: (self nextInto: buffer)].
			zipped close.
			self close].
	^zipped!

----- Method: StandardFileStream>>defaultBrowserReadyWait (in category 'browser requests') -----
defaultBrowserReadyWait
	^5000!

----- Method: StandardFileStream>>directory (in category 'access') -----
directory
	"Return the directory containing this file."

	^ FileDirectory forFileName: self fullName
!

----- Method: StandardFileStream>>directoryUrl (in category 'access') -----
directoryUrl

	^ self directory url!

----- Method: StandardFileStream>>ensureOpen (in category 'open/close') -----
ensureOpen
	"Make sure that this file really is open."

	self closed ifTrue: [^ self reopen].
	(self primSizeNoError: fileID) ifNotNil: [^ self].
	self reopen.
!

----- Method: StandardFileStream>>file (in category 'access') -----
file
	"Answer the object representing the receiver's file.  Need for compatibility with some calls -- check senders.  2/14/96 sw"

	^ self!

----- Method: StandardFileStream>>finalize (in category 'finalization') -----
finalize
	self primCloseNoError: fileID.!

----- Method: StandardFileStream>>findString: (in category 'read, write, position') -----
findString: string
	"Fast version of #upToAll: to find a String in a file starting from the beginning.
	Returns the position and also sets the position there.
	If string is not found 0 is returned and position is unchanged."

	| pos buffer count oldPos sz |
	oldPos := self position.
	self reset.
	sz := self size.
	pos := 0.
	buffer := String new: 2000.
	[ buffer := self nextInto: buffer.
	(count := buffer findString: string) > 0
		ifTrue: ["Found the string part way into buffer"
			self position: pos.
			self next: count - 1.
			^self position ].
	pos := ((pos + 2000 - string size) min: sz).
	self position: pos.
	pos = sz] whileFalse.
	"Never found it, and hit end of file"
	self position: oldPos.
	^0!

----- Method: StandardFileStream>>findStringFromEnd: (in category 'read, write, position') -----
findStringFromEnd: string
	"Fast version to find a String in a file starting from the end.
	Returns the position and also sets the position there.
	If string is not found 0 is returned and position is unchanged."

	| pos buffer count oldPos |
	oldPos := self position.
	self setToEnd.
	pos := self position.
	[ pos := ((pos - 2000 + string size) max: 0).  "the [+ string size] allows for the case where the end of the search string is at the beginning of the current buffer"
	self position: pos.
	buffer := self next: 2000.
	(count := buffer findString: string) > 0
		ifTrue: ["Found the string part way into buffer"
			self position: pos.
			self next: count-1.  "use next instead of position:, so that CrLfFileStream can do its magic if it is being used"
			^self position].
	pos = 0] whileFalse.
	"Never found it, and hit beginning of file"
	self position: oldPos.
	^0!

----- Method: StandardFileStream>>flush (in category 'read, write, position') -----
flush
	"Flush pending changes"
	^self primFlush: fileID!

----- Method: StandardFileStream>>fullName (in category 'access') -----
fullName
	"Answer this file's full path name."

	^ name
!

----- Method: StandardFileStream>>getFileType (in category 'properties-setting') -----
getFileType
	"On the Macintosh, get the file type and creator of this file. On other platforms, do nothing."

	^FileDirectory default
		getMacFileTypeAndCreator: self fullName
		
!

----- Method: StandardFileStream>>insertLineFeeds (in category 'properties-setting') -----
insertLineFeeds
	"(FileStream oldFileNamed: 'BBfix2.st') insertLineFeeds"
	| s crLf f |
	crLf := String with: Character cr with: (Character value: 10).
	s := ReadStream on: (self next: self size).
	self close.
	f := FileStream newFileNamed: self name.
	[s atEnd] whileFalse: 
		[f nextPutAll: (s upTo: Character cr); nextPutAll: crLf].
	f close!

----- Method: StandardFileStream>>isBinary (in category 'properties-setting') -----
isBinary
	^ buffer1 class == ByteArray!

----- Method: StandardFileStream>>isDirectory (in category 'access') -----
isDirectory
	"Answer whether the receiver represents a directory.  For the post-transition case, uncertain what to do.  2/14/96 sw"
	^ false!

----- Method: StandardFileStream>>isReadOnly (in category 'properties-setting') -----
isReadOnly

	^ rwmode not
!

----- Method: StandardFileStream>>localName (in category 'access') -----
localName
	^ name ifNotNil: [(name findTokens: FileDirectory pathNameDelimiter asString) last]!

----- Method: StandardFileStream>>name (in category 'access') -----
name
	"Answer this file's full path name."

	^ name
!

----- Method: StandardFileStream>>next (in category 'read, write, position') -----
next
	"Answer the next byte from this file, or nil if at the end of the file."

	^ self basicNext!

----- Method: StandardFileStream>>next: (in category 'read, write, position') -----
next: n
	"Return a string with the next n characters of the filestream in it.  1/31/96 sw"
	^ self nextInto: (buffer1 class new: n)!

----- Method: StandardFileStream>>next:into:startingAt: (in category 'read, write, position') -----
next: n into: aString startingAt: startIndex
	"Read n bytes into the given string.
	Return aString or a partial copy if less than
	n elements have been read."
	| count |
	count := self primRead: fileID into: aString
				startingAt: startIndex count: n.
	count = n
		ifTrue:[^aString]
		ifFalse:[^aString copyFrom: 1 to: startIndex+count-1]!

----- Method: StandardFileStream>>next:putAll:startingAt: (in category 'read, write, position') -----
next: anInteger putAll: aString startingAt: startIndex
	"Store the next anInteger elements from the given collection."
	rwmode ifFalse: [^ self error: 'Cannot write a read-only file'].
	self primWrite: fileID from: aString startingAt: startIndex count: anInteger.
	^aString!

----- Method: StandardFileStream>>nextPut: (in category 'read, write, position') -----
nextPut: char
	"Write the given character to this file."

	rwmode ifFalse: [^ self error: 'Cannot write a read-only file'].
	buffer1 at: 1 put: char.
	self primWrite: fileID from: buffer1 startingAt: 1 count: 1.
	^ char
!

----- Method: StandardFileStream>>nextPutAll: (in category 'read, write, position') -----
nextPutAll: aString
	"Write all the characters of the given string to this file."

	rwmode ifFalse: [^ self error: 'Cannot write a read-only file'].
	self primWrite: fileID from: aString startingAt: 1 count: aString basicSize.
	^ aString
!

----- Method: StandardFileStream>>nextWordsInto: (in category 'read, write, position') -----
nextWordsInto: aBitmap
	"Note: The file primitives automatically adjust for word based objects."

	self next: aBitmap basicSize into: aBitmap startingAt: 1.
	aBitmap restoreEndianness.
	^ aBitmap!

----- Method: StandardFileStream>>open (in category 'open/close') -----
open
	"For compatibility with a few existing things.  2/14/96 sw"

	^ self reopen!

----- Method: StandardFileStream>>open:forWrite: (in category 'open/close') -----
open: fileName forWrite: writeMode 
	"Open the file with the given name. If writeMode is true, allow writing, otherwise open the file in read-only mode."
	"Changed to do a GC and retry before failing ar 3/21/98 17:25"
	| f |
	f := fileName asVmPathName.

	fileID := StandardFileStream retryWithGC:[self primOpen: f writable: writeMode] 
					until:[:id| id notNil] 
					forFileNamed: fileName.
	fileID ifNil: [^ nil].  "allows sender to detect failure"
	self register.
	name := fileName.
	rwmode := writeMode.
	buffer1 := String new: 1.
!

----- Method: StandardFileStream>>openReadOnly (in category 'open/close') -----
openReadOnly
	"Open the receiver as a read-only file.  1/31/96 sw"

	^ self open: name forWrite: false!

----- Method: StandardFileStream>>padToEndWith: (in category 'read, write, position') -----
padToEndWith: aChar
	"On the Mac, files do not truncate.  One can delete the old file and write a new one, but sometime deletion fails (file still open? file stale?).  This is a sad compromise.  Just let the file be the same length but pad it with a harmless character."

	| pad |
	self atEnd ifTrue: [^ self].
	pad := self isBinary 
		ifTrue: [aChar asCharacter asciiValue]	"ok for char or number"
		ifFalse: [aChar asCharacter].
	self nextPutAll: (buffer1 class new: ((self size - self position) min: 20000) 
							withAll: pad).!

----- Method: StandardFileStream>>peek (in category 'read, write, position') -----
peek
	"Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil.  "
	| next |
	self atEnd ifTrue: [^ nil].
	next := self basicNext.
	self position: self position - 1.
	^ next!

----- Method: StandardFileStream>>peekFor: (in category 'access') -----
peekFor: item 
	"Answer false and do not advance if the next element is not equal to item, or if this stream is at the end.  If the next element is equal to item, then advance over it and return true"
	| next |
	"self atEnd ifTrue: [^ false]. -- SFStream will give nil"
	(next := self next) == nil ifTrue: [^ false].
	item = next ifTrue: [^ true].
	self skip: -1.
	^ false!

----- Method: StandardFileStream>>peekLast (in category 'read, write, position') -----
peekLast
	"Return that item just put at the end of the stream"

	^ buffer1 size > 0 
		ifTrue: [buffer1 last]
		ifFalse: [nil]
!

----- Method: StandardFileStream>>position (in category 'read, write, position') -----
position
	"Return the receiver's current file position.  2/12/96 sw"

	^ self primGetPosition: fileID!

----- Method: StandardFileStream>>position: (in category 'read, write, position') -----
position: pos
	"Set the receiver's position as indicated.  2/12/96 sw"

	^ self primSetPosition: fileID to: pos!

----- Method: StandardFileStream>>post:target:url:ifError: (in category 'browser requests') -----
post: data target: target url: url ifError: errorBlock
	"Post data to the given URL. The returned file stream contains the reply of the server.
	If Squeak is not running in a browser evaluate errorBlock"
	| sema index request result |
	self waitBrowserReadyFor: self defaultBrowserReadyWait ifFail: [^errorBlock value].
	sema := Semaphore new.
	index := Smalltalk registerExternalObject: sema.
	request := self primURLPost: url target: target data: data semaIndex: index.
	request == nil ifTrue:[
	
	Smalltalk unregisterExternalObject: sema.
		^errorBlock value.
	] ifFalse:[
		[sema wait. "until something happens"
		result := self primURLRequestState: request.
		result == nil] whileTrue.
		result ifTrue:[fileID := self primURLRequestFileHandle: request].
		self primURLRequestDestroy: request.
	].
	Smalltalk unregisterExternalObject: sema.
	fileID == nil ifTrue:[^nil].
	self register.
	name := url.
	rwmode := false.
	buffer1 := String new: 1.!

----- Method: StandardFileStream>>post:url:ifError: (in category 'browser requests') -----
post: data url: url ifError: errorBlock

	self post: data target: nil url: url ifError: errorBlock!

----- Method: StandardFileStream>>primAtEnd: (in category 'primitives') -----
primAtEnd: id
	"Answer true if the file position is at the end of the file."

	<primitive: 'primitiveFileAtEnd' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: StandardFileStream>>primBrowserReady (in category 'browser requests') -----
primBrowserReady
	<primitive:'primitivePluginBrowserReady'>
	^nil!

----- Method: StandardFileStream>>primClose: (in category 'primitives') -----
primClose: id
	"Close this file."

	<primitive: 'primitiveFileClose' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: StandardFileStream>>primCloseNoError: (in category 'primitives') -----
primCloseNoError: id
	"Close this file. Don't raise an error if the primitive fails."

	<primitive: 'primitiveFileClose' module: 'FilePlugin'>
!

----- Method: StandardFileStream>>primDropRequestFileHandle: (in category 'dnd requests') -----
primDropRequestFileHandle: dropIndex
	"Primitive. Return the (read-only) file handle for some file that was just dropped onto Squeak.
	Fail if dropIndex is out of range or the primitive is not supported."
	<primitive: 'primitiveDropRequestFileHandle' module:'DropPlugin'>
	^nil!

----- Method: StandardFileStream>>primDropRequestFileName: (in category 'dnd requests') -----
primDropRequestFileName: dropIndex
	"Primitive. Return the file name for some file that was just dropped onto Squeak.
	Fail if dropIndex is out of range or the primitive is not supported."
	<primitive: 'primitiveDropRequestFileName' module:'DropPlugin'>
	^nil!

----- Method: StandardFileStream>>primFlush: (in category 'primitives') -----
primFlush: id
	"Flush pending changes to the disk"
	| p |
	<primitive: 'primitiveFileFlush' module: 'FilePlugin'>
	"In some OS's seeking to 0 and back will do a flush"
	p := self position.
	self position: 0; position: p!

----- Method: StandardFileStream>>primGetPosition: (in category 'primitives') -----
primGetPosition: id
	"Get this files current position."

	<primitive: 'primitiveFileGetPosition' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: StandardFileStream>>primOpen:writable: (in category 'primitives') -----
primOpen: fileName writable: writableFlag
	"Open a file of the given name, and return the file ID obtained.
	If writableFlag is true, then
		if there is none with this name, then create one
		else prepare to overwrite the existing from the beginning
	otherwise
		if the file exists, open it read-only
		else return nil"

	<primitive: 'primitiveFileOpen' module: 'FilePlugin'>
	^ nil
!

----- Method: StandardFileStream>>primRead:into:startingAt:count: (in category 'primitives') -----
primRead: id into: byteArray startingAt: startIndex count: count
	"Read up to count bytes of data from this file into the given string or byte array starting at the given index. Answer the number of bytes actually read."

	<primitive: 'primitiveFileRead' module: 'FilePlugin'>
	self closed ifTrue: [^ self error: 'File is closed'].
	self error: 'File read failed'.
!

----- Method: StandardFileStream>>primSetPosition:to: (in category 'primitives') -----
primSetPosition: id to: anInteger
	"Set this file to the given position."

	<primitive: 'primitiveFileSetPosition' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: StandardFileStream>>primSize: (in category 'primitives') -----
primSize: id
	"Answer the size of this file."

	<primitive: 'primitiveFileSize' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: StandardFileStream>>primSizeNoError: (in category 'primitives') -----
primSizeNoError: id
	"Answer the size of this file. Answer nil if the primitive fails; this indicates that the file handle has become stale."

	<primitive: 'primitiveFileSize' module: 'FilePlugin'>
	^ nil
!

----- Method: StandardFileStream>>primTruncate:to: (in category 'primitives') -----
primTruncate: id to: anInteger
	"Truncate this file to the given position."

	<primitive: 'primitiveFileTruncate' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: StandardFileStream>>primURLPost:data:semaIndex: (in category 'browser requests') -----
primURLPost: url data: contents semaIndex: index
	^self primURLPost: url target: nil data: contents semaIndex: index!

----- Method: StandardFileStream>>primURLPost:target:data:semaIndex: (in category 'browser requests') -----
primURLPost: url target: target data: contents semaIndex: index
	"Post the data (url might be 'mailto:' etc)"
	<primitive:'primitivePluginPostURL'>
	^nil
 !

----- Method: StandardFileStream>>primURLRequest:semaIndex: (in category 'browser requests') -----
primURLRequest: url semaIndex: index
	<primitive:'primitivePluginRequestURLStream'>
	^nil!

----- Method: StandardFileStream>>primURLRequest:target:semaIndex: (in category 'browser requests') -----
primURLRequest: url target: target semaIndex: index
	"target - String (frame, also ':=top', ':=parent' etc)"
	<primitive:'primitivePluginRequestURL'>
	^nil
 !

----- Method: StandardFileStream>>primURLRequestDestroy: (in category 'browser requests') -----
primURLRequestDestroy: request
	<primitive:'primitivePluginDestroyRequest'>
	^nil!

----- Method: StandardFileStream>>primURLRequestFileHandle: (in category 'browser requests') -----
primURLRequestFileHandle: request
	<primitive: 'primitivePluginRequestFileHandle'>
	^nil!

----- Method: StandardFileStream>>primURLRequestState: (in category 'browser requests') -----
primURLRequestState: request
	<primitive:'primitivePluginRequestState'>
	^false!

----- Method: StandardFileStream>>primWrite:from:startingAt:count: (in category 'primitives') -----
primWrite: id from: stringOrByteArray startingAt: startIndex count: count
	"Write count bytes onto this file from the given string or byte array starting at the given index. Answer the number of bytes written."

	<primitive: 'primitiveFileWrite' module: 'FilePlugin'>
	self closed ifTrue: [^ self error: 'File is closed'].
	self error: 'File write failed'.
!

----- Method: StandardFileStream>>printOn: (in category 'access') -----
printOn: aStream
	"Put a printed version of the receiver onto aStream.  1/31/96 sw"

	aStream nextPutAll: self class name; nextPutAll: ': '; print: name!

----- Method: StandardFileStream>>readInto:startingAt:count: (in category 'read, write, position') -----
readInto: byteArray startingAt: startIndex count: count
	"Read into the given array as specified, and return the count
	actually transferred.  index and count are in units of bytes or
	longs depending on whether the array is Bitmap, String or ByteArray"
	^ self primRead: fileID into: byteArray
			startingAt: startIndex count: count
!

----- Method: StandardFileStream>>readOnly (in category 'properties-setting') -----
readOnly
	"Make this file read-only."

	rwmode := false.
!

----- Method: StandardFileStream>>readOnlyCopy (in category 'read, write, position') -----
readOnlyCopy

	^ self class readOnlyFileNamed: self name.
!

----- Method: StandardFileStream>>readWrite (in category 'properties-setting') -----
readWrite
	"Make this file writable."

	rwmode := true.
!

----- Method: StandardFileStream>>register (in category 'registry') -----
register
	^self class register: self!

----- Method: StandardFileStream>>reopen (in category 'open/close') -----
reopen
	"Close and reopen this file. The file position is reset to zero."
	"Details: Files that were open when a snapshot occurs are no longer valid when the snapshot is resumed. This operation re-opens the file if that has happened."

	fileID ifNotNil: [self primCloseNoError: fileID].
	self open: name forWrite: rwmode.
!

----- Method: StandardFileStream>>requestDropStream: (in category 'dnd requests') -----
requestDropStream: dropIndex
	"Return a read-only stream for some file the user has just dropped onto Squeak."
	| rawName |
	rawName := self primDropRequestFileName: dropIndex.
	name :=  (FilePath pathName: rawName isEncoded: true) asSqueakPathName.
	fileID := self primDropRequestFileHandle: dropIndex.
	fileID == nil ifTrue:[^nil].
	self register.
	rwmode := false.
	buffer1 := String new: 1.

!

----- Method: StandardFileStream>>requestURL:target: (in category 'browser requests') -----
requestURL: url target: target
	^self requestURL: url target: target ifError: [nil]!

----- Method: StandardFileStream>>requestURL:target:ifError: (in category 'browser requests') -----
requestURL: url target: target ifError: errorBlock
	"Request to go to the target for the given URL.
	If Squeak is not running in a browser evaluate errorBlock"

	| sema index request result |
	self waitBrowserReadyFor: self defaultBrowserReadyWait ifFail: [^errorBlock value].
	sema := Semaphore new.
	index := Smalltalk registerExternalObject: sema.
	request := self primURLRequest: url target: target semaIndex: index.
	request == nil ifTrue:[
	
	Smalltalk unregisterExternalObject: sema.
		^errorBlock value.
	] ifFalse:[
		[sema wait. "until something happens"
		result := self primURLRequestState: request.
		result == nil] whileTrue.
		self primURLRequestDestroy: request.
	].
	Smalltalk unregisterExternalObject: sema.
	fileID == nil ifTrue:[^nil].
	self register.
	name := url.
	rwmode := false.
	buffer1 := String new: 1.!

----- Method: StandardFileStream>>requestURLStream: (in category 'browser requests') -----
requestURLStream: url
	"FileStream requestURLStream:'http://www.squeak.org'"
	^self requestURLStream: url ifError:[nil]!

----- Method: StandardFileStream>>requestURLStream:ifError: (in category 'browser requests') -----
requestURLStream: url ifError: errorBlock
	"Request a FileStream for the given URL.
	If Squeak is not running in a browser evaluate errorBlock"
	"FileStream requestURLStream:'http://www.squeak.org'"
	| sema index request result |
	self waitBrowserReadyFor: self defaultBrowserReadyWait ifFail: [^errorBlock value].
	sema := Semaphore new.
	index := Smalltalk registerExternalObject: sema.
	request := self primURLRequest: url semaIndex: index.
	request == nil ifTrue:[
	
	Smalltalk unregisterExternalObject: sema.
		^errorBlock value.
	] ifFalse:[
		[sema wait. "until something happens"
		result := self primURLRequestState: request.
		result == nil] whileTrue.
		result ifTrue:[fileID := self primURLRequestFileHandle: request].
		self primURLRequestDestroy: request.
	].
	Smalltalk unregisterExternalObject: sema.
	fileID == nil ifTrue:[^nil].
	self register.
	name := url.
	rwmode := false.
	buffer1 := String new: 1.!

----- Method: StandardFileStream>>reset (in category 'access') -----
reset
	self ensureOpen.
	self position: 0.!

----- Method: StandardFileStream>>setFileTypeToObject (in category 'properties-setting') -----
setFileTypeToObject
	"On the Macintosh, set the file type and creator of this file to be a Squeak object file. On other platforms, do nothing. Setting the file type allows Squeak object files to be sent as email attachments and launched by double-clicking. On other platforms, similar behavior is achieved by creating the file with the '.sqo' file name extension."

	FileDirectory default
		setMacFileNamed: self fullName
		type: 'SOBJ'
		creator: 'FAST'.
!

----- Method: StandardFileStream>>setToEnd (in category 'read, write, position') -----
setToEnd
	"Set the position of the receiver to the end of file.  1/31/96 sw"

	self position: self size!

----- Method: StandardFileStream>>size (in category 'access') -----
size
	"Answer the size of the file in characters.  2/12/96 sw"

	^ self primSize: fileID!

----- Method: StandardFileStream>>skip: (in category 'read, write, position') -----
skip: n
	"Set the character position to n characters from the current position.
	Error if not enough characters left in the file.  1/31/96 sw"

	self position: self position + n!

----- Method: StandardFileStream>>truncate (in category 'read, write, position') -----
truncate
	"Truncate to zero"

	^ self truncate: 0!

----- Method: StandardFileStream>>truncate: (in category 'read, write, position') -----
truncate: pos
	"Truncate to this position"

	self position: pos.
	^self primTruncate: fileID to: pos!

----- Method: StandardFileStream>>unregister (in category 'registry') -----
unregister
	^self class unregister: self!

----- Method: StandardFileStream>>upTo: (in category 'read, write, position') -----
upTo: delim 
	"Fast version to speed up nextChunk"
	| pos buffer count |
	pos := self position.
	buffer := self next: 2000.
	(count := buffer indexOf: delim) > 0 ifTrue: 
		["Found the delimiter part way into buffer"
		self position: pos + count.
		^ buffer copyFrom: 1 to: count - 1].
	self atEnd ifTrue:
		["Never found it, and hit end of file"
		^ buffer].
	"Never found it, but there's more..."
	^ buffer , (self upTo: delim)!

----- Method: StandardFileStream>>upToEnd (in category 'read, write, position') -----
upToEnd
	"Answer a subcollection from the current access position through the last element of the receiver."

	| newStream buffer |
	buffer := buffer1 species new: 1000.
	newStream := WriteStream on: (buffer1 species new: 100).
	[self atEnd] whileFalse: [newStream nextPutAll: (self nextInto: buffer)].
	^ newStream contents!

----- Method: StandardFileStream>>verbatim: (in category 'read, write, position') -----
verbatim: aString
	"A version of nextPutAll that can be called knowing it won't call nextPut: "

	^ self nextPutAll: aString
!

----- Method: StandardFileStream>>waitBrowserReadyFor:ifFail: (in category 'browser requests') -----
waitBrowserReadyFor: timeout ifFail: errorBlock
	| startTime delay okay |
	okay := self primBrowserReady.
	okay ifNil:[^errorBlock value].
	okay ifTrue: [^true].
	startTime := Time millisecondClockValue.
	delay := Delay forMilliseconds: 100.
	[(Time millisecondsSince: startTime) < timeout]
		whileTrue: [
			delay wait.
			okay := self primBrowserReady.
			okay ifNil:[^errorBlock value].
			okay ifTrue: [^true]].
	^errorBlock value!

Object subclass: #AsyncFile
	instanceVariableNames: 'name writeable semaphore fileHandle'
	classVariableNames: 'Busy ErrorCode'
	poolDictionaries: ''
	category: 'Files-Kernel'!

!AsyncFile commentStamp: '<historical>' prior: 0!
An asynchronous file allows simple file read and write operations to be performed in parallel with other processing. This is useful in multimedia applications that need to stream large amounts of sound or image data from or to a file while doing other work.
!

----- Method: AsyncFile class>>initialize (in category 'class initialization') -----
initialize
	"AsyncFile initialize"

	"Possible abnormal I/O completion results."
	Busy := -1.
	ErrorCode := -2.
!

----- Method: AsyncFile>>close (in category 'as yet unclassified') -----
close

	fileHandle ifNil: [^ self].  "already closed"
	self primClose: fileHandle.
	Smalltalk unregisterExternalObject: semaphore.
	semaphore := nil.
	fileHandle := nil.
!

----- Method: AsyncFile>>fileHandle (in category 'as yet unclassified') -----
fileHandle
	^ fileHandle!

----- Method: AsyncFile>>open:forWrite: (in category 'as yet unclassified') -----
open: fullFileName forWrite: aBoolean
	"Open a file of the given name, and return a handle for that file. Answer the receiver if the primitive succeeds, nil otherwise.
	If openForWrite is true, then:
		if there is no existing file with this name, then create one
		else open the existing file in read-write mode
	otherwise:
		if there is an existing file with this name, then open it read-only
		else answer nil."
	"Note: if an exisiting file is opened for writing, it is NOT truncated. If truncation is desired, the file should be deleted before being opened as an asynchronous file."
	"Note: On some platforms (e.g., Mac), a file can only have one writer at a time."

	| semaIndex |
	name := fullFileName.
	writeable := aBoolean.
	semaphore := Semaphore new.
	semaIndex := Smalltalk registerExternalObject: semaphore.
	fileHandle := self primOpen: name asVmPathName forWrite: writeable semaIndex: semaIndex.
	fileHandle ifNil: [
		Smalltalk unregisterExternalObject: semaphore.
		semaphore := nil.
		^ nil].
!

----- Method: AsyncFile>>primClose: (in category 'primitives') -----
primClose: fHandle
	"Close this file. Do nothing if primitive fails."

	<primitive: 'primitiveAsyncFileClose' module: 'AsynchFilePlugin'>
!

----- Method: AsyncFile>>primOpen:forWrite:semaIndex: (in category 'primitives') -----
primOpen: fileName forWrite: openForWrite semaIndex: semaIndex
	"Open a file of the given name, and return a handle for that file. Answer the receiver if the primitive succeeds, nil otherwise."

	<primitive: 'primitiveAsyncFileOpen' module: 'AsynchFilePlugin'>
	^ nil
!

----- Method: AsyncFile>>primReadResult:intoBuffer:at:count: (in category 'primitives') -----
primReadResult: fHandle intoBuffer: buffer at: startIndex count: count
	"Copy the result of the last read operation into the given buffer starting at the given index. The buffer may be any sort of bytes or words object, excluding CompiledMethods. Answer the number of bytes read. A negative result means:
		-1 the last operation is still in progress
		-2 the last operation encountered an error"

	<primitive: 'primitiveAsyncFileReadResult' module: 'AsynchFilePlugin'>
	self primitiveFailed
!

----- Method: AsyncFile>>primReadStart:fPosition:count: (in category 'primitives') -----
primReadStart: fHandle fPosition: fPosition count: count
	"Start a read operation of count bytes starting at the given offset in the given file."

	<primitive: 'primitiveAsyncFileReadStart' module: 'AsynchFilePlugin'>
	self error: 'READ THE COMMENT FOR THIS METHOD.'

"NOTE: This method will fail if there is insufficient C heap to allocate an internal buffer of the required size (the value of count).  If you are trying to read a movie file, then the buffer size will be height*width*2 bytes.  Each Squeak image retains a value to be used for this allocation, and it it initially set to 0.  If you are wish to play a 640x480 movie, you need room for a buffer of 640*480*2 = 614400 bytes.  You should execute the following...

	Smalltalk extraVMMemory 2555000.

Then save-and-quit, restart, and try to open the movie file again.  If you are using Async files in another way, find out the value of count when this failure occurs (call it NNNN), and instead of the above, execute...

	Smalltalk extraVMMemory: Smalltalk extraVMMemory + NNNN

then save-and-quit, restart, and try again.
"

!

----- Method: AsyncFile>>primWriteResult: (in category 'primitives') -----
primWriteResult: fHandle
	"Answer the number of bytes written. A negative result means:
		-1 the last operation is still in progress
		-2 the last operation encountered an error"

	<primitive: 'primitiveAsyncFileWriteResult' module: 'AsynchFilePlugin'>
	self primitiveFailed
!

----- Method: AsyncFile>>primWriteStart:fPosition:fromBuffer:at:count: (in category 'primitives') -----
primWriteStart: fHandle fPosition: fPosition fromBuffer: buffer at: startIndex count: count
	"Start a write operation of count bytes starting at the given index in the given buffer. The buffer may be any sort of bytes or words object, excluding CompiledMethods. The contents of the buffer are copied into an internal buffer immediately, so the buffer can be reused after the write operation has been started. Fail if there is insufficient C heap to allocate an internal buffer of the requested size."

	<primitive: 'primitiveAsyncFileWriteStart' module: 'AsynchFilePlugin'>
	writeable ifFalse: [^ self error: 'attempt to write a file opened read-only'].
	self primitiveFailed
!

----- Method: AsyncFile>>readByteCount:fromFilePosition:onCompletionDo: (in category 'as yet unclassified') -----
readByteCount: byteCount fromFilePosition: fPosition onCompletionDo: aBlock
	"Start a read operation to read byteCount's from the given position in this file. and fork a process to await its completion. When the operation completes, evaluate the given block. Note that, since the completion block may run asynchronous, the client may need to use a SharedQueue or a semaphore for synchronization."

	| buffer n |
	buffer := String new: byteCount.
	self primReadStart: fileHandle fPosition: fPosition count: byteCount.
	"here's the process that awaits the results:"
	[
		[	semaphore wait.
		  	n := self primReadResult: fileHandle intoBuffer: buffer at: 1 count: byteCount.
		  	n = Busy.
		] whileTrue.  "loop while busy in case the semaphore had excess signals"
		n = ErrorCode ifTrue: [^ self error: 'asynchronous read operation failed'].
		aBlock value: buffer.
	] forkAt: Processor userInterruptPriority.
!

----- Method: AsyncFile>>test:fileName: (in category 'as yet unclassified') -----
test: byteCount fileName: fileName
	"AsyncFile new test: 10000 fileName: 'testData'"

	| buf1 buf2 bytesWritten bytesRead |
	buf1 := String new: byteCount withAll: $x.
	buf2 := String new: byteCount.
	self open: ( FileDirectory default fullNameFor: fileName) forWrite: true.
	self primWriteStart: fileHandle
		fPosition: 0
		fromBuffer: buf1
		at: 1
		count: byteCount.
	semaphore wait.
	bytesWritten := self primWriteResult: fileHandle.
	self close.
	
	self open: ( FileDirectory default fullNameFor: fileName) forWrite: false.
	self primReadStart: fileHandle fPosition: 0 count: byteCount.
	semaphore wait.
	bytesRead :=
		self primReadResult: fileHandle
			intoBuffer: buf2
			at: 1
			count: byteCount.
	self close.

	buf1 = buf2 ifFalse: [self error: 'buffers do not match'].
	^ 'wrote ', bytesWritten printString, ' bytes; ',
	   'read ', bytesRead printString, ' bytes'
!

----- Method: AsyncFile>>waitForCompletion (in category 'as yet unclassified') -----
waitForCompletion
	semaphore wait!

----- Method: AsyncFile>>writeBuffer:atFilePosition:onCompletionDo: (in category 'as yet unclassified') -----
writeBuffer: buffer atFilePosition: fPosition onCompletionDo: aBlock
	"Start an operation to write the contents of the buffer at given position in this file, and fork a process to await its completion. When the write completes, evaluate the given block. Note that, since the completion block runs asynchronously, the client may need to use a SharedQueue or a semaphore for synchronization."

	| n |
	self primWriteStart: fileHandle
		fPosition: fPosition
		fromBuffer: buffer
		at: 1
		count: buffer size.
	"here's the process that awaits the results:"
	[
		[	semaphore wait.
		  	n := self primWriteResult: fileHandle.
		  	n = Busy.
		] whileTrue.  "loop while busy in case the semaphore had excess signals"
		n = ErrorCode ifTrue: [^ self error: 'asynchronous write operation failed'].
		n = buffer size ifFalse: [^ self error: 'did not write the entire buffer'].
		aBlock value.
	] forkAt: Processor userInterruptPriority.
!

Object subclass: #FileDirectory
	instanceVariableNames: 'pathName'
	classVariableNames: 'StandardMIMEMappings DirectoryClass DefaultDirectory'
	poolDictionaries: ''
	category: 'Files-Directories'!

!FileDirectory commentStamp: '<historical>' prior: 0!
A FileDirectory represents a folder or directory in the underlying platform's file system. It carries a fully-qualified path name for the directory it represents, and can enumerate the files and directories within that directory.

A FileDirectory can be thought of as a Dictionary whose keys are the local names of files in that directory, and whose values are directory "entries". Each entry is an array of five items:

	<name> <creationTime> <modificationTime> <dirFlag> <fileSize>

The times are given in seconds, and can be converted to a time and date via Time>dateAndTimeFromSeconds:. See the comment in lookupEntry:... which provides primitive access to this information.
!

FileDirectory subclass: #AcornFileDirectory
	instanceVariableNames: ''
	classVariableNames: 'LegalCharMap'
	poolDictionaries: ''
	category: 'Files-Directories'!

----- Method: AcornFileDirectory class>>initialize (in category 'class initialization') -----
initialize
"Set up the legal chars map for filenames. May need extending for unicode etc.
Basic rule is that any char legal for use in filenames will have a non-nil entry in this array; except for space, this is the same character. Space is transcoded to a char 160 to be a 'hard space' "
"AcornFileDirectory initialize"
	| aVal |
	LegalCharMap := Array new: 256.
	Character alphabet do:[:c|
		LegalCharMap at: c asciiValue +1  put: c.
		LegalCharMap at: (aVal := c asUppercase) asciiValue +1 put: aVal].
	'`!!()-_=+[{]};~,./1234567890' do:[:c|
			LegalCharMap at: c asciiValue + 1 put: c].
	LegalCharMap at: Character space asciiValue +1 put: (Character value:160 "hardspace").
	LegalCharMap at: 161 put: (Character value:160 "hardspace")."secondary mapping to keep it in strings"!

----- Method: AcornFileDirectory class>>isActiveDirectoryClass (in category 'platform specific') -----
isActiveDirectoryClass
	"Does this class claim to be that properly active subclass of FileDirectory  
	for the current platform? On Acorn, the test is whether platformName 
	is 'RiscOS' (on newer VMs) or if the primPathNameDelimiter is $. (on
	older ones), which is what we would like to use for a dirsep if only it
	would work out. See pathNameDelimiter for more woeful details - then
	just get on and enjoy Squeak"

	^ SmalltalkImage current platformName = 'RiscOS'
		or: [self primPathNameDelimiter = $.]!

----- Method: AcornFileDirectory class>>isCaseSensitive (in category 'platform specific') -----
isCaseSensitive
	"Risc OS ignores the case of file names"
	^ false!

----- Method: AcornFileDirectory class>>maxFileNameLength (in category 'platform specific') -----
maxFileNameLength

	^ 255
!

----- Method: AcornFileDirectory class>>pathNameDelimiter (in category 'platform specific') -----
pathNameDelimiter
"Acorn RiscOS uses a dot as the directory separator and has no real concept of filename extensions. We tried to make code handle this, but there are just too many uses of dot as a filename extension - so fake it out by pretending to use a slash. The file prims do conversions instead.
Sad, but pragmatic"
	^ $/
!

----- Method: AcornFileDirectory>>checkName:fixErrors: (in category 'file name utilities') -----
checkName: aFileName fixErrors: fixing
	"Check if the file name contains any invalid characters"
	| fName hasBadChars correctedName newChar|
	fName := super checkName: aFileName fixErrors: fixing.
	correctedName := String streamContents:[:s|
								fName do:[:c|
									(newChar := LegalCharMap at: c asciiValue +1) ifNotNil:[s nextPut: newChar]]]. 
	hasBadChars := fName ~= correctedName.
	(hasBadChars and:[fixing not]) ifTrue:[^self error:'Invalid file name'].
	hasBadChars ifFalse:[^ fName].
	^ correctedName!

----- Method: AcornFileDirectory>>directoryContentsFor: (in category 'private') -----
directoryContentsFor: fullPath 
	"Return a collection of directory entries for the files and directories in 
	the directory with the given path. See primLookupEntryIn:index: for 
	further details."
	"FileDirectory default directoryContentsFor: ''"

	| entries extraPath |
	entries := super directoryContentsFor: fullPath.
	fullPath isNullPath
		ifTrue: [
			"For Acorn we also make sure that at least the parent of the current dir 
			is added - sometimes this is in a filing system that has not been (or 
			cannot be) polled for disc root names"
			extraPath := self class default containingDirectory.
			"Only add the extra path if we haven't already got the root of the current dir in the list"
			entries detect: [:ent | extraPath fullName beginsWith: ent name] 
				ifNone: [entries := entries
								copyWith: (DirectoryEntry
										name: extraPath fullName
										creationTime: 0
										modificationTime: 0
										isDirectory: true
										fileSize: 0)]].
	^ entries
!

----- Method: AcornFileDirectory>>directoryExists: (in category 'testing') -----
directoryExists: filenameOrPath
"if the path is a root,we have to treat it carefully"
	(filenameOrPath endsWith: '$') ifTrue:[^(FileDirectory on: filenameOrPath) exists].
	^(self directoryNamed: filenameOrPath ) exists!

----- Method: AcornFileDirectory>>fullPathFor: (in category 'file name utilities') -----
fullPathFor: path
	"if the arg is an empty string, just return my path name converted via the language stuff. 
If the arg seems to be a  rooted path, return it raw, assuming it is already ok.
Otherwise cons up a path"
	path isEmpty ifTrue:[^pathName asSqueakPathName].
	((path includes: $$ ) or:[path includes: $:]) ifTrue:[^path].
	^pathName asSqueakPathName, self slash, path!

----- Method: AcornFileDirectory>>pathParts (in category 'path access') -----
pathParts
	"Return the path from the root of the file system to this directory as an 
	array of directory names.
	This version tries to cope with the RISC OS' strange filename formatting; 
	filesystem::discname/$/path/to/file
	where the $ needs to be considered part of the filingsystem-discname atom."
	| pathList |
	pathList := super pathParts.
	(pathList indexOf: '$') = 2
		ifTrue: ["if the second atom is root ($) then stick $ on the first atom 
				and drop the second. Yuck"
			^ Array
				streamContents: [:a | 
					a nextPut: (pathList at: 1), '/$'.
					3 to: pathList size do: [:i | a
								nextPut: (pathList at: i)]]].
	^ pathList!

FileDirectory subclass: #DosFileDirectory
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Directories'!

!DosFileDirectory commentStamp: '<historical>' prior: 0!
I represent a DOS or Windows FileDirectory.
!

----- Method: DosFileDirectory class>>isCaseSensitive (in category 'platform specific') -----
isCaseSensitive
	"Return true if file names are treated case sensitive"
	^false!

----- Method: DosFileDirectory class>>isDrive: (in category 'platform specific') -----
isDrive: fullName
	"Answer whether the given full name describes a 'drive', e.g., one of the root directories of a Win32 file system. We allow two forms here - the classic one where a drive is specified by a letter followed by a colon, e.g., 'C:', 'D:' etc. and the network share form starting with double-backslashes e.g., '\\server'."
	^ (fullName size = 2 and: [fullName first isLetter and: [fullName last = $:]])
		or: [(fullName beginsWith: '\\') and: [(fullName occurrencesOf: $\) = 2]]!

----- Method: DosFileDirectory class>>maxFileNameLength (in category 'platform specific') -----
maxFileNameLength

	^ 255
!

----- Method: DosFileDirectory class>>pathNameDelimiter (in category 'platform specific') -----
pathNameDelimiter

	^ $\
!

----- Method: DosFileDirectory class>>splitName:to: (in category 'platform specific') -----
splitName: fullName to: pathAndNameBlock
	"Take the file name and convert it to the path name of a directory and a local file name within that directory. 
	IMPORTANT NOTE: For 'drives', e.g., roots of the file system on Windows we treat the full name of that 'drive' as the local name rather than the path. This is because conceptually, all of these 'drives' hang off the virtual root of the entire Squeak file system, specified by FileDirectory root. In order to be consistent with, e.g., 

		DosFileDirectory localNameFor: 'C:\Windows' -> 'Windows'
		DosFileDirectory dirPathFor: 'C:\Windows' -> 'C:'

	we expect the following to be true:

		DosFileDirectory localNameFor: 'C:' -> 'C:'
		DosFileDirectory dirPathFor: 'C:'. -> ''
		DosFileDirectory localNameFor: '\\server' -> '\\server'.
		DosFileDirectory dirPathFor: '\\server' -> ''.

	so that in turn the following relations hold:

		| fd |
		fd := DosFileDirectory on: 'C:\Windows'.
		fd containingDirectory includes: fd localName.
		fd := DosFileDirectory on: 'C:'.
		fd containingDirectory includes: fd localName.
		fd := DosFileDirectory on: '\\server'.
		fd containingDirectory includes: fd localName.
	"
	(self isDrive: fullName)
		ifTrue: [^ pathAndNameBlock value:''  value: fullName].
	^ super splitName: fullName to: pathAndNameBlock!

----- Method: DosFileDirectory>>checkName:fixErrors: (in category 'as yet unclassified') -----
checkName: aFileName fixErrors: fixing
	"Check if the file name contains any invalid characters"
	| fName badChars hasBadChars |
	fName := super checkName: aFileName fixErrors: fixing.
	badChars := #( $: $< $> $| $/ $\ $? $* $") asSet.
	hasBadChars := fName includesAnyOf: badChars.
	(hasBadChars and:[fixing not]) ifTrue:[^self error:'Invalid file name'].
	hasBadChars ifFalse:[^ fName].
	^ fName collect:
		[:char | (badChars includes: char) 
				ifTrue:[$#] 
				ifFalse:[char]]!

----- Method: DosFileDirectory>>driveName (in category 'path access') -----
driveName

   "return a possible drive letter and colon at the start of a Path name, empty string otherwise"

   | firstTwoChars |

   ( pathName asSqueakPathName size >= 2 ) ifTrue: [
      firstTwoChars := (pathName asSqueakPathName copyFrom: 1 to: 2).
      (self class isDrive: firstTwoChars) ifTrue: [^firstTwoChars]
   ].
   ^''!

----- Method: DosFileDirectory>>fullNameFor: (in category 'path access') -----
fullNameFor: fileName
	"Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name."
	fileName ifNil:[^fileName].
	"Check for fully qualified names"
	((fileName size >= 2 and: [fileName first isLetter and: [fileName second = $:]])
		or: [(fileName beginsWith: '\\') and: [(fileName occurrencesOf: $\) >= 2]])
			ifTrue:[^fileName].
	^super fullNameFor: fileName!

----- Method: DosFileDirectory>>fullPathFor: (in category 'path access') -----
fullPathFor: path
	"Return the fully-qualified path name for the given file."
	path isEmpty ifTrue:[^pathName asSqueakPathName].
	(path at: 1) = $\ ifTrue:[
		(path size >= 2 and:[(path at: 2) = $\]) ifTrue:[^path]. "e.g., \\pipe\"
		^self driveName , path "e.g., \windows\"].
	(path size >= 2 and:[(path at: 2) = $: and:[path first isLetter]])
		ifTrue:[^path]. "e.g., c:"
	^pathName asSqueakPathName, self slash, path!

----- Method: DosFileDirectory>>relativeNameFor: (in category 'path access') -----
relativeNameFor: path
	"Return the full name for path, assuming that path is a name relative to me."
	path isEmpty ifTrue:[^pathName asSqueakPathName].
	(path at: 1) = $\ ifTrue:[
		(path size >= 2 and:[(path at: 2) = $\]) ifTrue:[^super relativeNameFor: path allButFirst ]. "e.g., \\pipe\"
		^super relativeNameFor: path "e.g., \windows\"].
	(path size >= 2 and:[(path at: 2) = $: and:[path first isLetter]])
		ifTrue:[^super relativeNameFor: (path copyFrom: 3 to: path size) ]. "e.g., c:"
	^pathName asSqueakPathName, self slash, path!

----- Method: DosFileDirectory>>setPathName: (in category 'as yet unclassified') -----
setPathName: pathString
	"Ensure pathString is absolute - relative directories aren't supported on all platforms."

	(pathString isEmpty
		or: [pathString first = $\
			or: [pathString size >= 2 and: [pathString second = $: and: [pathString first isLetter]]]])
				ifTrue: [^ super setPathName: pathString].

	self error: 'Fully qualified path expected'!

----- Method: FileDirectory class>>activeDirectoryClass (in category 'private') -----
activeDirectoryClass
	"Return the concrete FileDirectory subclass for the platform on which we are currently running."

	FileDirectory allSubclasses do: [:class |
		class isActiveDirectoryClass ifTrue: [^ class]].

	"no responding subclass; use FileDirectory"
	^ FileDirectory
!

----- Method: FileDirectory class>>baseNameFor: (in category 'name utilities') -----
baseNameFor: fileName
	"Return the given file name without its extension, if any. We have to remember that many (most?) OSs allow extension separators within directory names and so the leaf filename needs to be extracted, trimmed and rejoined. Yuck"
	"The test is 
		FileDirectory baseNameFor: ((FileDirectory default directoryNamed: 'foo.bar') fullNameFor:'blim.blam') 
		should end 'foo.bar/blim' (or as appropriate for your platform AND
		FileDirectory baseNameFor: ((FileDirectory default directoryNamed: 'foo.bar') fullNameFor:'blim')
		should be the same and NOT  'foo'
		Oh, and FileDirectory baseNameFor: 'foo.bar' should be 'foo' not '/foo' "

	| delim i leaf |
	self splitName: fileName to: [:path : fn|
		
		delim := DirectoryClass extensionDelimiter.
		i := fn findLast: [:c | c = delim].
		leaf := i = 0
			ifTrue: [fn]
			ifFalse: [fn copyFrom: 1 to: i - 1].
		path isEmpty ifTrue:[^leaf].
		^path, self slash, leaf]
!

----- Method: FileDirectory class>>changeSuffix (in category 'name utilities') -----
changeSuffix
"if 'changes' is not suitable, override this message to return something that is ok"
	^'changes'!

----- Method: FileDirectory class>>checkName:fixErrors: (in category 'name utilities') -----
checkName: fileName fixErrors: flag
	"Check a string fileName for validity as a file name on the current default file system. Answer the original file name if it is valid. If the name is not valid (e.g., it is too long or contains illegal characters) and fixing is false, raise an error. If fixing is true, fix the name (usually by truncating and/or tranforming characters), and answer the corrected name. The default behavior is to truncate the name to 31 chars. Subclasses can do any kind of checking and correction appropriate to the underlying platform."

	^ DefaultDirectory
		checkName: fileName
		fixErrors: flag
!

----- Method: FileDirectory class>>default (in category 'instance creation') -----
default
	"Answer the default directory."

	^ DefaultDirectory
!

----- Method: FileDirectory class>>deleteFilePath: (in category 'create/delete file') -----
deleteFilePath: fullPathToAFile
	"Delete the file after finding its directory"

	| dir |
	dir := self on: (self dirPathFor: fullPathToAFile).
	dir deleteFileNamed: (self localNameFor: fullPathToAFile).
!

----- Method: FileDirectory class>>dirPathFor: (in category 'name utilities') -----
dirPathFor: fullName 
	"Return the directory part the given name."
	DirectoryClass
		splitName: fullName
		to: [:dirPath :localName | ^ dirPath]!

----- Method: FileDirectory class>>directoryEntryFor: (in category 'name utilities') -----
directoryEntryFor: filenameOrPath
	^self default directoryEntryFor: filenameOrPath!

----- Method: FileDirectory class>>dot (in category 'platform specific') -----
dot
	"Return a one-character string containing the filename extension delimiter for this platform (i.e., the local equivalent of 'dot')"

	^ self extensionDelimiter asString
!

----- Method: FileDirectory class>>extensionDelimiter (in category 'platform specific') -----
extensionDelimiter
	"Return the character used to delimit filename extensions on this platform. Most platforms use the period (.) character."

	^ $.
!

----- Method: FileDirectory class>>extensionFor: (in category 'name utilities') -----
extensionFor: fileName
	"Return the extension of given file name, if any."

	| delim i |
	delim := DirectoryClass extensionDelimiter.
	i := fileName findLast: [:c | c = delim].
	i = 0
		ifTrue: [^ '']
		ifFalse: [^ fileName copyFrom: i + 1 to: fileName size].
!

----- Method: FileDirectory class>>fileName:extension: (in category 'name utilities') -----
fileName: fileName extension: fileExtension
	| extension |
	extension := FileDirectory dot , fileExtension.
	^(fileName endsWith: extension)
		ifTrue: [fileName]
		ifFalse: [fileName , extension].!

----- Method: FileDirectory class>>forFileName: (in category 'instance creation') -----
forFileName: aString

	| path |
	path := self dirPathFor: aString.
	path isEmpty ifTrue: [^ self default].
	^ self on: path
!

----- Method: FileDirectory class>>imageSuffix (in category 'name utilities') -----
imageSuffix
"if 'image' is not suitable, override this message to return something that is ok"
	^'image'!

----- Method: FileDirectory class>>initializeStandardMIMETypes (in category 'class initialization') -----
initializeStandardMIMETypes
	"FileDirectory initializeStandardMIMETypes"
	StandardMIMEMappings := Dictionary new.
	#(
		(gif		('image/gif'))
		(pdf	('application/pdf'))
		(aiff	('audio/aiff'))
		(bmp	('image/bmp'))
		(png	('image/png'))
		(swf	('application/x-shockwave-flash'))
		(htm	('text/html' 'text/plain'))
		(html	('text/html' 'text/plain'))
		(jpg	('image/jpeg'))
		(jpeg	('image/jpeg'))
		(mid	('audio/midi'))
		(midi	('audio/midi'))
		(mp3	('audio/mpeg'))
		(mpeg	('video/mpeg'))
		(mpg	('video/mpg'))
		(txt		('text/plain'))
		(text	('text/plain'))
		(mov	('video/quicktime'))
		(qt		('video/quicktime'))
		(tif		('image/tiff'))
		(tiff	('image/tiff'))
		(ttf		('application/x-truetypefont'))
		(wrl	('model/vrml'))
		(vrml	('model/vrml'))
		(wav	('audio/wav'))
	) do:[:spec|
		StandardMIMEMappings at: spec first asString put: spec last.
	].!

----- Method: FileDirectory class>>isActiveDirectoryClass (in category 'private') -----
isActiveDirectoryClass
	"Does this class claim to be that properly active subclass of FileDirectory for this platform?
	Default test is whether the primPathNameDelimiter matches the one for this class. Other tests are possible"

	^self pathNameDelimiter = self primPathNameDelimiter
!

----- Method: FileDirectory class>>isCaseSensitive (in category 'platform specific') -----
isCaseSensitive
	"Return true if file names are treated case sensitive"
	^true!

----- Method: FileDirectory class>>isLegalFileName: (in category 'name utilities') -----
isLegalFileName: fullName
	"Return true if the given string is a legal file name."

	^ DefaultDirectory isLegalFileName: (self localNameFor: fullName)
!

----- Method: FileDirectory class>>localNameFor: (in category 'name utilities') -----
localNameFor: fullName 
	"Return the local part the given name."
	DirectoryClass
		splitName: fullName
		to: [:dirPath :localName | ^ localName]!

----- Method: FileDirectory class>>lookInUsualPlaces: (in category 'create/delete file') -----
lookInUsualPlaces: fileName
	"Check the default directory, the imagePath, and the vmPath (and the vmPath's owner) for this file."

	| vmp |
	(FileDirectory default fileExists: fileName)
		ifTrue: [^ FileDirectory default fileNamed: fileName].

	((vmp := FileDirectory on: SmalltalkImage current imagePath) fileExists: fileName)
		ifTrue: [^ vmp fileNamed: fileName].

	((vmp := FileDirectory on: SmalltalkImage current vmPath) fileExists: fileName)
		ifTrue: [^ vmp fileNamed: fileName].

	((vmp := vmp containingDirectory) fileExists: fileName)
		ifTrue: [^ vmp fileNamed: fileName].

	^ nil!

----- Method: FileDirectory class>>makeAbsolute: (in category 'platform specific') -----
makeAbsolute: path
	"Ensure that path looks like an absolute path"
	^path first = self pathNameDelimiter
		ifTrue: [ path ]
		ifFalse: [ self slash, path ]!

----- Method: FileDirectory class>>makeRelative: (in category 'platform specific') -----
makeRelative: path
	"Ensure that path looks like an relative path"
	^path first = self pathNameDelimiter
		ifTrue: [ path copyWithoutFirst ]
		ifFalse: [ path ]!

----- Method: FileDirectory class>>maxFileNameLength (in category 'platform specific') -----
maxFileNameLength

	^ 31
!

----- Method: FileDirectory class>>on: (in category 'instance creation') -----
on: pathString
	"Return a new file directory for the given path, of the appropriate FileDirectory subclass for the current OS platform."

	| pathName |
	DirectoryClass ifNil: [self setDefaultDirectoryClass].
	"If path ends with a delimiter (: or /) then remove it"
	((pathName := pathString) endsWith: self pathNameDelimiter asString) ifTrue: [
		pathName := pathName copyFrom: 1 to: pathName size - 1].
	^ DirectoryClass new setPathName: pathName
!

----- Method: FileDirectory class>>openChanges:forImage: (in category 'system start up') -----
openChanges: changesName forImage: imageName
"find the changes file by looking in
a) the directory derived from the image name
b) the DefaultDirectory (which will normally be the directory derived from the image name or the SecurityManager's choice)
If an old file is not found in either place, check for a read-only file in the same places. If that fails, return nil"
	| changes fd |
	"look for the changes file or an alias to it in the image directory"
	fd := FileDirectory on: (FileDirectory dirPathFor: imageName).
	(fd fileExists: changesName)
		ifTrue: [changes := fd oldFileNamed: changesName].
	changes ifNotNil:[^changes].

	"look for the changes in the default directory"
	fd := DefaultDirectory.
	(fd fileExists: changesName)
		ifTrue: [changes := fd oldFileNamed: changesName].
	changes ifNotNil:[^changes].

	"look for read-only changes in the image directory"
	fd := FileDirectory on: (FileDirectory dirPathFor: imageName).
	(fd fileExists: changesName)
		ifTrue: [changes := fd readOnlyFileNamed: changesName].
	changes ifNotNil:[^changes].

	"look for read-only changes in the default directory"
	fd := DefaultDirectory.
	(fd fileExists: changesName)
		ifTrue: [changes := fd readOnlyFileNamed: changesName].
	"this may be nil if the last try above failed to open a file"
	^changes
!

----- Method: FileDirectory class>>openSources:andChanges:forImage: (in category 'system start up') -----
openSources: sourcesName andChanges: changesName forImage: imageName 
	"Open the changes and sources files and install them in SourceFiles. Inform the user of problems regarding write permissions or CR/CRLF mixups."
	"Note: SourcesName and imageName are full paths; changesName is a  
	local name."
	| sources changes msg wmsg |
	msg := 'Squeak cannot locate &fileRef.

Please check that the file is named properly and is in the
same directory as this image.'.
	wmsg := 'Squeak cannot write to &fileRef.

Please check that you have write permission for this file.

You won''t be able to save this image correctly until you fix this.'.

	sources := self openSources: sourcesName forImage: imageName.
	changes := self openChanges: changesName forImage: imageName.

	((sources == nil or: [sources atEnd])
			and: [Preferences valueOfFlag: #warnIfNoSourcesFile])
		ifTrue: [SmalltalkImage current platformName = 'Mac OS'
				ifTrue: [msg := msg , '
Make sure the sources file is not an Alias.'].
self inform: (msg copyReplaceAll: '&fileRef' with: 'the sources file named ' , sourcesName)].

	(changes == nil
			and: [Preferences valueOfFlag: #warnIfNoChangesFile])
		ifTrue: [self inform: (msg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)].

	((Preferences valueOfFlag: #warnIfNoChangesFile) and: [changes notNil])
		ifTrue: [changes isReadOnly
				ifTrue: [self inform: (wmsg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)].

			((changes next: 200)
					includesSubString: String crlf)
				ifTrue: [self inform: 'The changes file named ' , changesName , '
has been injured by an unpacking utility.  Crs were changed to CrLfs.
Please set the preferences in your decompressing program to 
"do not convert text files" and unpack the system again.']].

	SourceFiles := Array with: sources with: changes!

----- Method: FileDirectory class>>openSources:forImage: (in category 'system start up') -----
openSources: fullSourcesName forImage: imageName 
"We first do a check to see if a compressed version ofthe sources file is present.
Open the .sources file read-only after searching in:
a) the directory where the VM lives
b) the directory where the image came from
c) the DefaultDirectory (which is likely the same as b unless the SecurityManager has changed it).
"

	| sources fd sourcesName |
	(fullSourcesName endsWith: 'sources') ifTrue:
		["Look first for a sources file in compressed format."
		sources := self openSources: (fullSourcesName allButLast: 7) , 'stc'
						forImage: imageName.
		sources ifNotNil: [^ CompressedSourceStream on: sources]].

	sourcesName := FileDirectory localNameFor: fullSourcesName.
	"look for the sources file or an alias to it in the VM's directory"
	fd := FileDirectory on: SmalltalkImage current vmPath.
	(fd fileExists: sourcesName)
		ifTrue: [sources := fd readOnlyFileNamed: sourcesName].
	sources ifNotNil: [^ sources].
	"look for the sources file or an alias to it in the image directory"
	fd := FileDirectory on: (FileDirectory dirPathFor: imageName).
	(fd fileExists: sourcesName)
		ifTrue: [sources := fd readOnlyFileNamed: sourcesName].
	sources ifNotNil: [^ sources].
	"look for the sources in the current directory"
	fd := DefaultDirectory.
	(fd fileExists: sourcesName)
		ifTrue: [sources := fd readOnlyFileNamed: sourcesName].
	"sources may still be nil here"
	^sources
!

----- Method: FileDirectory class>>pathNameDelimiter (in category 'platform specific') -----
pathNameDelimiter
"return the active directory class's directory seperator character"
	^ DirectoryClass pathNameDelimiter!

----- Method: FileDirectory class>>primPathNameDelimiter (in category 'private') -----
primPathNameDelimiter
	"Return the path delimiter for the underlying platform's file system."

 	<primitive: 'primitiveDirectoryDelimitor' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: FileDirectory class>>root (in category 'instance creation') -----
root
	"Answer the root directory."

	^ self on: ''
!

----- Method: FileDirectory class>>searchAllFilesForAString (in category 'name utilities') -----
searchAllFilesForAString

	"Prompt the user for a search string, and a starting directory. Search the contents of all files in the starting directory and its subdirectories for the search string (case-insensitive search.)
	List the paths of files in which it is found on the Transcript.
	By Stewart MacLean 5/00; subsequently moved to FileDirectory class-side, and refactored to call FileDirectory.filesContaining:caseSensitive:"

	| searchString dir |

	searchString := FillInTheBlank request: 'Enter search string'.
	searchString isEmpty ifTrue: [^nil].
	Transcript cr; show: 'Searching for ', searchString printString, ' ...'.
	(dir := PluggableFileList getFolderDialog open) ifNotNil:
		[(dir filesContaining: searchString caseSensitive: false) do:
				[:pathname | Transcript cr; show: pathname]].
	Transcript cr; show: 'Finished searching for ', searchString printString

	"FileDirectory searchAllFilesForAString"!

----- Method: FileDirectory class>>setDefaultDirectory: (in category 'system start up') -----
setDefaultDirectory: directoryName
	"Initialize the default directory to the directory supplied. This method is called when the image starts up."
	| dirName |
	DirectoryClass := self activeDirectoryClass.
	dirName := (FilePath pathName: directoryName) asSqueakPathName.
	[dirName endsWith: self slash] whileTrue:[
		dirName := dirName copyFrom: 1 to: dirName size - self slash size.
	].
	DefaultDirectory := self on: dirName.!

----- Method: FileDirectory class>>setDefaultDirectoryClass (in category 'system start up') -----
setDefaultDirectoryClass
	"Initialize the default directory class to suit this platform. This method is called when the image starts up - it needs to be right at the front of the list of the startup sequence"

	DirectoryClass := self activeDirectoryClass
!

----- Method: FileDirectory class>>setDefaultDirectoryFrom: (in category 'system start up') -----
setDefaultDirectoryFrom: imageName
	"Initialize the default directory to the directory containing the Squeak image file. This method is called when the image starts up."

	DirectoryClass := self activeDirectoryClass.
	DefaultDirectory := self on: (FilePath pathName: (self dirPathFor: imageName) isEncoded: true) asSqueakPathName.
!

----- Method: FileDirectory class>>shutDown (in category 'system start up') -----
shutDown

	SmalltalkImage current closeSourceFiles.
!

----- Method: FileDirectory class>>slash (in category 'platform specific') -----
slash
	^ self pathNameDelimiter asString!

----- Method: FileDirectory class>>splitName:to: (in category 'name utilities') -----
splitName: fullName to: pathAndNameBlock
	"Take the file name and convert it to the path name of a directory and a local file name within that directory. FileName must be of the form: <dirPath><delimiter><localName>, where <dirPath><delimiter> is optional. The <dirPath> part may contain delimiters."

	| delimiter i dirName localName |
	delimiter := self pathNameDelimiter.
	(i := fullName findLast: [:c | c = delimiter]) = 0
		ifTrue:
			[dirName := String new.
			localName := fullName]
		ifFalse:
			[dirName := fullName copyFrom: 1 to: (i - 1 max: 1).
			localName := fullName copyFrom: i + 1 to: fullName size].

	^ pathAndNameBlock value: dirName value: localName!

----- Method: FileDirectory class>>startUp (in category 'name utilities') -----
startUp
	"Establish the platform-specific FileDirectory subclass. Do any platform-specific startup."
	self setDefaultDirectoryClass.

	self setDefaultDirectory: (self dirPathFor: SmalltalkImage current imageName).

	Preferences startInUntrustedDirectory 
		ifTrue:[	"The SecurityManager may override the default directory to prevent unwanted write access etc."
				self setDefaultDirectory: SecurityManager default untrustedUserDirectory.
				"Make sure we have a place to go to"
				DefaultDirectory assureExistence].
	SmalltalkImage current openSourceFiles.
!

----- Method: FileDirectory class>>urlForFileNamed: (in category 'name utilities') -----
urlForFileNamed: aFilename 
	"Create a URL for the given fully qualified file name"
	"FileDirectory urlForFileNamed: 
	'C:\Home\andreasr\Squeak\DSqueak3\DSqueak3:=1.1\DSqueak3.1.image' "
	| path localName |
	DirectoryClass
		splitName: aFilename
		to: [:p :n | 
			path := p.
			localName := n].
	^ localName asUrlRelativeTo: (self on: path) url asUrl!

----- Method: FileDirectory>>acceptsUploads (in category 'testing') -----
acceptsUploads
	^true!

----- Method: FileDirectory>>asUrl (in category 'file name utilities') -----
asUrl
	"Convert my path into a file:// type url - a FileUrl."
	
	^FileUrl pathParts: (self pathParts copyWith: '')!

----- Method: FileDirectory>>assureExistence (in category 'file directory') -----
assureExistence
	"Make sure the current directory exists. If necessary, create all parts in between"

	self containingDirectory assureExistenceOfPath: self localName!

----- Method: FileDirectory>>assureExistenceOfPath: (in category 'file directory') -----
assureExistenceOfPath: lPath
	"Make sure the local directory exists. If necessary, create all parts in between"
	| localPath |
	localPath := lPath.
	localPath isEmpty ifTrue: [ ^self ]. "Assumed to exist"
	(self directoryExists: localPath) ifTrue: [^ self]. "exists"
	"otherwise check parent first and then create local dir"
	self containingDirectory assureExistenceOfPath: self localName.
	self createDirectory: localPath!

----- Method: FileDirectory>>checkName:fixErrors: (in category 'file name utilities') -----
checkName: aFileName fixErrors: fixing
	"Check a string aFileName for validity as a file name. Answer the original file name if it is valid. If the name is not valid (e.g., it is too long or contains illegal characters) and fixing is false, raise an error. If fixing is true, fix the name (usually by truncating and/or tranforming characters), and answer the corrected name. The default behavior is just to truncate the name to the maximum length for this platform. Subclasses can do any kind of checking and correction appropriate for their platform."

	| maxLength |
	aFileName size = 0 ifTrue: [self error: 'zero length file name'].
	maxLength := self class maxFileNameLength.
	aFileName size > maxLength ifTrue: [
		fixing
			ifTrue: [^ aFileName contractTo: maxLength]
			ifFalse: [self error: 'file name is too long']].

	^ aFileName
!

----- Method: FileDirectory>>containingDirectory (in category 'enumeration') -----
containingDirectory
	"Return the directory containing this directory."

	^ FileDirectory on: (FileDirectory dirPathFor: pathName asSqueakPathName)
!

----- Method: FileDirectory>>copyFile:toFile: (in category 'file operations') -----
copyFile: fileStream1 toFile: fileStream2
	| buffer |
	buffer := String new: 50000.
	[fileStream1 atEnd] whileFalse:
		[fileStream2 nextPutAll: (fileStream1 nextInto: buffer)].
!

----- Method: FileDirectory>>copyFileNamed:toFileNamed: (in category 'file operations') -----
copyFileNamed: fileName1 toFileNamed: fileName2
	"Copy the contents of the existing file with the first name into a new file with the second name. Both files are assumed to be in this directory."
	"FileDirectory default copyFileNamed: 'todo.txt' toFileNamed: 'todocopy.txt'"

	| file1 file2 |
	file1 := (self readOnlyFileNamed: fileName1) binary.
	file2 := (self newFileNamed: fileName2) binary.
	self copyFile: file1 toFile: file2.
	file1 close.
	file2 close.
!

----- Method: FileDirectory>>copyFileWithoutOverwriteConfirmationNamed:toFileNamed: (in category 'file operations') -----
copyFileWithoutOverwriteConfirmationNamed: fileName1 toFileNamed: fileName2
	"Copy the contents of the existing file with the first name into a file with the second name (which may or may not exist). If the second file exists, force an overwrite without confirming.  Both files are assumed to be in this directory."
	"FileDirectory default copyFileWithoutOverwriteConfirmationNamed: 'todo.txt' toFileNamed: 'todocopy.txt'"

	| file1 file2 |
	fileName1 = fileName2 ifTrue: [^ self].
	file1 := (self readOnlyFileNamed: fileName1) binary.
	file2 := (self forceNewFileNamed: fileName2) binary.
	self copyFile: file1 toFile: file2.
	file1 close.
	file2 close.!

----- Method: FileDirectory>>createDirectory: (in category 'file operations') -----
createDirectory: localFileName
	"Create a directory with the given name in this directory. Fail if the name is bad or if a file or directory with that name already exists."

 	self primCreateDirectory: (self fullNameFor: localFileName) asVmPathName
!

----- Method: FileDirectory>>deleteDirectory: (in category 'file operations') -----
deleteDirectory: localDirName
	"Delete the directory with the given name in this directory. Fail if the path is bad or if a directory by that name does not exist."

 	self primDeleteDirectory: (self fullNameFor: localDirName) asVmPathName.
!

----- Method: FileDirectory>>deleteFileNamed: (in category 'file operations') -----
deleteFileNamed: localFileName
	"Delete the file with the given name in this directory."

	self deleteFileNamed: localFileName ifAbsent: [].
!

----- Method: FileDirectory>>deleteFileNamed:ifAbsent: (in category 'file operations') -----
deleteFileNamed: localFileName ifAbsent: failBlock
	"Delete the file of the given name if it exists, else evaluate failBlock.
	If the first deletion attempt fails do a GC to force finalization of any lost references. ar 3/21/98 17:53"
	| fullName |
	fullName := self fullNameFor: localFileName.
	(StandardFileStream 
		retryWithGC:[self primDeleteFileNamed: (self fullNameFor: localFileName) asVmPathName]
		until:[:result| result notNil]
		forFileNamed: fullName) == nil
			ifTrue: [^failBlock value].
!

----- Method: FileDirectory>>deleteLocalFiles (in category 'file operations') -----
deleteLocalFiles
	"Delete the local files in this directory."

	self fileNames do:[:fn| self deleteFileNamed: fn ifAbsent: [(CannotDeleteFileException new
			messageText: 'Could not delete the old version of file ' , (self fullNameFor: fn)) signal]]
!

----- Method: FileDirectory>>directoryContentsFor: (in category 'private') -----
directoryContentsFor: fullPath
	"Return a collection of directory entries for the files and directories in the directory with the given path. See primLookupEntryIn:index: for further details."
	"FileDirectory default directoryContentsFor: ''"

	| entries index done entryArray f |
	entries := OrderedCollection new: 200.
	index := 1.
	done := false.
	f := fullPath asVmPathName.
	[done] whileFalse: [
		entryArray := self primLookupEntryIn: f index: index.
		#badDirectoryPath = entryArray ifTrue: [
			^(InvalidDirectoryError pathName: pathName asSqueakPathName) signal].
		entryArray == nil
			ifTrue: [done := true]
			ifFalse: [entries addLast: (DirectoryEntry fromArray: entryArray)].
		index := index + 1].

	^ entries asArray collect: [:s | s convertFromSystemName].
!

----- Method: FileDirectory>>directoryEntry (in category 'enumeration') -----
directoryEntry
	^self containingDirectory entryAt: self localName!

----- Method: FileDirectory>>directoryEntryFor: (in category 'enumeration') -----
directoryEntryFor: filenameOrPath
	"Answer the directory entry for the given file or path. Sorta like a poor man's stat()."
	| fName dir |
	DirectoryClass splitName: filenameOrPath to:[:filePath :name |
		fName := name.
		filePath isEmpty
			ifTrue: [dir := self]
			ifFalse: [dir := FileDirectory on: filePath]].
	self isCaseSensitive 
		ifTrue:[^dir entries detect:[:entry| entry name = fName] ifNone:[nil]]
		ifFalse:[^dir entries detect:[:entry| entry name sameAs: fName] ifNone:[nil]]!

----- Method: FileDirectory>>directoryExists: (in category 'testing') -----
directoryExists: filenameOrPath
	"Answer true if a directory of the given name exists. The given name may be either a full path name or a local directory within this directory."
	"FileDirectory default directoryExists: FileDirectory default pathName"

	| fName dir |
	DirectoryClass splitName: filenameOrPath to:
		[:filePath :name |
			fName := name.
			filePath isEmpty
				ifTrue: [dir := self]
				ifFalse: [dir := self directoryNamed: filePath]].

	^dir exists and: [
		self isCaseSensitive 
			ifTrue:[dir directoryNames includes: fName]
			ifFalse:[dir directoryNames anySatisfy: [:name| name sameAs: fName]]].
!

----- Method: FileDirectory>>directoryNamed: (in category 'enumeration') -----
directoryNamed: localFileName
	"Return the subdirectory of this directory with the given name."

	^ FileDirectory on: (self fullNameFor: localFileName)
!

----- Method: FileDirectory>>directoryNames (in category 'enumeration') -----
directoryNames
	"Return a collection of names for the subdirectories of this directory."
	"FileDirectory default directoryNames"

	^ (self entries select: [:entry | entry at: 4])
		collect: [:entry | entry first]
!

----- Method: FileDirectory>>directoryObject (in category 'squeaklets') -----
directoryObject

	^self!

----- Method: FileDirectory>>downloadUrl (in category 'squeaklets') -----
downloadUrl
	^''!

----- Method: FileDirectory>>eToyBaseFolderSpec (in category 'school support') -----
eToyBaseFolderSpec
	^ServerDirectory eToyBaseFolderSpecForFileDirectory: self!

----- Method: FileDirectory>>eToyBaseFolderSpec: (in category 'school support') -----
eToyBaseFolderSpec: aString
	^ServerDirectory eToyBaseFolderSpecForFileDirectory: self put: aString!

----- Method: FileDirectory>>eToyUserList (in category 'school support') -----
eToyUserList
	| spec index fd list match |
	spec := self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'."
	spec ifNil:[^ServerDirectory eToyUserListForFileDirectory: self].
	"Compute list of users based on base folder spec"
	index := spec indexOf: $*. "we really need one"
	index = 0 ifTrue:[^ServerDirectory eToyUserListForFileDirectory: self].
	fd := FileDirectory on: (FileDirectory dirPathFor: (spec copyFrom: 1 to: index)).
	"reject all non-directories"
	list := fd entries select:[:each| each isDirectory].
	"reject all non-matching entries"
	match := spec copyFrom: fd pathName size + 2 to: spec size.
	list := list collect:[:each| each name].
	list := list select:[:each| match match: each].
	"extract the names (e.g., those positions that match '*')"
	index := match indexOf: $*.
	list := list collect:[:each|
		each copyFrom: index to: each size - (match size - index)].
	^list!

----- Method: FileDirectory>>eToyUserListUrl (in category 'school support') -----
eToyUserListUrl
	^ServerDirectory eToyUserListUrlForFileDirectory: self!

----- Method: FileDirectory>>eToyUserListUrl: (in category 'school support') -----
eToyUserListUrl: urlString
	^ServerDirectory eToyUserListUrlForFileDirectory: self put: urlString.!

----- Method: FileDirectory>>eToyUserName: (in category 'school support') -----
eToyUserName: aString
	"Set the default directory from the given user name"
	| dirName |
	dirName := self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'"
	dirName ifNil:[^self].
	dirName := dirName copyReplaceAll:'*' with: aString.
"	dirName last = self class pathNameDelimiter ifFalse:[dirName := dirName, self slash].
	FileDirectory setDefaultDirectoryFrom: dirName.
	dirName := dirName copyFrom: 1 to: dirName size - 1.

"	pathName := FilePath pathName: dirName!

----- Method: FileDirectory>>entries (in category 'enumeration') -----
entries
	"Return a collection of directory entries for the files and directories in this directory. Each entry is a five-element array: (<name><creationTime><modificationTime><dirFlag><fileSize>). See primLookupEntryIn:index: for further details."
	"FileDirectory default entries"

	^ self directoryContentsFor: pathName
!

----- Method: FileDirectory>>entryAt: (in category 'file status') -----
entryAt: fileName  
	"find the entry with local name fileName"

	^self entryAt: fileName ifAbsent: [ self error: 'file not in directory: ', fileName ].!

----- Method: FileDirectory>>entryAt:ifAbsent: (in category 'file status') -----
entryAt: fileName ifAbsent: aBlock
	"Find the entry with local name fileName and answer it.
	If not found, answer the result of evaluating aBlock."

	| comparisonBlock |
	self isCaseSensitive
		ifTrue: [comparisonBlock := [:entry | (entry at: 1) = fileName]]
		ifFalse: [comparisonBlock := [:entry | (entry at: 1) sameAs: fileName]].
	^ self entries detect: comparisonBlock ifNone: [aBlock value]!

----- Method: FileDirectory>>exists (in category 'testing') -----
exists
"Answer whether the directory exists"

	| result |
	result := self primLookupEntryIn: pathName asVmPathName index: 1.
	^ result ~= #badDirectoryPath
!

----- Method: FileDirectory>>fileAndDirectoryNames (in category 'enumeration') -----
fileAndDirectoryNames
	"FileDirectory default fileAndDirectoryNames"

	^ self entries collect: [:entry | entry first]
!

----- Method: FileDirectory>>fileExists: (in category 'testing') -----
fileExists: filenameOrPath
	"Answer true if a file of the given name exists. The given name may be either a full path name or a local file within this directory."
	"FileDirectory default fileExists: Smalltalk sourcesName"

	| fName dir |
	DirectoryClass splitName: filenameOrPath to:
		[:filePath :name |
			fName := name.
			filePath isEmpty
				ifTrue: [dir := self]
				ifFalse: [dir := FileDirectory on: filePath]].
	self isCaseSensitive 
		ifTrue:[^dir fileNames includes: fName]
		ifFalse:[^dir fileNames anySatisfy: [:name| name sameAs: fName]].	!

----- Method: FileDirectory>>fileNamed: (in category 'file stream creation') -----
fileNamed: localFileName
	"Open the file with the given name in this directory for writing."

	^ FileStream concreteStream fileNamed: (self fullNameFor: localFileName)
!

----- Method: FileDirectory>>fileNames (in category 'enumeration') -----
fileNames
	"Return a collection of names for the files (but not directories) in this directory."
	"FileDirectory default fileNames"

	^ (self entries select: [:entry | (entry at: 4) not])
		collect: [:entry | entry first]
!

----- Method: FileDirectory>>fileNamesMatching: (in category 'file name utilities') -----
fileNamesMatching: pat
	"
	FileDirectory default fileNamesMatching: '*'
	FileDirectory default fileNamesMatching: '*.image;*.changes'
	"
	
	| files |
	files := OrderedCollection new.
	
	(pat findTokens: ';', String crlf) do: [ :tok | 
		files addAll: (self fileNames select: [:name | tok match: name]) ].
	
	^files
!

----- Method: FileDirectory>>fileOrDirectoryExists: (in category 'file operations') -----
fileOrDirectoryExists: filenameOrPath
	"Answer true if either a file or a directory file of the given name exists. The given name may be either a full path name or a local name within this directory."
	"FileDirectory default fileOrDirectoryExists: Smalltalk sourcesName"

	| fName dir |
	DirectoryClass splitName: filenameOrPath to:
		[:filePath :name |
			fName := name.
			filePath isEmpty
				ifTrue: [dir := self]
				ifFalse: [dir := FileDirectory on: filePath]].

	^ (dir includesKey: fName) or: [ fName = '' and:[ dir entries size > 1]]!

----- Method: FileDirectory>>filesContaining:caseSensitive: (in category 'searching') -----
filesContaining: searchString caseSensitive: aBoolean
	| aList |
	"Search the contents of all files in the receiver and its subdirectories for the search string.  Return a list of paths found.  Make the search case sensitive if aBoolean is true."

	aList := OrderedCollection new.
	self withAllFilesDo: [:stream |
			(stream contentsOfEntireFile includesSubstring: searchString caseSensitive: aBoolean)
				ifTrue:	[aList add: stream name]]
		andDirectoriesDo: [:d | d pathName].
	^ aList

"FileDirectory default filesContaining: 'includesSubstring:'  caseSensitive: true"!

----- Method: FileDirectory>>forceNewFileNamed: (in category 'file stream creation') -----
forceNewFileNamed: localFileName
	"Open the file with the given name in this directory for writing.  If it already exists, delete it first without asking."

	^ FileStream concreteStream forceNewFileNamed: (self fullNameFor: localFileName)
!

----- Method: FileDirectory>>fullName (in category 'enumeration') -----
fullName
	"Return the full name of this directory."

	^pathName asSqueakPathName
!

----- Method: FileDirectory>>fullNameFor: (in category 'file name utilities') -----
fullNameFor: fileName
	"Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name."
	"Details: Note that path relative to a directory, such as '../../foo' are disallowed by this algorithm.  Also note that this method is tolerent of a nil argument -- is simply returns nil in this case."

	| correctedLocalName prefix |
	fileName ifNil: [^ nil].
	DirectoryClass splitName: fileName to:
		[:filePath :localName |
			correctedLocalName := localName isEmpty 
				ifFalse: [self checkName: localName fixErrors: true]
				ifTrue: [localName].
			prefix := self fullPathFor: filePath].
	prefix isEmpty
		ifTrue: [^correctedLocalName].
	prefix last = self pathNameDelimiter
		ifTrue:[^ prefix, correctedLocalName]
		ifFalse:[^ prefix, self slash, correctedLocalName]!

----- Method: FileDirectory>>fullNamesOfAllFilesInSubtree (in category 'enumeration') -----
fullNamesOfAllFilesInSubtree
	"Answer a collection containing the full names of all the files in the subtree of the file system whose root is this directory."

	| result todo dir |
	result := OrderedCollection new: 100.
	todo := OrderedCollection with: self.
	[todo size > 0] whileTrue: [
		dir := todo removeFirst.
		dir fileNames do: [:n | result add: (dir fullNameFor: n)].
		dir directoryNames do: [:n | todo add: (dir directoryNamed: n)]].
	^ result asArray
!

----- Method: FileDirectory>>fullPathFor: (in category 'path access') -----
fullPathFor: path
	^path isEmpty ifTrue:[pathName asSqueakPathName] ifFalse:[path]!

----- Method: FileDirectory>>getMacFileTypeAndCreator: (in category 'file operations') -----
getMacFileTypeAndCreator: fileName 
	| results typeString creatorString |
	"get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. Does nothing on other platforms (where the underlying primitive is a noop)."
	"FileDirectory default getMacFileNamed: 'foo'"

	typeString := ByteArray new: 4 withAll: ($? asInteger).
	creatorString := ByteArray new: 4 withAll: ($? asInteger).
	[self primGetMacFileNamed: (self fullNameFor: fileName) asVmPathName
		type: typeString
		creator: creatorString.] ensure: 
		[typeString := typeString asString. 
		creatorString := creatorString asString].
	results := Array with: typeString convertFromSystemString with: creatorString convertFromSystemString.
	^results
!

----- Method: FileDirectory>>hasEToyUserList (in category 'school support') -----
hasEToyUserList
	^self eToyUserListUrl notNil or:[self eToyBaseFolderSpec notNil]!

----- Method: FileDirectory>>includesKey: (in category 'testing') -----
includesKey: localName
	"Answer true if this directory includes a file or directory of the given name. Note that the name should be a local file name, in contrast with fileExists:, which takes either local or full-qualified file names."
	"(FileDirectory on: Smalltalk vmPath) includesKey: 'SqueakV2.sources'"
	self isCaseSensitive
		ifTrue:[^ self fileAndDirectoryNames includes: localName]
		ifFalse:[^ self fileAndDirectoryNames anySatisfy: [:str| str sameAs: localName]].!

----- Method: FileDirectory>>isAFileNamed: (in category 'testing') -----
isAFileNamed: fName
	^FileStream isAFileNamed: (self fullNameFor: fName)!

----- Method: FileDirectory>>isCaseSensitive (in category 'testing') -----
isCaseSensitive
	"Return true if file names are treated case sensitive"
	^self class isCaseSensitive!

----- Method: FileDirectory>>isLegalFileName: (in category 'file name utilities') -----
isLegalFileName: aString 
	"Answer true if the given string is a legal file name."

	^ (self checkName: aString fixErrors: true) = aString
!

----- Method: FileDirectory>>isRemoteDirectory (in category 'testing') -----
isRemoteDirectory
	"answer whatever the receiver is a remote directory"
	^ false!

----- Method: FileDirectory>>isTypeFile (in category 'file name utilities') -----
isTypeFile
	^true!

----- Method: FileDirectory>>keysDo: (in category 'enumeration') -----
keysDo: nameBlock
	"Evaluate the given block for each file or directory name in this directory."

	^ self fileAndDirectoryNames do: nameBlock
!

----- Method: FileDirectory>>lastNameFor:extension: (in category 'file name utilities') -----
lastNameFor: baseFileName extension: extension
	"Assumes a file name includes a version number encoded as '.' followed by digits 
	preceding the file extension.  Increment the version number and answer the new file name.
	If a version number is not found, set the version to 1 and answer a new file name"

	| files splits |

	files := self fileNamesMatching: (baseFileName,'*', self class dot, extension).
	splits := files 
			collect: [:file | self splitNameVersionExtensionFor: file]
			thenSelect: [:split | (split at: 1) = baseFileName].
	splits := splits asSortedCollection: [:a :b | (a at: 2) < (b at: 2)].
	^splits isEmpty 
			ifTrue: [nil]
			ifFalse: [(baseFileName, '.', (splits last at: 2) asString, self class dot, extension) asFileName]!

----- Method: FileDirectory>>localName (in category 'enumeration') -----
localName
	"Return the local name of this directory."

	^FileDirectory localNameFor: pathName asSqueakPathName!

----- Method: FileDirectory>>localNameFor: (in category 'file directory') -----
localNameFor: fullName
	"Return the local part the given name."

	^self class localNameFor: fullName!

----- Method: FileDirectory>>matchingEntries: (in category 'enumeration') -----
matchingEntries: criteria
	"Ignore the filter criteria for now"
	^self entries!

----- Method: FileDirectory>>mimeTypesFor: (in category 'file operations') -----
mimeTypesFor: fileName
	"Return a list of MIME types applicable to the receiver. This default implementation uses the file name extension to figure out what we're looking at but specific subclasses may use other means of figuring out what the type of some file is. Some systems like the macintosh use meta data on the file to indicate data type"

	| idx ext dot |
	ext := ''.
	dot := self class extensionDelimiter.
	idx := fileName findLast: [:ch| ch = dot].
	idx = 0 ifFalse: [ext := fileName copyFrom: idx+1 to: fileName size].
	^ StandardMIMEMappings at: ext asLowercase ifAbsent: [nil]!

----- Method: FileDirectory>>newFileNamed: (in category 'file stream creation') -----
newFileNamed: localFileName
	"Create a new file with the given name in this directory."

	^ FileStream concreteStream newFileNamed: (self fullNameFor: localFileName)
!

----- Method: FileDirectory>>nextNameFor:extension: (in category 'file name utilities') -----
nextNameFor: baseFileName extension: extension
	"Assumes a file name includes a version number encoded as '.' followed by digits 
	preceding the file extension.  Increment the version number and answer the new file name.
	If a version number is not found, set the version to 1 and answer a new file name"

	| files splits version |

	files := self fileNamesMatching: (baseFileName,'*', self class dot, extension).
	splits := files 
			collect: [:file | self splitNameVersionExtensionFor: file]
			thenSelect: [:split | (split at: 1) = baseFileName].
	splits := splits asSortedCollection: [:a :b | (a at: 2) < (b at: 2)].
	splits isEmpty 
			ifTrue: [version := 1]
			ifFalse: [version := (splits last at: 2) + 1].
	^ (baseFileName, '.', version asString, self class dot, extension) asFileName!

----- Method: FileDirectory>>oldFileNamed: (in category 'file stream creation') -----
oldFileNamed: localFileName
	"Open the existing file with the given name in this directory."

	^ FileStream concreteStream oldFileNamed: (self fullNameFor: localFileName)
!

----- Method: FileDirectory>>oldFileOrNoneNamed: (in category 'file stream creation') -----
oldFileOrNoneNamed: localFileName
	"If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil."

	^ FileStream concreteStream oldFileOrNoneNamed: (self fullNameFor: localFileName)
!

----- Method: FileDirectory>>on: (in category 'path access') -----
on: fullPath
	"Return another instance"

	^ self class on: fullPath!

----- Method: FileDirectory>>pathFromUrl: (in category 'path access') -----
pathFromUrl: aFileUrl
	| first |
	^String streamContents: [ :s |
		first := false.
		aFileUrl path do: [ :p |
			first ifTrue: [ s nextPut: self pathNameDelimiter ].
			first := true.
			s nextPutAll: p ] ].!

----- Method: FileDirectory>>pathName (in category 'path access') -----
pathName
	"Return the path from the root of the file system to this directory."

	^ pathName asSqueakPathName.

!

----- Method: FileDirectory>>pathNameDelimiter (in category 'path access') -----
pathNameDelimiter
	"Return the delimiter character for this kind of directory. This depends on the current platform."

	^ self class pathNameDelimiter
!

----- Method: FileDirectory>>pathParts (in category 'path access') -----
pathParts
	"Return the path from the root of the file system to this directory as an array of directory names."

	^ pathName asSqueakPathName findTokens: self pathNameDelimiter asString!

----- Method: FileDirectory>>primCreateDirectory: (in category 'private') -----
primCreateDirectory: fullPath
	"Create a directory named by the given path. Fail if the path is bad or if a file or directory by that name already exists."

 	<primitive: 'primitiveDirectoryCreate' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: FileDirectory>>primDeleteDirectory: (in category 'private') -----
primDeleteDirectory: fullPath
	"Delete the directory named by the given path. Fail if the path is bad or if a directory by that name does not exist."

 	<primitive: 'primitiveDirectoryDelete' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: FileDirectory>>primDeleteFileNamed: (in category 'private') -----
primDeleteFileNamed: aFileName
	"Delete the file of the given name. Return self if the primitive succeeds, nil otherwise."

	<primitive: 'primitiveFileDelete' module: 'FilePlugin'>
	^ nil
!

----- Method: FileDirectory>>primGetMacFileNamed:type:creator: (in category 'private') -----
primGetMacFileNamed: fileName type: typeString creator: creatorString
	"Get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms."

 	<primitive: 'primitiveDirectoryGetMacTypeAndCreator' module: 'FilePlugin'>

!

----- Method: FileDirectory>>primLookupEntryIn:index: (in category 'private') -----
primLookupEntryIn: fullPath index: index
	"Look up the index-th entry of the directory with the given fully-qualified path (i.e., starting from the root of the file hierarchy) and return an array containing:

	<name> <creationTime> <modificationTime> <dirFlag> <fileSize>

	The empty string enumerates the top-level files or drives. (For example, on Unix, the empty path enumerates the contents of '/'. On Macs and PCs, it enumerates the mounted volumes/drives.)

	The creation and modification times are in seconds since the start of the Smalltalk time epoch. DirFlag is true if the entry is a directory. FileSize the file size in bytes or zero for directories. The primitive returns nil when index is past the end of the directory. It fails if the given path is bad."

 	<primitive: 'primitiveDirectoryLookup' module: 'FilePlugin'>
	^ #badDirectoryPath

!

----- Method: FileDirectory>>primRename:to: (in category 'private') -----
primRename: oldFileFullName to: newFileFullName 
	"Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name.
	Changed to return nil instead of failing ar 3/21/98 18:04"

	<primitive: 'primitiveFileRename' module: 'FilePlugin'>
	^nil!

----- Method: FileDirectory>>primSetMacFileNamed:type:creator: (in category 'private') -----
primSetMacFileNamed: fileName type: typeString creator: creatorString
	"Set the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms."

 	<primitive: 'primitiveDirectorySetMacTypeAndCreator' module: 'FilePlugin'>
	self primitiveFailed
!

----- Method: FileDirectory>>printOn: (in category 'printing') -----
printOn: aStream 
	"Refer to the comment in Object|printOn:."

	aStream nextPutAll: self class name.
	aStream nextPutAll: ' on '.
	pathName asSqueakPathName printOn: aStream.
!

----- Method: FileDirectory>>putFile:named: (in category 'file operations') -----
putFile: file1 named: destinationFileName
	"Copy the contents of the existing fileStream into the file destinationFileName in this directory.  fileStream can be anywhere in the fileSystem."

	| file2 |
	file1 binary.
	(file2 := self newFileNamed: destinationFileName) ifNil: [^ false].
	file2 binary.
	self copyFile: file1 toFile: file2.
	file1 close.
	file2 close.
	^ true
!

----- Method: FileDirectory>>putFile:named:retry: (in category 'file operations') -----
putFile: file1 named: destinationFileName retry: aBool
	"Copy the contents of the existing fileStream into the file destinationFileName in this directory.  fileStream can be anywhere in the fileSystem.  No retrying for local file systems."

	^ self putFile: file1 named: destinationFileName
!

----- Method: FileDirectory>>readOnlyFileNamed: (in category 'file stream creation') -----
readOnlyFileNamed: localFileName
	"Open the existing file with the given name in this directory for read-only access."

	^ FileStream concreteStream readOnlyFileNamed: (self fullNameFor: localFileName)
!

----- Method: FileDirectory>>realUrl (in category 'file name utilities') -----
realUrl
	"Senders expect url without trailing slash - #url returns slash"
	| url |
	url := self url.
	url last = $/ ifTrue:[^url copyFrom: 1 to: url size-1].
	^url!

----- Method: FileDirectory>>recursiveDelete (in category 'file operations') -----
recursiveDelete
	"Delete the this directory, recursing down its tree."
	self directoryNames
		do: [:dn | (self directoryNamed: dn) recursiveDelete].
	self deleteLocalFiles.
	"should really be some exception handling for directory deletion, but no 
	support for it yet"
	self containingDirectory deleteDirectory: self localName!

----- Method: FileDirectory>>relativeNameFor: (in category 'file name utilities') -----
relativeNameFor: aFileName
	"Return the full name for aFileName, assuming that aFileName is a name relative to me."
	aFileName isEmpty ifTrue: [ ^pathName asSqueakPathName].
	^aFileName first = self pathNameDelimiter
		ifTrue: [ pathName asSqueakPathName, aFileName ]
		ifFalse: [ pathName asSqueakPathName, self slash, aFileName ]
!

----- Method: FileDirectory>>rename:toBe: (in category 'file operations') -----
rename: oldFileName toBe: newFileName
	| selection oldName newName |
	"Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name."
	"Modified for retry after GC ar 3/21/98 18:09"
	oldName := self fullNameFor: oldFileName.
	newName := self fullNameFor: newFileName.
	(StandardFileStream 
		retryWithGC:[self primRename: oldName asVmPathName to: newName asVmPathName]
		until:[:result| result notNil]
		forFileNamed: oldName) ~~ nil ifTrue:[^self].
	(self fileExists: oldFileName) ifFalse:[
		^self error:'Attempt to rename a non-existent file'.
	].
	(self fileExists: newFileName) ifTrue:[
		selection := (PopUpMenu labels:
'delete old version
cancel')
				startUpWithCaption: 'Trying to rename a file to be
', newFileName , '
and it already exists.'.
		selection = 1 ifTrue:
			[self deleteFileNamed: newFileName.
			^ self rename: oldFileName toBe: newFileName]].
	^self error:'Failed to rename file'.!

----- Method: FileDirectory>>setMacFileNamed:type:creator: (in category 'file operations') -----
setMacFileNamed: fileName type: typeString creator: creatorString
	"Set the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. Does nothing on other platforms (where the underlying primitive is a noop)."
	"FileDirectory default setMacFileNamed: 'foo' type: 'TEXT' creator: 'ttxt'"

 	self primSetMacFileNamed: (self fullNameFor: fileName) asVmPathName
		type: typeString convertToSystemString
		creator: creatorString convertToSystemString.
!

----- Method: FileDirectory>>setPathName: (in category 'private') -----
setPathName: pathString

	pathName := FilePath pathName: pathString.
!

----- Method: FileDirectory>>slash (in category 'path access') -----
slash
	^self class slash!

----- Method: FileDirectory>>sleep (in category 'file directory') -----
sleep
	"Leave the FileList window.  Do nothing.  Disk directories do not have to be shut down."
!

----- Method: FileDirectory>>splitNameVersionExtensionFor: (in category 'file name utilities') -----
splitNameVersionExtensionFor: fileName
	" answer an array with the root name, version # and extension.
	See comment in nextSequentialNameFor: for more details"

	| baseName version extension i j |

	baseName := self class baseNameFor: fileName.
	extension := self class extensionFor: fileName.
	i := j := baseName findLast: [:c | c isDigit not].
	i = 0
		ifTrue: [version := 0]
		ifFalse:
			[(baseName at: i) = $.
				ifTrue:
					[version := (baseName copyFrom: i+1 to: baseName size) asNumber.
					j := j - 1]
				ifFalse: [version := 0].
			baseName := baseName copyFrom: 1 to: j].
	^ Array with: baseName with: version with: extension!

----- Method: FileDirectory>>statsForDirectoryTree: (in category 'enumeration') -----
statsForDirectoryTree: rootedPathName
	"Return the size statistics for the entire directory tree starting at the given root. The result is a three element array of the form: (<number of folders><number of files><total bytes in all files>). This method also serves as an example of how recursively enumerate a directory tree."
	"wod 6/16/1998: add Cursor wait, and use 'self pathNameDelimiter asString' rather than hardwired ':' "
	"FileDirectory default statsForDirectoryTree: '\smalltalk'"

	| dirs files bytes todo p entries |
	Cursor wait showWhile: [
		dirs := files := bytes := 0.
		todo := OrderedCollection with: rootedPathName.
		[todo isEmpty] whileFalse: [
			p := todo removeFirst.
			entries := self directoryContentsFor: p.
			entries do: [:entry |
				(entry at: 4)
					ifTrue: [
						todo addLast: (p, self pathNameDelimiter asString, (entry at: 1)).
						dirs := dirs + 1]
					ifFalse: [
						files := files + 1.
						bytes := bytes + (entry at: 5)]]]].

	^ Array with: dirs with: files with: bytes
!

----- Method: FileDirectory>>storeServerEntryOn: (in category 'private') -----
storeServerEntryOn: stream
	
	stream
		nextPutAll: 'name:'; tab; nextPutAll: self localName; cr;
		nextPutAll: 'directory:'; tab; nextPutAll: self pathName; cr;
		nextPutAll: 'type:'; tab; nextPutAll: 'file'; cr!

----- Method: FileDirectory>>upLoadProject:named:resourceUrl:retry: (in category 'file operations') -----
upLoadProject: projectFile named: destinationFileName resourceUrl: resUrl retry: aBool
	"Copy the contents of the existing fileStream into the file destinationFileName in this directory.  fileStream can be anywhere in the fileSystem.  No retrying for local file systems."

	| result |
	result := self putFile: projectFile named: destinationFileName.
	[self
		setMacFileNamed: destinationFileName
		type: 'SOBJ'
		creator: 'FAST']
		on: Error
		do: [ "ignore" ].
	^result!

----- Method: FileDirectory>>updateProjectInfoFor: (in category 'squeaklets') -----
updateProjectInfoFor: aProject

	"only swiki servers for now"!

----- Method: FileDirectory>>wakeUp (in category 'file directory') -----
wakeUp
	"Entering a FileList window.  Do nothing.  Disk directories do not have to be awakened."
!

----- Method: FileDirectory>>withAllFilesDo:andDirectoriesDo: (in category 'searching') -----
withAllFilesDo: fileStreamBlock andDirectoriesDo: directoryBlock

	"For the receiver and all it's subdirectories evaluate directoryBlock.
	For a read only file stream on each file within the receiver 
	and it's subdirectories evaluate fileStreamBlock."

	| todo dir |

	todo := OrderedCollection with: self.
	[todo size > 0] whileTrue: [
		dir := todo removeFirst.
		directoryBlock value: dir.
		dir fileNames do: [: n | 
			fileStreamBlock value: 
				(FileStream readOnlyFileNamed: (dir fullNameFor: n))].
		dir directoryNames do: [: n | 
			todo add: (dir directoryNamed: n)]]

!

----- Method: FileDirectory>>withAllSubdirectoriesCollect: (in category 'enumeration') -----
withAllSubdirectoriesCollect: aBlock
	"Evaluate aBlock with each of the directories in the subtree of the file system whose root is this directory.
	Answer the results of these evaluations."

	| result todo dir |
	result := OrderedCollection new: 100.
	todo := OrderedCollection with: self.
	[todo size > 0] whileTrue: [
		dir := todo removeFirst.
		result add: (aBlock value: dir).
		dir directoryNames do: [:n | todo add: (dir directoryNamed: n)]].
	^ result
!

----- Method: FileDirectory>>writeProject:inFileNamed:fromDirectory: (in category 'squeaklets') -----
writeProject: aProject inFileNamed: fileNameString fromDirectory: localDirectory 
	"write aProject (a file version can be found in the file named fileNameString in localDirectory)"
	aProject
		writeFileNamed: fileNameString
		fromDirectory: localDirectory
		toServer: self!

FileDirectory subclass: #MacFileDirectory
	instanceVariableNames: ''
	classVariableNames: 'TypeToMimeMappings'
	poolDictionaries: ''
	category: 'Files-Directories'!

!MacFileDirectory commentStamp: '<historical>' prior: 0!
I represent a Macintosh FileDirectory.
!

----- Method: MacFileDirectory class>>initializeTypeToMimeMappings (in category 'class initialization') -----
initializeTypeToMimeMappings
	"MacFileDirectory initializeTypeToMimeMappings"
	TypeToMimeMappings := Dictionary new.
	#(
		"format"
		"(abcd		('image/gif'))"
	) do:[:spec|
		TypeToMimeMappings at: spec first asString put: spec last.
	].
!

----- Method: MacFileDirectory class>>isAbsolute: (in category 'class initialization') -----
isAbsolute: fileName
	"Return true if the given fileName is absolute. The rules are:

If a path begins with a colon, it is relative.
Otherwise,
  If it contains a colon anywhere, it is absolute and the first component is the volume name.
  Otherwise,
    It is relative."

	^fileName first ~= $:
		and: [ fileName includes: $: ]!

----- Method: MacFileDirectory class>>isActiveDirectoryClass (in category 'platform specific') -----
isActiveDirectoryClass
	^ super isActiveDirectoryClass
		and: [(SmalltalkImage current getSystemAttribute: 1201) isNil
				or: [(SmalltalkImage current getSystemAttribute: 1201) asNumber <= 31]]!

----- Method: MacFileDirectory class>>isCaseSensitive (in category 'platform specific') -----
isCaseSensitive
	"Mac OS ignores the case of file names"
	^ false!

----- Method: MacFileDirectory class>>makeAbsolute: (in category 'platform specific') -----
makeAbsolute: path
	"Ensure that path looks like an absolute path"
	| absolutePath |
	(self isAbsolute: path)
		ifTrue: [ ^path ].
	"If a path begins with a colon, it is relative."
	absolutePath := (path first = $:)
		ifTrue: [ path copyWithoutFirst ]
		ifFalse: [ path ].
	(self isAbsolute: absolutePath)
		ifTrue: [ ^absolutePath ].
	"Otherwise, if it contains a colon anywhere, it is absolute and the first component is the volume name."
	^absolutePath, ':'!

----- Method: MacFileDirectory class>>makeRelative: (in category 'platform specific') -----
makeRelative: path
	"Ensure that path looks like an relative path"
	^path first = $:
		ifTrue: [ path ]
		ifFalse: [ ':', path ]!

----- Method: MacFileDirectory class>>maxFileNameLength (in category 'platform specific') -----
maxFileNameLength

	^31!

----- Method: MacFileDirectory class>>pathNameDelimiter (in category 'platform specific') -----
pathNameDelimiter

	^ $:
!

----- Method: MacFileDirectory>>fullNameFor: (in category 'as yet unclassified') -----
fullNameFor: fileName
	"Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name."
	"Details: Note that path relative to a directory, such as '../../foo' are disallowed by this algorithm.  Also note that this method is tolerent of a nil argument -- is simply returns nil in this case."
	"Fix by hmm: for a file in the root directory of a volume on MacOS, the filePath (name of the directory) is not  recognizable as an absolute path anymore (it has no delimiters). Therefore, the original fileName is tested for absoluteness, and the filePath is only made absolute if the original fileName was not absolute"

	| correctedLocalName prefix |
	fileName isEmptyOrNil ifTrue: [^ fileName].
	DirectoryClass splitName: fileName to:
		[:filePath :localName |
			correctedLocalName := localName isEmpty 
				ifFalse: [self checkName: localName fixErrors: true]
				ifTrue: [localName].
			prefix := (DirectoryClass isAbsolute: fileName)
						ifTrue: [filePath]
						ifFalse: [self fullPathFor: filePath]].
	prefix isEmpty
		ifTrue: [^correctedLocalName].
	prefix last = self pathNameDelimiter
		ifTrue:[^ prefix, correctedLocalName]
		ifFalse:[^ prefix, self slash, correctedLocalName]!

----- Method: MacFileDirectory>>fullPathFor: (in category 'file operations') -----
fullPathFor: path
	"Return the fully-qualified path name for the given file."
	path isEmptyOrNil ifTrue: [^ pathName asSqueakPathName].
	(self class isAbsolute: path) ifTrue: [^ path].
	pathName asSqueakPathName = ''			"Root dir?"
		ifTrue: [ ^path].
	^(path first = $:)
		ifTrue: [ pathName asSqueakPathName, path ]
		ifFalse: [pathName asSqueakPathName, ':' , path]!

----- Method: MacFileDirectory>>mimeTypesFor: (in category 'file operations') -----
mimeTypesFor: fileName
	"Return a list of MIME types applicable to the receiver. This default implementation uses the file name extension to figure out what we're looking at but specific subclasses may use other means of figuring out what the type of some file is. Some systems like the macintosh use meta data on the file to indicate data type"
	| typeCreator type | 
	typeCreator := self getMacFileTypeAndCreator: ((self fullNameFor: fileName)).
	type := (typeCreator at: 1) asLowercase.
	^TypeToMimeMappings at: type ifAbsent:[super mimeTypesFor: fileName]!

MacFileDirectory subclass: #MacHFSPlusFileDirectory
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Directories'!

----- Method: MacHFSPlusFileDirectory class>>isActiveDirectoryClass (in category 'platform specific') -----
isActiveDirectoryClass
	"Ok, lets see if we support HFS Plus file names, the long ones"

	^ (self pathNameDelimiter = self primPathNameDelimiter) and: [(SmalltalkImage current  getSystemAttribute: 1201) notNil and: [(SmalltalkImage current getSystemAttribute: 1201) asNumber > 31]]!

----- Method: MacHFSPlusFileDirectory class>>maxFileNameLength (in category 'platform specific') -----
maxFileNameLength

	^ 255!

FileDirectory subclass: #UnixFileDirectory
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Directories'!

!UnixFileDirectory commentStamp: '<historical>' prior: 0!
I represent a Unix FileDirectory.
!

----- Method: UnixFileDirectory class>>maxFileNameLength (in category 'platform specific') -----
maxFileNameLength

	^ 255!

----- Method: UnixFileDirectory class>>pathNameDelimiter (in category 'platform specific') -----
pathNameDelimiter

	^ $/
!

----- Method: UnixFileDirectory>>directoryExists: (in category 'testing') -----
directoryExists: filenameOrPath
	"Handles the special case of testing for the root dir: there isn't a
	possibility to express the root dir as full pathname like '/foo'."

	^ filenameOrPath = '/' or: [super directoryExists: filenameOrPath]!

----- Method: UnixFileDirectory>>fileOrDirectoryExists: (in category 'testing') -----
fileOrDirectoryExists: filenameOrPath 
	"Handles the special case of testing for the root dir: there isn't a 
	possibility to express the root dir as full pathname like '/foo'."

	^ filenameOrPath = '/' or: [super fileOrDirectoryExists: filenameOrPath]!

----- Method: UnixFileDirectory>>fullPathFor: (in category 'file names') -----
fullPathFor: path
	"Return the fully-qualified path name for the given file."
	path isEmpty ifTrue: [^ pathName asSqueakPathName].
	path first = $/ ifTrue: [^ path].
	^ pathName asSqueakPathName = '/'			"Only root dir ends with a slash"
		ifTrue: ['/' , path]
		ifFalse: [pathName asSqueakPathName , '/' , path]!

----- Method: UnixFileDirectory>>pathFromUrl: (in category 'file names') -----
pathFromUrl: aFileUrl
	^'/', (super pathFromUrl: aFileUrl)!

----- Method: UnixFileDirectory>>setPathName: (in category 'private') -----
setPathName: pathString
	"Unix path names start with a leading delimiter character."

	(pathString isEmpty or: [pathString first ~= self pathNameDelimiter])
		ifTrue: [pathName := FilePath pathName: (self pathNameDelimiter asString, pathString)]
		ifFalse: [pathName := FilePath pathName: pathString].
!

Object subclass: #FilePath
	instanceVariableNames: 'squeakPathName vmPathName converter'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Directories'!

!FilePath commentStamp: 'yo 10/19/2004 21:36' prior: 0!
This class absorb the difference of internal and external representation of the file path.  The idea is to keep the internal one as much as possible, and only when it goes to a primitive, the encoded file path, i.e. the native platform representation is passsed to the primitive.

	The converter used is obtained by "LanguageEnvironment defaultFileNameConverter".
!

----- Method: FilePath class>>classVersion (in category 'as yet unclassified') -----
classVersion

	^ 1.
!

----- Method: FilePath class>>pathName: (in category 'instance creation') -----
pathName: pathName

	^ self pathName: pathName isEncoded: false.
!

----- Method: FilePath class>>pathName:isEncoded: (in category 'instance creation') -----
pathName: pathName isEncoded: aBoolean

	^ (self new) pathName: pathName isEncoded: aBoolean; yourself.
!

----- Method: FilePath>>asSqueakPathName (in category 'conversion') -----
asSqueakPathName

	^ self pathName.
!

----- Method: FilePath>>asString (in category 'conversion') -----
asString
	^self asSqueakPathName!

----- Method: FilePath>>asVmPathName (in category 'conversion') -----
asVmPathName

	^ vmPathName.
!

----- Method: FilePath>>convertToCurrentVersion:refStream: (in category 'file in/out') -----
convertToCurrentVersion: varDict refStream: smartRefStrm
	"If we're reading in an old version with a system path instance variable, convert it to a vm path."

	varDict at: 'systemPathName' ifPresent: [ :x | 
		vmPathName := x.
	].
	^super convertToCurrentVersion: varDict refStream: smartRefStrm.
!

----- Method: FilePath>>copySystemToVm (in category 'file in/out') -----
copySystemToVm

	(self class instVarNames includes: 'systemPathName') ifTrue: [
		vmPathName := self instVarNamed: 'systemPathName'.
	].

!

----- Method: FilePath>>coverter: (in category 'conversion') -----
coverter: aTextConverter

	converter class ~= aTextConverter class ifTrue: [
		converter := aTextConverter.
		vmPathName := squeakPathName convertToWithConverter: converter
	].
!

----- Method: FilePath>>isNullPath (in category 'testing') -----
isNullPath
	"an empty path is used to represent the root path(s) when calling the primitive to list directory entries. Some users need to check for this and this is cleaner than grabbing the pathname and assuming it is a plain String"
	^self pathName isEmpty!

----- Method: FilePath>>pathName (in category 'conversion') -----
pathName

	^ squeakPathName.
!

----- Method: FilePath>>pathName:isEncoded: (in category 'conversion') -----
pathName: p isEncoded: isEncoded

	converter := LanguageEnvironment defaultFileNameConverter.
	isEncoded ifTrue: [
		squeakPathName := p convertFromWithConverter: converter.
		vmPathName := p.
	] ifFalse: [
		squeakPathName := p isOctetString ifTrue: [p asOctetString] ifFalse: [p].
		vmPathName := squeakPathName convertToWithConverter: converter.
	].
!

----- Method: FilePath>>printOn: (in category 'conversion') -----
printOn: aStream

	aStream nextPutAll: 'FilePath('''.
	aStream nextPutAll: squeakPathName.
	aStream nextPutAll: ''')'.
!

Object subclass: #RemoteString
	instanceVariableNames: 'sourceFileNumber filePositionHi'
	classVariableNames: 'TextAttributeStructureVersions CurrentTextAttVersion CurrentTextAttStructure'
	poolDictionaries: ''
	category: 'Files-System'!

!RemoteString commentStamp: '<historical>' prior: 0!
My instances provide an external file reference to a piece of text.  It may be the sourceCode of a method, or the class comments of a class.

The changes file or file-in file usually has a chunk that is just the source string of a method:

max: aNumber
	^ self > aNumber ifTrue: [self] ifFalse: [aNumber]!!

I can return either a String or a Text.  Some a chunk is followed by a second chunk (beginning with ]style[) containing style information.  The encoding is like this:

max: aNumber
	^ self > aNumber ifTrue: [self] ifFalse: [aNumber]!!
]style[(14 50 312)f1,f1b,f1LInteger +;i!!

Allowed TextAttributes are TextFontChange, TextEmphasis, TextColor, TextDoIt, TextKern, TextLink, TextURL.  TextFontReference and TextAnchor are not supported.

See PositionableStream nextChunkText and RunArray class scanFrom:.!

----- Method: RemoteString class>>currentTextAttVersion (in category 'as yet unclassified') -----
currentTextAttVersion
	"The current configuration of the TextAttributes classes has a structures array describing the inst vars of the classes (SmartRefStream instVarInfo:).  Return tag that indexes the TextAttributeStructureVersions dictionary (4 random characters)."

	^ CurrentTextAttVersion
	"Be sure to run makeNewTextAttVersion when any TextAttributes class changes inst vars"!

----- Method: RemoteString class>>initialize (in category 'as yet unclassified') -----
initialize
	"Derive the current TextAttributes classes object structure"

	self new makeNewTextAttVersion!

----- Method: RemoteString class>>newFileNumber:position: (in category 'as yet unclassified') -----
newFileNumber: sourceIndex position: anInteger 
	"Answer an instance of me fora file indexed by sourceIndex, at the 
	position anInteger. Assume that the string is already stored on the file 
	and the instance will be used to access it."

	^self new fileNumber: sourceIndex position: anInteger!

----- Method: RemoteString class>>newString:onFileNumber: (in category 'as yet unclassified') -----
newString: aString onFileNumber: sourceIndex 
	"Answer an instance of me for string, aString, on file indexed by 
	sourceIndex. Put the string on the file and create the remote reference."

	^self new string: aString onFileNumber: sourceIndex!

----- Method: RemoteString class>>newString:onFileNumber:toFile: (in category 'as yet unclassified') -----
newString: aString onFileNumber: sourceIndex toFile: aFileStream
	"Answer an instance of me for string, aString, on file indexed by 
	sourceIndex. Put the string on the file, aFileStream, and create the 
	remote reference. Assume that the index corresponds properly to 
	aFileStream."

	^self new string: aString onFileNumber: sourceIndex toFile: aFileStream!

----- Method: RemoteString class>>structureAt: (in category 'as yet unclassified') -----
structureAt: styleVersion

	^ TextAttributeStructureVersions at: styleVersion ifAbsent: [nil]!

----- Method: RemoteString>>checkSum: (in category 'private') -----
checkSum: aString
	"Construct a checksum of the string.  A three byte number represented as Base64 characters."

| sum shift bytes ss bb |
sum := aString size.
shift := 0.
aString do: [:char |
	(shift := shift + 7) > 16 ifTrue: [shift := shift - 17].
		"shift by 7 to keep a change of adjacent chars from xoring to same value"
	sum := sum bitXor: (char asInteger bitShift: shift)].
bytes := ByteArray new: 3.
sum := sum + 16r10000000000.
1 to: 3 do: [:ind | bytes at: ind put: (sum digitAt: ind)].
ss := ReadWriteStream on: (ByteArray new: 3).
ss nextPutAll: bytes.
bb := Base64MimeConverter mimeEncode: ss.
^ bb contents!

----- Method: RemoteString>>fileNumber:position: (in category 'private') -----
fileNumber: fileNumber position: position 

	sourceFileNumber := fileNumber.
	filePositionHi := position!

----- Method: RemoteString>>fileStream (in category 'accessing') -----
fileStream 
	"Answer the file stream with position set at the beginning of my string"

	| theFile |
	(sourceFileNumber == nil or: [(SourceFiles at: sourceFileNumber) == nil]) ifTrue: [^ nil].
	theFile := SourceFiles at: sourceFileNumber.
	theFile position: filePositionHi.
	^ theFile!

----- Method: RemoteString>>last (in category 'accessing') -----
last
	^self string ifNotNilDo: [ :s | s last ]!

----- Method: RemoteString>>makeNewTextAttVersion (in category 'private') -----
makeNewTextAttVersion
	"Create a new TextAttributes version because some inst var has changed.  If no change, don't make a new one."
	"Don't delete this method even though it has no callers!!!!!!!!!!"

| obj cls struct tag |
"Note that TextFontReference and TextAnchor are forbidden."
obj := #(RunArray TextDoIt TextLink TextURL TextColor TextEmphasis TextFontChange TextKern TextLinkToImplementors 3 'a string') collect: [:each | 
		cls := Smalltalk at: each ifAbsent: [nil].
		cls ifNil: [each] ifNotNil: [cls new]].
struct := (SmartRefStream on: (RWBinaryOrTextStream on: String new)) instVarInfo: obj.
tag := self checkSum: struct printString.
TextAttributeStructureVersions ifNil: [TextAttributeStructureVersions := Dictionary new].
(struct = CurrentTextAttStructure) & (tag = CurrentTextAttVersion) 
	ifTrue: [^ false].
CurrentTextAttStructure := struct.
CurrentTextAttVersion := tag.
TextAttributeStructureVersions at: tag put: struct.
^ true!

----- Method: RemoteString>>position (in category 'accessing') -----
position 
	"Answer the location of the string on a file."

	^ filePositionHi!

----- Method: RemoteString>>setSourcePointer: (in category 'accessing') -----
setSourcePointer: aSourcePointer
	sourceFileNumber := SourceFiles fileIndexFromSourcePointer: aSourcePointer.
	filePositionHi := SourceFiles filePositionFromSourcePointer: aSourcePointer!

----- Method: RemoteString>>sourceFileNumber (in category 'accessing') -----
sourceFileNumber
	"Answer the index of the file on which the string is stored."

	^sourceFileNumber!

----- Method: RemoteString>>sourcePointer (in category 'accessing') -----
sourcePointer
	sourceFileNumber ifNil: [^ 0].
	^SourceFiles sourcePointerFromFileIndex: sourceFileNumber andPosition: filePositionHi!

----- Method: RemoteString>>string (in category 'accessing') -----
string 
	"Answer the receiver's string if remote files are enabled."
	| theFile |
	(sourceFileNumber == nil or: [(SourceFiles at: sourceFileNumber) == nil]) ifTrue: [^''].
	theFile := SourceFiles at: sourceFileNumber.
	theFile position: filePositionHi.
	^ theFile nextChunk!

----- Method: RemoteString>>string:onFileNumber: (in category 'private') -----
string: aString onFileNumber: fileNumber
	"Store this as my string if source files exist."
	| theFile |
	(SourceFiles at: fileNumber) == nil ifFalse: 
		[theFile := SourceFiles at: fileNumber.
		theFile setToEnd; cr.
		self string: aString onFileNumber: fileNumber toFile: theFile]!

----- Method: RemoteString>>string:onFileNumber:toFile: (in category 'private') -----
string: aStringOrText onFileNumber: fileNumber toFile: aFileStream 
	"Store this as the receiver's text if source files exist. If aStringOrText is a Text, store a marker with the string part, and then store the runs of TextAttributes in the next chunk."

	| position |
	position := aFileStream position.
	self fileNumber: fileNumber position: position.
	aFileStream nextChunkPutWithStyle: aStringOrText
	"^ self		(important)"!

----- Method: RemoteString>>text (in category 'accessing') -----
text 
	"Answer the receiver's string asText if remote files are enabled."
	| theFile |
	(sourceFileNumber == nil or: [(SourceFiles at: sourceFileNumber) == nil]) ifTrue: [^ nil].
	theFile := SourceFiles at: sourceFileNumber.
	theFile position: filePositionHi.
	theFile position > theFile size ifTrue: [
		self error: 'RemoteString past end of file' ].
	^ theFile nextChunkText!

ArrayedCollection subclass: #DirectoryEntry
	instanceVariableNames: 'name creationTime modificationTime dirFlag fileSize'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Directories'!

!DirectoryEntry commentStamp: '<historical>' prior: 0!
an entry in a directory; a reference to either a file or a directory.!

----- Method: DirectoryEntry class>>fromArray: (in category 'instance creation') -----
fromArray: array
	^self name: (array at: 1) creationTime: (array at: 2) modificationTime: (array at: 3) isDirectory: (array at: 4) fileSize: (array at: 5) !

----- Method: DirectoryEntry class>>name:creationTime:modificationTime:isDirectory:fileSize: (in category 'instance creation') -----
name: name0  creationTime: creationTime  modificationTime: modificationTime   isDirectory: isDirectory  fileSize: fileSize
	^self new privateName: name0  creationTime: creationTime  modificationTime: modificationTime  isDirectory: isDirectory  fileSize: fileSize!

----- Method: DirectoryEntry>>at: (in category 'access-compatibility') -----
at: index
	"compatibility interface"
	"self halt: 'old-style access to DirectoryEntry'"
	index = 1 ifTrue: [ ^self name ].
	index = 2 ifTrue: [ ^self creationTime ].
	index = 3 ifTrue: [ ^self modificationTime ].
	index = 4 ifTrue:[ ^self isDirectory ].
	index = 5 ifTrue:[ ^self fileSize ].
	self error: 'invalid index specified'.!

----- Method: DirectoryEntry>>convertFromSystemName (in category 'multilingual system') -----
convertFromSystemName

	name := (FilePath pathName: name isEncoded: true) asSqueakPathName!

----- Method: DirectoryEntry>>creationTime (in category 'access') -----
creationTime
	"time the entry was created.  (what's its type?)"
	^creationTime!

----- Method: DirectoryEntry>>fileSize (in category 'access') -----
fileSize
	"size of the entry, if it's a file"
	^fileSize!

----- Method: DirectoryEntry>>isDirectory (in category 'access') -----
isDirectory
	"whether this entry represents a directory"
	^dirFlag!

----- Method: DirectoryEntry>>modificationTime (in category 'access') -----
modificationTime
	"time the entry was last modified"
	^modificationTime!

----- Method: DirectoryEntry>>name (in category 'access') -----
name
	"name of the entry"
	^name!

----- Method: DirectoryEntry>>privateName:creationTime:modificationTime:isDirectory:fileSize: (in category 'private-initialization') -----
privateName: name0  creationTime: creationTime0  modificationTime: modificationTime0  isDirectory: isDirectory0  fileSize: fileSize0
	name := name0.
	creationTime := creationTime0.
	modificationTime := modificationTime0.
	dirFlag := isDirectory0.
	fileSize := fileSize0.!

----- Method: DirectoryEntry>>size (in category 'access-compatibility') -----
size
	^5!

SequenceableCollection subclass: #SourceFileArray
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-System'!

!SourceFileArray commentStamp: '<historical>' prior: 0!
This class is an abstract superclass for source code access mechanisms. It defines the messages that need to be understood by those subclasses that store and retrieve source chunks on files, over the network or in databases.
The first concrete subclass, StandardSourceFileArray, supports access to the traditional sources and changes files. Other subclasses might implement multiple source files for different applications, or access to a network source server.!

----- Method: SourceFileArray>>at: (in category 'accessing') -----
at: index
	self subclassResponsibility!

----- Method: SourceFileArray>>at:put: (in category 'accessing') -----
at: index put: aFileStream
	self subclassResponsibility!

----- Method: SourceFileArray>>collect: (in category 'accessing') -----
collect: aBlock
	| copy |
	copy := self species new: self size.
	1 to: self size do:[:i| copy at: i put: (aBlock value: (self at: i))].
	^copy!

----- Method: SourceFileArray>>fileIndexFromSourcePointer: (in category 'sourcePointer conversion') -----
fileIndexFromSourcePointer: anInteger
	"Return the index of a source file corresponding to the given source pointer."
	self subclassResponsibility!

----- Method: SourceFileArray>>filePositionFromSourcePointer: (in category 'sourcePointer conversion') -----
filePositionFromSourcePointer: anInteger
	"Return the position within a source file for the given source pointer."
	self subclassResponsibility!

----- Method: SourceFileArray>>size (in category 'accessing') -----
size
	self subclassResponsibility!

----- Method: SourceFileArray>>sourcePointerFromFileIndex:andPosition: (in category 'sourcePointer conversion') -----
sourcePointerFromFileIndex: index andPosition: position
	"Return a sourcePointer encoding the given file index and position"
	self subclassResponsibility!

SourceFileArray subclass: #StandardSourceFileArray
	instanceVariableNames: 'files'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-System'!

!StandardSourceFileArray commentStamp: '<historical>' prior: 0!
This class implements the source file management behavior of traditional Squeak, with a sources file and a changes file. File positions are mapped such that those files can be up to 32MBytes in size.

Structure:
 files		Array -- storing the actual source files
!

----- Method: StandardSourceFileArray class>>install (in category 'initialize-release') -----
install
	"Replace SourceFiles by an instance of me with the standard sources and changes files.
	This only works if SourceFiles is either an Array or an instance of this class"

	"StandardSourceFileArray install"

	SourceFiles := self new!

----- Method: StandardSourceFileArray class>>new: (in category 'initialize-release') -----
new: nFiles
	^self new initialize: nFiles.!

----- Method: StandardSourceFileArray>>at: (in category 'accessing') -----
at: index
	^files at: index!

----- Method: StandardSourceFileArray>>at:put: (in category 'accessing') -----
at: index put: aFile
	files at: index put: aFile!

----- Method: StandardSourceFileArray>>fileIndexFromSourcePointer: (in category 'sourcePointer conversion') -----
fileIndexFromSourcePointer: anInteger
	"Return the index of the source file which contains the source chunk addressed by anInteger"
	"This implements the recent 32M source file algorithm"

	| hi |
	hi := anInteger // 16r1000000.
	^hi < 3
		ifTrue: [hi]
		ifFalse: [hi - 2]!

----- Method: StandardSourceFileArray>>filePositionFromSourcePointer: (in category 'sourcePointer conversion') -----
filePositionFromSourcePointer: anInteger
	"Return the position of the source chunk addressed by anInteger"
	"This implements the recent 32M source file algorithm"

	| hi lo |
	hi := anInteger // 16r1000000.
	lo := anInteger \\ 16r1000000.
	^hi < 3
		ifTrue: [lo]
		ifFalse: [lo + 16r1000000]!

----- Method: StandardSourceFileArray>>initialize (in category 'initialize-release') -----
initialize
	files := Array new: 2.
	files at: 1 put: (SourceFiles at: 1).
	files at: 2 put: (SourceFiles at: 2)!

----- Method: StandardSourceFileArray>>initialize: (in category 'initialize-release') -----
initialize: nFiles
	files := Array new: nFiles!

----- Method: StandardSourceFileArray>>size (in category 'accessing') -----
size
	^files size!

----- Method: StandardSourceFileArray>>sourcePointerFromFileIndex:andPosition: (in category 'sourcePointer conversion') -----
sourcePointerFromFileIndex: index andPosition: position
	| hi lo |
	"Return a source pointer according to the new 32M algorithm"
	((index between: 1 and: 2) and: [position between: 0 and: 16r1FFFFFF])
		ifFalse: [self error: 'invalid source code pointer'].
	hi := index.
	lo := position.
	lo >= 16r1000000 ifTrue: [
		hi := hi+2.
		lo := lo - 16r1000000].
	^hi * 16r1000000 + lo!

TestCase subclass: #DosFileDirectoryTests
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Tests'!

----- Method: DosFileDirectoryTests>>testFileDirectoryContainingDirectory (in category 'as yet unclassified') -----
testFileDirectoryContainingDirectory
	"Hoping that you have 'C:' of course..."
	| fd |
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	fd := FileDirectory on: 'C:'.
	self assert: fd containingDirectory pathName = ''.
!

----- Method: DosFileDirectoryTests>>testFileDirectoryContainingDirectoryExistence (in category 'as yet unclassified') -----
testFileDirectoryContainingDirectoryExistence
	"Hoping that you have 'C:' of course..."
	| fd |
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	fd := FileDirectory on: 'C:'.
	self assert: (fd containingDirectory fileOrDirectoryExists: 'C:').!

----- Method: DosFileDirectoryTests>>testFileDirectoryContainingEntry (in category 'as yet unclassified') -----
testFileDirectoryContainingEntry
	"Hoping that you have 'C:' of course..."
	| fd |
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	fd := FileDirectory on: 'C:'.
	self assert: (fd containingDirectory entryAt: fd localName) notNil.
!

----- Method: DosFileDirectoryTests>>testFileDirectoryDirectoryEntry (in category 'as yet unclassified') -----
testFileDirectoryDirectoryEntry
	"Hoping that you have 'C:' of course..."
	| fd |
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	fd := FileDirectory on: 'C:'.
	self assert: fd directoryEntry notNil.!

----- Method: DosFileDirectoryTests>>testFileDirectoryEntryFor (in category 'as yet unclassified') -----
testFileDirectoryEntryFor
	"Hoping that you have 'C:' of course..."
	| fd |
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	fd := FileDirectory root directoryEntryFor: 'C:'.
	self assert: (fd name sameAs: 'C:').!

----- Method: DosFileDirectoryTests>>testFileDirectoryExists (in category 'as yet unclassified') -----
testFileDirectoryExists
	"Hoping that you have 'C:' of course..."
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	self assert: (FileDirectory root directoryExists: 'C:').!

----- Method: DosFileDirectoryTests>>testFileDirectoryLocalName (in category 'as yet unclassified') -----
testFileDirectoryLocalName
	"Hoping that you have 'C:' of course..."
	| fd |
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	fd := FileDirectory on: 'C:'.
	self assert: fd localName = 'C:'.
!

----- Method: DosFileDirectoryTests>>testFileDirectoryNamed (in category 'as yet unclassified') -----
testFileDirectoryNamed
	"Hoping that you have 'C:' of course..."
	| fd |
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	fd := FileDirectory root directoryNamed: 'C:'.
	self assert: fd pathName = 'C:'.!

----- Method: DosFileDirectoryTests>>testFileDirectoryNonExistence (in category 'as yet unclassified') -----
testFileDirectoryNonExistence

	| inexistentFileName |
	
	"Hoping that you have 'C:' of course..."
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	
	inexistentFileName := DosFileDirectory default nextNameFor: 'DosFileDirectoryTest' extension: 'temp'.
	
	"This test can fail if another process creates a file with the same name as inexistentFileName
	(the probability of that is very very remote)"

	self deny: (DosFileDirectory default fileOrDirectoryExists: inexistentFileName)!

----- Method: DosFileDirectoryTests>>testFileDirectoryRootExistence (in category 'as yet unclassified') -----
testFileDirectoryRootExistence
	"Hoping that you have 'C:' of course..."
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	self assert: (FileDirectory root fileOrDirectoryExists: 'C:').!

----- Method: DosFileDirectoryTests>>testFullNameFor (in category 'as yet unclassified') -----
testFullNameFor
	"Hoping that you have 'C:' of course..."
	FileDirectory activeDirectoryClass == DosFileDirectory ifFalse:[^self].
	self assert: (FileDirectory default fullNameFor: 'C:') = 'C:'.
	self assert: (FileDirectory default fullNameFor: 'C:\test') = 'C:\test'.
	self assert: (FileDirectory default fullNameFor: '\\share') = '\\share'.
	self assert: (FileDirectory default fullNameFor: '\\share\test') = '\\share\test'.
	self assert: (FileDirectory default fullNameFor: '\test') = (FileDirectory default pathParts first, '\test').
!

----- Method: DosFileDirectoryTests>>testIsDriveForDrive (in category 'as yet unclassified') -----
testIsDriveForDrive
	self assert: (DosFileDirectory isDrive: 'C:').
	self deny: (DosFileDirectory isDrive: 'C:\').
	self deny: (DosFileDirectory isDrive: 'C:\foo').
	self deny: (DosFileDirectory isDrive: 'C:foo').!

----- Method: DosFileDirectoryTests>>testIsDriveForShare (in category 'as yet unclassified') -----
testIsDriveForShare
	self assert: (DosFileDirectory isDrive: '\\server').
	self deny: (DosFileDirectory isDrive: '\\server\').
	self deny: (DosFileDirectory isDrive: '\\server\foo').
!

TestCase subclass: #MacFileDirectoryTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Tests'!

----- Method: MacFileDirectoryTest>>testMacFileDirectory (in category 'test') -----
testMacFileDirectory
	"(self run: #testMacFileDirectory)"
	
	"This fails before the the fix if the Squeak directory is on the root
	directory like: 'HardDisk:Squeak'
	But should work both before and after the fix of John if there is several
	directories in the hieracry: HardDisk:User:Squeak"
	"If somebody can find a way to make the test failed all the time when the fix is not 
	present we should replace it"

	self assert: (FileDirectory default fullName) = (FileDirectory default fullNameFor: (FileDirectory default fullName))!

----- Method: MacFileDirectoryTest>>testMacIsAbsolute (in category 'test') -----
testMacIsAbsolute
	"(self selector: #testMacIsAbsolute) run"
	
	
	self deny: (MacFileDirectory isAbsolute: 'Volumes').
	self assert: (MacFileDirectory isAbsolute: 'Volumes:Data:Stef').
	self deny: (MacFileDirectory isAbsolute: ':Desktop:test.st')!

----- Method: MacFileDirectoryTest>>testMakeAbsolute (in category 'test') -----
testMakeAbsolute

	self assert: (MacFileDirectory isAbsolute: (MacFileDirectory makeAbsolute: 'Data')).
	self assert: (MacFileDirectory isAbsolute: (MacFileDirectory makeAbsolute: ':Data')).
!

ClassTestCase subclass: #FileDirectoryTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Tests'!

----- Method: FileDirectoryTest>>deleteDirectory (in category 'create/delete tests') -----
deleteDirectory
	
	(self myDirectory exists) ifTrue:
		[self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName]!

----- Method: FileDirectoryTest>>myAssuredDirectory (in category 'resources') -----
myAssuredDirectory

	^self myDirectory assureExistence!

----- Method: FileDirectoryTest>>myDirectory (in category 'resources') -----
myDirectory

	^FileDirectory default directoryNamed: self myLocalDirectoryName!

----- Method: FileDirectoryTest>>myLocalDirectoryName (in category 'resources') -----
myLocalDirectoryName

	^'zTestDir'!

----- Method: FileDirectoryTest>>tearDown (in category 'resources') -----
tearDown

	[ self deleteDirectory ] on: Error do: [ :ex | ]!

----- Method: FileDirectoryTest>>testAttemptExistenceCheckWhenFile (in category 'existence tests') -----
testAttemptExistenceCheckWhenFile
"How should a FileDirectory instance respond with an existent file name?"
| directory |
FileDirectory default
				forceNewFileNamed: 'aTestFile'.
directory := FileDirectory default
				directoryNamed: 'aTestFile'.
self shouldnt: [directory exists]
	description: 'Files are not directories.'.!

----- Method: FileDirectoryTest>>testDeleteDirectory (in category 'create/delete tests') -----
testDeleteDirectory
	"Test deletion of a directory"
	
	| aContainingDirectory preTestItems |
	aContainingDirectory := self myDirectory containingDirectory.
	preTestItems := aContainingDirectory fileAndDirectoryNames.
	
	self assert: self myAssuredDirectory exists.
	aContainingDirectory deleteDirectory: self myLocalDirectoryName.

	self shouldnt: 
		[aContainingDirectory directoryNames 
			includes: self myLocalDirectoryName ]
		description: 'Should successfully delete directory.'.
	self should: 
		[preTestItems = aContainingDirectory fileAndDirectoryNames]
		description: 'Should only delete the indicated directory.'.

	
	!

----- Method: FileDirectoryTest>>testDirectoryExists (in category 'existence tests') -----
testDirectoryExists

	self assert: self myAssuredDirectory exists.
	self should: [self myDirectory containingDirectory 
					directoryExists: self myLocalDirectoryName].

	self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName.
	self shouldnt: [self myDirectory containingDirectory 
						directoryExists: self myLocalDirectoryName]!

----- Method: FileDirectoryTest>>testDirectoryExistsWhenLikeNamedFileExists (in category 'existence tests') -----
testDirectoryExistsWhenLikeNamedFileExists

| testFileName |
[testFileName := self myAssuredDirectory fullNameFor: 'zDirExistsTest.testing'.
(FileStream newFileNamed: testFileName) close.

self should: [FileStream isAFileNamed: testFileName].
self shouldnt: [(FileDirectory on: testFileName) exists]]
ensure: [self myAssuredDirectory deleteFileNamed: 'zDirExistsTest.testing']

!

----- Method: FileDirectoryTest>>testDirectoryNamed (in category 'existence tests') -----
testDirectoryNamed

	self should: [(self myDirectory containingDirectory 
					directoryNamed: self myLocalDirectoryName) pathName 
						= self myDirectory pathName]!

----- Method: FileDirectoryTest>>testExists (in category 'existence tests') -----
testExists

	self should: [FileDirectory default exists]
		description: 'Should know default directory exists.'.
	self should: [self myAssuredDirectory exists]
		description: 'Should know created directory exists.'.

	self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName.
	self shouldnt: [(self myDirectory containingDirectory directoryNamed: self myLocalDirectoryName) exists]
		description: 'Should know that recently deleted directory no longer exists.'.!

----- Method: FileDirectoryTest>>testNonExistentDirectory (in category 'existence tests') -----
testNonExistentDirectory

	| directory parentDirectory |
	directory :=FileDirectory default
				directoryNamed: 'nonExistentFolder'.
	self shouldnt: [directory exists] 
		description: 'A FileDirectory instance should know if it points to a non-existent directory.'.

	parentDirectory :=FileDirectory default.
	self shouldnt: [parentDirectory directoryExists: 'nonExistentFolder'] 
		description: 'A FileDirectory instance should know when a directory of the given name doesn''t exist'.
!

----- Method: FileDirectoryTest>>testOldFileOrNoneNamed (in category 'existence tests') -----
testOldFileOrNoneNamed

	| file |
	file := self myAssuredDirectory oldFileOrNoneNamed: 'test.txt'.
	[self assert: file isNil.
	
	"Reproduction of Mantis #1049"
	(self myAssuredDirectory fileNamed: 'test.txt')
		nextPutAll: 'foo';
		close.
		
	file := self myAssuredDirectory oldFileOrNoneNamed: 'test.txt'.
	self assert: file notNil]
		ensure: [
			file ifNotNil: [file close].
			self myAssuredDirectory deleteFileNamed: 'test.txt' ifAbsent: nil]
	
!

ClassTestCase subclass: #FileStreamTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Tests'!

----- Method: FileStreamTest>>testDetectFileDo (in category 'as yet unclassified') -----
testDetectFileDo
	"Mantis #1838"
	
	[(FileDirectory default forceNewFileNamed: 'filestream.tst')
		nextPutAll: '42';
		close.
		
	FileStream 
		detectFile: [FileDirectory default oldFileNamed: 'filestream.tst']
		do: [:file |
			self assert: file notNil.
			self deny: file closed.
			self assert: file contentsOfEntireFile = '42']]
	
		ensure: [FileDirectory default deleteFileNamed: 'filestream.txt' ifAbsent: nil]!



More information about the Packages mailing list