The Trunk: System-fbs.648.mcz

Frank Shearar uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-fbs.648.mcz

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

Name: System-fbs.648
Author: fbs
Time: 28 December 2013, 10:20:54.933 pm
UUID: 18ce54b4-61ee-c247-924d-9c202cbf4a32
Ancestors: System-nice.647

Move all of Collections' file in/out logic to System, where the other file in/out logic lives (in System-Object Storage and friends).

=============== Diff against System-nice.647 ===============

Item was added:
+ ----- Method: Array>>objectForDataStream: (in category '*System-Object Storage-file in/out') -----
+ objectForDataStream: refStrm
+ | dp |
+ "I am about to be written on an object file.  If I am one of two shared global arrays, write a proxy instead."
+
+ self == (TextConstants at: #DefaultTabsArray) ifTrue: [
+ dp := DiskProxy global: #TextConstants selector: #at: args: #(DefaultTabsArray).
+ refStrm replace: self with: dp.
+ ^ dp].
+ self == (TextConstants at: #DefaultMarginTabsArray) ifTrue: [
+ dp := DiskProxy global: #TextConstants selector: #at: args: #(DefaultMarginTabsArray).
+ refStrm replace: self with: dp.
+ ^ dp].
+ ^ super objectForDataStream: refStrm!

Item was added:
+ ----- Method: Association>>objectForDataStream: (in category '*System-Object Storage-objects from disk') -----
+ objectForDataStream: refStrm
+ | dp |
+ "I am about to be written on an object file.  If I am a known global, write a proxy that will hook up with the same resource in the destination system."
+
+ ^ (Smalltalk globals associationAt: key ifAbsent: [nil]) == self
+ ifTrue: [dp := DiskProxy global: #Smalltalk selector: #associationOrUndeclaredAt:
+ args: (Array with: key).
+ refStrm replace: self with: dp.
+ dp]
+ ifFalse: [self]!

Item was added:
+ ----- Method: PositionableStream>>backChunk (in category '*System-Changes-fileIn/Out') -----
+ backChunk
+ "Answer the contents of the receiver back to the previous terminator character.  Doubled terminators indicate an embedded terminator character."
+
+ | output character |
+ output := WriteStream on: (String new: 1000).
+ self back. "oldBack compatibility"
+ [ (character := self back) == nil ] whileFalse: [
+ character == $!! ifTrue: [
+ self back == $!! ifFalse: [
+ self skip: 2. "oldBack compatibility"
+ ^output contents reversed ] ].
+ output nextPut: character].
+ self skip: 1. "oldBack compatibility"
+ ^output contents reversed!

Item was added:
+ ----- Method: PositionableStream>>basicNextChunk (in category '*System-Changes-fileIn/Out') -----
+ basicNextChunk
+ "Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character."
+ | terminator out ch |
+ terminator := $!!.
+ out := WriteStream on: (String new: 1000).
+ self skipSeparators.
+ [(ch := self next) == nil] whileFalse: [
+ (ch == terminator) ifTrue: [
+ self peek == terminator ifTrue: [
+ self next.  "skip doubled terminator"
+ ] ifFalse: [
+ ^ out contents  "terminator is not doubled; we're done!!"
+ ].
+ ].
+ out nextPut: ch.
+ ].
+ ^ out contents!

Item was added:
+ ----- Method: PositionableStream>>checkForPreamble: (in category '*System-Changes-fileIn/Out') -----
+ checkForPreamble: chunk
+ ((chunk beginsWith: '"Change Set:') and: [ChangeSet current preambleString == nil])
+ ifTrue: [ChangeSet current preambleString: chunk].
+ ((chunk beginsWith: '"Postscript:') and: [ChangeSet current postscriptString == nil])
+ ifTrue: [ChangeSet current postscriptString: chunk].
+
+ !

Item was added:
+ ----- Method: PositionableStream>>command: (in category '*System-Changes-fileIn/Out') -----
+ command: aString
+ "Overridden by HtmlFileStream to append commands directly without translation.  4/5/96 tk"
+ "We ignore any HTML commands.  Do nothing"!

Item was added:
+ ----- Method: PositionableStream>>copyMethodChunkFrom: (in category '*System-Changes-fileIn/Out') -----
+ copyMethodChunkFrom: aStream
+ "Copy the next chunk from aStream (must be different from the receiver)."
+ | chunk |
+ chunk := aStream nextChunkText.
+ chunk runs values size = 1 "Optimize for unembellished text"
+ ifTrue: [self nextChunkPut: chunk asString]
+ ifFalse: [self nextChunkPutWithStyle: chunk]!

