UIPainterView.st
author Claus Gittinger <cg@exept.de>
Mon, 11 Aug 1997 14:07:53 +0200
changeset 278 5b7dfe33b497
parent 238 882be7e03af4
child 279 ef937b65a7f6
permissions -rw-r--r--
drag & drop offset

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

        newSel size == 1 ifTrue:[
            newSel := newSel at:1
        ].
        self realizeAllSubViews.
        inputView raise.
        self elementChangedSize:frame.
    ].
    ^ newSel

    "Created: 11.8.1997 / 00:59:38 / cg"
    "Modified: 11.8.1997 / 01:05:27 / cg"
!

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

    aView notNil ifTrue:[
        spec := self specFor:aView.

        spec isNil ifTrue:[^ aView specClass supportsSubComponents]
                  ifFalse:[^ spec  class     supportsSubComponents]
    ].
    ^ false

!

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

Transcript showCR:aPoint.

    (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 / 01:07:09 / 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 , ' ...''.\' ,
      '\' ,
      '^ nil.' ,
      '!! !!\\') withCRs




!

generateWindowSpecMethodSource
    |spec specArray str code category cls mthd|

    specArray := OrderedCollection new.

    self subViews do:[:aView|
        aView ~~ inputView ifTrue:[
            specArray add:(self fullSpecFor:aView)
        ]
    ].
    spec := FullSpec new.
    spec fromBuilder:self components:(SpecCollection new collection:specArray).
    specArray := spec literalArrayEncoding.

    str := WriteStream on:String new.
    UISpecification prettyPrintSpecArray:specArray on:str indent:5.

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

    category := 'interface specs'.
    (cls := Smalltalk classNamed:className) notNil ifTrue:[
        (mthd := cls class compiledMethodAt:methodName asSymbol) notNil ifTrue:[
            category := mthd category.
        ]
    ].

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

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

    ^ code withCRs

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

!UIPainterView methodsFor:'initialization'!

initialize
    "setup attributes
    "
    super initialize.

    superclassName := 'ApplicationModel'.
    className      := 'NewApplication'.
    methodName     := 'windowSpec'.
    categoryName   := 'Applications'.
    HandCursor     := Cursor leftHand.

!

setupFromSpec:specOrSpecArray
    |spec builder|

    treeView cvsSetupListDo:[
        self removeAll.
        spec    := UISpecification from:specOrSpecArray.
        builder := UIBuilder new.
        spec window setupView:self topView for:builder.
        self addSpec:(spec component) builder:builder in:self.
        self realizeAllSubViews.
        inputView raise.
    ]
!

treeView:aTreeView
    treeView := aTreeView
! !

!UIPainterView methodsFor:'menus'!

showMiddleButtonMenu
    "show the middle button menu; this returns nil
    "
    |menu|

    self enabled ifTrue:[
        menu := MenuPanel fromSpec:(UIPainter menuCanvas) receiver:self.

        self hasSelection ifFalse:[
            menu disableAll
        ].
        menu enabledAt:#paste put:(self canPaste:(self getSelection)).
        menu enabledAt:#undo  put:(undoHistory isEmpty not).
        menu startUp.
    ].
  ^ nil



! !

!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
    "
    treeView cvsEventsDisabledDo:[
        self  select:nil.
        treeView removeAll.
        self  removeUndoHistory.
    ]
! !

!UIPainterView methodsFor:'searching'!

findContainerViewAt:aPoint
    "find container view responds to aPoint.
    "
    |view|

    (view := self findObjectAt:aPoint) isNil ifTrue:[
        ^ self
    ].

    [(view specClass supportsSubComponents or:[(view := view superView) == self])
    ] whileFalse:[
        [(self propertyOfView:view) isNil] whileTrue:[
            (view := view superView) == self ifTrue:[^ self]
        ].
    ].
    ^ view
!

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

    view := super findObjectAt:aPoint.

    view notNil ifTrue:[
        "can be a view within a view not visible
        "
        [ (self propertyOfView:view) isNil ] whileTrue:[
            (view := view superView) == self ifTrue:[^ nil]
        ]
    ].
    ^ view
!

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
!

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

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

    aSpecOrString isString ifFalse:[name := aSpecOrString className asString]
                            ifTrue:[name := aSpecOrString].

    (name endsWith:'Spec') ifTrue:[
        name := name copyFrom:1 to:(name size - 4).
    ] ifFalse:[
        name := name copy
    ].
    name at:1 put:(name at:1) asLowercase.
    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:[
        self setSelection:something withRedraw:true.
        treeView cvsSelection:something
    ]

!

updateSelectionFromModel:aSel
    "update selection from a new selection
    "
    |sel|

    selectionHiddenLevel == 0 ifTrue:[
        self selectionDo:[:el| (aSel includes:el) ifFalse:[self showUnselected:el] ]
    ].

    (aSel indexOf:self) ~~ 0 ifTrue:[
        aSel size > 1 ifTrue:[sel := aSel copyWithout:self]
    ] ifFalse:[
        aSel size ~~ 0 ifTrue:[sel := aSel]
    ].

    self setSelection:sel 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
    "

    className notNil ifTrue:[
        aBuilder applicationClass:(Smalltalk classNamed:className).
    ].

    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






!

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

    self singleSelection notNil ifTrue:[
        self withSelectionHiddenDo:[
            self transaction:#specification selectionDo:[:aView|
                builder := UIBuilder new.
                className notNil ifTrue:[
                    builder applicationClass:(Smalltalk classNamed: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.

                aSpec needsRebuildForAttributes ifTrue:[
                    v := aSpec buildViewWithLayoutFor:builder in:aView superView.
                    v realize.    
                    aView destroy.
                    device sync. device flush.
                    aView becomeSameAs:v.
                    inputView raise.
                ] ifFalse:[
                    aSpec setAttributesIn:aView with:builder.
                    self elementChangedSize:aView.
                ].
                props spec:(aSpec copy).
                treeView propertyChanged:props.
            ]
        ]
    ]

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

!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
    "
    |frame prop pId spec|

    (prop := self propertyOfView:aView) notNil ifTrue:[
        spec  := self fullSpecFor:aView.
        frame := aView superView.

        (self canPasteInto:frame) ifTrue:[
            (frame := self propertyOfView:frame) notNil ifTrue:[
                pId := frame identifier
            ]
        ].
        undoHistory addUndoSelector:#undoRemove:
                           withArgs:(Array with:spec 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) 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 v props|

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

    props notNil ifTrue:[
        view    := props view.
        spec    := args at:1.
        builder := UIBuilder new.
        className notNil ifTrue:[
            builder applicationClass:(Smalltalk classNamed:className).
        ].
        props spec:spec.

        spec needsRebuildForAttributes ifTrue:[
            v := spec buildViewWithLayoutFor:builder in:view superView.
            v realize.    
            view destroy.
            view become:v
        ] ifFalse:[
            spec setAttributesIn:view with:builder.
            self elementChangedSize:view.
        ].
        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$'
! !