UIPainterView.st
author ca
Fri, 21 Feb 1997 20:33:18 +0100
changeset 57 5af567f52811
parent 55 19e021c8f1ef
child 59 0a2b2ff030a0
permissions -rw-r--r--
checkin from browser

"
 COPYRIGHT (c) 1995 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

UIObjectView subclass:#UIPainterView
	instanceVariableNames:'fontPanel viewProperties superclassName className methodName
		categoryName'
	classVariableNames:'HandCursor'
	poolDictionaries:''
	category:'Interface-UIPainter'
!

Object subclass:#ViewProperty
	instanceVariableNames:'aspectSelector changeSelector nameIndex view elementClass
		labelSelector identifier tabable'
	classVariableNames:'Identifier'
	poolDictionaries:''
	privateIn:UIPainterView
!

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:'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 respondsTo:#label:) 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 initCode:nil.       --- add user-defined init code later

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





!

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

    code := ''.

    "generate code for groups"

    viewProperties do:[:props |
        g := props at:#group ifAbsent:[nil].
        g notNil ifTrue:[
            code := code , (self generateInitCodeForGroup:g)
        ]
    ].
    ^ code


!

generateInitCodeForView:aView
    |code c name p outlets moreCode sym typ val|

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

    code := ''.

    p := self propertyOfView:aView.
    name := p at:#variableName.
    c := '    ' , name , ' := ' ,
         (aView class name) , ' in:' , (self variableNameOf:(aView superView)) , '.\'.

    " <name> origin:(...) extent:(...)"

    c := c , '    ' , name , ' origin:(', aView origin printString , ')'
                    , ' extent:(', aView extent printString , ').\'.

    moreCode := p at:#initCode ifAbsent:nil.
    moreCode notNil ifTrue:[
        c := c , moreCode , '\' withCRs
    ].

    code := code , c withCRs.

    " <name> <symbol>:<value>"

    outlets := p at:#outlets ifAbsent:[nil].
    outlets notNil ifTrue:[
        outlets do:[:selectorOutlet |
            sym := selectorOutlet at:#selector.
            typ := selectorOutlet at:#type.
            val := selectorOutlet at:#value.
            c :=  '    ' , name , ' ' , sym.
            (typ == #number) ifTrue:[
                c := c , val printString
            ].
            (typ == #string) ifTrue:[
                c := c , '''' , val , ''''
            ].
            (typ == #text) ifTrue:[
                c := c , '''' , val asString , ''''
            ].
            (typ == #strings) ifTrue:[
                c := c , '#( '.
                val asText do:[:aString |
                    c := c , '''' , aString , ''' '
                ].
                c := c , ')'
            ].
            (typ == #block) ifTrue:[
                c := c , val
            ].
            (typ == #color) ifTrue:[
                c := c , '(Color name:''' , val , ''')'
            ].
            c := c , '.' , Character cr asString.
            code := code , c
        ]
    ].

    self subviewsOf:aView do:[:v |
        code := code , (self generateInitCodeForView:v)
    ].
    ^ code.

    "Modified: 5.9.1995 / 20:06:07 / claus"
!

generateInitMethod
    |defCode code|

    defCode := Character excla asString ,
               className , ' methodsFor:''initialization''' ,
               Character excla asString , '\\'.

    defCode := defCode , 'initialize\'.
    defCode := defCode , '    super initialize.\'.
    defCode := defCode , '    self setupSubViews.\'.
    defCode := defCode , '    self setupLocalStuff\'.
    defCode := defCode , Character excla asString , '\\'.

    defCode := defCode , 'setupSubViews\'.
    code := defCode withCRs.

    self subviewsOf:self do:[:v |
        code := code , (self generateInitCodeForView:v)
    ].

    code := code , (self generateInitCodeForOtherStuff).

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

    defCode := Character excla asString , '\\'.
    defCode := defCode , 'setupLocalStuff\'.
    defCode := defCode , '    ^ self\'.
    defCode := defCode , Character excla asString , ' ' ,
                         Character excla asString , '\\'.

    code := code , defCode withCRs.
    ^ code.




!

generateOutlets
    ^ self
! !

!UIPainterView methodsFor:'generating output'!

generateSpecFor:something 
    "generate a spec for a view or collection of views
    "
    |spec views|

    something notNil ifTrue:[
        something isCollection ifTrue:[views := something]
                              ifFalse:[views := Array with:something].

        spec := views collect:[:aView||topSpec|
            aView specClass isNil ifTrue:[^ nil].

            topSpec := aView specClass 
                            fromView:aView 
                            callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec].
            topSpec
        ]
    ].
    ^ spec






!

generateWindowSpecMethodSource
    |spec specArray str code|

    subViews remove:inputView.
    [
        spec := FullSpec fromView:self callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec].
    ] valueNowOrOnUnwindDo:[
        subViews addFirst:inputView.
    ].
    specArray := spec literalArrayEncoding.

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

    code := Character excla asString 
            , className , ' class methodsFor:''interface specs'''
            , Character excla asString , '\\'

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

    ^ code withCRs

    "Modified: 5.9.1995 / 21:01:35 / claus"
! !

!UIPainterView ignoredMethodsFor:'generating output'!

nameOfClass
    ^ 'NewView'
! !

!UIPainterView methodsFor:'generating output'!

outletValueOf:aSymbol for:aView
"/    |c name p outlets moreCode sym typ val|
"/
"/    p := self propertyOfView:aView.
"/    outlets := p at:#outlets ifAbsent:[^ nil].
"/    outlets notNil ifTrue:[
"/        outlets do:[:selectorOutlet |
"/            sym := selectorOutlet at:#selector.
"/            (sym == aSymbol) ifTrue:[
"/                typ := selectorOutlet at:#type.
"/                val := selectorOutlet at:#value.
"/                ^ val
"/            ]
"/        ]
"/    ].
    ^ nil




!

prettyPrintSpecArray:spec on:aStream indent:i
    "just for your convenience: prettyPrint a specArray to aStream - it looks better that way"

    |what oneLine|

    spec isArray ifFalse:[
        spec isLiteral ifTrue:[
            aStream nextPutAll:spec storeString
        ] ifFalse:[
            self halt.
        ].
        ^ self
    ].

    spec isEmpty ifTrue:[
        aStream nextPutAll:'#()'.
        ^ self
    ].

    what := spec at:1.
    what isArray ifTrue:[
        aStream cr; spaces:i+2.
        aStream nextPutAll:'#('.
        "/ a spec-collection
        spec do:[:element |
            self prettyPrintSpecArray:element on:aStream indent:i+2.
        ].
        aStream cr.
        aStream spaces:i+1.
        aStream nextPutAll:')'.
        ^ self.
    ].

    oneLine := false.
    (#(#LayoutFrame #LayoutOrigin #AlignmentOrigin 
       #Rectangle #Point
       #Color #ColorValue
    ) 
    includesIdentical:what) ifTrue:[
        oneLine := true
    ].

    oneLine ifFalse:[
        aStream cr.
        aStream spaces:i+2.
    ].
    aStream nextPutAll:'#('.


    aStream nextPutAll:what storeString.

    oneLine ifFalse:[
        aStream cr.
        aStream spaces:i+4.
    ].

    2 to:spec size do:[:index |
        aStream space.
        self prettyPrintSpecArray:(spec at:index) on:aStream indent:i+4.
        oneLine ifFalse:[
            (index odd and:[index ~~ (spec size)]) ifTrue:[
                aStream cr; spaces:i+4.
            ]
        ]
    ].
    oneLine ifFalse:[
        aStream cr.
        aStream spaces:i+1.
    ].
    aStream nextPutAll:')'.

    "Modified: 5.9.1995 / 17:44:20 / claus"
