"

 COPYRIGHT (c) 1995 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

	instanceVariableNames:'fontPanel code viewProperties superclassName className methodName

		categoryName'

	classVariableNames:'HandCursor'

	poolDictionaries:''

	category:'Interface-UIPainter'

!

!UIPainterView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1995 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    not yet finished, not yet published, not yet released.

"

! !

!UIPainterView methodsFor:'accessing'!

className

    ^ className

    "Modified: 5.9.1995 / 18:41:30 / claus"

!

className:aString

    className := aString

    "Modified: 5.9.1995 / 18:47:17 / claus"

!

methodName

    ^ methodName

    "Modified: 5.9.1995 / 18:41:34 / claus"

!

methodName:aString

    methodName := aString

    "Modified: 5.9.1995 / 18:47:27 / claus"

! !

!UIPainterView methodsFor:'builder interface'!

application

    self halt.

    ^ nil

    "Modified: 6.9.1995 / 00:46:44 / claus"

!

aspectAt:aSymbol

    self halt.

    ^ nil

    "Modified: 6.9.1995 / 00:45:35 / claus"

!

createdComponent:newView forSpec:aSpec

    "callBack from UISpec view building"

    |props|

    props := self propertiesForNewView:newView.

    aSpec name notNil ifTrue:[

        props name:aSpec name

    ].

    props labelSelector:(aSpec labelSelector).

    props aspectSelector:(aSpec modelSelector).

    viewProperties add:props.

! !

!UIPainterView methodsFor:'code manipulation'!

changeClass

    |box classNameHolder superclassNameHolder|

    classNameHolder := (className ? 'MyClass') asValue.

    superclassNameHolder := (superclassName ? 'ApplicationModel') asValue.

    box := DialogBox new.

    box addTextLabel:'class:'.

    box addInputFieldOn:classNameHolder.

    box addTextLabel:'super class:'.

    box addInputFieldOn:superclassNameHolder.

    box addAbortButton; addOkButton.

    box open.

    box accepted ifTrue:[

        className := classNameHolder value.

        superclassName := superclassNameHolder value.

    ].

!

changeVariables

    | box names propList p n newName|

    names := VariableArray new.

    propList := VariableArray new.

    viewProperties do:[:props |

        n := props name.

        n notNil ifTrue:[

            names add:n.

            propList add:props

        ]

    ].

    box := BuilderVariablesBox new.

    box list:names.

    box selectAction:[:selection |

        p := propList at:selection

    ].

    box okAction:[

        newName := box enterValue.

Transcript showCR:('renamed ' , (p name) , 'to:' , newName).

        p name:newName

    ].

    box showAtPointer

! !

!UIPainterView methodsFor:'creating subviews'!

addProperties:properties for:aView

    "set properties to a view and add properties to viewProperties.

     In case that properties are nil properties are created

    "

    |name props|

    (props := properties) isNil ifTrue:[

        props := self propertiesForNewView:aView.

    ].

    viewProperties add:props.

    name := props name.

    (aView respondsTo:#label:) ifTrue:[

        aView label:name

    ].

    aView name:name.

  ^ props

!

initializeCreatedObject:anObject

    "set default properties for a created object

    "

    |props|

    props := self addProperties:nil for:anObject.

    self undoCreate:(props identifier).

!

propertiesForNewView:aView

    |cls props index|

    cls := aView class.

    props := ViewProperty new.

    props view:aView.

    props elementClass:cls.

    index := self variableIndexForClass:cls.

    props nameIndex:index.

    props name:(self variableNameForClass:cls index:index).

"/    props initCode:nil.       --- add user-defined init code later

    ^ props

! !

!UIPainterView methodsFor:'cut & paste'!

copySelection

    "copy the selection into the cut&paste-buffer

    "

    |tmp|

    tmp := OrderedCollection new.

    self selectionDo:[:aView||topSpec|

        topSpec := aView specClass 

                        fromView:aView 

                        callBack:[:spec :aSubView | 

                                aSubView geometryLayout:(aSubView geometryLayout copy)

                        ].

        tmp add:topSpec.

    ].

    self setSelection:tmp

