Index: xotcl/library/serialize/Serializer.xotcl
===================================================================
diff -u -rbb3c756fb47517596b9dbcb4e580aa1212827b41 -r2846921e448d4d4aeb3245ebbfe4381182f0e286
--- xotcl/library/serialize/Serializer.xotcl	(.../Serializer.xotcl)	(revision bb3c756fb47517596b9dbcb4e580aa1212827b41)
+++ xotcl/library/serialize/Serializer.xotcl	(.../Serializer.xotcl)	(revision 2846921e448d4d4aeb3245ebbfe4381182f0e286)
@@ -1,10 +1,10 @@
-# $Id: Serializer.xotcl,v 1.13 2006/09/14 06:36:02 neumann Exp $
+# $Id: Serializer.xotcl,v 1.14 2006/09/25 08:29:04 neumann Exp $
 package require XOTcl 1.3
-package provide xotcl::serializer 1.0
+package provide xotcl::serializer 0.9
 
 namespace eval ::xotcl::serializer {
 
-  namespace import -force ::xotcl::*
+  namespace import ::xotcl::*
 
   @ @File {
     description {
@@ -15,7 +15,7 @@
     authors {
       Gustaf Neumann, Gustaf.Neumann@wu-wien.ac.at
     }
-    date { $Date: 2006/09/14 06:36:02 $ }
+    date { $Date: 2006/09/25 08:29:04 $ }
   }
   
   @ Serializer proc all {
@@ -132,7 +132,6 @@
   # ################################################################################
   Class Serializer -parameter {ignoreVarsRE map}
   namespace export Serializer
-
   Serializer proc ignore args {
     my set skip $args
   }
@@ -182,11 +181,7 @@
     }
   }
   Serializer instproc Object-serialize o {
-    append cmd [list [$o info class] create [$o self]]
-    # slots needs to be initialized when optimized, since
-    # parametercmds are not serialized
-    if {![$o istype ::xotcl::Slot]} {append cmd " -noinit"}
-    append cmd " \\\n"
+    append cmd [list [$o info class] create [$o self] -noinit] " \\\n"
     foreach i [$o info procs] {
       append cmd " " [my method-serialize $o $i ""] " \\\n"
     }
@@ -211,38 +206,31 @@
     }
     foreach x {mixin invar} {
       set v [$o info $x]
-      if {$v ne ""} {my append postcmd [list $o $x set $v] "\n"}
+      if {$v ne ""} {append cmd [my pcmd [list $x $v]] " \\\n"}
     }
     set v [$o info filter -guards]
     if {$v ne ""} {append cmd [my pcmd [list filter $v]] " \\\n"}
     return $cmd
   }
   Serializer instproc Class-serialize o {
     set cmd [my Object-serialize $o]
-    #set p [$o info parameter]
-    #if {$p ne ""} {
-    #  append cmd " " [my pcmd [list parameter $p]] " \\\n"
-    #}
+    set p [$o info parameter]
+    if {$p ne ""} {
+      append cmd " " [my pcmd [list parameter $p]] " \\\n"
+    }
     foreach i [$o info instprocs] {
       append cmd " " [my method-serialize $o $i inst] " \\\n"
     }
     foreach i [$o info instforward] {
       set fwd [concat [list instforward $i] [$o info instforward -definition $i]]
       append cmd \t [my pcmd $fwd] " \\\n"
     }
-    foreach x {superclass instinvar} {
+    foreach x {superclass instmixin instinvar} {
       set v [$o info $x]
       if {$v ne "" && "::xotcl::Object" ne $v } {
 	append cmd " " [my pcmd [list $x $v]] " \\\n"
       }
     }
-    foreach x {instmixin} {
-      set v [$o info $x]
-      if {$v ne "" && "::xotcl::Object" ne $v } {
-        my append postcmd [list $o $x set $v] "\n"
-	#append cmd " " [my pcmd [list $x $v]] " \\\n"
-      }
-    }
     set v [$o info instfilter -guards]
     if {$v ne ""} {append cmd [my pcmd [list instfilter $v]] " \\\n"}
     return $cmd\n
@@ -273,28 +261,14 @@
     }
     return $set
   }
