UIPainterView.st
changeset 2244 580cac31c444
parent 2231 ae58d3ccbbfd
child 2248 720b0784c6f2
--- 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|