Item was added:
+ ----- Method: PositionableStream>>copyMethodChunkFrom:at: (in category '*System-Changes-fileIn/Out') -----
+ copyMethodChunkFrom: aStream at: pos
+ "Copy the next chunk from aStream (must be different from the receiver)."
+ | chunk |
+ aStream position: pos.
+ chunk := aStream nextChunkText.
+ chunk runs values size = 1 "Optimize for unembellished text"
+ ifTrue: [self nextChunkPut: chunk asString]
+ ifFalse: [self nextChunkPutWithStyle: chunk]!

Item was added:
+ ----- Method: PositionableStream>>copyPreamble:from:at: (in category '*System-Changes-fileIn/Out') -----
+ copyPreamble: preamble from: aStream at: pos
+ "Look for a changeStamp for this method by peeking backward.
+ Write a method preamble, with that stamp if found."
+ | terminator last50 stamp i |
+ terminator := $!!.
+
+ "Look back to find stamp in old preamble, such as...
+ Polygon methodsFor: 'private' stamp: 'di 6/25/97 21:42' prior: 34957598!! "
+ aStream position: pos.
+ aStream backChunk. "to beginning of method"
+ last50 := aStream backChunk. "to get preamble"
+ aStream position: pos.
+ stamp := String new.
+ (i := last50
+ findLastOccurrenceOfString: 'stamp:'
+ startingAt: 1) > 0 ifTrue:
+ [ stamp := (last50
+ copyFrom: i + 8
+ to: last50 size) copyUpTo: $' ].
+
+ "Write the new preamble, with old stamp if any."
+ self
+ cr;
+ nextPut: terminator.
+ self nextChunkPut: (String streamContents:
+ [ :strm |
+ strm nextPutAll: preamble.
+ stamp size > 0 ifTrue:
+ [ strm
+ nextPutAll: ' stamp: ';
+ print: stamp ] ]).
+ self cr!

Item was added:
+ ----- Method: PositionableStream>>decodeString:andRuns: (in category '*System-Changes-fileIn/Out') -----
+ decodeString: string andRuns: runsRaw
+
+ | strm runLength runValues newString index |
+ strm := runsRaw readStream.
+ (strm peekFor: $( ) ifFalse: [^ nil].
+ runLength := OrderedCollection new.
+ [strm skipSeparators.
+ strm peekFor: $)] whileFalse:
+ [runLength add: (Number readFrom: strm)].
+
+ runValues := OrderedCollection new.
+ [strm atEnd not] whileTrue:
+ [runValues add: (Number readFrom: strm).
+ strm next.].
+
+ newString := WideString new: string size.
+ index := 1.
+ runLength with: runValues do: [:length :leadingChar |
+ index to: index + length - 1 do: [:pos |
+ newString at: pos put: (Character leadingChar: leadingChar code: (string at: pos) charCode).
+ ].
+ index := index + length.
+ ].
+
+ ^ newString.
+ !

Item was added:
+ ----- Method: PositionableStream>>decodeStyle:version: (in category '*System-Changes-fileIn/Out') -----
+ decodeStyle: runsObjData version: styleVersion
+ "Decode the runs array from the ReferenceStream it is stored in."
+ "Verify that the class mentioned have the same inst vars as we have now"
+
+ | structureInfo |
+ styleVersion = RemoteString currentTextAttVersion ifTrue: [
+ "Matches our classes, no need for checking"
+ ^ (ReferenceStream on: runsObjData) next].
+ structureInfo := RemoteString structureAt: styleVersion. "or nil"
+ "See SmartRefStream instVarInfo: for dfn"
+ ^ SmartRefStream read: runsObjData withClasses: structureInfo!

Item was added:
+ ----- Method: PositionableStream>>fileIn (in category '*System-Changes-fileIn/Out') -----
+ fileIn
+ "This is special for reading expressions from text that has been formatted
+ with exclamation delimitors. The expressions are read and passed to the
+ Compiler. Answer the result of compilation."
+
+ ^ self fileInAnnouncing: 'Reading ' , self name!

Item was added:
+ ----- Method: PositionableStream>>fileInAnnouncing: (in category '*System-Changes-fileIn/Out') -----
+ fileInAnnouncing: announcement
+ "This is special for reading expressions from text that has been formatted
+ with exclamation delimitors. The expressions are read and passed to the
+ Compiler. Answer the result of compilation.  Put up a progress report with
+      the given announcement as the title."
+
+ | val |
+ announcement
+ displayProgressFrom: 0
+ to: self size
+ during:
+ [:bar |
+ [self atEnd] whileFalse:
+ [bar value: self position.
+ self skipSeparators.
+
+ [ | chunk |
+ val := (self peekFor: $!!)
+ ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self]
+ ifFalse:
+ [chunk := self nextChunk.
+ self checkForPreamble: chunk.
+ Compiler evaluate: chunk logged: true]]
+ on: InMidstOfFileinNotification
+ do: [:ex | ex resume: true].
+ self skipStyleChunk].
+ self close].
+ "Note:  The main purpose of this banner is to flush the changes file."
+ Smalltalk logChange: '----End fileIn of ' , self name , '----'.
+ self flag: #ThisMethodShouldNotBeThere. "sd"
+ ^val!