!

storeContentsOn:aStream
    viewProperties do:[:p| p storeOn:aStream]
!

stuffPropertiesFrom:view intoSpec:newSpec
    "stuff any additional information (held in the properties) into the spec
     which was just created from view"

    |props aspectSelector changeSelector labelSelector name tabable|

    props := self propertyOfView:view.
    props isNil ifTrue:[^ self].

    (aspectSelector := props aspectSelector) notNil ifTrue:[
        newSpec model:aspectSelector
    ].
    (changeSelector := props changeSelector) notNil ifTrue:[
        newSpec change:changeSelector
    ].
    (labelSelector := props labelSelector) notNil ifTrue:[
        newSpec label:labelSelector
    ].
    (tabable := props tabable) notNil ifTrue:[
        newSpec tabable:tabable
    ].
    (name := props name) notNil ifTrue:[
        newSpec name:name
    ].

! !

!UIPainterView ignoredMethodsFor:'generating output'!

subviewVariableNames
    |names|

    names := ''.
    viewProperties do:[:p| names := names , ' ' , (p name)].
  ^ names
! !

!UIPainterView methodsFor:'generating output'!

subviewsOf:aView do:aBlock
    |subs v|

    (subs := aView subViews) notNil ifTrue:[
        subs do:[:v|
            (v ~~ inputView and:[v notNil]) ifTrue:[
                (viewProperties detect:[:p | p view == v] ifNone:nil) notNil ifTrue:[ 
                    (v superView == aView) ifTrue:[
                        aBlock value:v
                    ]
                ]
            ]
        ]
    ]

