"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic3' }"

OrderedCollection subclass:#ChangeSet

	instanceVariableNames:'changedClasses'

	classVariableNames:''

	poolDictionaries:''

	category:'System-Changes'

!

Object subclass:#DiffSet

	instanceVariableNames:'changed onlyInReceiver onlyInArg'

	classVariableNames:''

	poolDictionaries:''

	privateIn:ChangeSet

!

!ChangeSet class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    used in the changes management to keep track of changes

    [author:]

	Claus Gittinger

"

! !

!ChangeSet class methodsFor:'instance creation'!

changesFromParseTree:aTree andStream:aStream lineNumber:initialLineNumberOrNil position:initialPositionOrNil do:aBlock

    "given a parse-tree (from parsing some changes source/chunk),

     create changes and evaluate aBlock on each.

     The block is invoked with the change and a lineNumberOrNil as

     arg; the lineNumber is only valid, if the underlying stream 

     provides line-numbers; otherwise, nil is passed."

    |changes sel className categoryName 

     methodSource methodSelector change parser

     oldName newName priv receiver receiverVarName

     receiverSelector receiverReceiver primSource

     nameSpace lineNumberOrNil posOrNil|

     lineNumberOrNil := initialLineNumberOrNil.

     posOrNil := initialPositionOrNil.

"/    nameSpace := Class nameSpaceQuerySignal query.

