[Pkg] Rio: Rio-Kernel-kph.86.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Sun Nov 9 19:31:37 UTC 2008


A new version of Rio-Kernel was added to project Rio:
http://www.squeaksource.com/Rio/Rio-Kernel-kph.86.mcz

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

Name: Rio-Kernel-kph.86
Author: kph
Time: 9 November 2008, 7:31:34 pm
UUID: fe4e14d0-d65b-4fde-9f00-78e2cea6afa7
Ancestors: Rio-Kernel-kph.85

Refactored instanciation

=============== Diff against Rio-Kernel-kph.85 ===============

Item was added:
+ ----- Method: RioLocalDosExecutive>>getTempDirectory (in category 'as yet unclassified') -----
+ getTempDirectory
+ 
+  	^ self rioClass new: 'C:\WINDOWS\TEMP\'!

Item was added:
+ ----- Method: RioLocalExecutive>>primSetMacFileNamed:type:creator: (in category 'primitives') -----
+ primSetMacFileNamed: fileName type: typeString creator: creatorString
+ 	"Set the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms."
+ 
+  	<primitive: 'primitiveDirectorySetMacTypeAndCreator' module: 'FilePlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: RioExecutive>>makeNewRioFromString: (in category 'as yet unclassified') -----
+ makeNewRioFromString: aString
+ 
+ 	^ self rioClass executive: self value: aString !

Item was added:
+ ----- Method: RioLocalExecutive>>rename:to: (in category 'executive actions') -----
+ rename: aRio to: bRio
+ 	
+ 	(self retryWithGC:[
+ 		self primRename: aRio asVmPathName to: bRio asVmPathName
+ 	]
+ 		until:[:result| result notNil]
+ 		forFileNamed: aRio) ~~ nil ifTrue:[ aRio statIsNowInvalid. ^ bRio ].
+ 
+ 	aRio exists ifFalse:[ ^ self error:'Attempt to rename a non-existent file:' , aRio].
+ 	
+ 	bRio exists ifTrue:[ ^self error: 'Failed to rename, ', bRio,' already exists.' ].!

Item was added:
+ ----- Method: RioLocalDosExecutive>>importValue: (in category 'as yet unclassified') -----
+ importValue: aPath
+ 
+ 	^ super importValue: (aPath copy replaceAll: $/ with: $\).!

Item was added:
+ ----- Method: RioLocalExecutive class>>maxFileNameLengthOnMacOS (in category 'image start up ') -----
+ maxFileNameLengthOnMacOS
+ 
+ 	^ 31!

Item was added:
+ ----- Method: RioLocalDosExecutive>>migrateToLocalDosFileSystem: (in category 'fs migration') -----
+ migrateToLocalDosFileSystem: old
+ 
+  ^ self!

Item was added:
+ ----- Method: RioLocalDosExecutive class>>makeNewRioFrom: (in category 'as yet unclassified') -----
+ makeNewRioFrom: str
+ 
+ 	| rioDrive exec |
+ 	
+ 	rioDrive := nil.
+ 	
+ 	(str size > 1) ifTrue: [  
+ 
+ 		(str second = $:) ifTrue: [ rioDrive := (str first: 2) , self pathDelimiter ].
+ 		
+ 	].
+ 	exec := self executiveForVolume: rioDrive.
+ 
+ 	^ exec rioClass executive: exec value: str!

Item was added:
+ ----- Method: RioLocalExecutive class>>platform (in category 'image start up ') -----
+ platform
+ 
+ 	^ SmalltalkImage current platformName asLegalSelector capitalized!

Item was added:
+ ----- Method: RioLocalExecutive class>>initialize (in category 'class initialization') -----
+ initialize
+ 
+ 	Smalltalk addToStartUpList: self after: Delay.
+ 	RioLocalDosExecutive initializeVolumes.
+ 	Current := self newForThisPlatform.
+ 	Current initializeDefault.
+ 	!

Item was added:
+ ----- Method: RioLocalExecutive>>printId (in category 'printing') -----
+ printId
+ 
+ 	^ rootString!

Item was added:
+ ----- Method: RioLocalExecutive>>setRootString: (in category 'executive actions') -----
+ setRootString: aString  
+ 	rootString := aString.
+ 	 !

Item was added:
+ ----- Method: RioLocalExecutive>>retryWithGC:until:forFileNamed: (in category 'utilities') -----
+ retryWithGC: execBlock until: okBlock forFileNamed: aRio
+ 
+     ^ StandardFileStream 
+ 		retryWithGC: execBlock
+ 		until: okBlock
+ 		forFileNamed: aRio!

Item was added:
+ ----- Method: RioLocalExecutive class>>makeNewRioFrom: (in category 'as yet unclassified') -----
+ makeNewRioFrom: aString
+ 
+ 	| exec |
+ 	exec := self current.
+ 	
+ 	^ exec rioClass executive: exec value: aString !

Item was added:
+ ----- Method: RioLocalDosExecutive>>migrateFromLocalDosFileSystem: (in category 'fs migration todo') -----
+ migrateFromLocalDosFileSystem: nfs
+ 
+   "could do something here"
+ 
+  ^ nfs !

Item was changed:
  ----- Method: RioKernel class>>thisImage (in category 'as yet unclassified') -----
  thisImage
  
+ 	^ self new: self defaultExecutive current primImagePath.!
- 	^ self new: self defaultExecutive primImagePath.!

Item was added:
+ ----- Method: RioLocalExecutive>>primGetMacFileNamed:type:creator: (in category 'primitives') -----
+ primGetMacFileNamed: fileName type: typeString creator: creatorString
+ 	"Get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms."
+ 
+  	<primitive: 'primitiveDirectoryGetMacTypeAndCreator' module: 'FilePlugin'>
+ 
+ !

Item was added:
+ ----- Method: RioLocalExecutive>>migrateFromLocalDosFileSystem: (in category 'fs migration') -----
+ migrateFromLocalDosFileSystem: nfs
+ 
+   "could do something here"
+ 
+  ^ self !

Item was added:
+ ----- Method: RioLocalCaseInsensitiveExecutive>>hashFor: (in category 'case-sensitivity') -----
+ hashFor: aRio
+ 	
+ 	^ aRio value asLowercase hash!