! !

!UIPainterView methodsFor:'group manipulations'!

groupEnterFields
    |props name index group objects|

    selection isNil ifTrue:[^ self].
    self selectionDo:[:aView |
        (aView isKindOf:EditField) ifFalse:[
            self warn:'select EditFields only !!'.
            ^ self
        ]
    ].
    self selectionHiddenDo:[
        group := EnterFieldGroup new.

        props := GroupProperties new.
        props elementClass:EnterFieldGroup.
        props group:group.
        index := self variableIndexForClass:EnterFieldGroup.
        props nameIndex:index.
        name := self variableNameForClass:EnterFieldGroup index:index.
        props name:name.
        objects := OrderedCollection new.
        props controlledObjects:objects.
        viewProperties add:props.

        self selectionDo:[:aView |
            objects add:aView.
            group add:aView
        ].
    ]


!

groupRadioButtons
    |props name index group objects|

    selection isNil ifTrue:[^ self].
    self selectionDo:[:aView |
        (aView isKindOf:RadioButton) ifFalse:[
            self warn:'select RadioButtons only !!'.
            ^ self
        ]
    ].
    self selectionHiddenDo:[
        group := RadioButtonGroup new.

        props := GroupProperties new.
        props elementClass:RadioButtonGroup.
        props group:group.
        index := self variableIndexForClass:RadioButtonGroup.
        props nameIndex:index.
        name := self variableNameForClass:RadioButtonGroup index:index.
        props name:name.
        group groupID:name asSymbol.
        objects := OrderedCollection new.
        props controlledObjects:objects.
        viewProperties add:props.

        self selectionDo:[:aView |
            aView turnOff.
            objects add:aView.
            group add:aView
        ].
    ]

    "Modified: 5.9.1995 / 16:06:15 / claus"
! !

!UIPainterView methodsFor:'initialization'!

initialize
    super initialize.

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

    "Modified: 5.9.1995 / 19:58:06 / claus"
! !

!UIPainterView methodsFor:'interface to Builder'!

addOutletDefinitionFor:outletSymbol type:type value:outletValue for:aView
    |outletProps selectorProps viewProps|

    viewProps := self propertyOfView:aView.
"/    outletProps := viewProps at:#outlets ifAbsent:[nil].
"/    outletProps isNil ifTrue:[
"/        outletProps := Dictionary new.
"/        viewProps at:#outlets put:outletProps
"/    ].
"/    selectorProps := outletProps at:outletSymbol ifAbsent:[nil].
"/    selectorProps isNil ifTrue:[
"/        selectorProps := Dictionary new.
"/        outletProps at:outletSymbol put:selectorProps
"/    ].
"/
"/    selectorProps at:#selector put:outletSymbol.
"/    selectorProps at:#type put:type.
"/    selectorProps at:#value put:outletValue

!

addSpec:specOrSpecArray
    |spec builder|

    spec := UISpecification from:specOrSpecArray.

    builder := UIBuilder new.
    builder componentCreationHook:[:view :spec :aBuilder |
                self createdComponent:view forSpec:spec builder:aBuilder
            ].
    builder applicationClass:(Smalltalk classNamed:className).
    spec setupView:self for:builder.

    self realizeAllSubViews.
    inputView raise.

"/    viewProperties := OrderedCollection new.
"/    self generatePropertiesFor:(self subViews select:[:v | v ~~ inputView]).

    self changed:#tree.


    "Modified: 5.9.1995 / 23:36:55 / claus"
!

applicationName
    ^ className
!

aspectAt:aSymbol
    self halt.
    ^ nil

    "Modified: 6.9.1995 / 00:45:35 / claus"
!

aspectSelectorForView:aView
    |props aspect|

    props := self propertyOfView:aView.
    props isNil ifTrue:[^ nil].
    ^ props aspectSelector

!

