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

Object subclass:#WindowBuilder
	instanceVariableNames:'window windowView application bindings visuals focusSequence
		namedComponents helpKeys componentCreationHook applicationClass
		keyboardProcessor subCanvasSpecs'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Support-UI'
!

!WindowBuilder 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
"
    a no-op class, for systems which do not use the UIBuilder.
    Concrete subclasses know how to create a view (with components) from
    some interface spec. Currently, an experimantal version of UIBuilder exists,
    and more may be added in the future (for example, to parse different UI
    specs - thinking of motifs UIL specs etc).

    [author:]
        Claus Gittinger
"
! !

!WindowBuilder methodsFor:'accessing'!

addBindings:moreBindings
    "used with subDialogs, which provide local bindings.
     All bindings from moreBindings overwrite any local bindings."

    moreBindings notNil ifTrue:[
        moreBindings keysAndValuesDo:[:aKey :aValue |
            bindings at:aKey put:aValue
        ]
    ]

    "Created: 28.2.1997 / 14:14:33 / cg"
!

application
    "return the application (an ApplicationModel),
     for which the view is built.
     This one is supposed to provide the aspects, menus etc."

    ^ application

    "Modified: 17.1.1997 / 19:04:40 / cg"
!

application:anApplicationModel
    "set the application (an ApplicationModel),
     for which the view is built.
     This one is supposed to provide the aspects, menus etc."

    application := anApplicationModel

    "Modified: 17.1.1997 / 19:04:47 / cg"
!

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

    applicationClass := something.!

aspectAt:aSymbol
    |b|

    aSymbol notNil ifTrue:[
        bindings notNil ifTrue:[
            b := bindings at:aSymbol ifAbsent:nil.
            b notNil ifTrue:[^ b].
        ].

        application notNil ifTrue:[
            Object messageNotUnderstoodSignal handle:[:ex |
                Transcript showCR:'not understood: ' , aSymbol.
            ] do:[
                ^ application aspectFor:aSymbol
            ]
        ]
    ].
    ^ nil

    "Modified: 17.1.1997 / 19:28:32 / cg"
!

aspectAt:aSymbol put:aModel
    bindings isNil ifTrue:[
        bindings := IdentityDictionary new
    ].
    ^ bindings at:aSymbol put:aModel

    "Modified: 17.1.1997 / 19:28:37 / cg"
!

bindingAt:aSymbol
    bindings notNil ifTrue:[
        ^ bindings at:aSymbol ifAbsent:nil.
    ].
    ^ nil
!

bindings
    ^ bindings
!

bindings:aDictionary
    bindings := aDictionary
!

componentAt:name
    namedComponents isNil ifTrue:[^ nil].
    ^ namedComponents at:name asSymbol ifAbsent:nil
!

componentAt:name put:aComponent
    namedComponents isNil ifTrue:[
        namedComponents := IdentityDictionary new.
    ].
    namedComponents at:name asSymbol put:aComponent
!

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

    componentCreationHook := something.!

focusSequence 
    ^ focusSequence
!

helpKeyFor:aComponent
    |v key|

    helpKeys isNil ifTrue:[^ nil].
    v := aComponent.
    [v notNil] whileTrue:[
        (key := helpKeys at:v ifAbsent:nil) notNil ifTrue:[
            ^ key
        ].
        v := v superView
    ].
    ^ nil
!

helpKeyFor:aComponent put:aKey

    aKey isNil ifTrue:[
        helpKeys isNil ifFalse:[
            helpKeys removeKey:aComponent ifAbsent:nil
        ]
    ] ifFalse:[
        helpKeys isNil ifTrue:[
            helpKeys := IdentityDictionary new
        ].
        helpKeys at:aComponent put:aKey
    ]

!

keyboardProcessor
    keyboardProcessor isNil ifTrue:[
        keyboardProcessor := KeyboardProcessor new    
    ].
    ^ keyboardProcessor

    "Created: 3.3.1997 / 18:31:37 / cg"
    "Modified: 3.3.1997 / 18:32:27 / cg"
!

namedComponents
    ^ namedComponents
!

source
    "same as #application, for ST-80 compatibility"

    ^ application

    "Created: 17.1.1997 / 19:03:51 / cg"
!

source:anApplicationModel
    "same as #application:, for ST-80 compatibility"

    application := anApplicationModel

    "Modified: 17.1.1997 / 19:03:57 / cg"
!

