"

 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.

"

UIObjectView subclass:#UIPainterView

	classVariableNames:'HandCursor'

	poolDictionaries:''

	category:'Interface-UIPainter'

!

Object subclass:#ViewProperty

	instanceVariableNames:'view spec identifier'

	classVariableNames:'Identifier'

	poolDictionaries:''

	privateIn:UIPainterView

!

UIPainterView::ViewProperty subclass:#GroupProperties

	instanceVariableNames:'controlledObjects group name'

	classVariableNames:''

	poolDictionaries:''

	privateIn:UIPainterView

!

!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 class methodsFor:'defaults'!

defaultMenuMessage   

    "This message is the default yo be sent to the menuHolder to get a menu

    "

    ^ #menu

! !

!UIPainterView methodsFor:'accessing'!

application

    self halt.

    ^ nil

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

!

applicationName

    ^ self className

!

applicationName:aName

    self className:aName

!

className

    ^ className

!

className:aName

    className := aName

!

className:aClassName superclassName:aSuperclassName selector:aSelector

    className      := aClassName.

    superclassName := aSuperclassName.

    methodName     := aSelector.

!

methodName

    ^ methodName

!

methodName:aName

    methodName := aName

!

selectNames:aStringOrCollection

    |prop coll s|

    (aStringOrCollection isNil or:[aStringOrCollection isEmpty]) ifTrue:[

        ^ self unselect

    ].

    (s := aStringOrCollection) isString ifFalse:[

        s size == 1 ifTrue:[

            s := s first

        ] ifFalse:[

            coll := OrderedCollection new.

            s do:[:aName|

                (prop := self propertyOfName:aName) notNil ifTrue:[

                    coll add:(prop view)

                ]

            ].

            coll size == 1 ifTrue:[ ^ self select:(coll at:1) ].

            coll size == 0 ifTrue:[ ^ self unselect ].

          ^ self select:coll.

        ]

    ].

    prop := self propertyOfName:s.

    prop isNil ifTrue:[^ self unselect]

              ifFalse:[^ self select:(prop view)]

! !

!UIPainterView methodsFor:'copy & cut & paste'!

copySelection

    "copy the selection into the cut&paste-buffer

    "

    |specs coll|

    coll := self minSetOfSuperViews:selection.

    coll notNil ifTrue:[

        self unselect.

        specs := coll collect:[:aView| self fullSpecFor:aView ].

        self setSelection:specs

    ].

!

deleteSelection

    "delete the selection; copy the selection into the cut&paste-buffer

     and open a transaction

    "

    |text specs coll|

    coll := self minSetOfSuperViews:selection.

    coll notNil ifTrue:[

        self unselect.

        specs := coll collect:[:aView| self fullSpecFor:aView ].

        text  := self transactionTextFor:coll.

        undoHistory transaction:#cut text:text do:[

            coll reverseDo:[:o||p|

                (p := self propertyOfView:o) notNil ifTrue:[

                    self undoRemove:(p identifier)

                ].

                self remove:o

            ]

        ].

        self setSelection:specs.

        self changed:#tree.

    ]

!

pasteBuffer

    "add the objects in the paste-buffer to the object view

    "

    self pasteSpecifications:(self getSelection) keepLayout:false

!

pasteSpecifications:aSpecificationOrList keepLayout:keepLayout

    "add the specs to the object view

    "

    |paste frame pasteOrigin pasteOffset builder|

    (self canPaste:aSpecificationOrList) ifFalse:[

        ^ self

    ].

    aSpecificationOrList isCollection ifTrue:[

        paste := aSpecificationOrList

    ] ifFalse:[

        paste := Array with:aSpecificationOrList

    ].

    frame := self singleSelection.

    (self canPasteInto:frame) ifFalse:[

        frame := self

    ].

    self unselect.

    selection := OrderedCollection new.

    builder   := UIBuilder new.

    keepLayout ifFalse:[

        pasteOffset := 0@0.

        pasteOrigin := self sensor mousePoint.

        pasteOrigin := device translatePoint:pasteOrigin from:device rootView id to:frame id.

    ].

    paste do:[:aSpec|

        |view|

        view := self addSpec:aSpec builder:builder in:frame.

        keepLayout ifFalse:[

            (frame bounds containsPoint:pasteOrigin) ifFalse:[

                self moveObject:view to:pasteOffset.

            ] ifTrue:[

                self moveObject:view to:pasteOrigin + pasteOffset.

            ].

            pasteOffset := pasteOffset + 4

        ].

        view realize.

        selection add:view.

    ].

    self transaction:#paste selectionDo:[:v|

        self undoCreate:((self propertyOfView:v) identifier)

    ].

    selection size == 1 ifTrue:[

        selection := selection at:1

    ].

    self showSelection.

    self realizeAllSubViews.

    inputView raise.

    self elementChangedSize:frame.

    self changed:#tree

    "Modified: 8.4.1997 / 01:08:15 / cg"

