The Trunk: Files-ul.47.mcz

Andreas Raab uploaded a new version of Files to project The Trunk:
http://source.squeak.org/trunk/Files-ul.47.mcz

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

Name: Files-ul.47
Author: ul
Time: 6 December 2009, 8:17 am
UUID: 6895489e-17ce-8c48-945f-901a2206252d
Ancestors: Files-ul.46

- updated postscript

=============== Diff against Files-nice.31 ===============

Item was changed:
  ----- Method: StandardFileStream>>next: (in category 'read, write, position') -----
  next: n
  "Return a string with the next n characters of the filestream in it.  1/31/96 sw"
+ ^ self nextInto: (self collectionSpecies new: n)!
- ^ self nextInto: (buffer1 class new: n)!

Item was changed:
  ----- Method: StandardFileStream>>basicNext (in category 'read, write, position') -----
  basicNext
  "Answer the next byte from this file, or nil if at the end of the file."
+
-
  | count |
+ <primitive: 65>
+ collection ifNotNil: [
+ position < readLimit
+ ifFalse: [
+ readLimit := self primRead: fileID into: collection startingAt: 1 count: collection size.
+ position := 0.
+ readLimit = 0 ifTrue: [ ^nil ] ].
+ ^collection at: (position := position + 1) ].
  count := self primRead: fileID into: buffer1 startingAt: 1 count: 1.
  count = 1
+ ifTrue: [ ^buffer1 at: 1 ]
+ ifFalse: [ ^nil ]!
- ifTrue: [^ buffer1 at: 1]
- ifFalse: [^ nil].
- !

Item was changed:
  ----- Method: StandardFileStream>>nextPutAll: (in category 'read, write, position') -----
  nextPutAll: aString
  "Write all the characters of the given string to this file."
 
  rwmode ifFalse: [^ self error: 'Cannot write a read-only file'].
+ collection ifNotNil: [
+ position < readLimit ifTrue: [ self flushReadBuffer ] ].
  self primWrite: fileID from: aString startingAt: 1 count: aString basicSize.
  ^ aString
  !

Item was changed:
  ----- Method: StandardFileStream>>ascii (in category 'properties-setting') -----
  ascii
  "opposite of binary"
+ buffer1 := String new: 1.
+ collection ifNotNil: [ collection := collection asString ]!
- buffer1 := String new: 1!

Item was added:
+ ----- Method: StandardFileStream>>flushReadBuffer (in category 'private') -----
+ flushReadBuffer
+
+ collection ifNotNil: [
+ position < readLimit ifTrue: [
+ | currentPosition |
+ currentPosition := self position.
+ position := readLimit := 0.
+ self primSetPosition: fileID to: currentPosition ] ]!

Item was changed:
  ----- Method: StandardFileStream>>upTo: (in category 'read, write, position') -----
  upTo: delim
  "Fast version to speed up nextChunk"
  | pos buffer count |
+ collection ifNotNil: [
+ (position < readLimit and: [
+ (count := collection indexOf: delim startingAt: position + 1) <= readLimit and: [
+ count > 0 ] ]) ifTrue: [
+ ^collection copyFrom: position + 1 to: (position := position + count) ] ].
  pos := self position.
  buffer := self next: 2000.
  (count := buffer indexOf: delim) > 0 ifTrue:
  ["Found the delimiter part way into buffer"
  self position: pos + count.
  ^ buffer copyFrom: 1 to: count - 1].
  self atEnd ifTrue:
  ["Never found it, and hit end of file"
  ^ buffer].
  "Never found it, but there's more..."
  ^ buffer , (self upTo: delim)!

Item was changed:
  ----- Method: StandardFileStream>>close (in category 'open/close') -----
  close
  "Close this file."
 
  fileID ifNotNil: [
+ collection ifNotNil: [
+ readLimit := position := 0 ].
  self primClose: fileID.
  self unregister.
  fileID := nil].
  !

Item was changed:
  ----- Method: StandardFileStream>>closed (in category 'open/close') -----
  closed
  "Answer true if this file is closed."
 
+ ^ fileID == nil or: [ (self primSizeNoError: fileID) == nil ]
- ^ fileID isNil or: [(self primSizeNoError: fileID) isNil]
  !

Item was changed:
  ----- Method: StandardFileStream>>binary (in category 'properties-setting') -----
  binary
+ buffer1 := ByteArray new: 1.
+ collection ifNotNil: [ collection := collection asByteArray ]!
- buffer1 := ByteArray new: 1!

Item was changed:
  ----- Method: StandardFileStream>>next:putAll:startingAt: (in category 'read, write, position') -----
  next: anInteger putAll: aString startingAt: startIndex
  "Store the next anInteger elements from the given collection."
  rwmode ifFalse: [^ self error: 'Cannot write a read-only file'].
