1 files changed, 118 insertions, 0 deletions
diff --git a/tcllib/modules/tie/tie_rarray.tcl b/tcllib/modules/tie/tie_rarray.tcl
new file mode 100644
index 0000000..eb4d6d5
--- /dev/null
+++ b/tcllib/modules/tie/tie_rarray.tcl
@@ -0,0 +1,118 @@
+# tie_rarray.tcl --
+#
+#	Data source: Remote Tcl array.
+#
+# Copyright (c) 2004-2015 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# 
+# RCS: @(#) $Id: tie_rarray.tcl,v 1.3 2005/09/28 04:51:24 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require snit
+package require tie
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+snit::type ::tie::std::rarray {
+
+    # ### ### ### ######### ######### #########
+    ## Specials
+
+    pragma -hastypemethods no
+    pragma -hasinfo        no
+    pragma -simpledispatch yes
+
+    # ### ### ### ######### ######### #########
+    ## API : Construction & Destruction
+
+    constructor {rvar cmdpfx id} {
+	set remotevar $rvar
+	set cmd       $cmdpfx
+	set rid       $id
+
+	if {![$self Call array exists $rvar]} {
+	    return -code error "Undefined source array variable \"$rvar\""
+	}
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ## API : Data source methods
+
+    method get {} {
+	return [$self Call array get $remotevar]
+    }
+
+    method set {dict} {
+	$self Call array set $remotevar $dict
+	return
+    }
+
+    method unset {{pattern *}} {
+	$self Call array unset $remotevar $pattern
+	return
+    }
+
+    method names {} {
+	return [$self Call array names $remotevar]
+    }
+
+    method size {} {
+	return [$self Call array size $remotevar]
+    }
+
+    method getv {index} {
+	return [$self Call set ${remotevar}($index)]
+    }
+
+    method setv {index value} {
+	$self Call set ${remotevar}($index) $value
+	return
+    }
+
+    method unsetv {index} {
+	$self Call unset -nocomplain ${remotevar}($index)
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ## Internal : Instance data
+
+    variable remotevar {} ; # Name of rmeote array
+    variable cmd       {} ; # Send command prefix
+    variable rid       {} ; # Id of entity hosting the array.
+
+    # ### ### ### ######### ######### #########
+    ## Internal: Calling to the remote entity.
+
+    ## All calls are synchronous. Asynchronous operations would
+    ## created problems with circular ties. Because the operation may
+    ## came back so much later that the origin is already in a
+    ## completely new state. This is avoied in synchronous mode as the
+    ## origin waits for the change to be acknowledged, and the
+    ## operation came back in this time. The change made by it is no
+    ## problem. The trace is still running, thus any write does _not_
+    ## re-invoke our trace. The only possible problem is an unset for
+    ## an element already gone. This was solved by using -nocomplain
+    ## when propagating this type of change.
+
+    method Call {args} {
+	set     c $cmd
+	lappend c $rid
+	lappend c $args
+	return [uplevel #0 $c]
+    }
+
+    # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready to go
+
+::tie::register ::tie::std::rarray as remotearray
+package provide   tie::std::rarray 1.0.1