extensions.st
changeset 752 516a6334136c
parent 733 bad42d8d1161
child 765 d706c98adeb5
--- 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