class: Parser
authorClaus Gittinger <cg@exept.de>
Thu, 29 Aug 2013 20:22:03 +0200
changeset 3304 d1eb4409e3c8
parent 3303 786da23ce823
child 3305 1c46ca0f443c
class: Parser better correctByGeneratingMethod. (care for class messages; care for classVar getters)
Parser.st
--- a/Parser.st	Thu Aug 29 01:21:37 2013 +0200
+++ b/Parser.st	Thu Aug 29 20:22:03 2013 +0200
@@ -10804,7 +10804,12 @@
 fixFrom:pos1 to:pos2 for:aCompiler
     "an method needs to be defined"
 
-    |classToGenerateCode className|
+    |classToGenerateCode suggestedClassToCompileFor className varName codeGeneratorClass|
+
+    "/ todo: look for variables first and ask if setter/getter first, 
+    "/ so we can reduce the set of offered classes. Left as an excercise...
+
+    suggestedClassToCompileFor := aCompiler classToCompileFor.
 
     receiverNode isSelf ifTrue:[
         classToGenerateCode := aCompiler classToCompileFor
@@ -10818,10 +10823,25 @@
                     classToGenerateCode := nil
                 ].
             ].
+        ] ifFalse:[
+            (receiverNode isMessage
+            and:[ receiverNode receiver isSelf
+            and:[ receiverNode selector == #class]]) ifTrue:[
+                suggestedClassToCompileFor := aCompiler classToCompileFor theMetaclass
+            ].
         ]
     ].
     classToGenerateCode isNil ifTrue:[
-        className := Dialog request:'Generate code in class:' initialAnswer:aCompiler classToCompileFor name.
+        "/ className := Dialog request:'Generate code in class:' initialAnswer:suggestedClassToCompileFor name.
+        className := Dialog
+                        request:'Generate code in class:'
+                        initialAnswer:(suggestedClassToCompileFor name)
+                        okLabel:'OK'
+                        title:('Generate code in class:')
+                        onCancel:nil
+                        list:(suggestedClassToCompileFor withAllSuperclasses collect:[:cls | cls name])
+                        entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
+
         className size == 0 ifTrue:[
             ^ nil
         ].
@@ -10831,42 +10851,53 @@
             ^ nil
         ].
     ].
+    codeGeneratorClass := classToGenerateCode programmingLanguage codeGeneratorClass.
+    codeGeneratorClass isNil ifTrue:[
+        Dialog information:'sorry - no codegeneration facility for this class'.
+        ^ nil.
+    ].
+
+    "do not overwrite an already existing method"
     (classToGenerateCode includesSelector:selector asSymbol) ifFalse:[
-        |code category wantSetter wantGetter|
+        |code category wantSetter wantGetter varNames lcVarNames|
 
         wantSetter := wantGetter := false.
+        varNames := classToGenerateCode isMeta 
+                        ifTrue:[ classToGenerateCode theNonMetaclass classVarNames , classToGenerateCode instVarNames ]
+                        ifFalse:[ classToGenerateCode instVarNames ].
+        lcVarNames := varNames collect:[:nm | nm asLowercaseFirst].
 
         (selector isKeywordSelector
         and:[selector numArgs == 1
-        and:[classToGenerateCode instVarNames includes:(selector copyButLast:1)]]) ifTrue:[
+        and:[lcVarNames includes:(selector copyButLast:1)]]) ifTrue:[
             "/ want a setter ?
-            wantSetter := Dialog confirmWithCancel:('Create a setter for %1 ?' bindWith:(selector copyButLast:1) allBold).
-            wantSetter isNil ifTrue:[^ selector].
+            varName := varNames at:(lcVarNames indexOf:(selector copyButLast:1)).
+            wantSetter := Dialog confirmWithCancel:('Generate as setter for %1 ?' bindWith:varName allBold) default:true.
+            wantSetter isNil ifTrue:[ AbortOperationRequest raise. "^ selector"].
         ] ifFalse:[
             (selector isUnarySelector
-            and:[classToGenerateCode instVarNames includes:selector]) ifTrue:[
+            and:[lcVarNames includes:selector]) ifTrue:[
                 "/ want a getter ?
-                wantGetter := Dialog confirmWithCancel:('Create a getter for %1 ?' bindWith:selector allBold).
-                wantGetter isNil ifTrue:[^ selector].
+                varName := varNames at:(lcVarNames indexOf:selector).
+                wantGetter := Dialog confirmWithCancel:('Generate as getter for %1 ?' bindWith:varName allBold) default:true.
+                wantGetter isNil ifTrue:[AbortOperationRequest raise "^ selector"].
             ]
         ].
+
+        "/ get the real name (UC if classvar)
         wantSetter ifTrue:[
-            code := ('%1:something\    %1 := something.' bindWith:(selector copyButLast:1)) withCRs.
-            category := 'accessing'.
+            codeGeneratorClass new createSetterFor:varName in:classToGenerateCode.
         ] ifFalse:[
             wantGetter ifTrue:[
-                code := ('%1\    ^ %1.' bindWith:selector) withCRs.
-                category := 'accessing'.
+                codeGeneratorClass new createGetterFor:varName in:classToGenerateCode.
             ] ifFalse:[
                 code := (Parser methodSpecificationForSelector:selector) , '\    self shouldImplement' withCRs.
                 category := Compiler defaultMethodCategory.
-            ].
-        ].
-
-        "do not overwrite an already existing (deprecated) method"
-        classToGenerateCode
-            compile:code
-            classified:category.
+                classToGenerateCode
+                    compile:code
+                    classified:category.
+            ]
+        ]
     ].
 
     "/ return nil, so nothing is done in the compiler
@@ -11684,11 +11715,11 @@
 !Parser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.786 2013-08-28 23:21:02 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.787 2013-08-29 18:22:03 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.786 2013-08-28 23:21:02 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.787 2013-08-29 18:22:03 cg Exp $'
 !
 
 version_SVN