--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SmalltalkChunkFileSourceWriter.st Fri Mar 19 09:16:43 2004 +0100
@@ -0,0 +1,360 @@
+"{ Package: 'stx:libbasic' }"
+
+Object subclass:#SmalltalkChunkFileSourceWriter
+ instanceVariableNames:'classBeingSaved'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes'
+!
+
+
+!SmalltalkChunkFileSourceWriter methodsFor:'source writing'!
+
+fileOut:aClass on:outStreamArg withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
+ "file out my definition and all methods onto aStream.
+ If stampIt is true, a timeStamp comment is prepended.
+ If initIt is true, and the class implements a class-initialize method,
+ append a corresponding doIt expression for initialization.
+ 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
+ nonMeta meta classesImplementingInitialize outStream|
+
+ nonMeta := aClass theNonMetaclass.
+ meta := nonMeta class.
+
+ nonMeta isLoaded ifFalse:[
+ ^ ClassDescription fileOutErrorSignal
+ raiseRequestWith:nonMeta
+ errorString:' - will not fileOut unloaded class: ', nonMeta name
+ ].
+
+ encoderOrNil isNil ifTrue:[
+ outStream := outStreamArg.
+ ] ifFalse:[
+ outStream := EncodedStream stream:outStreamArg encoder:encoderOrNil.
+ outStream nextPutAll:'"{ Encoding: ' , encoderOrNil nameOfEncoding , ' }"'; cr; cr.
+ ].
+
+ "
+ 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 := meta compiledMethodAt:#copyright) notNil ifTrue:[
+ "
+ get the copyright methods source,
+ and insert at beginning.
+ "
+ copyrightText := copyrightMethod source.
+ copyrightText isNil ifTrue:[
+ "
+ no source available - trigger an error
+ "
+ ClassDescription fileOutErrorSignal
+ raiseRequestWith:nonMeta
+ errorString:('no source for class ' , nonMeta name , ' available. Cannot fileOut').
+ ^ self
+ ].
+ "
+ strip off the selector-line
+ "
+ copyrightText := copyrightText asCollectionOfLines asStringCollection.
+ copyrightText := copyrightText copyFrom:2 to:(copyrightText size).
+"/ copyrightText do:[:line | outStream nextPutAll:line. aStream cr.].
+ copyrightText := copyrightText asString.
+ outStream nextPutAllAsChunk:copyrightText.
+ ].
+
+ stampIt ifTrue:[
+ "/
+ "/ first, a timestamp
+ "/
+ outStream nextPutAll:(Smalltalk timeStamp).
+ outStream nextPutChunkSeparator.
+ outStream cr; cr.
+ ].
+
+ withDefinition ifTrue:[
+ "/
+ "/ then the definition(s)
+ "/
+ self fileOutAllDefinitionsOf:nonMeta on:outStream.
+ "/
+ "/ a comment - if any
+ "/
+ (comment := nonMeta comment) notNil ifTrue:[
+ nonMeta fileOutCommentOn:outStream.
+ outStream cr.
+ ].
+ "/
+ "/ primitive definitions - if any
+ "/
+ nonMeta fileOutPrimitiveSpecsOn:outStream.
+ ].
+
+ "/
+ "/ methods from all categories in metaclass (i.e. class methods)
+ "/ EXCEPT: the version method is placed at the very end, to
+ "/ avoid sourcePosition-shifts when checked out later.
+ "/ (RCS expands this string, so its size is not constant)
+ "/
+ collectionOfCategories := meta categories asSortedCollection.
+ collectionOfCategories notNil ifTrue:[
+ "/
+ "/ documentation first (if any), but not the version method
+ "/
+ (collectionOfCategories includes:'documentation') ifTrue:[
+ versionMethod := meta compiledMethodAt:(nonMeta nameOfVersionMethod).
+ versionMethod notNil ifTrue:[
+ skippedMethods := Array with:versionMethod
+ ].
+ self fileOutCategory:'documentation' of:meta except:skippedMethods only:nil methodFilter:methodFilter on:outStream.
+ outStream cr.
+ ].
+
+ "/
+ "/ initialization next (if any)
+ "/
+ (collectionOfCategories includes:'initialization') ifTrue:[
+ self fileOutCategory:'initialization' of:meta methodFilter:methodFilter on:outStream.
+ outStream cr.
+ ].
+
+ "/
+ "/ instance creation next (if any)
+ "/
+ (collectionOfCategories includes:'instance creation') ifTrue:[
+ self fileOutCategory:'instance creation' of:meta methodFilter:methodFilter on:outStream.
+ outStream cr.
+ ].
+ collectionOfCategories do:[:aCategory |
+ ((aCategory ~= 'documentation')
+ and:[(aCategory ~= 'initialization')
+ and:[aCategory ~= 'instance creation']]) ifTrue:[
+ self fileOutCategory:aCategory of:meta methodFilter:methodFilter on:outStream.
+ outStream cr
+ ]
+ ]
+ ].
+
+ "/
+ "/ methods from all categories
+ "/
+ collectionOfCategories := nonMeta categories asSortedCollection.
+ collectionOfCategories notNil ifTrue:[
+ collectionOfCategories do:[:aCategory |
+ self fileOutCategory:aCategory of:nonMeta methodFilter:methodFilter on:outStream.
+ outStream cr
+ ]
+ ].
+
+ "/
+ "/ any private classes' methods
+ "/
+ nonMeta privateClassesSorted do:[:aClass |
+ self fileOutAllMethodsOf:aClass on:outStream methodFilter:methodFilter
+ ].
+
+
+ "/
+ "/ finally, the previously skipped version method
+ "/
+ versionMethod notNil ifTrue:[
+ self fileOutCategory:'documentation' of:meta except:nil only:skippedMethods methodFilter:methodFilter on:outStream.
+ ].
+
+ initIt ifTrue:[
+ "/
+ "/ optionally an initialize message
+ "/
+ classesImplementingInitialize := OrderedCollection new.
+
+ (meta includesSelector:#initialize) ifTrue:[
+ classesImplementingInitialize add:nonMeta
+ ].
+ nonMeta privateClassesSorted do:[:aPrivateClass |
+ (aPrivateClass theMetaclass includesSelector:#initialize) ifTrue:[
+ classesImplementingInitialize add:aPrivateClass
+ ]
+ ].
+ classesImplementingInitialize size ~~ 0 ifTrue:[
+ classesImplementingInitialize topologicalSort:[:a :b | b isSubclassOf:a].
+ outStream cr.
+ classesImplementingInitialize do:[:eachClass |
+ eachClass printClassNameOn:outStream. outStream nextPutAll:' initialize'.
+ outStream nextPutChunkSeparator.
+ outStream cr.
+ ].
+ ].
+ ]
+
+ "Created: / 15.11.1995 / 12:53:06 / cg"
+ "Modified: / 1.4.1997 / 16:01:05 / stefan"
+ "Modified: / 13.3.1998 / 12:23:59 / cg"
+!
+
+fileOutAllDefinitionsOf:aNonMetaClass on:aStream
+ "append expressions on aStream, which defines myself and all of my private classes."
+
+ aNonMetaClass fileOutDefinitionOn:aStream.
+ aStream nextPutChunkSeparator.
+ aStream cr; cr.
+
+ "/
+ "/ optional classInstanceVariables
+ "/
+ aNonMetaClass class instanceVariableString isBlank ifFalse:[
+ aNonMetaClass fileOutClassInstVarDefinitionOn:aStream.
+ aStream nextPutChunkSeparator.
+ aStream cr; cr
+ ].
+
+ "/ here, the full nameSpace prefixes are output,
+ "/ to avoid confusing stc
+ "/ (which otherwise could not find the correct superclass)
+ "/
+ Class fileOutNameSpaceQuerySignal answer:false do:[
+ Class forceNoNameSpaceQuerySignal answer:true do:[
+ aNonMetaClass privateClassesSorted do:[:aClass |
+ self fileOutAllDefinitionsOf:aClass on:aStream
+ ]
+ ]
+ ].
+
+ "Created: 15.10.1996 / 11:15:19 / cg"
+ "Modified: 22.3.1997 / 16:11:56 / cg"
+!
+
+fileOutAllMethodsOf:aClass on:aStream methodFilter:methodFilter
+ |collectionOfCategories|
+
+ collectionOfCategories := aClass class categories asSortedCollection.
+ collectionOfCategories notNil ifTrue:[
+ collectionOfCategories do:[:aCategory |
+ self fileOutCategory:aCategory of:aClass class methodFilter:methodFilter on:aStream.
+ aStream cr
+ ]
+ ].
+ collectionOfCategories := aClass categories asSortedCollection.
+ collectionOfCategories notNil ifTrue:[
+ collectionOfCategories do:[:aCategory |
+ self fileOutCategory:aCategory of:aClass methodFilter:methodFilter on:aStream.
+ aStream cr
+ ]
+ ].
+
+ aClass privateClassesSorted do:[:aClass |
+ self fileOutAllMethodsOf:aClass on:aStream methodFilter:methodFilter
+ ].
+
+ "Created: 15.10.1996 / 11:13:00 / cg"
+ "Modified: 22.3.1997 / 16:12:17 / cg"
+!
+
+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."
+
+ |dict source sortedSelectors first privacy interestingMethods cat|
+
+ dict := aClass methodDictionary.
+ dict notNil ifTrue:[
+ interestingMethods := OrderedCollection new.
+ dict do:[:aMethod |
+ |wanted|
+
+ (methodFilter isNil
+ or:[methodFilter value:aMethod]) ifTrue:[
+ (aCategory = aMethod category) ifTrue:[
+ skippedMethods notNil ifTrue:[
+ wanted := (skippedMethods includesIdentical:aMethod) not
+ ] ifFalse:[
+ savedMethods notNil ifTrue:[
+ wanted := (savedMethods includesIdentical:aMethod).
+ ] ifFalse:[
+ wanted := true
+ ]
+ ].
+ wanted ifTrue:[interestingMethods add:aMethod].
+ ]
+ ]
+ ].
+ interestingMethods notEmpty ifTrue:[
+ first := true.
+ privacy := nil.
+
+ "/
+ "/ sort by selector
+ "/
+ sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m].
+ sortedSelectors sortWith:interestingMethods.
+
+ interestingMethods do:[:aMethod |
+ first ifFalse:[
+ privacy ~~ aMethod privacy ifTrue:[
+ first := true.
+ aStream space.
+ aStream nextPutChunkSeparator.
+ ].
+ aStream cr; cr
+ ].
+
+ privacy := aMethod privacy.
+
+ first ifTrue:[
+ aStream nextPutChunkSeparator.
+ aClass printClassNameOn:aStream.
+ privacy ~~ #public ifTrue:[
+ aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'.
+ ] ifFalse:[
+ aStream nextPutAll:' methodsFor:'.
+ ].
+ cat := aCategory.
+ cat isNil ifTrue:[ cat := '' ].
+ aStream nextPutAll:aCategory asString storeString.
+ 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.
+ ].
+ ].
+ aStream space.
+ aStream nextPutChunkSeparator.
+ aStream cr
+ ]
+ ]
+
+ "Modified: 28.8.1995 / 14:30:41 / claus"
+ "Modified: 12.6.1996 / 11:37:33 / stefan"
+ "Modified: 15.11.1996 / 11:32:21 / cg"
+ "Created: 1.4.1997 / 16:04:33 / stefan"
+!
+
+fileOutCategory:aCategory of:aClass methodFilter:methodFilter on:aStream
+ "file out all methods belonging to aCategory, aString onto aStream"
+
+ self fileOutCategory:aCategory of:aClass except:nil only:nil methodFilter:methodFilter on:aStream
+
+ "Created: 1.4.1997 / 16:04:44 / stefan"
+! !
+
+!SmalltalkChunkFileSourceWriter class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.1 2004-03-19 08:16:43 ca Exp $'
+! !