--- a/UIPainterView.st Thu Jan 17 10:55:25 2008 +0100
+++ b/UIPainterView.st Thu Jan 17 10:55:27 2008 +0100
@@ -13,8 +13,10 @@
UIObjectView subclass:#UIPainterView
instanceVariableNames:'treeView listHolder superclassName className methodName
- categoryName handleColorBlack handleColorWhite handleMasterColor'
- classVariableNames:'HandCursor RedefineAspectMethods AspectsAsInstances'
+ categoryName handleColorBlack handleColorWhite handleMasterColor
+ sketchPainter'
+ classVariableNames:'HandCursor RedefineAspectMethods AspectsAsInstances
+ GenerateCommentedCode'
poolDictionaries:''
category:'Interface-UIPainter'
!
@@ -71,8 +73,8 @@
generateAspectsAsInstanceVariables
"if on, aspects are held as instance variables;
- if off (the default), they are kept in the bindings dictionary.
- "
+ if off (the default), they are kept in the bindings dictionary."
+
^ AspectsAsInstances
"Created: / 29.7.1998 / 11:21:38 / cg"
@@ -81,30 +83,42 @@
generateAspectsAsInstanceVariables:aBoolean
"if on, aspects are held as instance variables;
- if off (the default), they are kept in the bindings dictionary.
- "
+ if off (the default), they are kept in the bindings dictionary."
+
AspectsAsInstances := aBoolean
"Created: / 29.7.1998 / 11:21:26 / cg"
"Modified: / 29.7.1998 / 11:22:11 / cg"
!
+generateCommentedCode
+ "comments in generated aspect methods; yes or no."
+
+ ^ GenerateCommentedCode ? true
+
+ "Modified: / 12-01-2008 / 10:21:06 / cg"
+!
+
+generateCommentedCode:aBoolean
+ "comments in generated aspect methods; yes or no."
+
+ GenerateCommentedCode := aBoolean
+!
+
redefineAspectMethods
- "redefine methods yes or no. If a method is defined in super class
- should the message be reinstalled ?
- "
+ "redefine methods yes or no.
+ If a method is defined in super class should the message be reinstalled ?"
+
^ RedefineAspectMethods
"Modified: / 22.9.1999 / 12:33:03 / stefan"
!
redefineAspectMethods:aBoolean
- "redefine methods yes or no. If a method is defined in super class
- should the message be reinstalled ?
- "
+ "redefine methods yes or no.
+ If a method is defined in super class should the message be reinstalled ?"
+
RedefineAspectMethods := aBoolean
-
-
! !
!UIPainterView class methodsFor:'defaults'!
@@ -597,6 +611,36 @@
"Created: / 13-10-2006 / 16:09:27 / cg"
! !
+!UIPainterView methodsFor:'drawing'!
+
+clearRectangle:visRect
+ super clearRectangle:visRect.
+ sketchPainter notNil ifTrue:[
+ sketchPainter redrawInTargetView
+ ].
+
+ "Created: / 16-01-2008 / 17:52:27 / cg"
+!
+
+clearView
+ super clearView.
+ sketchPainter notNil ifTrue:[
+ sketchPainter redrawInTargetView
+ ].
+
+ "Created: / 16-01-2008 / 17:46:08 / cg"
+!
+
+useSketch:aFilename
+ sketchPainter := TOPFileDrawer new.
+ sketchPainter targetView:self.
+ sketchPainter readFile:aFilename.
+ sketchPainter ajustSketch.
+ self invalidate.
+
+ "Created: / 16-01-2008 / 17:46:26 / cg"
+! !
+
!UIPainterView methodsFor:'event handling'!
keyPress:key x:x y:y view:aView
@@ -715,7 +759,7 @@
!
generateActionMethodFor:aspect spec:protoSpec inClass:targetClass
- |selector args showIt code alreadyInSuperclass numArgs method|
+ |selector args showIt codeStream alreadyInSuperclass numArgs method|
selector := aspect asSymbol.
@@ -725,55 +769,76 @@
method := aspect.
numArgs == 1 ifTrue:[
- args := 'anArgument'.
- showIt := ''' , anArgument printString , '' ...''.\'.
+ args := 'anArgument'.
+ showIt := ''' , anArgument printString , '' ...''.'.
] ifFalse:[
- args := ''.
- showIt := ' ...''.\'.
-
- numArgs ~~ 0 ifTrue:[
- method := ''.
-
- selector keywords keysAndValuesDo:[:i :key|
- method := method, key, 'arg', i printString, ' '
- ]
- ]
+ args := ''.
+ showIt := ' ...''.'.
+
+ numArgs ~~ 0 ifTrue:[
+ method := ''.
+
+ selector keywords keysAndValuesDo:[:i :key|
+ method := method, key, 'arg', i printString, ' '
+ ]
+ ]
].
-
- code := '!!' , targetClass name , ' methodsFor:''actions''!!\\' ,
- method , args , '\' ,
- ' "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."\' ,
- '\' .
+ codeStream := WriteStream on:(String new:100).
+ codeStream
+ nextPutLine:('!!',targetClass name,' methodsFor:''actions''!!');
+ nextPutLine:(method,args);
+ nextPutLine:' <resource: #uiCallback>';
+ cr.
+
+ self class generateCommentedCode ifTrue:[
+ codeStream
+ nextPutAll:' "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."
+ "*** (and replace this comment by something more useful ;-)"
+
+'.
+
+ alreadyInSuperclass ifTrue:[
+ codeStream
+ nextPutLine:' "action for ' , aspect , ' is already provided in a superclass."';
+ nextPutLine:' "It may be redefined here..."';
+ cr.
+ ] ifFalse:[
+ codeStream
+ nextPutLine:' "action to be defined here..."';
+ cr.
+ ].
+ ].
+
+ codeStream
+ nextPutAll:' Transcript showCR:self class name, '': '.
alreadyInSuperclass ifTrue:[
- code := code ,
- ' "action for ' , aspect , ' is already provided in a superclass."\' ,
- ' "It may be redefined here ..."\\'.
- ] ifFalse:[
- code := code ,
- ' "action to be added ..."\\'.
+ codeStream
+ nextPutAll:'inherited '.
].
-
- code := code ,
- ' Transcript showCR:self class name, '': '.
- alreadyInSuperclass ifTrue:[
- code := code , 'inherited '.
- ].
- code := code , 'action for ' , aspect , showIt.
+ codeStream
+ nextPutAll:'action for ';
+ nextPutAll:aspect;
+ nextPutLine:showIt.
alreadyInSuperclass ifTrue:[
- code := code ,
- ' super ' , aspect , args , '.\'.
+ codeStream
+ nextPutAll:' super ';
+ nextPutAll:aspect;
+ nextPutAll:args;
+ nextPutLine:'.'.
].
- code := code ,
- '!! !!\\'.
- ^ code withCRs
-
- "Modified: / 25.10.1997 / 19:18:50 / cg"
+ codeStream
+ nextPutLine:'!! !!'; cr.
+
+ ^ codeStream contents.
+
+ "Modified: / 12-01-2008 / 10:21:52 / cg"
!
generateAspectMethodCode
@@ -918,68 +983,87 @@
!
generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass
- |modelClass modelValueString modelValue modelGen code|
+ |modelClass modelValueString modelValue modelGen codeStream|
modelClass := protoSpec defaultModelClassFor:aspect.
modelValueString := protoSpec defaultModelValueStringFor:aspect.
modelValueString notNil ifTrue:[
- modelGen := modelValueString
+ modelGen := modelValueString
] ifFalse:[
- modelValue := protoSpec defaultModelValueFor:aspect.
- modelValue isNil ifTrue:[
- modelGen := modelClass name , ' new'
- ] ifFalse:[
- modelGen := modelValue storeString , ' asValue'
- ].
+ modelValue := protoSpec defaultModelValueFor:aspect.
+ modelValue isNil ifTrue:[
+ modelGen := modelClass name , ' new'
+ ] ifFalse:[
+ modelGen := modelValue storeString , ' asValue'
+ ].
].
- code := '!!' , targetClass name , ' methodsFor:''aspects''!!\\' ,
- aspect , '\' ,
- ' "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 it in the browser."\' ,
- ' "*** (and replace this comment by something more useful ;-)"\' .
-
+ codeStream := WriteStream on:(String new:100).
+ codeStream
+ nextPutLine:('!!' , targetClass name , ' methodsFor:''aspects''!!');
+ nextPutLine:aspect;
+ nextPutLine:' <resource: #uiAspect>';
+ cr.
+
+ self class generateCommentedCode ifTrue:[
+ codeStream
+ nextPutAll:' "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 it in the browser."
+ "*** (and replace this comment by something more useful ;-)"
+
+'.
+ ].
AspectsAsInstances ifTrue:[
- code := code , '\' ,
- ' ' , aspect , ' isNil ifTrue:[\' ,
- ' ' , aspect , ' := ' , modelGen , '.\'.
- modelClass ~~ TriggerValue ifTrue:[
- code := code ,
- '"/ if your app needs to be notified of changes, uncomment one of the lines below:\' ,
- '"/ ' , aspect , ' addDependent:self.\' ,
- '"/ ' , aspect , ' onChangeSend:#', aspect ,'Changed to:self.\'.
- ].
- code := code ,
- ' ].\' ,
- ' ^ ' , aspect ,'.\' ,
- '!! !!\\'
+ codeStream
+ nextPutLine:(' ',aspect,' isNil ifTrue:[');
+ nextPutLine:(' ',aspect,' := ',modelGen,'.').
+
+ modelClass ~~ TriggerValue ifTrue:[
+ self class generateCommentedCode ifTrue:[
+ codeStream
+ nextPutLine:'"/ if your app needs to be notified of changes, uncomment one of the lines below:'.
+ ].
+ codeStream
+ nextPutLine:'"/ ',aspect,' addDependent:self.';
+ nextPutLine:'"/ ',aspect,' onChangeSend:#',aspect,'Changed to:self.'.
+ ].
+ codeStream
+ nextPutLine:' ].';
+ nextPutLine:' ^ ',aspect,'.'.
] ifFalse:[
- code := code , '\' ,
- ' |holder|\' ,
- '\' ,
- ' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' ,
- ' holder := ', modelGen, '.\',
- ' builder aspectAt:#' , aspect , ' put:holder.\'.
- modelClass ~~ TriggerValue ifTrue:[
- code := code ,
- '"/ if your app needs to be notified of changes, uncomment one of the lines below:\' ,
- '"/ holder addDependent:self.\' ,
- '"/ holder onChangeSend:#', aspect ,'Changed to:self.\'.
- ].
- code := code ,
- ' ].\' ,
- ' ^ holder.\' ,
- '!! !!\\'
+ codeStream
+ nextPutLine:(' |holder|');
+ cr;
+ nextPutLine:(' (holder := builder bindingAt:#',aspect,') isNil ifTrue:[');
+ nextPutLine:(' holder := ',modelGen,'.');
+ nextPutLine:(' builder aspectAt:#',aspect,' put:holder.').
+
+ modelClass ~~ TriggerValue ifTrue:[
+ self class generateCommentedCode ifTrue:[
+ codeStream
+ nextPutLine:'"/ if your app needs to be notified of changes, uncomment one of the lines below:'.
+ ].
+ codeStream
+ nextPutLine:'"/ holder addDependent:self.';
+ nextPutLine:'"/ holder onChangeSend:#',aspect,'Changed to:self.'.
+ ].
+ codeStream
+ nextPutLine:' ].';
+ nextPutLine:' ^ holder.'.
].
- ^ code withCRs
-
- "Modified: / 29.7.1998 / 11:29:16 / cg"
- "Modified: / 22.9.1999 / 12:33:47 / stefan"
+ codeStream
+ nextPutLine:'!! !!'; cr.
+"/ self halt.
+ ^ codeStream contents.
+
+ "Modified: / 22-09-1999 / 12:33:47 / stefan"
+ "Modified: / 12-01-2008 / 10:21:43 / cg"
!
generateAspectSelectorsMethod
@@ -1443,6 +1527,64 @@
"Modified: / 15.10.1998 / 11:29:53 / cg"
!
+listOfAspects
+ |cls aspects|
+
+ aspects := IdentitySet new.
+
+ cls := self targetClass.
+ cls notNil ifTrue:[
+ cls methodsDo:[:m |
+ ((m resources ? #()) includesAny:#(uiAspect)) ifTrue:[
+ aspects add:m selector
+ ].
+ ]
+ ].
+
+ treeView propertiesDo:[:aProp|
+ |modelSelector|
+
+ (modelSelector := aProp model) notNil ifTrue:[
+ aspects add:modelSelector asSymbol
+ ].
+
+"/ aspects addAll:aProp spec actionSelectors.
+ aspects addAll:aProp spec valueSelectors.
+ aspects addAll:aProp spec aspectSelectors.
+ ].
+
+ ^ aspects asOrderedCollection sort.
+
+ "Created: / 12-01-2008 / 19:24:45 / cg"
+!
+
+listOfCallbacks
+ |cls aspects|
+
+ aspects := IdentitySet new.
+
+ cls := self targetClass.
+ cls notNil ifTrue:[
+ cls methodsDo:[:m |
+ ((m resources ? #()) includesAny:#(uiCallback)) ifTrue:[
+ aspects add:m selector
+ ].
+ ]
+ ].
+
+ treeView propertiesDo:[:aProp|
+ |modelSelector|
+
+ aspects addAll:aProp spec actionSelectors.
+"/ aspects addAll:aProp spec valueSelectors.
+"/ aspects addAll:aProp spec aspectSelectors.
+ ].
+
+ ^ aspects asOrderedCollection sort.
+
+ "Created: / 12-01-2008 / 19:25:19 / cg"
+!
+
targetClass
|cls|