[Pkg] The Trunk: Files-bf.142.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Dec 8 00:40:31 UTC 2014


Bert Freudenberg uploaded a new version of Files to project The Trunk:
http://source.squeak.org/trunk/Files-bf.142.mcz

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

Name: Files-bf.142
Author: bf
Time: 8 December 2014, 1:40:15.966 am
UUID: a1712c19-2d55-4680-a320-928c62f76cce
Ancestors: Files-ul.141

Restore timestamps lost in assignment conversion.

=============== Diff against Files-ul.141 ===============

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

Item was changed:
  ----- Method: AsyncFile>>test:fileName: (in category 'as yet unclassified') -----
  test: byteCount fileName: fileName
  	"AsyncFile new test: 10000 fileName: 'testData'"
  
  	| buf1 buf2 bytesWritten bytesRead |
  	buf1 := String new: byteCount withAll: $x.
  	buf2 := String new: byteCount.
  	self open: ( FileDirectory default fullNameFor: fileName) forWrite: true.
  	self primWriteStart: fileHandle
  		fPosition: 0
  		fromBuffer: buf1
  		at: 1
  		count: byteCount.
  	semaphore wait.
  	bytesWritten := self primWriteResult: fileHandle.
  	self close.
  	
  	self open: ( FileDirectory default fullNameFor: fileName) forWrite: false.
  	self primReadStart: fileHandle fPosition: 0 count: byteCount.
  	semaphore wait.
  	bytesRead :=
  		self primReadResult: fileHandle
  			intoBuffer: buf2
  			at: 1
  			count: byteCount.
  	self close.
  
  	buf1 = buf2 ifFalse: [self error: 'buffers do not match'].
  	^ 'wrote ', bytesWritten printString, ' bytes; ',
  	   'read ', bytesRead printString, ' bytes'
  !

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

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

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

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

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

Item was changed:
  ----- Method: CrLfFileStream>>next: (in category 'access') -----
  next: n
  
  		| string peekChar |
  		string := super next: n.
  		string size = 0 ifTrue: [ ^string ].
  		self isBinary ifTrue: [ ^string ].
  
  		"if we just read a CR, and the next character is an LF, then skip the LF"
  		( string last = Character cr ) ifTrue: [
  			peekChar := super next.		"super peek doesn't work because it relies on #next"
  			peekChar ~= Character lf ifTrue: [
  				super position: (super position - 1) ]. ].
   
  		string := string withSqueakLineEndings.
  
  		string size = n ifTrue: [ ^string ].
  
  		"string shrunk due to embedded crlfs; make up the difference"
  		^string, (self next: n - string size)!

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

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

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

Item was changed:
  ----- Method: DirectoryEntry>>convertFromSystemName (in category 'multilingual system') -----
  convertFromSystemName
  
  	name := (FilePath pathName: name isEncoded: true) asSqueakPathName!

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

Item was changed:
  ----- Method: DosFileDirectory>>driveName (in category 'path access') -----
  driveName
  
     "return a possible drive letter and colon at the start of a Path name, empty string otherwise"
  
     | firstTwoChars |
  
     ( pathName asSqueakPathName size >= 2 ) ifTrue: [
        firstTwoChars := (pathName asSqueakPathName copyFrom: 1 to: 2).
        (self class isDrive: firstTwoChars) ifTrue: [^firstTwoChars]
     ].
     ^''!

Item was changed:
  ----- Method: FileDirectory class>>deleteFilePath: (in category 'create/delete file') -----
  deleteFilePath: fullPathToAFile
  	"Delete the file after finding its directory"
  
  	| dir |
  	dir := self on: (self dirPathFor: fullPathToAFile).
  	dir deleteFileNamed: (self localNameFor: fullPathToAFile).
  !

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

Item was changed:
  ----- Method: FileDirectory class>>forFileName: (in category 'instance creation') -----
  forFileName: aString
  
  	| path |
  	path := self dirPathFor: aString.
  	path isEmpty ifTrue: [^ self default].
  	^ self on: path
  !

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

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

