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