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.25 -r1.26
--- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 13 Apr 2006 19:19:36 -0000 1.25
+++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 15 Apr 2006 23:01:09 -0000 1.26
@@ -6,6 +6,7 @@
@cvs-id $Id$
}
+
namespace eval ::xowiki {
::Generic::CrClass create Page -superclass ::Generic::CrItem \
-pretty_name "XoWiki Page" -pretty_plural "XoWiki Pages" \
@@ -56,36 +57,10 @@
}
-# the following block is legacy code
-# ::Generic::CrClass create CrWikiPage -superclass ::xowiki::Page \
-# -pretty_name "Wiki Page" -pretty_plural "Wiki Pages" \
-# -table_name "generic_cr_wiki_page" -id_column "page_id" \
-# -form ::xowiki::WikiForm -object_type "CrWikiPage"
+#
+# create reference table and table for user tracking
+#
-# ::Generic::CrClass create CrWikiPlainPage -superclass ::xowiki::PlainPage \
-# -pretty_name "Plain Wiki Page" -pretty_plural "Plain Wiki Pages" \
-# -table_name "generic_cr_plain_page" -id_column "ppage_id" \
-# -form ::xowiki::PlainWikiForm -object_type "CrWikiPlainPage"
-
-# ::Generic::CrClass create PageTemplate -superclass ::xowiki::PageTemplate \
-# -pretty_name "Page Template" -pretty_plural "Page Templates" \
-# -table_name "generic_page_template" -id_column "page_template_id" \
-# -form ::xowiki::WikiForm -object_type "PageTemplate"
-
-# ::Generic::CrClass create PageInstance -superclass ::xowiki::PageInstance \
-# -pretty_name "Page Instance" -pretty_plural "Page Instances" \
-# -table_name "generic_page_instance" -id_column "page_instance_id" \
-# -object_type "PageInstance" \
-# -cr_attributes {
-# ::Generic::Attribute new -attribute_name page_template -datatype integer \
-# -pretty_name "Page Template"
-# ::Generic::Attribute new -attribute_name instance_attributes -datatype text \
-# -pretty_name "Instance Attributes"
-# } \
-# -form ::xowiki::PageInstanceForm \
-# -edit_form ::xowiki::PageInstanceEditForm
-
-
if {![db_0or1row check-xowiki-references-table \
"select tablename from pg_tables where tablename = 'xowiki_references'"]} {
db_dml create-xowiki-references-table "create table xowiki_references(
@@ -111,6 +86,10 @@
namespace eval ::xowiki {
+ #
+ # upgrade logic
+ #
+
ad_proc ::xowiki::upgrade_callback {
{-from_version_name:required}
{-to_version_name:required}
@@ -200,6 +179,10 @@
}
}
+ #
+ # Application specific forms
+ #
+
Class create WikiForm -superclass ::Generic::Form \
-parameter {
{field_list {item_id title page_title creator text description nls_language}}
@@ -311,11 +294,8 @@
### ad_form! don't do it in pageinstanceforms.
$data render_adp false
$data render -update_references
- } else {
- # for the subsequent pretty_link; in the other branch, render sets it up already
- Page set url_prefix [site_node::get_url_from_object_id -object_id [ad_conn package_id]]
}
- my set submit_link [::xowiki::Page pretty_link [$data set title]]?
+ my set submit_link [::xowiki::Page pretty_link [$data set title]]
}
WikiForm instproc new_request {} {
@@ -526,6 +506,7 @@
namespace eval ::xowiki {
+
Page proc requireCSS name {set ::need_css($name) 1}
Page proc requireJS name {set ::need_js($name) 1}
Page proc header_stuff {} {
@@ -549,15 +530,30 @@
}
}
- Page proc pretty_link {-lang title} {
- my instvar url_prefix
+ Page proc url_prefix {-package_id} {
+ my instvar url_prefix folder_id
+ if {![info exists package_id]} {set package_id [$folder_id set package_id]}
+ if {![info exists url_prefix($package_id)]} {
+ set url_prefix($package_id) [site_node::get_url_from_object_id -object_id $package_id]
+ }
+ return $url_prefix($package_id)
+ }
+
+ Page proc pretty_link {-lang -package_id title} {
+ my instvar url_prefix folder_id
+
+ if {![info exists package_id]} {set package_id [$folder_id set package_id]}
+ if {![info exists url_prefix($package_id)]} {
+ set url_prefix($package_id) [site_node::get_url_from_object_id -object_id $package_id]
+ }
+
if {![info exists lang]} {
regexp {^(..):(.*)$} $title _ lang title
}
if {[info exists lang]} {
- return ${url_prefix}pages/$lang/[ad_urlencode $title]
+ return $url_prefix($package_id)pages/$lang/[ad_urlencode $title]
} else {
- return ${url_prefix}pages/[ad_urlencode $title]
+ return $url_prefix($package_id)pages/[ad_urlencode $title]
}
}
@@ -570,19 +566,25 @@
Page ad_proc require_folder_object {
-folder_id
- -package_id:required
+ -package_id:required
+ {-store_folder_id:boolean true}
} {
} {
if {![::xotcl::Object isobject ::$folder_id]} {
- set item_id [ns_cache eval xotcl_object_type_cache item-of-$folder_id {
- set item_id [CrItem lookup -title ::$folder_id -parent_id $folder_id]
- }]
- if {$item_id != 0} {
+ while {1} {
+ set item_id [ns_cache eval xotcl_object_type_cache item_id-of-$folder_id {
+ set id [CrItem lookup -title ::$folder_id -parent_id $folder_id]
+ if {$id == 0} break; # don't cache
+ return $id
+ }]
+ break
+ }
+ if {$item_id ne ""} {
+ # we have a valid item_id and get the folder object
#my log "--f fetch folder object -object ::$folder_id -item_id $item_id"
set o [::xowiki::Object fetch_object -object ::$folder_id -item_id $item_id]
} else {
- ns_cache flush xotcl_object_type_cache item-of-$folder_id
- #my log "--f save new folder object"
+ # we have no folder object yet. so we create one...
set o [::xowiki::Object create ::$folder_id]
$o set text "# this is the payload of the folder object\n\nset index_page \"\"\n"
$o set parent_id $folder_id
@@ -592,11 +594,13 @@
}
#$o proc destroy {} {my log "--f "; next}
$o set package_id $package_id
- #my log "--f package_id set, exists $o -> [::xotcl::Object isobject $o]"
uplevel #0 [list $o volatile]
} else {
#my log "--f reuse folder object $folder_id [::Serializer deepSerialize ::$folder_id]"
}
+ if {$store_folder_id} {
+ Page set folder_id $folder_id
+ }
}
Page proc import {-user_id -package-id -folder-id {-replace 0} -objects} {
@@ -704,7 +708,13 @@
set adp [string map { " "} $adp]
set adp_fn [lindex $adp 0]
if {![string match "/*" $adp_fn]} {set adp_fn /packages/xowiki/www/$adp_fn}
- set adp_args [concat [lindex $adp 1] [list __including_page [self]]]
+ set adp_args [lindex $adp 1]
+ if {[llength $adp_args] % 2 == 1} {
+ return "Error in '$arg'
\n\
+ Syntax: adp <name of adp-file> {<argument list>}
\n
+ Invalid argument list: '$adp_args'; must be attribute value pairs (even number of elements)"
+ }
+ lappend adp_args __including_page [self]
return [template::adp_include $adp_fn $adp_args]
}
}
@@ -728,66 +738,42 @@
regexp {^(.*)[|](.*)$} $arg _ link label
if {[string match "http*//*" $link]} {
return "$label"
+ }
+
+ my instvar parent_id
+ # do we have a language link (it starts with a ':')
+ if {[regexp {^:(..):(.*)$} $link _ lang stripped_name]} {
+ set link_type language
} else {
- set specified_link $link
- my instvar parent_id
- Page instvar url_prefix
- [my info class] instvar object_type
- if {[regexp {^:(..):(.*)$} $link _ lang stripped]} {
- set lang_item_id [CrItem lookup \
- -title $lang:$stripped -parent_id $parent_id]
- #my log "lang lookup for '$lang:$stripped' returned $lang_item_id"
- if {$lang_item_id} {
- set css_class "found"
- set link [Page pretty_link -lang $lang $stripped]
- #set link [export_vars -base view {{item_id $lang_item_id}}]
- } else {
- set css_class "undefined"
- set last_page_id [my set item_id]
- set link [export_vars -base ${url_prefix}edit {object_type {title $lang:$stripped} last_page_id}]
- }
- my lappend lang_links \
- ""
- return ""
- }
- set link_type link
- regexp {^([^:]+):([^:]+:.*)$} $link _ link_type link
- if {[regexp {^(..):(.*)$} $link _ lang stripped_name]} {
- if {$label eq $arg} {set label $stripped_name}
- set name $link
- } {
+ # do we have a typed link?
+ if {![regexp {^([^:][^:][^:]+):((..):)?(.+)$} $link _ link_type _ lang stripped_name]} {
+ # must be an untyped link; defaults, in case the second regexp does not match either
+ set lang ""
+ set link_type link
set stripped_name $link
- set name [my lang]:$link
- set lang [my lang]
+ regexp {^(..):(.+)$} $link _ lang stripped_name
}
- set item_id [::Generic::CrItem lookup -title $name -parent_id $parent_id]
- if {$item_id} {
- my lappend references [list $item_id $link_type]
- #set link [export_vars -base view {item_id}]
- #return "$label"
- return "$label"
- } else {
- my incr unresolved_references
- set link [export_vars -base ${url_prefix}edit {object_type {title $label}}]
- return " \[ $label \] "
- }
}
+ if {$lang eq ""} {set lang [my lang]}
+ if {$label eq $arg} {set label $stripped_name}
+ my log "--LINK lang=$lang type=$link_type stripped_name=$stripped_name"
+ Link create [self]::link \
+ -type $link_type -title $lang:$stripped_name -lang $lang \
+ -stripped_name $stripped_name -label $label \
+ -folder_id $parent_id -package_id [$parent_id set package_id]
+ return [[self]::link render]
}
Page instproc references {} {
[my info class] instvar table_name
- my instvar item_id url_prefix
- set l [db_list_of_lists references \
- "SELECT page,ci.name,link_type from xowiki_references, cr_items ci \
- where reference=$item_id and ci.item_id = page"]
+ my instvar item_id
set refs [list]
- foreach e $l {
- #set link [export_vars -base view {{item_id {[lindex $e 0]}}}]
- set link [lindex $e 1]
- lappend refs "$link"
- }
- return [join $refs ", "]
+ db_foreach references "SELECT page,ci.name,link_type,f.package_id \
+ from xowiki_references,cr_items ci,cr_folders f \
+ where reference=$item_id and ci.item_id = page and ci.parent_id = f.folder_id" {
+ lappend refs "$name"
+ }
+ join $refs ", "
}
Page instproc substitute_markup {source} {
@@ -811,7 +797,7 @@
}
Page instproc adp_subst {content} {
- set __ignorelist [list RE __defaults name_method object_type_key]
+ set __ignorelist [list RE __defaults name_method object_type_key url_prefix]
foreach __v [my info vars] {
if {[info exists $__v]} continue
my instvar $__v
@@ -859,8 +845,6 @@
my instvar item_id references lang render_adp unresolved_references parent_id
#my log "-- my class=[my info class]"
- set package_id [$parent_id set package_id]
- Page set url_prefix [site_node::get_url_from_object_id -object_id $package_id]
set title [my set title]
regexp {^(..):(.*)$} $title _ lang title
set references [list]
@@ -969,7 +953,7 @@
}
#
- # Methods of the object Object
+ # Methods of ::xowiki::Object
#
Object instproc get_content {} {