Index: openacs-4/packages/xowiki/tcl/form-field-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/form-field-procs.tcl,v
diff -u -r1.70 -r1.71
--- openacs-4/packages/xowiki/tcl/form-field-procs.tcl	18 Apr 2008 20:22:53 -0000	1.70
+++ openacs-4/packages/xowiki/tcl/form-field-procs.tcl	21 Apr 2008 10:26:44 -0000	1.71
@@ -373,68 +373,10 @@
   }
 
   FormField instproc pretty_value {v} {
-    if {[my exists options]} {
-      if {[my exists multiple] && [my set multiple]} {
-        foreach o [my set options] {
-          foreach {label value} $o break
-          set labels($value) [my localize $label]
-        }
-        set values [list]
-        foreach i $v {lappend values $labels($i)}
-        return [join $values {, }]
-      } else {
-        foreach o [my set options] {
-          foreach {label value} $o break
-          if {$value eq $v} {return [my localize $label]}
-        }
-      }
-    }
     #my log "mapping $v"
     return [string map [list & "&amp;" < "&lt;" > "&gt;" \" "&quot;" ' "&apos;" @ "&#64;"] $v]
   }
 
-  FormField instproc config_from_category_tree {tree_name} {
-    # Get the options of a select or rado from the specified
-    # category tree.
-    #
-    # We could config as well from the mapped category tree,
-    # and get required and multiple from there....
-    #
-    # The usage of the label does not seem to be very useful.
-    #
-    #set tree_id [category_tree::get_id $tree_name [my locale]]
-    set tree_id [category_tree::get_id $tree_name]
-    if {$tree_id eq ""} {
-      my msg "cannot lookup category tree name '$tree_name'"
-      return
-    }
-    #
-    # In case there are multiple trees with the same named map,
-    # take the first one to avoid confusions.
-    #
-    #my msg tree_id=$tree_id
-    set tree_id [lindex $tree_id 0]
-    set subtree_id ""
-    set options [list] 
-
-    foreach category [category_tree::get_tree -subtree_id $subtree_id $tree_id] {
-      foreach {category_id category_name deprecated_p level} $category break
-      #if {[lsearch $category_ids $category_id] > -1} {lappend value $category_id}
-      #lappend value $category_id
-      set category_name [ad_quotehtml [lang::util::localize $category_name]]
-      if { $level>1 } {
-        set category_name "[string repeat {&nbsp;} [expr {2*$level-4}]]..$category_name"
-      }
-      lappend options [list $category_name $category_id]
-    }
-    my options $options
-    my set is_category_field 1
-    # my msg label_could_be=$tree_name,existing=[my label]
-    # if {![my exists label]} {
-    #    my label $tree_name
-    # }
-  }
-
   ###########################################################
   #
   # helper method for extending slots: 
@@ -844,21 +786,98 @@
     }
   }
 
+  ###########################################################
+  #
+  # ::xowiki::FormField::enumeration
+  #
+  ###########################################################
 
+  # abstract superclass for select and radio
+  Class FormField::enumeration -superclass FormField -parameter {
+    {options}
+    {category_tree}
+  }
+  FormField::enumeration instproc initialize {} {
+    if {[my exists category_tree]} {
+      my config_from_category_tree [my category_tree]
+    }
+  }
+  FormField::enumeration abstract instproc render_input {}
+
+  FormField::enumeration instproc pretty_value {v} {
+    if {[my exists category_label($v)]} {
+      return [my set category_label($v)]
+    }
+    if {[my exists multiple] && [my set multiple]} {
+      foreach o [my set options] {
+        foreach {label value} $o break
+        set labels($value) [my localize $label]
+      }
+      set values [list]
+      foreach i $v {lappend values $labels($i)}
+      return [join $values {, }]
+    } else {
+      foreach o [my set options] {
+        foreach {label value} $o break
+        if {$value eq $v} {return [my localize $label]}
+      }
+    }
+  }
+  FormField::enumeration instproc config_from_category_tree {tree_name} {
+    # Get the options of a select or rado from the specified
+    # category tree.
+    #
+    # We could config as well from the mapped category tree,
+    # and get required and multiple from there....
+    #
+    # The usage of the label does not seem to be very useful.
+    #
+    #set tree_id [category_tree::get_id $tree_name [my locale]]
+    set tree_id [category_tree::get_id $tree_name]
+    if {$tree_id eq ""} {
+      my msg "cannot lookup category tree name '$tree_name'"
+      return
+    }
+    #
+    # In case there are multiple trees with the same named map,
+    # take the first one to avoid confusions.
+    #
+    #my msg tree_id=$tree_id
+    set tree_id [lindex $tree_id 0]
+    set subtree_id ""
+    set options [list] 
+
+    foreach category [category_tree::get_tree -subtree_id $subtree_id $tree_id] {
+      foreach {category_id category_name deprecated_p level} $category break
+      #if {[lsearch $category_ids $category_id] > -1} {lappend value $category_id}
+      #lappend value $category_id
+      set category_name [ad_quotehtml [lang::util::localize $category_name]]
+      my set category_label($category_id) $category_name
+      if { $level>1 } {
+        set category_name "[string repeat {&nbsp;} [expr {2*$level-4}]]..$category_name"
+      }
+      lappend options [list $category_name $category_id]
+    }
+    my options $options
+    my set is_category_field 1
+    # my msg label_could_be=$tree_name,existing=[my label]
+    # if {![my exists label]} {
+    #    my label $tree_name
+    # }
+  }
+
   ###########################################################
   #
   # ::xowiki::FormField::radio
   #
   ###########################################################
 