Item was added:
+ ----- Method: PositionableStream>>fileInFor:announcing: (in category '*System-Changes-fileIn/Out') -----
+ fileInFor: client announcing: announcement
+ "This is special for reading expressions from text that has been formatted
+ with exclamation delimitors. The expressions are read and passed to the
+ Compiler. Answer the result of compilation.  Put up a progress report with
+      the given announcement as the title.
+ Does NOT handle preambles or postscripts specially."
+ | val |
+ announcement
+ displayProgressFrom: 0
+ to: self size
+ during:
+ [:bar |
+ [self atEnd]
+ whileFalse:
+ [bar value: self position.
+ self skipSeparators.
+ [ | chunk |
+ val := (self peekFor: $!!) ifTrue: [
+ (Compiler evaluate: self nextChunk for: client logged: false) scanFrom: self
+ ] ifFalse: [
+ chunk := self nextChunk.
+ self checkForPreamble: chunk.
+ Compiler evaluate: chunk for: client logged: true ].
+ ] on: InMidstOfFileinNotification
+  do: [ :ex | ex resume: true].
+ self atEnd ifFalse: [ self skipStyleChunk ]].
+ self close].
+ "Note:  The main purpose of this banner is to flush the changes file."
+ Smalltalk logChange: '----End fileIn of ' , self name , '----'.
+ ^ val!

