1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
#!/usr/bin/env tclsh
## -*- tcl -*-
package require comm
package require tie
set id [lindex $argv 0]
array set local {}
proc export {localvar remotevar remoteid} {
uplevel #0 [list tie::tie $localvar remotearray $remotevar {comm::comm send} $remoteid]
return
}
proc import {remotevar remoteid localvar} {
comm::comm send $remoteid [list \
tie::tie $remotevar remotearray \
$localvar {comm::comm send} [comm::comm self] \
]
}
proc ExecChanges {list} {
if {![llength $list]} return
uplevel #0 [lindex $list 0]
after 100 [list ExecChanges [lrange $list 1 end]]
}
proc Track {args} {
global receiver
puts *\ \[[join $args "\] \["]\]\ ([dictsort [array get receiver]])
return
}
proc dictsort {dict} {
array set a $dict
set out [list]
foreach key [lsort [array names a]] {
lappend out $key $a($key)
}
return $out
}
export local server $id
import server $id local
trace add variable local {write unset} Track
comm::comm send $id {
proc ExecChanges {list} {
puts ($list)
if {![llength $list]} return
uplevel #0 [lindex $list 0]
after 100 [list ExecChanges [lrange $list 1 end]]
}
}
set changes {
{set local(a) 0}
{set local(a) 1}
{set local(b) .}
{unset local(a)}
{array set local {xa @ xb *}}
{array unset local x*}
}
lappend changes \
[list comm::comm send $id [list ExecChanges {
{set server(ZZ) foo}
{set server(XX) bar}
}]]
after 2000 [list ExecChanges $changes]
vwait forever
|