-  Class FormField::radio -superclass FormField -parameter {
-    {options ""}
+  Class FormField::radio -superclass FormField::enumeration -parameter {
     {horizontal false}
-    {category_tree}
   }
   FormField::radio instproc initialize {} {
     my set widget_type text(radio)
-    if {[my exists category_tree]} {my config_from_category_tree [my category_tree]}
+    next
   }
   FormField::radio instproc render_input {} {
     set value [my value]
@@ -873,21 +892,20 @@
     }
   }
 
+
   ###########################################################
   #
   # ::xowiki::FormField::select
   #
   ###########################################################
 
-  Class FormField::select -superclass FormField -parameter {
-    {options}
+  Class FormField::select -superclass FormField::enumeration -parameter {
     {multiple "false"}
-    {category_tree}
   }
 
   FormField::select instproc initialize {} {
     my set widget_type text(select)
-    if {[my exists category_tree]} {my config_from_category_tree [my category_tree]}
+    next
     if {![my exists options]} {my options [list]}
   }
   FormField::select instproc render_input {} {
@@ -956,7 +974,12 @@
         set labels($value) "<a href='$href'>$label</a>"
       }
       set values [list]
-      foreach i $v {lappend values $labels($i)}
+      foreach i $v {
+        if {[catch {lappend values $labels($i)}]} {
+          my msg "can't determine label for value '$i'"
+          lappend values $i
+        }
+      }
       return [join $values {, }]
     } else {
       foreach o [my set options] {
Index: openacs-4/packages/xowiki/tcl/package-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/package-procs.tcl,v
diff -u -r1.116 -r1.117
--- openacs-4/packages/xowiki/tcl/package-procs.tcl	18 Apr 2008 20:22:53 -0000	1.116
+++ openacs-4/packages/xowiki/tcl/package-procs.tcl	21 Apr 2008 10:26:44 -0000	1.117
@@ -615,7 +615,6 @@
     set todo [list]
 
     foreach o $objects {
-      $o demarshall -parent_id $folder_id -package_id $package_id -creation_user $user_id
 
       # page instances have references to page templates, add these first
       if {[$o istype ::xowiki::PageInstance]} {
@@ -624,6 +623,8 @@
       }
       my log "importing (1st round) $o [$o name] [$o info class]"
 
+      $o demarshall -parent_id $folder_id -package_id $package_id -creation_user $user_id
+
       set item_id [::xo::db::CrClass lookup -name [$o set name] -parent_id $folder_id]
       if {$item_id != 0} {
 	if {$replace} { ;# we delete the original
@@ -648,6 +649,7 @@
       set c 0
       set found 0
       foreach o $todo {
+        $o demarshall -parent_id $folder_id -package_id $package_id -creation_user $user_id
 	set old_template_id [$o set page_template]
 	set template_id [::xo::db::CrClass lookup \
                              -name [::$old_template_id set name] \
Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v
diff -u -r1.231 -r1.232
--- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl	18 Apr 2008 20:47:21 -0000	1.231
+++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl	21 Apr 2008 10:26:44 -0000	1.232
@@ -208,8 +208,6 @@
   #
   # Page marshall/demarshall
   #
-
-
   Page instproc marshall {} {
     my instvar name
     my unset_temporary_instance_variables
@@ -239,7 +237,93 @@
     my set __file_content [::base64::encode [::xowiki::read_file $fn]]
     next
   }
+  
+  Page instproc category_export {tree_name} {
+    # ignore locale in get_id for now, since it seems broken
+    set tree_id [category_tree::get_id $tree_name]
+    # make sure to have only one tree_id, in case there are multiple
+    # trees with the same name (arrgh)
+    set tree_id [lindex $tree_id 0]
+    array set data [category_tree::get_data $tree_id]
+    set categories [list]
+    if {[my exists __category_map]} {array set cm [my set __category_map]}
+    foreach category [category_tree::get_tree $tree_id] {
+      foreach {category_id category_name deprecated_p level} $category break
+      lappend categories $level $category_name
+      set names($level) $category_name
+      set node_name $tree_name
+      for {set l 1} {$l <= $level} {incr l} {append node_name /$names($l)}
+      set cm($category_id) $node_name
+    }
+    set cmd [list my category_import \
+                 -name $tree_name -description $data(description) \
+                 -locale [lang::system::site_wide_locale] \
+                 -categories $categories]
+    my append __category_command \n $cmd
+    my set __category_map [array get cm]
+    my log "data=[array get data]"
+    my log "cmd=$cmd"
+  }
+  Page instproc category_import {-name -description -locale -categories} {
+    set tree_id [category_tree::get_id $name $locale]
+    set tree_id [lindex $tree_id 0]; # handle multiple trees with same name
+    if {$tree_id eq ""} {
+      # we have to import the category tree
+      my log "...importing category tree $name"
+      category_tree::import -name $name -description $description \
+          -locale $locale -categories $categories
+    }
+    #
+    # build reverse category_map
+    foreach category [category_tree::get_tree $tree_id] {
+      foreach {category_id category_name deprecated_p level} $category break
+      lappend categories $level $category_name
+      set names($level) $category_name
+      set node_name $name
+      for {set l 1} {$l <= $level} {incr l} {append node_name /$names($l)}
+      set ::__xowiki_reverse_category_map($node_name) $category_id
+    }
+  }
 
+  Form instproc marshall {} {
+    set form_fields [my create_form_fields_from_form_constraints \
+                         [my get_form_constraints]]
+    foreach f $form_fields {
+      if {[$f exists category_tree]} {
+        set tree_key ::__xowiki_exported_category_tree([$f category_tree])
+        my lappend __category_use [$f name] [$f category_tree]
+        if {[info exists $tree_key]} continue
+        set $tree_key 1
+        my log "name [my name] uses [$f category_tree]"
+        my category_export [$f category_tree]
+      }
+    }
+    next
+  }
+
+  FormPage instproc marshall {} {
+    my instvar page_template
+    if {[$page_template exists __category_map]} {
+      my log "we have a category_map"
+      array set cm [$page_template set __category_map]
+      array set use [$page_template set __category_use]
+      set ia [list]
+      foreach {name value} [my instance_attributes] {
+        my log "check $name $value [info exists use($name)] [info exists cm($value)]"
+        if {[info exists use($name)] && [info exists cm($value)]} {
+          lappend ia $name $cm($value)
+          my log "...mapped to $name $cm($value)"
+        } else {
+          lappend ia $name $value
+        }
+      }
+      my set instance_attributes $ia
+      #my msg "setting instance_attributes $ia"
+    }
+    next
+  }
+
+
   Page instproc demarshall {-parent_id -package_id -creation_user} {
     # this method is the counterpart of marshall
     my set parent_id $parent_id
@@ -256,26 +340,73 @@
     my instvar import_file __file_content
     set import_file [ns_tmpnam]
     ::xowiki::write_file $import_file [::base64::decode $__file_content]
+    unset __file_content
   }
 
   # set default values. 
   # todo: with slots, it should be easier to set default values
-  # for non existing variables
+  # for non-existing variables
   PageInstance instproc demarshall {args} {
-    # some older versions do not have anon_instances
+    # some older versions do not have anon_instances and no slots
     if {![my exists anon_instances]} {
       my set anon_instances "f"
     }
     next
   }
   Form instproc demarshall {args} {
-    # some older versions do not have anon_instances
+    # some older versions do not have anon_instances and no slots
     if {![my exists anon_instances]} {
       my set anon_instances "t"
     }
+    # handle category import
+    if {[my exists __category_command]} {
+      eval [my set __category_command]
+      my log "reverse map: [array get ::__xowiki_reverse_category_map]"
+    }
     next
   }
+  FormPage instproc demarshall {args} {
+    #
+    # FormPages must be demarshalled after Form, since Form builds
+    # the reverse category map.
+    #
+    #my log "reverse map ?[info exists ::__xowiki_reverse_category_map]"
+    if {[info exists ::__xowiki_reverse_category_map]} {
+      #my log "we have a category_map"
+      #
+      # replace all symbolic category values by the mapped IDs
+      #
+      set ia [list]
+      array set use [[my page_template] set __category_use]
+      foreach {name value} [my instance_attributes] {
+        if {[info exists use($name)]} {
+          if {[info exists ::__xowiki_reverse_category_map($value)]} {
+            #my msg "map value '$value' (category tree: $use($name)) of [my name] to an ID"
+            lappend ia $name $::__xowiki_reverse_category_map($value)
+          } elseif {$value eq ""} {
+            lappend ia $name ""
+          } else {
+            my msg "cannot map value '$value' (category tree: $use($name))\
+		of [my name] to an ID; maybe there is some\
+		same_named category tree with less entries..."
+            lappend ia $name ""
+          }
+          #my log "...mapped to $name $::__xowiki_reverse_category_map($value)"
+        } else {
+          lappend ia $name $value
+        }
+      }
+      my set instance_attributes $ia
+      #my log "saving instance_attributes $ia"
+    }
+    next
+  }
 
+  ############################################
+  #
+  # conditions for policy rules
+  #
+  ############################################
   Page instproc condition=match {query_context value} {
     #
     # Conditon for conditional checks in policy rules
@@ -1450,34 +1581,44 @@
   }
 
 
+  Page instproc create_form_fields_from_form_constraints {form_constraints} {
+    #
+    # Create form-fields from form constraints.
+    # Since create_raw_form_field uses destroy_on_cleanup, we do not
+    # have to care here about destroying the objects.
+    #
+    set form_fields [list]
+    foreach name_and_spec $form_constraints {
+      regexp {^([^:]+):(.*)$} $name_and_spec _ spec_name short_spec
+      if {$spec_name eq "@table" || $spec_name eq "@categories"} continue
+      
+      #my msg "checking spec '$short_spec' for form field '$spec_name'"
+      lappend form_fields [my create_raw_form_field \
+                   -name $spec_name \
+                   -slot [my find_slot $spec_name] \
+                   -spec $short_spec]
+    }
+    return $form_fields
+  }
+
   Page instproc validate=form_constraints {form_constraints} {
     #
     # First check for invalid meta characters for security reasons.
     #
     if {[regexp {[\[\]]} $form_constraints]} {
-      my uplevel [list set errorMsg [_ xowiki.error-form_constraint-invalid_characters]]
+      my uplevel [list set errorMsg \
+                      [_ xowiki.error-form_constraint-invalid_characters]]
       return 0
     }
     #
     # Create from fields from all specs and report, if there are any errors
     #
-    foreach name_and_spec $form_constraints {
-      regexp {^([^:]+):(.*)$} $name_and_spec _ spec_name short_spec
-      #foreach {spec_name short_spec} [split $name_and_spec :] break
-      if {$spec_name eq "@table" || $spec_name eq "@categories"} continue
-
-      #my msg "checking spec '$short_spec' for form field '$spec_name'"
-      if {[catch {
-        set f [my create_raw_form_field \
-                   -name $spec_name \
-                   -slot [my find_slot $spec_name] \
-                   -spec $short_spec]
-        $f destroy
-      } errorMsg]} {
-        my uplevel [list set errorMsg $errorMsg]
-        #my msg "ERROR: invalid spec '$short_spec' for form field '$spec_name' -- $errorMsg"
-        return 0
-      }
+    if {[catch {
+      my create_form_fields_from_form_constraints $form_constraints
+    } errorMsg]} {
+      my uplevel [list set errorMsg $errorMsg]
+      #my msg "ERROR: invalid spec '$short_spec' for form field '$spec_name' -- $errorMsg"
+      return 0
     }
     return 1
   }