SmalltalkCodeGeneratorTool.st
branchjv
changeset 13657 fdc78070d46d
parent 13325 e94642d9a685
parent 13628 a718ccbff353
child 15566 184cea584be5
--- a/SmalltalkCodeGeneratorTool.st	Sat Oct 26 18:01:03 2013 +0100
+++ b/SmalltalkCodeGeneratorTool.st	Mon Nov 04 11:12:04 2013 -0300
@@ -573,6 +573,33 @@
     "Modified: / 30-01-2011 / 00:58:04 / cg"
 !
 
+createIsAbstractMethodIn:aClass
+    "create a #isAbstract query method (I'm tired of typing)"
+
+    |metaClass className code|
+
+    metaClass := aClass theMetaclass.
+    className := aClass theNonMetaclass name.
+
+    self startCollectChanges.
+
+    (metaClass includesSelector:#isAbstract) ifFalse:[
+        code :=
+'isAbstract
+    "Return if this class is an abstract class.
+     True is returned here for myself only; false for subclasses.
+     Abstract subclasses must redefine again."
+
+    ^ self == ',className,'.
+'.
+            self 
+                compile:code
+                forClass:metaClass 
+                inCategory:#'queries'.
+    ].
+    self executeCollectedChangesNamed:('Make ',className,' abstract').
+!
+
 createParametrizedInstanceCreationMethodsNamed:selector in:aClass
     "create a #selector instance creation method (I'm tired of typing)"
 
@@ -1953,6 +1980,24 @@
     self compile:source forClass:aClass inCategory:#accessing.
 !
 
+createShouldImplementMethodFor:aSelector category:cat in:aClass
+    "add a subclassResponsibility method;
+     but only if not already present."
+
+    (aClass includesSelector:aSelector) ifFalse:[
+
+        self compile:
+(Method methodDefinitionTemplateForSelector:aSelector) ,
+'
+    "raise an error: this method should be implemented (TODO)"
+
+    ^ self shouldImplement
+' 
+              forClass:aClass 
+              inCategory:cat.
+    ].
+!
+
 createSubclassResponsibilityMethodFor:aSelector category:cat in:aClass
     "add a subclassResponsibility method;
      but only if not already present."
@@ -2615,11 +2660,11 @@
 !SmalltalkCodeGeneratorTool class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/SmalltalkCodeGeneratorTool.st,v 1.21 2013-06-07 12:08:27 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/SmalltalkCodeGeneratorTool.st,v 1.23 2013-10-10 14:23:44 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/SmalltalkCodeGeneratorTool.st,v 1.21 2013-06-07 12:08:27 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/SmalltalkCodeGeneratorTool.st,v 1.23 2013-10-10 14:23:44 cg Exp $'
 !
 
 version_HG
@@ -2628,6 +2673,6 @@
 !
 
 version_SVN
-    ^ '$Id: SmalltalkCodeGeneratorTool.st,v 1.21 2013-06-07 12:08:27 cg Exp $'
+    ^ '$Id: SmalltalkCodeGeneratorTool.st,v 1.23 2013-10-10 14:23:44 cg Exp $'
 ! !