Index: openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl,v
diff -u -r1.26 -r1.27
--- openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl	17 Jun 2008 18:58:25 -0000	1.26
+++ openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl	19 Jun 2008 08:43:34 -0000	1.27
@@ -75,7 +75,7 @@
       if {[regexp {^::([^:]+)::} $object_type _ head]} {
 	set tail [namespace tail $object_type]
 	set pretty_name "#$head.$tail-$name#"
-	my log "--created pretty_name = $pretty_name"
+	#my log "--created pretty_name = $pretty_name"
       } else {
 	error "Cannot determine automatically message key for pretty name. \
 		Use namespaces for classes"
Index: openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl,v
diff -u -r1.69 -r1.70
--- openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl	16 Jun 2008 11:44:38 -0000	1.69
+++ openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl	19 Jun 2008 08:43:35 -0000	1.70
@@ -362,7 +362,7 @@
 	{security_inherit_p t}
 	{auto_save false}
 	{with_table true}
-	{sql_package_name "[namespace tail [self]]"}
+	{sql_package_name}
       } -ad_doc {
 	::xo::db::Class is a meta class for interfacing with acs_object_types.
 	acs_object_types are instances of this meta class. The meta class defines
@@ -374,6 +374,13 @@
   
   ::xo::db::Class set __default_superclass ::xo::db::Object  ;# will be supported in XOTcl 1.6
 
+  ::xo::db::Class proc namespace_head {name} {
+    if {[regexp {^(::)?([^:]+)::} $name _ colons head]} {
+      return $head
+    }
+    return ""
+  }
+
   #
   # Define an XOTcl interface for creating new object types
   #
@@ -520,6 +527,7 @@
           -pretty_name $pretty_name \
           -id_column $id_column \
           -table_name $table_name \
+          -sql_package_name [namespace tail $classname] \
 	  -noinit
     } else {
       #my log "--db we have a class $classname"
@@ -846,7 +854,11 @@
       my log "We cannot handle object_name = '$object_name' in this version"  
       return
     }
-    set package_name   [my sql_package_name]
+    #
+    # Object names have the form of e.g. ::xo::db::apm_parameter.
+    # Therefore, we use the namspace tail as sql_package_name.
+    #
+    set package_name   [my sql_package_name [namespace tail [self]]]
     set sql_command    [my generate_psql $package_name $object_name] 
     set proc_body      [my generate_proc_body] 
 
@@ -1121,20 +1133,23 @@
     my check_default_values
     set table_name_error_tail ""
     set id_column_error_tail ""
-    if {![my exists table_name]} {
-      if {[regexp {^::([^:]+)::} [self] _ head]} {
-	set tail [namespace tail [self]]
-	my set table_name [string tolower ${head}_$tail]
-	set table_name_error_tail ", or use different namespaces/class names"
-	#my log "-- created table_name '[my table_name]'"
-      } else {
-	error "Cannot determine automatically table name for class [self]. \
-		Use namespaces for classes."
-      }
+    my instvar sql_package_name
+
+    if {![my exists sql_package_name]} {
+      set sql_package_name [::xo::db::Class namespace_head [self]]
+      my log "-- sql_package_name of [self] is '$sql_package_name'"
     }
+    if {[string length $sql_package_name] > 31} {
+      error "SQL package_name '$sql_package_name' can be maximal 31 characters long!"
+    }
+    if {$sql_package_name eq ""} {
+      error "Cannot determine SQL package_name. Please specify it explicitely!"
+    }
 
-    if {[string length [my sql_package_name]] > 31} {
-      error "SQL package_name '[my sql_package_name]' can be maximal 31 characters"
+    if {![my exists table_name]} {
+      set tail [namespace tail [self]]
+      my set table_name [string tolower ${sql_package_name}_$tail]
+      set table_name_error_tail ", or use different namespaces/class names"
     }
 
     if {![my exists id_column]} {