The Trunk: Files-nice.63.mcz

Nicolas Cellier uploaded a new version of Files to project The Trunk:
http://source.squeak.org/trunk/Files-nice.63.mcz

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

Name: Files-nice.63
Author: nice
Time: 27 December 2009, 8:38:54 am
UUID: 551e20a5-4e60-452a-93eb-f84d1bc59eb5
Ancestors: Files-dtl.62

Cosmetic: move or remove a few temps inside closures

=============== Diff against Files-dtl.62 ===============

Item was changed:
  ----- Method: AcornFileDirectory>>checkName:fixErrors: (in category 'file name utilities') -----
  checkName: aFileName fixErrors: fixing
  "Check if the file name contains any invalid characters"
+ | fName hasBadChars correctedName |
- | fName hasBadChars correctedName newChar|
  fName := super checkName: aFileName fixErrors: fixing.
  correctedName := String streamContents:[:s|
  fName do:[:c|
+ | newChar |
  (newChar := LegalCharMap at: c asciiValue +1) ifNotNil:[s nextPut: newChar]]].
  hasBadChars := fName ~= correctedName.
  (hasBadChars and:[fixing not]) ifTrue:[^self error:'Invalid file name'].
  hasBadChars ifFalse:[^ fName].
  ^ correctedName!