Item was added:
+ ----- Method: RioLocalExecutive>>getMacFileTypeAndCreator: (in category 'executive actions') -----
+ getMacFileTypeAndCreator: aRio 
+ 
+ 	| results typeString creatorString |
+ 	"get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. Does nothing on other platforms (where the underlying primitive is a noop)."
+ 	"FileDirectory default getMacFileNamed: 'foo'"
+ 
+ 	typeString := ByteArray new: 4 withAll: ($? asInteger). 
+ 	creatorString := ByteArray new: 4 withAll: ($? asInteger).
+ 	[self primGetMacFileNamed: aRio asVmPathName
+ 		type: typeString
+ 		creator: creatorString.] ensure: 
+ 		[typeString := typeString asString. 
+ 		creatorString := creatorString asString].
+ 	results := Array with: typeString convertFromSystemString with: creatorString convertFromSystemString.
+ 	^results
+ !

Item was added:
+ ----- Method: RioLocalExecutive>>isDirectory: (in category 'executive actions') -----
+ isDirectory: aRio
+  
+ 	^ #badDirectoryPath ~= (self primLookupEntryIn: aRio full value index: 1)
+ 	 !

Item was added:
+ ----- Method: RioLocalExecutive>>primDeleteDirectory: (in category 'primitives') -----
+ primDeleteDirectory: fullPath
+ 	"Delete the directory named by the given path. Raise an error if the path is bad or if a directory by that name does not exist."
+ 
+  	<primitive: 'primitiveDirectoryDelete' module: 'FilePlugin'>
+ 	^ self errorUnableToDeleteDir: fullPath
+ !

Item was added:
+ ----- Method: RioExecutive>>MCPasswordManager (in category 'case-sensitivity') -----
+ MCPasswordManager
+ 
+ 	^ MCPasswordManager!

Item was added:
+ ----- Method: RioExecutive class>>default (in category 'as yet unclassified') -----
+ default
+ 
+ 	^ RioLocalExecutive            !

Item was added:
+ ----- Method: RioLocalExecutive>>deleteFile: (in category 'executive actions') -----
+ deleteFile: aRio
+ 	
+ 	"Delete the file of the given name if it exists.
+ 	If the first deletion attempt fails do a GC to force finalization of any lost references. ar 3/21/98 17:53"
+ 		 
+ 	self retryWithGC: [
+ 		self primDeleteFileNamed: aRio asVmPathName ]
+ 		until:[:result| result notNil]
+ 		forFileNamed: aRio.
+ 		
+ 	aRio statIsNowInvalid!

Item was added:
+ ----- Method: RioLocalExecutive>>maxFileNameLength (in category 'misc') -----
+ maxFileNameLength
+ 
+  ^ (self class respondsTo: #maxFileNameLength) 
+ 	ifTrue: [ self class maxFileNameLength ]
+ 	ifFalse: [ self class perform: ('maxFileNameLengthOn', self class platform) asSymbol ]!

Item was added:
+ ----- Method: RioLocalDosExecutive>>fullFor: (in category 'as yet unclassified') -----
+ fullFor: aRio
+ 
+ 	"the absolute path of this rio (with the current volume drive prepended), or if relative 
+ 	combine with #defaultDirectory to obtain the full path"
+ 	
+ 	aRio value isEmpty ifTrue: [ ^ self defaultDirectory ].
+ 	
+ 	(self isFull: aRio) ifTrue: [ ^ aRio ].
+ 	
+ 	"if we are an absolute path, prepend the volume"
+ 	aRio value first = self pathDelimiterChar ifTrue: [ ^ aRio newFrom: (self drive, aRio value) ].
+ 
+ 	^ aRio newFrom: (self defaultDirectory value, self pathDelimiter, aRio value)!

Item was added:
+ ----- Method: RioLocalExecutive class>>performStartUpMigration (in category 'image start up ') -----
+ performStartUpMigration
+  	| old |
+ 	
+ 	old := self current.
+ 	Current := self newForThisPlatform.
+ 	Current initializeDefault.
+ 
+ 	old migrateFileSystemTo: Current!

Item was added:
+ ----- Method: RioExecutive class>>makeNewRioFrom: (in category 'as yet unclassified') -----
+ makeNewRioFrom: aString
+ 
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: RioLocalExecutive class>>newForRiscOS (in category 'image start up ') -----
+ newForRiscOS
+ 
+ 	^ RioLocalExecutive new!

Item was added:
+ ----- Method: RioLocalDosExecutive>>pathDelimiter (in category 'as yet unclassified') -----
+ pathDelimiter
+  
+ 	^ '\'
+ !

Item was added:
+ ----- Method: RioLocalExecutive>>startAt:recursively:select:into: (in category 'executive actions') -----
+ startAt: rioOrString recursively: beRecursive select: selectBlock into: results 
+ 
+ 	"Return a collection of rio's selected by passing
+ 	the directoryEntry array to the selectBlock.
+ 	
+ 	The KernelRio implemetation of setStatFromEntryArray: 
+ 	does not populate these rios with stat data.
+ 	Rio's more verbose implementation does.
+ 
+ 	This can be called with startAt: aString, but if so beRecursive must be false.
+ 		
+ 	See primLookupEntryIn:index: for further details."
+ 
+ 	| index entryArray entryRio |
+ 
+ 	index := 1.
+ 
+ 	[ (entryArray := self primLookupEntryIn: rioOrString asVmPathName index: index) notNil ] 
+ 		whileTrue: [
+ 			#badDirectoryPath = entryArray ifTrue: [
+ 				^ results "(InvalidDirectoryError pathName: rioOrString value) signal" ].
+ 
+ 				(entryRio := rioOrString / (entryArray at: 1)) 
+ 									setStatFromDir: rioOrString andEntryArray:entryArray.
+ 
+ 				(selectBlock value: entryRio) ifTrue: [ results add: entryRio ].	
+ 						
+ 				(beRecursive and: [ entryArray at: 4]) 
+ 					ifTrue: [ 
+ 						self 
+ 							startAt: entryRio
+ 							recursively: beRecursive 
+ 							select: selectBlock
+ 							into: results   
+ 					].	
+ 			index := index + 1
+ 		].
+ 	
+ 	^ results!

Item was added:
+ ----- Method: RioLocalDosExecutive>>initializeDefault (in category 'as yet unclassified') -----
+ initializeDefault
+   
+ 	self setRootString: (self primImagePath first: 3);
+ 		setDefault: self getDefaultDirectory.
+ 
+ 	Volumes add: self.!

Item was added:
+ ----- Method: RioLocalExecutive>>deleteDirectory: (in category 'executive actions') -----
+ deleteDirectory: aRio
+ 	 
+ 	self primDeleteDirectory: aRio asVmPathName.
+ 	aRio statIsNowInvalid!

Item was added:
+ ----- Method: RioLocalDosExecutive>>isRoot: (in category 'as yet unclassified') -----
+ isRoot: aRioOrString
+ 
+ 	aRioOrString value size = self rootString size ifTrue: [ ^ super isRoot: aRioOrString ].
+ 	
+ 	^ (aRioOrString value, self pathDelimiter) = self rootString!

