diff -r b320f546dc91 -r beebdd1ee40e CodeGeneratorTool.st --- 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 $' ! !