"{ Package: 'jn:refactoring_custom' }"!

!AddClassChange methodsFor:'private'!

argumensBySelectorPartsFromMessage: aMessageNode

    "Returns message arguments as dictionary indexed by selector part name.

    For example: sel01:arg01 sel02:arg02 should be indexed 

    'sel01:' -> 'arg01',

    'sel02:' -> 'arg02' "

    | argumensBySelectorParts selectorParts |

    argumensBySelectorParts := Dictionary new.

    selectorParts := aMessageNode selectorParts ? #().

    aMessageNode arguments ? #() keysAndValuesDo: [ :key :argument |

        | part |

        part := selectorParts at: key ifAbsent: key.

        part == key ifFalse: [ 

            "We found appropriate selector part"

            part := part value asSymbol

        ].

        argumensBySelectorParts at: part put: argument.    

    ].

    ^ argumensBySelectorParts

    "Created: / 16-11-2014 / 14:47:55 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!AddClassChange methodsFor:'accessing'!

package

    ^ package

    "Created: / 09-10-2014 / 23:45:53 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!AddClassChange methodsFor:'accessing'!

package: aPackageName

    package := aPackageName

    "Created: / 08-10-2014 / 20:07:05 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!AddClassChange methodsFor:'accessing'!

privateInClassName

    "Returns privateIn class name (when this class is a private class of another class)"

    ^ self objectAttributeAt: #privateInClassName

    "Created: / 16-11-2014 / 14:18:53 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!AddClassChange methodsFor:'accessing'!

privateInClassName:aClassName

    "see privateInClassName"

    self objectAttributeAt: #privateInClassName put: aClassName

    "Created: / 16-11-2014 / 14:18:34 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!AddMethodChange methodsFor:'accessing'!

package: aPackageName    

    package := aPackageName

    "Created: / 08-10-2014 / 19:59:34 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

allClassVarNames

    | variableNames |

    variableNames := self allClassVariableNames.

    variableNames isNil ifTrue: [ 

        ^ #()

    ].

    ^ variableNames

    "Created: / 01-06-2014 / 23:40:50 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified: / 20-09-2014 / 19:26:24 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'enumerating'!

allSuperclassesDo: aBlock

    | superclass |

    superclass := self superclass.

    superclass isNil ifFalse: [ 

        superclass withAllSuperclassesDo: aBlock

    ].

    "Created: / 21-04-2014 / 19:15:49 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified: / 04-10-2014 / 22:35:33 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'method accessing'!

compileMethod: anRBMethod

    "Creates new method for this class with RBClass"

    | change method newSource |

    newSource := anRBMethod newSource.

    change := model 

        compile: newSource

        in: self

        classified: anRBMethod category.

    change package: anRBMethod package.

    method := anRBMethod deepCopy 

        source: newSource;

        category: anRBMethod category;

        package: anRBMethod package;

        model: self model;

        modelClass: self;

        yourself.

    self addMethod: method.

    ^ change

    "Created: / 10-10-2014 / 11:37:58 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified: / 10-10-2014 / 13:08:59 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing - classes'!

compilerClass

    "Answer a class suitable for compiling a source code in 'my' language"

    ^ self realClass isNil ifTrue: [

        "Return Smalltalk compiler, because we do not have multiple programming

        support in this class (yet)"

        self class compilerClass

    ] ifFalse: [ 

        self realClass compilerClass

    ]

    "Created: / 15-11-2014 / 16:58:35 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'queries'!

inheritsFrom: aClass

    ^ self isSubclassOf: aClass.

    "Created: / 11-10-2014 / 00:25:29 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'enumerating'!

instAndClassMethodsDo:aOneArgBlock

    "see Behavior >> instAndClassMethodsDo:"

    self theNonMetaclass methodsDo:aOneArgBlock.

    self theMetaclass methodsDo:aOneArgBlock.

    "Created: / 01-11-2014 / 21:35:48 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

instVarNames

    "Returns instance variable names - STX compatibility"

    ^ self instanceVariableNames

    "Created: / 29-05-2014 / 23:46:45 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified: / 24-09-2014 / 20:36:44 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified (comment): / 30-09-2014 / 19:30:18 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

instVarNames: aCollectionOfStrings 

    "Set instance variable names - STX compatibility"

    self instanceVariableNames: aCollectionOfStrings

    "Created: / 30-09-2014 / 19:30:58 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

isAbstract: aBoolean

    "see isAbstract"

    self theMetaclass isNil ifTrue: [ 

        self error: 'This class is not defined in the model.'

    ].

    self theMetaclass objectAttributeAt: #isAbstract put: aBoolean

    "Created: / 14-12-2014 / 16:39:15 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified: / 14-12-2014 / 18:12:03 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'autoload check'!

isLoaded

    "Returns true when the class is auto-loaded.

    see Metaclass >> isLoaded"

    ^ self class isLoaded

    "Created: / 15-11-2014 / 17:11:11 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

isModelClass

    "Tells wheter this class is a model class ( and not real class )"

    ^ true

    "Created: / 06-10-2014 / 07:12:50 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'queries'!

