# VERSION 1.3
 # Code below by Zarutian is under the Creative Commons SH-BY lisence.
 # Contact him if any other lisence is required.
 proc makeSerializableSafeSlaveInterp {interp} {
   interp create $interp -safe
   foreach command [$interp eval {info commands}] {
     $interp hide $command
     $interp alias $command passThrough $interp $command
   }
   $interp alias rename slaveRename $interp
 }
 proc passThrough args {
   set interp  [lindex $args 0]
   set command [lindex $args 1]
   set args    [lrange $args 2 end]
   set temp [list $interp invokehidden [set command]]
   foreach arg $args {
     lappend temp $arg
   }
   return [eval $temp]
 }
 proc slaveRename args {
   set interp  [lindex $args 0]
   set oldname [lindex $args 1]
   set newname [lindex $args 2]

   if {[$interp invokehidden info procs $oldname] != {}} {
     return [$interp invokehidden rename $oldname $newname]
   }
   $interp invokehidden rename $oldname {}
   $interp alias $newname passThrough $interp $oldname

 }
 proc serializeInterp {interp {ns {}}} {
   set result [list]
   if {$ns == {}} {
     if {[llength [interp invokehidden $interp -global file channels]] > 0} {
       error "cant serialize an interp that has IO channels open!"
     }
   }
   set vars [interp invokehidden $interp -global info vars [set ns]::*]
   foreach var $vars {
     if {[$interp invokehidden -global array exists $var]} {
       lappend result [list array $var [interp invokehidden $interp -global array get $var]]
     } else {
       lappend result [list scalar $var [interp invokehidden $interp -global set $var]]
     }
   }
   set procs [interp invokehidden $interp -global info procs [set ns]::*]
   foreach proc $procs {
     lappend result [list proc $proc [interp invokehidden $interp -global info args $proc] [interp invokehidden $interp -global info body $proc]]
   }
   foreach item [interp aliases $interp] {
     #set alias [interp alias $interp $item]
     # if {([lindex $alias 0] == "passThrough") && \
     #    ([lindex $alias 1] == $interp) && \
     #    ([lindex $alias 2] != $item) && \
     #    ([interp target $interp] == {}} {
     #  lappend result [list mapping $item [lindex $alias 2]]
     #}
     lappend result [list alias $item [interp target $interp $item] [interp alias $interp $item]]
   }

   set packages [interp invokehidden $interp -global package names]
   foreach name $packages {
     set versions [interp invokehidden $interp -global package versions $name]
     if {[llength $versions] == 0} {
       set versions [interp invokehidden $interp -global package present $name]
     }
     foreach version $versions {
       set script  [interp invokehidden $interp -global package ifneeded $name $version]
       set present [interp invokehidden $interp -global package present $name  $version]
       lappend result [list package $name $version $script $present]
     }    
   }

   foreach child [interp invokehidden $interp -global namespace children $ns] {
     foreach item [serializeInterp $interp $child] { lappend result $item }
   }

   foreach slave [interp slaves $interp] {
     lappend result [list slave_interp $slave [serializeInterp [join $interp $slave]]]
   }

   return $result
 }

 proc deserializeInterp {interp state} {
   foreach item $state {
     set op [lindex $item 0]
     switch -exact -- $op {
       "array" {
         set name [lindex $item 1]
         set data [lindex $item 2]
         interp invokehidden $interp -global array set $name $data
       }
       "scalar" {
         set name [lindex $item 1]
         set data [lindex $item 2]
         interp invokehidden $interp -global set $name $data
       }
       "proc" {
         set name [lindex $item 1]
         set args [lindex $item 2]
         set body [lindex $item 3]
 	interp invokehidden $interp -global proc $name $args $body
       }
       #"mapping" {
       #  # set newname [lindex $item 1]
       #  # set oldname [lindex $item 2]
       #  # interp alias $interp $newname {} passThrough $interp $oldname
       #}
       "slave_interp" {
         set name [lindex $item 1]
         set data [lindex $item 2]
         deserializeInterp [join $interp $name] $data
       }
       "alias" {
         # possible security hole if state is passed through 3rd party
         # and not verified agenst hash-key or public key on return
         set slavecommand [lindex $item 1]
         set target       [lindex $item 2]
         set command&args [lrange $item 3 end]
         set t [list interp alias $interp $slavecommand $target]
         foreach item [set command&args] { lappend t $item }
         eval $t
       }
       "invoked" {
         # mainly used when the slave isnt allways running
         # and one is using journaling to keep track of the state
         set command&args [lindex $item 1]
         interp eval $interp [set command&args]
       }
       "package" {
         set name    [lindex $item 1]
         set version [lindex $item 2]
         set script  [lindex $item 3]
         set present [lindex $item 4]
         interp invokehidden $interp -global package ifneeded $name $version $script]
       }
       default { error "deserializeInterp: unknown op [lindex $item 0]"}
     }
   }
 }

if 0 { 
[Zarutian] 3. August 2006: the above code has been tested somewhat, but not extensively

[RS] 2006-08-14: Note that this code from above
         set name    [lindex $item 1]
         set version [lindex $item 2]
         set script  [lindex $item 3]
         set present [lindex $item 4]
can also be written as
         foreach {- name version script present} $item break
Matter of style, and taste, of course... :^)


[schlenk] 2006-08-14: And if you're up for using Tcl 8.5 you can use [lassign] for the same.

[Zarutian] 7. december 2006: I am still figuring out how I can serialize the slave interp's callstack. (So I can use [interp limit] to implement preemptive scheduling of running tasks)

----
[Category Discussion]