[squeak-dev] The Trunk: Collections-fbs.553.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Dec 28 22:22:51 UTC 2013
Frank Shearar uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-fbs.553.mcz
==================== Summary ====================
Name: Collections-fbs.553
Author: fbs
Time: 28 December 2013, 10:22:03.872 pm
UUID: 30896006-fd4c-fc47-803c-572d1c1779ad
Ancestors: Collections-nice.552
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 Collections-nice.552 ===============
Item was removed:
- ----- Method: Array>>objectForDataStream: (in category '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 removed:
- ----- Method: Association>>objectForDataStream: (in category '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 removed:
- ----- Method: PositionableStream>>backChunk (in category '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 removed:
- ----- Method: PositionableStream>>basicNextChunk (in category '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 removed:
- ----- Method: PositionableStream>>checkForPreamble: (in category '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 removed:
- ----- Method: PositionableStream>>command: (in category '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 removed:
- ----- Method: PositionableStream>>copyMethodChunkFrom: (in category '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 removed:
- ----- Method: PositionableStream>>copyMethodChunkFrom:at: (in category '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 removed:
- ----- Method: PositionableStream>>copyPreamble:from:at: (in category '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 removed:
- ----- Method: PositionableStream>>decodeString:andRuns: (in category '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 removed:
- ----- Method: PositionableStream>>decodeStyle:version: (in category '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 removed:
- ----- Method: PositionableStream>>fileIn (in category '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 removed:
- ----- Method: PositionableStream>>fileInAnnouncing: (in category '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 removed:
- ----- Method: PositionableStream>>fileInFor:announcing: (in category '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 removed:
- ----- Method: PositionableStream>>fileInSilentlyAnnouncing: (in category '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 removed:
- ----- Method: PositionableStream>>header (in category 'fileIn/Out') -----
- header
- "If the stream requires a standard header, override this message. See HtmlFileStream"!
Item was removed:
- ----- Method: PositionableStream>>nextChunk (in category '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 removed:
- ----- Method: PositionableStream>>nextChunkText (in category '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 removed:
- ----- Method: PositionableStream>>parseLangTagFor: (in category '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 changed:
+ ----- Method: PositionableStream>>skipSeparators (in category 'positioning') -----
- ----- Method: PositionableStream>>skipSeparators (in category 'fileIn/Out') -----
skipSeparators
[self atEnd]
whileFalse:
[self next isSeparator ifFalse: [^ self position: self position-1]]!
Item was removed:
- ----- Method: PositionableStream>>skipSeparatorsAndPeekNext (in category '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 removed:
- ----- Method: PositionableStream>>skipStyleChunk (in category '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 removed:
- ----- Method: PositionableStream>>trailer (in category 'fileIn/Out') -----
- trailer
- "If the stream requires a standard trailer, override this message. See HtmlFileStream"!
Item was removed:
- ----- Method: PositionableStream>>unCommand (in category '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 removed:
- ----- Method: PositionableStream>>verbatim: (in category 'fileIn/Out') -----
- verbatim: aString
- "Do not attempt to translate the characters. Use to override nextPutAll:"
- ^ self nextPutAll: aString!
Item was removed:
- ----- Method: ReadWriteStream>>fileInObjectAndCode (in category '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 removed:
- ----- Method: ReadWriteStream>>fileNameEndsWith: (in category 'fileIn/Out') -----
- fileNameEndsWith: aString
- "See comment in FileStream fileNameEndsWith:"
-
- ^false!
Item was removed:
- ----- Method: ReadWriteStream>>fileOutChangeSet:andObject: (in category '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 removed:
- ----- Method: ReadWriteStream>>fileOutChanges (in category '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 removed:
- ----- Method: ReadWriteStream>>fileOutClass:andObject: (in category '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 removed:
- ----- Method: ReadWriteStream>>fileOutClass:andObject:blocking: (in category '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 removed:
- ----- Method: SmartRefStream>>abstractStringx0 (in category '*Collections-Strings-conversion') -----
- abstractStringx0
-
- ^ String!
Item was removed:
- ----- Method: SmartRefStream>>multiStringx0 (in category '*Collections-Strings-conversion') -----
- multiStringx0
-
- ^ WideString!
Item was removed:
- ----- Method: SmartRefStream>>multiSymbolx0 (in category '*Collections-Strings-conversion') -----
- multiSymbolx0
-
- ^ WideSymbol!
More information about the Squeak-dev
mailing list
|