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

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

"/        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:[
            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).
        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:[
            self halt:'unexpected receiver in #name: message'
        ].
    ].

    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:[
            self halt:'unexpected receiver in #name: message'
        ].
    ].

    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:[
            self halt:'unexpected receiver in #name: message'
        ].
    ].

    (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 changes
     lineNumber pos|

    nameSpace := Smalltalk.

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

                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:[
                            "/ self halt.
                            nameSpace := ns
                        ].
                        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:[
                                    (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:[
                                    self halt:'unexpected change-chunk'
                                ]
                            ]
                        ]
                    ]
                ]
            ]
        ]
    ].

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

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

    ^ self fromStream:aStream while:[:thisChange | true]

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

fromStream:aStream while:aConditionBlock
    "build a changeSet from a stream, containing chunks.
     (i.e. either a classes sourceFile or a change-file).
     Return the changeSet."

    |changeSet|

    changeSet := self new.
    self changesFromStream:aStream do:[:aChange :lineNumberOrNil :posOrNil |
        changeSet add:aChange.
        (aConditionBlock value:aChange) ifFalse:[^ changeSet].
    ].

    ^ 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"
!

fromXMLStream:aStream
    "build a changeSet from an XML stream, containing XML definitions.
     Return the changeSet."

    |changeSet builder nameSpace|

    aStream isNil ifTrue:[^ nil].

    changeSet := self new.
    nameSpace := Smalltalk.

    builder := XML::SourceScannerNodeBuilder new.
    builder scanFile:aStream
            do:[:change | changeSet add: change. ].
    ^ changeSet

    "
     ChangeSet fromXMLStream:('../../goodies/xml-vw/xmlFileInTests/XMLParser.xml' asFilename readStream)
     ChangeSetBrowser 
        openOn:(ChangeSet fromXMLStream:('../../goodies/xml-vw/xmlFileInTests/XMLParser.xml' asFilename readStream))
    "
! !

!ChangeSet class methodsFor:'Compatibility - ST80'!

patches
    ^ #()

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

!ChangeSet class methodsFor:'Compatibility - VW'!

component: component definition: anObject change: changeSymbol
    "Include indication that a class/namespace was added or removed
     from a CodeComponent." 

    self 
        changed:#'component:definition:change:'
        with:
            ( Array 
                    with: component
                    with: anObject
                    with: changeSymbol
            )

! !

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

changedClasses
    "return a collection of all classes for which changes are in this changeSet"

    |classes|

    changedClasses isNil ifTrue:[
        classes := IdentitySet new.
        self do:[:chg |
            |cls|

            cls := chg changeClass.
            cls notNil ifTrue:[
                cls isNameSpace ifFalse:[
                    classes add:cls
                ]
            ]
        ].
        changedClasses := classes.
    ].
    ^ changedClasses.

    "
     ChangeSet current changedClasses  
    "
!

component:component definition:anObject change:changeSymbol
    "Include indication that a class/namespace was added or removed
     from a CodeComponent." 

    self 
        changed:#'component:definition:change:'
        with:
            ( Array 
                    with: component
                    with: anObject
                    with: changeSymbol
            )
!

reorganizeSystem
    "dummy here"

    "Created: / 6.2.2000 / 20:45:10 / cg"
! !

!ChangeSet methodsFor:'change & update'!

changed:anAspectSymbol with:aParameter 
    "Allow objects to depend on the ChangeSet class instead of a particular instance 
     of ChangeSet (which may be switched using projects)."

    ChangeSet changed:anAspectSymbol with:aParameter.
    super changed:anAspectSymbol with:aParameter
! !

!ChangeSet methodsFor:'changes management'!

addClassCommentChangeFor:aClass
    "add a classComment change to the receiver"

    |newChange|

    newChange := ClassCommentChange class:aClass.
    newChange comment:aClass comment.
    self rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:35:34 / cg"
!

addClassDefinitionChangeFor:aClass
    "add a classDefinition change to the receiver"

    |newChange|

    newChange := ClassDefinitionChange class:aClass source:(aClass definition).
    self rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:35:37 / cg"
!

addClassRemoveChange:oldClassName
    "add a classRemove change to the receiver"

    |newChange|

    newChange := ClassRemoveChange new className:oldClassName.
    changedClasses := nil.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:35:39 / cg"
!

addClassRenameChangeFrom:oldName to:newName
    "add a classRename change to the receiver"

    |newChange|

    newChange := ClassRenameChange new oldName:oldName newName:newName.
    changedClasses := nil.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:35:41 / cg"