subCanvasAt:majorKey at:minorKey
    "get the subCanvas specification from major and minor key
    "
    |spec cls dict dkey|

    subCanvasSpecs notNil ifTrue:[
        dkey := majorKey ? #NoMajorKey.
        dict := subCanvasSpecs at:dkey ifAbsent:nil.

        dict notNil ifTrue:[
            spec := dict at:minorKey ifAbsent:nil.
            spec notNil ifTrue:[^ spec].
        ].
    ].

    majorKey isNil ifTrue:[
        spec := self safelyPerform:#specificationFor: with:minorKey.

        spec isNil ifTrue:[
            spec := self safelyPerform:minorKey
        ]
    ] ifFalse:[
        cls := Smalltalk at:majorKey ifAbsent:nil.
        (cls notNil and:[cls respondsTo:minorKey]) ifTrue:[
            spec := cls perform:minorKey
        ]
    ].
  ^ spec

!

subCanvasAt:majorKey at:minorKey put:aSpec
    |dict key|

    key := majorKey ? #NoMajorKey.
    dict := subCanvasSpecs at:key ifAbsent:nil.
    dict isNil ifTrue:[
        dict := IdentityDictionary new.
        subCanvasSpecs at:key put:dict
    ].
    dict at:minorKey put:aSpec

!

visualAt:name
    visuals isNil ifTrue:[^ nil].
    ^ visuals at:name asSymbol ifAbsent:nil

    "Created: 3.3.1997 / 16:24:17 / cg"
!

visualAt:name put:aVisual
    visuals isNil ifTrue:[
        visuals := IdentityDictionary new.
    ].
    visuals at:name asSymbol put:aVisual

    "Created: 3.3.1997 / 16:24:41 / cg"
!

visuals
    ^ visuals

    "Created: 3.3.1997 / 16:24:00 / cg"
!

visuals:aDictionary
    visuals := aDictionary

    "Created: 3.3.1997 / 16:24:06 / cg"
!

window
    "return the top window (view), for which an interface
     is (being) built"

    ^ window

    "Modified: 17.1.1997 / 19:30:00 / cg"
!

window:aView
    "set the top window (view), for which an interface
     is (being) built"

    window := aView

    "Modified: 17.1.1997 / 19:30:22 / cg"
!

windowGroup
    ^ window windowGroup

    "Modified: 17.6.1997 / 18:04:01 / cg"
! !

!WindowBuilder methodsFor:'aspect access support'!

booleanAspectFor:aKey
    "helper (common code) to generate a boolean aspect if required"

    |holder|

    (holder := self bindingAt:aKey) isNil ifTrue:[
        self aspectAt:aKey put:(holder :=  false asValue).
    ].
    ^ holder

    "Created: 28.7.1997 / 12:40:02 / cg"
! !

!WindowBuilder methodsFor:'building'!

buildFromSpec:aSpec
    ^ self subclassResponsibility
!

makeTabable:aComponent
    focusSequence isNil ifTrue:[
        focusSequence := OrderedCollection new.
    ].
    focusSequence add:aComponent
! !

!WindowBuilder methodsFor:'message sending'!

safelyPerform:aSelector
    "send the message aSelector to the receiver self or application;
     the result returned from the send or nil is returned
    "
    |res|

    aSelector isSymbol ifTrue:[
        Object messageNotUnderstoodSignal handle:[:ex |
        ] do:[
            (res := self perform:aSelector) notNil ifTrue:[^ res]
        ].

        application notNil ifTrue:[
            Object messageNotUnderstoodSignal handle:[:ex |
            ] do:[
                (res := application perform:aSelector) notNil ifTrue:[^ res]
            ]
        ]
    ].
  ^ nil
!

safelyPerform:aSelector with:anArgument
    "send the one-arg-message aSelector to the receiver self or application;
     the result returned from the send or nil is returned
    "
    |res|

    aSelector isSymbol ifTrue:[
        Object messageNotUnderstoodSignal handle:[:ex |
        ] do:[
            (res := self perform:aSelector with:anArgument) notNil ifTrue:[^ res]
        ].

        application notNil ifTrue:[
            Object messageNotUnderstoodSignal handle:[:ex |
            ] do:[
                (res := application perform:aSelector with:anArgument) notNil ifTrue:[^ res]
            ]
        ]
    ].
  ^ nil
! !

!WindowBuilder methodsFor:'spec creation aspect fetch'!