!

pasteWithLayout

    "add the objects in the paste-buffer to the object view; don't change the

     layout

    "

    self pasteSpecifications:(self getSelection) keepLayout:true

! !

!UIPainterView methodsFor:'drag & drop'!

canDrop:anObjectOrCollection

    |spec|

    testMode ifFalse:[

        anObjectOrCollection size == 1 ifTrue:[

            spec := (anObjectOrCollection at:1) theObject.

            ^ (spec isKindOf:UISpecification)

        ]

    ].

    ^ false

    "Modified: 8.4.1997 / 01:01:50 / cg"

!

drop:anObjectOrCollection at:aPoint

    |spec|

    spec := (anObjectOrCollection at:1) theObject.

    self pasteSpecifications:spec keepLayout:false.

! !

!UIPainterView methodsFor:'generating output'!

generateActionMethodFor:aspect spec:protoSpec inClass:targetClass

    ^ ('!!' , targetClass name , ' methodsFor:''actions''!!\\' ,

      aspect , '\' ,

      '    "automatically generated by UIPainter ..."\' ,

      '\' ,

      '    "action to be added ..."\' ,

      '    Transcript showCR:''action for ' , aspect , ' ...''.\' ,

      '!! !!\\') withCRs

!

generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass

    ^ ('!!' , targetClass name , ' methodsFor:''aspects''!!\\' ,

      aspect , '\' ,

      '    "automatically generated by UIPainter ..."\' ,

      '\' ,

      '    |holder|\' ,

      '\' ,

      '    (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' ,

      '        builder aspectAt:#' , aspect , ' put:(holder := ' , ' ValueHolder new' , ').\' ,

      '    ].\' ,

      '    ^ holder\' ,

      '!! !!\\') withCRs

!

generateAspectMethods

    |cls code|

    code := ''.

    className isNil ifTrue:[

        self warn:'set the class first'.

        ^ code

    ].

    cls := Smalltalk classNamed:className.

    viewProperties do:[:aProp |

        |modelSelector menuSelector protoSpec thisCode|

        (modelSelector := aProp model) notNil ifTrue:[

            (cls implements:modelSelector asSymbol) ifFalse:[

                protoSpec := aProp view specClass basicNew.

                "/ kludge ..

                (protoSpec isMemberOf:ActionButtonSpec) ifTrue:[

                    thisCode := (self generateActionMethodFor:modelSelector spec:protoSpec inClass:cls).

                ] ifFalse:[

                    thisCode := (self generateAspectMethodFor:modelSelector spec:protoSpec inClass:cls).

                ].

                code := code , thisCode

            ].

        ].

        (menuSelector := aProp menu) notNil ifTrue:[

            (cls implements:menuSelector asSymbol) ifFalse:[

                protoSpec := aProp view specClass basicNew.

                "/ kludge ..

                thisCode := (self generateAspectMethodFor:menuSelector spec:protoSpec inClass:cls).

                code := code , thisCode

            ]

        ]

    ].

    ^ code

!

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 , '\\'.

    ^ defCode withCRs

!

generateCode

    "generate code for the windowSpec method"

    |code|

    code := ''.

"/    (Smalltalk classNamed:className asSymbol) isNil ifTrue:[

"/        code := code , self generateClassDefinition.

"/    ].

"/    code := code , self generateInitMethod.

    code := code , self generateWindowSpecMethodSource.

"/    code := code , self generateAspectMethods.

    ^ code withCRs

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

!

generateInitCodeForGroup:aGroup

    |code c name p objects outlets moreCode sym typ val|

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

    code := ''.

    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 uniqueNameOf:controlledObject) , '.\'

        ]

    ].

    code := code , c withCRs

!

generateInitCodeForOtherStuff

    |code g c name p outlets moreCode sym typ val|

    code := ''.

    "generate code for groups"

    viewProperties do:[:props |

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

        g notNil ifTrue:[

            code := code , (self generateInitCodeForGroup:g)

        ]

    ].

    ^ code

!

generateInitCodeForView:aView

    |code c name p outlets moreCode sym typ val|

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

    code := ''.

    p := self propertyOfView:aView.

    name := p at:#variableName.

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

         (aView class name) , ' in:' , (self uniqueNameOf:(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 , ''')'

            ].