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 -N -r1.183 -r1.184
--- openacs-4/packages/xowiki/tcl/form-field-procs.tcl 13 Jul 2010 11:22:23 -0000 1.183
+++ openacs-4/packages/xowiki/tcl/form-field-procs.tcl 13 Jul 2010 18:11:04 -0000 1.184
@@ -2127,59 +2127,32 @@
# note that the includelet "include" can be used for implementing symbolic links
# to other xowiki pages.
Class include -superclass text -parameter {
- } -extend_slot validator link
-
- include instproc convert_to_internal {} {
- my instvar object value
-
- set props [$object compute_link_properties $value]
- $object set_property -new 1 [my name] $props
-
}
- include instproc convert_to_external {value} {
- if {$value ne ""} {
- if {[catch {array set "" $value}]} {return $value}
- return $(item_ref)
- }
- return ""
- }
-
+
include instproc pretty_value {v} {
if {$v eq ""} { return $v }
- if {[catch {array set "" $v}]} {
- my log "warning: strange value for field [my name] '$v'"
- return $v
- }
- my instvar object
- if {$(item_id) && [info command $(item_id)] ne ""} {
- set page $(item_id)
- } else {
- set page [[$object package_id] get_page_from_item_ref \
- -default_lang [$object lang] \
- -parent_id [$object parent_id] \
- $(item_ref)]
- }
- #my msg page=$page
- if {$page eq ""} {
+ my instvar object
+ set item_id [$object get_property_from_link_page item_id]
+ if {$item_id == 0} {
# Here, we could call "::xowiki::Link render" to offer the user means
# to create the entry like with [[..]], if he has sufficent permissions...;
# when $(package_id) is 0, the referenced package could not be
# resolved
return "Cannot resolve symbolic link '$v'"
}
- $object lappend references [list [$page item_id] $(link_type)]
+ set link_type [$object get_property_from_link_page link_type]
+ $object lappend references [list $item_id $link_type]
- #my msg "could switch from [$page item_id] [$page package_id] to [$object item_id] [$object package_id]"
#
# resetting esp. the item-id is dangerous. Therefore we reset it immediately after the rendering
#
- $page set_resolve_context \
+ $item_id set_resolve_context \
-package_id [$object package_id] -parent_id [$object parent_id] \
-item_id [$object item_id]
- set html [$page render]
+ set html [$item_id render]
#my msg "reset resolve-context"
- $page reset_resolve_context
+ $item_id reset_resolve_context
return $html
}
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 -N -r1.231 -r1.232
--- openacs-4/packages/xowiki/tcl/package-procs.tcl 13 Jul 2010 11:22:23 -0000 1.231
+++ openacs-4/packages/xowiki/tcl/package-procs.tcl 13 Jul 2010 18:11:04 -0000 1.232
@@ -899,8 +899,8 @@
# Page not found so far. Is the parent-page a folder-link?
#
::xo::db::CrClass get_instance_from_db -item_id $parent_id
- if {[$parent_id is_link_page] && [$parent_id is_folder_page]} {
- set target [$parent_id get_page_from_link_page]
+ if {$parent_id > 0 && [$parent_id is_link_page] && [$parent_id is_folder_page]} {
+ set target [$parent_id get_target_from_link_page]
#my log "LINK LOOKUP from target-package [$target package_id] source package $(package_id)"
return [[$target package_id] lookup \
-use_package_path $use_package_path \
@@ -1226,7 +1226,7 @@
# check link (todo should happen in package->lookup?)
::xo::db::CrClass get_instance_from_db -item_id $(parent_id)
if {[$(parent_id) is_link_page] && [$(parent_id) is_folder_page]} {
- set target [$(parent_id) get_page_from_link_page]
+ set target [$(parent_id) get_target_from_link_page]
#$target set_resolve_context -package_id [my id] -parent_id $(parent_id)
#my msg "LINK prefixed LOOKUP from target-package [$target package_id] source package [my id]"
array set "" [[$target package_id] prefixed_lookup -parent_id [$target item_id] \
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 -N -r1.420 -r1.421
--- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 13 Jul 2010 11:22:23 -0000 1.420
+++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 13 Jul 2010 18:11:04 -0000 1.421
@@ -913,14 +913,22 @@
#
Page instproc get_property_from_link_page {property {default ""}} {
if {![my is_link_page]} {return $default}
- set link [my property link]
- if {$link eq "" || [llength $link] < 2} {return $default}
- array set "" $link
- if {[info exists ($property)]} {return $($property)}
+ set item_ref [my property link]
+
+ # TODO we could save some double-fetch by collecing in
+ # get_form_entries via item-ids, not via new-objects
+ ::xo::db::CrClass get_instance_from_db -item_id [my item_id]
+
+ set props [::xo::cc cache [list [my item_id] compute_link_properties $item_ref]]
+ array set "" $props
+ if {[info exists ($property)]} {
+ #[my item_id] msg "prop $property ==> $($property)"
+ return $($property)
+ }
return $default
}
- Page instproc get_page_from_link_page {} {
+ Page instproc get_target_from_link_page {} {
set item_id [my get_property_from_link_page item_id 0]
if {$item_id == 0} {return ""}
set target [::xo::db::CrClass get_instance_from_db -item_id $item_id]
@@ -932,31 +940,12 @@
return $target
}
- FormPage instproc get_verified_link_type_from_link_page {} {
- set link_type [my get_property_from_link_page link_type "unresolved"]
- if {1 || $link_type eq "unresolved"} {
- # to to resolve again
- set props [my compute_link_properties [my get_property_from_link_page item_ref]]
- array set "" $props
- # if link_type is now unresolved, update the link properties
- if {$(link_type) ne $link_type} {
- set link_type $(link_type)
- my set_property -new 1 link $props
- my save
- my msg "rewritten"
- }
- }
- return $link_type
- }
-
FormPage instproc compute_link_properties {item_ref} {
my instvar package_id
set page [$package_id get_page_from_item_ref \
-default_lang [my lang] \
-parent_id [my parent_id] \
$item_ref]
- #my msg "$item_ref => $page, o package_id [my package_id] t [$page object_id]"
-
if {$page ne ""} {
set item_id [$page item_id]
set link_type [expr {[$page is_folder_page] ? "folder_link" : "link"}]
@@ -966,6 +955,7 @@
set link_type "unresolved"
set cross_package 0
}
+ #my msg [list item_ref $item_ref item_id $item_id link_type $link_type cross_package $cross_package]
return [list item_ref $item_ref item_id $item_id link_type $link_type cross_package $cross_package]
}
@@ -1019,7 +1009,7 @@
#my msg "$name / '$stripped_name'"
# prepend the language prefix only, if the entry is not empty
if {$stripped_name ne ""} {
- if {[my is_folder_page]} {
+ if {[my is_folder_page] || [my is_link_page]} {
#
# Do not add a language prefix to folder pages
#
@@ -3140,7 +3130,7 @@
return [list text "" is_richtext true]
}
en:link.form {
- set link_type [my get_verified_link_type_from_link_page]
+ set link_type [my get_property_from_link_page link_type "unresolved"]
set link_icon "http://www.ejoe.at/typo3/sysext/rtehtmlarea/res/accessibilityicons/img/internal_link.gif"
if {$link_type eq "unresolved"} {
return [list text " \