actionFor:aKey
    "return an action for aKey. This is invoked during window building
     (by the builder) to ask for an ActionButtons actionBlock.
     Here, first the local bindings are searched, then the application and
     finally the applications class is asked for a corresponding action.
     The returned object is typically a block."

    |b|

    bindings notNil ifTrue:[
        b := bindings at:aKey ifAbsent:nil.
        b notNil ifTrue:[^ b].
    ].

    application notNil ifTrue:[
        Object messageNotUnderstoodSignal handle:[:ex |
            Transcript showCR:'not understood: ' , aKey.
        ] do:[
            ^ application actionFor:aKey
        ]
    ].
    applicationClass notNil ifTrue:[
        (applicationClass respondsTo:#actionFor:) ifTrue:[
            ^ applicationClass actionFor:aKey
        ]
    ].
    ^ []

    "Created: 17.1.1997 / 21:08:22 / cg"
!

aspectFor:aKey
    "return a model for aKey. This is invoked during window building
     (by the builder) to ask for an Editfields, a Toggles etc. model.
     Here, first the local bindings are searched, then the application and
     finally the applications class is asked for a corresponding action.
     The returned object is typically a valueHolder."

    |b|

    bindings notNil ifTrue:[
        b := bindings at:aKey ifAbsent:nil.
        b notNil ifTrue:[^ b].
    ].

    application notNil ifTrue:[
        Object messageNotUnderstoodSignal handle:[:ex |
            Transcript showCR:'not understood: ' , aKey.
        ] do:[
            ^ application aspectFor:aKey
        ]
    ].
    applicationClass notNil ifTrue:[
        (applicationClass respondsTo:#aspectFor:) ifTrue:[
            ^ applicationClass aspectFor:aKey
        ]
    ].
    ^ self aspectAt:aKey

    "Created: 17.1.1997 / 21:06:16 / cg"
!

componentFor:aKey
    "return a component for aKey. This is invoked during window building
     (by the builder) to ask for an ArbitraryComponents view.
     Here, first the local bindings are searched, then the application and
     finally the applications class is asked for a corresponding action.
     The returned object is typically a view."

    |cls component|

    application notNil ifTrue:[
        component := application componentFor:aKey.
        component notNil ifTrue:[^ component].
    ].
    applicationClass notNil ifTrue:[
        (applicationClass respondsTo:#componentFor:) ifTrue:[
            ^ applicationClass componentFor:aKey
        ]
    ].
    ^ self aspectAt:aKey

    "Modified: 20.6.1997 / 11:40:22 / cg"
!

labelFor:aKey
    "return a label for aKey. This is invoked during window building
     (by the builder) to ask for a ???'s label.
     Here, first the local bindings are searched, then the application and
     finally the applications class is asked for a corresponding action.
     The returned object is typically a string."

    |cls|

    application notNil ifTrue:[
        Object messageNotUnderstoodSignal handle:[:ex |
            Transcript showCR:'not understood: ' , aKey.
        ] do:[
            ^ application labelFor:aKey
        ]
    ].
    applicationClass notNil ifTrue:[
        (applicationClass respondsTo:#labelFor:) ifTrue:[
            ^ applicationClass labelFor:aKey
        ]
    ].
    ^ self aspectAt:aKey

!

listFor:aKey
    "return a list for aKey. This is invoked during window building
     (by the builder) to ask for a ???'s label.
     Here, first the local bindings are searched, then the application and
     finally the applications class is asked for a corresponding action.
     The returned object is typically a list."

    application notNil ifTrue:[
        Object messageNotUnderstoodSignal handle:[:ex |
            Transcript showCR:'not understood: ' , aKey.
        ] do:[
            ^ application listFor:aKey
        ]
    ].
    applicationClass notNil ifTrue:[
        (applicationClass respondsTo:#listFor:) ifTrue:[
            ^ applicationClass listFor:aKey
        ]
    ].
    ^ self aspectAt:aKey

    "Created: 17.1.1997 / 21:08:45 / cg"
! !

!WindowBuilder methodsFor:'spec creation callbacks'!

createdComponent:aView forSpec:spec
    componentCreationHook notNil ifTrue:[
        componentCreationHook value:aView value:spec value:self
    ]

    "Modified: 5.9.1995 / 21:42:54 / claus"
! !

!WindowBuilder methodsFor:'startup'!

closeRequest
    window destroy

    "Modified: 17.1.1997 / 19:30:32 / cg"
!

open
    "open my topView, as previously created"

    |type|

    application isNil ifTrue:[
        type := #normal
    ] ifFalse:[
        type := application defaultWindowType
    ].
    self 
        openWithExtent:nil
        andType:type

    "Modified: 3.3.1997 / 19:43:57 / cg"
