"

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

Change subclass:#ClassChange

	classVariableNames:''

	poolDictionaries:''

	category:'System-Changes'

!

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

"

    Abstract superclass for class related changes

    They are typically held in a ChangeSet.

    [author:]

        Claus Gittinger

"

! !

!ClassChange class methodsFor:'instance creation'!

class:aClass

    ^ self new class:aClass

    "Created: 3.12.1995 / 14:01:32 / cg"

!

class:aClass source:source

    ^ self new class:aClass source:source

    "Created: 3.12.1995 / 14:01:32 / cg"

!

className:aClassName

    ^ self new className:aClassName

    "Created: / 13-11-2006 / 10:37:39 / cg"

!

className:aClassName source:source

    ^ self new className:aClassName source:source

    "Created: / 12-11-2006 / 20:11:26 / cg"

! !

!ClassChange methodsFor:'accessing'!

changeClass

    "the class of the change (nil if not present).

     Take care for changes from foreign Smalltalks having 

     a different Namespace definition syntax"

    "do not autoload an owning class of a private class!!"

    "/ ok, try some heuristics (for example Root.something -> Smalltalk::something)

        "/ VW - namespace prefix - convert to colon-notation

    ].       

    nsName notNil ifTrue:[

        ns := Smalltalk at:nsName asSymbol.

        ns isNil ifTrue:[

            ns := NameSpace name:nsName

        ]

    ].

    ].

    ns := (ns ? Smalltalk).

    class := ns isNameSpace 

    class isNil ifTrue:[

        self isPrivateClassDefinitionChange ifTrue:[

            ns isNameSpace ifTrue:[

                owner := ns loadedClassNamed:(self owningClassName).

            ] ifFalse:[

                owner := Smalltalk loadedClassNamed:(self owningClassName).

            ].

            owner notNil ifTrue:[

                ^ meta ifTrue:[class theMetaclass] ifFalse:[class].

            ].

        ] ifFalse:[

            class := ns isNameSpace 

            "/ class := Parser evaluate:className ifFail:[nil].

            class isNil ifTrue:[

                ifTrue:[

                    class := ns isNameSpace 

                                ifTrue:[ ns classNamed:altName ]

                                ifFalse:[ Smalltalk loadedClassNamed:altName ].     

                    class isNil ifTrue:[

                        class := Parser evaluate:altName ifFail:[nil]

                    ]

                ].

            ].

        ].

        class isNil ifTrue:[

            ns ~= Smalltalk ifTrue:[

                self isPrivateClassDefinitionChange ifTrue:[

                    owner := Smalltalk loadedClassNamed:(self owningClassName).

                    owner notNil ifTrue:[

                        ^ meta ifTrue:[class theMetaclass] ifFalse:[class].

                    ].

                ] ifFalse:[

                    "/ class := Parser evaluate:className ifFail:[nil].

                    class isNil ifTrue:[

                        ^ nil.

                    ].

                ].

            ].

            class isNil ifTrue:[^ nil].

        ].

    ].

    "/ care for aliases...

    "/ (class nameWithoutPrefix ~= className) ifTrue:[ ^ nil ].

    ^ meta ifTrue:[class theMetaclass] ifFalse:[class].

    "Modified: / 10-08-2012 / 12:07:26 / cg"

!

changeClass:aClass

    "set the class of the change"

    className := aClass name.

!

class:aClass

    "set the class of the change"

    self className:aClass name.

    "Created: / 03-12-1995 / 14:01:45 / cg"

    "Modified: / 12-11-2006 / 20:10:28 / cg"

!

class:aClass source:newSource

    "set both class and source of the change"

    self className:(aClass name) source:newSource

!

classBaseName 

    "return the className of the change"

    ^ self cutNameSpaceOf:className

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

!

className

    ^ className

!

className:aString 

    "set the className of the change"

    self assert:aString notNil.

    className := aString

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

    "Created: / 16.2.1998 / 13:05:36 / cg"

!

className:newClassName source:newSource

    "set both className and source of the change"

    self assert:(newSource isString).

    self assert:(newClassName isString).

    source := newSource.

!

classNameForWellKnownVisualWorksNamespaceClass:className

    (className startsWith:'Root::') ifTrue:[

        ^ className copyFrom:7.

    ].

    (className startsWith:'Core.') ifTrue:[

        ^ className copyFrom:6.

    ].

    (className startsWith:'Smalltalk.') ifTrue:[

        ^ className copyFrom:11.

    ].

    ^ nil

    "Created: / 29-01-2011 / 11:29:59 / cg"