changeSelectorForView:aView
    |props aspect|

    props := self propertyOfView:aView.
    props isNil ifTrue:[^ nil].
"/    ^ props changeSelector
    ^ nil
!

createdComponent:newView forSpec:aSpec builder:aBuilder
    "callBack from UISpec view building"

    |props|

    props := self propertiesForNewView:newView.

    aSpec name notNil ifTrue:[
        (self propertyOfName:(aSpec name)) isNil ifTrue:[
            props name:aSpec name
        ]
    ].

    props labelSelector:(aSpec labelSelector).
    props aspectSelector:(aSpec modelSelector).
    props tabable:(aSpec tabable).

    viewProperties add:props.
!

generatePropertiesFor:aCollectionOfViews

    "/ done as two loops, to get bread-first naming

    aCollectionOfViews do:[:aView|
        |props|

        props := self propertiesForNewView:aView.
        viewProperties add:props.
        aView name:(props name).

        aView geometryLayout isNil ifTrue:[
            aView geometryLayout:(aView bounds asLayout).
        ]
    ].

    aCollectionOfViews do:[:aView |
        |subs|

        subs := aView subViews.
        subs notNil ifTrue:[
            self generatePropertiesFor:subs
        ]
    ].

!

inspectAttributes
    |p|

    self singleSelectionDo:[:aView |
        p := self propertyOfView:aView.
        p inspect
    ]
!

inspectSpec
    |s|

    self singleSelectionDo:[:aView |
        s := self generateSpecFor:aView.
        s first inspect
    ]
!

setAspectSelector:aspectSymbol forView:aView
    |props|

    props := self propertyOfView:aView.

    props notNil ifTrue:[
        self transaction:#aspect selectionDo:[:aView|
            |oldAspect|

            oldAspect := props aspectSelector.

            undoHistory addUndoBlock:[
                props aspectSelector:oldAspect.
                aView superView sizeChanged:nil
            ]
        ].
        props aspectSelector:aspectSymbol
    ]
!

setChangeSelector:changeSymbol forView:aView
    |props|

    props := self propertyOfView:aView.
    props notNil ifTrue:[
        props changeSelector:changeSymbol
    ]
!

setupFromSpec:specOrSpecArray
    self removeAll.
    self addSpec:specOrSpecArray
!

showFontPanel
    |action|

    fontPanel isNil ifTrue:[
	fontPanel := FontPanel new 
    ].

    selection notNil ifTrue:[
	action := [:family :face :style :size |
		       self changeFontFamily:family face:face
				       style:style size:size
		  ].
	fontPanel action:action.
	fontPanel showAtPointer
    ]
! !

!UIPainterView methodsFor:'menu & submenus'!

menu
    testMode ifFalse:[
        selection notNil ifTrue:[^ self menuSelection ]
                        ifFalse:[^ self menuPainter   ]
    ].
    ^ nil
!

menuPainter
    "menu in case of non empty selection; for views
    "
    |menu gridMenu|

    menu := PopUpMenu labels:( 
                resources array:#(
                                  'paste' 
                                  '-' 
                                  'undo'
                                  'delete undo history'
                                  '-'
                                  'grid'
                                 ) 
                              )
                   selectors:#( 
                                #pasteBuffer
                                nil 
                                #undo
                                #undoDeleteAll
                                nil
                                #grid
                              )
                   accelerators:#(
                                  #Paste
                                  nil
                                  nil
                                  nil
                                  nil
                                  nil
                              )
                     receiver:self.

    (self canPaste:(self getSelection)) ifFalse:[
        menu disable:#pasteBuffer
    ].

    undoHistory isEmpty ifTrue:[
        menu disable:#undo
    ] ifFalse:[
        menu subMenuAt:#undo put:(undoHistory popupMenu)
    ].

    gridMenu := PopUpMenu labels:(
                            resources array:#(
                                    '\c show' 
                                    '\c align'
                                  )
                                )
                      selectors:#(
                                    #gridShown:
                                    #gridAlign:
                                ).

    gridMenu checkToggleAt:#gridShown: put:(self gridShown).
    gridMenu checkToggleAt:#gridAlign: put:aligning.
    menu subMenuAt:#grid put:gridMenu.

  ^ menu


!

