SystemOrganization addCategory: #'FS-Core-Public'! SystemOrganization addCategory: #'FS-Core-Kernel'! SystemOrganization addCategory: #'FS-Core-Resolvers'! SystemOrganization addCategory: #'FS-Core-Enumeration'! SystemOrganization addCategory: #'FS-Core-Exceptions'! SystemOrganization addCategory: #'FS-Core-Release'! Object subclass: #FSDirectoryEntry instanceVariableNames: 'reference creation modification isDirectory size' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Public'! !FSDirectoryEntry commentStamp: 'cwp 11/18/2009 11:09' prior: 0! I am a cache for metadata about a file or directory. The information I hold is as follows: reference A reference to the file or directory to which my data pertains. creation The creation date and time, stored as number seconds since the Smalltalk epoch. modification The modification date and time, number seconds since the Smalltalk epoch. isDirectory True if my data pertains to a directory, false if a file. size Size in bytes for a file, 0 for a directory. ! !FSDirectoryEntry classSide methodsFor: 'instance creation' stamp: 'StephaneDucasse 1/27/2011 22:22'! filesystem: aFilesystem path: aPath creation: cTime modification: mTime isDir: aBoolean size: anInteger "Create a directory entry given a filesystem and a path in such filesystem. In addition, the creation and modification time are required as well as a boolean that indicates whether the entry is a folder or a file and its size." ^ self reference: (aFilesystem referenceTo: aPath) creation: cTime modification: mTime isDir: aBoolean size: anInteger! ! !FSDirectoryEntry classSide methodsFor: 'instance creation' stamp: 'StephaneDucasse 1/27/2011 22:19'! reference: ref creation: cTime modification: mTime isDir: aBoolean size: anInteger "Create a directory entry for the file reference ref, with the creation time, cTime, the modification time, mTime. aBoolean indicates if the entry represents a directory or a file of size given by anInteger" ^ self basicNew initializeWithRef: ref creation: cTime modification: mTime isDir: aBoolean size: anInteger! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 17:59'! basename ^ reference basename! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:14'! creation "Return the creation date and time of the entry receiver." ^ DateAndTime fromSeconds: creation! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:16'! creationSeconds "Return the creation date and time of the entry receiver in seconds." ^ creation! ! !FSDirectoryEntry methodsFor: 'initialize-release' stamp: 'cwp 11/15/2009 21:52'! initializeWithRef: ref creation: cTime modification: mTime isDir: bool size: bytes reference := ref. creation := cTime. modification := mTime. isDirectory := bool. size := bytes! ! !FSDirectoryEntry methodsFor: 'testing' stamp: 'StephaneDucasse 1/27/2011 22:16'! isDirectory "Return whether the receiver is a directory" ^ isDirectory! ! !FSDirectoryEntry methodsFor: 'testing' stamp: 'StephaneDucasse 1/27/2011 22:16'! isFile "Return whether the receiver is a file" ^ isDirectory not! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:15'! modification "Return the modification date and time of the entry receiver." ^ DateAndTime fromSeconds: modification! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:15'! modificationSeconds "Return the modification date and time of the entry receiver in seconds." ^ modification! ! !FSDirectoryEntry methodsFor: 'printing' stamp: 'sd 2/11/2011 19:40'! printOn: aStream aStream nextPutAll: 'DirectoryEntry: '. reference ifNotNilDo: [:ref | aStream nextPutAll: reference printString].! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/15/2009 21:54'! reference ^ reference! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:15'! size "Returns the receiver size" ^ size! ! Object subclass: #FSFilesystem instanceVariableNames: 'workingDirectory store' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Public'! !FSFilesystem commentStamp: 'cwp 3/25/2011 13:26' prior: 0! I present a low-level protocol for interacting with filesystems. I hold a reference to a store (a subinstance of FSStore) which takes care of the details of performing file and directory operations on the filesystem I represent. I keep track of the current directory, and am responsible for resolving all paths that I pass into my store.! !FSFilesystem classSide methodsFor: 'initializing' stamp: 'cwp 4/4/2011 19:08'! startUp: aBoolean "This is only here to deal with migration from older versions of FSFilesystem that wanted to receive startup notifcations." Smalltalk removeFromStartUpList: self! ! !FSFilesystem classSide methodsFor: 'instance creation' stamp: 'cwp 2/18/2011 20:34'! store: aStore ^ self basicNew initializeWithStore: aStore; yourself! ! !FSFilesystem methodsFor: 'navigating' stamp: 'cwp 3/25/2011 13:04'! / anObject "Return the absolute reference obtained by resolving anObject against the root of this filesystem." ^ self root / anObject! ! !FSFilesystem methodsFor: 'comparing' stamp: 'cwp 2/18/2011 16:08'! = other ^ self species = other species and: [self store = other store]! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 3/25/2011 13:14'! basicOpen: aResolvable writable: aBoolean | path | path := self resolve: aResolvable. ^ store basicOpen: path writable: aBoolean! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 3/29/2011 15:58'! changeDirectory: aPath self workingDirectoryPath: (self resolve: aPath)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 4/3/2011 22:16'! childrenAt: aResolvable | path | path := self resolve: aResolvable. ^ Array streamContents: [ :out | store directoryAt: path ifAbsent: [ store signalDirectoryDoesNotExist: path ] nodesDo: [ :entry | out nextPut: path / (store basenameFromEntry: entry) ] ]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 2/19/2011 01:39'! close store close! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:39'! copy: sourcePath ifAbsent: aBlock to: destPath ifPresent: pBlock "Copy the file referenced as sourcePath to the destination referred as destPath. Perform associate actions in case of problems." | source destination | source := self resolve: sourcePath. destination := self resolve: destPath. store basicCopy: source ifAbsent: aBlock to: destination ifPresent: pBlock filesystem: self! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 4/3/2011 22:17'! copy: sourcePath to: destPath "Copy the file referenced as sourcePath to the destination referred as destPath. If there is no file at sourcePath, raise FileDoesNotExist. If destPath is a file, raise FileExists." self copy: sourcePath ifAbsent: [ store signalFileDoesNotExist: sourcePath ] to: destPath ifPresent: [ store signalFileExists: destPath ]! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 4/3/2011 22:17'! copy: aPath toReference: destRef | in path | path := self resolve: aPath. [in := self readStreamOn: path. in ifNil: [ store signalFileDoesNotExist: path ]. destRef filesystem copyFrom: in to: destRef path ] ensure: [ in ifNotNil: [ in close ] ]! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 4/3/2011 22:17'! copyFrom: in to: destPath | buffer out | out := nil. (self exists: destPath) ifTrue: [ store signalFileExists: destPath ]. ^ [ out := self writeStreamOn: destPath. buffer := ByteArray new: 1024. [ in atEnd ] whileFalse: [ buffer := in nextInto: buffer. out nextPutAll: buffer ] ] ensure: [ out ifNotNil: [ out close ] ]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:15'! createDirectory: aResolvable "Resolve aResolvable into an absolute path, then as the store to create a directory there. The store is expected to raise an exception if it cannot do so." ^ store createDirectory: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:14'! delete: aResolvable store delete: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:14'! delimiter "Return path delimiter used by this filesystem." ^ store delimiter! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:16'! ensureDirectory: aResolvable "Resolve the argument to an absolute path, then ask the store to make sure that all the directories contained in the argument path exist or are created." store ensureDirectory: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 4/3/2011 22:16'! entriesAt: aResolvable | path entry aFilesystem | path := self resolve: aResolvable. aFilesystem := self. ^ Array streamContents: [ :out | store directoryAt: path ifAbsent: [ store signalDirectoryDoesNotExist: path ] nodesDo: [ :node | entry := store entryFromNode: node path: path for: aFilesystem. out nextPut: entry ] ]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 4/3/2011 22:17'! entryAt: aResolvable | path | path := self resolve: aResolvable. ^ store nodeAt: path ifPresent: [ :node | store entryFromNode: node filesystem: self path: path ] ifAbsent: [ store signalFileDoesNotExist: path ]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:19'! exists: aResolvable "Resolve the argument, and answer true if the there is a file or directory at that path, false if there is not." ^ store exists: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'printing' stamp: 'cwp 2/18/2011 16:34'! forReferencePrintOn: aStream store forReferencePrintOn: aStream! ! !FSFilesystem methodsFor: 'comparing' stamp: 'cwp 2/18/2011 16:08'! hash ^ store hash! ! !FSFilesystem methodsFor: 'initialize-release' stamp: 'cwp 2/18/2011 20:33'! initializeWithStore: aStore store := aStore. workingDirectory := store defaultWorkingDirectory! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:21'! isDirectory: aResolvable "Resolve the argument, and answer true if the result refers to a directory, false if it refers to a file or doesn't exist." ^ store isDirectory: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:23'! isFile: aResolvable "Resolve the argument, and answer true if the result refers to a file, false if it refers to a directory or doesn't exist." | path | path := self resolve: aResolvable. ^ store isFile: path! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:23'! open "Some kinds of filesystems need to open connections to external resources. Does nothing by default." store open! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:22'! open: aResolvable writable: aBoolean "Resolve aResolvable into an absolute path, then ask the store to open the file at that path using the specified access mode." | path | path := self resolve: aResolvable. ^ store handleClass open: (FSReference filesystem: self path: path) writable: aBoolean ! ! !FSFilesystem methodsFor: 'delegated' stamp: 'cwp 3/25/2011 13:16'! openFileStream: aResolvable writable: aBoolean ^ store openFileStream: (self resolve: aResolvable) writable: aBoolean! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:30'! pathFromObject: anObject ^ anObject asPathWith: self! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 2/18/2011 16:39'! pathFromString: aString ^ store pathFromString: aString! ! !FSFilesystem methodsFor: 'printing' stamp: 'cwp 2/28/2011 12:29'! printPath: aPath on: aStream store printPath: aPath on: aStream! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:42'! readStreamOn: aResolvable "Resolve the argument into an absolute path and open a file handle on the file at that path. Ask the handle to give us a read stream for reading the file." ^ (self open: aResolvable writable: false) readStream.! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:44'! referenceTo: aResolvable "Answer a reference to the argument from the context of the receiver filesystem. Example: FSFilesystem onDisk referenceTo: 'plonk.taz'" ^ FSReference filesystem: self path: (self pathFromObject: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 4/3/2011 22:17'! rename: sourcePath as: destName "Rename the file referenced as sourcePath to destPath. Raise exceptions FileExists or FileDoesNotExist if the operation fails" ^ self rename: sourcePath ifAbsent: [store signalFileDoesNotExist: sourcePath] as: destName ifPresent: [self signalFileExists: destName]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:53'! rename: sourcePath ifAbsent: aBlock as: destPath ifPresent: pBlock "Rename the file referenced as sourcePath to the destination referred as destPath. Perform associate actions in case of problems." | source destination | source := self resolve: sourcePath. destination := self resolve: destPath. self basicRename: source ifAbsent: aBlock as: destination ifPresent: pBlock! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:54'! resolve: aResolvable ^ aResolvable asResolvedBy: self! ! !FSFilesystem methodsFor: 'navigating' stamp: 'cwp 3/29/2011 15:54'! resolvePath: aPath "Return a path where the argument is resolved in the context of the receiver. The behavior is similar to the one of a command line. > cd /a/b/c > cd b The shell will attempt to make /a/b/c/b the current directory. " ^ workingDirectory resolve: aPath! ! !FSFilesystem methodsFor: 'navigating' stamp: 'cwp 10/10/2009 17:32'! resolveReference: aReference ^ aReference filesystem = self ifTrue: [workingDirectory resolvePath: aReference path]! ! !FSFilesystem methodsFor: 'navigating' stamp: 'cwp 3/29/2011 15:56'! resolveString: aString "Returns the root of the receiver filesystem, i.e. / on unix" ^ workingDirectory resolvePath: (store pathFromString: aString)! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 9/20/2009 22:27'! root ^ self referenceTo: FSPath root! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 2/18/2011 16:08'! store ^ store! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 2/18/2011 12:09'! stringFromPath: aPath ^ store stringFromPath: aPath! ! !FSFilesystem methodsFor: 'accessing' stamp: 'lr 2/14/2010 09:48'! working ^ self referenceTo: self workingDirectory! ! !FSFilesystem methodsFor: 'accessing' stamp: 'sd 2/11/2011 18:23'! workingDirectory "Returns a reference to the directory from where the image was launched" ^ self referenceTo: self workingDirectoryPath! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 3/29/2011 15:57'! workingDirectoryPath ^ workingDirectory! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 3/29/2011 15:58'! workingDirectoryPath: aPath aPath isAbsolute ifFalse: [self error: 'Cannot set the working directory to a relative path']. workingDirectory := aPath ! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 16:01'! writeStreamOn: aResolvable "Open a write stream on the file referred by the argument. It can be a string or a path" ^ (self open: aResolvable writable: true) writeStream.! ! Object subclass: #FSGuide instanceVariableNames: 'visitor work' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Enumeration'! !FSGuide commentStamp: 'cwp 11/18/2009 12:09' prior: 0! I am an abstract superclass for objects that fulfill the Guide role in the Guide/Visitor pattern. My subclasses know how to traverse a filesystem in a specific order, "showing" the files and directories they encounter to a visitor. visitor An object that fulfills the Visitor role and implements the visitor protocol. work An OrderedCollection, used to keep track of filesystem nodes that have not yet been visited! FSGuide subclass: #FSBreadthFirstGuide instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Enumeration'! !FSBreadthFirstGuide commentStamp: 'cwp 11/18/2009 12:13' prior: 0! I traverse the filesystem in breadth-first order. Given this hierarchy: alpha beta gamma delta epsilon I would visit the nodes in the following order: alpha, delta, beta, gamma, epsilon. I use my work instance variable as a queue, adding nodes to be visited to the end and retrieving them from the beginning. ! !FSBreadthFirstGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 10:42'! show: aReference | entry | work add: aReference entry. self whileNotDoneDo: [entry := work removeFirst. entry isFile ifTrue: [ visitor visitFile: entry] ifFalse: [visitor visitDirectory: entry. work addAll: entry reference entries]]! ! !FSGuide classSide methodsFor: 'instance creation' stamp: 'cwp 10/29/2009 19:27'! for: aVisitor ^ self basicNew initializeWithVisitor: aVisitor! ! !FSGuide classSide methodsFor: 'instance creation' stamp: 'cwp 11/17/2009 11:58'! show: aReference to: aVisitor ^ (self for: aVisitor) show: aReference! ! !FSGuide methodsFor: 'initialize-release' stamp: 'StephaneDucasse 1/27/2011 10:37'! initialize super initialize. work := OrderedCollection new! ! !FSGuide methodsFor: 'initialize-release' stamp: 'cwp 10/29/2009 23:48'! initializeWithVisitor: aVisitor self initialize. visitor := aVisitor. ! ! !FSGuide methodsFor: 'showing' stamp: 'cwp 10/29/2009 23:21'! show: aReference self subclassResponsibility! ! !FSGuide methodsFor: 'showing' stamp: 'lr 7/13/2010 15:36'! whileNotDoneDo: aBlock [ work isEmpty ] whileFalse: [ aBlock value ]! ! FSGuide subclass: #FSPostorderGuide instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Enumeration'! !FSPostorderGuide commentStamp: 'cwp 11/18/2009 12:16' prior: 0! I traverse the filesystem in depth-first post order. Given this hierarchy: alpha beta gamma delta epsilon I would visit the nodes in the following order: beta, gamma, alpha, epsilon, delta. I use my work instance variable as a stack. I push messages that cause nodes to be traversed or visited, and execute them in reverse order.! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 10/29/2009 23:51'! pop ^ work removeLast! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/14/2009 22:41'! pushTraverse: aReference work add: (Message selector: #traverse: argument: aReference)! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/14/2009 22:42'! pushVisit: aReference work add: (Message selector: #visit: argument: aReference)! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 10:50'! show: aReference self pushTraverse: aReference entry. self whileNotDoneDo: [self pop sendTo: self ]! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 21:57'! traverse: anEntry self pushVisit: anEntry. anEntry isDirectory ifTrue: [anEntry reference entries reverseDo: [:ea | self pushTraverse: ea]]! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 10:50'! visit: anEntry anEntry isDirectory ifTrue: [visitor visitDirectory: anEntry] ifFalse: [visitor visitFile: anEntry] ! ! FSGuide subclass: #FSPreorderGuide instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Enumeration'! !FSPreorderGuide commentStamp: 'cwp 11/18/2009 12:18' prior: 0! I traverse the filesystem in depth-first pre order. Given this hierarchy: alpha beta gamma delta epsilon I would visit the nodes in the following order: alpha, beta, gamma, delta, epsilon. I use my work instance variable as a stack. I push nodes to be visited and visit them in reverse order.! !FSPreorderGuide methodsFor: 'showing' stamp: 'cwp 10/29/2009 23:51'! pop ^ work removeLast! ! !FSPreorderGuide methodsFor: 'showing' stamp: 'cwp 11/15/2009 22:24'! push: anObject work add: anObject! ! !FSPreorderGuide methodsFor: 'showing' stamp: 'cwp 10/29/2009 23:51'! pushAll: aCollection aCollection reverseDo: [ :ea | work add: ea ]! ! !FSPreorderGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 10:47'! show: aReference self push: aReference entry. self whileNotDoneDo: [| entry | entry := self pop. entry isFile ifTrue: [visitor visitFile: entry] ifFalse: [visitor visitDirectory: entry. self pushAll: entry reference entries]]! ! Object subclass: #FSHandle instanceVariableNames: 'reference writable' classVariableNames: 'Primitives' poolDictionaries: '' category: 'FS-Core-Kernel'! !FSHandle commentStamp: 'cwp 11/18/2009 11:11' prior: 0! I am an abstract superclass for file handle implementations. I provide a uniform interface that streams can use for read and write operations on a file regardless of the filesystem. I encapsulate the actual IO primitives.! !FSHandle classSide methodsFor: 'instance creation' stamp: 'cwp 7/26/2009 12:52'! on: aReference writable: aBoolean ^ self new setReference: aReference writable: aBoolean! ! !FSHandle classSide methodsFor: 'instance creation' stamp: 'cwp 7/26/2009 12:52'! open: aReference writable: aBoolean ^ (self on: aReference writable: aBoolean) open! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/29/2009 22:19'! at: index | buffer | buffer := ByteArray new: 1. self at: index read: buffer startingAt: 1 count: 1. ^ buffer at: 1! ! !FSHandle methodsFor: 'public' stamp: 'lr 4/13/2010 16:10'! at: index put: anObject | buffer | buffer := ByteArray with: (anObject isCharacter ifTrue: [ anObject codePoint ] ifFalse: [ anObject ]). self at: index write: buffer startingAt: 1 count: 1. ! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! at: offset read: buffer startingAt: start count: count self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! at: offset write: buffer startingAt: start count: count self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! close self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! flush self subclassResponsibility! ! !FSHandle methodsFor: 'testing' stamp: 'cwp 7/26/2009 12:50'! isOpen self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! open self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/31/2009 00:32'! readStream ^ self isOpen ifTrue: [FSReadStream onHandle: self]! ! !FSHandle methodsFor: 'accessing' stamp: 'cwp 7/26/2009 12:51'! reference ^ reference! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:51'! reopen self close. self open! ! !FSHandle methodsFor: 'initialize-release' stamp: 'cwp 11/20/2009 14:56'! setReference: aReference writable: aBoolean reference := aReference resolve. writable := aBoolean! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! truncateTo: anInteger self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/28/2009 23:06'! writeStream ^ FSWriteStream onHandle: self! ! Object subclass: #FSLocator instanceVariableNames: 'origin path' classVariableNames: 'Resolver' poolDictionaries: '' category: 'FS-Core-Public'! !FSLocator commentStamp: 'cwp 4/4/2011 18:43' prior: 0! "I am a late-bound reference. I refer to a file or directory in relation to a well-known location on the filesystem, called an origin. When asked to perform concrete operation, I look up the current location of my origin, and resolve my path against it. Usage ---------- FSLocator desktop. FSLocator desktop basename. FSLocator home basename. FSLocator image. FSLocator vmBinary asAbsolute pathString > '/Applications/Squeak' FSLocator vmBinary pathString > '/Applications/Squeak' FSLocator vmDirectory parent pathString > '/Applications' Implementation ------------------------ origin A symbolic name for base reference I use to resolve myself. path A relative path that is resolved against my origin" ! !FSLocator classSide methodsFor: 'class initialization' stamp: 'cwp 10/26/2009 20:54'! addResolver: aResolver Resolver addResolver: aResolver! ! !FSLocator classSide methodsFor: 'origins' stamp: 'lr 7/13/2010 13:29'! changes ^ self origin: #changes ! ! !FSLocator classSide methodsFor: 'origins' stamp: 'cwp 10/27/2009 10:24'! desktop ^ self origin: #desktop! ! !FSLocator classSide methodsFor: 'class initialization' stamp: 'cwp 10/27/2009 10:28'! flushCaches Resolver flushCaches! ! !FSLocator classSide methodsFor: 'origins' stamp: 'cwp 10/27/2009 09:34'! home ^ self origin: #home! ! !FSLocator classSide methodsFor: 'origins' stamp: 'cwp 10/25/2009 09:54'! image ^ self origin: #image ! ! !FSLocator classSide methodsFor: 'origins' stamp: 'lr 7/13/2010 13:35'! imageDirectory ^ self origin: #imageDirectory ! ! !FSLocator classSide methodsFor: 'class initialization' stamp: 'cwp 11/20/2009 15:01'! initialize Smalltalk addToStartUpList: self. self startUp: true! ! !FSLocator classSide methodsFor: 'instance creation' stamp: 'cwp 2/26/2011 18:22'! origin: aSymbol ^ self origin: aSymbol path: FSPath workingDirectory! ! !FSLocator classSide methodsFor: 'instance creation' stamp: 'cwp 10/25/2009 09:56'! origin: aSymbol path: aPath ^ self basicNew initializeWithOrigin: aSymbol path: aPath! ! !FSLocator classSide methodsFor: 'class initialization' stamp: 'lr 7/13/2010 15:19'! startUp: resuming resuming ifFalse: [ ^ self ]. Resolver := FSInteractiveResolver new. Resolver addResolver: FSSystemResolver new. Resolver addResolver: FSPlatformResolver forCurrentPlatform! ! !FSLocator classSide methodsFor: 'accessing' stamp: 'cwp 10/27/2009 11:25'! supportedOrigins | origins current | origins := IdentitySet new. current := Resolver. [current notNil] whileTrue: [origins addAll: current supportedOrigins. current := current next]. ^ origins! ! !FSLocator classSide methodsFor: 'origins' stamp: 'cwp 10/26/2009 11:37'! vmBinary ^ self origin: #vmBinary! ! !FSLocator classSide methodsFor: 'origins' stamp: 'cwp 10/26/2009 13:49'! vmDirectory ^ self origin: #vmDirectory! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 11:12'! , extension ^ self withPath: path, extension! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 11:03'! / aString ^ self withPath: (path / aString)! ! !FSLocator methodsFor: 'comparing' stamp: 'cwp 10/26/2009 10:28'! = other ^ self species = other species and: [origin = other origin and: [path = other path]]! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/15/2009 21:23'! allChildren ^ self resolve allChildren! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/16/2009 21:19'! allEntries ^ self resolve allEntries! ! !FSLocator methodsFor: 'converting' stamp: 'cwp 10/25/2009 10:30'! asAbsolute ^ self ! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:09'! asPathWith: anObject ^ self resolve asPathWith: anObject! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/25/2009 11:09'! basename ^ self resolve basename! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/15/2009 21:24'! children ^ self resolve children! ! !FSLocator methodsFor: 'comparing' stamp: 'cwp 10/25/2009 22:26'! contains: anObject ^ self resolve contains: anObject! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/15/2009 08:10'! copyAllTo: aReference ^ self resolve copyAllTo: aReference! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:02'! copyTo: aReference ^ self resolve copyTo: aReference resolve! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:03'! delete ^ self resolve delete! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/15/2009 08:11'! deleteAll ^ self resolve deleteAll! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:03'! ensureDirectory ^ self resolve ensureDirectory! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:03'! exists ^ self resolve exists! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:04'! fileStreamDo: aBlock ^ self resolve fileStreamDo: aBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/25/2009 22:12'! filesystem ^ self resolve filesystem! ! !FSLocator methodsFor: 'delegated' stamp: 'sd 2/11/2011 20:36'! fullName ^ self resolve fullName! ! !FSLocator methodsFor: 'comparing' stamp: 'cwp 10/25/2009 11:05'! hash ^ origin hash bitXor: path hash! ! !FSLocator methodsFor: 'initialize-release' stamp: 'cwp 10/25/2009 09:56'! initializeWithOrigin: aSymbol path: aPath self initialize. origin := aSymbol. path := aPath.! ! !FSLocator methodsFor: 'testing' stamp: 'cwp 10/25/2009 10:30'! isAbsolute ^ true! ! !FSLocator methodsFor: 'comparing' stamp: 'cwp 11/16/2009 09:07'! isChildOf: anObject ^ self resolve isChildOf: anObject! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/25/2009 23:05'! isContainedBy: anObject ^ self resolve isContainedBy: anObject! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:04'! isDirectory ^ self resolve isDirectory! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:04'! isFile ^ self resolve isFile! ! !FSLocator methodsFor: 'testing' stamp: 'cwp 10/25/2009 11:15'! isRelative ^ false! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/25/2009 11:22'! isRoot ^ self resolve isRoot! ! !FSLocator methodsFor: 'accessing' stamp: 'cwp 10/25/2009 21:31'! origin ^ origin! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 11:27'! parent ^ self withPath: path parent! ! !FSLocator methodsFor: 'accessing' stamp: 'cwp 10/25/2009 21:31'! path ^ path! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:05'! pathString ^ self resolve pathString! ! !FSLocator methodsFor: 'printing' stamp: 'lr 7/13/2010 15:19'! printOn: aStream | fs | aStream nextPut: ${; nextPutAll: origin; nextPut: $}. path isWorkingDirectory ifTrue: [ ^ self ]. fs := self filesystem. aStream nextPut: fs delimiter. fs printPath: path on: aStream! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:05'! readStream ^ self resolve readStream! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:05'! readStreamDo: aBlock ^ self resolve readStreamDo: aBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/29/2009 11:23'! readStreamDo: doBlock ifAbsent: aBlock ^ self resolve readStreamDo: doBlock ifAbsent: aBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/29/2009 11:24'! readStreamIfAbsent: aBlock ^ self resolve readStream readStreamIfAbsent: aBlock! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 09:59'! resolve ^ (Resolver resolve: origin) resolve: path! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/26/2009 01:03'! resolve: anObject ^ anObject asResolvedBy: self! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 21:36'! resolvePath: aPath ^ self withPath: (path resolvePath: aPath)! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 21:53'! resolveReference: aReference ^ aReference isAbsolute ifTrue: [aReference] ifFalse: [self withPath: aReference path]! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 11/21/2009 11:30'! resolveString: aString | filesystem thePath | filesystem := (Resolver resolve: origin) filesystem. thePath := filesystem pathFromString: aString. ^ self withPath: (path resolvePath: thePath)! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 11/18/2009 00:01'! withExtension: aString ^ self withPath: (path withExtension: aString)! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 11:03'! withPath: newPath ^ path == newPath ifTrue: [self] ifFalse: [self class origin: origin path: newPath]! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:05'! writeStream ^ self resolve writeStream! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:06'! writeStreamDo: aBlock ^ self resolve writeStreamDo: aBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/29/2009 11:24'! writeStreamDo: doBlock ifPresent: pBlock ^ self resolve writeStreamDo: doBlock ifPresent: pBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/29/2009 11:23'! writeStreamIfPresent: aBlock ^ self resolve writeStreamIfPresent: aBlock! ! Object variableSubclass: #FSPath instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Kernel'! !FSPath commentStamp: 'cwp 3/29/2011 16:16' prior: 0! I'm a private and abstract filesystem path, independent of the string representation used to describe paths on a specific filesystem. I provide methods for navigating the filesystem hierarchy and working with absolute and relative paths. I only refer to a concrete file or directory with regard to a specific filesystem. Normally users should not use me directly. Path independent representation of delimiter is defined by FSDiskFilesystem current delimiter. API instance creation: #* and #/ are mnemonic to . and / whose arguments should be string file- or directory names, not fragments of Unix path notation intended to be parsed. #/ and #* provide a mini-DSL for building up paths, while #readFrom:delimiter: parses path strings. Note that (FSPath with: 'parent/child/') isRelative returns true because it creates to a relative path to a file/directory called 'parent/child'. In bash you'd escape the slashes like this: parent\/child\/ similarly (FSPath with: '/parent/child/') isRelative returns true That's a relative path to '/parent/child'. In bash: /\parent\/child\/ (FSPath with: '') isRelative returns false Because this is an absolute path to the root of the file system. Absolute paths have an empty first element. If you consider $/ the separator, '/usr/local/bin' has an empty first element. ! FSPath variableSubclass: #FSAbsolutePath instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Kernel'! !FSAbsolutePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 10:58'! isAbsolute ^ true! ! !FSAbsolutePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 11:03'! isRoot ^ self size = 0! ! !FSAbsolutePath methodsFor: 'printing' stamp: 'cwp 2/27/2011 09:25'! printOn: aStream aStream nextPutAll: 'FSPath'. self isRoot ifTrue: [aStream nextPutAll: ' root'] ifFalse: [1 to: self size do: [:i | aStream nextPutAll: ' / '''; nextPutAll: (self at: i); nextPut: $']]! ! !FSAbsolutePath methodsFor: 'enumerating' stamp: 'cwp 3/29/2011 16:44'! withParents ^ super withParents addFirst: (FSPath root); yourself! ! !FSPath classSide methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 20:36'! * aString "Answer a relative path with aString as its sole segment. For example, FSPath * 'griffle' will produce the same result as ./griffle in a unix shell. The selector #* was chosen for it's visual similarity to $." "Note: aString is not parsed, so supplying a string like '/griffle/plonk' will not create an absolute path." ^ FSRelativePath with: aString! ! !FSPath classSide methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 20:51'! / aString "Answer an absolute path with aString as it's sole segment. The selector was chosen to allow path construction with Smalltalk syntax, which neverthelesss resembles paths as they appear in a unix shell. Eg. FSPath / 'griffle' / 'plonk'." ^ FSAbsolutePath with: aString! ! !FSPath classSide methodsFor: 'private' stamp: 'cwp 10/26/2009 13:42'! addElement: element to: result element = '..' ifTrue: [^ self addParentElementTo: result]. element = '' ifTrue: [^ self addEmptyElementTo: result]. element = '.' ifFalse: [result add: element]! ! !FSPath classSide methodsFor: 'private' stamp: 'cwp 10/26/2009 13:41'! addEmptyElementTo: result result isEmpty ifTrue: [result add: ''] ! ! !FSPath classSide methodsFor: 'private' stamp: 'cwp 10/26/2009 13:39'! addParentElementTo: result result isEmpty ifTrue: [result add: '..'] ifFalse: [result removeLast] ! ! !FSPath classSide methodsFor: 'private' stamp: 'cwp 10/26/2009 13:30'! canonicalizeElements: aCollection | result | result := OrderedCollection new. aCollection do: [:element | self addElement: element to: result]. ^ result! ! !FSPath classSide methodsFor: 'encodings' stamp: 'StephaneDucasse 2/18/2011 22:31'! extensionDelimiter "Return the extension delimiter character." ^ $.! ! !FSPath classSide methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 21:01'! parent "Answer a path that resolves to the parent of the current working directory. This is similar to .. in unix, but doesn't rely on actual hardlinks being present in the filesystem." ^ FSRelativePath with: '..'! ! !FSPath classSide methodsFor: 'instance creation' stamp: 'cwp 11/15/2009 00:11'! parents: anInteger | path | path := self new: anInteger. 1 to: anInteger do: [:i | path at: i put: '..']. ^ path! ! !FSPath classSide methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 21:04'! readFrom: aStream delimiter: aCharacter "Answer a path composed of several elements delimited by aCharacter" | elements out ch | elements := OrderedCollection new. out := (String new: 10) writeStream. [ aStream atEnd ] whileFalse: [ ch := aStream next. ch = aCharacter ifFalse: [ out nextPut: ch ] ifTrue: [ elements add: out contents. out := (String new: 10) writeStream ] ]. elements add: out contents. ^ self withAll: (self canonicalizeElements: elements)! ! !FSPath classSide methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 21:04'! root "Answer the root path - ie, / on unix" ^ FSAbsolutePath new! ! !FSPath classSide methodsFor: 'private' stamp: 'cwp 3/25/2011 21:45'! with: aString "Answer a relative path of the given string. N.B. that the argument is not parsed; it is the name of a single path element, and path separators in it do not have special meaning." "(FSPath with: '/parent/child/') isRelative answers true because this is a relative path to a file or directory named '/parent/child/'. In bash: \/parent\/child\/" | inst | inst := self new: 1. inst at: 1 put: aString. ^ inst! ! !FSPath classSide methodsFor: 'private' stamp: 'cwp 12/13/2008 13:33'! withAll: aCollection | inst | inst := self new: aCollection size. aCollection withIndexDo: [:segment :index | inst at: index put: segment]. ^ inst! ! !FSPath classSide methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 20:57'! workingDirectory "Answer a path that will always resolve to the current working directory." ^ FSRelativePath new! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/17/2009 23:52'! , extension ^ self withName: self basename extension: extension! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 12/13/2008 21:11'! / aString | path | path := self class new: self size + 1. path copyFrom: self. path at: path size put: aString. ^ path! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 12/14/2008 17:36'! = other ^ self species = other species and: [self size = other size and: [(1 to: self size) allSatisfy: [:i | (self at: i) = (other at: i)]]]! ! !FSPath methodsFor: 'converting' stamp: 'cwp 10/10/2009 18:04'! asPathWith: anObject ^ self! ! !FSPath methodsFor: 'converting' stamp: 'cwp 2/19/2011 15:09'! asReference ^ FSFilesystem onDisk referenceTo: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 9/22/2009 09:08'! asResolvedBy: anObject ^ anObject resolvePath: self! ! !FSPath methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 18:06'! base "Returns the base of the basename, i.e. /foo/gloops.taz basename is 'gloops'" ^ self basename copyUpTo: self extensionDelimiter! ! !FSPath methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 18:03'! basename "Returns the base of the basename, i.e. /foo/gloops.taz basename is 'gloops.taz'" ^ self at: self size! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 10/26/2009 01:03'! contains: anObject ^ anObject isContainedBy: self! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 10/25/2009 22:59'! containsPath: aPath self size < aPath size ifFalse: [^ false]. 1 to: self size do: [:i | (self at: i) = (aPath at: i) ifFalse: [^ false]]. ^ true! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 10/25/2009 23:05'! containsReference: aReference ^ false! ! !FSPath methodsFor: 'private' stamp: 'cwp 12/13/2008 21:08'! copyFrom: aPath | size | size := aPath size min: self size. 1 to: size do: [:i | self at: i put: (aPath at: i)]. ! ! !FSPath methodsFor: 'accessing' stamp: 'cwp 10/11/2009 11:05'! delimiter ^ $/! ! !FSPath methodsFor: 'enumerating' stamp: 'cwp 7/18/2009 01:13'! do: aBlock 1 to: self size do: [ :index || segment | segment := self at: index. segment isEmpty ifFalse: [ aBlock value: segment ] ]! ! !FSPath methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 18:04'! extension "Return the extension of path basename i.e., /foo/gloops.taz extension is 'taz'" ^ self basename copyAfter: self extensionDelimiter! ! !FSPath methodsFor: 'accessing' stamp: 'cwp 12/23/2008 11:25'! extensionDelimiter ^ self class extensionDelimiter! ! !FSPath methodsFor: 'accessing' stamp: 'sd 2/11/2011 21:02'! fullName "Return the fullName of the receiver." ^ self printString! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 12/14/2008 17:06'! hash | hash | hash := self class identityHash. 1 to: self size do: [:i | hash := String stringHash: (self at: i) initialHash: hash]. ^ hash! ! !FSPath methodsFor: 'testing' stamp: 'cwp 2/26/2011 10:58'! isAbsolute self subclassResponsibility ! ! !FSPath methodsFor: 'private' stamp: 'cwp 10/25/2009 19:53'! isAllParents 1 to: self size do: [:i | (self at: i) = '..' ifFalse: [^ false]]. ^ true! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 11/16/2009 09:06'! isChildOf: anObject ^ self parent = anObject! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 10/25/2009 23:01'! isContainedBy: anObject ^ anObject containsPath: self! ! !FSPath methodsFor: 'testing' stamp: 'DamienPollet 2/20/2011 04:00'! isEmpty ^ self size = 0! ! !FSPath methodsFor: 'testing' stamp: 'cwp 12/13/2008 21:00'! isRelative ^ self isAbsolute not! ! !FSPath methodsFor: 'testing' stamp: 'cwp 2/26/2011 11:03'! isRoot self subclassResponsibility ! ! !FSPath methodsFor: 'testing' stamp: 'cwp 7/18/2009 00:42'! isWorkingDirectory ^ self size = 0! ! !FSPath methodsFor: 'private' stamp: 'cwp 11/15/2009 00:19'! lengthOfStemWith: aPath | limit index | limit := self size min: aPath size. index := 1. [index <= limit and: [(self at: index) = (aPath at: index)]] whileTrue: [index := index + 1]. ^ index - 1! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:00'! makeRelative: anObject ^ anObject relativeToPath: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 10/25/2009 19:53'! parent | size parent | self isRoot ifTrue: [^ self]. self isAllParents ifTrue: [^ self / '..']. size := self size - 1. parent := self class new: size. 1 to: size do: [:i | parent at: i put: (self at: i)]. ^ parent! ! !FSPath methodsFor: 'printing' stamp: 'cwp 11/17/2009 10:22'! printOn: aStream self printOn: aStream delimiter: self delimiter. ! ! !FSPath methodsFor: 'printing' stamp: 'cwp 2/26/2011 17:58'! printOn: aStream delimiter: aCharacter (1 to: self size) do: [:index | aStream nextPutAll: (self at: index)] separatedBy: [aStream nextPut: aCharacter]! ! !FSPath methodsFor: 'printing' stamp: 'cwp 1/13/2009 21:27'! printWithDelimiter: aCharacter ^ String streamContents: [:out | self printOn: out delimiter: aCharacter]! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:00'! relativeTo: anObject ^ anObject makeRelative: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:23'! relativeToPath: aPath "Return the receiver as relative to the argument aPath" "(FSPath / 'griffle' / 'plonk' / 'nurp') relativeToPath: (FSPath / 'griffle') returns plonk/nurp" | prefix relative | aPath isRelative ifTrue: [^ aPath]. prefix := self lengthOfStemWith: aPath. relative := FSRelativePath parents: (aPath size - prefix). prefix + 1 to: self size do: [:i | relative := relative / (self at: i)]. ^ relative! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:23'! relativeToReference: aReference ^ self relativeToPath: aReference path! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/16/2009 10:19'! resolve ^ self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:25'! resolve: anObject "Return a path in which the argument has been interpreted in the context of the receiver. Different argument types have different resolution semantics, so we use double dispatch to resolve them correctly." ^ anObject asResolvedBy: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:29'! resolvePath: aPath "Answers an abolute path created by resolving the argument against the receiver. If the argument is abolute answer the argument itself. Otherwise, concatenate the two paths, then process all parent references '..', and create a path with the remaining elements." | elements | aPath isAbsolute ifTrue: [^ aPath]. elements := Array new: self size + aPath size. 1 to: self size do: [:i | elements at: i put: (self at: i)]. 1 to: aPath size do: [:i | elements at: self size + i put: (aPath at: i)]. ^ self class withAll: (self class canonicalizeElements: elements)! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 9/22/2009 09:06'! resolveReference: aReference ^ aReference! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:30'! resolveString: aString "Treat strings as relative paths with a single element." ^ self / aString! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/17/2009 23:51'! withExtension: extension | basename name | basename := self basename. ^ (basename endsWith: extension) ifTrue: [ self ] ifFalse: [name := basename copyUpToLast: self extensionDelimiter. self withName: name extension: extension]! ! !FSPath methodsFor: 'private' stamp: 'cwp 11/17/2009 23:58'! withName: name extension: extension | basename | basename :=String streamContents: [:out | out nextPutAll: name. out nextPut: self extensionDelimiter. out nextPutAll: extension]. ^ self copy at: self size put: basename; yourself! ! !FSPath methodsFor: 'enumerating' stamp: 'cwp 3/29/2011 16:42'! withParents | paths | paths := OrderedCollection new. 1 to: self size -1 do: [ :index | paths add: ((self class new: index) copyFrom: self) ]. paths add: self. ^ paths! ! FSPath variableSubclass: #FSRelativePath instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Kernel'! !FSRelativePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 10:58'! isAbsolute ^ false! ! !FSRelativePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 11:03'! isRoot ^ false! ! !FSRelativePath methodsFor: 'printing' stamp: 'cwp 2/27/2011 09:39'! printOn: aStream aStream nextPutAll: 'FSPath '. self isWorkingDirectory ifTrue: [aStream nextPutAll: 'workingDirectory'] ifFalse: [aStream nextPutAll: '* '''; nextPutAll: (self at: 1); nextPut: $'. 2 to: self size do: [:i | aStream nextPutAll: ' / '''; nextPutAll: (self at: i); nextPut: $']] ! ! !FSRelativePath methodsFor: 'printing' stamp: 'cwp 2/26/2011 18:00'! printOn: aStream delimiter: aCharacter self isWorkingDirectory ifTrue: [aStream nextPut: $.. ^ self]. super printOn: aStream delimiter: aCharacter! ! Object subclass: #FSPublisher instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Release'! !FSPublisher commentStamp: 'StephaneDucasse 2/3/2011 10:15' prior: 0! A dummy class to publish the code in FileSystem on SqueakSource and PharoTaskForces! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:20'! fetchFromColin "self fetchFromColin" Gofer new url: 'http://source.wiresong.ca/mc'; package: 'Filesystem'; fetch! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:27'! fetchFromLukas "self fetchFromLukas" Gofer new url: 'http://source.lukas-renggli.ch/fs'; package: 'Filesystem'; fetch! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:28'! fetchFromPharoTaskForces "self fetchFromPharoTaskForces" Gofer new squeaksource: 'PharoTaskForces'; package: 'Filesystem'; fetch! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:18'! fetchFromSqueaksource "self pushSqueakSource" Gofer new squeaksource: 'fs'; package: 'Filesystem'; fetch! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:17'! pushPharoTaskForces "self pushPharoTaskForces" Gofer new squeaksource: 'PharoTaskForces'; package: 'Filesystem'; push! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:16'! pushSqueakSource "self pushSqueakSource" Gofer new squeaksource: 'fs'; package: 'Filesystem'; push! ! Object subclass: #FSReference instanceVariableNames: 'filesystem path' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Public'! !FSReference commentStamp: 'cwp 3/29/2011 16:51' prior: 0! I combine a filesystem and path, which is sufficient to refer to a concrete file or directory. I provide methods for navigating my filesystem, performing filesystem operations and opening and closing files. I am the primary mechanism for working with files and directories. | working | working := FSFilesystem onDisk workingDirectory. working files | disk | disk := FSFilesystem onDisk. disk root. "a reference to the root directory" disk working. "a reference to the working directory" ! !FSReference classSide methodsFor: 'cross platform' stamp: 'cwp 3/25/2011 22:01'! / aString "Answer a reference to the argument resolved against the root of the current disk filesystem." ^ FSFilesystem onDisk / aString! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! A ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'A:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! B ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'B:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! C ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'C:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! D ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'D:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! E ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'E:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! F ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'F:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! G ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'G:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! H ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'H:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! I ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'I:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! J ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'J:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! K ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'K:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! L ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'L:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! M ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'M:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! N ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'N:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! O ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'O:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! P ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'P:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! Q ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'Q:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! R ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'R:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! S ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'S:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! T ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'T:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! U ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'U:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! V ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'V:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! W ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'W:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! X ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'X:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! Y ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'Y:' ! ! !FSReference classSide methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! Z ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'Z:' ! ! !FSReference classSide methodsFor: 'instance creation' stamp: 'cwp 1/13/2009 21:11'! filesystem: aFilesystem path: aPath ^ self new setFilesystem: aFilesystem path: aPath! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 7/20/2009 09:20'! , aString ^ self navigateWith: [path, aString]! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 7/20/2009 09:36'! / anObject ^ self navigateWith: [path / anObject]! ! !FSReference methodsFor: 'comparing' stamp: 'MaxLeske 7/30/2010 17:28'! <= other ^ path asString <= other path asString! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 7/20/2009 09:22'! = other ^ self species = other species and: [self path = other path and: [self filesystem = other filesystem]]! ! !FSReference methodsFor: 'enumerating' stamp: 'sd 2/11/2011 19:26'! allChildren "Return all the files and folders recursively nested in the receiver" ^ FSCollectVisitor breadthFirst: self collect: [:ea | ea reference]! ! !FSReference methodsFor: 'enumerating' stamp: 'sd 2/11/2011 19:27'! allDirectories "Return all the directories recursively nested in the receiver." ^ self allChildren reject: [:each | each isFile]! ! !FSReference methodsFor: 'enumerating' stamp: 'cwp 11/16/2009 10:40'! allEntries ^ FSCollectVisitor breadthFirst: self! ! !FSReference methodsFor: 'enumerating' stamp: 'sd 2/11/2011 19:27'! allFiles "Return all the files (not directories) recursively nested in the receiver." ^ self allChildren select: [:each | each isFile]! ! !FSReference methodsFor: 'converting' stamp: 'StephaneDucasse 2/3/2011 08:10'! asAbsolute "Return the receiver as an absolute file reference." ^ self isAbsolute ifTrue: [self] ifFalse: [filesystem referenceTo: (filesystem resolve: path)]! ! !FSReference methodsFor: 'converting' stamp: 'cwp 10/10/2009 18:04'! asPathWith: anObject ^ path! ! !FSReference methodsFor: 'converting' stamp: 'cwp 7/20/2009 09:08'! asReference ^ self! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 9/22/2009 09:03'! asResolvedBy: anObject ^ anObject resolveReference: self! ! !FSReference methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 17:57'! base "Returns the base of the basename, i.e. /foo/gloops.taz base is 'gloops'" ^ path base! ! !FSReference methodsFor: 'accessing' stamp: 'StephaneDucasse 2/2/2011 22:48'! basename "Returns the basename, i.e. /foo/gloops.taz basename is 'gloops.taz'" ^ path basename! ! !FSReference methodsFor: 'deprecated' stamp: 'cwp 3/29/2011 16:52'! childDirectories "Return all the directories (as opposed to files) contained in the receiver" self deprecated: 'Use directories'. ^ self directories ! ! !FSReference methodsFor: 'deprecated' stamp: 'sd 2/11/2011 19:53'! childFiles "Return the direct children (files and folders) of the receiver." self deprecated: 'Use files instead'. ^ self files ! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 3/25/2011 22:05'! children "Answer an array containing references to the direct children of this reference." ^ (filesystem childrenAt: path) collect: [:ea | FSReference filesystem: filesystem path: ea]! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 10/26/2009 01:03'! contains: anObject ^ anObject isContainedBy: self! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 10/26/2009 00:54'! containsPath: aPath ^ self path containsPath: aPath! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 10/25/2009 23:02'! containsReference: aReference ^ aReference filesystem = filesystem and: [path contains: aReference path]! ! !FSReference methodsFor: 'operations' stamp: 'cwp 3/29/2011 16:53'! copyAllTo: aResolvable FSCopyVisitor copy: self asAbsolute to: aResolvable resolve! ! !FSReference methodsFor: 'operations' stamp: 'cwp 2/18/2011 14:06'! copyTo: aReference self isDirectory ifTrue: [ aReference ensureDirectory ] ifFalse: [ filesystem = aReference filesystem ifTrue: [ filesystem copy: path to: aReference path ] ifFalse: [ filesystem copy: path toReference: aReference ] ]! ! !FSReference methodsFor: 'operations' stamp: 'cwp 11/17/2009 21:05'! createDirectory filesystem createDirectory: path! ! !FSReference methodsFor: 'operations' stamp: 'cwp 7/22/2009 07:42'! delete filesystem delete: path! ! !FSReference methodsFor: 'operations' stamp: 'cwp 11/15/2009 00:51'! deleteAll FSDeleteVisitor delete: self! ! !FSReference methodsFor: 'navigating' stamp: 'sd 2/11/2011 19:32'! directories "Return all the directories (by opposition to files) contained in the receiver" ^ self children reject: [:each | each isFile]! ! !FSReference methodsFor: 'operations' stamp: 'sd 2/11/2011 20:16'! ensureDirectory "Create if necessary a directory for the receiver." filesystem ensureDirectory: path ! ! !FSReference methodsFor: 'navigating' stamp: 'sd 2/11/2011 20:14'! entries "Return the entries (meta data - file description) of the direct children of the receiver" ^ filesystem entriesAt: path ! ! !FSReference methodsFor: 'accessing' stamp: 'sd 2/11/2011 19:58'! entry "Return the entry (meta data) describing the receiver." ^ filesystem entryAt: path! ! !FSReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 20:52'! exists ^ filesystem exists: path! ! !FSReference methodsFor: 'accessing' stamp: 'cwp 3/29/2011 16:56'! extension "Returns the extension of the basename, i.e. /foo/gloops.taz extension is 'taz'. Note that compound extensions are returned completely: /foo/gloops.taz.txt extension is 'taz.txt'" ^ path extension! ! !FSReference methodsFor: 'streams' stamp: 'cwp 3/11/2011 23:26'! fileStreamDo: aBlock ^ self fileStreamWritable: true do: aBlock! ! !FSReference methodsFor: 'streams' stamp: 'cwp 3/11/2011 23:27'! fileStreamWritable: aBoolean do: aBlock | stream | stream := filesystem openFileStream: path writable: aBoolean. ^ [ aBlock value: stream ] ensure: [ stream close ] ! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:56'! files "Return all the files (as opposed to folders) contained in the receiver" ^self children select: [:each | each isFile]! ! !FSReference methodsFor: 'accessing' stamp: 'sd 2/11/2011 19:58'! filesystem "Return the filesystem to which the receiver belong." ^ filesystem! ! !FSReference methodsFor: 'accessing' stamp: 'sd 2/11/2011 20:34'! fullName "Return the full path name of the receiver." ^ filesystem stringFromPath: (filesystem resolve: path)! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 9/16/2009 23:54'! hash ^ path hash bitXor: filesystem hash! ! !FSReference methodsFor: 'testing' stamp: 'lr 7/13/2010 15:36'! ifFile: fBlock ifDirectory: dBlock ifAbsent: aBlock ^ self isFile ifTrue: [ fBlock value ] ifFalse: [ self isDirectory ifTrue: [ dBlock value ] ifFalse: [ aBlock value ] ]! ! !FSReference methodsFor: 'testing' stamp: 'cwp 7/20/2009 09:24'! isAbsolute ^ path isAbsolute! ! !FSReference methodsFor: 'testing' stamp: 'cwp 11/16/2009 09:06'! isChildOf: anObject ^ self parent = anObject! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 10/25/2009 23:03'! isContainedBy: anObject ^ anObject containsReference: self! ! !FSReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 21:39'! isDirectory ^ filesystem isDirectory: path! ! !FSReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 21:57'! isFile ^ filesystem isFile: path! ! !FSReference methodsFor: 'testing' stamp: 'cwp 7/20/2009 09:25'! isRelative ^ path isRelative! ! !FSReference methodsFor: 'testing' stamp: 'cwp 7/20/2009 09:26'! isRoot ^ path isRoot! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:26'! makeRelative: anObject ^ anObject relativeToReference: self! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 7/20/2009 09:19'! navigateWith: aBlock | newPath | newPath := aBlock value. ^ path == newPath ifTrue: [self] ifFalse: [filesystem referenceTo: newPath]! ! !FSReference methodsFor: 'private' stamp: 'cwp 7/22/2009 22:05'! openWritable: aBoolean ^ filesystem open: path writable: aBoolean! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 7/20/2009 09:28'! parent ^ self navigateWith: [path parent]! ! !FSReference methodsFor: 'accessing private' stamp: 'sd 2/11/2011 20:00'! path "Return the path internal representation that denotes the receiver in the context of its filesystem. " ^ path! ! !FSReference methodsFor: 'printing' stamp: 'sd 2/11/2011 20:34'! pathString "Return the full path name of the receiver." ^ filesystem stringFromPath: (filesystem resolve: path)! ! !FSReference methodsFor: 'printing' stamp: 'cwp 10/11/2009 22:32'! printOn: aStream filesystem forReferencePrintOn: aStream. filesystem printPath: path on: aStream! ! !FSReference methodsFor: 'streams' stamp: 'cwp 9/22/2009 09:55'! readStream ^ filesystem readStreamOn: path! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:32'! readStreamDo: aBlock | stream | stream := self readStream. ^ [ aBlock value: stream ] ensure: [ stream close ]! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:35'! readStreamDo: doBlock ifAbsent: absentBlock ^ self isFile ifTrue: [ self readStreamDo: doBlock ] ifFalse: [ absentBlock value ]! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:35'! readStreamIfAbsent: absentBlock ^ self isFile ifTrue: [ self readStream ] ifFalse: [ absentBlock value ]! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:59'! relativeTo: landmark "Answer a new path relative to landmark." "parent/child/grandChild relativeTo: parent returns child/grandChild (FSFilesystem onDisk / 'griffle' / 'plonk' / 'nurp') relativeTo: (FSFilesystem onDisk / 'griffle') returns plonk/nurp" ^ landmark makeRelative: self! ! !FSReference methodsFor: 'as yet unclassified' stamp: 'DamienPollet 3/1/2011 19:05'! relativeToPath: landmarkPath ^ path relativeTo: landmarkPath! ! !FSReference methodsFor: 'navigating' stamp: 'DamienPollet 3/1/2011 19:05'! relativeToReference: landmarkReference "Return the path of the receiver relative to landmarkReference." ^ path relativeTo: landmarkReference path! ! !FSReference methodsFor: 'operations' stamp: 'sd 2/11/2011 21:45'! renameAs: aStringOrPath | res | res := self filesystem rename: self as: aStringOrPath. res ifNotNil: [self setFilesystem: filesystem path: (self filesystem resolvePath: aStringOrPath) ]. ^ self ! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 10/26/2009 02:02'! resolve ^ self! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 10/26/2009 01:03'! resolve: anObject ^ anObject asResolvedBy: self! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 9/22/2009 09:03'! resolvePath: anObject ^ self navigateWith: [path resolve: anObject]! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 9/22/2009 09:23'! resolveReference: aReference ^ (filesystem = aReference filesystem or: [aReference isRelative]) ifTrue: [filesystem referenceTo: (path resolvePath: aReference path)] ifFalse: [aReference]! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 11/21/2009 11:30'! resolveString: aString | thePath | thePath := filesystem pathFromString: aString. ^ filesystem referenceTo: (path resolve: thePath)! ! !FSReference methodsFor: 'initialize-release' stamp: 'cwp 1/13/2009 21:12'! setFilesystem: aFilesystem path: aPath filesystem := aFilesystem. path := aPath! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 11/17/2009 23:24'! withExtension: aString ^ self navigateWith: [ path withExtension: aString ]! ! !FSReference methodsFor: 'streams' stamp: 'cwp 7/28/2009 23:01'! writeStream ^ filesystem writeStreamOn: path! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:34'! writeStreamDo: aBlock | stream | stream := self writeStream. ^ [ aBlock value: stream ] ensure: [ stream close ]! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:33'! writeStreamDo: doBlock ifPresent: presentBlock ^ self isFile ifTrue: [ presentBlock value ] ifFalse: [ self writeStreamDo: doBlock ]! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:35'! writeStreamIfPresent: presentBlock ^ self isFile ifTrue: [ presentBlock value ] ifFalse: [ self writeStream ]! ! Object subclass: #FSReleaseInfo instanceVariableNames: 'version' classVariableNames: 'Current' poolDictionaries: '' category: 'FS-Core-Release'! !FSReleaseInfo classSide methodsFor: 'accessing' stamp: 'cwp 11/20/2009 12:01'! current ^ Current! ! !FSReleaseInfo classSide methodsFor: 'accessing' stamp: 'cwp 11/20/2009 12:00'! currentVersion: anArray Current := self version: anArray! ! !FSReleaseInfo classSide methodsFor: 'accessing' stamp: 'cwp 11/20/2009 12:00'! version: anArray ^ self new initializeWithVersion: anArray! ! !FSReleaseInfo methodsFor: 'initialization' stamp: 'cwp 11/20/2009 12:00'! initializeWithVersion: anArray self initialize. version := anArray! ! !FSReleaseInfo methodsFor: 'accessing' stamp: 'cwp 11/20/2009 12:02'! version ^ version! ! Object subclass: #FSResolver instanceVariableNames: 'next' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Resolvers'! !FSResolver commentStamp: 'cwp 3/29/2011 17:04' prior: 0! I am an abstract superclass for objects that can resolve origins into references. Such objects use the Chain of Responsibility pattern, and when unable to resolve a particular origin, delegate that resolution request to the next resolver in the list. next The next resolver in the list, or nil ! FSResolver subclass: #FSInteractiveResolver instanceVariableNames: 'cache' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Resolvers'! !FSInteractiveResolver commentStamp: 'cwp 11/18/2009 11:56' prior: 0! I resolve origins by consulting the user. I maintain a cache of the user's responses.! !FSInteractiveResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:29'! flushLocalCache cache := IdentityDictionary new! ! !FSInteractiveResolver methodsFor: 'initialize-release' stamp: 'cwp 10/27/2009 10:29'! initialize self flushLocalCache! ! !FSInteractiveResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 10:12'! resolve: origin ^ cache at: origin ifAbsent: [self unknownOrigin: origin] ! ! !FSInteractiveResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 11:15'! unknownOrigin: origin | reference | ^ (next ifNotNil: [next resolve: origin]) ifNil: [reference := FSResolutionRequest for: origin. reference ifNotNil: [cache at: origin put: reference]]! ! FSResolver subclass: #FSPlatformResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Resolvers'! !FSPlatformResolver commentStamp: 'cwp 11/18/2009 11:56' prior: 0! I am an abstract superclass for platform-specific resolvers.! FSPlatformResolver subclass: #FSMacOSResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Resolvers'! !FSMacOSResolver commentStamp: 'cwp 11/18/2009 11:57' prior: 0! I am an expert on Mac OS X filesystem conventions. I resolve origins according to these conventions.! !FSMacOSResolver classSide methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:59'! platformName ^ 'Mac OS'! ! !FSMacOSResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:45'! desktop ^ self home / 'Desktop'! ! !FSMacOSResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:50'! documents ^ self home / 'Documents'! ! !FSMacOSResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:39'! home ^ (self resolveString: SecurityManager default untrustedUserDirectory) parent parent parent parent parent! ! !FSPlatformResolver classSide methodsFor: 'instance creation' stamp: 'tg 11/8/2010 19:05'! forCurrentPlatform | platformName | platformName := Smalltalk os platformName. ^ (self allSubclasses detect: [:ea | ea platformName = platformName]) new! ! !FSPlatformResolver classSide methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:58'! platformName ^ nil! ! !FSPlatformResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 15:35'! desktop ^ self subclassResponsibility! ! !FSPlatformResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 15:35'! documents ^ self subclassResponsibility! ! !FSPlatformResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:01'! home ^ self subclassResponsibility! ! !FSPlatformResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 21:45'! supportedOrigins ^ #(home desktop documents)! ! FSPlatformResolver subclass: #FSUnixResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Resolvers'! !FSUnixResolver classSide methodsFor: 'accessing' stamp: 'pls 12/18/2009 04:53'! platformName ^ 'unix'! ! !FSUnixResolver methodsFor: 'origins' stamp: 'pls 12/18/2009 04:52'! desktop ^ self home / 'Desktop'! ! !FSUnixResolver methodsFor: 'origins' stamp: 'pls 12/18/2009 04:53'! documents ^ self home / 'Documents'! ! !FSUnixResolver methodsFor: 'origins' stamp: 'pls 12/18/2009 04:52'! home ^ (self resolveString: SecurityManager default untrustedUserDirectory) parent parent parent parent parent! ! FSPlatformResolver subclass: #FSWindowsResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Resolvers'! !FSWindowsResolver commentStamp: 'cwp 11/18/2009 11:57' prior: 0! I am an expert on Windows filesystem conventions. I resolve origins according to these conventions.! !FSWindowsResolver classSide methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:59'! platformName ^ 'Win32'! ! !FSWindowsResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:45'! desktop ^ self home / 'Desktop'! ! !FSWindowsResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:50'! documents ^ self home / 'My Documents'! ! !FSWindowsResolver methodsFor: 'origins' stamp: 'cwp 11/20/2009 22:55'! home | pathString | pathString := SecurityManager default untrustedUserDirectory. ^ (self resolveString: pathString) parent parent! ! !FSResolver methodsFor: 'accessing' stamp: 'cwp 10/26/2009 20:53'! addResolver: aResolver next ifNil: [next := aResolver] ifNotNil: [next addResolver: aResolver]! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 11:18'! canResolve: aSymbol ^ self supportedOrigins includes: aSymbol! ! !FSResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:28'! flushCaches self flushLocalCache. next ifNotNil: [next flushCaches]! ! !FSResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:28'! flushLocalCache! ! !FSResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 11:25'! next ^ next! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 11:18'! resolve: aSymbol ^ (self canResolve: aSymbol) ifTrue: [self perform: aSymbol] ifFalse: [self unknownOrigin: aSymbol]! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 2/27/2011 10:11'! resolveString: aString | decoded fs | decoded := (FilePath pathName: aString isEncoded: true) asSqueakPathName. fs := FSFilesystem onDisk. ^ FSReference filesystem: fs path: (fs pathFromString: decoded)! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 10/26/2009 20:06'! supportedOrigins ^ #()! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 09:26'! unknownOrigin: aSymbol ^ next ifNotNil: [next resolve: aSymbol]! ! FSResolver subclass: #FSSystemResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Resolvers'! !FSSystemResolver commentStamp: 'cwp 11/18/2009 11:58' prior: 0! I resolve origins that are related to the currently running Smalltalk system, using primitives provided by the VM. ! !FSSystemResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 13:31'! changes ^ self image withExtension: 'changes'! ! !FSSystemResolver methodsFor: 'origins' stamp: 'cwp 10/26/2009 20:04'! image ^ self resolveString: self primImagePath! ! !FSSystemResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 13:34'! imageDirectory ^ self image parent! ! !FSSystemResolver methodsFor: 'primitives' stamp: 'cwp 10/26/2009 20:05'! primImagePath "Answer the full path name for the current image." self primitiveFailed! ! !FSSystemResolver methodsFor: 'primitives' stamp: 'lr 7/13/2010 13:27'! primVmDirectoryPath "Answer the full path name for the current virtual machine." self primitiveFailed! ! !FSSystemResolver methodsFor: 'resolving' stamp: 'lr 7/13/2010 13:35'! supportedOrigins ^ #(image imageDirectory changes vmBinary vmDirectory)! ! !FSSystemResolver methodsFor: 'origins' stamp: 'cwp 10/26/2009 20:04'! vmBinary ^ self resolveString: (SmalltalkImage current getSystemAttribute: 0)! ! !FSSystemResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 13:33'! vmDirectory ^ self resolveString: self primVmDirectoryPath! ! Object subclass: #FSStore instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Kernel'! !FSStore commentStamp: 'cwp 4/4/2011 18:42' prior: 0! I am an abstract superclass for store implementations. My subclasses provide access to the actual data storage of a particular kind of filesystem. ! !FSStore methodsFor: 'private' stamp: 'cwp 2/19/2011 00:49'! basicCopy: source ifAbsent: aBlock to: destination ifPresent: pBlock filesystem: aFilesystem | buffer out in | in := nil. out := nil. buffer := nil. [ in := aFilesystem readStreamOn: source. in ifNil: [ aBlock value ]. (self exists: destination) ifTrue: [ pBlock value ]. out := aFilesystem writeStreamOn: destination. buffer := ByteArray new: 1024. [ in atEnd ] whileFalse: [ buffer := in nextInto: buffer. out nextPutAll: buffer ] ] ensure: [ in ifNotNil: [ in close ]. out ifNotNil: [ out close ] ]! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 13:15'! basicIsDirectory: aPath self subclassResponsibility ! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 14:32'! basicIsFile: entry self subclassResponsibility ! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/19/2011 01:39'! close "Some kinds of filesystems need to open connections to external resources"! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 23:59'! createDirectory: aPath self subclassResponsibility ! ! !FSStore methodsFor: 'accessing' stamp: 'cwp 2/18/2011 16:49'! defaultWorkingDirectory ^ FSPath root! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 13:25'! delete: aPath self subclassResponsibility ! ! !FSStore methodsFor: 'accessing' stamp: 'cwp 2/18/2011 17:19'! delimiter ^ self class delimiter! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 13:07'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock self subclassResponsibility ! ! !FSStore methodsFor: 'public' stamp: 'cwp 2/19/2011 00:00'! ensureDirectory: aPath (self isDirectory: aPath) ifTrue: [ ^ self ]. self ensureDirectory: aPath parent. self createDirectory: aPath! ! !FSStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:11'! exists: aPath self nodeAt: aPath ifPresent: [ :entry | ^ true ] ifAbsent: [ ^ false ]. ! ! !FSStore methodsFor: 'private' stamp: 'cwp 2/18/2011 12:28'! filename: aByteString matches: aByteString2 ^ aByteString = aByteString2! ! !FSStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:22'! isDirectory: aPath aPath isRoot ifTrue: [ ^ true ]. self nodeAt: aPath ifPresent: [ :entry | ^ self basicIsDirectory: entry ] ifAbsent: [ ^ false ]. ! ! !FSStore methodsFor: 'public' stamp: 'cwp 2/18/2011 14:35'! isFile: aPath ^ self nodeAt: aPath ifPresent: [ :entry | ^ self basicIsFile: entry ] ifAbsent: [ ^ false ]! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 12:50'! nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock self subclassResponsibility ! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/19/2011 01:38'! open "Some kinds of filesystems need to open connections to external resources"! ! !FSStore methodsFor: 'converting' stamp: 'cwp 2/26/2011 17:53'! pathFromString: aString "Use the unix convention by default, since many filesystems are based on it." | in | in := aString readStream. ^ in peek = $/ ifTrue: [in skip: 1. FSAbsolutePath readFrom: in delimiter: self delimiter] ifFalse: [FSRelativePath readFrom: in delimiter: self delimiter]! ! !FSStore methodsFor: 'converting' stamp: 'cwp 2/28/2011 12:28'! printPath: aPath on: out "Use the unix convention by default, since it's the most common." aPath isAbsolute ifTrue: [ out nextPut: $/ ]. ^ aPath printOn: out delimiter: self delimiter! ! !FSStore methodsFor: 'error signalling' stamp: 'cwp 4/3/2011 22:16'! signalDirectoryDoesNotExist: aPath ^ FSDirectoryDoesNotExist signalWith: aPath! ! !FSStore methodsFor: 'error signalling' stamp: 'cwp 4/3/2011 22:16'! signalDirectoryExists: aPath ^ FSDirectoryExists signalWith: aPath! ! !FSStore methodsFor: 'error signalling' stamp: 'cwp 4/3/2011 22:17'! signalFileDoesNotExist: aPath ^ FSFileDoesNotExist signalWith: aPath! ! !FSStore methodsFor: 'error signalling' stamp: 'cwp 4/3/2011 22:17'! signalFileExists: aPath ^ FSFileExists signalWith: aPath! ! !FSStore methodsFor: 'converting' stamp: 'cwp 2/28/2011 12:28'! stringFromPath: aPath ^ String streamContents: [ :out | self printPath: aPath on: out ]! ! Object subclass: #FSVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Enumeration'! !FSVisitor commentStamp: 'cwp 11/18/2009 12:25' prior: 0! I am an abstract superclass for objects that can perform operations on directory trees. My subclasses implement the visitor protocol, and process filesystem nodes shown to them by guides.! FSVisitor subclass: #FSCollectVisitor instanceVariableNames: 'out block' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Enumeration'! !FSCollectVisitor commentStamp: 'cwp 11/18/2009 12:32' prior: 0! I am a visitor that collects objects from the nodes I visit. I take a block similar to those passed to Collection>>collect:. I evaluate the block with DirectoryEntries for the nodes I visit, and collect the objects answered into an array. I can use any guide, and the objects in the array I produce will reflect the order imposed by the guide.! !FSCollectVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:33'! breadthFirst: aReference ^ self breadthFirst: aReference collect: [:entry | entry]! ! !FSCollectVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:32'! breadthFirst: aReference collect: aBlock ^ (self collect: aBlock) breadthFirst: aReference! ! !FSCollectVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:39'! collect: aBlock ^ self basicNew initializeWithBlock: aBlock! ! !FSCollectVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:36'! postorder: aReference ^ self postorder: aReference collect: [:entry | entry]! ! !FSCollectVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:35'! postorder: aReference collect: aBlock ^ (self collect: aBlock) postorder: aReference! ! !FSCollectVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:35'! preorder: aReference ^ self preorder: aReference collect: [:entry | entry]! ! !FSCollectVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:36'! preorder: aReference collect: aBlock ^ (self collect: aBlock) preorder: aReference! ! !FSCollectVisitor methodsFor: 'ordering' stamp: 'cwp 11/15/2009 07:58'! breadthFirst: aReference ^ self visit: aReference with: (FSBreadthFirstGuide for: self)! ! !FSCollectVisitor methodsFor: 'initialize-release' stamp: 'cwp 11/16/2009 10:38'! initializeWithBlock: aBlock self initialize. block := aBlock! ! !FSCollectVisitor methodsFor: 'ordering' stamp: 'cwp 11/15/2009 07:58'! postorder: aReference ^ self visit: aReference with: (FSPostorderGuide for: self)! ! !FSCollectVisitor methodsFor: 'ordering' stamp: 'cwp 11/15/2009 07:58'! preorder: aReference ^ self visit: aReference with: (FSPreorderGuide for: self)! ! !FSCollectVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 07:59'! visit: aReference with: aGuide out := (Array new: 10) writeStream. aGuide show: aReference. ^ out contents! ! !FSCollectVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:38'! visitReference: anEntry out nextPut: (block value: anEntry)! ! FSVisitor subclass: #FSCopyVisitor instanceVariableNames: 'source dest' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Enumeration'! !FSCopyVisitor commentStamp: 'cwp 11/18/2009 12:30' prior: 0! I create a copy of the directory tree that I visit. I use the PreorderGuide so that I can create directories before creating their contents. ! !FSCopyVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 10/30/2009 13:44'! copy: source to: dest (self from: source to: dest) visit! ! !FSCopyVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 10/30/2009 13:41'! from: srcReference to: dstReference ^ self basicNew initializeWithSource: srcReference dest: dstReference! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/17/2009 21:06'! copyDirectory: aReference | directory | directory := dest resolve: (aReference relativeTo: source). directory createDirectory! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:31'! copyFile: aReference | copy | copy := dest resolve: (aReference relativeTo: source). aReference copyTo: copy! ! !FSCopyVisitor methodsFor: 'initialize-release' stamp: 'cwp 10/30/2009 13:42'! initializeWithSource: srcReference dest: dstReference self initialize. source := srcReference. dest := dstReference! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 10/30/2009 13:45'! visit (FSPreorderGuide for: self) show: source! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:51'! visitDirectory: anEntry | reference | reference := anEntry reference. reference = source ifTrue: [dest ensureDirectory] ifFalse: [self copyDirectory: reference]! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:52'! visitFile: anEntry | reference | reference := anEntry reference. reference = source ifTrue: [source copyTo: dest] ifFalse: [self copyFile: reference]! ! FSVisitor subclass: #FSDeleteVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Enumeration'! !FSDeleteVisitor commentStamp: 'cwp 11/18/2009 12:30' prior: 0! I delete the directory tree that I visit. I use the PostorderGuide so that I can delete files before deleting their containing directories.! !FSDeleteVisitor classSide methodsFor: 'instance creation' stamp: 'cwp 11/17/2009 13:02'! delete: aReference ^ self new visit: aReference! ! !FSDeleteVisitor methodsFor: 'visiting' stamp: 'cwp 11/17/2009 16:02'! visit: aReference FSPostorderGuide show: aReference to: self! ! !FSDeleteVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:53'! visitReference: anEntry anEntry reference delete! ! !FSVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:45'! visitDirectory: aReference ^ self visitReference: aReference! ! !FSVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:45'! visitFile: aReference ^ self visitReference: aReference! ! !FSVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:45'! visitReference: aReference! ! Notification subclass: #FSResolutionRequest instanceVariableNames: 'origin' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Resolvers'! !FSResolutionRequest commentStamp: 'cwp 11/18/2009 11:38' prior: 0! I represent a request for user assistance in resolving an origin. I am a resumable exception that gets raised when there is no way of automatically resolving a particular origin. ! !FSResolutionRequest classSide methodsFor: 'instance creation' stamp: 'cwp 10/27/2009 10:13'! for: origin ^ self new origin: origin; signal! ! !FSResolutionRequest methodsFor: 'exceptionDescription' stamp: 'cwp 2/19/2011 15:09'! defaultAction | filedir ref | filedir := UIManager default chooseDirectory: 'Where is ', origin, '?'. ref := filedir ifNotNil: [FSFilesystem onDisk referenceTo: filedir fullName]. self resume: ref! ! !FSResolutionRequest methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:22'! origin: aSymbol origin := aSymbol! ! Error subclass: #FSFilesystemError instanceVariableNames: 'reference' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Exceptions'! !FSFilesystemError commentStamp: 'cwp 11/18/2009 12:32' prior: 0! I am an abstract superclass for errors that may occur during filesystem operations.! FSFilesystemError subclass: #FSDirectoryDoesNotExist instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Exceptions'! !FSDirectoryDoesNotExist commentStamp: 'cwp 11/18/2009 12:33' prior: 0! I am raised when I an operation is attempted inside a directory that does not exist. ! FSFilesystemError subclass: #FSDirectoryExists instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Exceptions'! !FSDirectoryExists commentStamp: 'cwp 11/18/2009 12:35' prior: 0! I am raised on an attempt to create a directory that already exists.! FSFilesystemError subclass: #FSFileDoesNotExist instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Exceptions'! !FSFileDoesNotExist commentStamp: 'cwp 11/18/2009 12:35' prior: 0! I am raised when an operation is attempted on a file that does not exist. This includes cases where a file operation is attempted on a directory.! FSFilesystemError subclass: #FSFileExists instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Exceptions'! !FSFileExists commentStamp: 'cwp 11/18/2009 12:37' prior: 0! I am raised on an attempt to create a file or directory over top of an existing file.! !FSFilesystemError classSide methodsFor: 'instance creation' stamp: 'cwp 11/14/2009 23:32'! reference: aReference ^ self basicNew initializeWithReference: aReference! ! !FSFilesystemError classSide methodsFor: 'instance creation' stamp: 'cwp 11/14/2009 23:31'! signalWith: aReference ^ (self reference: aReference) signal! ! !FSFilesystemError methodsFor: 'initialize-release' stamp: 'lr 8/16/2010 16:00'! initializeWithReference: aReference reference := aReference. messageText := aReference printString! ! !FSFilesystemError methodsFor: 'testing' stamp: 'lr 8/16/2010 16:00'! isResumable ^ true! ! !FSFilesystemError methodsFor: 'accessing' stamp: 'lr 7/13/2010 15:31'! reference ^ reference! ! FSFilesystemError subclass: #FSIllegalName instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'FS-Core-Exceptions'! !FSIllegalName classSide methodsFor: 'instance creation' stamp: 'DamienPollet 2/28/2011 17:04'! name: aName ^ self basicNew initializeWithName: aName! ! !FSIllegalName classSide methodsFor: 'instance creation' stamp: 'DamienPollet 2/28/2011 17:03'! signalWith: aName ^ (self name: aName) signal! ! !FSIllegalName methodsFor: 'initialization' stamp: 'DamienPollet 2/28/2011 17:08'! initializeWithName: aName name := aName. self messageText: aName! ! !FSIllegalName methodsFor: 'accessing' stamp: 'DamienPollet 2/28/2011 17:08'! name ^ name! ! !String methodsFor: '*fs-core-converting' stamp: 'cwp 11/21/2009 11:30'! asPathWith: anObject ^ anObject pathFromString: self! ! !String methodsFor: '*fs-core-converting' stamp: 'StephaneDucasse 2/9/2011 13:41'! asResolvedBy: aFileSystem ^ aFileSystem resolveString: self! ! FSLocator initialize!