Item was added:
+ ----- Method: PositionableStream>>fileInSilentlyAnnouncing: (in category '*System-Changes-fileIn/Out') -----
+ fileInSilentlyAnnouncing: announcement
+ "This is special for reading expressions from text that has been formatted
+ with exclamation delimitors. The expressions are read and passed to the
+ Compiler. Answer the result of compilation.  Put up a progress report with
+      the given announcement as the title."
+
+ | val chunk |
+ [self atEnd] whileFalse:
+ [self skipSeparators.
+
+ [val := (self peekFor: $!!)
+ ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self]
+ ifFalse:
+ [chunk := self nextChunk.
+ self checkForPreamble: chunk.
+ Compiler evaluate: chunk logged: true]]
+ on: InMidstOfFileinNotification
+ do: [:ex | ex resume: true].
+ self skipStyleChunk].
+ self close.
+ "Note:  The main purpose of this banner is to flush the changes file."
+ Smalltalk  logChange: '----End fileIn of ' , self name , '----'.
+ self flag: #ThisMethodShouldNotBeThere. "sd"
+ SystemNavigation new allBehaviorsDo:
+ [:cl |
+ cl
+ removeSelectorSimply: #DoIt;
+ removeSelectorSimply: #DoItIn:].
+ ^val!

Item was added:
+ ----- Method: PositionableStream>>header (in category '*System-Changes-fileIn/Out') -----
+ header
+ "If the stream requires a standard header, override this message.  See HtmlFileStream"!

Item was added:
+ ----- Method: PositionableStream>>nextChunk (in category '*System-Changes-fileIn/Out') -----
+ nextChunk
+ "Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character."
+ | terminator out ch |
+ terminator := $!!.
+ out := WriteStream on: (String new: 1000).
+ self skipSeparators.
+ [(ch := self next) == nil] whileFalse: [
+ (ch == terminator) ifTrue: [
+ self peek == terminator ifTrue: [
+ self next.  "skip doubled terminator"
+ ] ifFalse: [
+ ^ self parseLangTagFor: out contents  "terminator is not doubled; we're done!!"
+ ].
+ ].
+ out nextPut: ch.
+ ].
+ ^ self parseLangTagFor: out contents.
+ !

Item was added:
+ ----- Method: PositionableStream>>nextChunkText (in category '*System-Changes-fileIn/Out') -----
+ nextChunkText
+ "Deliver the next chunk as a Text.  Decode the following ]style[ chunk if present.  Position at start of next real chunk."
+ | string runs peek pos |
+ "Read the plain text"
+ string := self nextChunk.
+
+ "Test for ]style[ tag"
+ pos := self position.
+ peek := self skipSeparatorsAndPeekNext.
+ peek = $] ifFalse: [self position: pos. ^ string asText].  "no tag"
+ (self upTo: $[) = ']style' ifFalse: [self position: pos. ^ string asText].  "different tag"
+
+ "Read and decode the style chunk"
+ runs := RunArray scanFrom: self basicNextChunk readStream.
+
+ ^ Text basicNew setString: string setRunsChecking: runs.
+ !

Item was added:
+ ----- Method: PositionableStream>>parseLangTagFor: (in category '*System-Changes-fileIn/Out') -----
+ parseLangTagFor: aString
+
+ | string peek runsRaw pos |
+ string := aString.
+ "Test for ]lang[ tag"
+ pos := self position.
+ peek := self skipSeparatorsAndPeekNext.
+ peek = $] ifFalse: [self position: pos. ^ string].  "no tag"
+ (self upTo: $[) = ']lang' ifTrue: [
+ runsRaw := self basicNextChunk.
+ string := self decodeString: aString andRuns: runsRaw
+ ] ifFalse: [
+ self position: pos
+ ].
+ ^ string.
+ !

Item was added:
+ ----- Method: PositionableStream>>skipSeparatorsAndPeekNext (in category '*System-Changes-fileIn/Out') -----
+ skipSeparatorsAndPeekNext
+ "A special function to make nextChunk fast"
+ | peek |
+ [self atEnd]
+ whileFalse:
+ [(peek := self next) isSeparator
+ ifFalse: [self position: self position-1. ^ peek]]!

Item was added:
+ ----- Method: PositionableStream>>skipStyleChunk (in category '*System-Changes-fileIn/Out') -----
+ skipStyleChunk
+ "Get to the start of the next chunk that is not a style for the previous chunk"
+
+ | pos |
+ pos := self position.
+ self skipSeparators.
+ self peek == $]
+ ifTrue: [(self upTo: $[) = ']text' "old -- no longer needed"
+ "now positioned past the open bracket"
+ ifFalse: [self nextChunk]] "absorb ]style[ and its whole chunk"
+
+ ifFalse: [self position: pos] "leave untouched"
+ !

Item was added:
+ ----- Method: PositionableStream>>trailer (in category '*System-Changes-fileIn/Out') -----
+ trailer
+ "If the stream requires a standard trailer, override this message.  See HtmlFileStream"!

Item was added:
+ ----- Method: PositionableStream>>unCommand (in category '*System-Changes-fileIn/Out') -----
+ unCommand
+ "If this read stream is at a <, then skip up to just after the next >.  For removing html commands."
+ | char |
+ [self peek = $<] whileTrue: ["begin a block"
+ [self atEnd == false and: [self next ~= $>]] whileTrue.
+ "absorb characters"
+ ].
+  !

Item was added:
+ ----- Method: PositionableStream>>verbatim: (in category '*System-Changes-fileIn/Out') -----
+ verbatim: aString
+ "Do not attempt to translate the characters.  Use to override nextPutAll:"
+ ^ self nextPutAll: aString!

Item was added:
+ ----- Method: ReadWriteStream>>fileInObjectAndCode (in category '*System-Object Storage-fileIn/Out') -----
+ fileInObjectAndCode
+ "This file may contain:
+ 1) a fileIn of code  
+ 2) just an object in SmartReferenceStream format
+ 3) both code and an object.
+ File it in and return the object.  Note that self must be a FileStream or RWBinaryOrTextStream.  Maybe ReadWriteStream incorporate RWBinaryOrTextStream?"
+ | refStream object |
+ self text.
+ self peek asciiValue = 4
+ ifTrue: [  "pure object file"
+ refStream := SmartRefStream on: self.
+ object := refStream nextAndClose]
+ ifFalse: [  "objects mixed with a fileIn"
+ self fileIn.  "reads code and objects, then closes the file"
+ object := SmartRefStream scannedObject]. "set by side effect of one of the chunks"
+ SmartRefStream scannedObject: nil.  "clear scannedObject"
+ ^ object!

