"

 COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG

              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

	instanceVariableNames:'treeView listHolder superclassName className methodName

		categoryName'

	classVariableNames:'HandCursor'

	poolDictionaries:''

	category:'Interface-UIPainter'

!

Object subclass:#ViewProperty

	instanceVariableNames:'view spec identifier'

	classVariableNames:'Identifier'

	poolDictionaries:''

	privateIn:UIPainterView

!

!UIPainterView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG

              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

"

    buildIn view used by the UIPainter; from this view, the layout of the

    new application derives from.

    [see also:]

        UIBuilder

        UIObjectView

    [author:]

        Claus Gittinger

        Claus Atzkern

"

! !

!UIPainterView class methodsFor:'defaults'!

defaultMenuMessage   

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

    "

    ^ #showMiddleButtonMenu

! !

!UIPainterView methodsFor:'accessing'!

application

    ^ 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.

!

findInputViewIn:aSuperView

    "returns index of input view into superview or nil

    "

    aSuperView == self ifTrue:[

        ^ self subViews findFirst:[:v| v == inputView ]

    ].

  ^ 0

!

inputView

    ^ inputView

!

methodName

    ^ methodName

!

methodName:aName

    methodName := aName

!

selectNames:aStringOrCollection

    |prop coll s|

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

        ^ self select:nil

    ].

    (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 select:nil ].

          ^ self select:coll.

        ]

    ].

    prop := self propertyOfName:s.

    prop isNil ifTrue:[^ self select:nil]

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

! !

!UIPainterView methodsFor:'change & update'!

layoutChanged

    treeView layoutChanged

! !

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

copySelection

    "copy the selection into the cut&paste-buffer

    "

    |specs coll|

    coll := self minSetOfSuperViews:(self selection).

    coll notNil ifTrue:[

        self select:nil.

        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

    "

    |specs coll|

    coll := self minSetOfSuperViews:(self selection).

    coll notNil ifTrue:[

        treeView cvsEventsDisabledDo:[

            self select:nil.

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

            self withinTransaction:#cut objects:coll do:[

                coll reverseDo:[:aView|

                    self createUndoRemove:aView.

                    self remove:aView

                ]

            ].

            self setSelection:specs.

        ]

    ]

!

pasteBuffer

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

    "

    |sel|

    sel := self pasteSpecifications:(self getSelection) keepLayout:false.

    sel notNil ifTrue:[

        self select:sel.

    ].

!

pasteSpecifications:aSpecificationOrList keepLayout:keepLayout

    "add the specs to the object view; returns list of pasted components

    "

    ^ self

        pasteSpecifications:aSpecificationOrList 

        keepLayout:keepLayout 

        at:nil

    "Modified: 11.8.1997 / 01:00:35 / cg"

!

pasteSpecifications:aSpecificationOrList keepLayout:keepLayout at:aPointOrNil

    "add the specs to the object view; returns list of pasted components

    "

    |paste frame pasteOrigin pasteOffset builder newSel|

    (self canPaste:aSpecificationOrList) ifFalse:[

        ^ nil

    ].

    treeView cvsSetupListDo:[

        aSpecificationOrList isCollection ifTrue:[

            paste := aSpecificationOrList

        ] ifFalse:[

            paste := Array with:aSpecificationOrList

        ].

        (frame := self singleSelection) isNil ifTrue:[

            frame := self

        ].

        self setSelection:nil withRedraw:true.

        newSel  := OrderedCollection new.

        builder := UIBuilder new.

        className notNil ifTrue:[

            builder applicationClass:(Smalltalk classNamed:className).

        ].

        keepLayout ifFalse:[

            pasteOffset := 0@0.

            aPointOrNil isNil ifTrue:[

                pasteOrigin := self sensor mousePoint.

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

            ] ifFalse:[

                pasteOrigin := aPointOrNil

            ].

        ].

        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.

            newSel add:view.

        ].

        self withinTransaction:#paste objects:newSel do:[

            undoHistory addUndoSelector:#undoCreate:

                               withArgs:(newSel collect:[:v|(self propertyOfView:v) identifier])

        ].

        self realizeAllSubViews.

        inputView raise.

        self elementChangedSize:frame.

    ].

    ^ newSel