-  Serializer instproc exportedObject o {
-    # check, whether o is exported. for exported objects.
-    # we export the object tree.
-    set oo $o
-    while {1} {
-      if {[[self class] exists exportObjects($o)]} {
-        #puts stderr "exported: $o -> exported $oo"
-        return 1
-      }
-      # we do this for object trees without object-less name spaces
-      if {![my isobject $o]} {return 0}
-      set o [$o info parent]
-    }
-  }
   
   Serializer instproc topoSort {set all} {
     if {[my array exists s]} {my array unset s}
     if {[my array exists level]} {my array unset level}
     foreach c $set {
       if {!$all &&
 	  [string match "::xotcl::*" $c] && 
-	  ![my exportedObject $c]} continue
+	  ![[self class] exists exportObjects($c)]} continue
       if {[my exists skip($c)]} continue
       my set s($c) 1
     }
@@ -303,14 +277,14 @@
       set set [my array names s]
       if {[llength $set] == 0} break
       incr stratum
-      #my warn "$stratum set=$set"
+      #puts "$stratum set=$set"
       my set level($stratum) {}
       foreach c $set {
 	if {[my [my category $c]-needsNothing $c]} {
 	  my lappend level($stratum) $c
 	}
       }
-      if {[my set level($stratum)] eq ""} {
+      if {"" eq [my set level($stratum)]} {
 	my set level($stratum) $set
 	my warn "Cyclic dependency in $set"
       }
@@ -321,56 +295,51 @@
     if {[info command ns_log] ne ""} {
       ns_log Notice $msg
     } else {
-      puts stderr "!!! $msg"
+      puts stderr "!!! Warning: $msg"
     }
   }
   
   Serializer instproc Class-needsNothing x {
     if {![my Object-needsNothing $x]}         {return 0}
     if {[my needsOneOf [$x info superclass]]} {return 0}
-    #if {[my needsOneOf [$x info instmixin ]]} {return 0}
+    if {[my needsOneOf [$x info instmixin ]]} {return 0}
     return 1
   }
   Serializer instproc Object-needsNothing x {
     set p [$x info parent]
     if {$p ne "::"  && [my needsOneOf $p]} {return 0}
     if {[my needsOneOf [$x info class]]}  {return 0}
-    if {[my needsOneOf [[$x info class] info slots]]}  {return 0}
-    #if {[my needsOneOf [$x info mixin ]]} {return 0}
+    if {[my needsOneOf [$x info mixin ]]} {return 0}
     return 1
   }
   Serializer instproc needsOneOf list {
-    foreach e $list {if {[my exists s($e)]} {
-      #upvar x x; puts stderr "$x needs $e"
-      return 1
-    }}
+    foreach e $list {if {[my exists s($e)]} {return 1}}
     return 0
   }
   Serializer instproc serialize {objectOrClass} {
     string trimright [my [my category $objectOrClass]-serialize $objectOrClass] "\\\n"
   }
   Serializer instproc serialize-objects {list all} {
-    my set postcmd ""
     my topoSort $list $all
-    #foreach i [lsort [my array names level]] {my warn "$i: [my set level($i)]"}
+    #foreach i [lsort [my array names level]] {puts "$i: [my set level($i)]"}
     set result ""
     foreach l [lsort [my array names level]] {
       foreach i [my set level($l)] {
-	#my warn "serialize $i"
 	append result [my serialize $i] \n
       }
     }
     foreach e $list {
-      set namespace($e) 1
-      set namespace([namespace qualifiers $e]) 1
+      if {[namespace exists $e]} {
+	set namespace($e) 1
+	set namespace([namespace parent $e]) 1
+      }
     }
 
     set exports ""
     set nsdefines ""
     # delete ::xotcl from the namespace list, if it exists...
     catch {unset namespace(::xotcl)}
     foreach ns [array name namespace] {
-      if {![namespace exists $ns]} continue
       if {![my isobject $ns]} {
 	append nsdefines "namespace eval $ns {}\n"
       } elseif {$ns ne [namespace origin $ns] } {
@@ -381,7 +350,7 @@
 	append exports "namespace eval $ns {namespace export $exp}" \n
       }
     }
-    return $nsdefines$result[my set postcmd]$exports
+    return $nsdefines$result$exports
   }
   Serializer instproc deepSerialize o {
     # assumes $o to be fully qualified
@@ -422,23 +391,13 @@
     set r ""
     foreach k [my array names exportMethods] {
       foreach {o p m} [split $k ,] break
-      #if {$o ne "::xotcl::Object" && $o ne "::xotcl::Class"} {
-	#error "method export only for ::xotcl::Object and\
-	#	::xotcl::Class implemented, not for $o"
-      #}
-      if {![string match "::xotcl::*" $o]} {
-        error "method export is only for ::xotcl::* \
-          object an classes implemented, not for $o"
+      if {$o ne "::xotcl::Object" && $o ne "::xotcl::Class"} {
+	error "method export only for ::xotcl::Object and\
+		::xotcl::Class implemented, not for $o"
       }
       append methods($o) [$s serializeMethod $o $p $m] " \\\n "      
     }
-    set objects [array names methods]
     foreach o [list ::xotcl::Object ::xotcl::Class] {
-      set p [lsearch $o $objects]
-      if {$p == -1} continue
-      set objects [lreplace $objects $p $p]
-    }
-    foreach o [concat ::xotcl::Object ::xotcl::Class $objects] {
       if {![info exists methods($o)]} continue
       append r \n "$o configure \\\n " \
 	  [string trimright $methods($o) "\\\n "] 
@@ -448,20 +407,14 @@
   }
 
   Serializer proc all {args} {
-    # don't filter anything during serialization
     set filterstate [::xotcl::configure filter off]
     set s [eval my new -childof [self] -volatile $args]
     # always export __exitHandler
     my exportMethods [list ::xotcl::Object proc __exitHandler]
-    set r {
-      set ::xotcl::__filterstate [::xotcl::configure filter off]
-      ::xotcl::Slot instmixin add ::xotcl::Slot::Nocheck
-    } 
-    append r "::xotcl::configure softrecreate [::xotcl::configure softrecreate]"
+    set r {set ::xotcl::__filterstate [::xotcl::configure filter off]}
+    append r \n "::xotcl::configure softrecreate [::xotcl::configure softrecreate]"
     append r \n [my serializeExportedMethods $s]
     # export the objects and classes
-    #$s warn "export objects = [my array names exportObjects]"
-    #$s warn "export objects = [my array names exportMethods]"
     append r [$s serialize-objects [$s allInstances ::xotcl::Object] 0]    
     foreach o [list ::xotcl::Object ::xotcl::Class] {
       foreach x {mixin instmixin invar instinvar} {
@@ -472,7 +425,6 @@
       }
     }
     append r {
-      ::xotcl::Slot instmixin delete ::xotcl::Slot::Nocheck
       ::xotcl::configure filter $::xotcl::__filterstate
       unset ::xotcl::__filterstate
     }
@@ -493,18 +445,8 @@
     return $r
   }
 
-  # register serialize a global method
-  ::xotcl::Object instproc serialize {} {
-    ::Serializer deepSerialize [self]
-  }
-
-  # include this method in the serialized code
-  Serializer exportMethods {
-    ::xotcl::Object instproc contains
-  }
-
-  # include Serializer in the serialized code
   Serializer exportObjects [namespace current]::Serializer
-
   namespace eval :: "namespace import -force [namespace current]::*"
+
+  #ns_log notice "???? sourceing.....Serializer"
 }