Item was added:
+ ----- Method: ReadWriteStream>>fileNameEndsWith: (in category '*System-Object Storage-fileIn/Out') -----
+ fileNameEndsWith: aString
+ "See comment in FileStream fileNameEndsWith:"
+
+ ^false!

Item was added:
+ ----- Method: ReadWriteStream>>fileOutChangeSet:andObject: (in category '*System-Object Storage-fileIn/Out') -----
+ fileOutChangeSet: aChangeSetOrNil andObject: theObject
+ "Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically."
+
+ "An experimental version to fileout a changeSet first so that a project can contain its own classes"
+
+
+ self setFileTypeToObject.
+ "Type and Creator not to be text, so can attach correctly to an email msg"
+ self header; timeStamp.
+
+ aChangeSetOrNil ifNotNil: [
+ aChangeSetOrNil fileOutPreambleOn: self.
+ aChangeSetOrNil fileOutOn: self.
+ aChangeSetOrNil fileOutPostscriptOn: self.
+ ].
+ self trailer. "Does nothing for normal files.  HTML streams will have trouble with object data"
+
+ "Append the object's raw data"
+ (SmartRefStream on: self)
+ nextPut: theObject;  "and all subobjects"
+ close. "also closes me"
+ !

Item was added:
+ ----- Method: ReadWriteStream>>fileOutChanges (in category '*System-Object Storage-fileIn/Out') -----
+ fileOutChanges
+ "Append to the receiver a description of all class changes."
+ Cursor write showWhile:
+ [self header; timeStamp.
+ ChangeSet current fileOutOn: self.
+ self trailer; close]!

Item was added:
+ ----- Method: ReadWriteStream>>fileOutClass:andObject: (in category '*System-Object Storage-fileIn/Out') -----
+ fileOutClass: extraClass andObject: theObject
+ "Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically."
+
+ | class srefStream |
+ self setFileTypeToObject.
+ "Type and Creator not to be text, so can attach correctly to an email msg"
+ self text.
+ self header; timeStamp.
+
+ extraClass ifNotNil: [
+ class := extraClass. "A specific class the user wants written"
+ class sharedPools size > 0 ifTrue:
+ [class shouldFileOutPools
+ ifTrue: [class fileOutSharedPoolsOn: self]].
+ class fileOutOn: self moveSource: false toFile: 0].
+ self trailer. "Does nothing for normal files.  HTML streams will have trouble with object data"
+ self binary.
+
+ "Append the object's raw data"
+ srefStream := SmartRefStream on: self.
+ srefStream nextPut: theObject.  "and all subobjects"
+ srefStream close. "also closes me"
+ !

Item was added:
+ ----- Method: ReadWriteStream>>fileOutClass:andObject:blocking: (in category '*System-Object Storage-fileIn/Out') -----
+ fileOutClass: extraClass andObject: theObject blocking: anIdentDict
+ "Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically.  Accept a list of objects to map to nil or some other object (blockers).  In addition to teh choices in each class's objectToStoreOnDataStream"
+
+ | class srefStream |
+ self setFileTypeToObject.
+ "Type and Creator not to be text, so can attach correctly to an email msg"
+ self header; timeStamp.
+
+ extraClass ifNotNil: [
+ class := extraClass. "A specific class the user wants written"
+ class sharedPools size > 0 ifTrue:
+ [class shouldFileOutPools
+ ifTrue: [class fileOutSharedPoolsOn: self]].
+ class fileOutOn: self moveSource: false toFile: 0].
+ self trailer. "Does nothing for normal files.  HTML streams will have trouble with object data"
+
+ "Append the object's raw data"
+ srefStream := SmartRefStream on: self.
+ srefStream blockers: anIdentDict.
+ srefStream nextPut: theObject.  "and all subobjects"
+ srefStream close. "also closes me"
+ !

Item was added:
+ ----- Method: SmartRefStream>>abstractStringx0 (in category 'strings-conversion') -----
+ abstractStringx0
+
+ ^ String!

Item was added:
+ ----- Method: SmartRefStream>>multiStringx0 (in category 'strings-conversion') -----
+ multiStringx0
+
+ ^ WideString!

Item was added:
+ ----- Method: SmartRefStream>>multiSymbolx0 (in category 'strings-conversion') -----
+ multiSymbolx0
+
+ ^ WideSymbol!