--- a/UIPainterView.st Fri Feb 21 13:20:17 2003 +0100
+++ b/UIPainterView.st Fri Feb 21 16:26:07 2003 +0100
@@ -572,71 +572,80 @@
aspectMethods
"extract a list of aspect methods - for browsing"
- |cls methods skip selector protoSpec|
+ |cls methods|
className isNil ifTrue:[
- self warn:'set the class first'.
+ self warn:'No class defined !!'.
^ #()
].
cls := self resolveName:className.
methods := IdentitySet new.
+ self aspectSelectorsAndTypesDo:
+ [:selector :typeSymbol |
+ |skip|
+
+ (cls includesSelector:selector) ifTrue:[
+
+ skip := false.
+ (typeSymbol == #modelAspect) ifTrue:[
+ (cls isSubclassOf:SimpleDialog) ifTrue:[
+ skip := SimpleDialog includesSelector:(selector asSymbol)
+ ].
+ ].
+ skip ifFalse:[
+ methods add:(cls compiledMethodAt:selector)
+ ].
+ ]
+ ].
+
+ ^ methods
+
+ "Created: / 25.10.1997 / 18:58:25 / cg"
+ "Modified: / 26.10.1997 / 15:06:18 / cg"
+!
+
+aspectSelectorsAndTypesDo:aTwoArgBlock
+ "evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type"
+
+ |cls methods selector protoSpec|
+
+ className isNil ifTrue:[
+ self warn:'No class defined !!'.
+ ^ self
+ ].
+
+ cls := self resolveName:className.
+
treeView propertiesDo:[:aProp|
|selector|
(selector := aProp model) notNil ifTrue:[
selector isArray ifFalse:[
- selector := selector asSymbol.
- (cls includesSelector:selector) ifTrue:[
- skip := false.
- (cls isSubclassOf:SimpleDialog) ifTrue:[
- skip := SimpleDialog includesSelector:selector asSymbol
- ].
- skip ifFalse:[
- methods add:(cls compiledMethodAt:selector)
- ].
- ].
+ aTwoArgBlock value:(selector asSymbol) value:#modelAspect
].
].
(selector := aProp menu) notNil ifTrue:[
selector isArray ifFalse:[
- selector := selector asSymbol.
- (cls includesSelector:selector) ifTrue:[
- methods add:(cls compiledMethodAt:selector)
- ]
+ aTwoArgBlock value:(selector asSymbol) value:#menu
].
].
(aProp spec aspectSelectors) do:[:aSel |
- |selector|
-
aSel isArray ifFalse:[
- selector := aSel asSymbol.
- (cls includesSelector:selector) ifTrue:[
- methods add:(cls compiledMethodAt:selector)
- ]
+ aTwoArgBlock value:(aSel asSymbol) value:#channelAspect
].
].
aProp spec actionSelectors do:[:aSel|
- |selector|
-
aSel isArray ifFalse:[
- selector := aSel asSymbol.
- (cls includesSelector:selector) ifTrue:[
- methods add:(cls compiledMethodAt:selector)
- ]
+ aTwoArgBlock value:(aSel asSymbol) value:#actionSelector
].
].
aProp spec valueSelectors do:[:aSel|
- |selector|
-
aSel isArray ifFalse:[
- selector := aSel asSymbol.
- (cls includesSelector:selector) ifTrue:[
- methods add:(cls compiledMethodAt:selector)
- ]
+ aTwoArgBlock value:(aSel asSymbol) value:#valueSelector
].
]
].
@@ -645,17 +654,11 @@
(selector := protoSpec menu) notNil ifTrue:[
selector isArray ifFalse:[
- selector := selector asSymbol.
- (cls includesSelector:selector) ifTrue:[
- methods add:(cls compiledMethodAt:selector)
- ]
+ aTwoArgBlock value:(selector asSymbol) value:#menu
].
].
^ methods
-
- "Created: / 25.10.1997 / 18:58:25 / cg"
- "Modified: / 26.10.1997 / 15:06:18 / cg"
!
generateActionMethodFor:aspect spec:protoSpec inClass:targetClass
@@ -720,6 +723,147 @@
"Modified: / 25.10.1997 / 19:18:50 / cg"
!
+generateAspectMethodCode
+ "generate aspect, action & menu methods
+ - but do not overwrite existing ones.
+ Return a string ready to compile into the application class."
+
+ ^ self generateAspectMethodCodeFiltering:nil
+!
+
+generateAspectMethodCodeFiltering:aFilterOrEmpty
+ "generate aspect, action & menu methods
+ - but do not overwrite existing ones.
+ Return a string ready to compile into the application class."
+
+ |cls codePieces skip protoSpec thisCode
+ definedMethodSelectors iVars t exportSels|
+
+ cls := self targetClass.
+ cls isNil ifTrue:[
+ ^ nil
+ ].
+
+ codePieces := OrderedCollection new.
+ definedMethodSelectors := IdentitySet new.
+
+ treeView propertiesDo:[:aProp|
+ |modelSelector|
+
+ protoSpec := aProp spec.
+
+ (modelSelector := aProp model) notNil ifTrue:[
+ self generateCodeFrom:(Array with:modelSelector) in:cls
+ do:[:aSel|
+ (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
+ skip := false.
+
+ (cls isSubclassOf:SimpleDialog) ifTrue:[
+ skip := SimpleDialog includesSelector:aSel
+ ].
+ (definedMethodSelectors includes:aSel) ifTrue:[
+ skip := true.
+ ].
+
+ skip ifFalse:[
+ "/ kludge ..
+ "/ (protoSpec isKindOf:ActionButtonSpec)
+ (protoSpec defaultModelIsCallBackMethodSelector:aSel)
+ ifTrue:[
+ thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
+ ] ifFalse:[
+ thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
+ ].
+ codePieces add:thisCode.
+ definedMethodSelectors add:aSel.
+ Transcript showCR:'code generated for aspect: ' , aSel
+ ] ifTrue:[
+ Transcript showCR:'*** no code generated for aspect: ' , aSel , ' (method already exists)'
+ ].
+ ].
+ ].
+ ].
+
+ "/ for each aspect, generate getter (if not yet implemented)
+ self generateCodeFrom:(aProp spec aspectSelectors) in:cls
+ do:[:aSel|
+ (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
+ (definedMethodSelectors includes:aSel) ifFalse:[
+ thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
+ codePieces add:thisCode.
+ definedMethodSelectors add:aSel.
+ Transcript showCR:'code generated for aspect: ' , aSel
+ ]
+ ]
+ ].
+
+ "/ exported aspects - need setter methods
+ exportSels := (treeView exportedAspects ? #()) collect:[:entry | (entry subAspect , ':') asSymbol].
+ self generateCodeFrom:exportSels in:cls
+ do:[:aSel|
+ |aspect|
+
+ (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
+ (definedMethodSelectors includes:aSel) ifFalse:[
+ aspect := (aSel copyWithoutLast:1) asSymbol.
+ thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls).
+ codePieces add:thisCode.
+ definedMethodSelectors add:aSel.
+ Transcript showCR:'export code generated for aspect: ' , aSel
+ ]
+ ]
+ ].
+
+ self generateCodeFrom:(aProp spec actionSelectors) in:cls
+ do:[:aSel|
+ (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
+ (definedMethodSelectors includes:aSel) ifFalse:[
+ thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
+ codePieces add:thisCode.
+ definedMethodSelectors add:aSel.
+ Transcript showCR:'action generated for aspect: ' , aSel
+ ]
+ ]
+ ].
+
+ self generateCodeFrom:(aProp spec valueSelectors) in:cls
+ do:[:aSel|
+ (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
+ (definedMethodSelectors includes:aSel) ifFalse:[
+ "/ uppercase: - assume its a globals name.
+ aSel first isUppercase ifFalse:[
+ thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls).
+ codePieces add:thisCode.
+ definedMethodSelectors add:aSel.
+ Transcript showCR:'code generated for aspect: ' , aSel
+ ]
+ ]
+ ]
+ ].
+ ].
+
+ AspectsAsInstances ifTrue:[
+ iVars := cls instVarNames asOrderedCollection.
+ definedMethodSelectors do:[:ivar |
+ (iVars includes:ivar) ifFalse:[
+ iVars add:ivar
+ ]
+ ].
+ iVars := iVars asArray.
+ t := cls shallowCopy.
+ t setInstanceVariableString:iVars asStringCollection asString.
+ codePieces addFirst:(t definition , '!!\' withCRs).
+ ].
+
+ ^ String
+ streamContents:
+ [:codeStream |
+ codePieces do:[:eachPiece | codeStream nextPutAll:eachPiece].
+ ].
+
+ "Modified: / 29.7.1998 / 12:21:19 / cg"
+!
+
generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass
|modelClass modelValueString modelValue modelGen code|
@@ -785,158 +929,17 @@
"Modified: / 22.9.1999 / 12:33:47 / stefan"
!
-generateAspectMethods
- "generate aspect, action & menu methods
- - but do not overwrite existing ones.
- Return a string ready to compile into the application class."
-
- |cls code skip protoSpec thisCode
- definedMethodSelectors iVars t exportSels|
-
- definedMethodSelectors := IdentitySet new.
-
- code := ''.
-
- className isNil ifTrue:[
- self warn:'Set first the class!!'.
- ^ code
- ].
-
- (cls := self resolveName:className) isNil ifTrue:[
- self warn:'Class ', className asString, ' does not exist!!'.
- ^ code
- ].
-
- treeView propertiesDo:[:aProp|
- |modelSelector|
-
- protoSpec := aProp spec.
-
- (modelSelector := aProp model) notNil ifTrue:[
- self generateCodeFrom:(Array with:modelSelector) in:cls
- do:[:aSel|
- |sym|
-
- sym := aSel asSymbol.
- skip := false.
-
- (cls isSubclassOf:SimpleDialog) ifTrue:[
- skip := SimpleDialog includesSelector:sym
- ].
- (definedMethodSelectors includes:sym) ifTrue:[
- skip := true.
- ].
-
- skip ifFalse:[
- "/ kludge ..
- "/ (protoSpec isKindOf:ActionButtonSpec)
- (protoSpec defaultModelIsCallBackMethodSelector:aSel)
- ifTrue:[
- thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
- ] ifFalse:[
- thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
- ].
- code := code, thisCode.
- definedMethodSelectors add:sym.
- Transcript showCR:'code generated for aspect: ' , sym
- ] ifTrue:[
- Transcript showCR:'*** no code generated for aspect: ' , sym , ' (method already exists)'
- ].
- ].
- ].
-
- "/ for each aspect, generate getter (if not yet implemented)
- self generateCodeFrom:(aProp spec aspectSelectors) in:cls
- do:[:aSel|
- |sym|
-
- sym := aSel asSymbol.
- (definedMethodSelectors includes:sym) ifFalse:[
- thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
- code := code , thisCode.
- definedMethodSelectors add:sym.
- Transcript showCR:'code generated for aspect: ' , sym
- ]
- ].
-
- "/ exported aspects - need setter methods
- exportSels := (treeView exportedAspects ? #()) collect:[:entry | (entry subAspect , ':') asSymbol].
- self generateCodeFrom:exportSels in:cls
- do:[:aSel|
- |sym aspect|
-
- sym := aSel asSymbol.
- (definedMethodSelectors includes:sym) ifFalse:[
- aspect := (aSel copyWithoutLast:1) asSymbol.
- thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls).
- code := code , thisCode.
- definedMethodSelectors add:sym.
- Transcript showCR:'export code generated for aspect: ' , sym
- ]
- ].
-
- self generateCodeFrom:(aProp spec actionSelectors) in:cls
- do:[:aSel|
- |sym|
-
- sym := aSel asSymbol.
- (definedMethodSelectors includes:sym) ifFalse:[
- thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
- code := code , thisCode.
- definedMethodSelectors add:sym.
- Transcript showCR:'action generated for aspect: ' , sym
- ]
- ].
-
- self generateCodeFrom:(aProp spec valueSelectors) in:cls
- do:[:aSel|
- |sym|
-
- sym := aSel asSymbol.
- (definedMethodSelectors includes:sym) ifFalse:[
- "/ uppercase: - assume its a globals name.
- aSel first isUppercase ifFalse:[
- thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls).
- code := code , thisCode.
- definedMethodSelectors add:sym.
- Transcript showCR:'code generated for aspect: ' , sym
- ]
- ]
- ].
- ].
-
- AspectsAsInstances ifTrue:[
- iVars := cls instVarNames asOrderedCollection.
- definedMethodSelectors do:[:ivar |
- (iVars includes:ivar) ifFalse:[
- iVars add:ivar
- ]
- ].
- iVars := iVars asArray.
- t := cls shallowCopy.
- t setInstanceVariableString:iVars asStringCollection asString.
- code := (t definition) , '!!\' withCRs , code.
- ].
- ^ code
-
- "Modified: / 29.7.1998 / 12:21:19 / cg"
-!
-
generateAspectSelectorsMethod
"generate aspectSelectors method.
Return a string ready to compile into the application class."
|cls code spec|
- className isNil ifTrue:[
- self warn:'Set first the class!!'.
+ cls := self targetClass.
+ cls isNil ifTrue:[
^ nil
].
- (cls := self resolveName:className) isNil ifTrue:[
- self warn:'Class ', className asString, ' does not exist!!'.
- ^ nil
- ].
spec := treeView exportedAspects.
spec size == 0 ifTrue:[^ nil].
@@ -1020,7 +1023,7 @@
self class redefineAspectMethods ifTrue:[
aListOfSelectors do:[:aSelector|
(aSelector isArray or:[aClass includesSelector:aSelector]) ifFalse:[
- aBlock value:aSelector
+ aBlock value:aSelector asSymbol
] ifTrue:[
Transcript showCR:'#' , aSelector , ' skipped - already implemented in the class'
]
@@ -1029,7 +1032,7 @@
aListOfSelectors do:[:aSelector|
aSelector isArray ifFalse:[
(aClass canUnderstand:aSelector) ifFalse:[
- aBlock value:aSelector
+ aBlock value:aSelector asSymbol
] ifTrue:[
Transcript showCR:'#' , aSelector , ' skipped - already implemented in the class (or superclass)'
]
@@ -1061,22 +1064,14 @@
- but do not overwrite existing ones.
Return a string ready to compile into the application class."
- |cls code|
-
- code := ''.
-
- className isNil ifTrue:[
- self warn:'set the class first'.
- ^ code
+ |cls|
+
+ cls := self targetClass.
+ cls isNil ifTrue:[
+ ^ nil
].
- cls := self resolveName:className.
-
- code := code , (self generateHookMethodsInClass:cls).
-
- ^ code
-
- "Created: / 31.10.1997 / 17:21:29 / cg"
- "Modified: / 31.10.1997 / 17:38:11 / cg"
+
+ ^ self generateHookMethodsInClass:cls.
!
generateHookMethodsInClass:targetClass
@@ -1245,13 +1240,8 @@
specArray fullSpec winSpec menuSpec
|
- className isNil ifTrue:[
- self warn:'Define the class first !!'.
- ^ nil
- ].
-
- (cls := self resolveName:className) isNil ifTrue:[
- self warn:'Class ', className asString, ' does not exist!!'.
+ cls := self targetClass.
+ cls isNil ifTrue:[
^ nil
].
@@ -1390,6 +1380,20 @@
"Modified: / 5.9.1995 / 21:01:35 / claus"
"Modified: / 15.10.1998 / 11:29:53 / cg"
+!
+
+targetClass
+ |cls|
+
+ className isNil ifTrue:[
+ self warn:'No TargetClass defined !!'.
+ ^ nil
+ ].
+ (cls := self resolveName:className) isNil ifTrue:[
+ self warn:('Class ', className asString, ' does not exist !!').
+ ^ nil
+ ].
+ ^ cls.
! !
!UIPainterView methodsFor:'grid manipulation'!