# HG changeset patch # User Claus Gittinger # Date 878067704 -3600 # Node ID 088174fc1e71461ecaf6678d7a3591a90b9f3356 # Parent 7cb9f9c9a87236cd7e57ce0d3932abbad65f0fae support for constant lists; better aspect-method code added browse-aspect-methods diff -r 7cb9f9c9a872 -r 088174fc1e71 UIPainterView.st --- a/UIPainterView.st Tue Oct 28 20:37:54 1997 +0100 +++ b/UIPainterView.st Tue Oct 28 20:41:44 1997 +0100 @@ -387,6 +387,95 @@ !UIPainterView methodsFor:'generating output'! +aspectMethods + "extract a list of aspect methods - for browsing" + + |cls methods skip selector protoSpec| + + className isNil ifTrue:[ + self warn:'set the class first'. + ^ #() + ]. + + cls := self resolveName:className. + methods := IdentitySet new. + + treeView propertiesDo:[:aProp| + |selector| + + (selector := aProp model) notNil ifTrue:[ + selector isArray ifFalse:[ + selector := selector asSymbol. + (cls implements:selector) ifTrue:[ + skip := false. + (cls isSubclassOf:SimpleDialog) ifTrue:[ + skip := SimpleDialog implements:selector asSymbol + ]. + skip ifFalse:[ + methods add:(cls compiledMethodAt:selector) + ]. + ]. + ]. + ]. + + (selector := aProp menu) notNil ifTrue:[ + selector isArray ifFalse:[ + selector := selector asSymbol. + (cls implements:selector) ifTrue:[ + methods add:(cls compiledMethodAt:selector) + ] + ]. + ]. + + (aProp spec aspectSelectors) do:[:aSel | + |selector| + + aSel isArray ifFalse:[ + selector := aSel asSymbol. + (cls implements:selector) ifTrue:[ + methods add:(cls compiledMethodAt:selector) + ] + ]. + ]. + aProp spec actionSelectors do:[:aSel| + |selector| + + aSel isArray ifFalse:[ + selector := aSel asSymbol. + (cls implements:selector) ifTrue:[ + methods add:(cls compiledMethodAt:selector) + ] + ]. + ]. + aProp spec valueSelectors do:[:aSel| + |selector| + + aSel isArray ifFalse:[ + selector := aSel asSymbol. + (cls implements:selector) ifTrue:[ + methods add:(cls compiledMethodAt:selector) + ] + ]. + ] + ]. + + protoSpec := treeView canvasSpec. + + (selector := protoSpec menu) notNil ifTrue:[ + selector isArray ifFalse:[ + selector := selector asSymbol. + (cls implements:selector) ifTrue:[ + methods add:(cls compiledMethodAt:selector) + ] + ]. + ]. + + ^ methods + + "Created: / 25.10.1997 / 18:58:25 / cg" + "Modified: / 26.10.1997 / 15:06:18 / cg" +! + generateActionMethodFor:aspect spec:protoSpec inClass:targetClass |selector args showIt code alreadyInSuperclass| @@ -404,7 +493,10 @@ code := '!!' , targetClass name , ' methodsFor:''actions''!!\\' , aspect , args , '\' , - ' "automatically generated by UIPainter ..."\' , + ' "automatically generated by UIPainter ..."\\' , + ' "*** the code below performs no action"\' , + ' "*** (except for some feedback on the Transcript)"\' , + ' "*** Please change as required and accept in the browser."\' , '\' . alreadyInSuperclass ifTrue:[ @@ -432,29 +524,45 @@ '!! !!\\'. ^ code withCRs - "Modified: 19.8.1997 / 12:03:20 / cg" + "Modified: / 25.10.1997 / 19:18:50 / cg" ! generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass - |modelClass| + |modelClass modelValue modelGen| modelClass := protoSpec defaultModelClassFor:aspect. + modelValue := protoSpec defaultModelValueFor:aspect. + + modelValue isNil ifTrue:[ + modelGen := modelClass name , ' new' + ] ifFalse:[ + modelGen := modelValue storeString , ' asValue' + ]. ^ ('!!' , targetClass name , ' methodsFor:''aspects''!!\\' , aspect , '\' , - ' "automatically generated by UIPainter ..."\' , + ' "automatically generated by UIPainter ..."\\' , + ' "*** 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."\' , '\' , ' |holder|\' , '\' , ' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' , - ' builder aspectAt:#' , aspect , ' put:(holder := ' , ' ' , modelClass name , ' new' , ').\' , + ' builder aspectAt:#' , aspect , ' put:(holder := ' , ' ' , modelGen , ').\' , ' ].\' , ' ^ holder\' , '!! !!\\') withCRs + + "Modified: / 26.10.1997 / 19:01:15 / cg" ! generateAspectMethods - |cls code skip modelSelector menuSelector protoSpec thisCode| + "generate aspect, action & menu methods + - but do not overwrite existing ones. + Return a string ready to compile into the application class." + + |cls code skip menuSelector protoSpec thisCode| code := ''. @@ -465,49 +573,61 @@ cls := self resolveName:className. treeView propertiesDo:[:aProp| + |modelSelector menuSelector| + protoSpec := aProp spec. (modelSelector := aProp model) notNil ifTrue:[ - (cls implements:modelSelector asSymbol) ifFalse:[ - skip := false. - (cls isSubclassOf:SimpleDialog) ifTrue:[ - skip := SimpleDialog implements:modelSelector asSymbol - ]. - skip ifFalse:[ - "/ kludge .. - (protoSpec isMemberOf:ActionButtonSpec) ifTrue:[ - thisCode := (self generateActionMethodFor:modelSelector spec:protoSpec inClass:cls). - ] ifFalse:[ - thisCode := (self generateAspectMethodFor:modelSelector spec:protoSpec inClass:cls). + (modelSelector isArray not) ifTrue:[ + (cls implements:modelSelector asSymbol) ifFalse:[ + skip := false. + (cls isSubclassOf:SimpleDialog) ifTrue:[ + skip := SimpleDialog implements:modelSelector asSymbol ]. - code := code , thisCode + skip ifFalse:[ + "/ kludge .. + (protoSpec isMemberOf:ActionButtonSpec) ifTrue:[ + thisCode := (self generateActionMethodFor:modelSelector spec:protoSpec inClass:cls). + ] ifFalse:[ + thisCode := (self generateAspectMethodFor:modelSelector spec:protoSpec inClass:cls). + ]. + code := code , thisCode + ]. ]. ]. ]. (menuSelector := aProp menu) notNil ifTrue:[ - thisCode := self generateMenuMethodFor:menuSelector spec:protoSpec inClass:cls. - thisCode size ~~ 0 ifTrue:[ - code := code , thisCode + (menuSelector isArray not) ifTrue:[ + thisCode := self generateMenuMethodFor:menuSelector spec:protoSpec inClass:cls. + thisCode size ~~ 0 ifTrue:[ + code := code , thisCode + ] ] ]. aProp spec aspectSelectors do:[:aSel| - (cls implements:aSel asSymbol) ifFalse:[ - thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). - code := code , thisCode + (aSel isArray not) ifTrue:[ + (cls implements:aSel asSymbol) ifFalse:[ + thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). + code := code , thisCode + ] ] ]. aProp spec actionSelectors do:[:aSel| - (cls implements:aSel asSymbol) ifFalse:[ - thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). - code := code , thisCode + (aSel isArray not) ifTrue:[ + (cls implements:aSel asSymbol) ifFalse:[ + thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). + code := code , thisCode + ] ] ]. aProp spec valueSelectors do:[:aSel| - (cls implements:aSel asSymbol) ifFalse:[ - thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls). - code := code , thisCode + (aSel isArray not) ifTrue:[ + (cls implements:aSel asSymbol) ifFalse:[ + thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls). + code := code , thisCode + ] ] ] ]. @@ -515,14 +635,17 @@ protoSpec := treeView canvasSpec. (menuSelector := protoSpec menu) notNil ifTrue:[ - thisCode := self generateMenuMethodFor:menuSelector spec:protoSpec inClass:cls. - thisCode size ~~ 0 ifTrue:[ - code := code , thisCode + (menuSelector isArray not) ifTrue:[ + thisCode := self generateMenuMethodFor:menuSelector spec:protoSpec inClass:cls. + thisCode size ~~ 0 ifTrue:[ + code := code , thisCode + ] ] ]. + ^ code - ^ code + "Modified: / 26.10.1997 / 14:43:55 / cg" ! generateMenuMethodFor:aspect spec:protoSpec inClass:aClass @@ -547,7 +670,7 @@ , aClass name , ' methodsFor:' , category storeString , Character excla asString , '\\' , performer , '\' - , ' "this window spec was automatically generated by the UI Builder"\\' + , ' "this menu spec was automatically generated by the UI MenuBuilder"\\' , ' ^ self\\' , '\' , Character excla asString @@ -563,12 +686,17 @@ ^ nil ]. ^ code withCRs + + "Modified: / 26.10.1997 / 14:44:20 / cg" ! generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ^ ('!!' , targetClass name , ' methodsFor:''values''!!\\' , aspect , '\' , - ' "automatically generated by UIPainter ..."\' , + ' "automatically generated by UIPainter ..."\\' , + ' "*** the code below returns a default value when invoked."\' , + ' "*** (which may not be the one you wanted)"\' , + ' "*** Please change as required and accept in the browser."\' , '\' , ' "value to be added below ..."\' , ' Transcript showCR:self class name , '': no value yet for ' , aspect , ' ...''.\' , @@ -576,9 +704,7 @@ '^ nil.' , '!! !!\\') withCRs - - - + "Modified: / 25.10.1997 / 19:22:17 / cg" ! generateWindowSpecMethodSource