isSubclassOf: aClass

    "see Behavior >> isSubclassOf: ( same purpose, but for model class )"

    self allSuperclassesDo: [ :superclass |

        "we are testing name here, because the class 

        can be from another namespace"

        ((superclass name) = (aClass name)) ifTrue: [ 

            ^ true

        ]

    ].

    ^ false

    "Created: / 11-10-2014 / 00:16:42 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

methodDictionary

    "Stub method, returns real class MethodDictionary, although full MethodDictionary

    implementation would be better here."

    | methodDictionary |

    methodDictionary := MethodDictionary new.

    self realClass isNil ifFalse: [

        self realClass methodDictionary do: [ :method | 

            methodDictionary := methodDictionary 

                at: method selector asSymbol 

                putOrAppend: (RBMethod 

                    for: self 

                    fromMethod: method 

                    andSelector: method selector asSymbol)

        ].

    ].

    removedMethods isNil ifFalse: [

        removedMethods do: [ :removedMethod | 

            | method |

            method := methodDictionary at: removedMethod selector asSymbol ifAbsent: [ nil ].  

            method isNil ifFalse: [

                methodDictionary := methodDictionary removeKeyAndCompress: removedMethod selector asSymbol.

            ]

        ]

    ].

    newMethods isNil ifFalse: [

        newMethods do: [ :newMethod |

            methodDictionary := methodDictionary at: newMethod selector asSymbol putOrAppend: newMethod.

        ]

    ].

    ^ methodDictionary

    "Created: / 28-09-2014 / 22:57:28 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified: / 02-10-2014 / 21:11:23 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'enumerating'!

methodsDo:aOneArgBlock

    "see Behavior >> methodsDo:"

    self methodDictionary do:aOneArgBlock

    "Created: / 02-11-2014 / 09:47:06 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

nameWithoutPrefix

    "see ClassDescription >> nameWithoutPrefix"

    ^ (Smalltalk at: #Class) nameWithoutPrefix: name

    "Created: / 03-08-2014 / 23:29:11 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified: / 20-09-2014 / 19:21:11 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

owningClass

    "see Behavior >> owningClass"

    ^ self theMetaclass owningClass

    "Created: / 29-11-2014 / 13:17:10 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

owningClass: aClass

    "Sets the owning class which is actually stored in the metaclass"

    self theMetaclass owningClass: aClass

    "Created: / 29-11-2014 / 13:21:00 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'queries'!

owningClassOrYourself

    "see Behavior >> owningClassOrYourself"

    self owningClass notNil ifTrue:[^ self topOwningClass].

    ^ self

    "Created: / 29-11-2014 / 13:44:45 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

package

    "see Class >> package ( same purpose, but for model class )"

    | package |

    package := self objectAttributeAt: #package.

    (package isNil and: [ self realClass notNil ]) ifTrue: [ 

        package := self realClass package.

    ].

    ^ package

    "Created: / 09-10-2014 / 23:12:35 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

package: aPackage

    self objectAttributeAt: #package put: aPackage

    "Created: / 09-10-2014 / 23:12:14 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

privateClassesAt:aClassNameStringOrSymbol

    "see Class >> privateClassesAt:"

    | myName privateClassName |

    myName := self name.

    myName isNil ifTrue:[

        "/ no name - there cannot be a corresponding private class

        ^ nil

    ].

    privateClassName := (myName, '::' ,aClassNameStringOrSymbol) asSymbol.

    ^ model classNamed: privateClassName.

    "Created: / 15-11-2014 / 17:15:19 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified: / 16-11-2014 / 11:49:08 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

realSharedPoolNames

    "see Behavior >> realSharedPoolNames"

    ^ #()

    "Created: / 15-11-2014 / 17:19:50 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified: / 16-11-2014 / 16:37:08 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

superclassName: aName

    "Assign superclass by its name"

    self superclass: (self model classNamed: aName asSymbol)

    "Created: / 28-09-2014 / 22:53:46 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

theMetaclass

    "alias for theMetaClass - STX compatibility"

    ^ self theMetaClass.

    "Created: / 26-09-2014 / 16:26:07 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'accessing'!

theNonMetaclass

    "alias for theNonMetaClass - STX compatibility"

    ^ self theNonMetaClass

    "Created: / 26-09-2014 / 16:36:22 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'queries'!

topNameSpace

    "see ClassDescription >> topNameSpace"

    ^ self model

    "Created: / 15-11-2014 / 17:26:50 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

    "Modified (comment): / 16-11-2014 / 16:58:00 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'queries'!

topOwningClass

    "see Behavior >> topOwningClass"

    ^ self theMetaclass topOwningClass

    "Created: / 29-11-2014 / 13:48:15 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBAbstractClass methodsFor:'enumerating'!

withAllSuperclassesDo:aBlock

    "evaluate aBlock for the class and all of its superclasses"

    aBlock value:self.

    self allSuperclassesDo:aBlock

    "Created: / 29-09-2014 / 22:48:09 / Jakub Nesveda <nesvejak@fit.cvut.cz>"

! !

!RBClass methodsFor:'compiling'!

compile

    "Updates class definition in the namespace along with code changes"

    | change newClass |

    change := model defineClass: self definitionString.

    change package: self package.