hg/stx-libtool: comparison SmalltalkCodeGeneratorTool.st

equal deleted inserted replaced

-:03f5a6c8f136
+:d0f296d32d73
 ' bindWith:method with:aSelector.
 alreadyInSuperclass ifTrue:[
 code := code, (('\    super %1\' bindWith:method) withCRs).
 ].
-self compile:code forClass:aClass inCategory:(aCategory ? 'actions').
+self compile:code forClass:aClass inCategory:(aCategory ? #actions).
 ^ code
 !
 createAspectMethodFor:aSelector in:aClass category:aCategory redefine:redefine
 |alreadyInSuperclass method code text|
 text := '    ^ super %1\' bindWith:method.
 ] ifFalse:[
 text := '    ^ builder valueAspectFor:#''%1'' initialValue:true\' bindWith:aSelector.
 ].
 code := code, (text withCRs).
-self compile:code forClass:aClass inCategory:(aCategory ? 'actions').
+self compile:code forClass:aClass inCategory:(aCategory ? #actions).
 ^ code
 ! !
 !SmalltalkCodeGeneratorTool class methodsFor:'private'!
 code := (self codeFor_classInitialize) expandPlaceholdersWith:bindings.
 self
 compile:code
 forClass:metaClass
-inCategory:'initialization'.
+inCategory:#initialization.
 ].
 self executeCollectedChangesNamed:('Add Class Initializer to ' , className).
 !
 (aClass includesSelector:selector) ifFalse:[
 code := (selector , '\    ^ false') withCRs.
 self
 compile:code
 forClass:aClass
-inCategory:'testing'.
+inCategory:#testing.
 ].
 (eachSubClass includesSelector:selector) ifFalse:[
 code := (selector , '\    ^ true') withCRs.
 self
 compile:code
 forClass:eachSubClass
-inCategory:'testing'.
+inCategory:#testing.
 ].
 ].
 self executeCollectedChangesNamed:'Add ClassType Tests'
 !
 initCode nextPutLine:'    "'.
 self
 compile:(initCode contents)
 forClass:metaClass
-inCategory:'class initialization'.
+inCategory:#'class initialization'.
 code := 'allStateNames\    ^ #( ' ,
 ((enumValues collect:[:each | '#''',each asLowercaseFirst,'''']) asStringWith:' ') , ')',
 '\\    "\' ,
 '     ',className, ' allStateNames\' ,
 '    "\'.
 self
 compile:code withCRs
 forClass:metaClass
-inCategory:'queries'.
+inCategory:#queries.
 self executeCollectedChangesNamed:('Generate EnumType Code for ' , className).
 aClass initialize.
 ' bindWith:className.
 self
 compile:code
 forClass:metaClass
-inCategory:'documentation'.
+inCategory:#documentation.
 ].
 self executeCollectedChangesNamed:('Add Example to ' , className).
 !
 metaClass := aClass theMetaclass.
 className := nonMetaClass name.
 self startCollectChanges.
-(nonMetaClass includesSelector:#'initialize') ifFalse:[
+(nonMetaClass includesSelector:#initialize) ifFalse:[
 code :=
 'initialize
 "Invoked when a new instance is created."
 "/ please change as required (and remove this comment)
 ].
 self
 compile:code
 forClass:nonMetaClass
-inCategory:'initialization'.
+inCategory:#initialization.
 ].
 self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
 !
 self startCollectChanges.
 self createInitializationMethodIn:aClass.
-(metaClass includesSelector:#'new') ifFalse:[
+(metaClass includesSelector:#new) ifFalse:[
 m := metaClass responseTo:#new.
 (m isNil
 or:[ (m sends:#initialize) not
 or:[
 (Dialog
 ^ self basicNew initialize.
 '.
 self
 compile:code
 forClass:metaClass
-inCategory:'instance creation'.
+inCategory:#'instance creation'.
 ].
 ].
 self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
 ].
 self
 compile:code
 forClass:nonMetaClass
-inCategory:'initialization'.
+inCategory:#initialization.
 ].
 (metaClass includesSelector:selector) ifFalse:[
 m := metaClass responseTo:selector.
 (m isNil
 ^ self basicNew initialize',dfn asUppercaseFirst,'
 '.
 self
 compile:code
 forClass:metaClass
-inCategory:'instance creation'.
+inCategory:#'instance creation'.
 ].
 ].
 self executeCollectedChangesNamed:('Add Parametrized Instance Creation to ' , className).
 !
 createPoolInitializationCodeFor:aClass
-|nonMetaClass metaClass className poolVars code initCode runValue maxValue|
+|nonMetaClass metaClass className poolVars initCode|
 self startCollectChanges.
 nonMetaClass := aClass theNonMetaclass.
 metaClass := aClass theMetaclass.
 initCode nextPutLine:'    "'.
 self
 compile:(initCode contents)
 forClass:metaClass
-inCategory:'class initialization'.
+inCategory:#'class initialization'.
 self executeCollectedChangesNamed:('Generate Pool Initialization Code for ' , className).
 aClass initialize.
 ^ super new.
 '.
 self
 compile:code
 forClass:metaClass
-inCategory:'redefined instance creation'.
+inCategory:#'redefined instance creation'.
 ].
 (metaClass includesSelector:#'new:') ifFalse:[
 code :=
 'new:n
 ^ super new:n.
 '.
 self
 compile:code
 forClass:metaClass
-inCategory:'redefined instance creation'.
+inCategory:#'redefined instance creation'.
 ].
 self executeCollectedChangesNamed:('Redefined Instance Creation to ' , className).
 !
 metaClass := aClass theMetaclass.
 className := nonMetaClass name.
 self startCollectChanges.
-(metaClass includesSelector:#'theOneAndOnlyInstance') ifFalse:[
+(metaClass includesSelector:#theOneAndOnlyInstance) ifFalse:[
 code :=
 'theOneAndOnlyInstance
 "returns a singleton"
 %1 isNil ifTrue:[
 ^ %1.
 '.
 self
 compile:(code bindWith:varName)
 forClass:metaClass
-inCategory:'instance creation'.
+inCategory:#'instance creation'.
 ].
-(metaClass includesSelector:#'new') ifFalse:[
+(metaClass includesSelector:#new) ifFalse:[
 code :=
 'new
 "returns a singleton"
 ^ self theOneAndOnlyInstance.
 '.
 self
 compile:(code bindWith:varName)
 forClass:metaClass
-inCategory:'instance creation'.
+inCategory:#'instance creation'.
 ].
-(metaClass includesSelector:#'flushSingleton') ifFalse:[
+(metaClass includesSelector:#flushSingleton) ifFalse:[
 code :=
 'flushSingleton
 "flushes the cached singleton"
 %1 := nil
 "
 '.
 self
 compile:(code bindWith:varName)
 forClass:metaClass
-inCategory:'instance creation'.
+inCategory:#'instance creation'.
 ].
 self executeCollectedChangesNamed:('Singleton Pattern for ' , className).
 "Created: / 10-02-2011 / 16:32:48 / cg"
 nonMetaClass := aClass theNonMetaclass.
 self startCollectChanges.
-(nonMetaClass includesSelector:#'printOn:') ifFalse:[
+(nonMetaClass includesSelector:#printOn:) ifFalse:[
 code :=
 'printOn:aStream
 "append a printed representation if the receiver to the argument, aStream"
 super printOn:aStream.
 ].
 self
 compile:code
 forClass:nonMetaClass
-inCategory:'printing & storing'.
+inCategory:#'printing & storing'.
 ].
 self executeCollectedChangesNamed:('Add #printOn: to ' , nonMetaClass name).
 ifTrue: [anApplicationClassOrNil name]
 ifFalse: [className.].
 self
 compile:(source bindWith:anApplicationClassNameOrStartupClassName)
 forClass:metaClass
-inCategory:'startup'.
+inCategory:#startup.
 ].
 self executeCollectedChangesNamed:('Add Startup Code to ' , className).
 !
 createTestCaseSampleCodeFor:aClass
 self run:#test1
 self new test1
 "
 '
 forClass:nonMetaClass
-inCategory:'tests'.
+inCategory:#tests.
 ].
 ( nonMetaClass includesSelector:#test2 ) ifFalse:[
 self
 compile:
 self run:#test2
 self new test2
 "
 '
 forClass:nonMetaClass
-inCategory:'tests'.
+inCategory:#tests.
 ].
 ( nonMetaClass includesSelector:#test3 ) ifFalse:[
 self
 compile:
 self run:#test3
 self new test3
 "
 '
 forClass:nonMetaClass
-inCategory:'tests'.
+inCategory:#tests.
 ].
 ( nonMetaClass includesSelector:#setUp ) ifFalse:[
 self
 compile:
 "common setup - invoked before testing."
 super setUp
 '
 forClass:nonMetaClass
-inCategory:'initialize / release'.
+inCategory:#'initialize / release'.
 ].
 ( nonMetaClass includesSelector:#tearDown ) ifFalse:[
 self
 compile:
 "common cleanup - invoked after testing."
 super tearDown
 '
 forClass:nonMetaClass
-inCategory:'initialize / release'.
+inCategory:#'initialize / release'.
 ]
 !
 createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
 "create acceptVisitor: in visitedClass and acceptXXX in visitorClass. (I'm tired of typing)"
 "fall back to general object-case - please change as required"
 ^ self visitObject:anObject
 ') bindWith:sel with:visitedClass nameWithoutPrefix asLowercaseFirst)
 forClass:visitorClass
-inCategory:'visiting'.
+inCategory:#visiting.
 ].
-(visitorClass includesSelector:#'visitObject:') ifFalse:[
+(visitorClass includesSelector:#visitObject:) ifFalse:[
 self
 compile:
 ('visitObject:anObject
 "dispatched back from the visited objects (visitor pattern)"
 "general fallBack - please change as required"
 self halt:''not yet implemented''
 ')
 forClass:visitorClass
-inCategory:'visiting'.
+inCategory:#visiting.
 ].
-(visitorClass includesSelector:#'visit:') ifFalse:[
+(visitorClass includesSelector:#visit:) ifFalse:[
 self
 compile:
 ('visit:anObject
 "visit anObject (visitor pattern).
 The object should call back one of my visitXXXX methods."
 ^ anObject acceptVisitor:self
 ')
 forClass:visitorClass
-inCategory:'visiting'.
+inCategory:#visiting.
 ].
 self executeCollectedChangesNamed:('Add Visitor Pattern').
 !
 (metaClass includesSelector:#pageSpec) ifFalse:[
 txt := self class initialPageSpecMethodSourceForWebApplications.
 self
 compile:(txt bindWith:className)
 forClass:metaClass
-inCategory:'page specs'.
+inCategory:#'page specs'.
 ].
 self executeCollectedChangesNamed:('Add WebApplication Code for ' , className).
 "Modified: / 1.2.1998 / 16:10:03 / cg"
 response nextPutLine:''</HTML>''.
 '.
 self
 compile:txt
 forClass:nonMetaClass
-inCategory:'response generation - pages'.
+inCategory:#'response generation - pages'.
 ].
 (nonMetaClass includesSelector:#page2:) ifFalse:[
 txt :=
 'page2:aRequest
 aRequest reply:(page htmlString).
 '.
 self
 compile:txt
 forClass:nonMetaClass
-inCategory:'response generation - pages'.
+inCategory:#'response generation - pages'.
 ].
 (nonMetaClass includesSelector:#page3:) ifFalse:[
 txt :=
 'page3:aRequest
 without any html formatting.''
 '.
 self
 compile:txt
 forClass:nonMetaClass
-inCategory:'response generation - pages'.
+inCategory:#'response generation - pages'.
 ].
 (nonMetaClass includesSelector:#process:) ifFalse:[
 txt :=
 'process:aRequest
 aRequest reportNotFound:''No such page in this service''.
 '.
 self
 compile:txt
 forClass:nonMetaClass
-inCategory:'response generation'.
+inCategory:#'response generation'.
 ].
 (metaClass includesSelector:#linkName) ifFalse:[
 txt :=
 'linkName
 ^ ''/NewService''
 '.
 self
 compile:txt
 forClass:metaClass
-inCategory:'defaults'.
+inCategory:#defaults.
 ].
 (metaClass includesSelector:#settingsApplicationClass) ifFalse:[
 txt :=
 'settingsApplicationClass
 ^ nil
 '.
 self
 compile:txt
 forClass:metaClass
-inCategory:'defaults'.
+inCategory:#defaults.
 ].
 self executeCollectedChangesNamed:('Add WebService Code for ' , className).
 inCategory:category.
 ]
 ].
 #(
-#'initialize'               #code_forWidget_initialize  'initialization & release'
+initialize               code_forWidget_initialize  #'initialization & release'
-#'update:with:from:'        #code_forWidget_update      'change & update'
+update:with:from:        code_forWidget_update      #'change & update'
-#'redrawX:y:width:height:'  #code_forWidget_redraw      'drawing'
+redrawX:y:width:height:  code_forWidget_redraw      #'drawing'
-#'buttonPress:x:y:'         #code_forWidget_buttonPress 'event handling'
+buttonPress:x:y:         code_forWidget_buttonPress #'event handling'
-#'keyPress:x:y:'            #code_forWidget_keyPress    'event handling'
+keyPress:x:y:            code_forWidget_keyPress    #'event handling'
-#'sizeChanged:'             #code_forWidget_sizeChanged 'event handling'
+sizeChanged:             code_forWidget_sizeChanged #'event handling'
 ) inGroupsOf:3 do:compileTemplateAction.
 self executeCollectedChangesNamed:('Add Widget Code for ' , className).
 ! !
 source := source
 , '    ^ %2'.
 ].
 ].
 source := (source bindWith:varType with:name with:defaultMethodName) withCRs.
-self compile:source forClass:aClass inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
+self compile:source forClass:aClass inCategory:(asValueHolder ifTrue:[#aspects] ifFalse:[#accessing]).
 ] ifTrue:[
 Transcript showCR:'method ''', methodName , ''' already present'
 ].
 "/ default for lazy on class side
 ].
 source := source
 , '    self shouldImplement.\'
 , '    ^ nil.'.
 source := (source bindWith:varType with:name) withCRs.
-self compile:source forClass:aClass theMetaclass inCategory:'defaults'.
+self compile:source forClass:aClass theMetaclass inCategory:#defaults.
 ].
 ].
 ].
 "/ the SETTER
 ].
 source := (source bindWith:varType with:name with:argName) withCRs.
 self
 compile:source
 forClass:aClass
-inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
+inCategory:(asValueHolder ifTrue:[#aspects] ifFalse:[#accessing]).
 ] ifTrue:[
 Transcript showCR:'method ''', methodName , ':'' already present'
 ].
 ].
 ].
 , '        %2 := OrderedCollection new.\'.
 source := source
 , '    ].\'
 , '    %2 add: a%1'.
 source := (source bindWith:methodNameBase with:name) withCRs.
-self compile:source forClass:aClass inCategory:'accessing'.
+self compile:source forClass:aClass inCategory:#accessing.
 ] ifTrue:[
 Transcript showCR:'method ''', methodName , ''' already present'
 ].
 methodName := 'remove' , methodNameBase, ':'.
 source := source , '    "remove a ',methodNameBase,'"\\'.
 ].
 source := source
 , '    %2 remove: a%1'.
 source := (source bindWith:methodNameBase with:name) withCRs.
-self compile:source forClass:aClass inCategory:'accessing'.
+self compile:source forClass:aClass inCategory:#accessing.
 ] ifTrue:[
 Transcript showCR:'method ''', methodName , ''' already present'
 ].
 ].
 generateComments ifTrue:[
 source := source , '    "return the value in ''%2''"\\'.
 ].
 source := source , '    ^ self %2 value'.
 source := (source bindWith:methodName with:holderMethodName) withCRs.
-self compile:source forClass:nonMetaClass inCategory:('accessing').
+self compile:source forClass:nonMetaClass inCategory:#accessing.
 ] ifTrue:[
 Transcript showCR:'method ''', methodName , ''' already present'
 ].
 (metaClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
 generateComments ifTrue:[
 source := source , '    "set the value in ''%2''"\\'.
 ].
 source := source , '    self %2 value: newValue'.
 source := (source bindWith:methodName with:holderMethodName) withCRs.
-self compile:source forClass:nonMetaClass inCategory:('accessing').
+self compile:source forClass:nonMetaClass inCategory:#accessing.
 ] ifTrue:[
 Transcript showCR:'method ''', methodName , ':'' already present'
 ].
 ].
 (metaClass includesSelector:(holderMethodName asSymbol)) ifFalse:[
 source := source , '    %1 isNil ifTrue:[\'.
 source := source , '        %1 := ValueHolder with:nil "defaultValue here".\'.
 source := source , '    ].\'.
 source := source , '    ^ %1\'.
 source := (source bindWith:holderMethodName) withCRs.
-self compile:source forClass:nonMetaClass inCategory:('accessing').
+self compile:source forClass:nonMetaClass inCategory:#accessing.
 ] ifTrue:[
 Transcript showCR:'method ''', methodName , ''' already present'
 ].
 ].
 "stub code automatically generated - please change if required"
 ^ aVisitor %1self
 ') bindWith:selector)
 forClass:aClass
-inCategory:'visiting'.
+inCategory:#visiting.
 ]
 !
 createAcceptVisitorMethodIn:aClass
 "create an acceptVisitor: method
 'copyright
 "
 ' , txt , '
 "
 '             forClass:aClass
-inCategory:'documentation'.
+inCategory:#documentation.
 ]
 ].
 !
 createDocumentationMethodFor:aClass
 ].
 self
 compile:code
 forClass:metaClass
-inCategory:'documentation'.
+inCategory:#documentation.
 ].
 "Modified: / 24-11-2006 / 15:54:27 / cg"
 "Modified: / 04-02-2011 / 08:24:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 ... executable example here ...
 [exEnd]
 "
 '
 forClass:aClass
-inCategory:'documentation'.
+inCategory:#documentation.
 ].
 !
 createImageSpecMethodFor:anImage comment:comment in:aClass selector:sel
 |imageStoreStream mthd imageKey category|
 anImage storeOn: (imageStoreStream := WriteStream on: '').
 "/ if that method already exists, do not overwrite the category
-category := 'image specs'.
+category := #'image specs'.
 (mthd := aClass compiledMethodAt:sel) notNil ifTrue:[
 category := mthd category.
 ].
-imageKey :=  (aClass name, ' ', sel) asSymbol.
+imageKey :=  aClass theNonMetaclass name, ' ', sel.
 Icon constantNamed: imageKey put:nil.
 self
 compile: ((sel,
 '\', comment,
 '\\' ,
 HistoryManager notNil ifTrue:[
 code := HistoryManager codeForInitialHistoryMethodIn:aClass.
 self
 compile:code
 forClass:aClass
-inCategory:'documentation'.
+inCategory:#documentation.
 ].
 ].
 !
 createInstanceCreationMethodWithSetupFor:selector category:category in:aMetaClass
 source := source , ('    "set instance variables"' , Character cr , Character cr).
 ].
 aCollectionOfVarNames do:[:eachVar |
 source := source , ('    ' , eachVar , ' := ' , eachVar , 'Arg.' , Character cr).
 ].
-self compile:source forClass:aClass inCategory:'accessing'.
+self compile:source forClass:aClass inCategory:#accessing.
 !
 createSubclassResponsibilityMethodFor:aSelector category:cat in:aClass
 "add a subclassResponsibility method;
 but only if not already present."
 "create an update:with:from:-method
 (I'm tired of typing)"
 |code|
-(aClass includesSelector:#'update:with:from:') ifFalse:[
+(aClass includesSelector:#update:with:from:) ifFalse:[
 generateComments ifFalse:[
 code :=
 'update:something with:aParameter from:changedObject
 super update:something with:aParameter from:changedObject
 '
 ].
 self
 compile:code
 forClass:aClass
-inCategory:'change & update'.
+inCategory:#'change & update'.
 ]
 !
 createVersionMethodFor:aClass
 <resource: #obsolete>
 code:= ('version\    ^ ''$' , 'Header$''') withCRs
 ].
 self
 compile:code
 forClass:aClass
-inCategory:'documentation'.
+inCategory:#documentation.
 ]
 ].
 ! !
 !SmalltalkCodeGeneratorTool methodsFor:'code templates'!
 ! !
 !SmalltalkCodeGeneratorTool class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/SmalltalkCodeGeneratorTool.st,v 1.12 2012-01-27 13:55:22 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/SmalltalkCodeGeneratorTool.st,v 1.13 2012-05-22 16:33:26 stefan Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libtool/SmalltalkCodeGeneratorTool.st,v 1.12 2012-01-27 13:55:22 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/SmalltalkCodeGeneratorTool.st,v 1.13 2012-05-22 16:33:26 stefan Exp $'
 !
 version_SVN
 ^ '�Id�'
 ! !

changeset 11523	d0f296d32d73
parent 11223	52963b06ef66
child 11637	b7ab3efa491e