Item was added:
+ ----- Method: RioLocalExecutive class>>newForWin32 (in category 'image start up ') -----
+ newForWin32
+ 
+ 	^ RioLocalDosExecutive new!

Item was added:
+ ----- Method: RioLocalExecutive>>initializeDefault (in category 'executive actions') -----
+ initializeDefault
+ 
+ 	self setRootString: self pathDelimiter;
+ 		setDefault: self getDefaultDirectory!

Item was changed:
  ----- Method: RioKernel class>>defaultExecutive (in category 'as yet unclassified') -----
  defaultExecutive
  
+ 	^ RioExecutive default!
- 	^ RioLocalFileSystem current!

Item was added:
+ ----- Method: RioLocalExecutive>>linearRelativeTo: (in category 'executive actions') -----
+ linearRelativeTo: aDirectory
+ 
+ 	self ~= aDirectory executive ifTrue: [ ^ self errorMustBeInSameFileSystem: aDirectory ].
+ 	
+ 	^ self root!

Item was added:
+ ----- Method: RioLocalExecutive>>primPathNameDelimiter (in category 'primitives') -----
+ primPathNameDelimiter
+ 	"Return the path delimiter for the underlying platform's file system."
+ 
+  	<primitive: 'primitiveDirectoryDelimitor' module: 'FilePlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: RioLocalExecutive class>>current (in category 'accessing current') -----
+ current
+ 
+ 	^ Test ifNil: [ Current ]
+  	
+ !

Item was added:
+ ----- Method: RioLocalExecutive>>setDefault: (in category 'executive actions') -----
+ setDefault: d
+  
+ 	defaultDirectory := d!

Item was added:
+ ----- Method: RioLocalExecutive class>>newForThisPlatform (in category 'image start up ') -----
+ newForThisPlatform
+ 
+ 	^ self perform: ('newFor', self platform) asSymbol!

Item was added:
+ ----- Method: RioLocalExecutive>>errorUnableToDeleteDir: (in category 'errors') -----
+ errorUnableToDeleteDir: fullPath
+ 
+ 	| entries |
+ 	
+ 	entries := fullPath asRio entries.
+ 		
+ 	^ self error: 'unable to delete directory: ', fullPath, ((entries size >0) ifTrue: [' (not empty)'] ifFalse: ['']).
+ !

Item was added:
+ ----- Method: RioLocalExecutive class>>maxFileNameLengthOnDOS (in category 'image start up ') -----
+ maxFileNameLengthOnDOS
+ 
+ 	^ 8!

Item was added:
+ ----- Method: RioLocalCaseInsensitiveExecutive>>is:sameAs: (in category 'case-sensitivity') -----
+ is: aRio sameAs: bRio
+ 
+ ^ (aRio value compare: bRio value caseSensitive: false) = 2!

Item was added:
+ ----- Method: RioLocalDosExecutive class>>pathDelimiter (in category 'as yet unclassified') -----
+ pathDelimiter
+  
+ 	^ '\'
+ !

Item was added:
+ ----- Method: RioLocalExecutive>>untrustedDirectory (in category 'executive actions') -----
+ untrustedDirectory
+ 
+  	^ self rioClass new: (SecurityManager default primUntrustedUserDirectory)
+ 	 !

Item was added:
+ ----- Method: RioLocalExecutive>>primImagePath (in category 'primitives') -----
+ primImagePath
+ 	"Answer the full path name for the current image."
+ 	"self new primImagePath"
+ 
+ 	<primitive: 121>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: RioLocalExecutive>>set:macType:creator: (in category 'executive actions') -----
+ set: aRio macType: 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."
+ 	 
+  	self primSetMacFileNamed: aRio asVmPathName
+ 		type: typeString convertToSystemString
+ 		creator: creatorString convertToSystemString.!

Item was added:
+ ----- Method: RioLocalExecutive>>primRename:to: (in category 'primitives') -----
+ primRename: oldFileFullName to: newFileFullName 
+ 	"Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name.
+ 	Changed to return nil instead of failing ar 3/21/98 18:04"
+ 
+ 	<primitive: 'primitiveFileRename' module: 'FilePlugin'>
+ 	^nil!

Item was added:
+ ----- Method: RioLocalDosExecutive>>pathDelimiterChar (in category 'as yet unclassified') -----
+ pathDelimiterChar
+  
+ 	^ $\
+ !

Item was added:
+ RioExecutive subclass: #RioLocalExecutive
+ 	instanceVariableNames: 'rootString root defaultDirectory'
+ 	classVariableNames: 'Current Test'
+ 	poolDictionaries: ''
+ 	category: 'Rio-Kernel'!
+ 
+ !RioLocalExecutive commentStamp: 'kph 4/17/2007 19:25' prior: 0!
+ Introducing the idea that Rio's exist in the context of their 'physical container', we have the RioLocalFileSystem as the primary container which provides the file system interface, also known as the 'executive'.
+ 
+ On unix there is one executive for the whole system. On dos there is one executive per volume. This approach also supports the notion of files within archives and files on remote servers.
+ 
+ On startup, having a formal model of the host filesystem allows us to keep a current and previous instance introducing the possibility for migrating Rio's on startup when the image has been moved. For example C:/ could be replaced with /mnt/hda1 thus attempting to make images properly portable. (experimental idea)
+ 
+ !

Item was added:
+ ----- Method: RioLocalExecutive class>>maxFileNameLengthOnUnix (in category 'image start up ') -----
+ maxFileNameLengthOnUnix
+ 
+ ^ 255!

Item was added:
+ ----- Method: RioLocalDosExecutive class>>canInstanciateRioFrom: (in category 'as yet unclassified') -----
+ canInstanciateRioFrom: aString
+ 
+ 	^ (aString size > 1 and: [ aString second = $: ])!

Item was added:
+ ----- Method: RioLocalExecutive>>primCreateDirectory: (in category 'primitives') -----
+ primCreateDirectory: fullPath
+ 	"Create a directory named by the given path. Fail if the path is bad or if a file or directory by that name already exists."
+ 
+  	<primitive: 'primitiveDirectoryCreate' module: 'FilePlugin'>
+ 	self primitiveFailed!

Item was changed:
  ----- Method: RioExecutive>>root (in category 'as yet unclassified') -----
  root
  
+ 	^ self makeNewRioFromString: self rootString!
- 	^ self makeNewRioOfClass: self rioClass fromString: self rootString!

Item was added:
+ ----- Method: RioLocalExecutive>>getTempDirectory (in category 'executive actions') -----
+ getTempDirectory
+ 
+  	^ self rioClass new: '/tmp'!

