--- a/UIPainterView.st Thu Mar 05 13:37:26 1998 +0100
+++ b/UIPainterView.st Thu Mar 05 17:24:21 1998 +0100
@@ -13,7 +13,7 @@
UIObjectView subclass:#UIPainterView
instanceVariableNames:'treeView listHolder superclassName className methodName
categoryName'
- classVariableNames:'HandCursor'
+ classVariableNames:'HandCursor RedefineMethods'
poolDictionaries:''
category:'Interface-UIPainter'
!
@@ -56,6 +56,25 @@
"
! !
+!UIPainterView class methodsFor:'code generation mode'!
+
+redefineMethods
+ "redefine methods yes or no. If a method is defined in super class
+ should the message be reinstalled ?
+ "
+ ^ RedefineMethods ? false
+
+!
+
+redefineMethods:aBool
+ "redefine methods yes or no. If a method is defined in super class
+ should the message be reinstalled ?
+ "
+ RedefineMethods := aBool
+
+
+! !
+
!UIPainterView class methodsFor:'defaults'!
defaultMenuMessage
@@ -160,21 +179,24 @@
copySelection
"copy the selection into the cut&paste-buffer
"
- |specs coll|
+ |specs coll sel|
+
+ sel := treeView selection.
coll := self minSetOfSuperViews:(self selection).
coll notNil ifTrue:[
self select:nil.
specs := coll collect:[:aView| self fullSpecFor:aView ].
- self setSelection:specs
+ self setSelection:specs.
+ treeView selection: sel
].
!
-deleteSelection
- "delete the selection; copy the selection into the cut&paste-buffer
+cutSelection
+ "cut the selection into the cut&paste-buffer
and open a transaction
"
|specs coll|
@@ -193,6 +215,30 @@
]
].
self setSelection:specs.
+ treeView selection: (Array with: 1)
+ ]
+ ]
+!
+
+deleteSelection
+ "delete the selection; copy the selection into the cut&paste-buffer
+ and open a transaction
+ "
+ |specs coll|
+
+ coll := self minSetOfSuperViews:(self selection).
+
+ coll notNil ifTrue:[
+ treeView cvsEventsDisabledDo:[
+ self select:nil.
+ specs := coll collect:[:aView| self fullSpecFor:aView ].
+
+ self withinTransaction:#cut objects:coll do:[
+ coll reverseDo:[:aView|
+ self remove:aView
+ ]
+ ].
+ treeView selection: (Array with: 1)
]
]
!
@@ -322,7 +368,7 @@
canDrop:something
"returns true if something can be droped
- "
+ "
(something size == 1 and:[self enabled and:[self numberOfSelections <= 1]]) ifTrue:[
^ something first theObject isKindOf:UISpecification
].
@@ -355,7 +401,6 @@
^ self canPasteInto:(self singleSelection)
].
^ true
-
!
canPasteInto:aView
@@ -606,10 +651,14 @@
code := ''.
className isNil ifTrue:[
- self warn:'set the class first'.
+ self warn:'Set first the class!!'.
^ code
].
- cls := self resolveName:className.
+
+ (cls := self resolveName:className) isNil ifTrue:[
+ self warn:'Class ', className asString, ' does not exist!!'.
+ ^ code
+ ].
treeView propertiesDo:[:aProp|
|modelSelector menuSelector|
@@ -617,55 +666,69 @@
protoSpec := aProp spec.
(modelSelector := aProp model) notNil ifTrue:[
- (modelSelector isArray not) ifTrue:[
- (cls implements:modelSelector asSymbol) ifFalse:[
+ self generateCodeFrom:(Array with:modelSelector) in:cls
+ do:[:aSel|
skip := false.
+
(cls isSubclassOf:SimpleDialog) ifTrue:[
- skip := SimpleDialog implements:modelSelector asSymbol
+ skip := SimpleDialog implements:aSel asSymbol
].
+
skip ifFalse:[
"/ kludge ..
(protoSpec isKindOf:ActionButtonSpec) ifTrue:[
- thisCode := (self generateActionMethodFor:modelSelector spec:protoSpec inClass:cls).
+ thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
] ifFalse:[
- thisCode := (self generateAspectMethodFor:modelSelector spec:protoSpec inClass:cls).
+ thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
].
- code := code , thisCode
- ].
- ].
- ].
+ code := code, thisCode
+ ]
+ ]
].
- aProp spec aspectSelectors do:[:aSel|
- (aSel isArray not) ifTrue:[
- (cls implements:aSel asSymbol) ifFalse:[
+ self generateCodeFrom:(aProp spec aspectSelectors) in:cls
+ do:[:aSel|
thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
code := code , thisCode
- ]
- ]
- ].
- aProp spec actionSelectors do:[:aSel|
- (aSel isArray not) ifTrue:[
- (cls implements:aSel asSymbol) ifFalse:[
+ ].
+
+ self generateCodeFrom:(aProp spec actionSelectors) in:cls
+ do:[:aSel|
thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
code := code , thisCode
- ]
- ]
- ].
- aProp spec valueSelectors do:[:aSel|
- (aSel isArray not) ifTrue:[
- "/ uppercase: - assume its a globals name.
- aSel first isUppercase ifFalse:[
- (cls implements:aSel asSymbol) ifFalse:[
+ ].
+
+ self generateCodeFrom:(aProp spec valueSelectors) in:cls
+ do:[:aSel|
+ "/ uppercase: - assume its a globals name.
+ aSel first isUppercase ifFalse:[
thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls).
code := code , thisCode
]
- ]
- ]
- ]
+ ].
].
^ code
+
+!
+
+generateCodeFrom:aListOfSelectors in:aClass do:aBlock
+
+ self class redefineMethods ifTrue:[
+ aListOfSelectors do:[:aSelector|
+ (aSelector isArray or:[aClass implements:aSelector]) ifFalse:[
+ aBlock value:aSelector
+ ]
+ ]
+ ] ifFalse:[
+ aListOfSelectors do:[:aSelector|
+ (aSelector isArray or:[aClass canUnderstand:aSelector]) ifFalse:[
+ aBlock value:aSelector
+ ]
+ ]
+ ]
+
+
!
generateHookMethodFor:selectorSpec comment:commentWhen note:noteOrNil defaultCode:defaultCode inClass:targetClass
@@ -841,6 +904,7 @@
categoryName := 'Applications'.
HandCursor := Cursor leftHand.
+ self backgroundColor: self class defaultViewBackgroundColor
!
setupFromSpec:specOrSpecArray
@@ -1249,7 +1313,7 @@
|props name builder|
aSpec class == WindowSpec ifTrue:[
- ^ treeView canvasSpec:aSpec
+ ^ treeView canvasSpec:aSpec
].
self singleSelection notNil ifTrue:[