!

classNameWithoutNamespace

    "return the className of the change"

    ^ self cutMyNameSpaceOf: "cutNameSpaceOf:"className

    "Modified: / 06-10-2011 / 16:58:34 / cg"

!

fullClassName

    |ns|

    "/ used to be ^ className;

    "/

    "/ now include a translation from vw namespace to stx nameSpace

    ns := self nameSpaceName.

    (ns isNil or:[ns = 'Smalltalk']) ifTrue:[^ self className].

    ^ ns , '::' , self className

!

localClassName

    "for private classes, this returns the name relative to its owner;

     for non-private ones, this is the regular name.

    ^self className

!

nameSpace

    |nsName nameSpace|

    (nsName := self nameSpaceName) notNil ifTrue:[

        ^ NameSpace name:nsName.

    ].

    ^ Smalltalk

!

nameSpaceName

    className isNil ifTrue:[^ nil].

    ns := self nameSpaceOverride.

    ns notNil ifTrue:[ ^ ns ].

    "Modified: / 03-08-2006 / 02:04:03 / cg"

!

nameSpaceOverride

    |ns|

    ns := nameSpaceOverride.

        ns := Class nameSpaceQuerySignal query.

    ].

    ns isNil ifTrue:[^ nil].

    ^ ns name

    "Created: / 07-09-2011 / 20:45:43 / cg"

!

nameSpaceOverride:aNamespaceOrString

    aNamespaceOrString isString ifTrue:[

        nameSpaceOverride := NameSpace name:aNamespaceOrString

    ] ifFalse:[

        nameSpaceOverride := aNamespaceOrString

    ]

    "Created: / 20-03-2012 / 17:12:08 / cg"

!

nonMetaClassName

    ^ self isForMeta

	ifTrue:[ self className copyTo:(self className size - 6) ]

	ifFalse:[ self className ]

    "Created: / 06-11-2008 / 17:26:03 / Jan Vrany <vranyj1@fel.cvut.cz>"

!

package

    "return the value of the instance variable 'package' (automatically generated)"

    ^ package

!

package:something

    "set the value of the instance variable 'package' (automatically generated)"

    package := something.

! !

!ClassChange methodsFor:'applying'!

apply

    "apply the change"

    |class|

    class := self changeClass.

    class isNil ifTrue:[

        self error:('Cannot apply change for missing class: ' , className) mayProceed:true.

        ^ self

    ].

    class autoload.         "Most changes cannot be applied to unloaded classes"

    Class nameSpaceQuerySignal answer:self nameSpace do:[

        Parser evaluate:(self source)

    ].

"/    |ns|

"/

"/    ns := Class nameSpaceQuerySignal isHandled 

"/            ifTrue:[ Class nameSpaceQuerySignal query ]

"/            ifFalse:[ self nameSpace ].

"/

"/    Class nameSpaceQuerySignal answer:ns do:[

"/        Parser evaluate:(self source)

"/    ].

    "Modified: / 29-01-2011 / 12:28:03 / cg"

! !

!ClassChange methodsFor:'printing & storing'!

printOn:aStream

    "append a user printed representation of the receiver to aStream.

     The format is suitable for a human - not meant to be read back."

    source isNil ifTrue:[

        aStream nextPutAll:self class nameWithArticle,'-change (no source)'.

        ^ self

    ].

    aStream nextPutAll:(self class name , ' - ' , source string firstLine , '...').

! !

!ClassChange methodsFor:'queries'!

cutMyNameSpaceOf:aString

    |ns|

    aString isNil ifTrue:[ ^ nil ].

    (ns := self nameSpaceOverride) isNil ifTrue:[ ^ aString ].

    (aString startsWith:(ns , '.')) ifTrue:[ ^ self cutNameSpaceOf:aString ].

    (aString startsWith:(ns , '::')) ifTrue:[ ^ self cutNameSpaceOf:aString ].

    ^ aString

    "Modified: / 07-09-2011 / 20:49:33 / cg"

!

cutNameSpaceOf:aString

    |dotIndex colonIndex|

    aString isNil ifTrue:[ ^ nil].

    dotIndex := aString indexOf:$..

    dotIndex ~~ 0 ifTrue:[

        ^ aString copyFrom:dotIndex+1

    ].

    colonIndex := aString indexOf:$:.

    colonIndex ~~ 0 ifTrue:[

        ^ aString copyFrom:colonIndex+2

    ].

    ^ aString

    "Modified: / 29-01-2011 / 11:32:01 / cg"

!