"

 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.

"

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.

"

!

version

"

$Header: /cvs/stx/stx/libview2/PluggableAdaptor.st,v 1.6 1995-08-29 17:44:33 claus Exp $

"

!

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.

"

!

examples 

"

    an adaptor for the variable x:

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

    an adaptor to send #destroy:

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

    as above, more convenient setup:

	|m t|

	t := Button new.

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

	t model:m.

	t label:'close me'.

	t open.

    extract values from a complex model:

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

    extract values from a  point into different labels:

	|p t l|

	p := 10 @ 20.

	t := HorizontalPanelView new.

	t extent:200@50.

	t horizontalLayout:#fitSpace.

	l := Label in:t.

	l model:((PluggableAdaptor on:p) getSelector:#x putSelector:#x:);

	  labelMessage:#value; aspect:#value;

	  level:-1;

	  sizeFixed:true.

	l := Label in:t.

	l model:((PluggableAdaptor on:p) getSelector:#y putSelector:#y:);

	  labelMessage:#value; aspect:#value;

	  level:-1;

	  sizeFixed:true.

	t open.

	(Delay forSeconds:5) wait.

	p x:100.

	p changed.

    extract values from an array into different labels:

	|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:5) wait.

	a at:1 put:'1'.

	a changed.

"

! !

!PluggableAdaptor class methodsFor:'instance creation'!

on:anObject

    ^ self new model:anObject

! !

!PluggableAdaptor methodsFor:'initialize-release'!

model:anObject

    model notNil ifTrue:[

       model removeDependent:self

    ].

    model := anObject.

    model addDependent:self

!

subjectChannel:aValueHolder

    self model:aValueHolder

!

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

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

!

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

		   ]

!

collectionIndex:idx

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

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

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

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

    updateBlock := [:model :aspect :parameter | 

			aspect isNil or:[aspect == #value]

		   ]

!

getBlock:block1 putBlock:block2 updateBlock:block3

    "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 := block1.

    putBlock := block2.

    updateBlock := block3.

! !

!PluggableAdaptor methodsFor:'accessing'!

value

    getBlock notNil ifTrue:[

	^ getBlock value:model 

    ].

    ^ model value "/ stupid default

!

setValue:newValue 

    putBlock notNil ifTrue:[

	^ putBlock value:model value:newValue 

    ].

    model value:newValue "/ stupid default

! !

!PluggableAdaptor methodsFor:'changes'!

update:something with:aParameter from:changedObject

    changedObject == model ifTrue:[

	updateBlock notNil ifTrue:[

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

	    ifTrue:[

"/                self notifyChange:#value

		self changed:#value

	    ]

	]

    ].

! !