Item was changed:
  ----- Method: FileDirectory class>>setDefaultDirectoryFrom: (in category 'system start up') -----
  setDefaultDirectoryFrom: imageName
  	"Initialize the default directory to the directory containing the Squeak image file. This method is called when the image starts up."
  
  	DirectoryClass := self activeDirectoryClass.
  	DefaultDirectory := self on: (FilePath pathName: (self dirPathFor: imageName) isEncoded: true) asSqueakPathName.
  !

Item was changed:
  ----- Method: FileDirectory class>>shutDown (in category 'system start up') -----
  shutDown
  
  	Smalltalk closeSourceFiles.
  !

Item was changed:
  ----- Method: FileDirectory class>>splitName:to: (in category 'name utilities') -----
  splitName: fullName to: pathAndNameBlock
  	"Take the file name and convert it to the path name of a directory and a local file name within that directory. FileName must be of the form: <dirPath><delimiter><localName>, where <dirPath><delimiter> is optional. The <dirPath> part may contain delimiters."
  
  	| delimiter i dirName localName |
  	delimiter := self pathNameDelimiter.
  	(i := fullName findLast: [:c | c = delimiter]) = 0
  		ifTrue:
  			[dirName := String new.
  			localName := fullName]
  		ifFalse:
  			[dirName := fullName copyFrom: 1 to: (i - 1 max: 1).
  			localName := fullName copyFrom: i + 1 to: fullName size].
  
  	^ pathAndNameBlock value: dirName value: localName!

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

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

Item was changed:
  ----- Method: FileDirectory>>copyFileNamed:toFileNamed: (in category 'file operations') -----
  copyFileNamed: fileName1 toFileNamed: fileName2
  	"Copy the contents of the existing file with the first name into a new file with the second name. Both files are assumed to be in this directory."
  	"FileDirectory default copyFileNamed: 'todo.txt' toFileNamed: 'todocopy.txt'"
  
  	| file1 file2 |
  	file1 := (self readOnlyFileNamed: fileName1) binary.
  	file2 := (self newFileNamed: fileName2) binary.
  	self copyFile: file1 toFile: file2.
  	file1 close.
  	file2 close.
  !

Item was changed:
  ----- Method: FileDirectory>>copyFileWithoutOverwriteConfirmationNamed:toFileNamed: (in category 'file operations') -----
  copyFileWithoutOverwriteConfirmationNamed: fileName1 toFileNamed: fileName2
  	"Copy the contents of the existing file with the first name into a file with the second name (which may or may not exist). If the second file exists, force an overwrite without confirming.  Both files are assumed to be in this directory."
  	"FileDirectory default copyFileWithoutOverwriteConfirmationNamed: 'todo.txt' toFileNamed: 'todocopy.txt'"
  
  	| file1 file2 |
  	fileName1 = fileName2 ifTrue: [^ self].
  	file1 := (self readOnlyFileNamed: fileName1) binary.
  	file2 := (self forceNewFileNamed: fileName2) binary.
  	self copyFile: file1 toFile: file2.
  	file1 close.
  	file2 close.!

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

Item was changed:
  ----- Method: FileDirectory>>exists (in category 'testing') -----
  exists
  "Answer whether the directory exists"
  
  	| result |
  	result := self primLookupEntryIn: pathName asVmPathName index: 1.
  	^ result ~= #badDirectoryPath
  !

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

Item was changed:
  ----- Method: FileDirectory>>fileOrDirectoryExists: (in category 'file operations') -----
  fileOrDirectoryExists: filenameOrPath
  	"Answer true if either a file or a directory file of the given name exists. The given name may be either a full path name or a local name within this directory."
  	"FileDirectory default fileOrDirectoryExists: Smalltalk sourcesName"
  
  	| fName dir |
  	DirectoryClass splitName: filenameOrPath to:
  		[:filePath :name |
  			fName := name.
  			filePath isEmpty
  				ifTrue: [dir := self]
  				ifFalse: [dir := FileDirectory on: filePath]].
  
  	^ (dir includesKey: fName) or: [ fName = '' and:[ dir entries size > 1]]!

