----
 proc comment {text} {}
 proc prepend {varname data} {
   upvar $varname tmp
   set tmp "[set data][set tmp]"
 }
 proc lexclude {b a} {
   # returns list a where all elements of list b have been removed.
   set tmp [list]
   foreach item $a {
     if {[lsearch $b $item] == -1} {
       lappend tmp $item
     }
   }
   return $tmp
 }
 comment {
[Zarutian] 19 june 2005: This developed out of the idea outlined by the Croquet Project (http://www.opencroquet.org/Croquet_Technologies/architecture.html). 
Which is to replicate state of an object over many machines and synchronize those replicas.

This is a bit crude and thrown together implemention.

First, start of by setting up an slave interp. Alias after to be able to capture after scripts.

 }
 set i [interp create -safe]

 proc slave_after args {
   puts "debug: [info level 0]"
   set i [lindex $args 0]
   if {[lindex $args 1] != "info"} {
     store_after_script [lindex $args 0] [clock seconds] [lrange $args 1 end]
   }
   set tmp $i
   lappend tmp "invokehidden" 
   lappend tmp "after"
   foreach arg [lrange $args 1 end] { lappend tmp $arg }
   puts "debug:\t \$tmp = [list $tmp]"
   eval $tmp  
 }
 $i hide after
 $i alias after slave_after $i
 comment {
Then set up probe procedures for dumping the state of the slave interp.
 }
 #proc store_after_script {interp when_invoked args} {
 #  puts "debug: [info level 0]"
 #  variable after_scripts
 #  set first [lindex $args 0]
 #  if {[string is digit $first]} {
 #    while {[string length $first] < 4} {
 #      prepend first "0" 
 #    }
 #    append after_scripts($interp) "when \{\[clock seconds\] > ($when_invoked +"
 #    append after_scripts($interp) " [string range $first 0 end-3])\} \{\n"
 #    append after_scripts($interp) "  after [string range $first end-2 end] [list [lindex [lindex $args 1] 1]]\n"
 #    append after_scripts($interp) "\} 1000\n"
 #  } else {
 #    append after_scripts($interp) "when \{\[clock seconds\] > $when_invoked \} \{\n  after "
 #    foreach arg $args {
 #      append after_scripts($interp) $arg
 #      append after_scripts($interp) " "
 #    } 
 #    append after_scritps($interp) "\n\}\n"
 #  }
 #}
 proc store_after_script {interp when_invoked args} {
   puts "debug: [info level 0]"
   variable after_scripts
   append after_scripts($interp) "reschedule_after_script $when_invoked [list $args]\n"
 }
 proc capture_after_scripts {interp} {
   set res {
     proc when {condition body {interval 1000}} {
       if $condition $body else {
         after $interval [info level 0]
       }
     }
   }
   variable after_scripts
   if {[info exists after_scritps($interp)]} {
     append res $after_scripts($interp)
   }
   return $res
 }
 # a helper functions:
 proc interp_ns {interp namespace script} {
   return [$interp eval [list namespace eval $namespace $script]]
 }
 proc list_vars {interp namespace} {
   set globals [interp_ns $interp $namespace {info globals}]
   if {$namespace == {}} { set globals {} }
   set vars [interp_ns $interp $namespace {info vars}]
   return [lexclude $globals $vars]
 }
 proc capture_vars {interp {namespace {}}} {
   set vars [list_vars $interp $namespace]
      set tmp "# variables: \n"
   append tmp "namespace eval [list $namespace] \{\n"
   foreach var $vars {
     if {[interp_ns $interp $namespace [list array exists $var]]} {
       append tmp "array set [list $var] [list [interp_ns $interp $namespace [list array get $var]]]\n"
     } else {
       append tmp "set [list $var] [list [interp_ns $interp $namespace [list set $var]]]\n"
     }
   }
   append tmp "\}"
   return $tmp
 }
 proc capture_procs {interp {namespace {}}} {
   set procs [interp_ns $interp $namespace {info procs}]
   set tmp "# procedures: \n"
   append tmp "namespace eval [list $namespace] \{\n"
   foreach proc $procs {
     # dangerous asumption: expect that no variable will be named: {}
     # why: because it's the only way to squease data out of [info default]
     # proposed alt: add an -withDefaults to [info args]
     set args [list]
     foreach arg [interp_ns $interp $namespace [list info args $proc]] {
       if {[interp_ns $interp $namespace [list info default $proc $arg {}]]} {
         lappend args [list $arg [interp_ns $interp $namespace [list set {}]]]
       } else {
         lappend args $arg
       }
       catch { [interp_ns $interp $namespace [list unset {}]] }
     }
     set body [interp_ns $interp $namespace [list info body $proc]]
     append tmp "proc [list $proc] [list $args] [list $body]\n"
   }
   append tmp "\}"
   return $tmp
 }
 proc capture_varTraces {interp {namespace {}}} {
   set vars [list_vars $interp $namespace]
      set tmp "# traces on variables: \n"
   append tmp "namespace eval [list $namespace] \{\n"
   foreach var $vars {
     set traces [interp_ns $interp $namespace [list trace info variable $var]]
     foreach trace $traces {
       append tmp "trace add variable [list $var] [list [lindex $trace 0]] [list [lindex $trace 1]]\n"
     }
   }
   append tmp "\}"
   return $tmp
 }
 proc capture_all {interp {namespace {}}} {
   set tmp ""
   if {$namespace == {}} {
     append tmp "# Fascmile of interp state -BEGIN- \n"
   }
   append tmp "[capture_vars  $interp $namespace]\n"
   append tmp "[capture_procs $interp $namespace]\n"
   append tmp "[capture_varTraces $interp $namespace]\n"
   append tmp "[capture_after_scripts $interp]\n"

   set children [$interp eval [list namespace children $namespace]]
   if {[llength $children] > 0} {
     foreach child $children {
       append tmp [capture_all $interp $child]
     }
   }
   if {$namespace == {}} {
     append tmp "# Fascmile of interp state -END- \n"
   }
   return $tmp
 }

 proc update_replicas args {
   puts "debug: [info level 0]"
   variable channels_to_Replicas'_masters
   foreach chan [set channels_to_Replicas'_masters] {
     catch {
       puts $chan "cause [list $args]"
       flush $chan
     }
   }
 }
 comment {
Next handle incoming requests from other instances of the same replicated slave interp
 }
 proc connection_handler {sock} {
   variable buffers
   append buffers($sock) [gets $sock]
   append buffers($sock) "\n"
   if {[info complete $buffers($sock)]} {
     switch -exact -- [lindex $buffers($sock) 0] {
       "cause" {
         variable i
         if {[lsearch [$i hidden] [lindex [lindex $buffers($sock) 1] 0]] != -1} {
           set tmp $i
           lappend tmp "invokehidden"
           foreach item [lindex $buffers($sock) 1] { lappend tmp $item }
           eval $tmp
         } else {
           $i eval [lindex $buffers($sock) 1]
         }
       }
       "gimme_snapshot" {
         variable i
         set tmp [capture_all $i]
         catch {
           puts $sock "snapshot [list $tmp]"
           flush $sock
         }
       }
     }
     unset buffers($sock)
   }
   if {[eof $sock]} { close $sock; return }
 }
 comment {
Not fully tested yet

I am thinking I am aproaching this proplem from a wrong perspective.

[Lars H], 20 June 2005: Maybe if you gave more of an explanation of how it's supposed to work someone could lend a hand. For starters, what's the idea behind doing something special with [after]? It's probably a key part of the approach, but to what end isn't terribly clear from the above.

As an aside, the many
  puts "debug: ..."
lines are better coded like e.g.
  putdebug ...
with
  proc putdebug {str} {puts "debug: $str"}
as they can then easily be disabled by a simple
  proc putdebug {str} {}
when you're not debugging.

[Zarutian] 22 june 2005: Well the basic idea is to store the starting state of an object 
(here an slave interp), instancenate an object by using that state (replicate the object) 
and synchronise these two (or more) replicas together by sending external influences to all replicas in the same sequence as they occur (from some coordnator's point of view which could be the origin replica of a given external influence). How's that for a sentence ;-)

Why I have such an intrest in after is that unfired after-scripts are part of the slave's interp state.
 }

 comment {
[Zarutian] 19 june 2005 23:23 : Something like this would be cleaner:

   proc makeReplicatedSafeInterp {sync_proc {seed -1}} {
     proc [lindex [info level 0] 0] [list sync_chan [list seed [incr seed]]] [info body [lindex [info level 0]]
     set body {
       # nearly instance variables ;-)
       set body %body%
       set sync_proc %sync_proc%
       set sub_interp %sub_interp%
       set state_log %state_log%
       # initilize
       set dispatch false
  
       # method dispatch: (or nearly so)
       switch -exact -- [lindex $args 0] {
         "alias_called" {
           set tmp $sub_interp
           lappend tmp "invokehidden"
           foreach arg [lrange $args 1 end] {
             lappend tmp arg
           }
           eval $tmp
         }
         "eval" {
           $sync_proc cause [lrange $args 1 end] [lindex [info level 0] 0]
           set dispatch true
         }
         default { set dispatch true }
       }
       
       # save yourself!
       set subst [list \%body\% $body \ 
                       \%sync_proc\% $sync_proc \
                       \%sub_interp\% $sub_interp \
                       \%state_log\% $state_log
                 ]
       proc [lindex [info level 0] 0] args [string map $subst $body]

       if {$dispatch} {
         set tmp $sub_interp
         foreach arg $args {
           lappend tmp $arg
         }
         return [eval $tmp]
       }
     }
     set subst [list \%body\% $body \ 
                     \%sync_proc\% $sync_proc \
                     \%sub_interp\% $sub_interp \
               ]
     proc "replicaInterp[set seed]" args [string map $subst $body]
   }
 }
----