!

addDoIt:aString
    "add a doIt to the receiver"

    |newChange|

    newChange := DoItChange new source:aString.
    self addChange:newChange.

    "Modified: / 14.11.2001 / 13:35:44 / cg"
!

addInstVarDefinitionChangeFor:aClass
    "add an instVarDefinition change to the receiver"

    |newChange|

    newChange := ClassInstVarDefinitionChange 
                        class:aClass
                        source:(aClass name , ' instanceVariableNames:' , aClass instanceVariableString storeString).
    self rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:35:45 / 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 rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:35:48 / cg"
!

addMethodChange:aMethod fromOld:oldMethod in:aClass
    "add a method change to the receiver"

    |newChange|

    newChange := MethodChange 
                        class:aClass
                        selector:aMethod selector
                        source:aMethod source
                        category:aMethod category.
    oldMethod notNil ifTrue:[
        newChange previousVersion:oldMethod source.
    ].
    self rememberChangedClass:aClass.
    self addChange:newChange.

    "Modified: / 14.11.2001 / 13:35:50 / cg"
!

addMethodChange:aMethod in:aClass
    "add a method change to the receiver"

    |newChange|

    newChange := MethodChange 
                        class:aClass
                        selector:aMethod selector
                        source:aMethod source
                        category:aMethod category.
    self rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:35:52 / 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 rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 27.8.1995 / 22:55:22 / claus"
    "Modified: / 14.11.2001 / 13:35:55 / cg"
!

addPrimitiveDefinitionsChangeFor:aClass
    "add a primitiveDefinitions change to the receiver"

    |newChange|

    newChange := ClassPrimitiveDefinitionsChange new
                        class:aClass name source:(aClass primitiveDefinitionsString).
    self rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:35:57 / cg"
!

addPrimitiveFunctionsChangeFor:aClass
    "add a primitiveFunctions change to the receiver"

    |newChange|

    newChange := ClassPrimitiveFunctionsChange new
                        class:aClass name source:(aClass primitiveFunctionsString).
    self rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:35:59 / cg"
!

addPrimitiveVariablesChangeFor:aClass
    "add a primitiveVariables change to the receiver"

    |newChange|

    newChange := ClassPrimitiveVariablesChange new
                         class:aClass name source:(aClass primitiveVariablesString).
    self rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:36:01 / cg"
!

addRemoveSelectorChange:aSelector in:aClass
    "add a method-remove change to the receiver"

    |newChange|

    newChange := MethodRemoveChange class:aClass selector:aSelector.
    self rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 27.8.1995 / 22:55:22 / claus"
    "Created: / 16.2.1998 / 12:47:07 / cg"
    "Modified: / 14.11.2001 / 13:36:04 / cg"
!

addRenameCategoryChangeIn:aClass from:oldCategory to:newCategory
    "add a category rename change to the receiver"

    |newChange|

    newChange := MethodCategoryRenameChange class:aClass.
    newChange oldCategoryName:oldCategory newCategoryName:newCategory.
    self rememberChangedClass:aClass.
    self addChange:newChange

    "Modified: / 14.11.2001 / 13:36:06 / cg"
! !

!ChangeSet methodsFor:'misc'!

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

    ^ self
! !

!ChangeSet methodsFor:'private - accessing'!

addChange:aChange
    self add:aChange.
    self changed:#addChange: with:aChange.

    "Created: / 14.11.2001 / 13:35:11 / cg"
    "Modified: / 14.11.2001 / 13:36:58 / cg"
!

rememberChangedClass:aClass
    changedClasses notNil ifTrue:[
        changedClasses add:aClass
    ].
!

removeAll:aCollection
    super removeAll:aCollection.
    changedClasses := nil.
    self changed:#removeAll: with:aCollection.
! !

!ChangeSet methodsFor:'queries'!

includesChangeForClass:aClass
    |nameOfClass|

    nameOfClass := aClass theNonMetaclass name.

    ^ self contains:[:aChange | 
                                aChange className = nameOfClass
                    ]

    "
     ChangeSet current includesChangeForClass:ChangeSet
     ChangeSet current includesChangeForClass:ChangeSet class
    "

    "Modified: / 31.10.2001 / 10:58:40 / cg"
!