menuSelection
    "menu in case of non empty selection; for views
    "
    |menu|

    menu := PopUpMenu labels:( resources array:#(
                                  'copy' 
                                  'cut' 
                                  'paste' 
                                  '-' 
                                  'arrange'
                                  'dimension'
                                  'align'
                                )
                              )
                   selectors:#(   #copySelection
                                  #deleteSelection
                                  #pasteBuffer
                                  nil
                                  #arrange
                                  #dimension
                                  #align
                              )
                   accelerators:#(#Copy
                                  #Cut
                                  #Paste
                                  nil
                                  nil
                                  nil
                                  nil
                              )
                     receiver:self.

    (    (self canPaste:(self getSelection))
     and:[self supportsSubComponents:selection]
    ) ifFalse:[
        menu disable:#pasteBuffer
    ].

    menu subMenuAt:#arrange   put:(self subMenuArrange).
    menu subMenuAt:#dimension put:(self subMenuDimension).
    menu subMenuAt:#align     put:(self subMenuAlign).
  ^ menu
!

subMenuAlign
    "returns submenu alignment
    "
    |menu|

    menu := PopUpMenu labels:(
                resources array:#(
                                    'align left' 
                                    'align right'
                                    'align left & right'
                                    'align top' 
                                    'align bottom'
                                    'align centered vertical'
                                    'align centered horizontal'
                                    '-'
                                    'spread horizontal'
                                    'spread vertical'
                                    'center horizontal in frame'
                                    'center vertical in frame'
                                  )
                         )

              selectors:#(  
                            alignSelectionLeft
                            alignSelectionRight
                            alignSelectionLeftAndRight
                            alignSelectionTop
                            alignSelectionBottom
                            alignSelectionCenterHor
                            alignSelectionCenterVer
                            nil
                            spreadSelectionHor
                            spreadSelectionVer
                            centerSelectionHor
                            centerSelectionVer
                         )
               receiver:self.
    ^ menu    

!

subMenuArrange
    "returns submenu arrange
    "
    |menu|

    menu := PopUpMenu labels:( 
                resources array:#(
                                    'to front' 
                                    'to back' 
                                 )
                              )
                   selectors:#(
                                    raiseSelection
                                    lowerSelection
                              )
                     receiver:self.
  ^ menu
!

subMenuDimension
    "returns submenu dimension
    "
    |menu|

    menu := PopUpMenu labels:( 
                resources array:#(
                                    'default extent' 
                                    'default width' 
                                    'default height'
                                    '-'
                                    'copy extent'
                                    '-'
                                    'paste extent'
                                    'paste width'
                                    'paste height'
                                 )
                              )
                   selectors:#(
                                    setToDefaultExtent
                                    setToDefaultWidth
                                    setToDefaultHeight
                                    nil
                                    copyExtent
                                    nil
                                    pasteExtent
                                    pasteWidth
                                    pasteHeight
                              )
                     receiver:self.
  ^ menu
!

subMenuFont
    "returns submenu dimension
    "
    |menu|

    menu := PopUpMenu labels:( 
                resources array:#(
                                    'larger' 
                                    'smaller'
                                    '-'
                                    'normal'
                                    'bold'
                                    'italic'
                                    'bold italic'
                                    '-'
                                    'font panel'
                                 )
                              )
                   selectors:#(
                                    largerFont 
                                    smallerFont
                                    nil
                                    normalFont
                                    boldFont
                                    italicFont
                                    boldItalicFont
                                    nil
                                    showFontPanel
                              )
                     receiver:self.
  ^ menu
! !

!UIPainterView methodsFor:'menu actions'!

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
    "
    |specs text|

    self numberOfSelections ~~ 0 ifTrue:[
        specs := self generateSpecFor:selection.
        text  := self transactionTextFor:selection.

        undoHistory transaction:#cut text:text do:[
            super deleteSelection
        ].
        self setSelection:specs
    ]
!

gridAlign:aBool
    aBool ifTrue:[self alignOn]
         ifFalse:[self alignOff]
!

gridShown:aBool
    aBool ifTrue:[self showGrid]
         ifFalse:[self hideGrid]

!

lowerSelection

    self selectionDo:[:aView| aView lower ].
!

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

        builder componentCreationHook:[:view :spec :aBuilder |  
            self createdComponent:view forSpec:spec builder:aBuilder.
        ].
        builder applicationClass:(Smalltalk classNamed:className).
        v := aSpec buildViewWithLayoutFor:builder in:frame.

        (frame bounds containsPoint:pasteOrigin) ifFalse:[
            self moveObject:v to:pasteOffset.
        ] ifTrue:[
            self moveObject:v to:pasteOrigin + pasteOffset.
        ].

        v realize.
        selection add:v.

        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

