"

 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.

"

"{ Package: 'stx:libview2' }"

ValueModel subclass:#PluggableAdaptor

	instanceVariableNames:'model getBlock putBlock updateBlock'

	classVariableNames:''

	poolDictionaries:''

	category:'Interface-Support-Models'

!

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

"

    Allows forwarding of value/value:/change messages via blocks.

    Kind of what ST/X always did ....

    PluggableAdaptor is the most general of the adaptor models -

    any other adapter can be simulated. However, they incur certain

    overhead and complexity. 

    Therefore, in many situations, an AspectAdaptor is the better choice.

    Notice: 

        this class was implemented using protocol information

        from alpha testers - it may not be complete or compatible to

        the corresponding ST-80 class. 

        If you encounter any incompatibilities, please forward a note 

        describing the incompatibility verbal (i.e. no code) to the ST/X team.

    [author:]

        Claus Gittinger

"

!

examples 

"

    an adaptor for the variable x:

                                                                        [exBegin]

        |m x t|

        m := (PluggableAdaptor new)

                getBlock:[:m | x]

                putBlock:[:m :newValue | x := newValue. Transcript showCR:x]

                updateBlock:[:m :aspect :param | Transcript showCR:'changed'].

        t := Toggle new.

        t model:m.

        t label:'toggle me'.

        t open.

                                                                        [exEnd]

    an adaptor to send #destroy:

                                                                        [exBegin]

        |m t|

        m := (PluggableAdaptor new)

                getBlock:[:m | false]

                putBlock:[:m :newValue | t destroy]

                updateBlock:[:m :aspect :param | ].

        t := Button new.

        t model:m.

        t label:'close me'.

        t open.

                                                                        [exEnd]

    as above, more convenient setup:

                                                                        [exBegin]

        |m t|

        t := Button new.

        m := (PluggableAdaptor on:t) performAction:#destroy.

        t model:m.

        t label:'close me'.

        t open.

                                                                        [exEnd]

    extract values from a complex model:

                                                                        [exBegin]

        |model dialog  name pId|

        model := Plug new.

        model respondTo:#name with:[name].

        model respondTo:#name: with:[:newValue | name := newValue].

        model respondTo:#passportId with:[pId].

        model respondTo:#passportId: with:[:newValue | pId := newValue].

        name := 'John Smith'.

        pId := 56785432.

        dialog := Dialog new.

        dialog addInputFieldOn:((PluggableAdaptor on:model)

                                    getBlock:[:m | m name]

                                    putBlock:[:m :v | m name:v]

                                    updateBlock:[:m :a :p | false]).

        dialog addVerticalSpace.

        dialog addInputFieldOn:((PluggableAdaptor on:model)

                                    getBlock:[:m | m passportId printString]

                                    putBlock:[:m :v | m passportId:v asNumber]

                                    updateBlock:[:m :a :p | false]).

        dialog addAbortButton; addOkButton.

        dialog width:200; sizeFixed:true.

        dialog open.

        dialog accept value ifTrue:[

            Transcript showCR:'accepted.'.

        ].

        Transcript showCR:'  Name: ' , model name.

        Transcript showCR:'  ID  : ' , model passportId printString.

                                                                        [exEnd]

    extract values from an association into different labels:

                                                                        [exBegin]

        |assoc t l|

        assoc := 'hello' -> 'world'.

        t := HorizontalPanelView new.

        t extent:200@50.

        t horizontalLayout:#fitSpace.

        l := Label in:t.

        l model:((PluggableAdaptor on:assoc) getSelector:#key putSelector:#key:);

          labelMessage:#value; aspect:#value;

          level:-1.

        l := Label in:t.

        l model:((PluggableAdaptor on:assoc) getSelector:#value putSelector:#value:);

          labelMessage:#value; aspect:#value;

          level:-1.

        t open.

        (Delay forSeconds:3) wait.

        assoc key:'goodbye'.

        assoc changed.

                                                                        [exEnd]

    extract values from an array into different labels:

                                                                        [exBegin]

        |a t l|

        a := #('one' 'two' 'three').

        t := HorizontalPanelView new.

        t extent:200@50.

        t horizontalLayout:#fitSpace.

        l := Label in:t.

        l model:((PluggableAdaptor on:a) collectionIndex:1);

          labelMessage:#value; aspect:#value;

          level:-1;

          sizeFixed:true.

        l := Label in:t.

        l model:((PluggableAdaptor on:a) collectionIndex:2);

          labelMessage:#value; aspect:#value;

          level:-1;

          sizeFixed:true.

        l := Label in:t.

        l model:((PluggableAdaptor on:a) collectionIndex:3);

          labelMessage:#value; aspect:#value;

          level:-1;

          sizeFixed:true.

        t open.

        (Delay forSeconds:3) wait.

        a at:1 put:'1'.

        a changed.

                                                                        [exEnd]

"

! !

!PluggableAdaptor class methodsFor:'instance creation'!

on:anObject

    "create & return a new protocolAdaptor.

     Any get/put and updateBlocks are still to be defined"

    ^ self new model:anObject

    "Modified: 21.2.1997 / 18:31:22 / cg"

! !

!PluggableAdaptor methodsFor:'accessing'!

setValue:newValue 

    putBlock notNil ifTrue:[

	^ putBlock value:model value:newValue 

    ].

    model value:newValue "/ stupid default

!

value

    getBlock notNil ifTrue:[

	^ getBlock value:model 

    ].

    ^ model value "/ stupid default

!

valueUsingSubject:someObject

    someObject isNil ifTrue:[^ nil].

    ^ getBlock value:someObject

    "Created: 21.2.1997 / 18:28:35 / cg"

! !

!PluggableAdaptor methodsFor:'change & update'!

update:something with:aParameter from:changedObject

    changedObject == model ifTrue:[

        updateBlock notNil ifTrue:[

            (updateBlock value:model value:something value:aParameter)

            ifTrue:[

                self changed:#value

            ]

        ]

    ].

    "Modified: 21.2.1997 / 18:28:52 / cg"

! !

!PluggableAdaptor methodsFor:'initialization & release'!

collectionIndex:idx

    "configure the adaptor to translate #value/#value:-messages into

     indexed accesses via #at:/#at:put:, using the supplied index"

    getBlock := [:model | model value at:idx].

    putBlock := [:model :newValue | model value at:idx put:newValue].

    updateBlock := [:model :aspect :parameter | 

                        aspect isNil or:[aspect == #value]

                   ]

    "Modified: 21.2.1997 / 18:20:24 / cg"

!

getBlock:newGetBlock putBlock:newPutBlock

    "configure the adaptor to translate #value/#value:-messages into

     evaluation of the corresponding block1/block2.

     The getBlock argument block1 is called with one argument, the model, and is

     supposed to extract & return a value from that model.

     The putBlock argument, block2 is called with 2 arguments, the model

     and the new value, and is supposed to store the new value."

    getBlock := newGetBlock.

    putBlock := newPutBlock.

!

getBlock:newGetBlock putBlock:newPutBlock updateBlock:newUpdateBlock

    "configure the adaptor to translate #value/#value:-messages into

     evaluation of the corresponding block1/block2.

     The getBlock argument block1 is called with one argument, the model, and is

     supposed to extract & return a value from that model.

     The putBlock argument, block2 is called with 2 arguments, the model

     and the new value, and is supposed to store the new value.

     The updateBlock argument, block3 is called with 3 arguments, the model,

     the aspect as changed in the model and the change parameter. It

     is called when the adaptor receives an update message from the model, 

     and should return true if a new value should be fetched from the model."

    getBlock := newGetBlock.

    putBlock := newPutBlock.

    updateBlock := newUpdateBlock.

    "Modified: 21.2.1997 / 18:18:38 / cg"

!

getSelector:getSelector putSelector:putSelector 

    "configure the adaptor to translate #value-messages into a send of

     getSelector and #value:-messages into sends of putSelector."

    getBlock := [:model | model perform:getSelector].

    putBlock := [:model :newValue | model perform:putSelector with:newValue].

    updateBlock := [:model :aspect :parameter | 

                        aspect isNil

                        or:[aspect == getSelector 

                        or:[aspect == #value]]

                   ]

    "Modified: 21.2.1997 / 18:21:27 / cg"

!

model:anObject

    model notNil ifTrue:[

       model removeDependent:self

    ].

    model := anObject.

    model notNil ifTrue:[

        model addDependent:self

    ]

!

performAction:aSelector 

    "configure the adaptor to send an aSelector-message to the model

     whenever a new value is stored via #value:"

    getBlock := [:model | nil].

    putBlock := [:model :newValue | model perform:aSelector].

    updateBlock := [:model :aspect :parameter | false]

!

selectValue:something 

    "configure the adaptor to behave like a boolean value, returning

     true whenever the models value equals something"

"/    getBlock := [:model | model value = something].

"/    putBlock := [:model :newValue | newValue ifTrue:[model value:something]].

"/    updateBlock := [:model :aspect :parameter | 

"/                        aspect isNil or:[aspect == #value]

"/                   ]

    "/ changed for vw compatibility

    |lastValue|

    lastValue := nil.

    getBlock := [:model | lastValue := (model value = something)].

    putBlock := [:model :newValue | newValue 

                                        ifTrue:[model value:something]

                                        ifFalse:[model value = something

                                                     ifTrue:[model value:nil]

                                        ]

                ].

    updateBlock := [:model :aspect :parameter |

                        ((model value = something) = lastValue) not

                   ]

    "Modified: 31.12.1996 / 13:58:09 / stefan"

    "Modified: 21.2.1997 / 18:27:26 / cg"

!

subjectChannel:aValueHolder

    "setup to use aValueHolder as model"

    self model:aValueHolder

    "Modified: 21.2.1997 / 18:19:46 / cg"

! !

!PluggableAdaptor class methodsFor:'documentation'!

version

    ^ '$Header: /cvs/stx/stx/libview2/PluggableAdaptor.st,v 1.18 2006-03-06 08:45:55 cg Exp $'

! !