"{ Package: 'stx:libtool' }"
Object subclass:#CodeGeneratorTool
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers'
!
!CodeGeneratorTool class methodsFor:'documentation'!
documentation
"
extracted code generation stuff from old and newBrowser.
There is probably more to gome...
[author:]
Claus Gittiner
"
! !
!CodeGeneratorTool class methodsFor:'code generation'!
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly
^ self
createAccessMethodsFor:aCollectionOfVarNames
in:aClass
withChange:withChange
asValueHolder:asValueHolder
readersOnly:readersOnly
writersOnly:writersOnly
lazyInitialization:false
!
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
"workhorse for creating access methods for instvars."
|classesClassVars|
classesClassVars := aClass theNonMetaclass allClassVarNames.
aCollectionOfVarNames do:[:name |
|source varType methodName defaultMethodName|
varType := (classesClassVars includes:name)
ifTrue:['static']
ifFalse:[
(aClass isMeta ifTrue:['classInstVar'] ifFalse:['instance'])].
methodName := name.
name first isUppercase ifTrue:[
methodName := methodName asLowercaseFirst.
].
"/ the GETTER
writersOnly ifFalse:[
lazyInitialization ifTrue:[
defaultMethodName := 'default' , name asUppercaseFirst.
].
"check, if method is not already present"
(aClass includesSelector:(methodName asSymbol)) ifFalse:[
asValueHolder ifTrue:[
source := methodName
, '\ "return/create the ''%2'' value holder (automatically generated)"\\'
, ' %2 isNil ifTrue:[\'.
lazyInitialization ifTrue:[
source := source
, ' %2 := self class %3 asValue.\'.
] ifFalse:[
source := source
, ' %2 := ValueHolder new.\'.
].
withChange ifTrue:[
source := source
, ' %2 addDependent:self.\'.
].
source := source
, ' ].\'
, ' ^ %2'.
] ifFalse:[
source := methodName
, '\ "return the value of the %1 variable ''%2'' (automatically generated)"\\'.
lazyInitialization ifTrue:[
source := source
, ' %2 isNil ifTrue:[\'
, ' %2 := self class %3.\'
, ' ].\'
, ' ^ %2'.
] ifFalse:[
source := source
, ' ^ %2'.
].
].
source := (source bindWith:varType with:name with:defaultMethodName) withCRs.
self compile:source forClass:aClass inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
] ifTrue:[
Transcript showCR:'method ''', methodName , ''' already present'
].
"/ default for lazy on class side
lazyInitialization ifTrue:[
(aClass class includesSelector:(defaultMethodName asSymbol)) ifFalse:[
source := defaultMethodName
, '\ "default value for the ''%2'' instance variable (automatically generated)"\\'
, ' self halt:''unfinished code''.\'
, ' ^ nil.'.
source := (source bindWith:varType with:name) withCRs.
self compile:source forClass:aClass class inCategory:'defaults'.
].
].
].
"/ the SETTER
readersOnly ifFalse:[
(aClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
asValueHolder ifTrue:[
source := methodName
, ':something\ "set the ''%2'' value holder'.
withChange ifTrue:[
source := source
, ' (automatically generated)"\\'
, ' |oldValue newValue|\\'
, ' %2 notNil ifTrue:[\'
, ' oldValue := %2 value.\'
, ' %2 removeDependent:self.\'
, ' ].\'
, ' %2 := something.\'
, ' %2 notNil ifTrue:[\'
, ' %2 addDependent:self.\'
, ' ].\'
, ' newValue := %2 value.\'
, ' oldValue ~~ newValue ifTrue:[\'
, ' self update:#value with:newValue from:%2.\'
, ' ].\'
] ifFalse:[
source := source
, ' (automatically generated)"\\'
, ' %2 := something.'.
].
] ifFalse:[
source := methodName
, ':something\ "set the value of the %1 variable ''%2'''.
withChange ifTrue:[
source := source
, ' and send a change notification (automatically generated)"\\'
, ' (%2 ~~ something) ifTrue:[\'
, ' %2 := something.\'
, ' self changed:#%2.\'
, ' ].\'.
] ifFalse:[
source := source
, ' (automatically generated)"\\'
, ' %2 := something.'.
].
].
source := (source bindWith:varType with:name) withCRs.
self
compile:source
forClass:aClass
inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
] ifTrue:[
Transcript showCR:'method ''', methodName , ':'' already present'
].
].
]
!
createApplicationCodeFor:aClass
"create an empty application framework"
|nonMetaClass metaClass className txt isDialog|
nonMetaClass := aClass theNonMetaclass.
metaClass := aClass theMetaclass.
className := nonMetaClass name.
isDialog := (nonMetaClass isSubclassOf:SimpleDialog).
"/ add a windowSpec method for an empty applicationWindow,
"/ with a menuPanel.
(metaClass includesSelector:#windowSpec) ifFalse:[
isDialog ifTrue:[
txt := self initialWindowSpecMethodSourceForDialogs.
] ifFalse:[
txt := self initialWindowSpecMethodSourceForApplications.
].
self
compile:(txt bindWith:className)
forClass:metaClass
inCategory:'interface specs'.
].
isDialog ifFalse:[
"/ add a topMenu method
(metaClass includesSelector:#mainMenu) ifFalse:[
txt := self initialMenuSpecMethodSourceForApplications.
self
compile:(txt bindWith:className)
forClass:metaClass
inCategory:'menu specs'.
].
].
(metaClass includesSelector:#postBuildWith:) ifFalse:[
txt :=
'postBuildWith:aBuilder
"This is a hook method generated by the Browser.
It will be invoked during the initialization of your app/dialog,
after all of the visual components have been built,
but BEFORE the top window is made visible.
Add any app-specific actions here (reading files, setting up values etc.)
See also #postOpenWith:, which is invoked after opening."
"/ add any code here ...
^ super postBuildWith:aBuilder
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'initialization & release'.
].
(metaClass includesSelector:#postOpenWith:) ifFalse:[
txt :=
'postOpenWith:aBuilder
"This is a hook method generated by the Browser.
It will be invoked right after the applications window has been opened.
Add any app-specific actions here (starting background processes etc.).
See also #postBuildWith:, which is invoked before opening."
"/ add any code here ...
^ super postOpenWith:aBuilder
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'initialization & release'.
].
isDialog ifFalse:[
(metaClass includesSelector:#closeRequest) ifFalse:[
txt :=
'closeRequest
"This is a hook method generated by the Browser.
It will be invoked when your app/dialog-window is about to be
closed (this method has a chance to suppress the close).
See also #closeDownViews, which is invoked when the close is really done."
"/ change the code below as required ...
"/ Closing can be suppressed, by simply returning.
"/ The ''super closeRequest'' at the end will initiate the real closeDown
("self hasUnsavedChanges" true) ifTrue:[
(self confirm:(resources string:''Close without saving ?'')) ifFalse:[
^ self
]
].
^ super closeRequest
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'initialization & release'.
].
].
isDialog ifFalse:[
(metaClass includesSelector:#closeDownViews) ifFalse:[
txt :=
'closeDownViews
"This is a hook method generated by the Browser.
It will be invoked when your app/dialog-window is really closed.
See also #closeDownViews, which is invoked before and may suppress the close
or ask the user for confirmation."
"/ change the code below as required ...
"/ This should cleanup any leftover resources
"/ (for example, temporary files)
"/ super closeRequest will initiate the closeDown
"/ add your code here
"/ do not remove the one below ...
^ super closeDownViews
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'initialization & release'.
].
].
isDialog ifTrue:[
(metaClass includesSelector:#accept) ifFalse:[
txt :=
'closeAccept
"This is a hook method generated by the Browser.
It will be invoked when your dialog-window is closed with OK."
"/ add any actions as required here ...
Transcript showCR:''dialog accepted''.
"/ do not remove the one below ...
^ super closeAccept
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'user actions'.
].
].
isDialog ifFalse:[
(metaClass includesSelector:#menuNew) ifFalse:[
txt :=
'menuNew
"This method was generated by the Browser.
It will be invoked when the menu-item ''new'' is selected."
"/ change below and add any actions as required here ...
self warn:''no action for ''''new'''' available.''.
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'menu actions'.
].
].
isDialog ifFalse:[
(metaClass includesSelector:#menuOpen) ifFalse:[
txt :=
'menuOpen
"This method was generated by the Browser.
It will be invoked when the menu-item ''open'' is selected."
"/ change below and add any actions as required here ...
self warn:''no action for ''''open'''' available.''.
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'menu actions'.
].
].
isDialog ifFalse:[
(metaClass includesSelector:#menuSave) ifFalse:[
txt :=
'menuSave
"This method was generated by the Browser.
It will be invoked when the menu-item ''save'' is selected."
"/ change below and add any actions as required here ...
self warn:''no action for ''''save'''' available.''.
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'menu actions'.
].
].
isDialog ifFalse:[
(metaClass includesSelector:#menuSaveAs) ifFalse:[
txt :=
'menuSaveAs
"This method was generated by the Browser.
It will be invoked when the menu-item ''saveAs'' is selected."
"/ change below and add any actions as required here ...
self warn:''no action for ''''saveAs'''' available.''.
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'menu actions'.
].
].
isDialog ifFalse:[
(metaClass includesSelector:#openDocumentation) ifFalse:[
txt :=
'openDocumentation
"This method was generated by the Browser.
It will be invoked when the menu-item ''help-documentation'' is selected."
"/ change below as required ...
"/ to open an HTML viewer on some document (under ''doc/online/<language>/'' ):
HTMLDocumentView openFullOnDocumentationFile:''TOP.html''.
"/ add application-specific help files under the ''doc/online/<language>/help/appName''
"/ directory, and open a viewer with:
"/ HTMLDocumentView openFullOnDocumentationFile:''help/<MyApplication>/TOP.html''.
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'menu actions'.
].
].
isDialog ifFalse:[
(metaClass includesSelector:#openAboutThisApplication) ifFalse:[
txt :=
'openAboutThisApplication
"This method was generated by the Browser.
It will be invoked when the menu-item ''help-about'' is selected."
"/ could open a customized aboutBox here ...
super openAboutThisApplication
'.
self
compile:txt
forClass:nonMetaClass
inCategory:'menu actions'.
].
].
"Modified: / 1.2.1998 / 16:10:03 / cg"
!
createClassResponsibleProtocolFor:aClass
"create stubs for the required protocol"
self privCreateClassResponsibleProtocolFor:aClass theNonMetaclass.
self privCreateClassResponsibleProtocolFor:aClass theMetaclass.
!
createClassTypeTestMethodsIn:aClass
"create a #isXXX test methods
(I'm tired of typing)"
|subClasses code|
subClasses := aClass subclasses.
subClasses do:[:eachSubClass |
|nm selector|
nm := eachSubClass nameWithoutPrefix.
selector := 'is' , nm.
(aClass includesSelector:selector) ifFalse:[
code := (selector , '\ ^ false') withCRs.
self
compile:code
forClass:aClass
inCategory:'testing'.
].
(eachSubClass includesSelector:selector) ifFalse:[
code := (selector , '\ ^ true') withCRs.
self
compile:code
forClass:eachSubClass
inCategory:'testing'.
].
].
!
createDocumentationMethodsFor:aClass
"create empty documentation methods"
|cls|
cls := aClass theMetaclass.
self createVersionMethodFor:cls.
self createCopyrightMethodFor:aClass.
self createDocumentationMethodFor:aClass.
self createInitialHistoryMethodFor:aClass.
!
createStandardInitializationMethodsIn:aClass
"create a #new and #initialize methods
(I'm tired of typing)"
|code initializer m|
(aClass includesSelector:#'initialize') ifFalse:[
code :=
'initialize
"Invoked when a new instance is created."
super initialize.
"/ please change as required (and remove this comment)
'.
m := aClass responseTo:#initialize.
m notNil ifTrue:[
m messagesSent size == 0 ifTrue:[
"/ inherits an empty initialize.
code :=
'initialize
"Invoked when a new instance is created."
"/ please change as required (and remove this comment)
"/ super initialize. -- commented since inherited method does nothing
'.
].
].
aClass instVarNames do:[:eachInstVar |
initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
code := code , (' ' , eachInstVar , ' := ' , initializer , Character cr).
].
self
compile:code
forClass:aClass
inCategory:'initialization'.
].
(aClass class includesSelector:#'new') ifFalse:[
m := aClass class responseTo:#new.
m notNil ifTrue:[
(m sends:#initialize) ifTrue:[
(self confirm:'The inherited #new method already seems to invoke #initialize. Redefine ?')
ifFalse:[
^ self
]
].
].
code :=
'new
^ self basicNew initialize.
'.
self
compile:code
forClass:aClass class
inCategory:'instance creation'.
].
"Created: / 11.10.2001 / 22:18:55 / cg"
!
createTestCaseSampleCodeFor:aClass
"create an empty testCase"
|nonMetaClass metaClass|
nonMetaClass := aClass theNonMetaclass.
metaClass := aClass theMetaclass.
"/ className := nonMetaClass name.
( nonMetaClass includesSelector:#test1 ) ifFalse:[
self
compile:
'test1
"Just a demonstration testCase.
Double click on the TestCase class or open a TestRunner to see me checking...
- please add more methods like this..."
|o|
o := Array new:2.
self assert: ( o size == 2 ).
self should: [ o at:0 ] raise:Error.
self shouldnt: [ o at:1 ] raise:Error.
"
self run:#test1
"
'
forClass:nonMetaClass
inCategory:'tests'.
].
( nonMetaClass includesSelector:#setUp ) ifFalse:[
self
compile:
'setUp
"common setup - invoked before testing"
super setUp
'
forClass:nonMetaClass
inCategory:'initialize / release'.
].
( nonMetaClass includesSelector:#tearDown ) ifFalse:[
self
compile:
'tearDown
"common cleanup - invoked after testing"
super tearDown
'
forClass:nonMetaClass
inCategory:'initialize / release'.
]
!
createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
"create acceptVisitor: in visitedClass and acceptXXX in visitorClass.
(I'm tired of typing)"
|sel|
visitedClass isMeta ifTrue:[self halt].
visitorClass isMeta ifTrue:[self halt].
sel := ('visit' , visitedClass nameWithoutPrefix , ':').
self createAcceptVisitorMethod:sel in:visitedClass.
(visitorClass includesSelector:sel) ifFalse:[
self
compile:
(('%1anObject
"dispatched back from the visited %2-object (visitor pattern)"
"fall back to general object-case - please change as required"
^ self visitObject:anObject
') bindWith:sel with:visitedClass nameWithoutPrefix asLowercaseFirst)
forClass:visitorClass
inCategory:'visiting'.
].
(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'.
].
(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'.
]
!
initialMenuSpecMethodSourceForApplications
^
'mainMenu
"This resource specification was automatically generated by the CodeGeneratorTool."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:%1 andSelector:#mainMenu
"
<resource: #menu>
^ #(#Menu
#(
#(#MenuItem
#label: ''File''
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: ''New''
#translateLabel: true
#value: #menuNew
)
#(#MenuItem
#label: ''-''
)
#(#MenuItem
#label: ''Open...''
#translateLabel: true
#value: #menuOpen
)
#(#MenuItem
#label: ''-''
)
#(#MenuItem
#label: ''Save''
#translateLabel: true
#value: #menuSave
)
#(#MenuItem
#label: ''Save As...''
#translateLabel: true
#value: #menuSaveAs
)
#(#MenuItem
#label: ''-''
)
#(#MenuItem
#label: ''Exit''
#translateLabel: true
#value: #closeRequest
)
) nil
nil
)
)
#(#MenuItem
#label: ''Help''
#translateLabel: true
#startGroup: #right
#submenu:
#(#Menu
#(
#(#MenuItem
#label: ''Documentation''
#translateLabel: true
#value: #openDocumentation
)
#(#MenuItem
#label: ''-''
)
#(#MenuItem
#label: ''About this Application''
#translateLabel: true
#value: #openAboutThisApplication
)
) nil
nil
)
)
) nil
nil
)
'.
!
initialWindowSpecMethodSourceForApplications
^
'windowSpec
"This resource specification was automatically generated by the CodeGeneratorTool."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:%1 andSelector:#windowSpec
"
<resource: #canvas>
^ #(#FullSpec
#window:
#(#WindowSpec
#name: ''%1''
#layout: #(#LayoutFrame 204 0 162 0 503 0 461 0)
#label: ''%1''
#min: #(#Point 10 10)
#max: #(#Point 1024 768)
#bounds: #(#Rectangle 204 162 504 462)
#menu: #mainMenu
#usePreferredExtent: false
)
#component:
#(#SpecCollection
#collection: #()
)
)
'.
!
initialWindowSpecMethodSourceForDialogs
^
'windowSpec
"This resource specification was automatically generated by the CodeGeneratorTool."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:%1 andSelector:#windowSpec
"
<resource: #canvas>
^
#(#FullSpec
#window:
#(#WindowSpec
#name: ''%1''
#layout: #(#LayoutFrame 221 0 118 0 520 0 417 0)
#level: 0
#label: ''%1''
#min: #(#Point 10 10)
#max: #(#Point 1024 768)
#bounds: #(#Rectangle 221 118 521 418)
#usePreferredExtent: false
)
#component:
#(#SpecCollection
#collection:
#(
#(#HorizontalPanelViewSpec
#name: ''buttonPanel''
#layout: #(#LayoutFrame 0 0.0 -45 1 0 1.0 0 1.0)
#component:
#(#SpecCollection
#collection:
#(
#(#ActionButtonSpec
#name: ''cancelButton''
#label: ''Cancel''
#tabable: true
#translateLabel: true
#model: #cancel
#extent: #(#Point 125 22)
)
#(#ActionButtonSpec
#name: ''okButton''
#label: ''OK''
#tabable: true
#translateLabel: true
#isDefault: true
#model: #accept
#extent: #(#Point 125 22)
)
)
)
#reverseOrderIfOKAtLeft: true
#horizontalLayout: #spreadSpaceMax
#verticalLayout: #center
#horizontalSpace: 3
#verticalSpace: 3
)
)
)
)
'.
! !
!CodeGeneratorTool class methodsFor:'code generation - individual methods'!
createAcceptVisitorMethod:selector in:aClass
"create an acceptVisitor: method
(I'm tired of typing)"
aClass isMeta ifTrue:[self halt].
(aClass includesSelector:#'acceptVisitor:') ifFalse:[
self
compile:
(('acceptVisitor:aVisitor
"Double dispatch back to the visitor, passing my type encoded in
the selector (visitor pattern)"
"stub code automatically generated - please change if required"
^ aVisitor %1self
') bindWith:selector)
forClass:aClass
inCategory:'visiting'.
]
!
createAcceptVisitorMethodIn:aClass
"create an acceptVisitor: method
(I'm tired of typing)"
self
createAcceptVisitorMethod:('visit' , aClass nameWithoutPrefix , ':') asSymbol
in:aClass
!
createCopyrightMethodFor:aClass
"add copyright method containing your/your companies
copyright template but only if not already present.
this is only added, if specified in the
COPYRIGHT_TEMPLATE_FILE resources."
|fn txt|
(aClass includesSelector:#copyright) ifFalse:[
fn := SystemBrowser classResources at:#'COPYRIGHT_TEMPLATE_FILE' default:nil.
fn notNil ifTrue:[
fn := fn asFilename.
fn exists ifTrue:[
txt := fn contents asString
]
].
txt notNil ifTrue:[
txt := txt bindWith:(Date today year).
self compile:
'copyright
"
' , txt , '
"
' forClass:aClass
inCategory:'documentation'.
]
].
!
createDocumentationMethodFor:aClass
"add documentation method containing doc template
but only if not already present."
|userName loginName hostName emailAddress|
(aClass includesSelector:#documentation) ifFalse:[
userName := OperatingSystem getFullUserName.
loginName := OperatingSystem getLoginName.
hostName := OperatingSystem getHostName.
emailAddress := loginName , '@' , hostName.
self compile:
'documentation
"
documentation to be added.
[author:]
' , userName
, ' (' , emailAddress , ')' , '
[instance variables:]
[class variables:]
[see also:]
"
' forClass:aClass
inCategory:'documentation'.
].
!
createExamplesMethodFor:aClass
"add examples method containing examples template
but only if not already present."
|fragment|
(aClass includesSelector:#examples) ifFalse:[
(aClass theNonMetaclass isSubclassOf:ApplicationModel) ifTrue:[
fragment := ' Starting the application:
[exBegin]
' , aClass theNonMetaclass name , ' open
[exEnd]
'
] ifFalse:[
fragment := ''
].
self
compile:
'examples
"
' , fragment , '
more examples to be added:
[exBegin]
... add code fragment for
... executable example here ...
[exEnd]
"
'
forClass:aClass
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'.
(mthd := aClass compiledMethodAt:sel) notNil ifTrue:[
category := mthd category.
].
imageKey := (aClass name, ' ', sel) asSymbol.
Icon constantNamed: imageKey put:nil.
aClass
compile: ((sel,
'\', comment,
'\\' ,
' "\',
' self ' , sel , ' inspect\',
' ImageEditor openOnClass:self andSelector:#', sel, '\',
' Icon flushCachedIcons',
'\ "',
'\\',
' <resource: #image>',
'\\',
' ^Icon\') withCRs,
' constantNamed:#''', imageKey, '''\' withCRs,
' ifAbsentPut:[', imageStoreStream contents, ']')
classified: category.
!
createInitialHistoryMethodFor:aClass
"add history method containing created-entry
but only if not already present."
(aClass includesSelector:#history) ifFalse:[
HistoryManager notNil ifTrue:[
HistoryManager createInitialHistoryMethodIn:aClass
].
].
!
createMultiSetterMethodFor:aCollectionOfVarNames in:aClass
"create a multi-setter method for instvars."
|source|
source := ''.
aCollectionOfVarNames do:[:eachVar |
source := source , (eachVar , ':' , eachVar , 'Arg ').
].
source := source , Character cr.
source := source , (' "set instance variables (automatically generated)"' , Character cr , Character cr).
aCollectionOfVarNames do:[:eachVar |
source := source , (' ' , eachVar , ' := ' , eachVar , 'Arg.' , Character cr).
].
self compile:source forClass:aClass inCategory:'accessing'.
!
createSubclassResponsibilityMethodFor: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: must be redefined in concrete subclass(es)"
^ self subclassResponsibility
'
forClass:aClass
inCategory:cat.
].
!
createUpdateMethodIn:aClass
"create an update:with:from:-method
(I'm tired of typing)"
(aClass includesSelector:#'update:with:from:') ifFalse:[
self
compile:
'update:something with:aParameter from:changedObject
"Invoked when an object that I depend upon sends a change notification."
"stub code automatically generated - please change as required"
"/ changedObject == someOfMyValueHolders ifTrue:[
"/ self doSomethingApropriate
"/ ^ self
"/ ].
super update:something with:aParameter from:changedObject
'
forClass:aClass
inCategory:'change & update'.
]
!
createVersionMethodFor:aClass
"add version method containing RCS template
but only if not already present and its not a private class."
aClass isPrivate ifFalse:[
(aClass includesSelector:#version) ifFalse:[
self compile:
'version
^ ''$' , 'Header$''
'
forClass:aClass
inCategory:'documentation'.
]
].
! !
!CodeGeneratorTool class methodsFor:'compilation'!
canUseRefactoringSupport
^ RefactoryChangeManager notNil and:[RefactoryChangeManager isLoaded]
!
compile:theCode forClass:aClass inCategory:cat
|change|
self canUseRefactoringSupport ifFalse:[
aClass compile:theCode classified:cat.
^ self.
].
change := InteractiveAddMethodChange compile:(theCode asString) in:aClass classified:cat.
RefactoryChangeManager instance performChange:change.
! !
!CodeGeneratorTool class methodsFor:'private'!
privCreateClassResponsibleProtocolFor:aClass
"create stubs for the required protocol aClass may be a a MetaClass
or a NonMetaClass"
|selectors|
selectors := IdentitySet new.
aClass allSuperclassesDo:[:cls |
cls methodDictionary keysAndValuesDo:[:sel :mthd |
(mthd sends:#subclassResponsibility) ifTrue:[
selectors add:sel.
]
]
].
selectors do:[:eachSelector |
|cat comment mthd implClass|
implClass := aClass whichClassImplements:eachSelector.
implClass ~~ aClass ifTrue:[
mthd := implClass compiledMethodAt:eachSelector.
(mthd sends:#subclassResponsibility) ifTrue:[
cat := mthd category.
comment := mthd methodComment.
comment size == 0 ifTrue:[
comment := 'Superclass says that I am responsible to implement this method'
].
self
compile:
(Method methodDefinitionTemplateForSelector:eachSelector), Character cr, ' "', comment,
'"
self shouldImplement
'
forClass:aClass
inCategory:cat.
].
].
].
! !
!CodeGeneratorTool class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.10 2003-01-16 10:15:16 cg Exp $'
! !