Item was changed:
  ----- Method: FileDirectory class>>baseNameFor: (in category 'name utilities') -----
  baseNameFor: fileName
  "Return the given file name without its extension, if any. We have to remember that many (most?) OSs allow extension separators within directory names and so the leaf filename needs to be extracted, trimmed and rejoined. Yuck"
  "The test is
  FileDirectory baseNameFor: ((FileDirectory default directoryNamed: 'foo.bar') fullNameFor:'blim.blam')
  should end 'foo.bar/blim' (or as appropriate for your platform AND
  FileDirectory baseNameFor: ((FileDirectory default directoryNamed: 'foo.bar') fullNameFor:'blim')
  should be the same and NOT  'foo'
  Oh, and FileDirectory baseNameFor: 'foo.bar' should be 'foo' not '/foo' "
 
- | delim i leaf |
  self splitName: fileName to: [:path : fn|
+ | delim i leaf |
-
  delim := DirectoryClass extensionDelimiter.
  i := fn findLast: [:c | c = delim].
  leaf := i = 0
  ifTrue: [fn]
  ifFalse: [fn copyFrom: 1 to: i - 1].
  path isEmpty ifTrue:[^leaf].
  ^path, self slash, leaf]
  !

Item was changed:
  ----- Method: FileStream>>viewGZipContents (in category 'editing') -----
  viewGZipContents
  "View the contents of a gzipped file"
 
  | stringContents |
  self binary.
  stringContents := self contentsOfEntireFile.
+ stringContents := Cursor wait showWhile: [(GZipReadStream on: stringContents) upToEnd].
- Cursor wait showWhile: [stringContents := (GZipReadStream on: stringContents) upToEnd].
  stringContents := stringContents asString withSqueakLineEndings.
 
  Workspace new
  contents: stringContents;
  openLabel: 'Decompressed contents of: ', self localName!

Item was changed:
  ----- Method: StandardSourceFileArrayTest>>testChangesFileAddressRange (in category 'testing') -----
  testChangesFileAddressRange
  "Test file position to source pointer address translation for the changes file"
 
+ | sf a |
- | sf i p a a2 |
  sf := StandardSourceFileArray new.
+ (0 to: 16r1FFFFFF by: 811) do: [:e | | a2 i p |
- (0 to: 16r1FFFFFF by: 811) do: [:e |
  a := sf sourcePointerFromFileIndex: 2 andPosition: e.
  i := sf fileIndexFromSourcePointer: a.
  self assert: i == 2.
  p := sf filePositionFromSourcePointer: a.
  self assert: p = e.
  a2 := sf sourcePointerFromFileIndex: 2 andPosition: p.
  self assert: a2 = a].
  (0 to: 16rFFFFFF by: 811) do: [:e |
  a := sf sourcePointerFromFileIndex: 2 andPosition: e.
  self assert: (a between: 16r2000000 and: 16r2FFFFFF)].
  (16r1000000 to: 16r1FFFFFF by: 811) do: [:e |
  a := sf sourcePointerFromFileIndex: 2 andPosition: e.
  self assert: (a between: 16r4000000 and: 16r4FFFFFF)]
 
 
  !

Item was changed:
  ----- Method: StandardSourceFileArrayTest>>testAddressRange (in category 'testing') -----
  testAddressRange
  "Test source pointer to file position address translation across the full address range"
 
+ | sf |
- | sf i p a |
  sf := StandardSourceFileArray new.
+ (16r1000000 to: 16r4FFFFFF by: 811) do: [:e | | i a p |
- (16r1000000 to: 16r4FFFFFF by: 811) do: [:e |
  i := sf fileIndexFromSourcePointer: e.
  p := sf filePositionFromSourcePointer: e.
  a := sf sourcePointerFromFileIndex: i andPosition: p.
  self assert: a = e]
  !

Item was changed:
  ----- Method: FileDirectory>>pathFromUrl: (in category 'path access') -----
  pathFromUrl: aFileUrl
+
+ ^String streamContents: [ :s | | first |
- | first |
- ^String streamContents: [ :s |
  first := false.
  aFileUrl path do: [ :p |
  first ifTrue: [ s nextPut: self pathNameDelimiter ].
  first := true.
  s nextPutAll: p ] ].!

Item was changed:
  ----- Method: AsyncFile>>writeBuffer:atFilePosition:onCompletionDo: (in category 'as yet unclassified') -----
  writeBuffer: buffer atFilePosition: fPosition onCompletionDo: aBlock
  "Start an operation to write the contents of the buffer at given position in this file, and fork a process to await its completion. When the write completes, evaluate the given block. Note that, since the completion block runs asynchronously, the client may need to use a SharedQueue or a semaphore for synchronization."
 
- | n |
  self primWriteStart: fileHandle
  fPosition: fPosition
  fromBuffer: buffer
  at: 1
  count: buffer size.
  "here's the process that awaits the results:"
+ [| n |
- [
  [ semaphore wait.
    n := self primWriteResult: fileHandle.
    n = Busy.
  ] whileTrue.  "loop while busy in case the semaphore had excess signals"
  n = ErrorCode ifTrue: [^ self error: 'asynchronous write operation failed'].
  n = buffer size ifFalse: [^ self error: 'did not write the entire buffer'].
  aBlock value.
  ] forkAt: Processor userInterruptPriority.
  !

Item was changed:
  ----- Method: FileStreamTest>>testNextLine (in category 'as yet unclassified') -----
  testNextLine
+ | filename lines text |
- | filename lines text file |
  filename := 'filestream.tst'.
  lines := #('line 1' ' and line 2' '' 'fourth').
  text := lines first , String cr , lines second , String crlf , lines third , String lf , lines fourth.
 
+ [ | file |
+ (StandardFileStream forceNewFileNamed: filename)
- [(StandardFileStream forceNewFileNamed: filename)
  nextPutAll: text;
  close.
 
  file := StandardFileStream readOnlyFileNamed: filename.
  lines do: [:e |
  self assert: file nextLine = e].
  self assert: file nextLine = nil.
  file close]
  ensure: [FileDirectory default deleteFileNamed: filename ifAbsent: [] ]!

Item was changed:
  ----- Method: AcornFileDirectory class>>initialize (in category 'class initialization') -----
  initialize
  "Set up the legal chars map for filenames. May need extending for unicode etc.
  Basic rule is that any char legal for use in filenames will have a non-nil entry in this array; except for space, this is the same character. Space is transcoded to a char 160 to be a 'hard space' "
  "AcornFileDirectory initialize"
- | aVal |
  LegalCharMap := Array new: 256.
  Character alphabet do:[:c|
+ | aVal |
  LegalCharMap at: c asciiValue +1  put: c.
  LegalCharMap at: (aVal := c asUppercase) asciiValue +1 put: aVal].
  '`!!()-_=+[{]};~,./1234567890' do:[:c|
  LegalCharMap at: c asciiValue + 1 put: c].
  LegalCharMap at: Character space asciiValue +1 put: (Character value:160 "hardspace").
  LegalCharMap at: 161 put: (Character value:160 "hardspace")."secondary mapping to keep it in strings"!

Item was changed:
  ----- Method: FileStream class>>httpPostMultipart:args: (in category 'browser requests') -----
  httpPostMultipart: url args: argsDict
+ | mimeBorder argsStream crLf resultStream result |
- | mimeBorder argsStream crLf fieldValue resultStream result |
  " do multipart/form-data encoding rather than x-www-urlencoded "
 
  crLf := String crlf.
  mimeBorder := '----squeak-', Time millisecondClockValue printString, '-stuff-----'.
  "encode the arguments dictionary"
  argsStream := WriteStream on: String new.
  argsDict associationsDo: [:assoc |
+ assoc value do: [ :value | | fieldValue |
- assoc value do: [ :value |
  "print the boundary"
  argsStream nextPutAll: '--', mimeBorder, crLf.
  " check if it's a non-text field "
  argsStream nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'.
  (value isKindOf: MIMEDocument)
  ifFalse: [fieldValue := value]
  ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', crLf, 'Content-Type: ', value contentType.
  fieldValue := (value content
  ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile]
  ifNotNil: [value content]) asString].
  " Transcript show: 'field=', key, '; value=', fieldValue; cr. "
  argsStream nextPutAll: crLf, crLf, fieldValue, crLf.
  ]].
  argsStream nextPutAll: '--', mimeBorder, '--'.
 
  resultStream := self
  post:
  ('Content-type: multipart/form-data; boundary=', mimeBorder, crLf,
  'Content-length: ', argsStream contents size printString, crLf, crLf,
  argsStream contents)
  url: url ifError: [^'Error in post ' url asString].
  "get the header of the reply"
  result := resultStream upToEnd.
  ^MIMEDocument content: result!

Item was changed:
  ----- Method: RemoteString>>makeNewTextAttVersion (in category 'private') -----
  makeNewTextAttVersion
  "Create a new TextAttributes version because some inst var has changed.  If no change, don't make a new one."
  "Don't delete this method even though it has no callers!!!!!!!!!!"
 
+ | obj struct tag |
- | obj cls struct tag |
  "Note that TextFontReference and TextAnchor are forbidden."
+ obj := #(RunArray TextDoIt TextLink TextURL TextColor TextEmphasis TextFontChange TextKern TextLinkToImplementors 3 'a string') collect: [:each | | cls |
- obj := #(RunArray TextDoIt TextLink TextURL TextColor TextEmphasis TextFontChange TextKern TextLinkToImplementors 3 'a string') collect: [:each |
  cls := Smalltalk at: each ifAbsent: [nil].
  cls ifNil: [each] ifNotNil: [cls new]].
  struct := (SmartRefStream on: (RWBinaryOrTextStream on: String new)) instVarInfo: obj.
  tag := self checkSum: struct printString.
  TextAttributeStructureVersions ifNil: [TextAttributeStructureVersions := Dictionary new].
  (struct = CurrentTextAttStructure) & (tag = CurrentTextAttVersion)
  ifTrue: [^ false].
  CurrentTextAttStructure := struct.
  CurrentTextAttVersion := tag.
  TextAttributeStructureVersions at: tag put: struct.
  ^ true!

Item was changed:
  ----- Method: FileDirectory>>statsForDirectoryTree: (in category 'enumeration') -----
  statsForDirectoryTree: rootedPathName
  "Return the size statistics for the entire directory tree starting at the given root. The result is a three element array of the form: (<number of folders><number of files><total bytes in all files>). This method also serves as an example of how recursively enumerate a directory tree."
  "wod 6/16/1998: add Cursor wait, and use 'self pathNameDelimiter asString' rather than hardwired ':' "
  "FileDirectory default statsForDirectoryTree: '\smalltalk'"
 
+ | dirs files bytes |
+ Cursor wait showWhile: [ | todo entries p |
- | dirs files bytes todo p entries |
- Cursor wait showWhile: [
  dirs := files := bytes := 0.
  todo := OrderedCollection with: rootedPathName.
  [todo isEmpty] whileFalse: [
  p := todo removeFirst.
  entries := self directoryContentsFor: p.
  entries do: [:entry |
  (entry at: 4)
  ifTrue: [
  todo addLast: (p, self pathNameDelimiter asString, (entry at: 1)).
  dirs := dirs + 1]
  ifFalse: [
  files := files + 1.
  bytes := bytes + (entry at: 5)]]]].
 
  ^ Array with: dirs with: files with: bytes
  !

Item was changed:
  ----- Method: AsyncFile>>readByteCount:fromFilePosition:onCompletionDo: (in category 'as yet unclassified') -----
  readByteCount: byteCount fromFilePosition: fPosition onCompletionDo: aBlock
  "Start a read operation to read byteCount's from the given position in this file. and fork a process to await its completion. When the operation completes, evaluate the given block. Note that, since the completion block may run asynchronous, the client may need to use a SharedQueue or a semaphore for synchronization."
 
+ | buffer |
- | buffer n |
  buffer := String new: byteCount.
  self primReadStart: fileHandle fPosition: fPosition count: byteCount.
  "here's the process that awaits the results:"
+ [| n |
- [
  [ semaphore wait.
    n := self primReadResult: fileHandle intoBuffer: buffer at: 1 count: byteCount.
    n = Busy.
  ] whileTrue.  "loop while busy in case the semaphore had excess signals"
  n = ErrorCode ifTrue: [^ self error: 'asynchronous read operation failed'].
  aBlock value: buffer.
  ] forkAt: Processor userInterruptPriority.
  !

Item was changed:
  ----- Method: StandardSourceFileArrayTest>>testSourcesFileAddressRange (in category 'testing') -----
  testSourcesFileAddressRange
  "Test file position to source pointer address translation for the sources file"
 
+ | sf a |
- | sf i p a a2 |
  sf := StandardSourceFileArray new.
+ (0 to: 16r1FFFFFF by: 811) do: [:e | | a2 p i |
- (0 to: 16r1FFFFFF by: 811) do: [:e |
  a := sf sourcePointerFromFileIndex: 1 andPosition: e.
  i := sf fileIndexFromSourcePointer: a.
  self assert: i == 1.
  p := sf filePositionFromSourcePointer: a.
  self assert: p = e.
  a2 := sf sourcePointerFromFileIndex: 1 andPosition: p.
  self assert: a2 = a].
  (0 to: 16rFFFFFF by: 811) do: [:e |
  a := sf sourcePointerFromFileIndex: 1 andPosition: e.
  self assert: (a between: 16r1000000 and: 16r1FFFFFF)].
  (16r1000000 to: 16r1FFFFFF by: 811) do: [:e |
  a := sf sourcePointerFromFileIndex: 1 andPosition: e.
  self assert: (a between: 16r3000000 and: 16r3FFFFFF)]
 
  !

Item was changed:
  ----- Method: FileDirectoryTest>>testDirectoryExistsWhenLikeNamedFileExists (in category 'existence tests') -----
  testDirectoryExistsWhenLikeNamedFileExists
 
+ [ | testFileName |
+ testFileName := self myAssuredDirectory fullNameFor: 'zDirExistsTest.testing'.
- | testFileName |
- [testFileName := self myAssuredDirectory fullNameFor: 'zDirExistsTest.testing'.
  (FileStream newFileNamed: testFileName) close.
 
  self should: [FileStream isAFileNamed: testFileName].
  self shouldnt: [(FileDirectory on: testFileName) exists]]
  ensure: [self myAssuredDirectory deleteFileNamed: 'zDirExistsTest.testing']
 
  !