"{ Encoding: utf8 }"

"

 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' }"

"{ NameSpace: Smalltalk }"

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]

    choose one from alternatives (radioButton-like behavior):

                                                                        [exBegin]

        |m v|

        m := #foo asValue.

        v := HorizontalPanelView new.

        v add:(Toggle on:((PluggableAdaptor on:m) selectValue:#foo) label:'foo' ).

        v add:(Toggle on:((PluggableAdaptor on:m) selectValue:#bar) label:'bar' ).

        v add:(Toggle on:((PluggableAdaptor on:m) selectValue:#baz) label:'baz' ).

        v add:(Label label:'Current:' ).

        v add:(Label new labelChannel:m ).

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

!

on:anObject getter:getterBlock

    ^ (self on:anObject) getter:getterBlock

    "Created: / 08-08-2004 / 21:54:04 / janfrog"

    "Modified: / 20-04-2005 / 18:59:28 / janfrog"

    "Modified: / 22-12-2010 / 11:29:14 / cg"

!

on:anObject getter:getterBlock setter:setterBlock

    ^ (self on:anObject) getter:getterBlock setter:setterBlock

    "Created: / 08-08-2004 / 21:53:58 / janfrog"

    "Modified: / 20-04-2005 / 18:59:28 / janfrog"

    "Modified: / 22-12-2010 / 11:29:18 / cg"

!

on:anObject setter:setterBlock

    ^ (self on:anObject)

        setter:setterBlock

    "Created: / 08-08-2004 / 21:54:12 / janfrog"

    "Modified: / 20-04-2005 / 18:59:28 / janfrog"

! !

!PluggableAdaptor methodsFor:'accessing'!

getBlock

    ^ getBlock

!

putBlock

    ^ putBlock

!

setValue:newValue

    putBlock notNil ifTrue:[

	^ putBlock value:model value:newValue

    ].

    model value:newValue "/ stupid default

!

updateBlock

    ^ updateBlock

!

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

    "configure the adaptor to translate #value-messages into

     evaluation of the corresponding block.

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

     supposed to extract & return a value from that model."

    getBlock := newGetBlock.

!

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.

    self assert:(newUpdateBlock isNil or:[newUpdateBlock argumentCount == 3]).

    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

    "get the real model, into which / from which the

     real model value is converted"

    ^ model 

!

model:anObject

    "set the real model, into which / from which the

     real model value is converted"

    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]

!

putBlock:newPutBlock

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

     evaluation of the corresponding block2.

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

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

    putBlock := newPutBlock.

!

selectValue:something

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

     true whenever the model's 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 methodsFor:'utilities'!

getter:getterBlock

    self

        getter:getterBlock

        setter:[:value|self shouldNeverBeReached]

    "Created: / 08-08-2004 / 21:53:02 / janfrog"

    "Modified: / 20-04-2005 / 18:59:28 / janfrog"

!

getter:getter setter:setter

    | getterBlock setterBlock |

    getterBlock := getter.

    setter argumentCount == 1 ifTrue:[

        setterBlock := [:model :value| model value:(setter  value:value)]

    ] ifFalse:[

        setterBlock := setter

    ].

    self

        getBlock:getterBlock

        putBlock:setterBlock

        updateBlock:[:model :aspect :value|true]

    "Created: / 08-08-2004 / 21:52:20 / janfrog"

    "Modified: / 20-04-2005 / 18:59:28 / janfrog"

    "Modified: / 14-03-2014 / 23:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

setter:setterBlock

    self

        getter:[:value|self shouldNeverBeReached]

        setter:setterBlock

    "Created: / 08-08-2004 / 21:53:19 / janfrog"

    "Modified: / 20-04-2005 / 18:59:28 / janfrog"