Item was added:
+ ----- Method: RioLocalExecutive class>>newForMacOS (in category 'image start up ') -----
+ newForMacOS
+ 
+ 	^ RioLocalCaseInsensitiveExecutive new!

Item was added:
+ ----- Method: RioLocalExecutive>>migrateFileSystemTo: (in category 'fs migration') -----
+ migrateFileSystemTo: next
+ 
+ 	^ next migrateFromLocalFileSystem: self !

Item was added:
+ ----- Method: RioLocalExecutive>>tempDirectory (in category 'executive actions') -----
+ tempDirectory
+ 
+  	^ self rioClass new: '/tmp'!

Item was added:
+ ----- Method: RioLocalExecutive class>>testEnd (in category 'image start up ') -----
+ testEnd
+ 
+ 	Test := nil!

Item was added:
+ ----- Method: RioLocalDosExecutive>>executiveForVolume: (in category 'accessing') -----
+ executiveForVolume: requestedRoot
+  
+ 	^ Volumes 
+ 		detect: [ :i | i isRoot: requestedRoot ] 
+ 		ifNone: [ Volumes add: (self class basicNew setRootString: requestedRoot; setDefault: nil; yourself) ]!

Item was added:
+ ----- Method: RioLocalDosExecutive>>drive (in category 'accessing') -----
+ drive 
+ 
+ 	^ self rootString first: 2!

Item was added:
+ ----- Method: RioLocalExecutive>>printOn: (in category 'printing') -----
+ printOn: str
+ 
+ 	super printOn: str.
+ 	str nextPut: $(; nextPutAll: self printId; nextPut: $).!

Item was added:
+ ----- Method: RioLocalExecutive class>>newForDOS (in category 'image start up ') -----
+ newForDOS
+ 
+ 	^ RioLocalDosExecutive new!

Item was added:
+ ----- Method: RioLocalExecutive class>>testFileSystem: (in category 'image start up ') -----
+ testFileSystem: fs
+ 
+ 	^ Test := fs!

Item was added:
+ ----- Method: RioLocalExecutive>>getDefaultDirectory (in category 'executive actions') -----
+ getDefaultDirectory
+ 
+ 	^ (Preferences startInUntrustedDirectory 
+ 					ifTrue: [ self untrustedDirectory mkdir ]
+  					ifFalse: [ self getImageDirectory ] )!

Item was added:
+ ----- Method: RioLocalExecutive class>>maxFileNameLengthOnWin32 (in category 'image start up ') -----
+ maxFileNameLengthOnWin32
+ 
+ 	^ 255!

Item was added:
+ ----- Method: RioExecutive class>>newRioFrom: (in category 'as yet unclassified') -----
+ newRioFrom: aString
+ 
+ 	| executiveClass |
+ 	
+ 	RioExecutive allSubclassesDo: [ :c | (c canInstanciateRioFrom: aString) ifTrue: [ executiveClass := c ]].
+ 	
+ 	^ (executiveClass ifNil: [ self default ]) makeNewRioFrom: aString
+     !

Item was added:
+ ----- Method: RioLocalDosExecutive class>>initializeVolumes (in category 'as yet unclassified') -----
+ initializeVolumes 
+ 	
+ 	Volumes := Set new !

Item was added:
+ ----- Method: RioLocalExecutive class>>newForUnix (in category 'image start up ') -----
+ newForUnix
+ 
+ 	^ RioLocalExecutive new!

Item was added:
+ ----- Method: RioLocalExecutive>>errorMustBeInSameFileSystem: (in category 'errors') -----
+ errorMustBeInSameFileSystem: aDirectory
+ 
+ 	^ self error: 'Must be in same file system', aDirectory, ',', self printString!

Item was added:
+ RioLocalCaseInsensitiveExecutive subclass: #RioLocalDosExecutive
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'Volumes'
+ 	poolDictionaries: ''
+ 	category: 'Rio-Kernel'!
+ 
+ !RioLocalDosExecutive commentStamp: 'kph 4/17/2007 19:19' prior: 0!
+ The initial idea was to model things properly as a file within a named volume, on unix there would be one executive for the whole system. On dos there would be one executive per volume.!

Item was added:
+ ----- Method: RioLocalExecutive>>primDeleteFileNamed: (in category 'primitives') -----
+ primDeleteFileNamed: aFileName
+ 	"Delete the file of the given name. Return self if the primitive succeeds, nil otherwise."
+ 
+ 	<primitive: 'primitiveFileDelete' module: 'FilePlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: RioExecutive class>>pathDelimiter (in category 'as yet unclassified') -----
+ pathDelimiter
+  
+ 	^ '/'
+ !

Item was added:
+ ----- Method: RioLocalExecutive>>createDirectory: (in category 'executive actions') -----
+ createDirectory: aRio
+ 	 
+ 	^ self primCreateDirectory: aRio asVmPathName  !

Item was added:
+ ----- Method: RioLocalExecutive>>primVmPath (in category 'primitives') -----
+ primVmPath
+ 	"Answer the path for the directory containing the Smalltalk virtual machine. Return the 	empty string if this primitive is not implemented."
+ 	"Rio primVmPath"
+ 
+ 	<primitive: 142>
+ 	^ ''!

Item was changed:
  ----- Method: RioKernel class>>new: (in category 'as yet unclassified') -----
  new: aPathOrRio
  
  	"the preferred generic instanciation method, 
  	will call the correct specific instanciation method on the correct class"
  
  	aPathOrRio isRio ifTrue: [ ^ aPathOrRio copy ].
+ 	                                                                                                            	
+ 	^ self defaultExecutive newRioFrom: aPathOrRio!
- 	                                                                                                            
- 	self allSubclassesDo: [ :c | (c canInstanciate: aPathOrRio) ifTrue: [ ^ c defaultExecutive makeNewRioOfClass: c fromString: aPathOrRio ]].              
- 	
- 	^ self defaultExecutive makeNewRioOfClass: self fromString: aPathOrRio!

Item was added:
+ ----- Method: RioLocalDosExecutive>>makeNewRioFrom: (in category 'fs migration') -----
+ makeNewRioFrom: aString
+ 
+ 	| rioDrive exec str |
+ 	
+ 	str := aString.
+ 	exec := self.
+ 	
+ 	(aString size > 1) ifTrue: [  
+ 
+ 		rioDrive := rootString.
+ 		(str second = $:) ifTrue: [ rioDrive := (str first: 2) , self pathDelimiter ].
+ 		
+ 		rioDrive ~= rootString ifTrue: [ exec := self executiveForVolume: rioDrive ].
+ 
+ 	].
+ 
+ 	^ exec rioClass executive: exec value: str!

