--- a/VSEPackageFileSourceWriter.st Thu Feb 05 14:16:31 2015 +0100
+++ b/VSEPackageFileSourceWriter.st Thu Feb 05 14:16:40 2015 +0100
@@ -75,7 +75,10 @@
!VSEPackageFileSourceWriter methodsFor:'source writing'!
fileOut:aClass on:aStream withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
- |commentOrDocumentation skipDocumentationMethod|
+ |commentOrDocumentation skipDocumentationMethod hasInitialize|
+
+ hasInitialize := false.
+ skipDocumentationMethod := false.
aStream nextPutAll:'Class '.
aStream nextPutAll:(self rewrittenClassNameOf:aClass).
@@ -86,7 +89,6 @@
aStream nextPutAll:(self rewrittenClassNameOf:aClass superclass).
aStream nextPutLine:'!!'.
- skipDocumentationMethod := false.
(commentOrDocumentation := aClass comment) isEmptyOrNil ifTrue:[
(commentOrDocumentation := aClass commentOrDocumentationString) notEmptyOrNil ifTrue:[
skipDocumentationMethod := true
@@ -126,132 +128,21 @@
(skipDocumentationMethod and:[sel == #documentation]) ifTrue:[
"/ skip method
] ifFalse:[
+ sel == #initialize ifTrue:[
+ hasInitialize := true.
+ ].
self fileOutMethod:(aClass class methodDictionary at:sel) isExtension:false on:aStream.
].
].
- self putEntry:'EndClass' value:nil on:aStream.
-!
-
-fileOutCategory:aCategory of:aClass except:skippedMethods only:savedMethods methodFilter:methodFilter on:aStream
- "file out all methods belonging to aCategory, aString onto aStream.
- If skippedMethods is nonNil, those are not saved.
- If savedMethods is nonNil, only those are saved.
- If both are nil, all are saved. See version-method handling in
- fileOut for what this is needed."
-
- |sortedSelectors first prevPrivacy privacy interestingMethods|
-
-self halt:'should not be called'.
- interestingMethods := OrderedCollection new.
- aClass methodsDo:[:aMethod |
- |wanted|
-
- (methodsAlreadySaved includes:aMethod) ifFalse:[
- (aCategory = aMethod category) ifTrue:[
- (methodFilter isNil or:[methodFilter value:aMethod]) ifTrue:[
- skippedMethods notNil ifTrue:[
- wanted := (skippedMethods includesIdentical:aMethod) not
- ] ifFalse:[
- 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 printString.
- ].
- ].
- ]
- ]
- ]
- ].
- interestingMethods notEmpty ifTrue:[
- first := true.
- prevPrivacy := nil.
-
- "/
- "/ sort by selector
- "/
- sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m].
- sortedSelectors sortWith:interestingMethods.
+ hasInitialize ifTrue:[
+ |initializerCode|
- interestingMethods do:[:eachMethod |
- privacy := eachMethod privacy.
-
- first ifFalse:[
- privacy ~~ prevPrivacy ifTrue:[
- first := true.
- aStream space.
- aStream nextPutChunkSeparator.
- ].
- aStream cr; cr
- ].
-
- first ifTrue:[
- aStream nextPutChunkSeparator.
- aClass printClassNameOn:aStream.
- privacy ~~ #public ifTrue:[
- aStream nextPutAll:' privateMethods'.
- ] ifFalse:[
- aStream nextPutAll:' publicMethods'.
- ].
- aStream nextPutChunkSeparator; cr; cr.
- first := false.
- ].
- self fileOutMethod:eachMethod on:aStream.
- methodsAlreadySaved add:eachMethod.
-
- prevPrivacy := privacy.
- ].
- aStream space.
- aStream nextPutChunkSeparator.
- aStream cr
- ].
- aStream cr
-!
-
-fileOutDefinitionOf:aClass on:aStream
- "append an expression on aStream, which defines myself."
-
- |s owner ns superclass nm|
-
-self halt:'should not be called'.
- owner := aClass owningClass.
- ns := aClass topNameSpace.
-
- "take care of nil-superclass"
- superclass := aClass superclass.
- superclass isNil ifTrue:[
- s := 'nil'
- ] ifFalse:[
- s := superclass nameWithNameSpacePrefix.
+ initializerCode := (self rewrittenClassNameOf:aClass), ' initialize.'.
+ self putEntry:'Initialization' value:initializerCode on:aStream.
].
- aStream nextPutAll:s. "/ superclass
- aStream space.
- aClass basicFileOutInstvarTypeKeywordOn:aStream.
-
- nm := aClass nameWithoutPrefix.
- aStream nextPut:$#.
- aStream nextPutAll:nm.
-
- aStream crtab.
- aStream nextPutAll:'instanceVariableNames:'''.
- aClass printInstVarNamesOn:aStream indent:16.
- aStream nextPutAll:''''.
-
- aStream crtab.
- aStream nextPutAll:'classVariableNames:'''.
- aClass printClassVarNamesOn:aStream indent:16.
- aStream nextPutAll:''''.
-
- aStream crtab.
- aStream nextPutAll:'poolDictionaries:'''.
- aClass printSharedPoolNamesOn:aStream indent:16.
- aStream nextPutAll:''''.
-
- aStream cr.
+ self putEntry:'EndClass' value:nil on:aStream.
!
fileOutMethod:aMethod isExtension:isExtension on:aStream
@@ -292,6 +183,15 @@
possiblyRewrittenSource := (rewriteQuery query) ? originalSource.
isExtension ifTrue:[
+ "/ hack for LPReal -> move to Float, unles defined there.
+ mclass theNonMetaclass == LimitedPrecisionReal ifTrue:[
+ (Float implements:sel) ifTrue:[
+ self halt:'method skipped'.
+ ^ self.
+ ].
+ self halt:'save for Float instead of LPReal'.
+ mclass := mclass isMeta ifTrue:[Float class] ifFalse:[Float].
+ ].
aStream nextPutAll:'MethodDefinition ',(self rewrittenClassNameOf:mclass theNonMetaclass).
] ifFalse:[
aStream nextPutAll:'Method'.
@@ -311,6 +211,66 @@
self putEntry:'' value:aMethod category on:aStream.
!
+fileOutPackage:packageID on:aStream
+ |classesToFileout methodsToFileOut rewriter|
+
+ projectDefinitionClass := packageID asPackageId projectDefinitionClass.
+ classesToBeInitialized := OrderedCollection new.
+
+ aStream lineEndCRLF.
+
+ "/ make sure that everything is loaded.
+ projectDefinitionClass notNil ifTrue:[
+ projectDefinitionClass autoload.
+ projectDefinitionClass ensureFullyLoaded.
+ classesToFileout := Smalltalk allClassesInPackage:packageID.
+ ] ifFalse:[
+ classesToFileout := Smalltalk allClassesInPackage:packageID.
+ classesToFileout := classesToFileout collect:[:each | each autoload].
+ ].
+
+ classesToFileout := classesToFileout reject:[:cls | cls isSubclassOf: ProjectDefinition ].
+ classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].
+
+ rewriter := self class vseSourceRewriter new.
+ rewriter classNamesToRewrite:classNameTranslations.
+
+ methodsToFileOut := self extensionMethodsFor:packageID.
+
+ self activityNotification:'checking for unportable unicode...'.
+ classesToFileout do:[:eachClass |
+ self ensureNoUnicodeInClass:eachClass
+ ].
+ methodsToFileOut do:[:eachClass |
+ self ensureNoUnicodeInMethod:eachClass
+ ].
+
+ self writeHeaderOn:aStream.
+
+ AbstractSourceFileWriter methodSourceRewriteQuery handle:[:rewriteQuery |
+ |method source|
+
+ method := rewriteQuery method.
+ source := rewriteQuery source.
+ source := rewriter rewriteMethod:method.
+ rewriteQuery proceedWith:source.
+ ] do:[
+ classesToFileout do:[:eachClass |
+ self activityNotification:'exporting ',eachClass name,'...'.
+ self fileOut:eachClass on:aStream.
+ ].
+
+ "/ fileout extensions
+ self activityNotification:'exporting extensions...'.
+ methodsToFileOut do:[:eachMethod |
+ self fileOutMethod:eachMethod isExtension:true on:aStream.
+ aStream cr.
+ ].
+ ].
+
+ self activityNotification:'done.'.
+!
+
putEntry:key value:value on:aStream
key notNil ifTrue:[
aStream nextPutAll:key.
@@ -403,90 +363,13 @@
self putEntry:nil value:author on:aStream.
! !
-!VSEPackageFileSourceWriter methodsFor:'utilities'!
-
-fileOutPackage:packageID on:aStream
- |classesToFileout methodsToFileOut rewriter|
-
- projectDefinitionClass := packageID asPackageId projectDefinitionClass.
- classesToBeInitialized := OrderedCollection new.
-
- aStream lineEndCRLF.
-
- "/ make sure that everything is loaded.
- projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass autoload.
- projectDefinitionClass ensureFullyLoaded.
- classesToFileout := Smalltalk allClassesInPackage:packageID.
- ] ifFalse:[
- classesToFileout := Smalltalk allClassesInPackage:packageID.
- classesToFileout := classesToFileout collect:[:each | each autoload].
- ].
-
- classesToFileout := classesToFileout reject:[:cls | cls isSubclassOf: ProjectDefinition ].
- classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].
-
- rewriter := self class vseSourceRewriter new.
- rewriter classNamesToRewrite:classNameTranslations.
-
- methodsToFileOut := self extensionMethodsFor:packageID.
-
- self activityNotification:'checking for unportable unicode...'.
- classesToFileout do:[:eachClass |
- self ensureNoUnicodeInClass:eachClass
- ].
- methodsToFileOut do:[:eachClass |
- self ensureNoUnicodeInMethod:eachClass
- ].
-
- self writeHeaderOn:aStream.
-
- AbstractSourceFileWriter methodSourceRewriteQuery handle:[:rewriteQuery |
- |method source|
-
- method := rewriteQuery method.
- source := rewriteQuery source.
- source := rewriter rewriteMethod:method.
- rewriteQuery proceedWith:source.
- ] do:[
- classesToFileout do:[:eachClass |
- self activityNotification:'exporting ',eachClass name,'...'.
- self fileOut:eachClass on:aStream.
- (eachClass theMetaclass includesSelector:#initialize) ifTrue:[
- classesToBeInitialized add:eachClass.
- ].
- ].
-
- "/ fileout extensions
- self activityNotification:'exporting extensions...'.
- methodsToFileOut do:[:eachMethod |
- self fileOutMethod:eachMethod isExtension:true on:aStream.
- aStream cr.
- ].
- ].
-
- classesToBeInitialized notEmpty ifTrue:[
- |initializerCode|
-
- initializerCode := String
- streamContents:[:s |
- classesToBeInitialized do:[:eachClass |
- s nextPutLine:(self rewrittenClassNameOf:eachClass), ' initialize.'.
- ]
- ].
- self putEntry:'Initialization' value:initializerCode on:aStream.
- ].
-
- self activityNotification:'done.'.
-! !
-
!VSEPackageFileSourceWriter class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.11 2015-02-05 11:40:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.12 2015-02-05 13:16:40 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.11 2015-02-05 11:40:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.12 2015-02-05 13:16:40 cg Exp $'
! !