--- a/ChangeSet.st Wed Mar 14 22:18:07 2012 +0000
+++ b/ChangeSet.st Thu Mar 15 19:55:46 2012 +0000
@@ -34,6 +34,20 @@
privateIn:ChangeSet
!
+SmalltalkChunkFileSourceWriter subclass:#ClassSourceWriter
+ instanceVariableNames:'changeSetBeingSaved infos topClassName classInfos metaInfos'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ChangeSet
+!
+
+Object subclass:#ClassInfo
+ instanceVariableNames:'name superclass definition methods'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ChangeSet::ClassSourceWriter
+!
+
Object subclass:#DiffSet
instanceVariableNames:'changed onlyInReceiver onlyInArg'
classVariableNames:''
@@ -2660,6 +2674,490 @@
^ self handleRenameClassChange.
! !
+!ChangeSet::ClassSourceWriter methodsFor:'private'!
+
+analyze
+ "Analyzes changeset an build some index"
+
+ classInfos := Dictionary new.
+ metaInfos := Dictionary new.
+ topClassName := nil.
+ "Pass 1 - collect classes"
+ changeSetBeingSaved do:[:change|
+ change isClassDefinitionChange ifTrue:[
+ | nm |
+
+ nm := change className.
+ (nm endsWith:' class') ifFalse:[
+ (classInfos includesKey: nm) ifTrue:[
+ self error:'Multiple definitions of class ', nm.
+ ^self.
+ ].
+ classInfos at: nm put: (ClassInfo new name: nm).
+ metaInfos at: nm put: (ClassInfo new name: nm , ' class').
+ change isPrivateClassDefinitionChange ifFalse:[
+ topClassName notNil ifTrue:[
+ self error: ('Multiple top class definitions (%1 vs %2)' bindWith: topClassName with: nm).
+ ].
+ topClassName := nm.
+ ]
+ ].
+ ]
+ ].
+
+ "Pass 2: fill in infos"
+ changeSetBeingSaved do:[:change|
+ | nm info |
+
+ nm := change className.
+ (nm endsWith: ' class') ifTrue:[
+ info := metaInfos at: (nm copyTo:(nm size - 6)).
+ ] ifFalse:[
+ info := classInfos at: nm.
+ "Fill superclass info..."
+ change isClassDefinitionChange ifTrue:[
+ | superNm |
+ superNm := change superClassName.
+ (classInfos includesKey: superNm) ifTrue:[
+ info superclass: (classInfos at: superNm).
+ (metaInfos at: nm) superclass: (classInfos at: superNm).
+ ].
+ ].
+ ].
+ info addChange: change.
+
+
+
+
+ ].
+
+
+ "
+ ChangeSet::ClassSourceWriter new
+ changeSetBeingSaved: (ChangeSet forExistingClass: ChangeSet);
+ analyze;
+ yourself
+
+ "
+
+ "Created: / 15-03-2012 / 17:51:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+changeSetBeingSaved:something
+ changeSetBeingSaved := something.
+!
+
+privateClassesOf: classInfo
+
+ ^classInfos values select:[:info|
+ info name size > classInfo name size and:[
+ (info name indexOf: $: startingAt: classInfo name size + 3) == 0.
+ ]
+ ]
+
+ "Created: / 15-03-2012 / 19:31:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+privateClassesSortedOf: classInfo
+
+ |classes|
+
+ classes := self privateClassesOf: classInfo.
+ (classes size > 0) ifTrue:[
+ classes := classes asOrderedCollection.
+ classes sort:[:a :b | a name < b name].
+
+ classes topologicalSort:[:a :b |
+ "/ a must come before b iff:
+ "/ b is a subclass of a
+ "/ b has a private class which is a subclass of a
+
+ |mustComeBefore pivateClassesOfB|
+ mustComeBefore := (b isSubclassOf:a) or:[b isPrivateClassOf: a].
+ mustComeBefore
+ ].
+ ].
+ ^ classes.
+
+ "
+ Object privateClassesSorted
+ NewSystemBrowser privateClassesSorted
+ NewSystemBrowser privateClasses
+ "
+
+ "Created: / 15-03-2012 / 19:45:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ChangeSet::ClassSourceWriter methodsFor:'source writing'!
+
+fileOut:aChangeSet on:outStreamArg withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
+
+ |collectionOfCategories versionMethods
+ nonMeta meta classesImplementingInitialize outStream|
+
+ changeSetBeingSaved := aChangeSet.
+ self analyze.
+ nonMeta := classInfos at: topClassName.
+ meta := metaInfos at: topClassName.
+
+ methodsAlreadySaved := Set new.
+
+ 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.
+ "
+ self generateHeaderWithCopyrightOn:outStream.
+
+ 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.
+"/ ].
+ "/
+ "/ ST/X primitive definitions - if any
+ "/
+ self fileOutPrimitiveSpecsOf: nonMeta on:outStream.
+ ].
+
+ ^self.
+
+ "/
+ "/ 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.
+ versionMethods := meta methodDictionary values select:[:mthd | mthd isVersionMethod].
+
+ collectionOfCategories notNil ifTrue:[
+ "/
+ "/ documentation first (if any), but not the version method
+ "/
+ (collectionOfCategories includes:'documentation') ifTrue:[
+
+"/ versionMethods do:[:versionMethod |
+"/ |source|
+"/
+"/ source := versionMethod source.
+"/ (source isEmptyOrNil or:[(source startsWith:nonMeta nameOfOldVersionMethod) not]) ifTrue:[
+"/ "something bad happend to the classes code"
+"/
+"/ Class fileOutErrorSignal
+"/ raiseRequestWith:aClass
+"/ errorString:' - bad source for version method (uncompiled class file?): ', (versionMethod displayString)
+"/ ].
+"/ ].
+
+ self fileOutCategory:'documentation' of:meta except:versionMethods 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
+ ]
+ ]
+ ].
+
+ "/ 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
+ "/
+ 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
+ "/
+ versionMethods notEmpty ifTrue: [
+ self fileOutCategory:'documentation' of:meta except:nil only:versionMethods 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: / 01-04-1997 / 16:01:05 / stefan"
+ "Modified: / 29-09-2011 / 14:53:49 / cg"
+ "Created: / 15-03-2012 / 17:39:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+fileOutAllDefinitionsOf:nonMetaInfo on:aStream
+ "append expressions on aStream, which defines myself and all of my private classes."
+
+ | metaInfo |
+
+ aStream nextPutAll: nonMetaInfo definition source.
+ aStream nextPutChunkSeparator.
+ aStream cr; cr.
+
+ "/
+ "/ optional classInstanceVariables
+ "/
+ metaInfo := metaInfos at: nonMetaInfo name.
+ metaInfo definition notNil ifTrue:[
+ aStream nextPutAll: metaInfo definition source.
+ 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:[
+ (self privateClassesSortedOf: nonMetaInfo) do:[:i |
+ self fileOutAllDefinitionsOf:i on:aStream
+ ]
+ ]
+ ].
+
+ "Created: / 15-10-1996 / 11:15:19 / cg"
+ "Modified: / 22-03-1997 / 16:11:56 / cg"
+ "Created: / 15-03-2012 / 19:18:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+fileOutPrimitiveSpecsOf: nonMeta on:outStream
+
+ "Nothing now..."
+
+ "Created: / 15-03-2012 / 19:48:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+generateHeaderWithCopyrightOn:outStream
+ |copyrightChange copyrightText|
+
+ copyrightChange :=
+ (metaInfos at: topClassName) methodAt: #copyright.
+
+
+ copyrightChange notNil ifTrue:[
+ "
+ get the copyright method's comment-text, strip off empty and blank lines
+ and insert at beginning.
+ "
+ copyrightText := Parser methodCommentFromSource: copyrightChange source.
+ 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.
+ ].
+ ].
+ ].
+
+ "Created: / 15-03-2012 / 19:01:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ChangeSet::ClassSourceWriter::ClassInfo class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
+!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'accessing'!
+
+definition
+ ^ definition
+!
+
+definition:something
+ definition := something.
+!
+
+methodAt: selector
+ ^methods detect:[:each|each selector == selector] ifNone:[nil].
+
+ "Created: / 15-03-2012 / 19:11:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methods
+ ^ methods
+!
+
+methods:something
+ methods := something.
+!
+
+name
+ ^ name
+!
+
+name:something
+ name := something.
+!
+
+superclass
+ ^ superclass
+!
+
+superclass:something
+ superclass := something.
+! !
+
+!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'adding'!
+
+addChange: change
+
+ change isClassDefinitionChange ifTrue:[
+ definition := change.
+ ^self.
+ ].
+ change isMethodCodeChange ifTrue:[
+ methods add: change.
+ ^self.
+ ].
+
+ self error: 'Unknown change'
+
+ "Created: / 15-03-2012 / 19:12:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'initialization'!
+
+initialize
+ "Invoked when a new instance is created."
+
+ "/ please change as required (and remove this comment)
+ "/ name := nil.
+ "/ instDefinition := nil.
+ "/ classDefinition := nil.
+ methods := OrderedCollection new.
+
+ "/ super initialize. -- commented since inherited method does nothing
+
+ "Modified: / 15-03-2012 / 19:12:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'printing & storing'!
+
+printOn:aStream
+ "append a printed representation if the receiver to the argument, aStream"
+
+ super printOn:aStream.
+ aStream nextPutAll:'('.
+ name printOn:aStream.
+ aStream nextPutAll:')'.
+
+ "Modified: / 15-03-2012 / 19:49:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'queries'!
+
+isPrivateClassOf: classInfo
+
+ ^name startsWith: classInfo name
+
+ "Created: / 15-03-2012 / 19:42:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+isSubclassOf: classInfo
+
+ ^superclass notNil and:
+ [superclass == classInfo or:[superclass isSubclassOf: classInfo]]
+
+ "Created: / 15-03-2012 / 19:41:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!ChangeSet::DiffSet class methodsFor:'documentation'!
documentation
@@ -3035,5 +3533,5 @@
!
version_SVN
- ^ '$Id: ChangeSet.st 1879 2012-02-11 22:06:36Z vranyj1 $'
+ ^ '$Id: ChangeSet.st 1894 2012-03-15 19:55:46Z vranyj1 $'
! !