Item was added:
+ ----- Method: RioLocalDosExecutive>>driveLetter (in category 'accessing') -----
+ driveLetter
+ 
+ 	^ self rootString first!

Item was added:
+ ----- Method: RioLocalDosExecutive>>migrateFromLocalFileSystem: (in category 'fs migration') -----
+ migrateFromLocalFileSystem: nfs
+ 
+  ^ self  !

Item was added:
+ ----- Method: RioLocalExecutive>>primLookupEntryIn:index: (in category 'primitives') -----
+ primLookupEntryIn: fullPath index: index
+ 
+ 	"Look up the index-th entry of the directory with the given fully-qualified path (i.e., starting from the root of the file hierarchy) and return an array containing:
+ 
+ 	<name> 
+ 	<creationTime in seconds since squeak epoch> 
+ 	<modificationTime>
+ 	<dirFlag (dir is true)>
+ 	<fileSize in bytes>
+ 
+ 	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.)
+ 
+ 	Returns nil when index is past the end of the directory. 
+ 	Fails if the given path is bad."
+ 
+  	<primitive: 'primitiveDirectoryLookup' module: 'FilePlugin'>
+ 	^ #badDirectoryPath
+ 
+ !

Item was added:
+ ----- Method: RioLocalExecutive>>defaultDirectory (in category 'accessing') -----
+ defaultDirectory
+ 
+ 	^ defaultDirectory!

Item was added:
+ ----- Method: RioLocalDosExecutive class>>executiveForVolume: (in category 'as yet unclassified') -----
+ executiveForVolume: theRequestedRoot
+  
+ 	| requestedRoot |
+ 	requestedRoot := theRequestedRoot.
+ 	requestedRoot = nil ifTrue: [ requestedRoot := 'C:/' ].
+ 	
+ 	^ Volumes 
+ 		detect: [ :i | i isRoot: requestedRoot ] 
+ 		ifNone: [ Volumes add: (self class basicNew setRootString: requestedRoot; setDefault: nil; yourself) ]!

Item was added:
+ ----- Method: RioLocalExecutive>>getImageDirectory (in category 'executive actions') -----
+ getImageDirectory
+ 
+  	^ (self rioClass new: self primImagePath) parent !

Item was added:
+ ----- Method: RioLocalExecutive>>rootString (in category 'accessing') -----
+ rootString
+ 
+ 	^ rootString!

Item was added:
+ RioLocalExecutive subclass: #RioLocalCaseInsensitiveExecutive
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Rio-Kernel'!

Item was added:
+ ----- Method: RioExecutive class>>canInstanciateRioFrom: (in category 'as yet unclassified') -----
+ canInstanciateRioFrom: aPathString
+ 
+ 	"we return false, because we do not support any specific protocol"
+ 
+ 	^ false!

Item was added:
+ ----- Method: RioLocalExecutive>>migrateFromLocalFileSystem: (in category 'fs migration') -----
+ migrateFromLocalFileSystem: nfs
+ 
+  ^ nfs !

Item was added:
+ ----- Method: RioLocalExecutive class>>maxFileNameLengthOnRiscOS (in category 'image start up ') -----
+ maxFileNameLengthOnRiscOS
+ 
+ ^ 255!

Item was added:
+ ----- Method: RioLocalExecutive class>>startUp: (in category 'image start up ') -----
+ startUp: resuming
+ 	
+  	resuming ifFalse: [ ^self ].
+ 	 		
+ 	self performStartUpMigration.!

Item was removed:
- ----- Method: RioLocalFileSystem>>defaultDirectory (in category 'accessing') -----
- defaultDirectory
- 
- 	^ defaultDirectory!

Item was removed:
- ----- Method: RioLocalFileSystem>>untrustedDirectory (in category 'executive actions') -----
- untrustedDirectory
- 
-  	^ self rioClass new: (SecurityManager default primUntrustedUserDirectory)
- 	 !

Item was removed:
- ----- Method: RioLocalFileSystem>>primRename:to: (in category 'primitives') -----
- primRename: oldFileFullName to: newFileFullName 
- 	"Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name.
- 	Changed to return nil instead of failing ar 3/21/98 18:04"
- 
- 	<primitive: 'primitiveFileRename' module: 'FilePlugin'>
- 	^nil!

Item was removed:
- ----- Method: RioLocalCaseInsensitiveFileSystem>>is:sameAs: (in category 'case-sensitivity') -----
- is: aRio sameAs: bRio
- 
- ^ (aRio value compare: bRio value caseSensitive: false) = 2!

Item was removed:
- ----- Method: RioLocalFileSystem>>migrateFromLocalFileSystem: (in category 'fs migration') -----
- migrateFromLocalFileSystem: nfs
- 
-  ^ nfs !

Item was removed:
- ----- Method: RioLocalFileSystem class>>maxFileNameLengthOnRiscOS (in category 'image start up ') -----
- maxFileNameLengthOnRiscOS
- 
- ^ 255!

Item was removed:
- RioExecutive subclass: #RioLocalFileSystem
- 	instanceVariableNames: 'rootString root defaultDirectory'
- 	classVariableNames: 'Current Test'
- 	poolDictionaries: ''
- 	category: 'Rio-Kernel'!
- 
- !RioLocalFileSystem commentStamp: 'kph 4/17/2007 19:25' prior: 0!
- Introducing the idea that Rio's exist in the context of their 'physical container', we have the RioLocalFileSystem as the primary container which provides the file system interface, also known as the 'executive'.
- 
- On unix there is one executive for the whole system. On dos there is one executive per volume. This approach also supports the notion of files within archives and files on remote servers.
- 
- On startup, having a formal model of the host filesystem allows us to keep a current and previous instance introducing the possibility for migrating Rio's on startup when the image has been moved. For example C:/ could be replaced with /mnt/hda1 thus attempting to make images properly portable. (experimental idea)
- 
- !

Item was removed:
- ----- Method: RioLocalFileSystem>>primSetMacFileNamed:type:creator: (in category 'primitives') -----
- primSetMacFileNamed: fileName type: typeString creator: creatorString
- 	"Set the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms."
- 
-  	<primitive: 'primitiveDirectorySetMacTypeAndCreator' module: 'FilePlugin'>
- 	self primitiveFailed
- !

Item was removed:
- ----- Method: RioLocalFileSystem>>rename:to: (in category 'executive actions') -----
- rename: aRio to: bRio
- 	
- 	(self retryWithGC:[
- 		self primRename: aRio asVmPathName to: bRio asVmPathName
- 	]
- 		until:[:result| result notNil]
- 		forFileNamed: aRio) ~~ nil ifTrue:[ aRio statIsNowInvalid. ^ bRio ].
- 
- 	aRio exists ifFalse:[ ^ self error:'Attempt to rename a non-existent file:' , aRio].
- 	
- 	bRio exists ifTrue:[ ^self error: 'Failed to rename, ', bRio,' already exists.' ].!

