Index: openacs-4/packages/xowiki/tcl/link-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/link-procs.tcl,v diff -u -r1.57 -r1.58 --- openacs-4/packages/xowiki/tcl/link-procs.tcl 18 Dec 2008 09:39:59 -0000 1.57 +++ openacs-4/packages/xowiki/tcl/link-procs.tcl 29 Dec 2008 02:26:46 -0000 1.58 @@ -68,10 +68,10 @@ if {![my exists parent_id]} {my parent_id [$page parent_id]} if {![my exists package_id]} {my package_id [$page package_id]} - #my log "--L link has class [my info class] // $class" + #my msg "--L link has class [my info class] // $class" } Link instproc resolve {} { - #my msg "--lookup of [my name] -page [my page]" + #my msg "--lookup of [my name] -page [my page] -> [[my package_id] lookup -name [my name] -parent_id [my parent_id]]" return [[my package_id] lookup -name [my name] -parent_id [my parent_id]] } Link instproc render_found {href label} { @@ -202,7 +202,7 @@ set last_page_id [$page set item_id] set title $label set object_type ::xowiki::File - set return_url [$package_id url] + set return_url [::xo::cc url] set link [$package_id make_link $package_id edit-new object_type \ return_url autoname name title] set html [my render_not_found $link $label] @@ -228,7 +228,6 @@ if {[my exists href]} { set href [my set href] if {[string match "java*" $href]} {set href .} - set css_class return "$pre$label$post" } else { return "$pre$label$post" 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.157 -r1.158 --- openacs-4/packages/xowiki/tcl/package-procs.tcl 18 Dec 2008 10:10:53 -0000 1.157 +++ openacs-4/packages/xowiki/tcl/package-procs.tcl 29 Dec 2008 02:26:47 -0000 1.158 @@ -297,6 +297,40 @@ return $value } + Package instproc resolve_package_path {path name_var} { + # + # In case, we can resolve the path against an xowiki instance, + # require the package, set the provide name of the object and + # return the package_id. If we cannot resolve the name, turn 0. + # + my upvar $name_var name + if {[regexp {^/(/.*)$} $path _ path]} { + array set "" [site_node::get_from_url -url $path] + if {$(package_key) eq "acs-subsite"} { + # the main site + return 0 + } + set package_id $(package_id) + set package_class [::xo::PackageMgr get_package_class_from_package_key $(package_key)] + if {$package_class ne ""} { + # we found an xo::Package, but is it an xowiki package? + set classes [concat $package_class [$package_class info heritage]] + if {[lsearch $classes ::xowiki::Package] > -1} { + # yes, it is an xowiki::package, compute the name and return the package_id + ::xowiki::Package require $package_id + set name [string range $path [string length $(url)] end] + return $package_id + } + } + } elseif {!([string match "http*//*" $path] + || [string match "ftp://*" $path] + )} { + return [my id] + } + + return 0 + } + Package instproc resolve_page_name {page_name} { # # This is a very simple version for resolving page names in an @@ -639,7 +673,7 @@ 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] + lappend packages ::[::xowiki::Package initialize -url $package_instance_url/[my set object] -keep_cc true -init_url false] } # final sanity check, in case package->initialize is broken 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.314 -r1.315 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 17 Nov 2008 17:02:31 -0000 1.314 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 29 Dec 2008 02:26:47 -0000 1.315 @@ -1115,12 +1115,19 @@ regexp {^([^|]+)[|](.*)$} $arg _ link label regexp {^([^|]+)[|](.*)$} $label _ label options set options [my unescape $options] - if {[string match "http*//*" $link] - || [string match "ftp://*" $link] - || [string match "//*" $link] - } { + + # Get the package_id from the provided path, and - if found - + # return the shortened link relative to it. + set package_id [[my package_id] resolve_package_path $link link] + + if {$package_id == 0} { + # we treat all such links like external links if {[regsub {^//} $link / link]} { - #my msg t=[::xowiki::guesstype $link] + # + # For local links (starting with //), we provide + # a direct treatment. Javascript and CSS files are + # included, images are rendered directly. + # switch -glob -- [::xowiki::guesstype $link] { text/css { ::xo::Page requireCSS $link @@ -1133,22 +1140,23 @@ image/* { Link create [self]::link \ -page [self] \ - -type localimage -label $label \ + -name "" \ + -type localimage [list -label $label] \ -href $link eval [self]::link configure $options return [[self]::link render] } } } - set l [ExternalLink new -label $label -href $link] + set l [ExternalLink new [list -label $label] -href $link] eval $l configure $options set html [$l render] $l destroy return $html } + set parent_id [$package_id folder_id] set name "" - my instvar parent_id package_id if {[regexp {^:(..):(.*)$} $link _ lang stripped_name]} { # language link (it starts with a ':') set link_type language @@ -1205,8 +1213,8 @@ Link create [self]::link \ -page [self] \ - -type $link_type -name $name -lang $lang -anchor $anchor \ - -stripped_name $normalized_name -label $label \ + -type $link_type [list -name $name] -lang $lang [list -anchor $anchor] \ + [list -stripped_name $normalized_name] [list -label $label] \ -parent_id $parent_id -package_id $package_id if {[catch {eval [self]::link configure $options} errorMsg]} { @@ -1229,7 +1237,8 @@ } if {![my do_substitutions]} {return [lindex $source 0]} set content "" - set l ""; + set l "" + my log "--- lindex '$source' 0" foreach l0 [split [lindex $source 0] \n] { append l [string map $markupmap(escape) $l0] if {[string first \{\{ $l] > -1 && [string first \}\} $l] == -1} {append l " "; continue}