extensions.st
author Jakub Nesveda <jakubnesveda@seznam.cz>
Sat, 08 Nov 2014 14:42:12 +0100
changeset 731 6ec82b81a246
parent 730 a18417c3cee7
child 733 bad42d8d1161
permissions -rw-r--r--
fix class changes not working with non existing classes defined as model classes (RBClass, RBMetaclass)

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

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

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

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

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

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:'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.

    (model respondsTo: #putModelClass:) ifTrue: [
        model putModelClass: self  
    ] ifFalse: [ 
        newClass := model classNamed: self name.
        newClass package: self package
    ].

    ^ change

    "Created: / 25-09-2014 / 22:31:44 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
    "Modified: / 04-11-2014 / 00:06:49 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBClass methodsFor:'accessing'!

theNonMetaClass
    "alias for theNonMetaclass - squeak compatibility"

    ^ self theNonMetaclass

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

!RBMetaclass methodsFor:'accessing'!

theMetaClass
    "alias for metaclass - sqeak compatibility"

    ^ self metaclass.

    "Created: / 26-09-2014 / 21:32:09 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMetaclass methodsFor:'accessing'!

theMetaclass
    "alias for metaclass - STX compatibility"

    ^ self metaclass.

    "Created: / 26-09-2014 / 21:28:37 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

category: aCategoryName
    "Sets in which category/protocol does the method belongs within a class"

    self objectAttributeAt: #category put: aCategoryName.

    "Created: / 06-10-2014 / 07:54:57 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

class: aClass
    "Helper for enabling usage of either real class or RBClass"

    self modelClass: (self model classFor: aClass)

    "Created: / 05-10-2014 / 21:04:44 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
    "Modified (comment): / 08-11-2014 / 13:26:35 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'compiling'!

compile
    "Modifies/adds method in the model class."

    ^ self modelClass compileMethod: self

    "Created: / 06-10-2014 / 11:11:30 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
    "Modified: / 10-10-2014 / 12:28:06 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

methodArgNames
    "Returns collection of method argument names"

    | methodNode arguments |

    methodNode := RBParser 
        parseMethod: self source 
        onError: [ :str :pos | 
            self error: 'Cannot parse: ', str, ' at pos: ', pos asString 
        ].    

    "Transform arguments to what Method returns - keep compatibility"
    arguments := methodNode arguments.
    (arguments size > 0) ifTrue: [ 
        | newArguments |

        newArguments := OrderedCollection new.
        arguments do: [ :argument | 
            newArguments add: argument name
        ].
        ^ newArguments asArray
    ].

    ^ nil

    "Created: / 07-10-2014 / 20:18:53 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
    "Modified: / 07-10-2014 / 22:13:15 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'queries'!

methodDefinitionTemplate
    "see Method >> methodDefinitionTemplate"

    ^ Method
        methodDefinitionTemplateForSelector:self selector
        andArgumentNames:self methodArgNames

    "Created: / 07-10-2014 / 20:18:53 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

model

    ^ self objectAttributeAt: #model

    "Created: / 05-10-2014 / 20:33:09 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

model: anRBSmalltalk

    self objectAttributeAt: #model put: anRBSmalltalk

    "Created: / 05-10-2014 / 20:32:38 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

newSource
    "Returns new source code with performed modifications by CodeGenerator
    ( replace: something with: anotherthing and custom formatting)."
    | newSource generator |

    newSource := self source.
    generator := self sourceCodeGenerator.
    generator notNil ifTrue: [ 
        generator source: newSource.
        newSource := generator newSource.
    ].

    "Fixes test CustomRBMethodTests >> test_compile_with_code_generator
    when none selector and method is given then parse the selector from new source code"
    (selector isNil and: [ compiledMethod isNil ] and: [ newSource notNil ]) ifTrue: [ 
        selector := (Parser parseMethodSpecification: newSource) selector
    ].

    ^ newSource

    "Created: / 10-10-2014 / 12:23:20 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
    "Modified (comment): / 10-10-2014 / 15:31:25 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

package: aPackage

    self objectAttributeAt: #package put: aPackage

    "Created: / 10-10-2014 / 11:12:26 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

protocol
    "Returns in which category/protocol does the method belongs within a class"

    ^ self category

    "Created: / 06-10-2014 / 07:46:14 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

protocol: aProtocolName
    "Sets in which category/protocol does the method belongs within a class"

    self category: aProtocolName.

    "Created: / 06-10-2014 / 07:56:27 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

replace: placeholder with: code

    self sourceCodeGenerator replace: placeholder with: code

    "Created: / 06-10-2014 / 08:58:31 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'queries'!

sends:selectorSymbol1 or:selectorSymbol2
    "Returns true, if this method contains a message-send
     to either selectorSymbol1 or selectorSymbol2.
     ( non-optimized version of Message>>sends:or: )"

    ^ (self sendsSelector: selectorSymbol1) or: [ self sendsSelector: selectorSymbol2 ]

    "Created: / 04-10-2014 / 00:01:56 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

sourceCodeGenerator
    "Returns helper tool for method source code manipulation like formatting and search & replace"

    ^ self objectAttributeAt: #sourceCodeGenerator

    "Created: / 06-10-2014 / 08:33:09 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RBMethod methodsFor:'accessing'!