Item was removed:
- ----- Method: RioLocalFileSystem>>getTempDirectory (in category 'executive actions') -----
- getTempDirectory
- 
-  	^ self rioClass new: '/tmp'!

Item was removed:
- ----- Method: RioLocalFileSystem>>migrateFileSystemTo: (in category 'fs migration') -----
- migrateFileSystemTo: next
- 
- 	^ next migrateFromLocalFileSystem: self !

Item was removed:
- ----- Method: RioLocalDosFileSystem>>pathDelimiter (in category 'as yet unclassified') -----
- pathDelimiter
-  
- 	^ '\'
- !

Item was removed:
- ----- Method: RioLocalFileSystem>>tempDirectory (in category 'executive actions') -----
- tempDirectory
- 
-  	^ self rioClass new: '/tmp'!

Item was removed:
- RioLocalFileSystem subclass: #RioLocalCaseInsensitiveFileSystem
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Rio-Kernel'!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>drive (in category 'accessing') -----
- drive 
- 
- 	^ self rootString first: 2!

Item was removed:
- ----- Method: RioLocalFileSystem class>>initialize (in category 'class initialization') -----
- initialize
- 
- 	Smalltalk addToStartUpList: self after: Delay.
- 	RioLocalDosFileSystem initializeVolumes.
- 	Current := self newForThisPlatform.
- 	Current initializeDefault.
- 	!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>initializeDefault (in category 'as yet unclassified') -----
- initializeDefault
-   
- 	self setRootString: (self primImagePath first: 3);
- 		setDefault: self getDefaultDirectory.
- 
- 	Volumes add: self.!

Item was removed:
- ----- Method: RioLocalFileSystem class>>platform (in category 'image start up ') -----
- platform
- 
- 	^ SmalltalkImage current platformName asLegalSelector capitalized!

Item was removed:
- ----- Method: RioLocalFileSystem>>printId (in category 'printing') -----
- printId
- 
- 	^ rootString!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>isRoot: (in category 'as yet unclassified') -----
- isRoot: aRioOrString
- 
- 	aRioOrString value size = self rootString size ifTrue: [ ^ super isRoot: aRioOrString ].
- 	
- 	^ (aRioOrString value, self pathDelimiter) = self rootString!

Item was removed:
- ----- Method: RioLocalFileSystem>>getDefaultDirectory (in category 'executive actions') -----
- getDefaultDirectory
- 
- 	^ (Preferences startInUntrustedDirectory 
- 					ifTrue: [ self untrustedDirectory mkdir ]
-  					ifFalse: [ self getImageDirectory ] )!

Item was removed:
- ----- Method: RioLocalFileSystem class>>maxFileNameLengthOnWin32 (in category 'image start up ') -----
- maxFileNameLengthOnWin32
- 
- 	^ 255!

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

Item was removed:
- ----- Method: RioLocalFileSystem>>errorMustBeInSameFileSystem: (in category 'errors') -----
- errorMustBeInSameFileSystem: aDirectory
- 
- 	^ self error: 'Must be in same file system', aDirectory, ',', self printString!

Item was removed:
- ----- Method: RioLocalFileSystem>>primDeleteFileNamed: (in category 'primitives') -----
- primDeleteFileNamed: aFileName
- 	"Delete the file of the given name. Return self if the primitive succeeds, nil otherwise."
- 
- 	<primitive: 'primitiveFileDelete' module: 'FilePlugin'>
- 	^ nil
- !

Item was removed:
- ----- Method: RioLocalFileSystem>>createDirectory: (in category 'executive actions') -----
- createDirectory: aRio
- 	 
- 	^ self primCreateDirectory: aRio asVmPathName  !

Item was removed:
- ----- Method: RioLocalFileSystem>>primDeleteDirectory: (in category 'primitives') -----
- primDeleteDirectory: fullPath
- 	"Delete the directory named by the given path. Raise an error if the path is bad or if a directory by that name does not exist."
- 
-  	<primitive: 'primitiveDirectoryDelete' module: 'FilePlugin'>
- 	^ self errorUnableToDeleteDir: fullPath
- !

Item was removed:
- ----- Method: RioLocalDosFileSystem>>pathDelimiterChar (in category 'as yet unclassified') -----
- pathDelimiterChar
-  
- 	^ $\
- !

Item was removed:
- ----- Method: RioLocalFileSystem>>getImageDirectory (in category 'executive actions') -----
- getImageDirectory
- 
-  	^ (self rioClass new: self primImagePath) parent !

Item was removed:
- ----- Method: RioLocalFileSystem>>rootString (in category 'accessing') -----
- rootString
- 
- 	^ rootString!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>getTempDirectory (in category 'as yet unclassified') -----
- getTempDirectory
- 
-  	^ self rioClass new: 'C:\WINDOWS\TEMP\'!

Item was removed:
- ----- Method: RioLocalFileSystem class>>startUp: (in category 'image start up ') -----
- startUp: resuming
- 	
-  	resuming ifFalse: [ ^self ].
- 	 		
- 	self performStartUpMigration.!

Item was removed:
- ----- Method: RioLocalFileSystem class>>maxFileNameLengthOnMacOS (in category 'image start up ') -----
- maxFileNameLengthOnMacOS
- 
- 	^ 31!

Item was removed:
- ----- Method: RioLocalFileSystem class>>newForRiscOS (in category 'image start up ') -----
- newForRiscOS
- 
- 	^ RioLocalFileSystem new!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>executiveForVolume: (in category 'accessing') -----
- executiveForVolume: requestedRoot
-  
- 	^ Volumes 
- 		detect: [ :i | i isRoot: requestedRoot ] 
- 		ifNone: [ Volumes add: (self class basicNew setRootString: requestedRoot; setDefault: nil; yourself) ]!

Item was removed:
- ----- Method: RioLocalFileSystem>>setRootString: (in category 'executive actions') -----
- setRootString: aString  
- 	rootString := aString.
- 	 !

Item was removed:
- ----- Method: RioLocalFileSystem>>retryWithGC:until:forFileNamed: (in category 'utilities') -----
- retryWithGC: execBlock until: okBlock forFileNamed: aRio
- 
-     ^ StandardFileStream 
- 		retryWithGC: execBlock
- 		until: okBlock
- 		forFileNamed: aRio!

Item was removed:
- ----- Method: RioLocalDosFileSystem class>>initializeVolumes (in category 'as yet unclassified') -----
- initializeVolumes 
- 	
- 	Volumes := Set new !

