"
 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 handleColor handleMasterColor'
	classVariableNames:'HandCursor RedefineAspectMethods'
	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:'code generation mode'!

redefineAspectMethods
    "redefine methods yes or no. If a method is defined in super class
     should the message be reinstalled ?
    "
    ^ RedefineAspectMethods ? false

!

redefineAspectMethods:aBoolean
    "redefine methods yes or no. If a method is defined in super class
     should the message be reinstalled ?
    "
    RedefineAspectMethods := aBoolean


! !

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

    sel := treeView selection.

    coll := self minSetOfSuperViews:(self selection).

    coll notNil ifTrue:[
"/        self select:nil.
        specs := coll collect:[:aView| self fullSpecFor:aView ].
        self setSelection:specs.
"/        treeView selection: sel
    ].


!

deleteSelection
    "cut 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.
            treeView selection: (Array with: 1)
        ]
    ]
!

deleteTotalSelection
    "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 remove:aView
                ]
            ].
            treeView selection: (Array with: 1)
        ]
    ]
!

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

!

pasteFromClipBoard:aString
    ^ self


!

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

    (self canPaste:aSpecificationOrList) ifFalse:[
        ^ nil
    ].

    aSpecificationOrList isCollection ifTrue:[
        paste := aSpecificationOrList
    ] ifFalse:[
        paste := Array with:aSpecificationOrList
    ].
    (frame := self singleSelection) isNil ifTrue:[
        frame := self
    ].
    self selection:nil.

    newSel  := OrderedCollection new.
    builder := UIBuilder new isEditing:true.

    className notNil ifTrue:[
        builder applicationClass:(self resolveName: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 := device translatePoint:aPointOrNil
                                            from:self id
                                              to:frame id.
        ]
    ].
    keepLayout ifFalse:[
        bounds := Rectangle origin:0@0 extent:(frame bounds extent)
    ].

    paste do:[:aSpec|
        |view|

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

        keepLayout ifFalse:[
            (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.
    newSel do:[:v| v raise].
    inputView raise.
    self elementChangedSize:frame.

    newSel size == 1 ifTrue:[newSel := newSel at:1].
    ^ 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:something
    "returns true if something can be droped
    "      
    (something size == 1 and:[self enabled and:[self numberOfSelections <= 1]]) ifTrue:[
      ^ something first theObject isKindOf:UISpecification
    ].
    ^ false
!

canPaste
    "returns true if something to be past exists and can be paste into
     the selection if exists
    "
    ^ self canPaste:(self getSelection)
!

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
    "
    |prop|

    aView notNil ifTrue:[
        (prop := self propertyRespondsToView:aView) notNil ifTrue:[
            ^ prop spec class supportsSubComponents
        ].
      ^ aView specClass supportsSubComponents.
    ].
    ^ false

!

drop:anObjectOrCollection at:aPoint
    |spec newSel oldSel dragOffset|

    self selection notNil ifTrue:[
        oldSel := self singleSelection.

        (self canPasteInto:oldSel) ifFalse:[
            oldSel := nil.
            self setSelection:nil withRedraw:true
        ]
    ].
    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]
! !

!UIPainterView methodsFor:'event handling'!

keyPress:key x:x y:y view:aView
    "a delegated keyEvent from aView"

    self keyPress:key x:x y:y

    "Modified: / 31.10.1997 / 20:27:22 / cg"
!

keyRelease:key x:x y:y view:aView
    "a delegated keyEvent from aView"

    self keyRelease:key x:x y:y

    "Modified: / 31.10.1997 / 20:27:32 / cg"
!

sizeChanged:how

    super sizeChanged:how. 

    self layoutChanged
! !

!UIPainterView methodsFor:'generating output'!

aspectMethods
    "extract a list of aspect methods - for browsing"

    |cls methods skip selector protoSpec|

    className isNil ifTrue:[
        self warn:'set the class first'.
        ^ #()
    ].

    cls := self resolveName:className.
    methods := IdentitySet new.

    treeView propertiesDo:[:aProp|
        |selector|

        (selector := aProp model) notNil ifTrue:[
            selector isArray ifFalse:[
                selector := selector asSymbol.
                (cls implements:selector) ifTrue:[
                    skip := false.
                    (cls isSubclassOf:SimpleDialog) ifTrue:[
                        skip := SimpleDialog implements:selector asSymbol
                    ].
                    skip ifFalse:[
                        methods add:(cls compiledMethodAt:selector)
                    ].
                ].
            ].
        ].

        (selector := aProp menu) notNil ifTrue:[
            selector isArray ifFalse:[
                selector := selector asSymbol.
                (cls implements:selector) ifTrue:[
                    methods add:(cls compiledMethodAt:selector)
                ]
            ].
        ].

        (aProp spec aspectSelectors) do:[:aSel |
            |selector|

            aSel isArray ifFalse:[
                selector := aSel asSymbol.
                (cls implements:selector) ifTrue:[
                    methods add:(cls compiledMethodAt:selector)
                ]
            ].
        ].
        aProp spec actionSelectors do:[:aSel|
            |selector|

            aSel isArray ifFalse:[
                selector := aSel asSymbol.
                (cls implements:selector) ifTrue:[
                    methods add:(cls compiledMethodAt:selector)
                ]
            ].
        ].
        aProp spec valueSelectors do:[:aSel|
            |selector|

            aSel isArray ifFalse:[
                selector := aSel asSymbol.
                (cls implements:selector) ifTrue:[
                    methods add:(cls compiledMethodAt:selector)
                ]
            ].
        ]
    ].

    protoSpec := treeView canvasSpec.

    (selector := protoSpec menu) notNil ifTrue:[
        selector isArray ifFalse:[
            selector := selector asSymbol.
            (cls implements:selector) ifTrue:[
                methods add:(cls compiledMethodAt:selector)
            ]
        ].
    ].

    ^ methods

    "Created: / 25.10.1997 / 18:58:25 / cg"
    "Modified: / 26.10.1997 / 15:06:18 / cg"
!

generateActionMethodFor:aspect spec:protoSpec inClass:targetClass
    |selector args showIt code alreadyInSuperclass numArgs method|

    selector := aspect asSymbol.

    alreadyInSuperclass := targetClass superclass canUnderstand:selector.

    numArgs := selector numArgs.
    method  := aspect.

    numArgs == 1 ifTrue:[
        args := 'anArgument'.
        showIt := ''' , anArgument printString , '' ...''.\'.
    ] ifFalse:[    
        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."\' ,
                '\' .

    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 ..."\\'.
    ].

    code := code ,
                '    Transcript showCR:self class name, '': '.
    alreadyInSuperclass ifTrue:[
        code := code , 'inherited '.
    ].
    code := code , 'action for ' , aspect , showIt.

    alreadyInSuperclass ifTrue:[
        code := code ,
                        '    super ' , aspect , args , '.\'.
    ].

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

    "Modified: / 25.10.1997 / 19:18:50 / cg"
!

generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass
    |modelClass modelValue modelGen code|

    modelClass := protoSpec defaultModelClassFor:aspect.
    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 in the browser."\'.

    code := (code ,
      '\' ,
      '    |holder|\' ,
      '\' ,
      '    (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' ,
      '        builder aspectAt:#' , aspect , ' put:(holder := ' , ' ' , modelGen , ').\' ,
      '    ].\' ,
      '    ^ holder\' ,
      '!! !!\\') withCRs.
    ^ code

    "Modified: / 26.10.1997 / 19:01:15 / cg"
!

generateAspectMethods
    "generate aspect, action & menu methods
     - but do not overwrite existing ones.
     Return a string ready to compile into the application class."

    |cls code skip menuSelector protoSpec thisCode|

    code := ''.

    className isNil ifTrue:[
        self warn:'Set first the class!!'.
        ^ code
    ].

    (cls := self resolveName:className) isNil ifTrue:[
        self warn:'Class ', className asString, ' does not exist!!'.
        ^ code
    ].

    treeView propertiesDo:[:aProp|
        |modelSelector menuSelector|

        protoSpec := aProp spec.

        (modelSelector := aProp model) notNil ifTrue:[
            self generateCodeFrom:(Array with:modelSelector) in:cls
                do:[:aSel|
                    skip := false.

                    (cls isSubclassOf:SimpleDialog) ifTrue:[
                        skip := SimpleDialog implements:aSel asSymbol
                    ].

                    skip ifFalse:[
                        "/ kludge ..
                        "/ (protoSpec isKindOf:ActionButtonSpec) 
                        (protoSpec defaultModelIsCallBackMethodSelector:aSel)
                        ifTrue:[
                            thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
                        ] ifFalse:[
                            thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
                        ].
                        code := code, thisCode
                    ]
                ]
        ].

        self generateCodeFrom:(aProp spec aspectSelectors) in:cls
                do:[:aSel|
                    thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
                    code := code , thisCode
                ].

        self generateCodeFrom:(aProp spec actionSelectors) in:cls
                do:[:aSel|
                    thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
                    code := code , thisCode
                ].

        self generateCodeFrom:(aProp spec valueSelectors) in:cls
                do:[:aSel|
                 "/ uppercase: - assume its a globals name.
                    aSel first isUppercase ifFalse:[
                        thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls).
                        code := code , thisCode
                    ]
                ].
    ].

    ^ code

    "Modified: / 21.4.1998 / 20:23:48 / cg"
!

generateCodeFrom:aListOfSelectors in:aClass do:aBlock

    self class redefineAspectMethods ifTrue:[
        aListOfSelectors do:[:aSelector|
            (aSelector isArray or:[aClass implements:aSelector]) ifFalse:[
                aBlock value:aSelector
            ]
        ]
    ] ifFalse:[
        aListOfSelectors do:[:aSelector|
            (aSelector isArray or:[aClass canUnderstand:aSelector]) ifFalse:[
                aBlock value:aSelector
            ]
        ]
    ]


!

generateHookMethodFor:selectorSpec comment:commentWhen note:noteOrNil defaultCode:defaultCode inClass:targetClass
    ^ ('!!' , targetClass name , ' methodsFor:''hooks''!!\\' ,
      selectorSpec , '\' ,
      '    "automatically generated by UIPainter ..."\\' ,
      '    "*** the code here does nothing. It is invoked when"\' ,
      '    "*** ' , commentWhen , '"\' ,
      '    "*** Please change as required and accept in the browser."\' ,
      '\' ,
      '    "specific code to be added below ..."\' ,
      '    "' , (noteOrNil ? '') , '"\' ,
      '\' ,
      (defaultCode ? '^ self.') ,
      '!! !!\\') withCRs

    "Modified: / 25.10.1997 / 19:22:17 / cg"
    "Created: / 31.10.1997 / 17:31:53 / cg"
!

generateHookMethods
    "generate hook methods
     - but do not overwrite existing ones.
     Return a string ready to compile into the application class."

    |cls code skip menuSelector protoSpec thisCode|

    code := ''.

    className isNil ifTrue:[
        self warn:'set the class first'.
        ^ code
    ].
    cls := self resolveName:className.

    code := code , (self generateHookMethodsInClass:cls).

    ^ code

    "Created: / 31.10.1997 / 17:21:29 / cg"
    "Modified: / 31.10.1997 / 17:38:11 / cg"
!

generateHookMethodsInClass:targetClass
    |code|

    code := ''.

    (targetClass implements:#postBuildWith:) ifFalse:[
        code := code 
                , (self 
                    generateHookMethodFor:'postBuildWith:aBuilder'
                    comment:'the widgets have been built, but before the view is opened'
                    note:'or after the super send'
                    defaultCode:'    super postBuildWith:aBuilder'
                    inClass:targetClass)
    ].
    (targetClass implements:#postOpenWith:) ifFalse:[
        code := code 
                , (self 
                    generateHookMethodFor:'postOpenWith:aBuilder'
                    comment:'the topView has been opened, but before events are dispatched for it'
                    note:'or after the super send'
                    defaultCode:'    super postOpenWith:aBuilder'
                    inClass:targetClass)
    ].
    (targetClass implements:#closeRequest) ifFalse:[
        code := code 
                , (self 
                    generateHookMethodFor:'closeRequest'
                    comment:'the topView has been asked to close'
                    note:'return without the ''super closeRequest'' to stay open'
                    defaultCode:'    ^super closeRequest'
                    inClass:targetClass)
    ].
    ^ code

    "Modified: / 31.10.1997 / 17:30:34 / cg"
    "Created: / 31.10.1997 / 17:32:49 / cg"
!

generateValueMethodFor:aspect spec:protoSpec inClass:targetClass
    ^ ('!!' , targetClass name , ' methodsFor:''values''!!\\' ,
      aspect , '\' ,
      '    "automatically generated by UIPainter ..."\\' ,
      '    "*** the code below returns a default value when invoked."\' ,
      '    "*** (which may not be the one you wanted)"\' ,
      '    "*** Please change as required and accept in the browser."\' ,
      '\' ,
      '    "value to be added below ..."\' ,
      '    Transcript showCR:self class name , '': no value yet for ' , aspect , ' ...''.\' ,
      '\' ,
      '^ nil.' ,
      '!! !!\\') withCRs

    "Modified: / 25.10.1997 / 19:22:17 / cg"
!

generateWindowSpecMethodSource
    |spec str code category cls mthd specCode|

    spec := OrderedCollection new.

    self subViews do:[:aView|
        aView ~~ inputView ifTrue:[
            spec add:(self fullSpecFor:aView)
        ]
    ].
    spec := treeView generateFullSpecForComponents:spec.
    str  := WriteStream on:String new.
    UISpecification prettyPrintSpecArray:spec on:str indent:5.
    specCode := str contents.

    (specCode includes:$!!) ifTrue:[
        "/ oops - must be chunk format ...
        str  := WriteStream on:String new.
        str nextPutAllAsChunk:specCode.
        specCode := str contents.
    ].

    "/ if that method already exists, do not overwrite the category

    category := 'interface specs'.
    cls := self resolveName:className.

    cls notNil ifTrue:[
        (mthd := cls class compiledMethodAt:methodName asSymbol) notNil ifTrue:[
            category := mthd category.
        ]
    ].

    code := '!!'
            , className , ' class methodsFor:' , category storeString
            , '!!' , '\\'

            , methodName , '\'
            , ((ResourceSpecEditor codeGenerationCommentForClass: UIPainter) replChar:$!! withString:'!!!!')
            , '\\    "\'
            , ('     UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '\')
            , ('     ' , className , ' new openInterface:#' , methodName , '\')
            ,(methodName = 'windowSpec' 
                ifTrue:['     ' , className , ' open\'] ifFalse: [''])
            , '    "\'.

    code := code 
            , '\'
            , '    <resource: #canvas>\\'
            , '    ^\' 
            , '     ', specCode
            , '\'
            , '!! !!'
            , '\\'.

    ^ code withCRs

    "Modified: 5.9.1995 / 21:01:35 / claus"
    "Modified: 24.6.1997 / 19:12:44 / cg"
! !

!UIPainterView methodsFor:'grid manipulation'!

newGrid
    "define a new grid - this is a private helper which has to be
     called after any change in the grid. It (re)creates the gridPixmap,
     clears the view and redraws all visible objects."

    |defaultViewBackground|

    gridPixmap := nil.
    defaultViewBackground := self class defaultViewBackgroundColor.

    shown ifTrue:[
        self viewBackground: (defaultViewBackground isColor
            ifTrue: [defaultViewBackground]
            ifFalse:[Black]).
        self clear.
    ].

    gridShown ifTrue:[
        self defineGrid.
        gridPixmap colorMap: (defaultViewBackground isColor
            ifTrue: [Array with:defaultViewBackground with:Color darkGray]
            ifFalse:[Array with:White with:Black]).
        self viewBackground:gridPixmap.
    ].

    self invalidate

! !

!UIPainterView methodsFor:'initialization'!

create
    "colors on device
    "
    super create.

    handleColor       := handleColor on:device.
    handleMasterColor := handleMasterColor on:device.
!

initialize
    "setup attributes
    "
    super initialize.
    superclassName    := 'ApplicationModel'.
    className         := 'NewApplication'.
    methodName        := 'windowSpec'.
    categoryName      := 'Applications'.
    HandCursor        := Cursor leftHand.
    handleColor       := Color black.
    handleMasterColor := Color red.

    self backgroundColor: self class defaultViewBackgroundColor.
!

setupFromSpec:specOrSpecArray

    |spec builder|

    Cursor wait showWhile: [
        self removeAll.
        spec    := UISpecification from:specOrSpecArray.
        builder := UIBuilder new isEditing:true.
        "set applicationClass, in order that subspecifications may be resolved"
        className notNil ifTrue:[
            builder applicationClass:(self resolveName:className).
        ].
        spec window setupView:self topView for:builder.
        self addSpec:(spec component) builder:builder in:self.
        self realizeAllSubViews.
        inputView raise.
        treeView setAttributesFromWindowSpec:(spec window)
    ]

!

treeView:aTreeView
    treeView := aTreeView.

    treeView delegate:(
        "/
        "/ I want to handle everything typed
        "/ in the treeView, except for Return and Cursor-keys
        "/
        KeyboardForwarder 
            toView:self
            condition:nil
            filter:[:k | (k isSymbol 
                         and:[k ~~ #Return 
                         and:[(k startsWith:#Cursor) not]])
                   ]
    )

    "Modified: / 31.10.1997 / 20:22:09 / cg"
! !

!UIPainterView methodsFor:'menus'!

showMiddleButtonMenu
    "show the middle button menu; this returns nil
    "
    self enabled ifTrue:[
        (MenuPanel fromSpec:(UIPainter menuEdit) receiver:self superView application) startUp
    ].
  ^ nil



! !

!UIPainterView methodsFor:'private handles'!

showSelected:aComponent
    "show object selected
    "
    |wasClipped|

    selectionHiddenLevel == 0 ifTrue:[
        (treeView selection size > 1 and: 
        [(treeView model list at: treeView selection first) contents view == aComponent])
            ifTrue: [self paint: handleMasterColor]
            ifFalse:[self paint: handleColor].

        (wasClipped := clipChildren) ifTrue:[
            self clippedByChildren:(clipChildren := false). 
        ].

        self handlesOf:aComponent do:[:rectangle :what|
            what == #view ifTrue:[self displayRectangle:rectangle]
                         ifFalse:[self fillRectangle:rectangle]
        ].

        wasClipped ifTrue:[
            self clippedByChildren:(clipChildren := true).
        ]
    ]


! !

!UIPainterView methodsFor:'queries'!

resolveName:aName
    |appl|

    appl := self application.

    appl notNil ifTrue:[
        ^ appl resolveName:aName
    ].
    ^ Smalltalk resolveName:aName inClass:self class
! !

!UIPainterView methodsFor:'removing components'!

remove:anObject
    "remove anObject from the contents do redraw
    "
    anObject notNil ifTrue:[
        treeView removeView:anObject.
    ]
!

removeAll
    "remove all objects and properties
    "
    self select:nil.
    treeView removeAll.
    self removeUndoHistory.
! !

!UIPainterView methodsFor:'searching'!

findContainerOfView:aView
    "returns the super view assigned to a view
    "
    |p|

    (p := self propertyOfParentForView:aView) isNil ifTrue:[
        ^ self
    ].
    ^ p view
!

findObjectAt:aPoint
    "find the origin/corner of the currentWidget
    "
    |view prop|

    view := super findObjectAt:aPoint.
    prop := self propertyRespondsToView:view.

    prop notNil ifTrue:[^ prop view].
  ^ nil
!

findViewWithId:aViewId
    "finds view assigned to identifier and returns the view or nil
    "
    |prop|

    prop := self propertyOfIdentifier:aViewId.

    prop notNil ifTrue:[^ prop view]
               ifFalse:[^ nil]
!

propertyOfIdentifier:anId
    "returns property assigned to unique identifier
    "
    anId notNil ifTrue:[
        ^ treeView propertyDetect:[:p| p identifier == anId ]
    ].
    ^ nil
!

propertyOfName:aString
    "returns property assigned to name
    "
    |name|

    aString isNil ifFalse:[
        name := aString string withoutSeparators.
      ^ treeView propertyDetect:[:p| p name = name ].
    ].
    ^ nil
!

propertyOfParentForView:aSubView
    "returns the property of the parent or nil
    "
    |item|

    (item := treeView detectItemRespondsToView:aSubView) notNil ifTrue:[
        (item := item parent) notNil ifTrue:[^ item contents]
    ].
    ^ nil
!

propertyOfView:aView
    "returns property assigned to view
    "
    (aView isNil or:[aView == self]) ifFalse:[
        ^ treeView propertyDetect:[:p| p view == aView ]
    ].
    ^ nil
!

propertyRespondsToView:aView
    "detect the property responding to the argument a view. The property of the view or
     the first subview providing the properties is returned. If no property is detected
     nil is returned.
    "
    |item|

    item := treeView detectItemRespondsToView:aView.

    (item notNil and:[item parent notNil]) ifTrue:[
        ^ item contents
    ].
    ^ nil
!

uniqueNameFor:aSpecOrString
    "generate and return an unique name for a class
    "
    |next name size|

    aSpecOrString isString ifFalse:[name := aSpecOrString userFriendlyName]
                            ifTrue:[name := aSpecOrString].

    size  := name size + 1.
    next  := 0.

    treeView propertiesDo:[:p|
        |n|
        n := p name.

        (n size >= size and:[n startsWith:name]) ifTrue:[
            next := next max:(p extractNumberStartingAt:size)
        ]
    ].
    next := next + 1.
    name := name, next printString.
  ^ name




!

uniqueNameOf:aView
    |prop|

    (prop := self propertyOfView:aView) notNil ifTrue:[
        prop name isNil ifTrue:[
            prop name:(self uniqueNameFor:(prop spec)).
        ].
        ^ prop name
    ].
    ^ 'self'

! !

!UIPainterView methodsFor:'selection basics'!

addToSelection:anObject
    "add an object to the selection
    "
    (self enabled and:[(self isSelected:anObject) not]) ifTrue:[
        selection isCollection ifFalse:[
            selection isNil ifTrue:[
                selection := anObject
            ] ifFalse:[
                selection := OrderedCollection with:selection with:anObject
            ]
        ] ifTrue:[
            selection add:anObject
        ].
        self showSelected:anObject.
        treeView cvsSelectionAdd:anObject.
    ]


!

removeFromSelection:anObject
    "remove an object from the selection
    "
    (self isSelected:anObject) ifTrue:[
        self showUnselected:anObject.

        selection size > 1 ifTrue:[
            selection remove:anObject ifAbsent:nil.
            self showSelection.
        ] ifFalse:[
            selection := nil
        ].
        treeView cvsSelectionRemove:anObject.
    ]

!

select:something
    "change selection to something
    "
    (self enabled and:[something ~= self selection]) ifTrue:[   
        something isNil 
            ifTrue: [treeView selection: (Array with: 1)]
            ifFalse:[treeView cvsSelection:something].
        self setSelection:something withRedraw:true
    ]

!

updateSelectionFromModel:aSelOrNil
    "update selection from a new selection
    "
    |aSet|

    selectionHiddenLevel == 0 ifTrue:[
        aSelOrNil size ~~ 0 ifTrue:[
            self selectionDo:[:el|
                (aSelOrNil includes:el) ifFalse:[
                    aSet isNil ifTrue:[
                        aSet := IdentitySet new
                    ].
                    self showUnselected:el addAffectedViewsTo:aSet.
                ] 
            ].
            self handleAffectedViews:aSet.
        ] ifFalse:[
            self hideSelection.
        ]
    ].
    self setSelection:aSelOrNil withRedraw:false.
    self showSelection

! !

!UIPainterView methodsFor:'specification'!

addSpec:aSpecification builder:aBuilder in:aFrame
    "build view and subviews from aSpecification into a frame. The top view
     is returned. The contained components of a spec are set to nil
    "
    |cls|

    cls := self resolveName:className.

    cls notNil ifTrue:[
        aBuilder applicationClass:cls.
    ].

    aBuilder componentCreationHook:[:aView :aSpec :aBdr||sv p s n|
        p := ViewProperty new.
        s := aSpec copy.
        p spec:s.
        p view:aView.

        s class supportsSubComponents ifTrue:[
            s component:nil
        ].

        n := s name.

        (n isNil or:[(self propertyOfName:n) notNil]) ifTrue:[
            s name:(self uniqueNameFor:s)
        ].
        treeView addProperty:p.
    ].

    ^ aSpecification buildViewWithLayoutFor:aBuilder in:aFrame.

    "Modified: 4.7.1997 / 23:48:55 / cg"
!

fullSpecFor:anObject
    "generate a full spec for an object
    "
    |mySpec subSpecs|

    mySpec := self specFor:anObject.

    (mySpec notNil and:[mySpec class supportsSubComponents]) ifTrue:[
        (anObject subViews notNil) ifTrue:[
            anObject subViews do:[:aSubView||spec|
                spec := self fullSpecFor:aSubView.
                spec notNil ifTrue:[
                    subSpecs isNil ifTrue:[
                        subSpecs := OrderedCollection new
                    ].
                    subSpecs add:spec.
                ].
            ].
            subSpecs notNil ifTrue:[
                mySpec component:(SpecCollection new collection:subSpecs)
            ]
        ]
    ].
    ^ mySpec






!

rebuildView:aView fromSpec:aSpec withBuilder:aBuilder
    |v|

    aSpec needsRebuildForAttributes ifTrue:[
        v := aSpec buildViewWithLayoutFor:aBuilder in:(self findContainerOfView:aView).
        v realize.    
        aView destroy.
        device sync.
        device flush.
        aView becomeSameAs:v.
        inputView raise.
    ] ifFalse:[
        aSpec setAttributesIn:aView with:aBuilder.
        self elementChangedSize:aView.
    ].

!

specFor:anObject
    "returns spec assigned to an object
    "
    |prop spec|

    (prop := self propertyOfView:anObject) notNil ifTrue:[
        spec := prop spec copy.
        spec layoutFromView:anObject
    ].
    ^ spec



!

specForSelection
    "returns spec assigned to current single selection or nil
    "
    ^ self specFor:(self singleSelection)


!

updateFromSpec:aSpec
    "update current selected view from specification
    "
    |props name builder|

    aSpec class == WindowSpec ifTrue:[
         ^ treeView canvasSpec:aSpec
    ].

    self singleSelection notNil ifTrue:[
        self withSelectionHiddenDo:[
            self transaction:#specification selectionDo:[:aView|
                builder := UIBuilder new isEditing:true.
                className notNil ifTrue:[
                    builder applicationClass:(self resolveName:className).
                ].
                props   := self propertyOfView:aView.
                name    := (aSpec name) withoutSeparators.

                name = props name ifFalse:[
                    (self propertyOfName:name) notNil ifTrue:[
                        name := props name
                    ]
                ].
                aSpec name:name.
                self createUndoSpecModify:props.
                self rebuildView:aView fromSpec:aSpec withBuilder:builder.
                props spec:(aSpec copy).
                treeView propertyChanged:props.
            ]
        ]
    ]

    "Modified: 4.7.1997 / 23:49:44 / cg"
! !

!UIPainterView methodsFor:'testing'!

canChangeLayoutOfView:aView
    "returns true if the view can change its layout which is dependant on
     its parent view.
    "
    |item prnt|

    (     (item := treeView itemOfView:aView) isNil
      or:[(prnt := item parent) isNil]
    ) ifTrue:[
        ^ false
    ].
    ^ (prnt parent isNil or:[prnt contents spec class isLayoutContainer not])
!

canKeepLayoutInSelection
    "returns true if layout can be kept during a paste operation
    "
    |prop|

    prop := self propertyOfView:(self singleSelection).
  ^ (prop isNil or:[prop spec class isLayoutContainer not])
!

canMove:something
    "checks whether something is not nil and if all widgets derived from
     something can change their layout ( move, align, ... operation ).
    "
    something notNil ifTrue:[
        self forEach:something do:[:aView|
            (self canChangeLayoutOfView:aView) ifFalse:[^ false]
        ].
        ^ true
    ].
    ^ false
!

canMoveOrAlignSelection
    "returns true if a selection exists and all elements in the selection
     can be moved or aligned
    "
  ^ self canMove:(self selection)

! !

!UIPainterView methodsFor:'transaction'!

transaction:aType objects:something do:aOneArgBlock
    "opens a transaction and evaluates a block within the transaction; the
     argument to the block is a view from derived from something
    "
    self withinTransaction:aType objects:something do:[
        self forEach:something do:aOneArgBlock
    ]
!

withinTransaction:aType objects:objects do:aNoneArgBlock
    "evaluate a block with no arguments within a transaction
    "
    |text size prop|

    objects isNil ifTrue:[ ^ self ].

    size := objects size.

    objects isCollection ifTrue:[
        size == 0 ifTrue:[ ^ self ].
        size == 1 ifTrue:[ prop := self propertyOfView:(objects first) ]
    ] ifFalse:[
        prop := self propertyOfView:objects
    ].

    prop notNil ifTrue:[
        text := prop name
    ] ifFalse:[
        text := size printString, ' elements'
    ].

    undoHistory withinTransaction:aType text:text do:[
        aNoneArgBlock value
    ]
! !

!UIPainterView methodsFor:'undo actions'!

createUndoLayout:aView
    "create undo action before changing a views layout
    "
    |lyt args prop|

    undoHistory isTransactionOpen ifTrue:[
        prop := self propertyOfView:aView.

        prop notNil ifTrue:[
            args := Array new:3.
            args at:1 put:(prop identifier).

            (lyt := aView geometryLayout) notNil ifTrue:[
                args at:2 put:#geometryLayout:
            ] ifFalse:[
                lyt := aView extent.
                args at:2 put:#extent:
            ].
            args at:3 put:(lyt copy).
            undoHistory addUndoSelector:#undoLayout: withArgs:args.
        ]
    ]
!

createUndoRemove:aView
    "create undo method before deleting views
    "
    |prop pid|

    (prop := self propertyOfView:aView) notNil ifTrue:[
        (pid := self propertyOfParentForView:aView) notNil ifTrue:[
            pid := pid identifier
        ].

        undoHistory addUndoSelector:#undoRemove:
                           withArgs:(Array with:(self fullSpecFor:aView)
                               with:(prop identifier)
                               with:pid)
    ]
!

createUndoSpecModify:aProp
    "undo method when changing the specification for an object
    "
    aProp notNil ifTrue:[
        undoHistory addUndoSelector:#undoSpecModify:
                           withArgs:(Array with:(aProp spec) with:(aProp identifier))
    ]
!

undoCreate:something
    "undo method for creating or pasting an object
    "
    self forEach:something do:[:anId|self remove:(self findViewWithId:anId)].
!

undoLayout:args
    "undo method to set the old layout; see 'createUndoLayout:'
    "
    |view|

    (view := self findViewWithId:(args at:1)) notNil ifTrue:[
        view perform:(args at:2) with:(args at:3).
        self layoutChanged.
    ]
!

undoRemove:args
    "undo method when removing an object; see 'createUndoRemove:'
    "
    |frame prop view|

    (args at:3) notNil ifTrue:[
        frame := self findViewWithId:(args at:3).
    ].
    frame isNil ifTrue:[
        frame := self
    ].
    view := self addSpec:(args at:1) builder:(UIBuilder new isEditing:true) in:frame.
    view realize.
    inputView raise.

    prop := self propertyOfView:view.
    prop identifier:(args at:2).

!

undoSpecModify:args
    "undo method when changing a spec; see 'createUndoSpecModify:'
    "
    |builder view spec props|

    props := self propertyOfIdentifier:(args at:2).

    props notNil ifTrue:[
        view    := props view.
        spec    := args at:1.
        builder := UIBuilder new isEditing:true.

        className notNil ifTrue:[
            builder applicationClass:(self resolveName:className).
        ].
        props spec:spec.
        self rebuildView:view fromSpec:spec withBuilder:builder.
        treeView propertyChanged:props.
    ]
! !

!UIPainterView::ViewProperty class methodsFor:'instance creation'!

new
    Identifier notNil ifTrue:[Identifier := Identifier + 1]
                     ifFalse:[Identifier := 1].

  ^ self basicNew initialize
! !

!UIPainterView::ViewProperty methodsFor:'accessing'!

identifier
    "return the unique identifier assigned to property
    "
    ^ identifier
!

identifier:anIdentifier
    "set the unique identifier assigned to property; called after an restore of
     a deleted instance
    "
    identifier := anIdentifier
!

spec
    "return the value of the instance variable 'spec' (automatically generated)"

    ^ spec!

spec:something
    "set the value of the instance variable 'spec' (automatically generated)"

    spec := something.!

view
    "return the value of the instance variable 'view' (automatically generated)"

    ^ view!

view:something
    "set the value of the instance variable 'view' (automatically generated)"

    view := something.! !

!UIPainterView::ViewProperty methodsFor:'initialization'!

initialize
    super initialize.
    identifier := Identifier
! !

!UIPainterView::ViewProperty methodsFor:'misc'!

extractNumberStartingAt:anIndex
    "return the number from the name starting at anIndex or 0.
    "
    |val|

    val := 0.

    self name from:anIndex do:[:c|
        c isDigit ifTrue:[val := val * 10 + c digitValue]
                 ifFalse:[^ 0]
    ].
    ^ val
        
! !

!UIPainterView::ViewProperty methodsFor:'spec messages'!

doesNotUnderstand:aMessage
    spec notNil ifTrue:[
        (spec respondsTo:(aMessage selector)) ifTrue:[^ aMessage sendTo:spec]
    ].
    ^ nil
!

layout
    spec layout
!

layout:aLayout
    spec layout:aLayout
!

name
    ^ spec name
!

name:aName
    spec name:aName
! !

!UIPainterView class methodsFor:'documentation'!

version
    ^ '$Header$'
! !