ClassChange.st
author boris
Wed, 15 Nov 2006 12:50:15 +0100
changeset 1905 51e766803c45
parent 1903 fc7a6b27312e
child 2019 685031a55645
permissions -rw-r--r--
avoid endless recursion, if change is for a namespace definition.

"
 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
	instanceVariableNames:'className package'
	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)"

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

    |className cls owner|

    className := self className.
    cls := Smalltalk loadedClassNamed:className.
    cls isNil ifTrue:[
        self isPrivateClassDefinitionChange ifTrue:[
            owner := Smalltalk loadedClassNamed:(self owningClassName).
            owner notNil ifTrue:[
                cls := owner privateClassesAt:className.
                ^ cls.
            ].
        ].
        ^ nil.
    ].
    "/ care for aliases...
    cls name ~= className ifTrue:[ ^ nil ].
    ^ cls.

"/    |className ns cls|
"/
"/    className := self className.
"/    className isNil ifTrue:[^ nil].
"/
"/    ns := (Class nameSpaceQuerySignal query) ? Smalltalk.
"/    ns isNameSpace ifFalse:[
"/        ns := Smalltalk
"/    ].
"/
"/    cls := ns classNamed:className.
"/    cls isNil ifTrue:[
"/        ns ~~ Smalltalk ifTrue:[
"/            cls := Smalltalk classNamed:className
"/        ].
"/    ].
"/    ^ cls

    "Modified: / 10-11-2006 / 16:42:28 / 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:aString 
    "set the className of the change"

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

    className := newClassName.
    source := newSource.

    "Created: 3.12.1995 / 14:01:45 / cg"
    "Modified: 15.7.1996 / 09:28:26 / cg"
!

classNameWithoutNamespace
    "return the className of the change"

    ^ self cutNameSpaceOf:className

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

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"

    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)
"/    ].
!

className
    |ns|

    "/ used to be ^ className;
    "/
    "/ now include a translation from vw namespace to stx nameSpace

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

    ^ ns , '::' , (self classNameWithoutNamespace)
!

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
!

nameSpace
    |nsName nameSpace|

    (nsName := self nameSpaceName) notNil ifTrue:[
        ^ NameSpace name:nsName.
    ].
    ^ Smalltalk
!

nameSpaceName
    |ns cnm idx|

    className isNil ifTrue:[^ nil].

    (className includes:$:) ifTrue:[
        "/ in a namespace
        ^ className upTo:$:.
    ].
    (idx := className indexOf:$.) ~~ 0 ifTrue:[
        "/ in a namespace
        ns := className copyTo:(idx - 1).
        cnm := className copyFrom:(idx + 1).
        "cheat: VW namespaces"
        ^ self nameSpaceForVWNamespace:ns class:cnm ifAbsent:ns
    ].
    ^ nil

    "Modified: / 03-08-2006 / 02:04: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:'an empty change'.
        ^ self
    ].
    aStream nextPutAll:(self class name , ' - ' , source string firstLine , '...').
! !

!ClassChange methodsFor:'queries'!

cutNameSpaceOf:aString
    |dotIndex colonIndex|

    aString notNil ifTrue:[
        dotIndex := aString indexOf:$..
        dotIndex ~~ 0 ifTrue:[
            ^ aString copyFrom:dotIndex+1
        ].
        colonIndex := aString indexOf:$:.
        colonIndex ~~ 0 ifTrue:[
            ^ aString copyFrom:colonIndex+2
        ].
    ].
    ^ aString
!

isClassChange
    ^ true
!

nameSpaceForVWNamespace:ns class:className ifAbsent:default
    "map the namespace for a given class"

    ns = 'Core' ifTrue:[^ 'Smalltalk'].
    ns = 'Kernel' ifTrue:[^ 'Smalltalk'].
    ns = 'Graphics' ifTrue:[^ 'Smalltalk'].
    ns = 'OS' ifTrue:[^ 'Smalltalk'].
    ns = 'Smalltalk' ifTrue:[^ 'Smalltalk'].
    ns = 'UI' ifTrue:[^ 'Smalltalk'].
    ^ default value
! !

!ClassChange class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.47 2006-11-15 11:50:15 boris Exp $'
! !