1 Model subclass:#ValueModel |
1 'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:03:02 pm'! |
2 instanceVariableNames:'accepted' |
2 |
|
3 Model subclass:#ValueModel |
|
4 instanceVariableNames:'accepted interrest' |
3 classVariableNames:'' |
5 classVariableNames:'' |
4 poolDictionaries:'' |
6 poolDictionaries:'' |
5 category:'Interface-Support' |
7 category:'Interface-Support' |
6 ! |
8 ! |
7 |
9 |
8 !ValueModel class methodsFor:'documentation'! |
10 !ValueModel class methodsFor:'documentation'! |
9 |
11 |
|
12 Model class methodsFor:'documentation'! |
|
13 |
|
14 copyright |
|
15 " |
|
16 COPYRIGHT (c) 1995 by Claus Gittinger |
|
17 All Rights Reserved |
|
18 |
|
19 This software is furnished under a license and may be used |
|
20 only in accordance with the terms of that license and with the |
|
21 inclusion of the above copyright notice. This software may not |
|
22 be provided or otherwise made available to, or used by, any |
|
23 other person. No title to or ownership of the software is |
|
24 hereby transferred. |
|
25 " |
|
26 ! |
|
27 |
|
28 version |
|
29 " |
|
30 $Header: /cvs/stx/stx/libview2/Attic/ValModel.st,v 1.4 1995-05-09 00:22:56 claus Exp $ |
|
31 " |
|
32 ! |
|
33 |
10 documentation |
34 documentation |
11 " |
35 " |
12 abstract superclass for ValueHolders and Adaptors. |
36 abstract superclass for ValueHolders and Adaptors. |
|
37 It does not itself know how and where the value is stored, |
|
38 but knows about interrested objects (which get informed, whenever |
|
39 the value changes) and keeps track if the value was ever accepted. |
13 |
40 |
14 Notice: this class was implemented using protocol information |
41 Notice: this class was implemented using protocol information |
15 from alpha testers - it may not be complete or compatible to |
42 from alpha testers - it may not be complete or compatible to |
16 the corresponding ST-80 class. If you encounter any incompatibilities, |
43 the corresponding ST-80 class. If you encounter any incompatibilities, |
17 please forward a note to the ST/X team. |
44 please forward a note to the ST/X team. |
|
45 |
|
46 subclasses must redefine: #setValue: and #value |
|
47 (and optionally redefine #value:) |
18 " |
48 " |
19 ! ! |
49 ! ! |
20 |
50 |
21 !ValueModel class methodsFor:'instance creation'! |
51 !ValueModel class methodsFor:'instance creation'! |
22 |
52 |
23 new |
53 new |
24 ^ (super new) initialize |
54 ^ (super new) initialize |
25 ! ! |
55 ! ! |
26 |
56 |
27 !ValueModel methodsFor:'initialization'! |
57 !ValueModel methodsFor:'change notification'! |
28 |
58 |
29 initialize |
59 notifyChange:aSymbol |
30 accepted := false |
60 interrest notNil ifTrue:[ |
|
61 interrest keysAndValuesDo:[:someone :selector | |
|
62 someone perform:selector |
|
63 ]. |
|
64 ]. |
|
65 self changed:aSymbol |
31 ! ! |
66 ! ! |
32 |
67 |
33 !ValueModel methodsFor:'accessing'! |
68 !ValueModel methodsFor:'accessing'! |
|
69 |
|
70 value:anObject |
|
71 |oldValue| |
|
72 |
|
73 oldValue := self value. |
|
74 self setValue:anObject. |
|
75 anObject ~= oldValue ifTrue:[ |
|
76 self notifyChange:#value |
|
77 ] |
|
78 ! |
|
79 |
|
80 accepted |
|
81 ^ accepted |
|
82 ! |
34 |
83 |
35 accept |
84 accept |
36 accepted := true |
85 accepted := true |
37 ! |
86 ! |
38 |
87 |
40 self subclassResponsibility |
89 self subclassResponsibility |
41 ! |
90 ! |
42 |
91 |
43 setValue:newValue |
92 setValue:newValue |
44 self subclassResponsibility |
93 self subclassResponsibility |
|
94 ! ! |
|
95 |
|
96 !ValueModel methodsFor:'initialization'! |
|
97 |
|
98 initialize |
|
99 accepted := false |
|
100 ! ! |
|
101 |
|
102 !ValueModel methodsFor:'interrest'! |
|
103 |
|
104 retractInterrestFor:someone |
|
105 "release interrest i.e. do no longer send changeMsg to changeReceiver |
|
106 iff someone is the changeReceiver. |
|
107 This can be used to (temporarily) turn off information sends, |
|
108 to break endless cycles (if two values change each other)" |
|
109 |
|
110 interrest notNil ifTrue:[ |
|
111 interrest removeKey:someone ifAbsent:nil |
|
112 ] |
45 ! |
113 ! |
46 |
114 |
47 value:anObject |
115 onChangeSend:selector to:someone |
48 |oldValue| |
116 "add an interrest, arranging that |
|
117 a message with selector will be sent to someone |
|
118 when my value changes." |
49 |
119 |
50 oldValue := self value. |
120 interrest isNil ifTrue:[ |
51 self setValue:anObject. |
121 interrest := IdentityDictionary new |
52 anObject ~= oldValue ifTrue:[ |
122 ]. |
53 self changed:#value |
123 interrest at:someone put:selector |
54 ] |
|
55 ! ! |
124 ! ! |
56 |
125 |