Item was changed:
  ----- Method: FileDirectory>>filesContaining:caseSensitive: (in category 'searching') -----
  filesContaining: searchString caseSensitive: aBoolean
  	| aList |
  	"Search the contents of all files in the receiver and its subdirectories for the search string.  Return a list of paths found.  Make the search case sensitive if aBoolean is true."
  
  	aList := OrderedCollection new.
  	self withAllFilesDo: [:stream |
  			(stream contentsOfEntireFile includesSubstring: searchString caseSensitive: aBoolean)
  				ifTrue:	[aList add: stream name]]
  		andDirectoriesDo: [:d | d pathName].
  	^ aList
  
  "FileDirectory default filesContaining: 'includesSubstring:'  caseSensitive: true"!

Item was changed:
  ----- Method: FileDirectory>>fullNameFor: (in category 'file name utilities') -----
  fullNameFor: fileName
  	"Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name."
  	"Details: Note that path relative to a directory, such as '../../foo' are disallowed by this algorithm.  Also note that this method is tolerent of a nil argument -- is simply returns nil in this case."
  
  	| correctedLocalName prefix |
  	fileName ifNil: [^ nil].
  	DirectoryClass splitName: fileName to:
  		[:filePath :localName |
  			correctedLocalName := localName isEmpty 
  				ifFalse: [self checkName: localName fixErrors: true]
  				ifTrue: [localName].
  			prefix := self fullPathFor: filePath].
  	prefix isEmpty
  		ifTrue: [^correctedLocalName].
  	prefix last = self pathNameDelimiter
  		ifTrue:[^ prefix, correctedLocalName]
  		ifFalse:[^ prefix, self slash, correctedLocalName]!

Item was changed:
  ----- Method: FileDirectory>>fullNamesOfAllFilesInSubtree (in category 'enumeration') -----
  fullNamesOfAllFilesInSubtree
  	"Answer a collection containing the full names of all the files in the subtree of the file system whose root is this directory."
  
  	| result todo dir |
  	result := OrderedCollection new: 100.
  	todo := OrderedCollection with: self.
  	[todo size > 0] whileTrue: [
  		dir := todo removeFirst.
  		dir fileNames do: [:n | result add: (dir fullNameFor: n)].
  		dir directoryNames do: [:n | todo add: (dir directoryNamed: n)]].
  	^ result asArray
  !

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

Item was changed:
  ----- Method: FileDirectory>>lastNameFor:extension: (in category 'file name utilities') -----
  lastNameFor: baseFileName extension: extension
  	"Assumes a file name includes a version number encoded as '.' followed by digits 
  	preceding the file extension.  Increment the version number and answer the new file name.
  	If a version number is not found, set the version to 1 and answer a new file name"
  
  	| files splits |
  
  	files := self fileNamesMatching: (baseFileName,'*', self class dot, extension).
  	splits := files 
  			collect: [:file | self splitNameVersionExtensionFor: file]
  			thenSelect: [:split | (split at: 1) = baseFileName].
  	splits := splits asSortedCollection: [:a :b | (a at: 2) < (b at: 2)].
  	^splits isEmpty 
  			ifTrue: [nil]
  			ifFalse: [(baseFileName, '.', (splits last at: 2) asString, self class dot, extension) asFileName]!

Item was changed:
  ----- Method: FileDirectory>>nextNameFor:extension: (in category 'file name utilities') -----
  nextNameFor: baseFileName extension: extension
  	"Assumes a file name includes a version number encoded as '.' followed by digits 
  	preceding the file extension.  Increment the version number and answer the new file name.
  	If a version number is not found, set the version to 1 and answer a new file name"
  
  	| files splits version |
  
  	files := self fileNamesMatching: (baseFileName,'*', self class dot, extension).
  	splits := files 
  			collect: [:file | self splitNameVersionExtensionFor: file]
  			thenSelect: [:split | (split at: 1) = baseFileName].
  	splits := splits asSortedCollection: [:a :b | (a at: 2) < (b at: 2)].
  	splits isEmpty 
  			ifTrue: [version := 1]
  			ifFalse: [version := (splits last at: 2) + 1].
  	^ (baseFileName, '.', version asString, self class dot, extension) asFileName!

