OpenACS

gustafn
committed
MAIN:gustafn:20100408072231
on 08 Apr 10
- add switch "-allow_complete_url" to method returnredirect of class ConnectionContext
openacs-4/.../xowiki/tcl/package-procs.tcl (+5 -2)
708 708       # Report back not found
709 709       return ""
710 710     }
711 711
712 712     #my log "--o object is '$object'"
713 713     if {$object eq ""} {
714 714       # we have no object, but as well no method callable on the package
715 715       set object [$id get_parameter index_page "index"]
716 716       #my log "--o object is now '$object'"
717 717     }
718 718     #
719 719     # second, resolve object level
720 720     #
721 721     set page [my resolve_request -default_lang $lang -simple $simple -path $object method]
722 722
723 723     #my log "--o resolving object '$object' -default_lang $lang -simple $simple returns '$page'"
724 724     if {$simple || $page ne ""} {
725 725       return $page
726 726     }
727 727
  728     my get_lang_and_name -default_lang $lang -path $object lang stripped_name
  729
728 730     # stripped object is the object without a language prefix
729 731     set stripped_object $object
730 732     regexp {^..:(.*)$} $object _ stripped_object
731 733
732 734     # try standard page
733 735     set standard_page [$id get_parameter ${object}_page]
734 736     if {$standard_page ne ""} {
735 737       set page [my resolve_request -default_lang [::xo::cc lang] -path $standard_page method]
736 738       #my log "--o resolving standard_page '$standard_page' returns $page"
737 739       if {$page ne ""} {
738 740         return $page
739 741       }
740 742
741 743       # Maybe we are calling from a different language, but the
742 744       # standard page with en: was already instantiated.
743 745       set standard_page "en:$stripped_object"
744 746       set page [my resolve_request -default_lang en -path $standard_page method]
745 747       #my msg "resolve -default_lang en -path $standard_page returns --> $page"
746 748       if {$page ne ""} {
747 749         return $page
 
752 754     if {$lang ne "en"} {
753 755       set page [my resolve_request -default_lang en -path $stripped_object method]
754 756       #my msg "resolve -default_lang en -path $stripped_object returns --> $page"
755 757       if {$page ne ""} {
756 758         return $page
757 759       }
758 760     }
759 761
760 762     if {$use_package_path} {
761 763       # Check for this page along the package path
762 764       foreach package [my package_path] {
763 765         set page [$package resolve_page -simple $simple -lang $lang $object method]
764 766         if {$page ne ""} {
765 767           #my msg "set_resolve_context inherited -package_id [my id] -parent_id [my folder_id]"
766 768           $page set_resolve_context -package_id [my id] -parent_id [my folder_id]
767 769           return $page
768 770         }
769 771       }
770 772     }
771 773    
772       set page [::xowiki::Package get_site_wide_page -name en:$object]
  774     set page [::xowiki::Package get_site_wide_page -name en:$stripped_name]
  775     #my log "get_site_wide_page for en:'$stripped_name' returned $page (stripped name)"
773 776     if {$page ne ""} {
774 777       #my msg "set_resolve_context site-wide -package_id [my id] -parent_id [my folder_id]"
775 778       $page set_resolve_context -package_id [my id] -parent_id [my folder_id]
776 779       return $page
777 780     }
778 781
779 782     #my msg "we have to try to import a prototype page for $stripped_object"
780 783     set page [my import-prototype-page $stripped_object]
781 784     if {$page ne ""} {
782 785       return $page
783 786     }
784 787     my log "no prototype for '$object' found"
785 788     return $page
786 789   }
787 790
788 791   Package instproc package_path {} {
789 792     #
790 793     # Compute a list fo package objects which should be used for
791 794     # resolving ("inheriance of objects from other instances").
792 795     #