Item was removed:
- ----- Method: RioLocalFileSystem class>>newForWin32 (in category 'image start up ') -----
- newForWin32
- 
- 	^ RioLocalDosFileSystem new!

Item was removed:
- ----- Method: RioLocalFileSystem>>initializeDefault (in category 'executive actions') -----
- initializeDefault
- 
- 	self setRootString: self pathDelimiter;
- 		setDefault: self getDefaultDirectory!

Item was removed:
- ----- Method: RioLocalFileSystem>>linearRelativeTo: (in category 'executive actions') -----
- linearRelativeTo: aDirectory
- 
- 	self ~= aDirectory executive ifTrue: [ ^ self errorMustBeInSameFileSystem: aDirectory ].
- 	
- 	^ self root!

Item was removed:
- ----- Method: RioLocalFileSystem class>>current (in category 'accessing current') -----
- current
- 
- 	^ Test ifNil: [ Current ]
-  	
- !

Item was removed:
- ----- Method: RioLocalFileSystem>>setDefault: (in category 'executive actions') -----
- setDefault: d
-  
- 	defaultDirectory := d!

Item was removed:
- ----- Method: RioLocalFileSystem>>migrateFromLocalDosFileSystem: (in category 'fs migration') -----
- migrateFromLocalDosFileSystem: nfs
- 
-   "could do something here"
- 
-  ^ self !

Item was removed:
- ----- Method: RioLocalDosFileSystem>>driveLetter (in category 'accessing') -----
- driveLetter
- 
- 	^ self rootString first!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>migrateFromLocalFileSystem: (in category 'fs migration') -----
- migrateFromLocalFileSystem: nfs
- 
-  ^ self  !

Item was removed:
- ----- Method: RioLocalFileSystem>>getMacFileTypeAndCreator: (in category 'executive actions') -----
- getMacFileTypeAndCreator: aRio 
- 
- 	| results typeString creatorString |
- 	"get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. Does nothing on other platforms (where the underlying primitive is a noop)."
- 	"FileDirectory default getMacFileNamed: 'foo'"
- 
- 	typeString := ByteArray new: 4 withAll: ($? asInteger). 
- 	creatorString := ByteArray new: 4 withAll: ($? asInteger).
- 	[self primGetMacFileNamed: aRio asVmPathName
- 		type: typeString
- 		creator: creatorString.] ensure: 
- 		[typeString := typeString asString. 
- 		creatorString := creatorString asString].
- 	results := Array with: typeString convertFromSystemString with: creatorString convertFromSystemString.
- 	^results
- !

Item was removed:
- ----- Method: RioLocalFileSystem>>isDirectory: (in category 'executive actions') -----
- isDirectory: aRio
-  
- 	^ #badDirectoryPath ~= (self primLookupEntryIn: aRio full value index: 1)
- 	 !

Item was removed:
- ----- Method: RioLocalFileSystem>>errorUnableToDeleteDir: (in category 'errors') -----
- errorUnableToDeleteDir: fullPath
- 
- 	| entries |
- 	
- 	entries := fullPath asRio entries.
- 		
- 	^ self error: 'unable to delete directory: ', fullPath, ((entries size >0) ifTrue: [' (not empty)'] ifFalse: ['']).
- !

Item was removed:
- ----- Method: RioLocalFileSystem class>>maxFileNameLengthOnDOS (in category 'image start up ') -----
- maxFileNameLengthOnDOS
- 
- 	^ 8!

Item was removed:
- ----- Method: RioLocalFileSystem>>primImagePath (in category 'primitives') -----
- primImagePath
- 	"Answer the full path name for the current image."
- 	"self new primImagePath"
- 
- 	<primitive: 121>
- 	self primitiveFailed!

Item was removed:
- ----- Method: RioLocalCaseInsensitiveFileSystem>>hashFor: (in category 'case-sensitivity') -----
- hashFor: aRio
- 	
- 	^ aRio value asLowercase hash!

Item was removed:
- ----- Method: RioLocalFileSystem>>set:macType:creator: (in category 'executive actions') -----
- set: aRio macType: 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."
- 	 
-  	self primSetMacFileNamed: aRio asVmPathName
- 		type: typeString convertToSystemString
- 		creator: creatorString convertToSystemString.!

Item was removed:
- ----- Method: RioLocalFileSystem>>deleteFile: (in category 'executive actions') -----
- deleteFile: aRio
- 	
- 	"Delete the file of the given name if it exists.
- 	If the first deletion attempt fails do a GC to force finalization of any lost references. ar 3/21/98 17:53"
- 		 
- 	self retryWithGC: [
- 		self primDeleteFileNamed: aRio asVmPathName ]
- 		until:[:result| result notNil]
- 		forFileNamed: aRio.
- 		
- 	aRio statIsNowInvalid!

Item was removed:
- ----- Method: RioLocalFileSystem class>>maxFileNameLengthOnUnix (in category 'image start up ') -----
- maxFileNameLengthOnUnix
- 
- ^ 255!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>fullFor: (in category 'as yet unclassified') -----
- fullFor: aRio
- 
- 	"the absolute path of this rio (with the current volume drive prepended), or if relative 
- 	combine with #defaultDirectory to obtain the full path"
- 	
- 	aRio value isEmpty ifTrue: [ ^ self defaultDirectory ].
- 	
- 	(self isFull: aRio) ifTrue: [ ^ aRio ].
- 	
- 	"if we are an absolute path, prepend the volume"
- 	aRio value first = self pathDelimiterChar ifTrue: [ ^ aRio newFrom: (self drive, aRio value) ].
- 
- 	^ aRio newFrom: (self defaultDirectory value, self pathDelimiter, aRio value)!

Item was removed:
- ----- Method: RioExecutive>>makeNewRioOfClass:fromString: (in category 'as yet unclassified') -----
- makeNewRioOfClass: aRioClass fromString: aString
- 
- 	^ aRioClass executive: self value: aString !

