Squeak-dev December 2013

squeak-dev@lists.squeakfoundation.org

45 participants
325 discussions

The Trunk: Collections-fbs.554.mcz
by commits＠source.squeak.org 29 Dec '13

29 Dec '13

Frank Shearar uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-fbs.554.mcz ==================== Summary ==================== Name: Collections-fbs.554 Author: fbs Time: 29 December 2013, 7:10:52.228 pm UUID: eed3b0bf-2aaa-8d43-acc7-693d5881a32c Ancestors: Collections-fbs.553 Make browseWithPrettyPrint, browseWithDragNDrop pragma-based preferences. =============== Diff against Collections-fbs.553 =============== Item was changed: ----- Method: Text>>askIfAddStyle:req: (in category 'attributes') ----- askIfAddStyle: priorMethod req: requestor "Ask the user if we have a complex style (i.e. bold) for the first time" | tell answ old | + (SystemBrowser browseWithPrettyPrint) - (Preferences browseWithPrettyPrint) ifTrue: [self couldDeriveFromPrettyPrinting ifTrue: [^ self asString]]. self runs coalesce. self unembellished ifTrue: [^ self asString]. priorMethod ifNotNil: [old := priorMethod getSourceFromFile]. (old == nil or: [old unembellished]) ifTrue: [tell := 'This method contains style for the first time (e.g. bold or colored text). Do you really want to save the style info?'. answ := (UIManager default chooseFrom: #('Save method with style' 'Save method simply') title: tell). answ = 2 ifTrue: [^ self asString]]!

1 0

The Trunk: Tools-fbs.512.mcz
by commits＠source.squeak.org 29 Dec '13

29 Dec '13

Frank Shearar uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-fbs.512.mcz ==================== Summary ==================== Name: Tools-fbs.512 Author: fbs Time: 29 December 2013, 7:10:20.18 pm UUID: 49c920b7-6e0d-a04d-83e5-dfa1578622ca Ancestors: Tools-cmm.511 Make browseWithPrettyPrint, browseWithDragNDrop pragma-based preferences. =============== Diff against Tools-cmm.511 =============== Item was changed: ----- Method: Browser>>buildClassListWith: (in category 'toolbuilder') ----- buildClassListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #classList; getIndex: #classListIndex; setIndex: #classListIndex:; menu: #classListMenu:shifted:; keyPress: #classListKey:from:. + SystemBrowser browseWithDragNDrop - Preferences browseWithDragNDrop ifTrue:[listSpec dragItem: #dragFromClassList:]. ^listSpec ! Item was changed: ----- Method: Browser>>buildMessageCategoryListWith: (in category 'toolbuilder') ----- buildMessageCategoryListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #messageCategoryList; getIndex: #messageCategoryListIndex; setIndex: #messageCategoryListIndex:; menu: #messageCategoryMenu:; keyPress: #arrowKey:from:. + SystemBrowser browseWithDragNDrop ifTrue:[ - Preferences browseWithDragNDrop ifTrue:[ listSpec dropAccept: #wantsMessageCategoriesDrop:; dropItem: #dropOnMessageCategories:at:]. ^listSpec ! Item was changed: ----- Method: Browser>>buildMessageListWith: (in category 'toolbuilder') ----- buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #messageList; getIndex: #messageListIndex; setIndex: #messageListIndex:; menu: #messageListMenu:shifted:; keyPress: #messageListKey:from:. + SystemBrowser browseWithDragNDrop - Preferences browseWithDragNDrop ifTrue:[listSpec dragItem: #dragFromMessageList:]. ^listSpec ! Item was changed: ----- Method: Browser>>buildSystemCategoryListWith: (in category 'toolbuilder') ----- buildSystemCategoryListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #systemCategoryList; getIndex: #systemCategoryListIndex; setIndex: #systemCategoryListIndex:; menu: #systemCategoryMenu:; keyPress: #systemCatListKey:from:. + SystemBrowser browseWithDragNDrop ifTrue:[ - Preferences browseWithDragNDrop ifTrue:[ listSpec dropAccept: #wantsSystemCategoriesDrop:; dropItem: #dropOnSystemCategories:at:]. ^listSpec! Item was changed: ----- Method: CodeHolder>>contentsSymbol (in category 'contents') ----- contentsSymbol "Answer a symbol indicating what kind of content should be shown for the method; for normal showing of source code, this symbol is #source. A nil value in the contentsSymbol slot will be set to #source by this method" ^ contentsSymbol ifNil: + [contentsSymbol := SystemBrowser browseWithPrettyPrint - [contentsSymbol := Preferences browseWithPrettyPrint ifTrue: [#prettyPrint] ifFalse: [#source]]! Item was changed: ----- Method: FileContentsBrowser>>selectedMessage (in category 'edit pane') ----- selectedMessage "Answer a copy of the source code for the selected message selector." | class selector | class := self selectedClassOrMetaClass. selector := self selectedMessageName. contents := class sourceCodeAt: selector. + SystemBrowser browseWithPrettyPrint - Preferences browseWithPrettyPrint ifTrue: [contents := class prettyPrinterClass format: contents in: class notifying: nil decorated: false]. self showingAnyKindOfDiffs ifTrue: [contents := self methodDiffFor: contents class: self selectedClass selector: self selectedMessageName meta: self metaClassIndicated]. ^contents asText makeSelectorBoldIn: class! Item was changed: ----- Method: FileList>>buildDirectoryTreeWith: (in category 'toolbuilder') ----- buildDirectoryTreeWith: builder | treeSpec | treeSpec := builder pluggableTreeSpec new. treeSpec model: self ; roots: #rootDirectoryList ; hasChildren: #hasMoreDirectories: ; getChildren: #subDirectoriesOf: ; getSelectedPath: #selectedPath ; setSelected: #setDirectoryTo: ; label: #directoryNameOf: ; menu: #volumeMenu: ; autoDeselect: false. + SystemBrowser browseWithDragNDrop ifTrue: - Preferences browseWithDragNDrop ifTrue: [ treeSpec dragItem: #dragFromDirectoryList: ; dropItem: #drop:ontoDirectory:shouldCopy: ]. ^ treeSpec! Item was changed: ----- Method: FileList>>buildFileListWith: (in category 'toolbuilder') ----- buildFileListWith: builder | buttons listSpec top | top := builder pluggablePanelSpec new. top children: OrderedCollection new. buttons := self buildButtonPaneWith: builder. buttons frame: (self topConstantHeightFrame: self buttonHeight fromLeft: 0 width: 1). top children add: buttons. listSpec := builder pluggableListSpec new. listSpec model: self ; list: #fileList ; getIndex: #fileListIndex ; setIndex: #fileListIndex: ; menu: #fileListMenu: ; keyPress: nil ; frame: (self frameOffsetFromTop: self buttonHeight + 4 fromLeft: 0 width: 1 bottomFraction: 1) ; color: Color white. + SystemBrowser browseWithDragNDrop ifTrue: [ listSpec dragItem: #dragFromFileList: ]. - Preferences browseWithDragNDrop ifTrue: [ listSpec dragItem: #dragFromFileList: ]. top children add: listSpec. ^ top! Item was changed: ----- Method: MessageSet>>buildMessageListWith: (in category 'toolbuilder') ----- buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #messageList; getIndex: #messageListIndex; setIndex: #messageListIndex:; menu: #messageListMenu:shifted:; keyPress: #messageListKey:from:. + SystemBrowser browseWithDragNDrop - Preferences browseWithDragNDrop ifTrue:[listSpec dragItem: #dragFromMessageList:]. ^listSpec ! Item was changed: ----- Method: MessageTrace>>buildMessageListWith: (in category 'private initializing') ----- buildMessageListWith: builder | listSpec | listSpec := builder pluggableAlternateMultiSelectionListSpec new. listSpec model: self ; list: #messageList ; getIndex: #messageListIndex ; setIndex: #toggleSelectionAt:shifted:controlled: ; menu: #messageListMenu:shifted: ; getSelectionList: #isMessageSelectedAt: ; setSelectionList: #messageAt:beSelected: ; keyPress: #messageListKey:from:. + SystemBrowser browseWithDragNDrop - Preferences browseWithDragNDrop ifTrue: [ listSpec dragItem: #dragFromMessageList: ]. ^ listSpec! Item was changed: AppRegistry subclass: #SystemBrowser instanceVariableNames: '' + classVariableNames: 'BrowseWithDragNDrop BrowseWithPrettyPrint' - classVariableNames: '' poolDictionaries: '' category: 'Tools-Base'! !SystemBrowser commentStamp: '<historical>' prior: 0! This is the AppRegistry class for class browsing! Item was added: + ----- Method: SystemBrowser class>>browseWithDragNDrop (in category 'preferences') ----- + browseWithDragNDrop + <preference: 'Browse with drag ''n'' drop' category: 'browsing' description: 'If true, new browsers will open with drag & drop functionality (only in Morphic)' type: #Boolean> + ^ BrowseWithDragNDrop ifNil: [false].! Item was added: + ----- Method: SystemBrowser class>>browseWithDragNDrop: (in category 'preferences') ----- + browseWithDragNDrop: aBoolean + BrowseWithDragNDrop := aBoolean.! Item was added: + ----- Method: SystemBrowser class>>browseWithPrettyPrint (in category 'preferences') ----- + browseWithPrettyPrint + <preference: 'Browse with pretty-print' category: 'browsing' description: 'If true, browsers will automatically format their contents' type: #Boolean> + ^ BrowseWithPrettyPrint ifNil: [false].! Item was added: + ----- Method: SystemBrowser class>>browseWithPrettyPrint: (in category 'preferences') ----- + browseWithPrettyPrint: aBoolean + BrowseWithPrettyPrint := aBoolean.! Item was changed: ----- Method: TimeProfileBrowser>>selectedMessage (in category 'message list') ----- selectedMessage "Answer the source method for the currently selected message." self setClassAndSelectorIn: [:class :selector | | source | source := class sourceMethodAt: selector ifAbsent: [^'Missing']. + SystemBrowser browseWithPrettyPrint - Preferences browseWithPrettyPrint ifTrue: [source := class prettyPrinterClass format: source in: class notifying: nil decorated: false]. self selectedClass: class. self selectedSelector: selector. ^source asText makeSelectorBoldIn: class]. ^''! Item was changed: + (PackageInfo named: 'Tools') postscript: 'SystemBrowser browseWithPrettyPrint: Preferences browseWithPrettyPrint. + SystemBrowser browseWithDragNDrop: Preferences browseWithDragNDrop. + + Preferences removePreference: #browseWithPrettyPrint. + Preferences removePreference: #browseWithDragNDrop.'! - (PackageInfo named: 'Tools') postscript: 'SystemBrowser browserShowsPackagePane: Preferences browserShowsPackagePane. - Preferences removePreference: #browserShowsPackagePane.'!

1 0

Fix: OSProcess on Windows
by Sean P. DeNigris 29 Dec '13

29 Dec '13

I made a small fix for MNU #defaultShellPath, which has been reported a few times. I didn't have repo write access, so I committed to http://smalltalkhub.com/#!/~SeanDeNigris/SeansOutbox . Sometimes on Windows (e.g. seemingly when there are quoted command line arguments), the argument to #waitForCommand: and command: must be wrapped in $". I don't think there is any harm in always doing this (on Windows), but wanted to get feedback from Dave first... OSProcess-Win32-SeanDeNigris.11 - Supply shell flags valid for Windows (i.e. '/c'); shell commands via PipeableOSProcess are now working, with two restrictions: - no access to stdout - argument to #waitXyz: may have to be surroundedByDoubleQuotes OSProcess-Base-SeanDeNigris.41 - Extract default shell flags ('-c') into a method, so that Windows may supply flags valid there (i.e. '/c') CommandShell-Piping-SeanDeNigris.15 - Fix Win32 shell by providing path to cmd.exe HTH ----- Cheers, Sean -- View this message in context: http://forum.world.st/Fix-OSProcess-on-Windows-tp4732740.html Sent from the Squeak - Dev mailing list archive at Nabble.com.

2 1

Re: [squeak-dev] The Trunk: Morphic-ul.710.mcz
by Frank Shearar 29 Dec '13

29 Dec '13

On 29 December 2013 18:47, <commits(a)source.squeak.org> wrote: > Levente Uzonyi uploaded a new version of Morphic to project The Trunk: > http://source.squeak.org/trunk/Morphic-ul.710.mcz > > ==================== Summary ==================== > > Name: Morphic-ul.710 > Author: ul > Time: 29 December 2013, 7:24:57.804 pm > UUID: 25743463-c5a5-4154-b761-110cb4e69e65 > Ancestors: Morphic-nice.709 > > MorphicUIManager DNU #restore > > =============== Diff against Morphic-nice.709 =============== > > Item was changed: > ----- Method: MorphicUIManager>>restoreDisplayAfter: (in category 'display') ----- > restoreDisplayAfter: aBlock > "Evaluate the block, wait for a mouse click, and then restore the screen." > > aBlock value. > Sensor waitButton. > + self restoreDisplay! > - self restore.! I don't get it. I touched this method last, changing whatever was there to "self restore" instead of (IIRC) "Display restore". Did I simply mess up the change? Er yes, I think that I did. Thanks, Levente. frank

1 0

The Trunk: Morphic-ul.710.mcz
by commits＠source.squeak.org 29 Dec '13

29 Dec '13

Levente Uzonyi uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ul.710.mcz ==================== Summary ==================== Name: Morphic-ul.710 Author: ul Time: 29 December 2013, 7:24:57.804 pm UUID: 25743463-c5a5-4154-b761-110cb4e69e65 Ancestors: Morphic-nice.709 MorphicUIManager DNU #restore =============== Diff against Morphic-nice.709 =============== Item was changed: ----- Method: MorphicUIManager>>restoreDisplayAfter: (in category 'display') ----- restoreDisplayAfter: aBlock "Evaluate the block, wait for a mouse click, and then restore the screen." aBlock value. Sensor waitButton. + self restoreDisplay! - self restore.!

1 0

The Trunk: ST80-ul.169.mcz
by commits＠source.squeak.org 29 Dec '13

29 Dec '13

Levente Uzonyi uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-ul.169.mcz ==================== Summary ==================== Name: ST80-ul.169 Author: ul Time: 29 December 2013, 7:25:22.052 pm UUID: 5bf0c4a1-3cac-4788-bf0e-1ddfa9d770b9 Ancestors: ST80-nice.168 MVCUIManager DNU #restore =============== Diff against ST80-nice.168 =============== Item was changed: ----- Method: MVCUIManager>>restoreDisplayAfter: (in category 'display') ----- restoreDisplayAfter: aBlock "Evaluate the block, wait for a mouse click, and then restore the screen." aBlock value. Sensor waitButton. + self restoreDisplay! - self restore.!

1 0

Daily Commit Log
by commits＠source.squeak.org 29 Dec '13

29 Dec '13

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2013-December/006822.h… Name: System-fbs.648 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). ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-December/006823.h… Name: Collections-fbs.553 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). =============================================

1 0

PositionableStream does too much?
by Frank Shearar 28 Dec '13

28 Dec '13

It looks like PositionableStream serves both as an introducer of certain specific functionality - making a stream where you can move arbitrarily forwards and backwards through a stream - but also has a bunch of stuff relating to filing in/out chunk-formatted Smalltalk code. It looks like the entire fileIn/Out category either belongs in a separate subclass, or at least belongs in the System package, along with ChangeSets and the other Object Storage code. (I can see an argument for pulling all #skipSeparators looks like the only method in that category that has general utility. Ideally we'd split the responsibility, but (a) I think separating the packages is more immediately important and (b) at some point I'd like to push hard for moving over to Xtreams based work. Together with this, ReadWriteStream has a fileIn/Out category that also looks like it belongs with the rest of the file in/out logic, in System. What do you think of moving these entire categories (except maybe #skipSeparators) to System? frank

3 3

The Trunk: Collections-fbs.553.mcz
by commits＠source.squeak.org 28 Dec '13

28 Dec '13

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!

1 0

The Trunk: System-fbs.648.mcz
by commits＠source.squeak.org 28 Dec '13

28 Dec '13

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!

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
33
Older →

Jump to page: