"

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

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 directoive 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:'ST80 compatibility'!

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:'change management'!

addClassCategoryChange:newCategory for:aClass

    "add a classCategory change to the receiver"

    |newChange|

    newChange := ClassCategoryChange class:aClass category:newCategory.

    self add:newChange

    "Created: 3.12.1995 / 13:45:53 / cg"

    "Modified: 15.7.1996 / 09:26:52 / 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"

!

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

            ].

            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.

            ].

            self add: change.

            ^ true

        ] ifFalse:[

            self halt:'unexpected change'

        ].

    ].

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

        self add: change.

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

        self add: change.

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

            self add: change.

            ^ true

        ] ifFalse:[

            self halt

        ].

    ].