!

openAt:aPoint
    "open my topView at some location"

    self 
        openAt:aPoint 
        withExtent:nil  
        andType:(application defaultWindowType)

    "Created: 14.2.1997 / 20:21:57 / cg"
    "Modified: 28.2.1997 / 22:50:29 / cg"
!

openAt:origin withExtent:ext andType:type
    "open my window, as previously created, optionally defining the
     windows origin and/or extent. 
     The type argument may be #dialog or #normal, and specifies if the view 
     should be opened as a modal view, blocking interaction to the currently 
     active view, or as a normal view."

    |mainSubView|

    origin notNil ifTrue:[
        window origin:origin
    ].
    ext notNil ifTrue:[
        window extent:ext.
    ] ifFalse:[
        type == #dialog ifTrue:[
            window fixSize
        ]
    ].

    (windowView notNil and:[windowView ~~ window]) ifTrue:[
        windowView extent:(window extent).
    ].

    type == #dialog ifTrue:[
        window fixPosition:(window device pointerPosition - window positionOffset).
        window openModal.
        ^ self
    ].

    type == #normal ifTrue:[
        window isNil ifTrue:[
            self setupWindowFor:(StandardSystemView new).
        ].

        window open.
        ^ self
    ].

    type == #popUp ifTrue:[
        window fixPosition:(window device pointerPosition).
        window openAsPopUp.
        ^ self
    ].

    "
     if ST-80 supports more types - these may be added later
    "
    self halt:'unimplemented'

    "Created: 14.2.1997 / 20:22:24 / cg"
    "Modified: 3.3.1997 / 22:27:52 / cg"
!

openDialog
    "open my topView, as previously created as a modal view,
     blocking interaction to the currently active view."

    self 
        openWithExtent:nil 
        andType:#dialog

    "Modified: 17.1.1997 / 19:59:29 / cg"
!

openDialogAt:aPoint withExtent:ext
    "open my topView, as previously created as a modal view,
     blocking interaction to the currently active view."

    self 
        openAt:aPoint withExtent:ext 
        andType:#dialog

    "Modified: 17.1.1997 / 19:59:36 / cg"
    "Created: 14.2.1997 / 20:24:19 / cg"
!

openDialogWithExtent:ext
    "open my topView, as previously created as a modal view,
     blocking interaction to the currently active view."

    self 
        openWithExtent:ext 
        andType:#dialog

    "Modified: 17.1.1997 / 19:59:36 / cg"
!

openModal
    "open my topView, as previously created"

    self 
        openWithExtent:nil
        andType:#dialog

    "Modified: 3.3.1997 / 19:43:57 / cg"
!

openPopUpAt:aPoint
    "open my topView, as previously created as a popUp view,
     blocking interaction to the currently active view."

    self 
        openAt:aPoint withExtent:nil 
        andType:#popUp

    "Modified: 17.1.1997 / 19:59:29 / cg"
    "Created: 14.2.1997 / 20:24:38 / cg"
!

openPopUpIn:aRectangle
    "open my topView, as previously created as a popUp view,
     blocking interaction to the currently active view."

    self 
        openWithExtent:nil 
        andType:#popUp

    "Modified: 17.1.1997 / 19:59:29 / cg"
    "Created: 17.1.1997 / 20:01:24 / cg"
!

openWindowAt:aPoint
    "open my topView at some location"

    self openAt:aPoint
!

openWindowAt:origin withExtent:ext andType:type
    "open my window, as previously created, optionally defining the
     windows origin and/or extent. 
     The type argument may be #dialog or #normal, and specifies if the view 
     should be opened as a modal view, blocking interaction to the currently 
     active view, or as a normal view."

    ^ self openAt:origin withExtent:ext andType:type
!

openWithExtent:aPoint
    "open my topView, as previously created, but override
     the extent."

    self 
        openWithExtent:aPoint 
        andType:(application defaultWindowType)

    "Modified: 17.1.1997 / 19:58:48 / cg"
!

openWithExtent:ext andType:type
    "open my window, as previously created. The type argument
     may be #dialog or #normal, and specifies if the view should
     be opened as a modal view, blocking interaction to the currently 
     active view, or as a normal view."

    ^ self openAt:nil withExtent:ext andType:type

    "Modified: 14.2.1997 / 20:22:47 / cg"
! !

!WindowBuilder class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/WindowBuilder.st,v 1.44 1997-07-28 10:43:53 cg Exp $'
! !