"/    nameSpace isNil ifTrue:[nameSpace := Smalltalk].

    sel := aTree selector.

    receiver := aTree receiver.

    receiver isMessage ifTrue:[

        receiverSelector := receiver selector.

        receiverReceiver := receiver receiver.

    ] ifFalse:[

        receiver isVariable ifTrue:[

            receiverVarName := receiver name

        ]

    ].

    (sel == #'methods'

    or:[(sel == #'methodsFor:')

    or:[(sel == #'publicMethodsFor:')

    or:[(sel == #'privateMethodsFor:')

    or:[(sel == #'methodsFor:stamp:')

    or:[(sel == #'ignoredMethodsFor:')]]]]]) ifTrue:[

        (sel == #'ignoredMethodsFor:') ifTrue:[

            priv := #ignored.

        ] ifFalse:[

            priv := nil

        ].

        (receiver isUnaryMessage 

        and:[receiverSelector == #class]) ifTrue:[

            className := (receiverReceiver name) , ' class'.

        ] ifFalse:[

            className := (receiver name).

        ].

"/        nameSpace ~~ Smalltalk ifTrue:[

"/            className := nameSpace name , '::' , className

"/        ].

        sel == #'methods' ifTrue:[

            categoryName := 'uncategorized'

        ] ifFalse:[

            categoryName := (aTree arguments at:1) evaluate.

        ].

        aStream skipSeparators.

        lineNumberOrNil := aStream lineNumber.

        posOrNil := aStream position.

        methodSource := aStream nextChunk.

        changes := OrderedCollection new.

        [methodSource notEmpty] whileTrue:[

            parser := Parser

                        parseMethodArgAndVarSpecification:methodSource 

                        in:nil 

                        ignoreErrors:true 

                        ignoreWarnings:true

                        parseBody:false.

            parser isNil ifTrue:[

                "/ something wierd ...

                methodSelector := '????'.

            ] ifFalse:[

                methodSelector := parser selector.

            ].

            change := MethodChange new.

            change 

                className:className

                selector:methodSelector

                source:methodSource

                category:categoryName

                privacy:priv.

            aBlock value:change value:lineNumberOrNil value:posOrNil.

            aStream skipSeparators.

            lineNumberOrNil := aStream lineNumber.

            posOrNil := aStream position.

            methodSource := aStream nextChunk.

        ].

        ^ true

    ].

    sel == #'removeSelector:' ifTrue:[

        (receiver isUnaryMessage 

        and:[receiverSelector == #class]) ifTrue:[

            className := (receiverReceiver name) , ' class'.

        ] ifFalse:[

            className := (receiver name).

        ].

"/        nameSpace ~~ Smalltalk ifTrue:[

"/            className := nameSpace name , '::' , className

"/        ].

        methodSelector := (aTree arguments at:1) evaluate.

        change := MethodRemoveChange new.

        change 

            className:className

            selector:methodSelector.

        aBlock value:change value:lineNumberOrNil value:posOrNil.

        ^ true

    ].

    "/ any subclass definiton selector ?

    (Behavior definitionSelectors includes:sel)

    ifTrue:[

        className := (aTree arguments at:1) evaluate.

"/        nameSpace ~~ Smalltalk ifTrue:[

"/            className := nameSpace name , '::' , className

"/        ].

        nameSpace := Class nameSpaceQuerySignal query.

        nameSpace ~~ Smalltalk ifTrue:[

            className := nameSpace name , '::' , className

        ].

        change := ClassDefinitionChange new.

        change 

            className:className;

            source:(aTree printString).

        change package:(Class packageQuerySignal query).

"/        nameSpace ~~ Smalltalk ifTrue:[

"/            change nameSpaceName:(nameSpace name).

"/        ].

"/

        aBlock value:change value:lineNumberOrNil value:posOrNil.

        ^ true

    ].

    sel == #'renameCategory:to:' ifTrue:[

        (receiver isUnaryMessage 

        and:[receiverSelector == #class]) ifTrue:[

            className := (receiverReceiver name) , ' class'.

        ] ifFalse:[

            className := (receiver name).

        ].

"/        nameSpace ~~ Smalltalk ifTrue:[

"/            className := nameSpace name , '::' , className

"/        ].

        change := MethodCategoryRenameChange new.

        change 

            className:className;

            oldCategoryName:(aTree arguments at:1) evaluate

            newCategoryName:(aTree arguments at:2) evaluate.

        aBlock value:change value:lineNumberOrNil value:posOrNil.

        ^ true

    ].

    (sel == #'category:' 

    or:[sel == #'privacy:']) ifTrue:[

        (receiver isMessage

        and:[receiverSelector == #'compiledMethodAt:']) ifTrue:[

            (receiverReceiver isUnaryMessage 

            and:[receiverReceiver selector == #class]) ifTrue:[

                className := (receiverReceiver receiver name) , ' class'.

            ] ifFalse:[

                className := (receiverReceiver name).

            ].

"/            nameSpace ~~ Smalltalk ifTrue:[

"/                className := nameSpace name , '::' , className

"/            ].

            methodSelector := (receiver arguments at:1) evaluate.

            sel == #'category:' ifTrue:[

                change := MethodCategoryChange new.

                change 

                    className:className

                    selector:methodSelector

                    category:(aTree arguments at:1) evaluate.

            ] ifFalse:[

                change := MethodPrivacyChange new.

                change 

                    className:className

                    selector:methodSelector

                    privacy:(aTree arguments at:1) evaluate.

            ].

            aBlock value:change value:lineNumberOrNil value:posOrNil.

            ^ true

        ] ifFalse:[

        ].

    ].

    sel == #'comment:' ifTrue:[

        (receiver isUnaryMessage 

        and:[receiverSelector == #class]) ifTrue:[

            className := (receiverReceiver name) , ' class'.

        ] ifFalse:[

            className := (receiver name).

        ].

"/        nameSpace ~~ Smalltalk ifTrue:[

"/            className := nameSpace name , '::' , className

"/        ].

        change := ClassCommentChange new.

        change 

            className:className

            comment:(aTree arguments at:1) evaluate.

        change source:(aTree printString).

        aBlock value:change value:lineNumberOrNil value:posOrNil.

        ^ true

    ].

    sel == #'instanceVariableNames:' ifTrue:[

        (receiver isUnaryMessage 

        and:[receiverSelector == #class]) ifTrue:[

            className := (receiverReceiver name) , ' class'.

        ] ifFalse:[

            className := (receiver name).

        ].

"/        nameSpace ~~ Smalltalk ifTrue:[

"/            className := nameSpace name , '::' , className

"/        ].

        change := ClassInstVarDefinitionChange new.

        change className:className.

        change source:(aTree printString).

        aBlock value:change value:lineNumberOrNil value:posOrNil.

        ^ true

    ].

    sel == #'removeClass:' ifTrue:[

        (receiverVarName == #Smalltalk) ifTrue:[

            className := (aTree arguments at:1) name.

"/            nameSpace ~~ Smalltalk ifTrue:[

"/                className := nameSpace name , '::' , className

"/            ].

            change := ClassRemoveChange new.

            change className:className.

            aBlock value:change value:lineNumberOrNil value:posOrNil.

            ^ true

        ] ifFalse:[

        ].

    ].

    sel == #'renameClass:to:' ifTrue:[

        (receiverVarName == #Smalltalk) ifTrue:[

            oldName := (aTree arguments at:1) name.

            newName := (aTree arguments at:2) evaluate.

            change := ClassRenameChange new.

            change oldName:oldName newName:newName.

            aBlock value:change value:lineNumberOrNil value:posOrNil.

            ^ true

        ] ifFalse:[

        ].

    ].

    sel == #'name:' ifTrue:[

        ((receiverVarName == #Namespace) 

        or:[receiverVarName == #NameSpace]) ifTrue:[

            className := (aTree arguments at:1) evaluate.

            change := NameSpaceCreationChange new.

            change name:className.

            aBlock value:change value:lineNumberOrNil value:posOrNil.

            ^ true

        ] ifFalse:[

        ].

    ].

    (sel == #'primitiveDefinitions'

    or:[sel == #'primitiveFunctions'

    or:[sel == #'primitiveVariables']]) ifTrue:[

        (receiver isUnaryMessage 

        and:[receiverSelector == #class]) ifTrue:[

            className := (receiverReceiver name) , ' class'.

        ] ifFalse:[

            className := (receiver name).

        ].

"/        nameSpace ~~ Smalltalk ifTrue:[

"/            className := nameSpace name , '::' , className

"/        ].

        aStream skipSeparators.

        primSource := aStream nextChunk.

        sel == #'primitiveDefinitions' ifTrue:[

            change := ClassPrimitiveDefinitionsChange new

        ] ifFalse:[

            sel == #'primitiveFunctions' ifTrue:[

                change := ClassPrimitiveFunctionsChange new

            ] ifFalse:[

                change := ClassPrimitiveVariablesChange new

            ]

        ].

        change class:className source:primSource.

        aBlock value:change value:lineNumberOrNil value:posOrNil.

        ^ true

    ].

    ^ false

    "Created: / 16.2.1998 / 13:42:40 / cg"

    "Modified: / 15.12.1999 / 00:29:06 / cg"

!

changesFromStream:aStream do:aBlock

    "enumerate changes from a stream and invoke aBlock on each.

     The block is invoked with the change and a lineNumberOrNil as

     arg; the lineNumber is only valid, if the underlying stream 

     provides line-numbers; otherwise, nil is passed."

    |chunk sawExcla lastTimeStamp s change nameSpace package

     lineNumber pos|

    nameSpace := Smalltalk.

    package := Class packageQuerySignal query.

    [aStream atEnd] whileFalse:[

        aStream skipSeparators.

        sawExcla := aStream peekFor:$!!.

        lineNumber := aStream lineNumber.

        pos := aStream position.

        chunk := aStream nextChunk.

        (chunk notNil and:[chunk notEmpty]) ifTrue:[

            Class nameSpaceQuerySignal answer:nameSpace do:[

                |parser tree ns pkg|

                parser := Parser for:chunk.

                tree := parser 

                            parseExpressionWithSelf:nil 

                            notifying:nil 

                            ignoreErrors:true 

                            ignoreWarnings:true 

                            inNameSpace:nameSpace.

                tree == #Error ifTrue:[

                    change := DoItChange new.

                    change source:chunk.

                    aBlock value:change value:lineNumber value:pos.

                ] ifFalse:[    

                    (tree notNil and:[tree ~~ #Error]) ifTrue:[

                        "/ if there is any nameSpace directive in there, extract it.

                        ((ns := parser currentNameSpace) notNil 

                        and:[ns ~~ nameSpace]) ifTrue:[

                            nameSpace := ns

                        ].

                        "/ if there is any package directive in there, extract it.

                        ((pkg := parser currentPackage) notNil 

                        and:[pkg ~~ package]) ifTrue:[

                            package := pkg

                        ].

                        Class packageQuerySignal answer:package do:[

                            Class nameSpaceQuerySignal answer:nameSpace do:[

                                "/

                                "/ what type of chunk is this ...

                                "/

                                tree isConstant ifTrue:[

                                    (s := tree evaluate) isString ifTrue:[

                                        (s startsWith:'---- timestamp ') ifTrue:[

                                            lastTimeStamp := s.

                                        ]

                                    ] ifFalse:[

                                    ]

                                ] ifFalse:[

                                    tree isMessage ifTrue:[

                                        (self 

                                                changesFromParseTree:tree 

                                                andStream:aStream

                                                lineNumber:lineNumber

                                                position:pos

                                                do:aBlock) ifFalse:[

                                            change := DoItChange new.

                                            change source:chunk.

                                            aBlock value:change value:lineNumber value:pos.

                                        ]

                                    ] ifFalse:[

                                    ]

                                ]

                            ]

                        ]

                    ]

                ]

            ]

        ]

    ].

    "

     ChangeSet fromStream:('changes' asFilename readStream)

     ChangeSet fromStream:('patches' asFilename readStream)

     ChangeSet fromStream:(Object source asString readStream)

    "

    "Created: / 16.2.1998 / 12:19:34 / cg"

    "Modified: / 14.12.1999 / 15:23:16 / cg"

!

forExistingClass:aClass

    "build a changeSet for some given class.

     That does of course not give deltas, but instead reflects the current

     state of the given class.

     It is useful in conjunction with the other utility methods,

     for example, when building patchLists, diffSets etc."

    |source changeSet chunk sawExcla lastTimeStamp s change nameSpace|

    s := '' writeStream.

    aClass fileOutOn:s.

    source := s contents.

    changeSet := self fromStream:(source readStream).

    ^ changeSet

"/    changeSet := self new.

"/    nameSpace := Smalltalk.

"/

"/    "/ first, a classDefinition change ...

"/    changeSet addClassDefinitionChangeFor:aClass.

"/    "/ are there any class-instVars ?

"/    aClass class instVarNames size > 0 ifTrue:[

"/        changeSet addInstVarDefinitionChangeFor:aClass class.

"/    ].

"/    "/ a comment ?

"/    aClass comment size > 0 ifTrue:[

"/        changeSet addClassCommentChangeFor:aClass.

"/    ].

"/

"/    "/ class methods first ...

"/    aClass class methodDictionary keysAndValuesDo:[:sel :mthd |

"/        changeSet addMethodChange:mthd in:aClass class. 

"/    ].