SystemOrganization addCategory: #'FS-Disk'! !FSFilesystem classSide methodsFor: '*fs-disk' stamp: 'cwp 4/4/2011 19:08'! onDisk "Answer a filesystem that represents the 'on-disk' filesystem used by the host operating system." ^ FSDiskStore currentFilesystem! ! FSHandle subclass: #FSFileHandle instanceVariableNames: 'id' classVariableNames: '' poolDictionaries: '' category: 'FS-Disk'! !FSFileHandle commentStamp: 'cwp 11/18/2009 13:02' prior: 0! I provide an interface for doing IO on an open file. I keep an id, which as an opaque identifier used by the FilePlugin primitives. I translate positions from the 1-based indexes used in Smalltalk to the 0-based offsets used by the primitives. I do not implement the primitives myself, instead delegating those to an instance of FilePluginPrimitives.! !FSFileHandle classSide methodsFor: 'class initialization' stamp: 'cwp 11/20/2009 16:16'! initialize self useFilePlugin. ! ! !FSFileHandle classSide methodsFor: 'class initialization' stamp: 'cwp 11/20/2009 16:51'! startUp: resuming "This functionality is disabled for now, to avoid doing a lot of processing at image start up. To reenable, add this class to the start up list." resuming ifTrue: [self allInstancesDo: [:ea | ea startUp]]! ! !FSFileHandle classSide methodsFor: 'class initialization' stamp: 'cwp 7/22/2009 07:11'! useFilePlugin Primitives := FSFilePluginPrims new! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/31/2009 00:05'! at: index read: buffer startingAt: start count: count ^ Primitives setPosition: id to: index - 1; read: id into: buffer startingAt: start count: count ! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 14:15'! at: index write: buffer startingAt: start count: count Primitives setPosition: id to: index - 1; write: id from: buffer startingAt: start count: count ! ! !FSFileHandle methodsFor: 'private' stamp: 'cwp 11/20/2009 14:38'! basicOpen id := reference filesystem basicOpen: reference path writable: writable! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 11/20/2009 14:59'! close Primitives close: id. id := nil! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/22/2009 07:49'! flush Primitives flush: id! ! !FSFileHandle methodsFor: 'testing' stamp: 'cwp 7/22/2009 07:10'! isOpen ^ (Primitives sizeOrNil: id) notNil! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 11/20/2009 14:38'! open self basicOpen. id ifNil: [(writable or: [reference exists]) ifTrue: [self error: 'Unable to open file ' , reference printString] ifFalse: [FSFileDoesNotExist signalWith: reference]]! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/22/2009 07:44'! size ^ Primitives size: id! ! !FSFileHandle methodsFor: 'private' stamp: 'cwp 11/20/2009 16:48'! startUp "This functionality is disabled for now, to avoid doing lots of processing on start up." "We're starting up in a new OS process, so the file id will be invalid. Try to reopen the file, but fail silently: just leave the id as nil. #isOpen will answer false, and we'll raise an error if anyone tries to do IO." self basicOpen! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/22/2009 08:17'! truncateTo: anInteger Primitives truncate: id to: anInteger. self reopen! ! FSStore subclass: #FSDiskStore instanceVariableNames: '' classVariableNames: 'CurrentFS Primitives' poolDictionaries: '' category: 'FS-Disk'! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 2/18/2011 17:22'! activeClass self allSubclassesDo: [:ea | ea isActiveClass ifTrue: [^ ea]]. ^ self! ! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 2/27/2011 10:02'! createDefault ^ self new! ! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 4/4/2011 19:04'! current ^ self currentFilesystem store! ! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 4/4/2011 19:04'! currentFilesystem ^ CurrentFS ifNil: [CurrentFS := FSFilesystem store: self activeClass createDefault]! ! !FSDiskStore classSide methodsFor: 'class initialization' stamp: 'cwp 2/27/2011 10:17'! initialize self useFilePlugin. Smalltalk addToStartUpList: self. ! ! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 2/18/2011 17:20'! isActiveClass ^ self delimiter = Primitives delimiter! ! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 4/4/2011 19:04'! reset CurrentFS := nil! ! !FSDiskStore classSide methodsFor: 'class initialization' stamp: 'cwp 2/27/2011 10:19'! startUp: resuming resuming ifTrue: [self reset]! ! !FSDiskStore classSide methodsFor: 'class initialization' stamp: 'cwp 2/18/2011 11:33'! useFilePlugin Primitives := FSFilePluginPrims new! ! !FSDiskStore methodsFor: 'comparing' stamp: 'cwp 2/27/2011 09:50'! = other ^ self species = other species! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:27'! basenameFromEntry: entry ^ entry at: 1! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 11:32'! basicIsDirectory: anEntry ^ anEntry at: 4! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 11:33'! basicIsFile: anEntry ^ (anEntry at: 4) not! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/28/2011 12:35'! basicOpen: aPath writable: aBoolean | string encoded | string := self stringFromPath: aPath. encoded := Primitives encode: string. ^ Primitives open: encoded writable: aBoolean! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 4/3/2011 22:17'! createDirectory: path "Create a directory for the argument path. If the path refers to an existing file, raise FileExists. If the path refers to an existing directory, raise DirectoryExists. If the parent directory of the path does not exist, raise DirectoryDoesNotExist" | parent encodedPathString pathString result | pathString := self stringFromPath: path. encodedPathString := Primitives encode: pathString. result := Primitives createDirectory: encodedPathString. result ifNil: [ parent := path parent. (self exists: path) ifTrue: [ (self isFile: path) ifTrue: [ self signalFileExists: path ] ifFalse: [ self signalDirectoryExists: path ] ]. (self isDirectory: parent) ifFalse: [ ^ self signalDirectoryDoesNotExist: parent ]. self primitiveFailed ]. ^ self! ! !FSDiskStore methodsFor: 'accessing' stamp: 'cwp 2/27/2011 10:03'! defaultWorkingDirectory | pathString | pathString := Primitives decode: Primitives imageFile. ^ (self pathFromString: pathString) parent! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/27/2011 10:03'! delete: path | pathString encodedPathString | pathString := self stringFromPath: path. encodedPathString := Primitives encode: pathString. (self isDirectory: path) ifTrue: [ Primitives deleteDirectory: encodedPathString ] ifFalse: [ StandardFileStream retryWithGC: [ Primitives deleteFile: encodedPathString ] until: [ :result | result notNil ] forFileNamed: pathString ]! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/27/2011 10:03'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock | encodedPathString index entry pathString | index := 1. pathString := self stringFromPath: aPath. encodedPathString := Primitives encode: pathString. entry := Primitives lookupEntryIn: encodedPathString index: index. entry = #badDirectoryPath ifTrue: [ ^ absentBlock value ]. [ entry isNil ] whileFalse: [ entry at: 1 put: (Primitives decode: entry first). aBlock value: entry. index := index + 1. entry := Primitives lookupEntryIn: encodedPathString index: index ]. ^ self! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 14:45'! entryFromNode: anArray filesystem: aFilesystem path: aPath ^ FSDirectoryEntry filesystem: aFilesystem path: aPath creation: (anArray at: 2) modification: (anArray at: 3) isDir: (anArray at: 4) size: (anArray at: 5)! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/18/2011 14:56'! entryFromNode: node path: path for: aFileystem | entryPath | entryPath := path / (self basenameFromEntry: node). ^ self entryFromNode: node filesystem: aFileystem path: entryPath! ! !FSDiskStore methodsFor: 'printing' stamp: 'cwp 2/27/2011 08:32'! forReferencePrintOn: aStream ! ! !FSDiskStore methodsFor: 'accessing' stamp: 'cwp 2/18/2011 16:02'! handleClass ^ FSFileHandle! ! !FSDiskStore methodsFor: 'comparing' stamp: 'cwp 2/27/2011 09:51'! hash ^ self species hash! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 3/25/2011 13:18'! nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock | name | aPath isRoot ifTrue: [ ^ presentBlock value: self rootNode ]. name := aPath basename. self directoryAt: aPath parent ifAbsent: absentBlock nodesDo: [ :entry | (self filename: (entry at: 1) matches: name) ifTrue: [ ^ presentBlock value: entry ] ]. ^ absentBlock value! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:36'! openFileStream: path writable: aBoolean | fullPath | fullPath := self stringFromPath: path. ^ StandardFileStream new open: fullPath forWrite: aBoolean! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 11:37'! rootNode ^ #('' 0 0 true 0)! ! FSDiskStore subclass: #FSUnixStore instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Disk'! !FSUnixStore classSide methodsFor: 'public' stamp: 'cwp 2/18/2011 17:19'! delimiter ^ $/! ! FSDiskStore subclass: #FSWindowsStore instanceVariableNames: 'disk' classVariableNames: 'Disks' poolDictionaries: '' category: 'FS-Disk'! !FSWindowsStore classSide methodsFor: 'accessing' stamp: 'cwp 2/18/2011 17:19'! delimiter ^ $\! ! !FSWindowsStore methodsFor: 'converting' stamp: 'cwp 2/27/2011 08:15'! pathFromString: aString | class | class := ((aString at: 1) isLetter and: [(aString at: 2) = $:]) ifTrue: [FSAbsolutePath] ifFalse: [FSRelativePath]. ^ class readFrom: aString readStream delimiter: self delimiter! ! !FSWindowsStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/28/2011 12:32'! printPath: aPath on: aStream aPath printOn: aStream delimiter: self delimiter! ! Object subclass: #FSFilePluginPrims instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Disk'! !FSFilePluginPrims commentStamp: 'cwp 11/18/2009 13:02' prior: 0! I provide an interface to the primitives in the FilePlugin. ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:26'! atEnd: id "Answer true if the file position is at the end of the file." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:27'! close: id "Close this file." ! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 11/17/2009 16:26'! createDirectory: 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." ^ nil ! ! !FSFilePluginPrims methodsFor: 'encoding primitives' stamp: 'lr 7/13/2010 14:10'! decode: aString ^ aString convertFromWithConverter: LanguageEnvironment defaultFileNameConverter! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:21'! deleteDirectory: 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." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:22'! deleteFile: aFileName "Delete the file of the given name. Return self if the primitive succeeds, nil otherwise." ^ nil ! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 10/11/2009 11:02'! delimiter "Return the path delimiter for the underlying platform's file system." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'encoding primitives' stamp: 'lr 7/13/2010 14:11'! encode: aString ^ aString convertToWithConverter: LanguageEnvironment defaultFileNameConverter! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'lr 3/21/2010 12:10'! flush: id "Flush pending changes to the disk" | pos | "In some OS's seeking to 0 and back will do a flush" pos := self getPosition: id. self setPosition: id to: 0; setPosition: id to: pos! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:23'! getMacFile: 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." ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:27'! getPosition: id "Get this files current position." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 10/11/2009 11:02'! imageFile "Answer the full path name for the current image." self primitiveFailed! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:24'! lookupEntryIn: 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: 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." ^ #badDirectoryPath ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:27'! open: 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" ^ nil ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:28'! read: 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." self primitiveFailed! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:24'! rename: 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." ^nil! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:25'! 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. This primitive is Mac specific; it is a noop on other platforms." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:30'! setPosition: id to: anInteger "Set this file to the given position." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:30'! size: id "Answer the size of this file." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/22/2009 07:10'! sizeOrNil: id "Answer the size of this file." ^ nil! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:33'! truncate: id to: anInteger "Truncate this file to the given position." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:33'! write: 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." self primitiveFailed! ! FSFileHandle initialize! FSDiskStore initialize!