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.151 -r1.152
--- openacs-4/packages/xowiki/tcl/package-procs.tcl	16 Nov 2008 01:18:58 -0000	1.151
+++ openacs-4/packages/xowiki/tcl/package-procs.tcl	23 Nov 2008 18:43:43 -0000	1.152
@@ -146,8 +146,12 @@
     # handle different parent_ids
     #
     if {$parent_id ne "" && $parent_id != [my folder_id]} {
-      ::xo::db::CrClass get_instance_from_db -item_id $parent_id
-      return [$parent_id name]/
+      if {[::xo::db::sql::content_folder is_folder -item_id $parent_id]} {
+        return ""
+      } else {
+        ::xo::db::CrClass get_instance_from_db -item_id $parent_id
+        return [$parent_id name]/
+      }
     } else {
       return ""
     }
@@ -417,6 +421,7 @@
     my instvar id
 
     set computed_link ""
+    #my msg "obj=$object, [$object info class]"
     if {[$object istype ::xowiki::Package]} {
       set base  [my package_url]
       if {[info exists link]} {
@@ -430,15 +435,17 @@
         set base $link
       } else {
         set base [my url]
+        #my msg "base = '[my url]'"
       }
       lappend args [list m $method]
       set computed_link [uplevel export_vars -base [list $base] [list $args]]
+      #my msg "computed_link = '$computed_link'"
     }
     if {$with_entities} {
       regsub -all & $computed_link "&" computed_link
     }
 
-    #set party_id [::xo::cc user_id]
+    # provide links based in untrusted_user_id
     set party_id [::xo::cc set untrusted_user_id]
     if {[info exists privilege]} {
       #my log "-- checking priv $privilege for [self args]"
@@ -522,17 +529,22 @@
   Package instproc resolve_page {{-simple false} -lang object method_var} {
     my log "resolve_page '$object'"
     upvar $method_var method
-    my instvar folder_id id policy
+    my instvar id
 
     # get the default language if not specified
     if {![info exists lang]} {
       set lang [my default_language]
     }
+
+    # stripped object is the object without a language prefix
+    set stripped_object $object
+    regexp {^..:(.*)$} $object _ stripped_object
+
     #
     # first, resolve package level methods
     #
     if {$object eq ""} {
-      set exported [$policy defined_methods Package]
+      set exported [[my set policy] defined_methods Package]
       foreach m $exported {
 	#my log "--QP my exists_query_parameter $m = [my exists_query_parameter $m]"
         if {[my exists_query_parameter $m]} {
@@ -555,64 +567,94 @@
       #my log "--o object is now '$object'"
     }
     #
-    # second, resolve object level methods
+    # second, resolve object level
     #
     set page [my resolve_request -default_lang $lang -simple $simple -path $object method]
-    #my msg "--o try '$object' -default_lang $lang -simple $simple returns '$page'"
+    #my log "--o resolving object '$object' -default_lang $lang -simple $simple returns '$page'"
     if {$simple || $page ne ""} {
-      if {$page ne ""} {
-      }
       return $page
     }
-    #
-    # Make a second attempt in the default language, if it is diffent
-    # from the connection language. This is not optimal, since it is
-    # just relevant for the cases, where the language was not
-    # explicitely given. It would be nice to have e.g. a list of
-    # language preferences which could be checked, but this would
-    # require a different structure. The underlying methods are used
-    # for two different cases: (a) complete an non-fully specified
-    # entry, and (b) search whether such an entry exists. Not
-    # undoable, but this should wait for the next release.
-#     if {[::xo::cc lang] ne [my default_language]} {
-#       set page [my resolve_request -default_lang [my default_language] -simple $simple -path $object method]
-#       if {$simple || $page ne ""} {
-#         if {$page ne ""} {
-#         }
-#         return $page
-#       }
-#     }
 
-    # stripped object is the object without a language prefix
-    set stripped_object $object
-    regexp {^..:(.*)$} $object _ stripped_object
-
     # try standard page
     set standard_page [$id get_parameter ${object}_page]
-    #my msg "--o standard_page '$standard_page'"
     if {$standard_page ne ""} {
       set page [my resolve_request -default_lang [::xo::cc lang] -path $standard_page method]
+      #my msg "--o resolving standard_page '$standard_page' returns $page"
       if {$page ne ""} {
         return $page
       }
 
-      # maybe we are calling from a different language, but the
-      # standard page with en: was already instantiated
+      # Maybe we are calling from a different language, but the
+      # standard page with en: was already instantiated.
       set standard_page "en:$stripped_object"
       set page [my resolve_request -default_lang en -path $standard_page method]
       #my msg "resolve -default_lang en -path $standard_page returns --> $page"
       if {$page ne ""} {
         return $page
       }
     }
-    #my msg "we have to import a prototype page for $stripped_object"
+
+    foreach package [my package_path] {
+      set page [$package resolve_page -simple $simple -lang $lang $object $method_var]
+      if {$page ne ""} {
+        return $page
+      }
+    }
+
+    my msg "we have to try to import a prototype page for $stripped_object"
     set page [my import_prototype_page $stripped_object]
-    if {$page eq ""} {
-      my log "no prototype for '$object' found"
+    if {$page ne ""} {
+      return $page
     }
+    my log "no prototype for '$object' found"
     return $page
   }
 
+  Package instproc package_path {} {
+    # 
+    # Compute a list fo package objects which should be used for
+    # resolving ("inheriance of objects from other instances").
+    #
+    set packages [list]
+    set package_url [string trimright [my package_url] /]
+    set package_path [my get_parameter PackagePath]
+    #
+    # To avoid recursions, remove the current package from the list of
+    # packages if was accidentally included. Get the package objects
+    # from the remaining URLs.
+    #
+    foreach package_instance_url $package_path {
+      #my msg "compare $package_instance_url eq $package_url"
+      if {$package_instance_url eq $package_url} continue
+      lappend packages ::[::xowiki::Package initialize -url $package_instance_url/[my set object] -keep_cc true]
+    }
+
+    # final sanity check, in case package->initialize is broken
+    set p [lsearch $packages ::[my id]]
+    if {$p > -1} {set packages [lreplace $packages $p $p]}
+
+    #my msg "[my id] packages=$packages, p=$p"
+    return $packages
+  }
+
+  Package instproc lookup {-name:required -parent_id} {
+    #
+    # Lookup of names from a given parent_id or from the list of
+    # configured instances (obtained via package_path).
+    #
+    if {![info exists parent_id]} {set parent_id [my folder_id]}
+    set item_id [::xo::db::CrClass lookup -name $name -parent_id $parent_id]
+    my msg "lookup $name $parent_id returns $item_id"
+    if {$item_id == 0} {
+      foreach package [my package_path] {
+        set item_id [$package lookup -name $name]
+        my msg "lookup from package $package $name returns $item_id"
+        if {$item_id != 0} break
+      }
+    }
+    return $item_id
+  }
+
   Package instproc import_prototype_page {{prototype_name ""}} {
     set page ""
     if {$prototype_name eq ""} {