requires: {#Stream. #ExtensibleArray}. provides: {#FileLocator. #FileStream}. prototypes addPrototype: #File derivedFrom: {ExternalResource}. File addDelegate: #handle valued: FileHandle. "This is the Lisp primitive object until the VM setup." f@(File traits) enable []. f@(File traits) openFor: handle@(FileHandle traits) [| newF | newF: f clone. newF handle: handle. newF open ]. f@(File traits) open: filename@(String traits) [ (f handle newNamed: filename) ifNil: [f noneExistsFor: filename] ifNotNilDo: [| :handle | f openFor: handle] ]. f@(File traits) openForInput: filename [ (f handle newForInputNamed: filename) ifNil: [f noneExistsFor: filename] ifNotNilDo: [| :handle | f openFor: handle] ]. f@(File traits) openForOutput: filename [ (f handle newForOutputNamed: filename) ifNil: [f noneExistsFor: filename] ifNotNilDo: [| :handle | f openFor: handle] ]. f@(File traits) openNew: filename [| handle | handle: (f handle newForNewNamed: filename). f openFor: handle ]. f@(File traits) withOpenNamed: filename do: block "Calls the block with the File object as input, opening and closing it transparently in an error-tolerant way. The return value of the block is answered if it completes without error." [| newF | [newF: (f open: filename). block applyWith: newF] ensure: [newF ifNotNil: [newF close]] ]. File traits addPrototype: #NotFound derivedFrom: {DescriptiveError}. File NotFound addSlot: #filename valued: File Locator. f@(File traits) noneExistsFor: filename [| newE | newE: f NotFound clone. newE filename: filename. newE signal ]. e@(File NotFound traits) describe [ DebugConsole ; 'Error: A file does not exist for the pathname: '. e filename printOn: DebugConsole ]. File traits addPrototype: #Locator derivedFrom: {ExternalResource Locator}. File Locator addSlot: #host. "The storage system or logical host of the file." File Locator addSlot: #device. "The logical or physical device hosting the file. (optional)" File Locator addSlot: #path valued: ExtensibleArray newEmpty. "The Sequence of path accessors (directory names) to reach the file's area." File Locator addSlot: #name valued: ''. "The name of a file(-group)." File Locator addSlot: #fileType. "Corresponds to the filetype or suffix used in many filesystems." File Locator addSlot: #version. "Corresponds to the version of a file, with optional support." File Locator traits addSlot: #hostSeparator valued: $:. File Locator traits addSlot: #pathSeparator valued: $\\. f@(File traits) open: l@(File Locator traits) [f open: (l as: String)]. s@(String traits) as: path@(File Locator traits) "Parses the String representation of a path into an actual File Locator object; this will assume the current platform's naming scheme." [| newPath segments endHostPart | newPath: path clone. endHostPart: (s indexOf: path hostSeparator ifAbsent: [0]). newPath host: (s copyFrom: 0 to: endHostPart). newPath path: ((s sliceFrom: endHostPart) splitWith: path pathSeparator) allButLast. newPath name: (s last = path pathSeparator ifTrue: [''] ifFalse: [s copyFrom: (s lastIndexOf: path pathSeparator ifAbsent: [0]) to: (s size - 1)]). newPath ]. l@(File Locator traits) as: s@(String traits) [| result | result: s newEmpty writer. l path do: [| :each | result ; each] separatedBy: [result nextPut: l pathSeparator]. result ; l name ; '.' ; l fileType. result contents ]. f@(File traits) locator "Convert the file's fullName attribute into a Locator object and return that." [ f fullName as: f Locator ]. l@(File Locator traits) openFile [ (File newNamed: (l as: String)) open ]. l@(File Locator traits) withResourceDo: block "Calls the block with the File object as input, opening and closing it transparently in an error-tolerant way. The return value of the block is answered if it completes without error." [| file | [file: l openFile. block applyWith: file] ensure: [file ifNotNil: [file close]] ]. File traits addPrototype: #Stream derivedFrom: {ExternalResource ReadWriteStream. PositionableStream}. File Stream removeSlot: #position. "A bootstrap hack since this would override the FileHandle position accessors." "FIXME: All File Streams are read-write. The following are temporary aliases." File traits addPrototype: #ReadStream derivedFrom: {File Stream}. File traits addPrototype: #WriteStream derivedFrom: {File Stream}. File traits addPrototype: #ReadWriteStream derivedFrom: {File Stream}. fs@(File Stream traits) on: target@(String traits) "Open a File ReadWriteStream on the String path." [ fs on: (File open: target) ]. fs@(File ReadStream traits) on: target@(String traits) "Open a File ReadStream on the String path." [ fs on: (File openForInput: target) ]. fs@(File WriteStream traits) on: target@(String traits) "Open a File WriteStream on the String path." [ fs on: ([File openForOutput: target] on: File NotFound do: [| :c | c return: (File openNew: target)]) ]. fs@(File ReadWriteStream traits) on: target@(String traits) "Open a File ReadWriteStream on the String path." [ fs on: (File open: target) ]. fs@(File Stream traits) elementType "FIXME: kluge." [Character]. fs@(File Stream traits) arrayType [ (fs elementType isSameAs: Character) ifTrue: [String] ifFalse: [ByteArray] ]. fs@(File Stream traits) position [fs resource position]. fs@(File Stream traits) position: index [fs resource position: index]. fs@(File Stream traits) atEnd [fs position = fs resource size]. fs@(File Stream traits) peekForwardBy: offset "Saves the original position and moves forward by the given offset and then restores before answering the element found." [| origPos elem | origPos: fs position. (origPos + offset between: 0 and: fs resource size) ifFalse: [error: 'Beyond the end of the file.']. fs position: origPos + offset - 1. elem: fs next. fs position: origPos. elem ]. fs@(File Stream traits) contents "Get everything from the file at once, preserving the current position in the file." [| s pos | pos: fs position. fs position: 0. s: (fs next: fs resource size). fs position: pos. s ]. fs@(File Stream traits) file [fs resource]. fs@(File Stream traits) next: n putInto: seq@(ExtensibleArray traits) "A utility wrapper for ExtensibleArrays." [ n > (seq contents size - seq firstIndex) ifTrue: [CollectionNotBigEnough signal]. fs next: n putInto: seq contents startingAt: seq firstIndex ]. fs@(File WriteStream traits) nextPutAll: s@(String traits) [fs resource write: s size startingAt: 0 from: (s as: ByteArray). fs]. fs@(File WriteStream traits) nextPut: c@(Character traits) [fs resource write: 1 startingAt: 0 from: {c as: Integer}. fs].