"

 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.

"

'From Smalltalk/X, Version:3.1.4 on 25-feb-1997 at 2:17:29 pm'                  !

UIObjectView subclass:#UIPainterView

	instanceVariableNames:'fontPanel viewProperties superclassName className methodName

		categoryName'

	classVariableNames:'HandCursor'

	poolDictionaries:''

	category:'Interface-UIPainter'

!

UIPainterView::ViewProperty subclass:#GroupProperties

	instanceVariableNames:'controlledObjects group'

	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"

!

className

    ^ className

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

!

className:aString

    className := aString

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

!

className:aClassName superclassName:aSuperclassName selector:aSelector

    className := aClassName.

    superclassName := aSuperclassName.

    methodName := aSelector.

!

methodName

    ^ methodName

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

!

methodName:aString

    methodName := aString

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

!

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 ignoredMethodsFor:'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:'copy & cut & paste'!

copySelection

    "copy the selection into the cut&paste-buffer

    "

    |specs|

    specs := self generateSpecFor:selection.

    specs notNil ifTrue:[

        self setSelection:specs

    ].

    self unselect.

!

deleteSelection

    "delete the selection; not into the paste buffer (undo)

    "

    |text|

    self numberOfSelections ~~ 0 ifTrue:[

        text := self transactionTextFor:selection.

        undoHistory transaction:#cut text:text do:[

            super deleteSelection

        ].

    ]

!

pasteBuffer

    "add the objects in the paste-buffer

    "

    |paste builder frame pasteOrigin pasteOffset|

    paste := self getSelection.

    (self canPaste:paste) ifFalse:[ ^ self].

    (paste isCollection)  ifFalse:[ paste := Array with:paste].

    frame := self singleSelection.

    (self supportsSubComponents:frame) ifFalse:[

        frame := self

    ].

    self unselect.

    builder     := UIBuilder new.

    selection   := OrderedCollection new.

    pasteOffset := 0@0.

    pasteOrigin := self sensor mousePoint.

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

    paste do:[:aSpec|

        |view org|

        builder componentCreationHook:[:aView :aSpecification :aBuilder |  

            self createdComponent:aView forSpec:aSpecification builder:aBuilder.

        ].

        builder applicationClass:(Smalltalk classNamed:className).

        view := aSpec buildViewWithLayoutFor:builder in:frame.

        (frame bounds containsPoint:pasteOrigin) ifFalse:[

            self moveObject:view to:pasteOffset.

        ] ifTrue:[

            self moveObject:view to:pasteOrigin + pasteOffset.

        ].

        view realize.

        selection add:view.

        pasteOffset := pasteOffset + 4.

    ].

    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 changed:#tree

! !

!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 specClass basicNew supportsLabel ifTrue:[

        aView label:name

    ].

    aView name:name.

  ^ props

!

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

!

setupCreatedObject:anObject

    "set default properties for a created object

    "

    |props|

    props := self addProperties:nil for:anObject.

    undoHistory transaction:#create text:(props name) do:[

        self undoCreate:(props identifier).

    ].

! !

!UIPainterView methodsFor:'drag & drop'!

canDrop:anObjectOrCollection

    Transcript showCR:'canDrop'.

    ^ true

!

drop:anObjectOrCollection at:aPoint

    Transcript showCR:'drop:anObjectOrCollection at:aPoint'.

! !

!UIPainterView methodsFor:'event handling'!

keyPress:key x:x y:y

    <resource: #keyboard ( #Copy #Paste) >

    key == #Copy ifTrue:[

        ^ self copySelection

    ].

    key == #Paste ifTrue:[

        ^ self pasteBuffer

    ].

    super keyPress:key x:x y:y

! !

!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|

    className isNil ifTrue:[

        ^ self warn:'set the class first'

    ].

    (cls := Smalltalk at:className asSymbol) isNil ifTrue:[

        ^ self warn:'create the class first'

    ].

    code := ''.

    viewProperties do:[:aProp |

        |modelSelector protoSpec thisCode|

        (modelSelector := aProp aspectSelector) 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

            ]

        ]

    ].

    ^ code

! !

!UIPainterView ignoredMethodsFor:'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 , '\\'.

    ^ defCode withCRs

! !

!UIPainterView methodsFor:'generating output'!

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"

! !

!UIPainterView ignoredMethodsFor:'generating output'!

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

        ]

    ].

    code := code , c withCRs