Item was changed:
  ----- Method: FileDirectory>>putFile:named: (in category 'file operations') -----
  putFile: file1 named: destinationFileName
  	"Copy the contents of the existing fileStream into the file destinationFileName in this directory.  fileStream can be anywhere in the fileSystem."
  
  	| file2 |
  	file1 binary.
  	(file2 := self newFileNamed: destinationFileName) ifNil: [^ false].
  	file2 binary.
  	self copyFile: file1 toFile: file2.
  	file1 close.
  	file2 close.
  	^ true
  !

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

Item was changed:
  ----- Method: FileDirectory>>setPathName: (in category 'private') -----
  setPathName: pathString
  
  	pathName := FilePath pathName: pathString.
  !

Item was changed:
  ----- Method: FileDirectory>>splitNameVersionExtensionFor: (in category 'file name utilities') -----
  splitNameVersionExtensionFor: fileName
  	" answer an array with the root name, version # and extension.
  	See comment in nextSequentialNameFor: for more details"
  
  	| baseName version extension i j |
  
  	baseName := self class baseNameFor: fileName.
  	extension := self class extensionFor: fileName.
  	i := j := baseName findLast: [:c | c isDigit not].
  	i = 0
  		ifTrue: [version := 0]
  		ifFalse:
  			[(baseName at: i) = $.
  				ifTrue:
  					[version := (baseName copyFrom: i+1 to: baseName size) asNumber.
  					j := j - 1]
  				ifFalse: [version := 0].
  			baseName := baseName copyFrom: 1 to: j].
  	^ Array with: baseName with: version with: extension!

Item was changed:
  ----- Method: FileDirectory>>upLoadProject:named:resourceUrl:retry: (in category 'file operations') -----
  upLoadProject: projectFile named: destinationFileName resourceUrl: resUrl retry: aBool
  	"Copy the contents of the existing fileStream into the file destinationFileName in this directory.  fileStream can be anywhere in the fileSystem.  No retrying for local file systems."
  
  	| result |
  	result := self putFile: projectFile named: destinationFileName.
  	[self
  		setMacFileNamed: destinationFileName
  		type: 'SOBJ'
  		creator: 'FAST']
  		on: Error
  		do: [ "ignore" ].
  	^result!

Item was changed:
  ----- Method: FileDirectory>>withAllFilesDo:andDirectoriesDo: (in category 'searching') -----
  withAllFilesDo: fileStreamBlock andDirectoriesDo: directoryBlock
  
  	"For the receiver and all it's subdirectories evaluate directoryBlock.
  	For a read only file stream on each file within the receiver 
  	and it's subdirectories evaluate fileStreamBlock."
  
  	| todo dir |
  
  	todo := OrderedCollection with: self.
  	[todo size > 0] whileTrue: [
  		dir := todo removeFirst.
  		directoryBlock value: dir.
  		dir fileNames do: [: n | 
  			fileStreamBlock value: 
  				(FileStream readOnlyFileNamed: (dir fullNameFor: n))].
  		dir directoryNames do: [: n | 
  			todo add: (dir directoryNamed: n)]]
  
  !

Item was changed:
  ----- Method: FileDirectory>>withAllSubdirectoriesCollect: (in category 'enumeration') -----
  withAllSubdirectoriesCollect: aBlock
  	"Evaluate aBlock with each of the directories in the subtree of the file system whose root is this directory.
  	Answer the results of these evaluations."
  
  	| result todo dir |
  	result := OrderedCollection new: 100.
  	todo := OrderedCollection with: self.
  	[todo size > 0] whileTrue: [
  		dir := todo removeFirst.
  		result add: (aBlock value: dir).
  		dir directoryNames do: [:n | todo add: (dir directoryNamed: n)]].
  	^ result
  !

Item was changed:
  ----- Method: FilePath>>convertToCurrentVersion:refStream: (in category 'file in/out') -----
  convertToCurrentVersion: varDict refStream: smartRefStrm
  	"If we're reading in an old version with a system path instance variable, convert it to a vm path."
  
  	varDict at: 'systemPathName' ifPresent: [ :x | 
  		vmPathName := x.
  	].
  	^super convertToCurrentVersion: varDict refStream: smartRefStrm.
  !

Item was changed:
  ----- Method: FilePath>>copySystemToVm (in category 'file in/out') -----
  copySystemToVm
  
  	(self class instVarNames includes: 'systemPathName') ifTrue: [
  		vmPathName := self instVarNamed: 'systemPathName'.
  	].
  
  !