!

pasteBuffer

    "add the objects in the paste-buffer

    "

    |sel|

    Transcript showCR:'pasteBuffer'.

    sel := self getSelection.

    self unselect.

    sel do:[:aSpec |

        self createFromSpec:aSpec

    ]

! !

!UIPainterView methodsFor:'draw-object initialization'!

setupCreatedObject

    ^ self

! !

!UIPainterView methodsFor:'generating output'!

generateClassDefinition

    |defCode|

    defCode := superclassName , ' subclass:#' , className , '\'.

    defCode := defCode , '  instanceVariableNames:'''.

    defCode := defCode , self subviewVariableNames , '''\'.

    defCode := defCode , '  classVariableNames:''''\'.

    defCode := defCode , '  poolDictionaries:''''\'.

    defCode := defCode , '  category:''' , categoryName , '''\'.

    defCode := defCode , Character excla asString , '\\'.

    code := code , (defCode withCRs)

!

generateCode

    code := ''.

    (Smalltalk classNamed:className) isNil ifTrue:[

        self generateClassDefinition.

    ].

"/    self generateInitMethod.

    code := code , self generateWindowSpec.

    self generateOutlets.

    ^ code withCRs

    "Modified: 5.9.1995 / 20:57:53 / claus"

! !

!UIPainterView ignoredMethodsFor:'generating output'!

generateInitCodeForGroup:aGroup

    |c name p objects outlets moreCode sym typ val|

    " <name> := <GroupClass> in:<name-of-superview>"

    p := self propertyOfGroup:aGroup.

    name := p at:#variableName.

    c := '  ' , name , ' := ' , (aGroup class name) , ' new.\'.

    code := code , c withCRs.

    " <name> <symbol>:<value>"

    objects := p at:#controlledObjects ifAbsent:[nil].

    objects notNil ifTrue:[

	objects do:[:controlledObject |

	    c := c , name , ' add:' , (self variableNameOf:controlledObject) , '.\'

	]

    ].

    code := code , c withCRs

!

generateInitCodeForOtherStuff

    |g c name p outlets moreCode sym typ val|

    "generate code for groups"

    viewProperties do:[:props |

	g := props at:#group ifAbsent:[nil].

	g notNil ifTrue:[

	    self generateInitCodeForGroup:g

	]

    ]

!

generateInitCodeForView:aView

    |c name p outlets moreCode sym typ val|

    " <name> := <ViewClass> in:<name-of-superview>"

    p := self propertyOfView:aView.

    name := p at:#variableName.

    c := '    ' , name , ' := ' ,

	 (aView class name) , ' in:' , (self variableNameOf:(aView superView)) , '.\'.

    " <name> origin:(...) extent:(...)"

    c := c , '    ' , name , ' origin:(', aView origin printString , ')'

		    , ' extent:(', aView extent printString , ').\'.

    moreCode := p at:#initCode ifAbsent:nil.

    moreCode notNil ifTrue:[

	c := c , moreCode , '\' withCRs

    ].

    code := code , c withCRs.

    " <name> <symbol>:<value>"

    outlets := p at:#outlets ifAbsent:[nil].

    outlets notNil ifTrue:[

	outlets do:[:selectorOutlet |

	    sym := selectorOutlet at:#selector.

	    typ := selectorOutlet at:#type.

	    val := selectorOutlet at:#value.

	    c :=  '    ' , name , ' ' , sym.

	    (typ == #number) ifTrue:[

		c := c , val printString

	    ].

	    (typ == #string) ifTrue:[

		c := c , '''' , val , ''''

	    ].

	    (typ == #text) ifTrue:[

		c := c , '''' , val asString , ''''

	    ].

	    (typ == #strings) ifTrue:[

		c := c , '#( '.

		val asText do:[:aString |

		    c := c , '''' , aString , ''' '

		].

		c := c , ')'

	    ].

	    (typ == #block) ifTrue:[

		c := c , val

	    ].

	    (typ == #color) ifTrue:[

		c := c , '(Color name:''' , val , ''')'

	    ].

	    c := c , '.' , Character cr asString.

	    code := code , c

	]

    ].

    self subviewsOf:aView do:[:v |

	self generateInitCodeForView:v

    ]

    "Modified: 5.9.1995 / 20:06:07 / claus"

!

generateInitMethod

    |defCode|

    defCode := Character excla asString ,

	       className , ' methodsFor:''initialization''' ,

	       Character excla asString , '\\'.

    defCode := defCode , 'initialize\'.

    defCode := defCode , '    super initialize.\'.

    defCode := defCode , '    self setupSubViews.\'.

    defCode := defCode , '    self setupLocalStuff\'.

    defCode := defCode , Character excla asString , '\\'.

    defCode := defCode , 'setupSubViews\'.

    code := code , defCode withCRs.

    self subviewsOf:self do:[:v |

	self generateInitCodeForView:v

    ].

    self generateInitCodeForOtherStuff.

    code := code , '    ^ self\' withCRs.

    defCode := Character excla asString , '\\'.

    defCode := defCode , 'setupLocalStuff\'.

    defCode := defCode , '    ^ self\'.

    defCode := defCode , Character excla asString , ' ' ,

			 Character excla asString , '\\'.

    code := code , defCode withCRs

! !

!UIPainterView methodsFor:'generating output'!

generateOutlets

    ^ self

!

generateWindowSpec

    |spec specArray str|

    subViews remove:inputView.

    [

        spec := FullSpec fromView:self callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec].

    ] valueNowOrOnUnwindDo:[

        subViews addFirst:inputView.

    ].

    specArray := spec literalArrayEncoding.

    str := WriteStream on:String new.

    self prettyPrintSpecArray:specArray on:str indent:5.

    code := Character excla asString 

            , className , ' class methodsFor:''interface specs'''

            , Character excla asString , '\\'

            , methodName , '\'

            , '    "this window spec was automatically generated by the ST/X UIPainter"\\'

            , '    "do not manually edit this - the painter/builder may not be able to\'

            , '     handle the specification if its corrupted."\\'

            , '    "UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '"\'

            , '    "' , className , ' new openInterface:#' , methodName , '"\'.

    methodName = 'windowSpec' ifTrue:[

        code := code , '    "' , className , ' open"\'

    ].

    code := code 

            , '\'

            , '    <resource: #canvas>\\'

            , '    ^\' 

            , '     ', str contents

            , '\'

            , Character excla asString

            , ' '

            , Character excla asString

            , '\\'.

    ^ code withCRs

    "Modified: 5.9.1995 / 21:01:35 / claus"

!

nameOfClass

    ^ 'NewView'

!

outletValueOf:aSymbol for:aView

"/    |c name p outlets moreCode sym typ val|

"/

"/    p := self propertyOfView:aView.

"/    outlets := p at:#outlets ifAbsent:[^ nil].

"/    outlets notNil ifTrue:[

"/        outlets do:[:selectorOutlet |

"/            sym := selectorOutlet at:#selector.

"/            (sym == aSymbol) ifTrue:[

"/                typ := selectorOutlet at:#type.

"/                val := selectorOutlet at:#value.

"/                ^ val

"/            ]

"/        ]

"/    ].

    ^ nil

!

prettyPrintSpecArray:spec on:aStream indent:i

    "just for your convenience: prettyPrint a specArray to aStream - it looks better that way"

    |what oneLine|

    spec isArray ifFalse:[

        spec isLiteral ifTrue:[

            aStream nextPutAll:spec storeString

        ] ifFalse:[

            self halt.

        ].

        ^ self

    ].

    spec isEmpty ifTrue:[

        aStream nextPutAll:'#()'.

        ^ self

    ].

    what := spec at:1.

    what isArray ifTrue:[

        aStream cr; spaces:i+2.