includesChangeForClass:aClass selector:selector
    |nameOfClass|

    nameOfClass := aClass name.

    ^ self contains:[:aChange | 
                        aChange selector = selector
                        ifFalse:[
                            false
                        ] ifTrue:[
                            aChange className = nameOfClass 
                        ]
                    ]

    "
     ChangeSet current includesChangeForClass:ChangeSet selector:#includesChangeForClass:
    "

    "Created: / 31.10.2001 / 10:26:31 / cg"
    "Modified: / 31.10.2001 / 10:59:49 / cg"
!

includesChangeForClassOrMetaclass:aClass
    |nameOfClass nameOfMetaclass|

    nameOfClass := aClass theNonMetaclass name.
    nameOfMetaclass := aClass theMetaclass name.

    ^ self contains:[:aChange | 
                        |changeClassName|

                        changeClassName := aChange className.
                        changeClassName = nameOfClass or:[changeClassName = nameOfMetaclass]
                    ]
!

includesChangeForClassOrMetaclassOrPrivateClassOf:aClass
    |nameOfClass nameOfMetaclass|

    nameOfClass := aClass theNonMetaclass name.
    nameOfMetaclass := aClass theMetaclass name.

    self do:[:aChange | 
        |changeClassName changeClass|

        changeClassName := aChange className.
        (changeClassName = nameOfClass) ifTrue:[^ true].
        (changeClassName = nameOfMetaclass) ifTrue:[^ true].
        changeClass := aChange changeClass.
        (changeClass notNil
        and:[changeClass isPrivate
        and:[changeClass owningClass == aClass]]) ifTrue:[
            ^ true
        ]
    ].
    ^ false
! !

!ChangeSet methodsFor:'utilities'!

apply
    "apply all changes in the receivers changeSet"

    self do:[:aChange |
	aChange apply
    ]
!

condenseChangesForClass:aClass 
    "remove all changes for aClass
     (i.e. leave changes for other classes)."

    self condenseChangesForClass:aClass package:nil
!

condenseChangesForClass:aClass package:aPackageSymbol
    "remove all changes for aClass and aPackageSymbol
     (i.e. leave methodChanges for other packages).
     This is invoked when a class is checked into the repository."

    |changesToRemove className metaClassName chgCls|

    changesToRemove := OrderedCollection new.
    className := aClass theNonMetaclass name.
    metaClassName := aClass theMetaclass name.
    self do:[:aChange | 
        |chgClassName chgClass removeThis mClass mthd|

        removeThis := false.
        chgClassName := aChange className.
        (chgClassName = className
        or:[chgClassName = metaClassName]) ifTrue:[
            removeThis := true.
        ] ifFalse:[
            chgCls := aChange changeClass.
            (chgCls notNil
            and:[chgCls isPrivate
            and:[chgCls owningClass == aClass]]) ifTrue:[
                removeThis := true
            ]
        ].
        removeThis ifTrue:[
            aChange isMethodChange ifTrue:[
                mClass := aChange changeClass.
                mClass notNil ifTrue:[
                    mthd := mClass compiledMethodAt:(aChange selector).
                    mthd isNil ifTrue:[
                        "/ mthd does no longer exist
                        aPackageSymbol notNil ifTrue:[
                            removeThis := false
                        ]
                    ] ifFalse:[
                        (aPackageSymbol notNil and:[mthd package ~= aPackageSymbol]) ifTrue:[
                            removeThis := false
                        ]
                    ]
                ]
            ].
        ].
        removeThis ifTrue:[
            changesToRemove add:aChange
        ]
    ].
    self removeAll:changesToRemove

    "Modified: / 5.11.2001 / 14:29:22 / cg"
!

condenseChangesForExtensionsInPackage:aPackageSymbol
    "remove all changes for aClass and aPackageSymbol
     (i.e. leave methodChanges for other packages).
     This is invoked when a class is checked into the repository."

    |changesToRemove|

    changesToRemove := OrderedCollection new.

    self do:[:aChange | 
        |removeThis mClass mthd|

        aChange isMethodChange ifTrue:[
            removeThis := false.
            mClass := aChange changeClass.
            mClass notNil ifTrue:[
                mthd := mClass compiledMethodAt:(aChange selector).
                (mthd isNil or:[mthd package ~= aPackageSymbol]) ifTrue:[
                    removeThis := false
                ]
            ].
            removeThis ifTrue:[
                changesToRemove add:aChange
            ]
        ].
    ].
    self removeAll:changesToRemove

    "Modified: / 5.11.2001 / 14:11:45 / cg"
    "Created: / 5.11.2001 / 14:21:17 / cg"