Item was removed:
- ----- Method: RioLocalFileSystem>>maxFileNameLength (in category 'misc') -----
- maxFileNameLength
- 
-  ^ (self class respondsTo: #maxFileNameLength) 
- 	ifTrue: [ self class maxFileNameLength ]
- 	ifFalse: [ self class perform: ('maxFileNameLengthOn', self class platform) asSymbol ]!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>importValue: (in category 'as yet unclassified') -----
- importValue: aPath
- 
- 	^ super importValue: (aPath copy replaceAll: $/ with: $\).!

Item was removed:
- ----- Method: RioLocalFileSystem>>primCreateDirectory: (in category 'primitives') -----
- primCreateDirectory: fullPath
- 	"Create a directory named by the given path. Fail if the path is bad or if a file or directory by that name already exists."
- 
-  	<primitive: 'primitiveDirectoryCreate' module: 'FilePlugin'>
- 	self primitiveFailed!

Item was removed:
- ----- Method: RioLocalFileSystem class>>performStartUpMigration (in category 'image start up ') -----
- performStartUpMigration
-  	| old |
- 	
- 	old := self current.
- 	Current := self newForThisPlatform.
- 	Current initializeDefault.
- 
- 	old migrateFileSystemTo: Current!

Item was removed:
- RioLocalCaseInsensitiveFileSystem subclass: #RioLocalDosFileSystem
- 	instanceVariableNames: ''
- 	classVariableNames: 'Volumes'
- 	poolDictionaries: ''
- 	category: 'Rio-Kernel'!
- 
- !RioLocalDosFileSystem commentStamp: 'kph 4/17/2007 19:19' prior: 0!
- The initial idea was to model things properly as a file within a named volume, on unix there would be one executive for the whole system. On dos there would be one executive per volume.!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>migrateToLocalDosFileSystem: (in category 'fs migration') -----
- migrateToLocalDosFileSystem: old
- 
-  ^ self!

Item was removed:
- ----- Method: RioLocalFileSystem class>>newForMacOS (in category 'image start up ') -----
- newForMacOS
- 
- 	^ RioLocalCaseInsensitiveFileSystem new!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>makeNewRioOfClass:fromString: (in category 'fs migration') -----
- makeNewRioOfClass: aRioClass fromString: aString
- 
- 	| rioDrive exec str |
- 	
- 	str := aString.
- 	exec := self.
- 	
- 	(aString size > 1) ifTrue: [  
- 
- 		rioDrive := driveRoot.
- 		(str second = $:) ifTrue: [ rioDrive := (str first: 2) , self pathDelimiter ].
- 		
- 		rioDrive ~= driveRoot ifTrue: [ exec := self executiveForVolume: rioDrive ].
- 
- 	].
- 
- 	^ aRioClass executive: exec value: str!

Item was removed:
- ----- Method: RioLocalFileSystem class>>testEnd (in category 'image start up ') -----
- testEnd
- 
- 	Test := nil!

Item was removed:
- ----- Method: RioLocalFileSystem class>>newForDOS (in category 'image start up ') -----
- newForDOS
- 
- 	^ RioLocalDosFileSystem new!

Item was removed:
- ----- Method: RioLocalFileSystem>>startAt:recursively:select:into: (in category 'executive actions') -----
- startAt: rioOrString recursively: beRecursive select: selectBlock into: results 
- 
- 	"Return a collection of rio's selected by passing
- 	the directoryEntry array to the selectBlock.
- 	
- 	The KernelRio implemetation of setStatFromEntryArray: 
- 	does not populate these rios with stat data.
- 	Rio's more verbose implementation does.
- 
- 	This can be called with startAt: aString, but if so beRecursive must be false.
- 		
- 	See primLookupEntryIn:index: for further details."
- 
- 	| index entryArray entryRio |
- 
- 	index := 1.
- 
- 	[ (entryArray := self primLookupEntryIn: rioOrString asVmPathName index: index) notNil ] 
- 		whileTrue: [
- 			#badDirectoryPath = entryArray ifTrue: [
- 				^ results "(InvalidDirectoryError pathName: rioOrString value) signal" ].
- 
- 				(entryRio := rioOrString / (entryArray at: 1)) 
- 									setStatFromDir: rioOrString andEntryArray:entryArray.
- 
- 				(selectBlock value: entryRio) ifTrue: [ results add: entryRio ].	
- 						
- 				(beRecursive and: [ entryArray at: 4]) 
- 					ifTrue: [ 
- 						self 
- 							startAt: entryRio
- 							recursively: beRecursive 
- 							select: selectBlock
- 							into: results   
- 					].	
- 			index := index + 1
- 		].
- 	
- 	^ results!

Item was removed:
- ----- Method: RioLocalFileSystem>>printOn: (in category 'printing') -----
- printOn: str
- 
- 	super printOn: str.
- 	str nextPut: $(; nextPutAll: self printId; nextPut: $).!

Item was removed:
- ----- Method: RioLocalFileSystem class>>testFileSystem: (in category 'image start up ') -----
- testFileSystem: fs
- 
- 	^ Test := fs!

Item was removed:
- ----- Method: RioLocalFileSystem>>deleteDirectory: (in category 'executive actions') -----
- deleteDirectory: aRio
- 	 
- 	self primDeleteDirectory: aRio asVmPathName.
- 	aRio statIsNowInvalid!

Item was removed:
- ----- Method: RioLocalDosFileSystem>>migrateFromLocalDosFileSystem: (in category 'fs migration todo') -----
- migrateFromLocalDosFileSystem: nfs
- 
-   "could do something here"
- 
-  ^ nfs !

Item was removed:
- ----- Method: RioLocalFileSystem class>>newForUnix (in category 'image start up ') -----
- newForUnix
- 
- 	^ RioLocalFileSystem new!

Item was removed:
- ----- Method: RioLocalFileSystem>>primPathNameDelimiter (in category 'primitives') -----
- primPathNameDelimiter
- 	"Return the path delimiter for the underlying platform's file system."
- 
-  	<primitive: 'primitiveDirectoryDelimitor' module: 'FilePlugin'>
- 	self primitiveFailed
- !

Item was removed:
- ----- Method: RioLocalFileSystem class>>newForThisPlatform (in category 'image start up ') -----
- newForThisPlatform
- 
- 	^ self perform: ('newFor', self platform) asSymbol!

Item was removed:
- ----- Method: RioLocalFileSystem>>primVmPath (in category 'primitives') -----
- primVmPath
- 	"Answer the path for the directory containing the Smalltalk virtual machine. Return the 	empty string if this primitive is not implemented."
- 	"Rio primVmPath"
- 
- 	<primitive: 142>
- 	^ ''!

Item was removed:
- ----- Method: RioLocalFileSystem>>primLookupEntryIn:index: (in category 'primitives') -----
- primLookupEntryIn: fullPath index: index
- 
- 	"Look up the index-th entry of the directory with the given fully-qualified path (i.e., starting from the root of the file hierarchy) and return an array containing:
- 
- 	<name> 
- 	<creationTime in seconds since squeak epoch> 
- 	<modificationTime>
- 	<dirFlag (dir is true)>
- 	<fileSize in bytes>
- 
- 	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.)
- 
- 	Returns nil when index is past the end of the directory. 
- 	Fails if the given path is bad."
- 
-  	<primitive: 'primitiveDirectoryLookup' module: 'FilePlugin'>
- 	^ #badDirectoryPath
- 
- !



More information about the Packages mailing list