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