!

pasteWithLayout

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

     layout

    "

    |sel|

    sel := self pasteSpecifications:(self getSelection) keepLayout:true.

    sel notNil ifTrue:[

        self select:sel.

    ].

! !

!UIPainterView methodsFor:'drag & drop'!

canDrop:anObjectOrCollection

    anObjectOrCollection size == 1 ifTrue:[

        ^ self canPaste:(anObjectOrCollection first theObject)

    ].

    ^ false

!

canPaste:something

    "returns true if something could be paste

    "

    |el size|

    ((size := self numberOfSelections) <= 1 and:[self enabled]) ifFalse:[

        ^ false

    ].

    something isCollection ifTrue:[something notEmpty ifTrue:[el := something first]]

                          ifFalse:[el := something].

    (el isKindOf:UISpecification) ifFalse:[

        ^ false

    ].

    size == 1 ifTrue:[

        ^ self canPasteInto:(self singleSelection)

    ].

  ^ true

!

canPasteInto:aView

    "can paste into a view

    "

    aView notNil ifTrue:[

    ].

    ^ false

!

drop:anObjectOrCollection at:aPoint

    |spec newSel oldSel dragOffset|

    (oldSel := selection) isCollection ifTrue:[

        oldSel := selection copy

    ].

    spec := (anObjectOrCollection at:1) theObject.

    dragOffset := DragAndDropManager dragOffsetQuerySignal raise.

    newSel := self pasteSpecifications:spec keepLayout:false at:aPoint - dragOffset.

    oldSel isNil ifTrue:[self select:newSel]

                ifFalse:[self select:oldSel]

    "Modified: 11.8.1997 / 16:41:52 / cg"

! !

!UIPainterView methodsFor:'generating output'!

generateActionMethodFor:aspect spec:protoSpec inClass:targetClass

    |args showIt|

    (aspect asSymbol numArgs) == 1 ifFalse:[

        args := '\'.

        showIt := ' ...''.\'.

    ] ifTrue:[

        args := 'anArgument\'.

        showIt := ''' , anArgument printString , '' ...''.\'.

    ].

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

      aspect , args ,

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

      '\' ,

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

      '    Transcript showCR:self class name , '': action for ' , aspect , showIt ,

      '!! !!\\') withCRs

!

generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass

    |modelClass|

    modelClass := protoSpec defaultModelClassFor:aspect.

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

      aspect , '\' ,

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

      '\' ,

      '    |holder|\' ,

      '\' ,

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

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

      '    ].\' ,

      '    ^ holder\' ,

      '!! !!\\') withCRs

!

generateAspectMethods

    |cls code skip|

    code := ''.

    className isNil ifTrue:[

        self warn:'set the class first'.

        ^ code

    ].

    cls := Smalltalk classNamed:className.

    treeView propertiesDo:[:aProp |

        |modelSelector menuSelector protoSpec thisCode|

        protoSpec := aProp spec.

        (modelSelector := aProp model) notNil ifTrue:[

            (cls implements:modelSelector asSymbol) ifFalse:[

                skip := false.

                (cls isSubclassOf:SimpleDialog) ifTrue:[

                    skip := SimpleDialog implements:modelSelector asSymbol

                ].

                skip ifFalse:[

                    "/ 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:[

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

                code := code , thisCode

            ]

        ].

        aProp spec aspectSelectors do:[:aSel|

            (cls implements:aSel asSymbol) ifFalse:[

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

                code := code , thisCode

            ]

        ].

        aProp spec actionSelectors do:[:aSel|

            (cls implements:aSel asSymbol) ifFalse:[

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

                code := code , thisCode

            ]

        ].

        aProp spec valueSelectors do:[:aSel|

            (cls implements:aSel asSymbol) ifFalse:[

                thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls).

                code := code , thisCode

            ]

        ].

    ].

    ^ code

!

generateValueMethodFor:aspect spec:protoSpec inClass:targetClass

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

      aspect , '\' ,

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

      '\' ,

      '    "value to be added below ..."\' ,

      '    Transcript showCR:self class name , '': no value yet for ' , aspect , ' ...''.\' ,