"

 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.

"

OrderedCollection subclass:#ChangeSet

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'System-Changes'

!

!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'!

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 etc."

    |changeSet chunk sawExcla lastTimeStamp s change nameSpace|

    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. 

    ].

    "/ instance methods ...

    aClass methodDictionary keysAndValuesDo:[:sel :mthd |

        changeSet addMethodChange:mthd in:aClass.

    ].

    ^ changeSet

    "

     ChangeSet forExistingClass:ChangeSet

    "

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

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

!

fromStream:aStream

    "build a changeSet from a stream, containing chunks.

     (i.e. either a classes sourceFile or a change-file).

     Return the changeSet."

    |changeSet chunk sawExcla lastTimeStamp s change nameSpace|

    changeSet := self new.

    nameSpace := Smalltalk.

    [aStream atEnd] whileFalse:[

        aStream skipSeparators.

        sawExcla := aStream peekFor:$!!.

        chunk := aStream nextChunk.

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

            Class nameSpaceQuerySignal answer:nameSpace do:[

                |parser tree|

                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.

                    changeSet add: change.

                ] ifFalse:[    

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

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

                        parser currentNameSpace notNil ifTrue:[

                            nameSpace := parser currentNameSpace

                        ].

                        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:[

                                    self halt:'unexpected change-chunk'

                                ]

                            ] ifFalse:[

                                tree isMessage ifTrue:[

                                    (changeSet addFromParseTree:tree andStream:aStream) ifFalse:[

                                        change := DoItChange new.

                                        change source:chunk.

                                        changeSet add: change.

                                    ]

                                ] ifFalse:[

                                    self halt:'unexpected change-chunk'

                                ]

                            ]

                        ]

                    ]

                ]

            ]

        ]

    ].

    ^ changeSet

    "

     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"

! !

!ChangeSet class methodsFor:'Compatibility - ST80'!

patches

    ^ #()

    "Created: / 27.10.1997 / 13:52:54 / cg"

! !

!ChangeSet class methodsFor:'queries'!

current

    "ST-80 compatibility: return the current changeSet"

    |p|

    (Project notNil and:[(p := Project current) notNil]) ifTrue:[

	^ p changeSet

    ]

    "

     ChangeSet current 

    "

! !

!ChangeSet methodsFor:'Compatibility - ST80'!

changeClass:aClass

    "dummy here"

    "Created: / 4.2.2000 / 18:30:59 / cg"

! !

addClassCommentChangeFor:aClass

    "add a classComment change to the receiver"

    |newChange|

    newChange := ClassCommentChange class:aClass.

    newChange comment:aClass comment.

    self add:newChange

    "Modified: 15.7.1996 / 09:27:05 / cg"

!

addClassDefinitionChangeFor:aClass

    "add a classDefinition change to the receiver"

    |newChange|

    newChange := ClassDefinitionChange class:aClass.

    newChange source:aClass definition.

    self add:newChange

    "Modified: 15.7.1996 / 09:27:05 / cg"

!

addInstVarDefinitionChangeFor:aClass

    "add an instVarDefinition change to the receiver"

    |newChange|

    newChange := ClassInstVarDefinitionChange class:aClass.

    newChange source:(aClass name , ' instanceVariableNames:' , aClass instanceVariableString storeString).

    self add:newChange

!

addMethodCategoryChange:aMethod category:newCategory in:aClass

    "add a methodCategory change to the receiver"

    |newChange|

    newChange := MethodCategoryChange class:aClass

				   selector:(aClass selectorAtMethod:aMethod)

				   category:newCategory.

    self add:newChange

    "Modified: 15.7.1996 / 09:27:15 / cg"

!

addMethodChange:aMethod in:aClass

    "add a method change to the receiver"

    |newChange|

    newChange := MethodChange class:aClass

			   selector:(aClass selectorAtMethod:aMethod)

			     source:aMethod source

			   category:aMethod category.

    self add:newChange

    "Modified: 15.7.1996 / 09:27:21 / cg"

!

addMethodPrivacyChange:aMethod in:aClass

    "add a methodPrivacy change to the receiver"

    |newChange|

    newChange := MethodPrivacyChange class:aClass

				   selector:(aClass selectorAtMethod:aMethod)

				   privacy:aMethod privacy.

    self add:newChange

    "Modified: 27.8.1995 / 22:55:22 / claus"

    "Modified: 15.7.1996 / 09:27:28 / cg"

!

addPrimitiveDefinitionsChangeFor:aClass

    "add a primitiveDefinitions change to the receiver"

    |newChange|

    newChange := ClassPrimitiveDefinitionsChange new

			class:aClass name source:aClass primitiveDefinitionsString.

    self add:newChange

    "Modified: 15.7.1996 / 09:27:40 / cg"

!

addPrimitiveFunctionsChangeFor:aClass

    "add a primitiveFunctions change to the receiver"

    |newChange|

    newChange := ClassPrimitiveFunctionsChange new

			class:aClass name source:aClass primitiveFunctionsString.

    self add:newChange

    "Modified: 15.7.1996 / 09:27:47 / cg"

!

addPrimitiveVariablesChangeFor:aClass

    "add a primitiveVariables change to the receiver"

    |newChange|

    newChange := ClassPrimitiveVariablesChange new

			 class:aClass name source:aClass primitiveVariablesString.

    self add:newChange

    "Modified: 15.7.1996 / 09:27:55 / cg"

!

addRemoveSelectorChange:aSelector in:aClass

    "add a method-remove change to the receiver"

    |newChange|

    newChange := MethodRemoveChange 

			class:aClass

			selector:aSelector.

    self add:newChange

    "Modified: / 27.8.1995 / 22:55:22 / claus"

    "Modified: / 15.7.1996 / 09:27:28 / cg"

    "Created: / 16.2.1998 / 12:47:07 / cg"

! !

!ChangeSet methodsFor:'misc'!

addPatch:nameOfPatch

    "ignored for now - allows fileIn of ST-80 patch stuff .."

    ^ self

! !

!ChangeSet methodsFor:'private'!

addFromParseTree:aTree andStream:aStream

    |sel className categoryName 

     methodSource methodSelector change parser

     oldName newName priv receiver receiverVarName

     receiverSelector receiverReceiver primSource

     nameSpace|

    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 == #'methodsFor:'

    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

        ].

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

        aStream skipSeparators.

        methodSource := aStream nextChunk.

        [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.

            self add: change.

            aStream skipSeparators.

            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.

        self add: change.

        ^ true

    ].

    "/ any subclass definiton selector ?

    (Behavior definitionSelectors includes:sel)

    ifTrue:[

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

        nameSpace ~~ Smalltalk ifTrue:[

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

        ].

        change := ClassDefinitionChange new.

        change 

            className:className;

            source:(aTree printString).

        self add: change.

        ^ 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.

        self add: change.

        ^ 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).

            ].