--- 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