Item was changed:
  ----- Method: FilePath>>pathName:isEncoded: (in category 'conversion') -----
  pathName: p isEncoded: isEncoded
  
  	converter := LanguageEnvironment defaultFileNameConverter.
  	isEncoded ifTrue: [
  		squeakPathName := p convertFromWithConverter: converter.
  		vmPathName := p.
  	] ifFalse: [
  		squeakPathName := p isOctetString ifTrue: [p asOctetString] ifFalse: [p].
  		vmPathName := squeakPathName convertToWithConverter: converter.
  	].
  !

Item was changed:
  ----- Method: FileStream class>>oldFileOrNoneNamed: (in category 'instance creation') -----
  oldFileOrNoneNamed: fileName
  	"If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil."
  
  	| fullName |
  	fullName := self fullName: fileName.
  	(self concreteStream isAFileNamed: fullName)
  		ifTrue: [^ self concreteStream readOnlyFileNamed: fullName]
  		ifFalse: [^ nil].
  !

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

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

Item was changed:
  ----- Method: HtmlFileStream class>>initialize (in category 'class initialization') -----
  initialize   "HtmlFileStream initialize"
  	TabThing := '&nbsp;&nbsp;&nbsp;'
  
  "I took Ted's suggestion to use &nbsp, which works far better for the HTML.  Style sheets provide an alternative, possibly better, solution since they permit finer-grain control of the HTML formatting, and thus would permit capturing the style in which text was originally rendered.  Internal tabbings would still get lost. 1/1/99 acg."!

Item was changed:
  ----- Method: HtmlFileStream class>>newFrom: (in category 'instance creation') -----
  newFrom: aFileStream
  	"Answer an HtmlFileStream that is 'like' aFileStream.  As a side-effect, the surviving fileStream answered by this method replaces aFileStream on the finalization registry. 1/6/99 acg"
  
  	|inst|
  	inst := super newFrom: aFileStream.
  	StandardFileStream unregister: aFileStream.
  	HtmlFileStream register: inst.
  	inst detectLineEndConvention.
  	^inst
  !

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

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

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

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

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

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

Item was changed:
  ----- Method: MacFileDirectory>>fullNameFor: (in category 'as yet unclassified') -----
  fullNameFor: fileName
  	"Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name."
  	"Details: Note that path relative to a directory, such as '../../foo' are disallowed by this algorithm.  Also note that this method is tolerent of a nil argument -- is simply returns nil in this case."
  	"Fix by hmm: for a file in the root directory of a volume on MacOS, the filePath (name of the directory) is not  recognizable as an absolute path anymore (it has no delimiters). Therefore, the original fileName is tested for absoluteness, and the filePath is only made absolute if the original fileName was not absolute"
  
  	| correctedLocalName prefix |
  	fileName isEmptyOrNil ifTrue: [^ fileName].
  	DirectoryClass splitName: fileName to:
  		[:filePath :localName |
  			correctedLocalName := localName isEmpty 
  				ifFalse: [self checkName: localName fixErrors: true]
  				ifTrue: [localName].
  			prefix := (DirectoryClass isAbsolute: fileName)
  						ifTrue: [filePath]
  						ifFalse: [self fullPathFor: filePath]].
  	prefix isEmpty
  		ifTrue: [^correctedLocalName].
  	prefix last = self pathNameDelimiter
  		ifTrue:[^ prefix, correctedLocalName]
  		ifFalse:[^ prefix, self slash, correctedLocalName]!

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

Item was changed:
  ----- Method: RemoteString>>fileStream (in category 'accessing') -----
  fileStream 
  	"Answer the file stream with position set at the beginning of my string"
  
  	| theFile |
  	(sourceFileNumber == nil or: [(SourceFiles at: sourceFileNumber) == nil]) ifTrue: [^ nil].
  	theFile := SourceFiles at: sourceFileNumber.
  	theFile position: filePositionHi.
  	^ theFile!

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

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

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

Item was changed:
  ----- Method: StandardFileStream class>>isAFileNamed: (in category 'file creation') -----
  isAFileNamed: fileName
  	"Answer true if a file of the given name exists."
  
  	| f |
  	f := self new open: fileName forWrite: false.
  	f ifNil: [^ false].
  	f close.
  	^ true
  !