!

raiseSelection

    self selectionDo:[:aView|
        aView raise.
        inputView raise.
    ].

! !

!UIPainterView methodsFor:'misc'!

changeFontFamily:family face:face style:style size:size
    |f|

    f := Font family:family
                face:face
               style:style
                size:size.

    f notNil ifTrue:[
        self selectionHiddenDo:[
            self selectionDo:[:aView |
                aView font:f.
                self elementChanged:aView.
            ]
        ]
    ]

    "Modified: 5.9.1995 / 12:13:27 / claus"
!

changeVariableNameOf:aView to:newName
    |prop|

    prop := self propertyOf:aView.

    prop isNil ifTrue:[
        ^ self error:'no such view'
    ].

    ((aView respondsTo:#label:) and:[aView label = prop name]) ifTrue:[
        self selectionHiddenDo:[
            |layout|
            layout := aView geometryLayout copy.
            aView label:newName.
            aView geometryLayout:layout.
        ]
    ].

    prop  name:newName.
    aView name:newName.
    self changed:#widgetName



!

variableIndexForClass:aClass
    |max|

    max := 0.

    viewProperties do:[:p|
        p elementClass == aClass ifTrue:[
            max := max max:(p nameIndex)
        ]
    ].
    ^ max + 1

!

variableNameForClass:aClass index:index
    |n|

    n := (aClass name) , index printString.
    n at:1 put:(n at:1) asLowercase.
  ^ n

!

variableNameOf:aView
    |prop|

    aView notNil ifTrue:[
        prop := self propertyOf:aView
    ].

    prop notNil ifTrue:[^ prop name]
               ifFalse:[^ 'self']

! !

!UIPainterView methodsFor:'removing components'!

remove:something
    "remove something, anObject or a collection of objects from the contents
     do redraw"

    self forEach:something do:[:anObject |
	self removeObject:anObject
    ]


!

removeAll
    "remove the argument, anObject"

    self unselect.

    subViews notNil ifTrue:[
        subViews copy do:[:sub |
            sub ~~ inputView ifTrue:[   
                self removeTreeFrom:sub
            ]
        ]
    ].

    viewProperties := OrderedCollection new.
    undoHistory reinitialize.
    self changed:#tree
!

removeObject:anObject
    "remove the argument, anObject"

    self removeTreeFrom:anObject.
    self changed:#tree

    "Modified: 5.9.1995 / 20:51:28 / claus"
!

removeTreeFrom:anObject
    "remove the argument, anObject and all of its children
    "
    |props|

    anObject notNil ifTrue:[
        (anObject subViews notNil) ifTrue:[
            anObject subViews copy do:[:sub |
                self removeTreeFrom:sub
            ]
        ].
        props := self propertyOf:anObject.

        props notNil ifTrue:[
            self undoRemove:props.
            viewProperties remove:props
        ].
        anObject destroy
    ]
! !

!UIPainterView methodsFor:'searching'!

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

!UIPainterView methodsFor:'seraching property'!

propertyOf:something

    ^ viewProperties detect:[:p| (p view == something or:[p group == something])]
                     ifNone:nil





!

propertyOfGroup:aGroup

    ^ viewProperties detect:[:p| p group == aGroup] ifNone:nil
!

propertyOfIdentifier:anIdentifier

    ^ viewProperties detect:[:p| p identifier == anIdentifier] ifNone:nil.
!

propertyOfName:aString

    aString = 'self' ifFalse:[
        ^ viewProperties detect:[:p| p name = aString] ifNone:nil
    ].
    ^ nil
!

propertyOfView:aView

    aView == self ifFalse:[
        ^ viewProperties detect:[:p| p view == aView] ifNone:nil
    ].
    ^ nil
! !

!UIPainterView methodsFor:'testing'!

isHorizontalResizable:aComponent

    (aComponent isKindOf:ScrollBar) ifTrue:[
        ^ aComponent orientation == #horizontal
    ].
    (aComponent isKindOf:Scroller) ifTrue:[
        ^ aComponent orientation == #horizontal
    ].
    (aComponent isKindOf:Slider) ifTrue:[
        ^ aComponent orientation == #horizontal
    ].
    ^ true


!

isVerticalResizable:aComponent

    (aComponent isKindOf:EditField) ifTrue:[
        ^ false
    ].
    (aComponent isKindOf:ComboBoxView) ifTrue:[
        ^ false
    ].
    (aComponent isKindOf:CheckBox) ifTrue:[
        ^ false
    ].
    (aComponent isKindOf:ScrollBar) ifTrue:[
        ^ aComponent orientation == #vertical
    ].
    (aComponent isKindOf:Scroller) ifTrue:[
        ^ aComponent orientation == #vertical
    ].
    (aComponent isKindOf:Slider) ifTrue:[
        ^ aComponent orientation == #vertical
    ].
    ^ true


! !

!UIPainterView methodsFor:'transaction & undo'!

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

    something notNil ifTrue:[
        text := self transactionTextFor:something.

        undoHistory transaction:aType text:text do:[
            something isCollection ifTrue:[
                something do:[:aView| aOneArgBlock value:aView ]
            ] ifFalse:[
                aOneArgBlock value:something
            ]
        ]
    ]
!

transactionTextFor:anElementOrCollection
    "returns text used by transaction or nil
    "
    |props size|

    anElementOrCollection notNil ifTrue:[
        anElementOrCollection isCollection ifTrue:[
            size := anElementOrCollection.
            size == 0 ifTrue:[^ nil].
            size ~~ 1 ifTrue:[^ 'a collection'].

            props := self propertyOfView:(anElementOrCollection at:1).
        ] ifFalse:[
            props := self propertyOfView:anElementOrCollection
        ].
        props notNil ifTrue:[ ^ props name ]
    ].
    ^ nil
!

undoCreate:aViewIdentifier

    undoHistory isTransactionOpen ifTrue:[
        undoHistory addUndoBlock:[
            |props|

            props := self propertyOfIdentifier:aViewIdentifier.

            props notNil ifTrue:[
                self removeObject:(props view)
            ]
        ]
    ]
!

undoRemove:propertyOfView
    |clsName layout parent aView|

    (propertyOfView notNil and:[undoHistory isTransactionOpen]) ifFalse:[
        ^ self
    ].

    aView   := propertyOfView view.
    clsName := aView class.
    layout  := aView geometryLayout.
    parent  := aView superView.

    parent ~~ self ifTrue:[
        parent := (self propertyOf:parent) identifier.
    ] ifFalse:[
        parent := nil
    ].
    propertyOfView view:nil.    

    undoHistory addUndoBlock:[
        |recreatedView props|

        parent notNil ifTrue:[
            props := self propertyOfIdentifier:parent.

            props notNil ifTrue:[parent := props view]
                        ifFalse:[parent := self]
        ] ifFalse:[
            parent := self
        ].

        recreatedView := clsName in:parent.
        recreatedView geometryLayout:layout.
        propertyOfView view:recreatedView.    
        self addProperties:propertyOfView for:recreatedView.
        recreatedView realize.
        inputView raise.
    ].
    aView := nil.

! !

!UIPainterView methodsFor:'update from Specification'!

updateFromSpec:aSpec
    "update current selected view from specification
    "
    self singleSelection notNil ifTrue:[
        self selectionHiddenDo:[
            self transaction:#specification selectionDo:[:aView|
                |spec builder|

                spec := (self generateSpecFor:aView) first.

                undoHistory addUndoBlock:[
                    builder := UIBuilder new.
                    spec setAttributesIn:aView with:builder.
                    aView superView sizeChanged:nil
                ].
                builder := UIBuilder new.
                aSpec setAttributesIn:aView with:builder.
                aView superView sizeChanged:nil.
                (self propertyOfView:aView) tabable:aSpec tabable.
            ].
            self changed:#tree
        ]
    ]

! !

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

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

  ^ self basicNew initialize
! !

!UIPainterView::ViewProperty methodsFor:'accessing'!

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

    ^ aspectSelector
!

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

    aspectSelector := something.
!

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

    ^ changeSelector!

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

    changeSelector := something.!

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

    ^ elementClass!

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

    elementClass := something.!

group
    ^ nil
!

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

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

    ^ labelSelector!

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

    labelSelector := something.!

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

    ^ view name
!

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

    view name:something
!

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

    ^ nameIndex!

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

    nameIndex := something.!

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

    ^ tabable!

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

    tabable := 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::GroupProperties methodsFor:'accessing'!

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

    ^ controlledObjects!

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

    controlledObjects := something.!

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

    ^ group!

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

    group := something.! !

!UIPainterView class methodsFor:'documentation'!

version
    ^ '$Header$'
! !