!

diffSetsAgainst:anotherChangeSet
    "walk over the receiver and anotherChangeSet,
     add all changes to one of the tree lists:
        onlyInReceiver, onlyInArg or changed,
     each being a changeSet containing corresponding changes.
     WARNING: destructive; could modify both the receiver and the argument"

    |onlyInReceiver onlyInArg changedMethods
     indexFromChangedMethodsToA indexFromChangedMethodsToB
     "info" ret|

    onlyInReceiver := ChangeSet new.
    onlyInArg      := ChangeSet new.
    changedMethods := ChangeSet new.

    indexFromChangedMethodsToA := OrderedCollection new.
    indexFromChangedMethodsToB := OrderedCollection new.

    self keysAndValuesDo:[:idxA :aChangeInA |
        |anyFound ch|

        anyFound := false.

        anotherChangeSet keysAndValuesDo:[:idxB :aChangeInB |
            (aChangeInA isForSameAs:aChangeInB) ifTrue:[
                anyFound := true.

                "/ also in B - is it different ?
                (aChangeInA sameAs:aChangeInB) ifFalse:[
                    changedMethods add:aChangeInA.
                    indexFromChangedMethodsToA add:idxA.
                    indexFromChangedMethodsToB add:idxB.
                ] ifTrue:[
                    aChangeInA isMethodChange ifTrue:[
                        aChangeInA methodCategory ~= aChangeInB methodCategory ifTrue:[
                            "/ only the category is different;
                            "/ make it a MethodCategory changes.

                            ch := MethodCategoryChange new
                                    className:aChangeInA className
                                    selector:aChangeInA selector
                                    category:aChangeInA methodCategory.
                            self at:idxA put:ch.

                            ch := MethodCategoryChange new
                                    className:aChangeInB className
                                    selector:aChangeInB selector
                                    category:aChangeInB methodCategory.
                            anotherChangeSet at:idxB put:ch.

                            changedMethods add:aChangeInA.
                            indexFromChangedMethodsToA add:idxA.
                            indexFromChangedMethodsToB add:idxB.
                        ]
                    ].
                ]
            ] ifFalse:[
                (aChangeInA sameAs:aChangeInB) ifTrue:[
                    anyFound := true.
                ] ifFalse:[
                ]
            ]
        ].

        anyFound ifFalse:[
            onlyInReceiver add:aChangeInA.
        ]
    ].

    anotherChangeSet keysAndValuesDo:[:idxB :aChangeInB |
        |anyFound|

        anyFound := false.

        self do:[:aChangeInA |
            |idxM|

            (aChangeInA isForSameAs:aChangeInB) ifTrue:[
                anyFound := true.

                "/ also in B - is it different ?
                (aChangeInA sameAs:aChangeInB) ifFalse:[
                    "/ already there ?
                    idxM := changedMethods findFirst:[:c | c isForSameAs:aChangeInB].
                    idxM == 0 ifTrue:[
                        changedMethods add:aChangeInB.
                        indexFromChangedMethodsToB add:idxB.
                    ] ifFalse:[
                        indexFromChangedMethodsToB at:idxM put:idxB
                    ]
                ]
            ] ifFalse:[
                (aChangeInA sameAs:aChangeInB) ifTrue:[
                    anyFound := true.
                ] ifFalse:[
                ]
            ]
        ].
        anyFound ifFalse:[
            onlyInArg add:aChangeInB.
        ]
    ].

"/    info := OrderedCollection new:(changedMethods size).
"/    changedMethods keysAndValuesDo:[:idx :changedMethod |
"/        info add:(Array 
"/                        with:(indexFromChangedMethodsToA at:idx)
"/                        with:(indexFromChangedMethodsToB at:idx)
"/                 )
"/    ].
    changedMethods := (1 to:changedMethods size) collect:[:idx |
                        |cA cB|

                        cA := self at:(indexFromChangedMethodsToA at:idx).
                        cB := anotherChangeSet at:(indexFromChangedMethodsToB at:idx).
                        Array with:cA with:cB
                      ].

    ret := IdentityDictionary new.
"/    ret at:#info           put:info.
    ret at:#changed        put:changedMethods.
    ret at:#onlyInReceiver put:onlyInReceiver.
    ret at:#onlyInArg      put:onlyInArg.
    ^ret
! !

!ChangeSet class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.75 2002-01-23 10:26:13 cg Exp $'
! !