--- a/extensions.st Sat Nov 15 15:45:07 2014 +0100
+++ b/extensions.st Sun Nov 16 18:06:36 2014 +0100
@@ -1,5 +1,32 @@
"{ 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
@@ -18,6 +45,26 @@
"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
@@ -90,6 +137,22 @@
"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
@@ -132,6 +195,17 @@
"Created: / 30-09-2014 / 19:30:58 / 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
@@ -253,6 +327,38 @@
!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"
@@ -281,6 +387,17 @@
"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:'enumerating'!
withAllSuperclassesDo:aBlock