+ collection ifNotNil: [
+ position < readLimit ifTrue: [ self flushReadBuffer ] ].
  self primWrite: fileID from: aString startingAt: startIndex count: anInteger.
  ^aString!

Item was changed:
  ----- Method: StandardFileStream>>position (in category 'read, write, position') -----
  position
  "Return the receiver's current file position.  2/12/96 sw"
 
+ collection ifNotNil: [
+ position < readLimit ifTrue: [
+ ^(self primGetPosition: fileID) - readLimit + position ] ].
+ ^self primGetPosition: fileID!
- ^ self primGetPosition: fileID!

Item was changed:
  ----- Method: StandardFileStream>>next:into:startingAt: (in category 'read, write, position') -----
  next: n into: aString startingAt: startIndex
  "Read n bytes into the given string.
  Return aString or a partial copy if less than
  n elements have been read."
+
+ | count  newN newStartIndex |
+ collection
+ ifNil: [
+ newN := n.
+ newStartIndex := startIndex ]
+ ifNotNil: [
+ aString class isBytes
+ ifFalse: [
+ position < readLimit ifTrue: [ self flushReadBuffer ].
+ newN := n.
+ newStartIndex := startIndex ]
+ ifTrue: [
+ | available |
+ (available := readLimit - position) > 0
+ ifFalse: [ available := 0 ]
+ ifTrue: [
+ | bufferedCount |
+ bufferedCount := n min: available.
+ aString
+ replaceFrom: startIndex
+ to: startIndex + bufferedCount - 1
+ with: collection
+ startingAt: position + 1.
+ position := position + bufferedCount.
+ bufferedCount = n ifTrue: [ ^aString ] ].
+ newN := n - available.
+ newStartIndex := startIndex + available ] ].
- | count |
  count := self primRead: fileID into: aString
+ startingAt: newStartIndex count: newN.
+ count = newN
+ ifTrue:[ ^aString ]
+ ifFalse:[ ^aString copyFrom: 1 to: newStartIndex + count - 1 ]!
- startingAt: startIndex count: n.
- count = n
- ifTrue:[^aString]
- ifFalse:[^aString copyFrom: 1 to: startIndex+count-1]!

Item was changed:
  ----- Method: StandardFileStream>>atEnd (in category 'read, write, position') -----
  atEnd
  "Answer whether the receiver is at its end.  "
+
+ collection ifNotNil: [
+ position < readLimit ifTrue: [ ^false ] ].
+ ^self primAtEnd: fileID!
- ^ self primAtEnd: fileID!

Item was changed:
  ----- Method: StandardFileStream>>requestURLStream:ifError: (in category 'browser requests') -----
  requestURLStream: url ifError: errorBlock
  "Request a FileStream for the given URL.
  If Squeak is not running in a browser evaluate errorBlock"
  "FileStream requestURLStream:'http://www.squeak.org'"
  | sema index request result |
  self waitBrowserReadyFor: self defaultBrowserReadyWait ifFail: [^errorBlock value].
  sema := Semaphore new.
  index := Smalltalk registerExternalObject: sema.
  request := self primURLRequest: url semaIndex: index.
  request == nil ifTrue:[
 
  Smalltalk unregisterExternalObject: sema.
  ^errorBlock value.
  ] ifFalse:[
  [sema wait. "until something happens"
  result := self primURLRequestState: request.
  result == nil] whileTrue.
  result ifTrue:[fileID := self primURLRequestFileHandle: request].
  self primURLRequestDestroy: request.
  ].
  Smalltalk unregisterExternalObject: sema.
  fileID == nil ifTrue:[^nil].
  self register.
  name := url.
  rwmode := false.
+ buffer1 := String new: 1.
+ self enableReadBuffering
+ !
- buffer1 := String new: 1.!

Item was changed:
  ----- Method: StandardFileStream>>post:target:url:ifError: (in category 'browser requests') -----
  post: data target: target url: url ifError: errorBlock
  "Post data to the given URL. The returned file stream contains the reply of the server.
  If Squeak is not running in a browser evaluate errorBlock"
  | sema index request result |
  self waitBrowserReadyFor: self defaultBrowserReadyWait ifFail: [^errorBlock value].
  sema := Semaphore new.
  index := Smalltalk registerExternalObject: sema.
  request := self primURLPost: url target: target data: data semaIndex: index.
  request == nil ifTrue:[
 
  Smalltalk unregisterExternalObject: sema.
  ^errorBlock value.
  ] ifFalse:[
  [sema wait. "until something happens"
  result := self primURLRequestState: request.
  result == nil] whileTrue.
  result ifTrue:[fileID := self primURLRequestFileHandle: request].
  self primURLRequestDestroy: request.
  ].
  Smalltalk unregisterExternalObject: sema.
  fileID == nil ifTrue:[^nil].
  self register.
  name := url.
  rwmode := false.
