--- a/CodeGeneratorTool.st Sat Mar 07 12:11:14 2009 +0100
+++ b/CodeGeneratorTool.st Sat Mar 07 12:11:31 2009 +0100
@@ -12,7 +12,8 @@
"{ Package: 'stx:libtool' }"
Object subclass:#CodeGeneratorTool
- instanceVariableNames:'compositeChangeCollector compositeChangeNesting'
+ instanceVariableNames:'compositeChangeCollector compositeChangeNesting userPreferences
+ generateComments'
classVariableNames:'GenerateCommentsForGetters GenerateCommentsForSetters
CopyrightTemplate'
poolDictionaries:''
@@ -46,6 +47,12 @@
"
! !
+!CodeGeneratorTool class methodsFor:'instance creation'!
+
+new
+ ^ self basicNew initialize.
+! !
+
!CodeGeneratorTool class methodsFor:'code generation'!
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly
@@ -130,6 +137,12 @@
^ self new createWebServiceCodeFor:aClass
!
+createWidgetCodeFor:aClass
+ "create usually required widget code (redraw, model update, event handling)"
+
+ ^ self new createWidgetCodeFor:aClass
+!
+
initialMenuSpecMethodSourceForApplications
"return a menuSpec with typical stuff in it"
@@ -772,7 +785,7 @@
self startCollectChanges.
- categoryForMenuActionsMethods := UserPreferences current categoryForMenuActionsMethods.
+ categoryForMenuActionsMethods := userPreferences categoryForMenuActionsMethods.
nonMetaClass := aClass theNonMetaclass.
metaClass := aClass theMetaclass.
@@ -912,7 +925,8 @@
self createVersionMethodFor:metaClass.
self createCopyrightMethodFor:metaClass.
self createDocumentationMethodFor:metaClass.
- self createInitialHistoryMethodFor:metaClass.
+ self createExamplesMethodFor:metaClass.
+ "/ self createInitialHistoryMethodFor:metaClass.
self executeCollectedChangesNamed:('Add Documentation to ' , className).
!
@@ -937,10 +951,14 @@
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].
+ 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'.
@@ -998,6 +1016,53 @@
"Modified: / 1.2.1998 / 16:10:03 / cg"
!
+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).
+!
+
createInitializedInstanceCreationMethodsIn:aClass
"create a #new and #initialize methods (I'm tired of typing)"
@@ -1504,6 +1569,42 @@
self executeCollectedChangesNamed:('Add WebService Code for ' , className).
"Modified: / 1.2.1998 / 16:10:03 / cg"
+!
+
+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).
! !
!CodeGeneratorTool methodsFor:'code generation-basic'!
@@ -1511,13 +1612,12 @@
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
"workhorse for creating access methods for instvars."
- |classesClassVars generateComments generateCommentsForSetters generateCommentsForGetters|
+ |classesClassVars generateCommentsForSetters generateCommentsForGetters|
self startCollectChanges.
- generateComments := UserPreferences current generateComments.
- generateCommentsForSetters := UserPreferences current generateCommentsForSetters.
- generateCommentsForGetters := UserPreferences current generateCommentsForGetters.
+ generateCommentsForSetters := userPreferences generateCommentsForSetters.
+ generateCommentsForGetters := userPreferences generateCommentsForGetters.
classesClassVars := aClass theNonMetaclass allClassVarNames.
@@ -1667,13 +1767,10 @@
!
createCollectionAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange
-
- |classesClassVars generateComments generateCommentsForSetters generateCommentsForGetters|
+ |classesClassVars|
self startCollectChanges.
- generateComments := UserPreferences current generateComments.
-
classesClassVars := aClass theNonMetaclass allClassVarNames.
aCollectionOfVarNames do:[:name |
@@ -1742,16 +1839,15 @@
createValueHoldersFor:aCollectionOfVarNames in:aClass lazyInitialization:lazyInitialization
"workhorse for creating access methods for instvars."
- |nonMetaClass metaClass classesClassVars generateComments generateCommentsForSetters generateCommentsForGetters|
+ |nonMetaClass metaClass classesClassVars generateCommentsForSetters generateCommentsForGetters|
nonMetaClass := aClass theNonMetaclass.
metaClass := aClass theMetaclass.
self startCollectChanges.
- generateComments := UserPreferences current generateComments.
- generateCommentsForSetters := UserPreferences current generateCommentsForSetters.
- generateCommentsForGetters := UserPreferences current generateCommentsForGetters.
+ generateCommentsForSetters := userPreferences generateCommentsForSetters.
+ generateCommentsForGetters := userPreferences generateCommentsForGetters.
classesClassVars := nonMetaClass allClassVarNames.
@@ -1969,6 +2065,12 @@
|nonMetaclass fragment|
nonMetaclass := aClass theNonMetaclass.
+
+ (nonMetaclass isSubclassOf:View) ifTrue:[
+ self createExamplesMethodForViewClass:aClass.
+ ^ self
+ ].
+
(nonMetaclass isSubclassOf:ApplicationModel) ifFalse:[
^ self
].
@@ -2077,7 +2179,7 @@
source := source , (eachVar , ':' , eachVar , 'Arg ').
].
source := source , Character cr.
- (UserPreferences current generateCommentsForSetters) ifTrue:[
+ (userPreferences generateCommentsForSetters) ifTrue:[
source := source , (' "set instance variables"' , Character cr , Character cr).
].
aCollectionOfVarNames do:[:eachVar |
@@ -2108,9 +2210,16 @@
"create an update:with:from:-method
(I'm tired of typing)"
+ |code|
+
(aClass includesSelector:#'update:with:from:') ifFalse:[
- self
- compile:
+ 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."
@@ -2122,6 +2231,10 @@
"/ ].
super update:something with:aParameter from:changedObject
'
+ ].
+
+ self
+ compile:code
forClass:aClass
inCategory:'change & update'.
]
@@ -2152,6 +2265,13 @@
!CodeGeneratorTool methodsFor:'code templates'!
codeFor_closeAccept
+ generateComments ifFalse:[
+ ^
+'closeAccept
+ ^ super closeAccept
+'.
+ ].
+
^
'closeAccept
"This is a hook method generated by the Browser.
@@ -2168,6 +2288,13 @@
!
codeFor_closeDownViews
+ generateComments ifFalse:[
+ ^
+'closeDownViews
+ ^ super closeDownViews
+'.
+ ].
+
^
'closeDownViews
"This is a hook method generated by the Browser.
@@ -2190,6 +2317,18 @@
!
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.
@@ -2220,6 +2359,13 @@
!
codeFor_emptyMenuActionCodeFor:selector menuItem:item
+ generateComments ifFalse:[
+ ^
+selector,'
+ self warn:''no action for ''''',item,''''' defined.''.
+'.
+ ].
+
^
selector,'
"This method was generated by the Browser.
@@ -2233,6 +2379,13 @@
!
codeFor_hasUnsavedChanges
+ generateComments ifFalse:[
+ ^
+'hasUnsavedChanges
+ ^ false.
+'.
+ ].
+
^
'hasUnsavedChanges
"Return true, if any unsaved changes are present
@@ -2315,6 +2468,13 @@
!
codeFor_postBuildWith
+ generateComments ifFalse:[
+ ^
+'postBuildWith:aBuilder
+ ^ super postBuildWith:aBuilder
+'.
+ ].
+
^
'postBuildWith:aBuilder
"This is a hook method generated by the Browser.
@@ -2333,6 +2493,13 @@
!
codeFor_postOpenWith
+ generateComments ifFalse:[
+ ^
+'postOpenWith:aBuilder
+ ^ super postOpenWith:aBuilder
+'.
+ ].
+
^
'postOpenWith:aBuilder
"This is a hook method generated by the Browser.
@@ -2346,6 +2513,133 @@
'.
"Created: / 27-10-2006 / 09:59:56 / cg"
+!
+
+code_forWidget_buttonPress
+ generateComments ifFalse:[
+ ^
+'buttonPress:button x:x y:y
+ 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...."
+
+ "/ super-code handles middleButtonMenu, if it was assigned (with middleButtonmenu:)
+ super buttonPress:button x:x y:y
+'
+!
+
+code_forWidget_initialize
+ ^
+'initialize
+ super initialize "/ to initialize inherited state
+
+ "/ add code to initialize private variables,
+ "/ and sub-components as required.
+'
+!
+
+code_forWidget_keyPress
+ generateComments ifFalse:[
+ ^
+'keyPress:key x:x y:y
+"/ key == #Copy ifTrue:[
+"/ ].
+"/ key == #Cut ifTrue:[
+"/ ].
+ 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...."
+
+ super keyPress:key x:x y:y
+'
+!
+
+code_forWidget_redraw
+ generateComments ifFalse:[
+ ^
+'redrawX:x y:y width:w height:h
+ self paint:Color red.
+ self filleRectangleX: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)
+'
+ ].
+
+ ^
+'redrawX:x y:y width:w height:h
+ "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."
+
+ self paint:Color red.
+ self filleRectangleX: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)
+'
+!
+
+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.
+'
+!
+
+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
+'
! !
!CodeGeneratorTool methodsFor:'compilation'!
@@ -2397,6 +2691,13 @@
"Modified: / 21-08-2006 / 18:39:06 / cg"
! !
+!CodeGeneratorTool methodsFor:'initialization'!
+
+initialize
+ userPreferences := UserPreferences current.
+ generateComments := userPreferences generateComments.
+! !
+
!CodeGeneratorTool methodsFor:'private'!
canUseRefactoringSupport
@@ -2461,5 +2762,5 @@
!CodeGeneratorTool class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.58 2008-12-09 14:03:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.59 2009-03-07 11:11:31 cg Exp $'
! !