Item was changed:
  ----- Method: StandardFileStream class>>newFileNamed: (in category 'file creation') -----
  newFileNamed: fileName
   	"Create a new file with the given name, and answer a stream opened for writing on that file. If the file already exists, ask the user what to do."
  
  	| fullName |
  	fullName := self fullName: fileName.
  
  	^(self isAFileNamed: fullName)
  		ifTrue: ["file already exists:"
  			(FileExistsException fileName: fullName fileClass: self) signal]
  		ifFalse: [self new open: fullName forWrite: true]
  
  !

Item was changed:
  ----- Method: StandardFileStream class>>oldFileNamed: (in category 'file creation') -----
  oldFileNamed: fileName
  	"Open an existing file with the given name for reading and writing. If the name has no directory part, then the file will be created in the default directory. If the file already exists, its prior contents may be modified or replaced, but the file will not be truncated on close."
  
  	| fullName |
  	fullName := self fullName: fileName.
  
  	^(self isAFileNamed: fullName)
  		ifTrue: [self new open: fullName forWrite: true]
  		ifFalse: ["File does not exist..."
  			(FileDoesNotExistException fileName: fullName) signal]!

Item was changed:
  ----- Method: StandardFileStream>>findStringFromEnd: (in category 'read, write, position') -----
  findStringFromEnd: string
  	"Fast version to find a String in a file starting from the end.
  	Returns the position and also sets the position there.
  	If string is not found 0 is returned and position is unchanged."
  
  	| pos buffer count oldPos |
  	oldPos := self position.
  	self setToEnd.
  	pos := self position.
  	[ pos := ((pos - 2000 + string size) max: 0).  "the [+ string size] allows for the case where the end of the search string is at the beginning of the current buffer"
  	self position: pos.
  	buffer := self next: 2000.
  	(count := buffer findString: string) > 0
  		ifTrue: ["Found the string part way into buffer"
  			self position: pos.
  			self next: count-1.  "use next instead of position:, so that CrLfFileStream can do its magic if it is being used"
  			^self position].
  	pos = 0] whileFalse.
  	"Never found it, and hit beginning of file"
  	self position: oldPos.
  	^0!

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

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

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

Item was changed:
  ----- Method: StandardFileStream>>readOnly (in category 'properties-setting') -----
  readOnly
  	"Make this file read-only."
  
  	rwmode := false.
  !

Item was changed:
  ----- Method: StandardFileStream>>readWrite (in category 'properties-setting') -----
  readWrite
  	"Make this file writable."
  
  	rwmode := true.
  !

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

Item was changed:
  ----- Method: StandardSourceFileArray>>fileIndexFromSourcePointer: (in category 'sourcePointer conversion') -----
  fileIndexFromSourcePointer: anInteger
  	"Return the index of the source file which contains the source chunk addressed by anInteger"
  	"This implements the recent 32M source file algorithm"
  
  	| hi |
  	hi := anInteger // 16r1000000.
  	^hi < 3
  		ifTrue: [hi]
  		ifFalse: [hi - 2]!

Item was changed:
  ----- Method: StandardSourceFileArray>>filePositionFromSourcePointer: (in category 'sourcePointer conversion') -----
  filePositionFromSourcePointer: anInteger
  	"Return the position of the source chunk addressed by anInteger"
  	"This implements the recent 32M source file algorithm"
  
  	| hi lo |
  	hi := anInteger // 16r1000000.
  	lo := anInteger \\ 16r1000000.
  	^hi < 3
  		ifTrue: [lo]
  		ifFalse: [lo + 16r1000000]!

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

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

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

Item was changed:
  ----- Method: UnixFileDirectory>>setPathName: (in category 'private') -----
  setPathName: pathString
  	"Unix path names start with a leading delimiter character."
  
  	(pathString isEmpty or: [pathString first ~= self pathNameDelimiter])
  		ifTrue: [pathName := FilePath pathName: (self pathNameDelimiter asString, pathString)]
  		ifFalse: [pathName := FilePath pathName: pathString].
  !



More information about the Packages mailing list