--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PluggableAdaptor.st Tue May 16 19:14:48 1995 +0200
@@ -0,0 +1,266 @@
+"
+ 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:'realModel 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.1 1995-05-16 17:13: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, so in many situations, an AspectAdaptor or
+ is the better choice.
+
+ example (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.
+
+
+
+ example (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 an array:
+
+ |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.
+ l := Label in:t.
+ l model:((PluggableAdaptor on:a) collectionIndex:2);
+ labelMessage:#value; aspect:#value;
+ level:-1.
+ l := Label in:t.
+ l model:((PluggableAdaptor on:a) collectionIndex:3);
+ labelMessage:#value; aspect:#value;
+ level:-1.
+ 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
+ realModel notNil ifTrue:[
+ realModel removeDependent:self
+ ].
+ realModel := anObject.
+ realModel 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 == 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 == #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:realModel
+ ].
+ ^ realModel value "/ stupid default
+!
+
+setValue:newValue
+ putBlock notNil ifTrue:[
+ ^ putBlock value:realModel value:newValue
+ ].
+ realModel value:newValue "/ stupid default
+! !
+
+!PluggableAdaptor methodsFor:'changes'!
+
+update:something with:aParameter from:changedObject
+ changedObject == realModel ifTrue:[
+ updateBlock notNil ifTrue:[
+ (updateBlock value:realModel value:something value:aParameter)
+ ifTrue:[
+ self changed:#value
+ ]
+ ]
+ ].
+! !