sourceCodeGenerator: aSourceCodeGenerator
    "Set ... see method sourceCodeGenerator"

    ^ self objectAttributeAt: #sourceCodeGenerator put: aSourceCodeGenerator

    "Created: / 06-10-2014 / 08:37:54 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RefactoryChange methodsFor:'accessing'!

model
    "Returns reference to RBNamespace for retrieving model classes (RBClass, RBMetaclass)"

    ^ self objectAttributeAt: #model

    "Created: / 08-11-2014 / 14:00:17 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!RefactoryChange methodsFor:'accessing'!

model: aModel
    "see model"

    self objectAttributeAt: #model put: aModel

    "Created: / 08-11-2014 / 14:00:33 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menus extensions-custom refactorings'!

classMenuExtensionCustomGenerators:aMenu 
    <menuextension: #classMenu>

    | item  index  perspective  context |

    item := MenuItem label:(resources string:'Generate - Custom').
    perspective := CustomPerspective classPerspective.
    context := CustomBrowserContext 
                    perspective:perspective
                    state:self navigationState.
    item submenuChannel:[ CustomMenuBuilder buildMenuForContext:context ].
    index := aMenu indexOfMenuItemForWhich:[:each | each label = 'Generate' ].
    index ~~ 0 ifTrue:[
        aMenu addItem:item beforeIndex:index + 1.
    ] ifFalse:[
        aMenu addItem:item.
    ].

    "Created: / 26-08-2014 / 10:21:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menus extensions-custom refactorings'!

codeViewMenuExtensionCustomRefactorings:aMenu 
    <menuextension: #codeViewMenu>

    | item  index  perspective  context |

    item := MenuItem label:(resources string:'Refactor - Custom').
    perspective := CustomPerspective codeViewPerspective.
    context := CustomBrowserContext 
                    perspective:perspective
                    state:self navigationState.
    item submenuChannel:[ CustomMenuBuilder buildMenuForContext:context filter: [:each | each isCustomRefactoring ] ].
    index := aMenu indexOfMenuItemForWhich:[:each | each label = 'Refactor' ].
    index ~~ 0 ifTrue:[
        aMenu addItem:item beforeIndex:index + 1.
    ] ifFalse:[
        aMenu addItem:item.
    ].

    "Created: / 26-08-2014 / 22:44:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-10-2014 / 09:47:00 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menus extensions-custom refactorings'!

selectorMenuExtensionCustomGenerators:aMenu 
    <menuextension: #selectorMenuCompareGenerateDebugSlice>

    | item  index  perspective  context |

    item := MenuItem label:(resources string:'Generate - Custom').
    perspective := CustomPerspective methodPerspective.
    context := CustomBrowserContext 
                    perspective:perspective
                    state:self navigationState.
    item submenuChannel:[ CustomMenuBuilder buildMenuForContext:context filter: [:each | each isCustomCodeGenerator ] ].
    index := aMenu indexOfMenuItemForWhich:[:each | each label = 'Generate' ].
    index ~~ 0 ifTrue:[
        aMenu addItem:item beforeIndex:index + 1.
    ] ifFalse:[
        aMenu addItem:item.
    ].

    "Created: / 26-08-2014 / 10:18:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 05-09-2014 / 11:28:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menus extensions-custom refactorings'!

selectorMenuExtensionCustomRefactorings:aMenu 
    <menuextension: #selectorMenuCompareGenerateDebugSlice>

    | item  index  perspective  context |

    item := MenuItem label:(resources string:'Refactor - Custom').
    perspective := CustomPerspective methodPerspective.
    context := CustomBrowserContext 
                    perspective:perspective
                    state:self navigationState.
    item submenuChannel:[ CustomMenuBuilder buildMenuForContext:context filter: [:each | each isCustomRefactoring ] ].
    index := aMenu indexOfMenuItemForWhich:[:each | each label = 'Refactor' ].
    index ~~ 0 ifTrue:[
        aMenu addItem:item beforeIndex:index + 1.
    ] ifFalse:[
        aMenu addItem:item.
    ].

    "Created: / 24-08-2014 / 15:23:49 / Jakub Nesveda <nesvejak@fit.cvut.cz>"
    "Modified: / 05-09-2014 / 11:28:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menus extensions-custom refactorings'!

variablesMenuExtensionCustomGenerators:aMenu 
    <menuextension: #variablesMenu>

    | item  index  perspective  context |

    item := MenuItem label:(resources string:'Generate - Custom').
    perspective := CustomPerspective instanceVariablePerspective.
    context := CustomBrowserContext 
                    perspective:perspective
                    state:self navigationState.
    item submenuChannel:[ CustomMenuBuilder buildMenuForContext:context ].
    index := aMenu indexOfMenuItemForWhich:[:each | each label = 'Generate' ].
    index ~~ 0 ifTrue:[
        aMenu addItem:item beforeIndex:index + 1.
    ] ifFalse:[
        aMenu addItem:item.
    ].

    "Created: / 26-08-2014 / 10:21:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!jn_refactoring_custom class methodsFor:'documentation'!

extensionsVersion_HG

    ^ '$Changeset: <not expanded> $'
! !