diff -r d6fec8c8e9ce -r 580cac31c444 UIPainterView.st --- 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:' '; + 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:' '; + 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|