+ buffer1 := String new: 1.
+ self enableReadBuffering
+ !
- buffer1 := String new: 1.!

Item was changed:
  ----- Method: StandardFileStream>>position: (in category 'read, write, position') -----
  position: pos
  "Set the receiver's position as indicated.  2/12/96 sw"
 
+ collection ifNotNil: [
+ position < readLimit ifTrue: [
+ | newPosition |
+ newPosition := pos - (self primGetPosition: fileID) + readLimit.
+ newPosition < 0 ifTrue: [
+ | offsetPos |
+ self primSetPosition: fileID to: (offsetPos := pos - (collection size // 4) max: 0).
+ readLimit := self primRead: fileID into: collection startingAt: 1 count: collection size.
+ position := pos - offsetPos.
+ ^self ].
+ newPosition < readLimit
+ ifTrue: [
+ position := newPosition.
+ ^self ]
+ ifFalse: [
+ readLimit := position := 0 ] ] ].
+ ^self primSetPosition: fileID to: pos!
- ^ self primSetPosition: fileID to: pos!

Item was changed:
  ----- Method: StandardFileStream>>readInto:startingAt:count: (in category 'read, write, position') -----
  readInto: byteArray startingAt: startIndex count: count
  "Read into the given array as specified, and return the count
  actually transferred.  index and count are in units of bytes or
  longs depending on whether the array is Bitmap, String or ByteArray"
+
+ ^self next: count into: byteArray startingAt: startIndex
- ^ self primRead: fileID into: byteArray
- startingAt: startIndex count: count
  !

Item was added:
+ ----- Method: StandardFileStream>>enableReadBuffering (in category 'private') -----
+ enableReadBuffering
+
+ collection ifNil: [
+ buffer1 ifNotNil: [
+ collection := self collectionSpecies new: 2048 ] ].
+ readLimit := position := 0!

Item was added:
+ ----- Method: StandardFileStream>>disableReadBuffering (in category 'private') -----
+ disableReadBuffering
+
+ collection ifNotNil: [
+ position < readLimit
+ ifTrue: [
+ | currentPosition |
+ currentPosition := self position.
+ collection := readLimit := position := nil.
+ self position: currentPosition ]
+ ifFalse: [
+ collection := readLimit := position := nil ] ]
+ !

Item was changed:
  ----- Method: StandardFileStream>>requestDropStream: (in category 'dnd requests') -----
  requestDropStream: dropIndex
  "Return a read-only stream for some file the user has just dropped onto Squeak."
  | rawName |
  rawName := self primDropRequestFileName: dropIndex.
  name :=  (FilePath pathName: rawName isEncoded: true) asSqueakPathName.
  fileID := self primDropRequestFileHandle: dropIndex.
  fileID == nil ifTrue:[^nil].
  self register.
  rwmode := false.
  buffer1 := String new: 1.
+ self enableReadBuffering
-
  !

Item was changed:
  FileStream subclass: #StandardFileStream
  instanceVariableNames: 'name fileID buffer1'
  classVariableNames: 'Registry'
  poolDictionaries: ''
  category: 'Files-Kernel'!
 
+ !StandardFileStream commentStamp: 'ul 12/6/2009 05:13' prior: 0!
+ Provides a simple, platform-independent, interface to a file system. The instance variable rwmode, inherited from class PositionableStream, here is used to hold a Boolean -- true means opened for read-write, false means opened for read-only.  2/12/96 sw
+
+ I implement a simple read buffering scheme with the variables defined in PositionableStream (which are unused in me otherwise) in the following way:
+ collection <ByteString> or <ByteArray> This is the buffer.
+ position <Integer> The relative position in the buffer. Greater or equal to zero.
+ readLimit <Integer> The number of bytes buffered. Greater or equal to zero.
+ Read buffering is enabled with #enableReadBuffering, disabled with #disableReadBuffering and it is enabled by default. The buffer is filled when a read attempt of an unbuffered absolute position is requested, or when a negative repositioning is made (with #position: with an argument < than the current absolute position) to an absolute position which is not buffered. In the first case, the buffer is positioned to the given absolute position. In the latter case the repositioning is made to the requested absolute position minus fourth of the buffer size. This means that further small negative repositionings won't result in buffer flushing. This is really useful when filing in code.
+ The read buffer is flushed (#flushReadBuffer) whenever a write attempt is made.
+ The buffer state is valid if and only if collection is not nil and position < readLimit.!
- !StandardFileStream commentStamp: '<historical>' prior: 0!
- Provides a simple, platform-independent, interface to a file system.  This initial version ignores issues of Directories etc.  The instance-variable fallbackStream at the moment holds an instance of HFSMacFileStream, to bridge us to the new world while in the old.  The instance variable rwmode, inherited from class PositionableStream, here is used to hold a Boolean -- true means opened for read-write, false means opened for read-only.  2/12/96 sw!

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

Item was changed:
  ----- Method: StandardFileStream>>upToEnd (in category 'read, write, position') -----
  upToEnd
  "Answer a subcollection from the current access position through the last element of the receiver."
 
+ ^self collectionSpecies streamContents: [ :newStream |
+ | next |
+ [ (next := self next) == nil ] whileFalse: [
+ newStream nextPut: next ] ]!
- | newStream buffer |
- buffer := buffer1 species new: 1000.
- newStream := WriteStream on: (buffer1 species new: 100).
- [self atEnd] whileFalse: [newStream nextPutAll: (self nextInto: buffer)].
- ^ newStream contents!

Item was added:

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

Item was changed:
  ----- Method: StandardFileStream>>open:forWrite: (in category 'open/close') -----
  open: fileName forWrite: writeMode
  "Open the file with the given name. If writeMode is true, allow writing, otherwise open the file in read-only mode."
  "Changed to do a GC and retry before failing ar 3/21/98 17:25"
  | f |
  f := fileName asVmPathName.
 
  fileID := StandardFileStream retryWithGC:[self primOpen: f writable: writeMode]
  until:[:id| id notNil]
  forFileNamed: fileName.
  fileID ifNil: [^ nil].  "allows sender to detect failure"
  self register.
  name := fileName.
  rwmode := writeMode.
  buffer1 := String new: 1.
+ self enableReadBuffering
+ !
- !

Item was changed:
  ----- Method: StandardFileStream>>nextPut: (in category 'read, write, position') -----
  nextPut: char
  "Write the given character to this file."
 
  rwmode ifFalse: [^ self error: 'Cannot write a read-only file'].
+ collection ifNotNil: [
+ position < readLimit ifTrue: [ self flushReadBuffer ] ].
  buffer1 at: 1 put: char.
  self primWrite: fileID from: buffer1 startingAt: 1 count: 1.
  ^ char
  !

Item was changed:
  ----- Method: StandardFileStream>>reopen (in category 'open/close') -----
  reopen
  "Close and reopen this file. The file position is reset to zero."
  "Details: Files that were open when a snapshot occurs are no longer valid when the snapshot is resumed. This operation re-opens the file if that has happened."
 
+ fileID ifNotNil: [
+ collection ifNotNil: [
+ position < readLimit ifTrue: [
+ self flushReadBuffer ] ].
+ self primCloseNoError: fileID ].
- fileID ifNotNil: [self primCloseNoError: fileID].
  self open: name forWrite: rwmode.
  !

Item was changed:
  ----- Method: StandardFileStream>>padToEndWith: (in category 'read, write, position') -----
  padToEndWith: aChar
  "On the Mac, files do not truncate.  One can delete the old file and write a new one, but sometime deletion fails (file still open? file stale?).  This is a sad compromise.  Just let the file be the same length but pad it with a harmless character."
 
  | pad |
  self atEnd ifTrue: [^ self].
  pad := self isBinary
  ifTrue: [aChar asCharacter asciiValue] "ok for char or number"
  ifFalse: [aChar asCharacter].
+ self nextPutAll: (self collectionSpecies new: ((self size - self position) min: 20000)
- self nextPutAll: (buffer1 class new: ((self size - self position) min: 20000)
  withAll: pad).!

Item was changed:
  ----- Method: StandardFileStream>>requestURL:target:ifError: (in category 'browser requests') -----
  requestURL: url target: target ifError: errorBlock
  "Request to go to the target for the given URL.
  If Squeak is not running in a browser evaluate errorBlock"
 
  | sema index request result |
  self waitBrowserReadyFor: self defaultBrowserReadyWait ifFail: [^errorBlock value].
  sema := Semaphore new.
  index := Smalltalk registerExternalObject: sema.
  request := self primURLRequest: url target: target semaIndex: index.
  request == nil ifTrue:[
 
  Smalltalk unregisterExternalObject: sema.
  ^errorBlock value.
  ] ifFalse:[
  [sema wait. "until something happens"
  result := self primURLRequestState: request.
  result == nil] whileTrue.
  self primURLRequestDestroy: request.
  ].
  Smalltalk unregisterExternalObject: sema.
  fileID == nil ifTrue:[^nil].
  self register.
  name := url.
  rwmode := false.
+ buffer1 := String new: 1.
+ self enableReadBuffering
+ !
- buffer1 := String new: 1.!