--- a/SmalltalkChunkFileSourceWriter.st Thu Aug 13 17:19:47 2009 +0200
+++ b/SmalltalkChunkFileSourceWriter.st Thu Aug 13 17:54:45 2009 +0200
@@ -12,7 +12,7 @@
"{ Package: 'stx:libbasic' }"
Object subclass:#SmalltalkChunkFileSourceWriter
- instanceVariableNames:'classBeingSaved'
+ instanceVariableNames:'classBeingSaved methodsAlreadySaved'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Classes'
@@ -44,11 +44,12 @@
The order by which the fileOut is done is used to put the version string at the end.
Thus, if the version string is expanded (by CVS), the characterPositions of methods should not move"
- |collectionOfCategories copyrightMethod copyrightText comment versionMethod skippedMethods
+ |collectionOfCategories comment versionMethod skippedMethods
nonMeta meta classesImplementingInitialize outStream|
- nonMeta := aClass theNonMetaclass.
+ classBeingSaved := nonMeta := aClass theNonMetaclass.
meta := nonMeta class.
+ methodsAlreadySaved := Set new.
nonMeta isLoaded ifFalse:[
^ ClassDescription fileOutErrorSignal
@@ -72,24 +73,7 @@
copyright string at the beginning be preserved .... even if the
code was edited in the browser and filedOut.
"
- (copyrightMethod := meta compiledMethodAt:#copyright) notNil ifTrue:[
- "
- get the copyright method's comment-text, strip off empty and blank lines
- and insert at beginning.
- "
- copyrightText := copyrightMethod comment.
- copyrightText notEmptyOrNil ifTrue:[
- copyrightText := copyrightText asCollectionOfLines asStringCollection.
- copyrightText := copyrightText withoutLeadingBlankLines.
- copyrightText := copyrightText withoutTrailingBlankLines.
- copyrightText notEmpty ifTrue:[
- copyrightText addFirst:'"'.
- copyrightText addLast:'"'.
- copyrightText := copyrightText asString.
- outStream nextPutAllAsChunk:copyrightText.
- ].
- ].
- ].
+ self generateHeaderWithCopyrightOn:outStream.
stampIt ifTrue:[
"/
@@ -113,7 +97,7 @@
outStream cr.
].
"/
- "/ primitive definitions - if any
+ "/ ST/X primitive definitions - if any
"/
nonMeta fileOutPrimitiveSpecsOn:outStream.
].
@@ -173,6 +157,16 @@
]
].
+ "/ if there are any primitive definitions (vw-like ffi-primitives),
+ "/ file them out first in the order: defines, types.
+ "/ Otherwise, we might have trouble when filing in later, because the types are needed
+ "/ for the primitive calls.
+ nonMeta methodDictionary keysAndValuesDo:[:sel :m |
+ m isVisualWorksTypedef ifTrue:[
+ self fileOutCategory:m category of:nonMeta except:nil only:(Array with:m) methodFilter:methodFilter on:outStream.
+ ].
+ ].
+
"/
"/ methods from all categories
"/
@@ -294,37 +288,34 @@
If both are nil, all are saved. See version-method handling in
fileOut for what this is needed."
- |source sortedSelectors first privacy interestingMethods cat|
+ |sortedSelectors first prevPrivacy privacy interestingMethods cat|
interestingMethods := OrderedCollection new.
aClass methodsDo:[:aMethod |
|wanted|
- (methodFilter isNil
- or:[methodFilter value:aMethod]) ifTrue:[
+ (methodsAlreadySaved includes:aMethod) ifFalse:[
(aCategory = aMethod category) ifTrue:[
- skippedMethods notNil ifTrue:[
- wanted := (skippedMethods includesIdentical:aMethod) not
- ] ifFalse:[
- savedMethods notNil ifTrue:[
- wanted := (savedMethods includesIdentical:aMethod).
+ (methodFilter isNil or:[methodFilter value:aMethod]) ifTrue:[
+ skippedMethods notNil ifTrue:[
+ wanted := (skippedMethods includesIdentical:aMethod) not
] ifFalse:[
- wanted := true
- ]
- ].
- wanted ifTrue:[
- aMethod selector isSymbol ifTrue:[
- interestingMethods add:aMethod
- ] ifFalse:[
- Transcript showCR:'skipping non-symbol method ',aMethod selector.
+ wanted := savedMethods isNil or:[ savedMethods includesIdentical:aMethod ].
].
- ].
+ wanted ifTrue:[
+ aMethod selector isSymbol ifTrue:[
+ interestingMethods add:aMethod
+ ] ifFalse:[
+ Transcript showCR:'skipping non-symbol method ',aMethod selector.
+ ].
+ ].
+ ]
]
]
].
interestingMethods notEmpty ifTrue:[
first := true.
- privacy := nil.
+ prevPrivacy := nil.
"/
"/ sort by selector
@@ -332,9 +323,11 @@
sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m].
sortedSelectors sortWith:interestingMethods.
- interestingMethods do:[:aMethod |
+ interestingMethods do:[:eachMethod |
+ privacy := eachMethod privacy.
+
first ifFalse:[
- privacy ~~ aMethod privacy ifTrue:[
+ privacy ~~ prevPrivacy ifTrue:[
first := true.
aStream space.
aStream nextPutChunkSeparator.
@@ -342,8 +335,6 @@
aStream cr; cr
].
- privacy := aMethod privacy.
-
first ifTrue:[
aStream nextPutChunkSeparator.
aClass printClassNameOn:aStream.
@@ -358,14 +349,10 @@
aStream nextPutChunkSeparator; cr; cr.
first := false.
].
- source := aMethod source.
- source isNil ifTrue:[
- Class fileOutErrorSignal
- raiseRequestWith:aClass
- errorString:' - no source for method: ', (aMethod displayString)
- ] ifFalse:[
- aStream nextChunkPut:source.
- ].
+ self fileOutMethod:eachMethod on:aStream.
+ methodsAlreadySaved add:eachMethod.
+
+ prevPrivacy := privacy.
].
aStream space.
aStream nextPutChunkSeparator.
@@ -384,10 +371,56 @@
self fileOutCategory:aCategory of:aClass except:nil only:nil methodFilter:methodFilter on:aStream
"Created: 1.4.1997 / 16:04:44 / stefan"
+!
+
+fileOutMethod:aMethod on:aStream
+ "file a single method onto aStream."
+
+ |source|
+
+ source := aMethod source.
+ source isNil ifTrue:[
+ Class fileOutErrorSignal
+ raiseRequestWith:aMethod mclass
+ errorString:' - no source for method: ', (aMethod displayString)
+ ] ifFalse:[
+ aStream nextChunkPut:source.
+ ].
+!
+
+generateHeaderWithCopyrightOn:outStream
+ |copyrightMethod copyrightText|
+
+ "if there is a copyright method, add a copyright comment
+ at the beginning, taking the string from the copyright method.
+ We cannot do this unconditionally - that would lead to my copyrights
+ being put on your code ;-).
+ On the other hand: I want every file created by myself to have the
+ copyright string at the beginning be preserved .... even if the
+ code was edited in the browser and filedOut."
+
+ (copyrightMethod := classBeingSaved theMetaclass compiledMethodAt:#copyright) notNil ifTrue:[
+ "
+ get the copyright method's comment-text, strip off empty and blank lines
+ and insert at beginning.
+ "
+ copyrightText := copyrightMethod comment.
+ copyrightText notEmptyOrNil ifTrue:[
+ copyrightText := copyrightText asCollectionOfLines asStringCollection.
+ copyrightText := copyrightText withoutLeadingBlankLines.
+ copyrightText := copyrightText withoutTrailingBlankLines.
+ copyrightText notEmpty ifTrue:[
+ copyrightText addFirst:'"'.
+ copyrightText addLast:'"'.
+ copyrightText := copyrightText asString.
+ outStream nextPutAllAsChunk:copyrightText.
+ ].
+ ].
+ ].
! !
!SmalltalkChunkFileSourceWriter class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.7 2009-05-14 12:29:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.8 2009-08-13 15:54:45 cg Exp $'
! !