--- a/CodeGeneratorTool.st Thu Jan 27 12:16:02 2011 +0100
+++ b/CodeGeneratorTool.st Fri Jan 28 10:22:02 2011 +0100
@@ -12,12 +12,12 @@
"{ Package: 'stx:libtool' }"
Object subclass:#CodeGeneratorTool
- instanceVariableNames:'compositeChangeCollector compositeChangeNesting userPreferences
- generateComments'
- classVariableNames:'GenerateCommentsForGetters GenerateCommentsForSetters
- CopyrightTemplate'
- poolDictionaries:''
- category:'Interface-Browsers'
+ instanceVariableNames:'compositeChangeCollector compositeChangeNesting userPreferences
+ generateComments'
+ classVariableNames:'GenerateCommentsForGetters GenerateCommentsForSetters
+ CopyrightTemplate'
+ poolDictionaries:''
+ category:'Interface-Browsers'
!
!CodeGeneratorTool class methodsFor:'documentation'!
@@ -42,6 +42,8 @@
these were extracted from the old and newBrowser.
There is probably more to come...
+ Note: being refactored into separate per-language generators
+
[author:]
Claus Gittiner
"
@@ -156,449 +158,55 @@
!
initialMenuSpecMethodSourceForApplications
- "return a menuSpec with typical stuff in it"
-
- ^
-'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>
+ "return code for a menuSpec with typical stuff in it"
- ^ #(#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
- )
-'.
-!
-
-initialPageMenuSpec
- "return a menuSpec with typical stuff in it"
-
- "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
- )
+ self subclassResponsibility
!
initialPageMenuSpecMethodSourceForWebApplications
- "return a menuSpec with typical stuff in it"
+ "return code for a menuSpec with typical stuff in it"
- ^
-'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."
+ self subclassResponsibility
"
- MenuEditor new openOnClass:%1 andSelector:#mainMenu
- "
-
- <resource: #menu>
-
- ^ ',(self initialPageMenuSpec decodeAsLiteralArray literalArrayEncoding storeString),'
-'.
-
- "
- self initialPageMenuSpecMethodSourceForWebApplications
+ SmalltalkCodeGeneratorTool initialPageMenuSpecMethodSourceForWebApplications
"
!
initialPageSpecMethodSourceForWebApplications
"return an empty pageSpec"
- ^
-'pageSpec
- "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: #pageMenu
- #usePreferredExtent: false
- )
- #component:
- #(#SpecCollection
- #collection: #()
- )
- )
-'.
-!
-
-initialToolbarMenuSpec
- "This resource specification was automatically generated
- by the MenuEditor of ST/X."
-
- "Do not manually edit this!! If it is corrupted,
- the MenuEditor may not be able to read the specification."
-
- "
- MenuEditor new openOnClass:CodeGeneratorTool andSelector:#initialToolbarMenuSpec
- (Menu new fromLiteralArrayEncoding:(CodeGeneratorTool initialToolbarMenuSpec)) startUp
- "
-
- <resource: #menu>
-
- ^
- #(Menu
- (
- (MenuItem
- label: 'Reload'
- itemValue: menuReload
- translateLabel: true
- labelImage: (ResourceRetriever ToolbarIconLibrary reload24x24Icon)
- )
- )
- nil
- nil
- )
+ self subclassResponsibility
!
initialToolbarMenuSpecMethodSource
"return a menuSpec with typical stuff in it"
- ^
-'toolbarMenu
- "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:#toolbarMenu
- "
-
- <resource: #menu>
-
- ^ ',(self initialToolbarMenuSpec decodeAsLiteralArray literalArrayEncoding storeString),'
-'.
-
- "
- self initialToolbarMenuSpecMethodSource
- "
-!
-
-initialWindowSpecForApplications
- "This resource specification was automatically generated
- by the UIPainter of ST/X."
-
- "Do not manually edit this!! If it is corrupted,
- the UIPainter may not be able to read the specification."
+ self subclassResponsibility
"
- UIPainter new openOnClass:CodeGeneratorTool andSelector:#initialWindowSpecForApplications
- "
-
- <resource: #canvas>
-
- ^
- #(FullSpec
- name: initialWindowSpecForApplications
- window:
- (WindowSpec
- label: '%1'
- name: '%1'
- min: (Point 10 10)
- bounds: (Rectangle 0 0 300 300)
- menu: mainMenu
- )
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'Hello World'
- name: 'Label1'
- layout: (LayoutFrame 0 0.0 60 0 0 1.0 219 0)
- translateLabel: true
- )
- )
-
- )
- )
-
- "Modified: / 07-05-2010 / 14:21:48 / cg"
-!
-
-initialWindowSpecForDialogs
- "This resource specification was automatically generated
- by the UIPainter of ST/X."
-
- "Do not manually edit this!! If it is corrupted,
- the UIPainter may not be able to read the specification."
-
- "
- UIPainter new openOnClass:CodeGeneratorTool andSelector:#initialWindowSpecForDialogs
+ SmalltalkCodeGenerator initialToolbarMenuSpecMethodSource
"
-
- <resource: #canvas>
-
- ^
- #(FullSpec
- name: initialWindowSpecForDialogs
- window:
- (WindowSpec
- label: '%1'
- name: '%1'
- min: (Point 10 10)
- bounds: (Rectangle 0 0 300 300)
- )
- component:
- (SpecCollection
- collection: (
- (HorizontalPanelViewSpec
- name: 'buttonPanel'
- layout: (LayoutFrame 0 0.0 -40 1 0 1.0 0 1.0)
- horizontalLayout: spreadSpaceMax
- verticalLayout: center
- horizontalSpace: 3
- verticalSpace: 3
- reverseOrderIfOKAtLeft: true
- component:
- (SpecCollection
- collection: (
- (ActionButtonSpec
- label: 'Cancel'
- name: 'cancelButton'
- translateLabel: true
- tabable: true
- model: cancel
- extent: (Point 125 22)
- )
- (ActionButtonSpec
- label: 'OK'
- name: 'okButton'
- translateLabel: true
- tabable: true
- model: accept
- isDefault: true
- extent: (Point 125 22)
- )
- )
-
- )
- )
- )
-
- )
- )
-
- "Modified: / 07-05-2010 / 14:21:55 / cg"
!
initialWindowSpecMethodSourceForApplications
"return an empty windowSpec with an initial menubar in it"
- ^
-'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."
+ self subclassResponsibility
"
- UIPainter new openOnClass:%1 andSelector:#windowSpec
- "
-
- <resource: #canvas>
-
- ^ ',
- self initialWindowSpecForApplications2 decodeAsLiteralArray prettyPrintString
-.
-
- "
- self initialWindowSpecMethodSourceForApplications
+ SmalltalkCodeGeneraotTool initialWindowSpecMethodSourceForApplications
"
!
initialWindowSpecMethodSourceForDialogs
"return an empty windowSpec for dialogs"
- ^
-'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."
+ self subclassResponsibility
"
- UIPainter new openOnClass:%1 andSelector:#windowSpec
+ SmalltalkCodeGeneraotTool initialWindowSpecMethodSourceForDialogs
"
-
- <resource: #canvas>
-
- ^ ',
- self initialWindowSpecForDialogs decodeAsLiteralArray prettyPrintString
! !
!CodeGeneratorTool class methodsFor:'code generation-basic'!
@@ -696,75 +304,11 @@
!CodeGeneratorTool class methodsFor:'code generation-menus'!
createActionMethodFor:aSelector in:aClass category:aCategory redefine:redefine
- |alreadyInSuperclass method code|
-
- (aClass includesSelector:aSelector) ifTrue:[
- ^ nil
- ].
-
- alreadyInSuperclass := aClass superclass canUnderstand:aSelector.
- (alreadyInSuperclass and:[redefine not]) ifTrue:[
- ^ nil
- ].
-
- method := self methodNameTemplateFor:aSelector.
-
- code := '%1
- "automatically generated by UIEditor ..."
-
- "*** the code below performs no action"
- "*** (except for some feedback on the Transcript)"
- "*** Please change as required and accept in the browser."
- "*** (and replace this comment by something more useful ;-)"
-
- "action to be added ..."
-
- Transcript showCR:self class name, '': action for #%2 ...''.
-' bindWith:method with:aSelector.
-
- alreadyInSuperclass ifTrue:[
- code := code, (('\ super %1\' bindWith:method) withCRs).
- ].
- self compile:code forClass:aClass inCategory:(aCategory ? 'actions').
- ^ code
+ self subclassResponsibility
!
createAspectMethodFor:aSelector in:aClass category:aCategory redefine:redefine
- |alreadyInSuperclass method code text|
-
- (aClass includesSelector:aSelector) ifTrue:[
- ^ nil
- ].
-
- alreadyInSuperclass := aClass superclass canUnderstand:aSelector.
- (alreadyInSuperclass and:[redefine not]) ifTrue:[
- ^ nil
- ].
-
- method := self methodNameTemplateFor:aSelector.
-
- code := '%1
- "automatically generated by UIEditor ..."
-
- "*** the code below creates a default model when invoked"
- "*** (which may not be the one you wanted)"
- "*** Please change as required and accept in the browser."
- "*** (and replace this comment by something more useful ;-)"
-
- "aspect to be added ..."
-
- Transcript showCR:self class name, '': aspect for #%2 ...''.
-
-' bindWith:method with:aSelector.
-
- alreadyInSuperclass ifTrue:[
- 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').
- ^ code
+ self subclassResponsibility
! !
!CodeGeneratorTool class methodsFor:'compilation'!
@@ -813,6 +357,283 @@
!CodeGeneratorTool class methodsFor:'interface specs'!
+initialMenuSpecForApplications
+ "return a menuSpec with typical stuff in it"
+
+ "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:self andSelector:#initialMenuSpecForApplications
+ "
+
+ <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
+ )
+!
+
+initialPageMenuSpecForWebApplications
+ "return a menuSpec with typical stuff in it"
+
+ "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:self andSelector:#initialPageMenuSpecForWebApplications
+ "
+
+ <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
+ )
+!
+
+initialPageSpecForWebApplications
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:self andSelector:#initialPageSpecForWebApplications
+ "
+
+ <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: #pageMenu
+ #usePreferredExtent: false
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #()
+ )
+ )
+!
+
+initialToolbarMenuSpec
+ "This resource specification was automatically generated
+ by the MenuEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the MenuEditor may not be able to read the specification."
+
+ "
+ MenuEditor new openOnClass:CodeGeneratorTool andSelector:#initialToolbarMenuSpec
+ (Menu new fromLiteralArrayEncoding:(CodeGeneratorTool initialToolbarMenuSpec)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+ #(Menu
+ (
+ (MenuItem
+ label: 'Reload'
+ itemValue: menuReload
+ translateLabel: true
+ labelImage: (ResourceRetriever ToolbarIconLibrary reload24x24Icon)
+ )
+ )
+ nil
+ nil
+ )
+!
+
+initialWindowSpecForApplications
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:CodeGeneratorTool andSelector:#initialWindowSpecForApplications
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: initialWindowSpecForApplications
+ window:
+ (WindowSpec
+ label: '%1'
+ name: '%1'
+ min: (Point 10 10)
+ bounds: (Rectangle 0 0 300 300)
+ menu: mainMenu
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Hello World'
+ name: 'Label1'
+ layout: (LayoutFrame 0 0.0 60 0 0 1.0 219 0)
+ translateLabel: true
+ )
+ )
+
+ )
+ )
+
+ "Modified: / 07-05-2010 / 14:21:48 / cg"
+!
+
initialWindowSpecForApplications2
"This resource specification was automatically generated
by the UIPainter of ST/X."
@@ -834,7 +655,6 @@
label: '%1'
name: '%1'
min: (Point 10 10)
- max: (Point 1024 768)
bounds: (Rectangle 0 0 300 300)
menu: mainMenu
)
@@ -888,6 +708,72 @@
)
)
+!
+
+initialWindowSpecForDialogs
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:CodeGeneratorTool andSelector:#initialWindowSpecForDialogs
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: initialWindowSpecForDialogs
+ window:
+ (WindowSpec
+ label: '%1'
+ name: '%1'
+ min: (Point 10 10)
+ bounds: (Rectangle 0 0 300 300)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (HorizontalPanelViewSpec
+ name: 'buttonPanel'
+ layout: (LayoutFrame 0 0.0 -40 1 0 1.0 0 1.0)
+ horizontalLayout: spreadSpaceMax
+ verticalLayout: center
+ horizontalSpace: 3
+ verticalSpace: 3
+ reverseOrderIfOKAtLeft: true
+ component:
+ (SpecCollection
+ collection: (
+ (ActionButtonSpec
+ label: 'Cancel'
+ name: 'cancelButton'
+ translateLabel: true
+ tabable: true
+ model: cancel
+ extent: (Point 125 22)
+ )
+ (ActionButtonSpec
+ label: 'OK'
+ name: 'okButton'
+ translateLabel: true
+ tabable: true
+ model: accept
+ isDefault: true
+ extent: (Point 125 22)
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ )
+
+ "Modified: / 07-05-2010 / 14:21:55 / cg"
! !
!CodeGeneratorTool class methodsFor:'private'!
@@ -901,22 +787,7 @@
!
methodNameTemplateFor:aSelector
- |numArgs method|
-
- numArgs := aSelector numArgs.
- numArgs == 1 ifTrue:[
- method := aSelector, 'anArgument'.
- ] ifFalse:[
- numArgs == 0 ifTrue:[
- method := aSelector
- ] ifFalse:[
- method := ''.
- aSelector keywords keysAndValuesDo:[:i :key|
- method := method, key, 'arg', i printString, ' '.
- ].
- ]
- ].
- ^ method
+ self subclassResponsibility
! !
!CodeGeneratorTool class methodsFor:'utilities'!
@@ -1090,46 +961,7 @@
createClassInitializeMethodIn:aClass
"create a #initialize method on the class side (I'm tired of typing)"
- |nonMetaClass metaClass className code initializer bindings|
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- self startCollectChanges.
-
- (metaClass includesSelector:#'initialize') ifFalse:[
-'initialize
- "Invoked at system start or when the class is dynamically loaded."
-
- "/ please change as required (and remove this comment)
-'.
- bindings := Dictionary new.
- bindings at:'INIT_CLASSINSTVARS' put:(
- String streamContents:[:s |
- metaClass instVarNames do:[:eachClassInstVar |
- initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
- s nextPutLine:(' "/ %1 := %2.' bindWith:eachClassInstVar with:initializer).
- ]
- ]).
-
- bindings at:'INIT_CLASSVARS' put:(
- String streamContents:[:s |
- nonMetaClass classVarNames do:[:eachClassVar |
- initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
- s nextPutLine:(' "/ %1 := %2.' bindWith:eachClassVar with:initializer).
- ]
- ]).
-
- code := (self codeFor_classInitialize) expandPlaceholdersWith:bindings.
-
- self
- compile:code
- forClass:metaClass
- inCategory:'initialization'.
- ].
-
- self executeCollectedChangesNamed:('Add Class Initializer to ' , className).
+ self subclassResponsibility
!
createClassResponsibleProtocolFor:aClass
@@ -1152,32 +984,7 @@
createClassTypeTestMethodsIn:aClass forClasses:subClasses
"create a #isXXX test methods (I'm tired of typing)"
- | code|
-
- self startCollectChanges.
-
- 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'.
- ].
- ].
-
- self executeCollectedChangesNamed:'Add ClassType Tests'
+ self subclassResponsibility
!
createDocumentationMethodsFor:aClass
@@ -1201,782 +1008,83 @@
!
createEnumTypeCodeFor:aClass
- |nonMetaClass metaClass className enumValues code initCode runValue maxValue|
-
- self startCollectChanges.
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- enumValues := nonMetaClass classVarNames.
- enumValues do:[:eachVariableName |
- self
- createAccessMethodsFor:(Array with:eachVariableName)
- in:metaClass
- withChange:false
- asValueHolder:false
- readersOnly:true
- writersOnly:false
- ].
-
- maxValue := enumValues
- inject:0
- into:[:maxSoFar :eachVariableName |
- |oldVal val|
- oldVal := nonMetaClass classVarAt:eachVariableName.
- oldVal notNil ifTrue:[ val := oldVal numericValue ].
- (val ? maxSoFar) max:maxSoFar
- ].
-
- initCode := WriteStream on: String new.
- initCode nextPutLine:'initialize'.
- runValue := maxValue + 1.
- enumValues keysAndValuesDo:[:idx :eachVariableName |
- |oldValue thisValue|
-
- oldValue := nonMetaClass classVarAt:eachVariableName.
- oldValue notNil ifTrue:[
- thisValue := oldValue numericValue.
- ] ifFalse:[
- thisValue := runValue.
- runValue := runValue + 1.
- ].
- initCode
- nextPutAll:' ';
- nextPutAll:eachVariableName;
- nextPutAll:' := self basicNew'.
- (aClass canUnderstand:#'setNumericValue:') ifTrue:[
- initCode nextPutAll:' setNumericValue: ',thisValue printString.
- ].
- (aClass canUnderstand:#'setCssClassString:') ifTrue:[
- initCode nextPutAll:('; setCssClassString: ''' , nonMetaClass nameWithoutPrefix asLowercaseFirst , eachVariableName , '''').
- ].
- (aClass canUnderstand:#'setName:') ifTrue:[
- initCode nextPutAll:('; setName: ''' , eachVariableName asLowercaseFirst , '''').
- ].
- initCode nextPutLine:'.'.
- ].
- initCode cr.
- initCode nextPutLine:' "'.
- initCode nextPutLine:' ',className, ' initialize'.
- initCode nextPutLine:' "'.
-
- self
- compile:(initCode contents)
- forClass:metaClass
- inCategory:'class initialization'.
-
-
- code := 'allStateNames\ ^ #( ' ,
- ((enumValues collect:[:each | '#''',each asLowercaseFirst,'''']) asStringWith:' ') , ')',
- '\\ "\' ,
- ' ',className, ' allStateNames\' ,
- ' "\'.
- self
- compile:code withCRs
- forClass:metaClass
- inCategory:'queries'.
-
- self executeCollectedChangesNamed:('Generate EnumType Code for ' , className).
-
- aClass initialize.
-
- "Modified: / 1.2.1998 / 16:10:03 / cg"
+ self subclassResponsibility
!
createExamplesMethodForViewClass:aClass
"create an examples method"
- |nonMetaClass metaClass className code|
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- self startCollectChanges.
-
- (metaClass includesSelector:#examples) ifFalse:[
- code :=
-'examples
-"
- Notice that everything between [exBegin] and [exEnd] is extracted by the html-doc generator
- to create nicely formatted and clickable executable examples in the generated html-doc.
- (see the browsers class-documentation menu items for more)
-
- trying the widget as standAlone view:
- [exBegin]
- %1 new open
- [exEnd]
-
- embedded in another view:
- [exBegin]
- |top v|
-
- top := StandardSystemView new.
- top extent:300@300.
- v := %1 new.
- v origin:10@10 corner:150@150.
- top add:v.
- top open
- [exEnd]
-"
-' bindWith:className.
-
- self
- compile:code
- forClass:metaClass
- inCategory:'documentation'.
- ].
-
- self executeCollectedChangesNamed:('Add Example to ' , className).
+ self subclassResponsibility
!
createInitializationMethodIn:aClass
"create a #initialize methods (I'm tired of typing)"
- |nonMetaClass metaClass className code initializer m|
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- self startCollectChanges.
-
- (nonMetaClass includesSelector:#'initialize') ifFalse:[
- code :=
-'initialize
- "Invoked when a new instance is created."
-
- "/ please change as required (and remove this comment)
-'.
-
- nonMetaClass instVarNames do:[:eachInstVar |
- initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
- code := code , (' "/ ' , eachInstVar , ' := ' , initializer , '.' , Character cr).
- ].
-
- m := nonMetaClass responseTo:#initialize.
- (m notNil and:[m messagesSent size == 0]) ifTrue:[
- "/ inherits an empty initialize.
-
- code := code , '
- "/ super initialize. -- commented since inherited method does nothing
-'.
- ] ifFalse:[
- code := code , '
- super initialize.
-'.
- ].
-
- self
- compile:code
- forClass:nonMetaClass
- inCategory:'initialization'.
- ].
-
- self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
+ self subclassResponsibility
!
createInitializedInstanceCreationMethodsIn:aClass
"create a #new and #initialize methods (I'm tired of typing)"
- |nonMetaClass metaClass className code m|
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- self startCollectChanges.
-
- self createInitializationMethodIn:aClass.
-
- (metaClass includesSelector:#'new') ifFalse:[
- m := metaClass responseTo:#new.
- (m isNil
- or:[ (m sends:#initialize) not
- or:[
- (Dialog
- confirmWithCancel:'The inherited #new method already seems to invoke #initialize. Redefine ?'
- onCancel:[^ self]) ]]) ifTrue:[
- code :=
-'new
- "return an initialized instance"
-
- ^ self basicNew initialize.
-'.
- self
- compile:code
- forClass:metaClass
- inCategory:'instance creation'.
- ].
- ].
-
- self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
-
- "Created: / 11.10.2001 / 22:18:55 / cg"
+ self subclassResponsibility
!
createParametrizedInstanceCreationMethodsNamed:selector in:aClass
"create a #selector instance creation method (I'm tired of typing)"
- |nonMetaClass metaClass className code initializer m dfn|
-
- dfn := Method methodDefinitionTemplateForSelector:selector.
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- self startCollectChanges.
-
- (nonMetaClass includesSelector:selector asSymbol) ifFalse:[
- code :=
-'initialize',dfn asUppercaseFirst,'
- "Invoked when a new instance is created for arg."
-
- "/ please change as required (and remove these comments)
- "/ do something with arg here (instVar-foo := arg)
-'.
- nonMetaClass instVarNames do:[:eachInstVar |
- initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
- code := code , (' "/ ' , eachInstVar , ' := ' , initializer , '.' , Character cr).
- ].
-
- m := nonMetaClass responseTo:#initialize.
- (m notNil and:[ m messagesSent size == 0 ]) ifTrue:[
- "/ inherits an empty initialize.
-
- code := code , '
- "/ super initialize. -- commented since inherited method does nothing
-'.
- ] ifFalse:[
- code := code , '
- super initialize.
-'.
- ].
-
- self
- compile:code
- forClass:nonMetaClass
- inCategory:'initialization'.
- ].
-
- (metaClass includesSelector:selector) ifFalse:[
- m := metaClass responseTo:selector.
- (m isNil
- or:[ (Dialog confirmWithCancel:'The ',selector,'- method is already inherited. Redefine ?' onCancel:[^ self]) ])
- ifTrue:[
- code :=
-dfn,'
- "Create & return a new instance for arg."
-
- ^ self basicNew initialize',dfn asUppercaseFirst,'
-'.
- self
- compile:code
- forClass:metaClass
- inCategory:'instance creation'.
- ].
- ].
-
- self executeCollectedChangesNamed:('Add Parametrized Instance Creation to ' , className).
+ self subclassResponsibility
!
createPoolInitializationCodeFor:aClass
- |nonMetaClass metaClass className poolVars code initCode runValue maxValue|
-
- self startCollectChanges.
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- poolVars := nonMetaClass classVarNames.
-
- initCode := WriteStream on: String new.
- initCode nextPutLine:'initialize'.
-
- poolVars do:[:eachVariableName |
- |oldValue thisValue|
-
- oldValue := nonMetaClass classVarAt:eachVariableName.
- oldValue notNil ifTrue:[
- thisValue := oldValue.
- ] ifFalse:[
- thisValue := nil.
- ].
- initCode
- nextPutAll:' ';
- nextPutAll:eachVariableName;
- nextPutAll:' := ';
- nextPutAll:thisValue storeString;
- nextPutLine:'.'.
- ].
- initCode cr.
- initCode nextPutLine:' "'.
- initCode nextPutLine:' ',className, ' initialize'.
- initCode nextPutLine:' "'.
-
- self
- compile:(initCode contents)
- forClass:metaClass
- inCategory:'class initialization'.
-
- self executeCollectedChangesNamed:('Generate Pool Initialization Code for ' , className).
-
- aClass initialize.
-
- "Created: / 25-10-2006 / 09:28:40 / cg"
+ self subclassResponsibility
!
createRedefinedInstanceCreationMethodsIn:aClass
"create a redefined #new methods"
- |nonMetaClass metaClass className code|
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- self startCollectChanges.
-
- (metaClass includesSelector:#'new') ifFalse:[
- code :=
-'new
- ^ super new.
-'.
- self
- compile:code
- forClass:metaClass
- inCategory:'redefined instance creation'.
- ].
- (metaClass includesSelector:#'new:') ifFalse:[
- code :=
-'new:n
- ^ super new:n.
-'.
- self
- compile:code
- forClass:metaClass
- inCategory:'redefined instance creation'.
- ].
-
- self executeCollectedChangesNamed:('Redefined Instance Creation to ' , className).
+ self subclassResponsibility
!
createStandardPrintOnMethodIn:aClass
"create a #printOn: method (I'm tired of typing)"
- |code nonMetaClass|
-
- nonMetaClass := aClass theNonMetaclass.
-
- self startCollectChanges.
-
- (nonMetaClass includesSelector:#'printOn:') ifFalse:[
- code :=
-'printOn:aStream
- "append a printed representation if the receiver to the argument, aStream"
-
- super printOn:aStream.
-'.
- nonMetaClass instVarNames do:[:eachInstVarName |
- code := code , ' '.
- code := code , 'aStream nextPutAll:'''.
- code := code , eachInstVarName.
- code := code , ': ''.' , Character cr.
- code := code , ' '.
- code := code , eachInstVarName.
- code := code , ' printOn:aStream.' , Character cr.
-
- ].
-
- self
- compile:code
- forClass:nonMetaClass
- inCategory:'printing & storing'.
- ].
-
-
- self executeCollectedChangesNamed:('Add #printOn: to ' , nonMetaClass name).
-
- "Created: / 11.10.2001 / 22:18:55 / cg"
+ self subclassResponsibility
!
createStartupCodeFor:aClass forStartOf:anApplicationClassOrNil
"create startup code (main)"
- |nonMetaClass metaClass className source
- hasAplicationClass anApplicationClassNameOrStartupClassName|
-
- self startCollectChanges.
-
- hasAplicationClass := anApplicationClassOrNil notNil.
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- (metaClass includesSelector:#main:) ifFalse:[
-
- source := String streamContents:[:stream |
- stream nextPutAll:
-'main:argv
- self verboseInfo:''starting %1''.
-
-'.
- hasAplicationClass ifTrue: [
- stream nextPutAll:
-' Smalltalk openDisplay.
- Display notNil ifTrue:[
- Display exitOnLastClose:true.
- ].
- %1 open.
-'.
- ].
- ].
-
- anApplicationClassNameOrStartupClassName := hasAplicationClass
- ifTrue: [anApplicationClassOrNil name]
- ifFalse: [className.].
- self
- compile:(source bindWith:anApplicationClassNameOrStartupClassName)
- forClass:metaClass
- inCategory:'startup'.
- ].
- self executeCollectedChangesNamed:('Add Startup Code to ' , className).
+ self subclassResponsibility
!
createTestCaseSampleCodeFor:aClass
"create an (almost) empty testCase class"
- |nonMetaClass metaClass|
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- "/ className := nonMetaClass name.
-
- ( nonMetaClass includesSelector:#test1 ) ifFalse:[
- self
- compile:
-'test1
- "This is a demonstration testCase - it is meant to be removed eventually.
- This testCase will PASS.
- 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
- self new test1
- "
-'
- forClass:nonMetaClass
- inCategory:'tests'.
- ].
-
- ( nonMetaClass includesSelector:#test2 ) ifFalse:[
- self
- compile:
-'test2
- "This is a demonstration testCase - it is meant to be removed eventually..
- This testCase WILL FAIL.
- 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 == 3 ).
-
- "
- self run:#test2
- self new test2
- "
-'
- forClass:nonMetaClass
- inCategory:'tests'.
- ].
-
- ( nonMetaClass includesSelector:#test3 ) ifFalse:[
- self
- compile:
-'test3
- "This is a demonstration testCase - it is meant to be removed eventually..
- This testCase WILL generate an ERROR.
- 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 foo ).
-
- "
- self run:#test3
- self new test3
- "
-'
- 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'.
- ]
+ self subclassResponsibility
!
createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
"create acceptVisitor: in visitedClass and acceptXXX in visitorClass. (I'm tired of typing)"
- |sel|
-
- self assert:( visitedClass isMeta not ).
- self assert:( visitorClass isMeta not ).
-
- self startCollectChanges.
-
- 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'.
- ].
-
- self executeCollectedChangesNamed:('Add Visitor Pattern').
+ self subclassResponsibility
!
createWebApplicationCodeFor:aClass
"create an empty webApplication framework"
- |nonMetaClass metaClass className txt|
-
- self startCollectChanges.
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- (metaClass includesSelector:#pageSpec) ifFalse:[
- txt := self class initialPageSpecMethodSourceForWebApplications.
- self
- compile:(txt bindWith:className)
- forClass:metaClass
- inCategory:'page specs'.
- ].
-
- self executeCollectedChangesNamed:('Add WebApplication Code for ' , className).
-
- "Modified: / 1.2.1998 / 16:10:03 / cg"
+ self subclassResponsibility
!
createWebServiceCodeFor:aClass
"create an empty webService framework"
- |nonMetaClass metaClass className txt|
-
- self startCollectChanges.
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- (nonMetaClass includesSelector:#process:) ifFalse:[
- txt :=
-'process:aRequest
- "This is the web services main processing method.
- It will be invoked for every incoming webBrowser-request.
- The argument, aRequest contains the parameters (url, fields, parameters etc.)."
-
- (aRequest pathRelativeToService = ''hello'') ifTrue:[
- ^ self process_hello:aRequest
- ].
- (aRequest pathRelativeToService = ''hello2'') ifTrue:[
- ^ self process_hello2:aRequest
- ].
-
- aRequest reportNotFound:''URL must be <service>/hello or <service>/hello2''
-'.
- self
- compile:txt
- forClass:nonMetaClass
- inCategory:'response generation'.
- ].
-
- (nonMetaClass includesSelector:#process_hello:) ifFalse:[
- txt :=
-'process_hello:aRequest
- "a sample render method - this is the lowest possible level: simply returning a bunch of lines"
-
- |response|
-
- response := aRequest response.
- response nextPutLine:''<HTML>''.
- response nextPutLine:'' <HEAD>''.
- response nextPutLine:'' <TITLE>Hello</TITLE>''.
- response nextPutLine:'' </HEAD>''.
- response nextPutLine:'' <BODY>''.
- response nextPutLine:'' <H1>Hello World !!</H1>''.
- response nextPutLine:'' </BODY>''.
- response nextPutLine:''</HTML>''.
-'.
- self
- compile:txt
- forClass:nonMetaClass
- inCategory:'response generation'.
- ].
-
- (nonMetaClass includesSelector:#process_hello2:) ifFalse:[
- txt :=
-'process_hello2:aRequest
- "a slightly more structured render method - uses a tree builder to ensure correct html"
-
- |builder|
-
- builder := HTML::TreeBuilder new.
-
- builder
- body;
- h1:''Hello World2'';
- bodyEnd.
-
- aRequest response nextPutAll:(builder htmlString).
-'.
- self
- compile:txt
- forClass:nonMetaClass
- inCategory:'response generation'.
- ].
-
- (metaClass includesSelector:#linkName) ifFalse:[
- txt :=
-'linkName
- "return the default linkName path (with slash)."
-
- ^ ''/NewService''
-'.
- self
- compile:txt
- forClass:metaClass
- inCategory:'defaults'.
- ].
-
- (metaClass includesSelector:#settingsApplicationClass) ifFalse:[
- txt :=
-'settingsApplicationClass
- "a SettingsApplication class - or nil (used in the settings dialog if non-nil)."
-
- ^ nil
-'.
- self
- compile:txt
- forClass:metaClass
- inCategory:'defaults'.
- ].
-
-
- self executeCollectedChangesNamed:('Add WebService Code for ' , className).
-
- "Modified: / 03-07-2010 / 10:48:39 / cg"
+ self subclassResponsibility
!
createWidgetCodeFor:aClass
"create usually required widget code (redraw, model update, event handling)"
- |nonMetaClass metaClass className compileTemplateAction|
-
- self startCollectChanges.
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
- className := nonMetaClass name.
-
- compileTemplateAction :=
- [:selector :templateSelector :category |
- (nonMetaClass includesSelector:selector) ifFalse:[
- |txt|
-
- txt := self perform:templateSelector.
- self
- compile:txt
- forClass:nonMetaClass
- inCategory:category.
- ]
- ].
-
- #(
- #'initialize' #code_forWidget_initialize 'initialization & release'
- #'update:with:from:' #code_forWidget_update 'change & update'
- #'redrawX:y:width:height:' #code_forWidget_redraw 'drawing'
- #'buttonPress:x:y:' #code_forWidget_buttonPress 'event handling'
- #'keyPress:x:y:' #code_forWidget_keyPress 'event handling'
- #'sizeChanged:' #code_forWidget_sizeChanged 'event handling'
- ) inGroupsOf:3 do:compileTemplateAction.
-
- self executeCollectedChangesNamed:('Add Widget Code for ' , className).
+ self subclassResponsibility
! !
!CodeGeneratorTool methodsFor:'code generation-basic'!
@@ -1984,306 +1092,17 @@
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
"workhorse for creating access methods for instvars."
- |classesClassVars generateCommentsForSetters generateCommentsForGetters|
-
- self startCollectChanges.
-
- generateCommentsForSetters := userPreferences generateCommentsForSetters.
- generateCommentsForGetters := userPreferences generateCommentsForGetters.
-
- classesClassVars := aClass theNonMetaclass allClassVarNames.
-
- aCollectionOfVarNames do:[:name |
- |source varType methodName defaultMethodName argName|
-
- varType := (classesClassVars includes:name)
- ifTrue:['static']
- ifFalse:[
- (aClass isMeta ifTrue:['classInstVar'] ifFalse:['instance'])].
-
- methodName := name.
- name isUppercaseFirst ifTrue:[
- methodName := methodName asLowercaseFirst.
- ].
- argName := 'something'.
-
- "/ 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 , '\'.
- generateComments ifTrue:[
- source := source , ' "return/create the ''%2'' value holder (automatically generated)"\\'.
- ].
- source := source , ' %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 , '\'.
- lazyInitialization ifTrue:[
- generateCommentsForGetters ifTrue:[
- source := source , ' "return the %1 instance variable ''%2'' with lazy instance creation (automatically generated)"\\'.
- ].
- source := source
- , ' %2 isNil ifTrue:[\'
- , ' %2 := self class %3.\'
- , ' ].\'
- , ' ^ %2'.
- ] ifFalse:[
- generateCommentsForGetters ifTrue:[
- source := source , ' "return the %1 instance variable ''%2'' (automatically generated)"\\'.
- ].
- 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 theMetaclass includesSelector:(defaultMethodName asSymbol)) ifFalse:[
- source := defaultMethodName , '\'.
- generateComments ifTrue:[
- source := source , ' "default value for the ''%2'' instance variable (automatically generated)"\\'.
- ].
- source := source
- , ' self shouldImplement.\'
- , ' ^ nil.'.
- source := (source bindWith:varType with:name) withCRs.
- self compile:source forClass:aClass theMetaclass inCategory:'defaults'.
- ].
- ].
- ].
-
- "/ the SETTER
- readersOnly ifFalse:[
- (aClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
- ((methodName size > 2) and:[ (methodName startsWith:'is') and:[ (methodName at:3) isUppercase ]])
- ifTrue:[
- argName := 'aBoolean'
- ].
- asValueHolder ifTrue:[
- source := methodName , ':%3\'. "/ argName
- generateComments ifTrue:[
- source := source , ' "set the ''%2'' value holder' , ' (automatically generated)"\\'.
- ].
- withChange ifTrue:[
- source := source
- , ' |oldValue newValue|\\'
- , ' %2 notNil ifTrue:[\'
- , ' oldValue := %2 value.\'
- , ' %2 removeDependent:self.\'
- , ' ].\'
- , ' %2 := %3.\' "/ argName
- , ' %2 notNil ifTrue:[\'
- , ' %2 addDependent:self.\'
- , ' ].\'
- , ' newValue := %2 value.\'
- , ' oldValue ~~ newValue ifTrue:[\'
- , ' self update:#value with:newValue from:%2.\'
- , ' ].\'
- ] ifFalse:[
- source := source
- , ' %2 := %3.'. "/ argName
- ].
- ] ifFalse:[
- source := methodName , ':%3\'. "/ argName
- withChange ifTrue:[
- generateComments ifTrue:[
- source := source , ' "set the value of the %1 variable ''%2'''.
- source := source , ' and send a change notification (automatically generated)"\\'.
- ].
- source := source
- , ' (%2 ~~ %3) ifTrue:[\'
- , ' %2 := %3.\' "/ argName
- , ' self changed:#%2.\'
- , ' ].\'.
- ] ifFalse:[
- generateCommentsForSetters ifTrue:[
- source := source , ' "set the value of the %1 variable ''%2'''.
- source := source , ' (automatically generated)"\\'.
- ].
- source := source
- , ' %2 := %3.'. "/ argName
- ].
- ].
- source := (source bindWith:varType with:name with:argName) withCRs.
- self
- compile:source
- forClass:aClass
- inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
- ] ifTrue:[
- Transcript showCR:'method ''', methodName , ':'' already present'
- ].
- ].
- ].
-
- self executeCollectedChangesNamed:('Add Accessors').
+ self subclassResponsibility
!
createCollectionAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange
- |classesClassVars|
-
- self startCollectChanges.
-
- classesClassVars := aClass theNonMetaclass allClassVarNames.
-
- aCollectionOfVarNames do:[:name |
- |source varType methodNameBase methodName defaultMethodName|
-
- varType := (classesClassVars includes:name)
- ifTrue:['static']
- ifFalse:[
- (aClass isMeta ifTrue:['classInstVar'] ifFalse:['instance'])].
-
- methodNameBase := name asUppercaseFirst.
- (methodNameBase endsWith:'s') ifTrue:[
- methodNameBase := methodNameBase copyWithoutLast:1.
- ].
- methodName := 'add' , methodNameBase, ':'.
-
- "check, if method is not already present"
- (aClass includesSelector:(methodName asSymbol)) ifFalse:[
- source := methodName , 'a%1\'.
- generateComments ifTrue:[
- source := source , ' "add a ',methodNameBase,'"\\'.
- ].
- source := source , ' %2 isNil ifTrue:[\'.
- source := source
- , ' %2 := OrderedCollection new.\'.
- source := source
- , ' ].\'
- , ' %2 add: a%1'.
- source := (source bindWith:methodNameBase with:name) withCRs.
- self compile:source forClass:aClass inCategory:'accessing'.
- ] ifTrue:[
- Transcript showCR:'method ''', methodName , ''' already present'
- ].
-
- methodName := 'remove' , methodNameBase, ':'.
-
- "check, if method is not already present"
- (aClass includesSelector:(methodName asSymbol)) ifFalse:[
- source := methodName , 'a%1\'.
- generateComments ifTrue:[
- 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'.
- ] ifTrue:[
- Transcript showCR:'method ''', methodName , ''' already present'
- ].
- ].
-
- self
- createAccessMethodsFor:aCollectionOfVarNames
- in:aClass
- withChange:withChange
- asValueHolder:false
- readersOnly:true
- writersOnly:false
- lazyInitialization:false.
-
- self executeCollectedChangesNamed:('Add Collection Access').
-
- "Created: / 04-02-2007 / 15:52:31 / cg"
+ self subclassResponsibility
!
createValueHoldersFor:aCollectionOfVarNames in:aClass lazyInitialization:lazyInitialization
"workhorse for creating access methods for instvars."
- |nonMetaClass metaClass classesClassVars generateCommentsForSetters generateCommentsForGetters|
-
- nonMetaClass := aClass theNonMetaclass.
- metaClass := aClass theMetaclass.
-
- self startCollectChanges.
-
- generateCommentsForSetters := userPreferences generateCommentsForSetters.
- generateCommentsForGetters := userPreferences generateCommentsForGetters.
-
- classesClassVars := nonMetaClass allClassVarNames.
-
- aCollectionOfVarNames do:[:name |
- |source varType methodName holderMethodName defaultMethodName|
-
- holderMethodName := name.
- name isUppercaseFirst ifTrue:[
- holderMethodName := holderMethodName asLowercaseFirst.
- ].
- (holderMethodName endsWith:'Holder') ifTrue:[
- methodName := holderMethodName copyWithoutLast:6.
- ] ifFalse:[
- methodName := holderMethodName.
- holderMethodName := methodName , 'Holder'.
- ].
-
- methodName notNil ifTrue:[
- (metaClass includesSelector:(methodName asSymbol)) ifFalse:[
- source := '%1\'.
- 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').
- ] ifTrue:[
- Transcript showCR:'method ''', methodName , ''' already present'
- ].
-
- (metaClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
- source := '%1: newValue\'.
- 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').
- ] ifTrue:[
- Transcript showCR:'method ''', methodName , ':'' already present'
- ].
- ].
- (metaClass includesSelector:(holderMethodName asSymbol)) ifFalse:[
- source := '%1\'.
- generateComments ifTrue:[
- source := source , ' "return/create the valueHolder ''%1''"\\'.
- ].
- 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').
- ] ifTrue:[
- Transcript showCR:'method ''', methodName , ''' already present'
- ].
- ].
-
- self executeCollectedChangesNamed:('Add ValueHolder').
+ self subclassResponsibility
! !
!CodeGeneratorTool methodsFor:'code generation-individual methods'!
@@ -2292,31 +1111,14 @@
"create an acceptVisitor: method
(I'm tired of typing)"
- self assert:( aClass isMeta not ).
-
- (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'.
- ]
+ self subclassResponsibility
!
createAcceptVisitorMethodIn:aClass
"create an acceptVisitor: method
(I'm tired of typing)"
- self
- createAcceptVisitorMethod:('visit' , aClass nameWithoutPrefix , ':') asSymbol
- in:aClass
+ self subclassResponsibility
!
createCopyrightMethodFor:aClass
@@ -2343,418 +1145,85 @@
"add copyright method containing text,
but only if not already present."
- |txt|
-
- (aClass includesSelector:#copyright) ifFalse:[
- copyRightText notNil ifTrue:[
- txt := copyRightText bindWith:(Date today year).
- self compile:
-'copyright
-"
-' , txt , '
-"
-' forClass:aClass
- inCategory:'documentation'.
- ]
- ].
+ self subclassResponsibility
!
createDocumentationMethodFor:aClass
"add documentation method containing doc template
but only if not already present."
- |metaClass nonMetaClass userName loginName hostName emailAddress code existingComment|
-
- metaClass := aClass theMetaclass.
- nonMetaClass := aClass theNonMetaclass.
-
- (metaClass includesSelector:#documentation) ifFalse:[
- existingComment := nonMetaClass comment.
- existingComment isEmptyOrNil ifTrue:[
- (nonMetaClass isSubclassOf:HTTPService) ifTrue:[
- existingComment := ' [start Server with:]
- HTTPServer startServerOnPort:8080
-
- [start with:]
- (self new)
- registerServiceOn:(HTTPServer runningServerOnPort:8080)'.
- ].
- ].
-
- userName := OperatingSystem getFullUserName.
- loginName := OperatingSystem getLoginName.
- hostName := OperatingSystem getHostName.
- emailAddress := loginName , '@' , hostName.
-
- "/ ugly; should ask the class for that
- metaClass isJavaScriptMetaclass ifTrue:[
- code :=
-'function documentation() {
-/*
-' , (existingComment ? ' documentation to be added.') , '
-
- [author:]
- ' , userName
- , ' (' , emailAddress , ')' , '
-
- [instance variables:]
-
- [class variables:]
-
- [see also:]
-
-*/
-}
-'
- ] ifFalse:[
- code:=
-'documentation
-"
-' , (existingComment ? ' documentation to be added.') , '
-
- [author:]
- ' , userName
- , ' (' , emailAddress , ')' , '
-
- [instance variables:]
-
- [class variables:]
-
- [see also:]
-
-"
-'
- ].
-
- self
- compile:code
- forClass:metaClass
- inCategory:'documentation'.
- ].
-
- "Modified: / 24-11-2006 / 15:54:27 / cg"
+ self subclassResponsibility
!
createExamplesMethodFor:aClass
"add examples method containing examples template
but only if not already present."
- |nonMetaclass fragment|
-
- nonMetaclass := aClass theNonMetaclass.
-
- (nonMetaclass isSubclassOf:View) ifTrue:[
- self createExamplesMethodForViewClass:aClass.
- ^ self
- ].
-
- (nonMetaclass isSubclassOf:ApplicationModel) ifFalse:[
- ^ self
- ].
-
- (aClass includesSelector:#examples) ifFalse:[
- (nonMetaclass isSubclassOf:ApplicationModel) ifTrue:[
- fragment := ' Starting the application:
- [exBegin]
- ' , nonMetaclass 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'.
- ].
+ self subclassResponsibility
!
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.
+ self subclassResponsibility
!
createInitialHistoryMethodFor:aClass
"add history method containing created-entry
but only if not already present."
- |code|
-
- (aClass includesSelector:#history) ifFalse:[
- HistoryManager notNil ifTrue:[
- code := HistoryManager codeForInitialHistoryMethodIn:aClass.
- self
- compile:code
- forClass:aClass
- inCategory:'documentation'.
- ].
- ].
+ self subclassResponsibility
!
createInstanceCreationMethodWithSetupFor:selector category:category in:aMetaClass
"add an inst-creation method"
- |template instMthd argNames|
-
- (aMetaClass includesSelector:selector) ifFalse:[
- instMthd := aMetaClass theNonMetaclass compiledMethodAt:selector.
- (instMthd notNil
- and:[ (argNames := instMthd methodArgNames) notEmptyOrNil ])
- ifTrue:[
- template := Parser methodSpecificationForSelector:selector argNames:argNames.
- ] ifFalse:[
- template := Parser methodSpecificationForSelector:selector.
- ].
-
- self
- compile:
-template , '
- ^ self new ' , template , '
-'
- forClass:aMetaClass
- inCategory:category.
- ].
+ self subclassResponsibility
!
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.
- (userPreferences generateCommentsForSetters) ifTrue:[
- 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 subclassResponsibility
!
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.
- ].
+ self subclassResponsibility
!
createUpdateMethodIn:aClass
"create an update:with:from:-method
(I'm tired of typing)"
- |code|
-
- (aClass includesSelector:#'update:with:from:') ifFalse:[
- generateComments ifFalse:[
- code :=
-'update:something with:aParameter from:changedObject
- super update:something with:aParameter from:changedObject
-'
- ] ifTrue:[
- code :=
-'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
-'
- ].
-
- self
- compile:code
- forClass:aClass
- inCategory:'change & update'.
- ]
+ self subclassResponsibility
!
createVersionMethodFor:aClass
<resource: #obsolete>
+
"add version method containing RCS template
but only if not already present and its not a private class."
- |code|
-
- self obsoleteMethodWarning.
-
- aClass isPrivate ifFalse:[
- (aClass includesSelector:#version) ifFalse:[
- "/ ugly; should ask the class for that
- aClass isJavaScriptClass ifTrue:[
- code:= ('function version() {\ return ("$' , 'Header$");\}') withCRs
- ] ifFalse:[
- code:= ('version\ ^ ''$' , 'Header$''') withCRs
- ].
- self
- compile:code
- forClass:aClass
- inCategory:'documentation'.
- ]
- ].
+ self subclassResponsibility
! !
!CodeGeneratorTool methodsFor:'code templates'!
codeFor_classInitialize
- generateComments ifFalse:[
- ^
-'initialize
-%(INIT_CLASSINSTVARS)
-%(INIT_CLASSVARS)
-'.
- ].
-
- ^
-'initialize
- "Invoked at system start or when the class is dynamically loaded."
-
- "/ please change as required (and remove this comment)
-%(INIT_CLASSINSTVARS)
-%(INIT_CLASSVARS)
-'.
+ self subclassResponsibility
!
codeFor_closeAccept
- generateComments ifFalse:[
- ^
-'closeAccept
- ^ super closeAccept
-'.
- ].
-
- ^
-'closeAccept
- "This is a hook method generated by the Browser/CodeGeneratorTool.
- 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 (otherwise, the dialog will not close itself)...
- ^ super closeAccept
-'.
-
- "Created: / 27-10-2006 / 10:03:31 / cg"
+ self subclassResponsibility
!
codeFor_closeDownViews
- generateComments ifFalse:[
- ^
-'closeDownViews
- ^ super closeDownViews
-'.
- ].
-
- ^
-'closeDownViews
- "This is a hook method generated by the Browser/CodeGeneratorTool.
- 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
-'.
-
- "Created: / 27-10-2006 / 10:01:32 / cg"
+ self subclassResponsibility
!
codeFor_closeRequest
- generateComments ifFalse:[
- ^
-'closeRequest
- self hasUnsavedChanges ifTrue:[
- (self confirm:(resources string:''Close without saving ?'')) ifFalse:[
- ^ self
- ]
- ].
- ^ super closeRequest
-'.
- ].
-
- ^
-'closeRequest
- "This is a hook method generated by the Browser/CodeGeneratorTool.
- 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 ifTrue:[
- (self confirm:(resources string:''Close without saving ?'')) ifFalse:[
- ^ self
- ]
- ].
-
- ^ super closeRequest
-'.
+ self subclassResponsibility
"Created: / 27-10-2006 / 10:01:06 / cg"
!
@@ -2766,42 +1235,11 @@
!
codeFor_emptyMenuActionCodeFor:selector menuItem:item
- generateComments ifFalse:[
- ^
-selector,'
- self warn:''no action for ''''',item,''''' defined.''.
-'.
- ].
-
- ^
-selector,'
- "This method was generated by the Browser/CodeGeneratorTool.
- It will be invoked when the menu-item ''',item,''' is selected."
-
- "/ change below and add any actions as required here ...
- self warn:''no action for ''''',item,''''' defined.''.
-'.
-
- "Created: / 27-10-2006 / 10:16:43 / cg"
+ self subclassResponsibility
!
codeFor_hasUnsavedChanges
- generateComments ifFalse:[
- ^
-'hasUnsavedChanges
- ^ false.
-'.
- ].
-
- ^
-'hasUnsavedChanges
- "Return true, if any unsaved changes are present
- (i.e. the contents needs to be saved or else will be lost)"
-
- "/ add real code as required (or remove the halt and always return false)...
- "/ self halt:''check this code''.
- ^ false.
-'.
+ self subclassResponsibility
"Created: / 27-10-2006 / 10:00:36 / cg"
!
@@ -2829,231 +1267,54 @@
!
codeFor_menuSaveAs
- ^
-'menuSaveAs
- "This method was generated by the Browser/CodeGeneratorTool.
- It will be invoked when the menu-item ''saveAs'' is selected."
-
- "/ change below as required... (see examples in Dialog class for more options)
- Dialog
- requestSaveFileName:(resources string:''Save'')
- default:''foo.txt''
- fromDirectory:nil
- action:[:fileName | self doSaveAs:fileName]
- appendAction:nil.
-'.
-
- "Created: / 27-10-2006 / 10:01:57 / cg"
+ self subclassResponsibility
!
codeFor_openAboutThisApplication
- ^
-'openAboutThisApplication
- "This method was generated by the Browser/CodeGeneratorTool.
- It will be invoked when the menu-item ''help-about'' is selected."
-
- "/ could open a customized aboutBox here ...
- super openAboutThisApplication
-'.
-
- "Created: / 27-10-2006 / 10:03:13 / cg"
+ self subclassResponsibility
!
codeFor_openDocumentation
- ^
-'openDocumentation
- "This method was generated by the Browser/CodeGeneratorTool.
- 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>/'' ):
- self openDocumentationFile:''TOP.html''.
-
- "/ add application-specific help files under the ''doc/online/<language>/help/appName''
- "/ directory, and open a viewer with:
- "/ self openDocumentationFile:''help/<MyApplication>/TOP.html''.
-'.
-
- "Created: / 27-10-2006 / 10:02:55 / cg"
+ self subclassResponsibility
!
codeFor_postBuildWith
- generateComments ifFalse:[
- ^
-'postBuildWith:aBuilder
- ^ super postBuildWith:aBuilder
-'.
- ].
-
- ^
-'postBuildWith:aBuilder
- "This is a hook method generated by the Browser/CodeGeneratorTool.
- 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
-'.
-
- "Created: / 27-10-2006 / 09:59:33 / cg"
+ self subclassResponsibility
!
codeFor_postOpenWith
- generateComments ifFalse:[
- ^
-'postOpenWith:aBuilder
- ^ super postOpenWith:aBuilder
-'.
- ].
+ self subclassResponsibility
+!
- ^
-'postOpenWith:aBuilder
- "This is a hook method generated by the Browser/CodeGeneratorTool.
- 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."
+codeFor_shouldImplementFor:selector inClass:aClass
+ "used in the 'generate required protocol' to generate a shouldImplement-sending
+ method for each subclassClassresponsibility method above aClass."
- "/ add any code here ...
-
- ^ super postOpenWith:aBuilder
-'.
-
- "Created: / 27-10-2006 / 09:59:56 / cg"
+ self subclassResponsibility
!
code_forWidget_buttonPress
- generateComments ifFalse:[
- ^
-'buttonPress:button x:x y:y
- Transcript show:''button: ''; showCR:button.
- super buttonPress:button x:x y:y
-'
- ].
-
- ^
-'buttonPress:button x:x y:y
- "called when a mouse-button is pressed. button is the button-nr (1 for left-button).
- x/y are the mouse position at the time of the click.
- There are also corresponding buttonRelease and buttonMotion methods which could be
- redefined...."
-
- Transcript show:''button: ''; showCR:button.
- "/ super-code handles middleButtonMenu, if it was assigned (with middleButtonmenu:)
- super buttonPress:button x:x y:y
-'
+ self subclassResponsibility
!
code_forWidget_initialize
- ^
-'initialize
- super initialize "/ to initialize inherited state
-
- "/ add code to initialize private variables,
- "/ and sub-components as required.
-'
+ self subclassResponsibility
!
code_forWidget_keyPress
- generateComments ifFalse:[
- ^
-'keyPress:key x:x y:y
-"/ key == #Copy ifTrue:[
-"/ ].
-"/ key == #Cut ifTrue:[
-"/ ].
- Transcript show:''key: ''; showCR:key.
- super keyPress:key x:x y:y
-'
- ].
- ^
-'keyPress:key x:x y:y
- "called when a keyboard-key was pressed. key is either a character (for ordinary keys)
- or a symbol, such as #Copy, #Cut or #Paste.
- x/y are the mouse position at the time of the key-press.
- There is also a corresponding keyRelease method which could be redefined...."
-
- Transcript show:''key: ''; showCR:key.
- super keyPress:key x:x y:y
-'
+ self subclassResponsibility
!
code_forWidget_redraw
- |sel comment code|
-
- sel := 'redrawX:x y:y width:w height:h'.
- generateComments ifFalse:[
- comment := ''.
- ] ifTrue:[
- comment := '
- "called to redraw a part of the widgets area. x/y define the origin, w/h the size of
- that area. The clipping region has already been set by the caller, so even if the code
- below draws outside the redraw-area, it will not affect what is on the screen.
- Therefore, the example below can fill the rectangle in the redraw area, but still draw
- the cross in the outside regions."
-
-'.
- ].
-
- code := '
- self paint:Color red.
- self fillRectangleX:x y:y width:w height:h.
-
- self paint:Color yellow.
- self displayLineFrom:0@0 to:(width@height).
- self displayLineFrom:width@0 to:(0@height).
-'.
-
- ^ sel,comment,code
+ self subclassResponsibility
!
code_forWidget_sizeChanged
- generateComments ifFalse:[
- ^
-'sizeChanged:how
- self invalidate.
- super sizeChanged:how.
-'
- ].
-
- ^
-'sizeChanged:how
- "Invoked whenever the size of the view changes.
- Here, we force a full redraw, which might not be needed all the time"
-
- self invalidate.
- super sizeChanged:how.
-'
+ self subclassResponsibility
!
code_forWidget_update
- generateComments ifFalse:[
- ^
-'update:something with:aParameter from:changedObject
- changedObject == model ifTrue:[
- self invalidate.
- ^ self
- ].
- super update:something with:aParameter from:changedObject
-'
- ].
-
- ^
-'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 == model ifTrue:[
- self invalidate.
- ^ self
- ].
- super update:something with:aParameter from:changedObject
-'
+ self subclassResponsibility
! !
!CodeGeneratorTool methodsFor:'compilation'!
@@ -3120,70 +1381,6 @@
^ self class canUseRefactoringSupport
!
-codeFor_shouldImplementFor:selector inClass:aClass
- "used in the 'generate required protocol' to generate a shouldImplement-sending
- method for each subclassClassresponsibility method above aClass."
-
- |mthd comment implClass methodBodyStream searcher errorMessageString|
-
- (aClass notNil
- and:[ aClass superclass notNil ]) ifTrue:[
- implClass := aClass superclass whichClassImplements:selector.
- ].
- implClass isNil ifTrue:[
- ^ ((Method methodDefinitionTemplateForSelector:selector),'\ ^ self shouldImplement\') withCRs
- ].
-
- mthd := implClass compiledMethodAt:selector.
-
- methodBodyStream := '' writeStream.
- methodBodyStream
- nextPutAll:mthd methodDefinitionTemplate; cr;
- nextPutAll:' "'.
-
- "/ include the comment of the subclassResponsibility-sending method
-
- comment := mthd methodComment.
- comment isEmptyOrNil ifTrue:[
- methodBodyStream
- nextPutAll:('superclass <1s> says that I am responsible to implement this method'
- expandMacrosWith:implClass name)
- ] ifFalse:[
- comment
- asStringCollection do:[:eachLine|
- methodBodyStream nextPutAll:eachLine.
- ] separatedBy:[
- methodBodyStream cr; nextPutAll:' '.
- ].
- ].
- methodBodyStream
- nextPut:$"; cr; cr.
-
- "/ include the argument of the subclassResponsibility:-sending method
- self canUseRefactoringSupport ifTrue:[
- (mthd sends:#subclassResponsibility:) ifTrue:[
- searcher := ParseTreeSearcher new.
- searcher
- matches: 'self subclassResponsibility: `''.*'''
- do:[:node :answer |
- errorMessageString := node arguments first value.
- true.
- ].
- searcher executeTree: (mthd parseTree) initialAnswer: false.
- ].
- ].
- errorMessageString notEmptyOrNil ifTrue:[
- methodBodyStream
- nextPutAll:' ^ self shouldImplement:';
- nextPutLine:(errorMessageString storeString)
- ] ifFalse:[
- methodBodyStream
- nextPutLine:' ^ self shouldImplement'.
- ].
-
- ^ methodBodyStream contents
-!
-
privCreateClassResponsibleProtocolFor:aClass
"create stubs for the required protocol.
aClass may be a a MetaClass or a non-MetaClass"
@@ -3209,9 +1406,9 @@
!CodeGeneratorTool class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.86 2010-07-03 08:49:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.87 2011-01-28 09:22:02 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.86 2010-07-03 08:49:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.87 2011-01-28 09:22:02 cg Exp $'
! !