class: Parser
better correctByGeneratingMethod.
(care for class messages; care for classVar getters)
--- 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