Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -r1.94 -r1.95 --- openacs-4/packages/xowiki/xowiki.info 17 Sep 2008 10:14:20 -0000 1.94 +++ openacs-4/packages/xowiki/xowiki.info 27 Sep 2008 17:27:56 -0000 1.95 @@ -8,11 +8,11 @@ f xowiki - + Gustaf Neumann A more generic xotcl-based wikis example with object types and subtypes based on the content repository (with category support) - 2008-09-17 + 2008-09-27 Gustaf Neumann, WU Wien <pre> XoWiki is a Wiki implementation for OpenACS in XOTcl. Instead of @@ -54,12 +54,12 @@ BSD-Style 0 - + - + 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 -r1.99 -r1.100 --- openacs-4/packages/xowiki/tcl/form-field-procs.tcl 25 Sep 2008 21:00:35 -0000 1.99 +++ openacs-4/packages/xowiki/tcl/form-field-procs.tcl 27 Sep 2008 17:27:56 -0000 1.100 @@ -517,10 +517,7 @@ next } file instproc entry_name {value} { - set obj [my object] - set name [$obj build_name -nls_language [$obj form_parameter nls_language {}]] - regsub -all : $name _ object_name - return file:$object_name-[my name] + return [list name file:[my name] parent_id [[my object] item_id]] } file instproc process_user_input {} { my instvar value @@ -534,15 +531,15 @@ my set __refresh_instance_attributes [list [my name] $value] set folder_id [[my object] set parent_id] - set entry_name [my entry_name $value] + array set entry_info [my entry_name $value] set content_type [my set content-type] if {$content_type eq "application/octetstream"} { set content_type [::xowiki::guesstype $value] } #my msg "mime_type of $entry_name = [::xowiki::guesstype $value] // [my set content-type] ==> $content_type" - if {[set id [::xo::db::CrClass lookup -name $entry_name -parent_id $folder_id]]} { + if {[set id [::xo::db::CrClass lookup -name $entry_info(name) -parent_id $entry_info(parent_id)]]} { # file entry exists already, create a new revision set file_object [::xo::db::CrClass get_instance_from_db -item_id $id] $file_object set import_file [my set tmpfile] @@ -553,8 +550,8 @@ # create a new file set file_object [::xowiki::File new -destroy_on_cleanup \ -title $value \ - -name $entry_name \ - -parent_id $folder_id \ + -name $entry_info(name) \ + -parent_id $entry_info(parent_id) \ -mime_type $content_type \ -package_id [[my object] package_id] \ -creation_user [::xo::cc user_id] ] @@ -570,10 +567,11 @@ } else { set link_label $v } + array set entry_info [my entry_name $v] set l [::xowiki::Link new -volatile \ -page [my object] \ -extra_query_parameter [list [list filename $v]] \ - -type file -name [my entry_name $v] -label $link_label] + -type file -name $entry_info(name) -label $link_label -parent_id $entry_info(parent_id)] return [$l render] } } Index: openacs-4/packages/xowiki/tcl/includelet-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/includelet-procs.tcl,v diff -u -r1.54 -r1.55 --- openacs-4/packages/xowiki/tcl/includelet-procs.tcl 24 Sep 2008 09:55:05 -0000 1.54 +++ openacs-4/packages/xowiki/tcl/includelet-procs.tcl 27 Sep 2008 17:27:56 -0000 1.55 @@ -763,7 +763,7 @@ db_foreach [my qn get_pages] \ [::xo::db::sql select \ - -vars "i.name, r.title, p.page_id, r.publish_date, \ + -vars "i.name, r.title, p.page_id, r.publish_date, i.parent_id, \ to_char(r.publish_date,'YYYY-MM-DD HH24:MI:SS') as formatted_date" \ -from "cr_items i, cr_revisions r, xowiki_page p" \ -where "i.parent_id = [$package_id folder_id] \ @@ -773,27 +773,22 @@ -orderby "publish_date desc" \ -limit $max_entries ] { + set page_link [$package_id pretty_link -parent_id $parent_id $name] t1 add \ -title $title \ - -title.href [$package_id pretty_link $name] \ + -title.href $page_link \ -date $formatted_date if {$allow_edit} { - #set page_link [$package_id pretty_link $name] - #set edit_link [$package_id make_link $page_link edit return_url] set p [::xo::db::CrClass get_instance_from_db -item_id 0 -revision_id $page_id] - $p destroy_on_cleanup - set page_link [$package_id pretty_link $name] set edit_link [$package_id make_link -link $page_link $p edit return_url] - my log "page_link=$page_link, edit=$edit_link" + #my log "page_link=$page_link, edit=$edit_link" [t1 last_child] set edit.href $edit_link } if {$allow_delete} { if {![info exists p]} { set p [::xo::db::CrClass get_instance_from_db -item_id 0 -revision_id $page_id] - $p destroy_on_cleanup } - set page_link [$package_id pretty_link $name] set delete_link [$package_id make_link -link $page_link $p delete return_url] [t1 last_child] set delete.href $delete_link } @@ -828,7 +823,7 @@ db_foreach [my qn get_pages] \ [::xo::db::sql select \ - -vars "r.title,i.name, to_char(time,'YYYY-MM-DD HH24:MI:SS') as visited_date" \ + -vars "i.parent_id, r.title,i.name, to_char(time,'YYYY-MM-DD HH24:MI:SS') as visited_date" \ -from "xowiki_last_visited x, xowiki_page p, cr_items i, cr_revisions r" \ -where "x.page_id = i.item_id and i.live_revision = p.page_id \ and r.revision_id = p.page_id and x.user_id = [::xo::cc user_id] \ @@ -838,7 +833,7 @@ { t1 add \ -title $title \ - -title.href [$package_id pretty_link $name] + -title.href [$package_id pretty_link -parent_id $parent_id $name] } return [t1 asHTML] } @@ -881,17 +876,17 @@ set since_condition "and [::xo::db::sql since_interval_condition time $interval]" db_foreach [my qn get_pages] \ [::xo::db::sql select \ - -vars "count(x.user_id) as nr_different_users, x.page_id, r.title,i.name" \ + -vars "count(x.user_id) as nr_different_users, x.page_id, r.title,i.name, i.parent_id" \ -from "xowiki_last_visited x, xowiki_page p, cr_items i, cr_revisions r" \ -where "x.page_id = i.item_id and i.live_revision = p.page_id and r.revision_id = p.page_id \ and x.package_id = $package_id and i.publish_status <> 'production' \ $since_condition" \ - -groupby "x.page_id, r.title, i.name" \ + -groupby "x.page_id, r.title, i.name, i.parent_id" \ -orderby "nr_different_users desc" \ -limit $max_entries ] { t1 add \ -title $title \ - -title.href [$package_id pretty_link $name] \ + -title.href [$package_id pretty_link -parent_id $parent_id $name] \ -users $nr_different_users } } else { @@ -904,16 +899,16 @@ } db_foreach [my qn get_pages] \ [::xo::db::sql select \ - -vars "sum(x.count) as sum, count(x.user_id) as nr_different_users, x.page_id, r.title,i.name" \ + -vars "sum(x.count) as sum, count(x.user_id) as nr_different_users, x.page_id, r.title,i.name, i.parent_id" \ -from "xowiki_last_visited x, xowiki_page p, cr_items i, cr_revisions r" \ -where "x.page_id = i.item_id and i.live_revision = p.page_id and r.revision_id = p.page_id \ and x.package_id = $package_id and i.publish_status <> 'production'" \ - -groupby "x.page_id, r.title, i.name" \ + -groupby "x.page_id, r.title, i.name, i.parent_id" \ -orderby "sum desc" \ -limit $max_entries] { t1 add \ -title $title \ - -title.href [$package_id pretty_link $name] \ + -title.href [$package_id pretty_link -parent_id $parent_id $name] \ -users $nr_different_users \ -count $sum } @@ -1053,7 +1048,7 @@ db_foreach [my qn get_pages] \ [::xo::db::sql select \ - -vars "a.title, i.name" \ + -vars "a.title, i.name, i.parent_id" \ -from "xowiki_page p, cr_items i, acs_objects a " \ -where "(i.item_id not in ( select x.page_id from xowiki_last_visited x @@ -1069,7 +1064,7 @@ { t1 add \ -title $title \ - -title.href [$package_id pretty_link $name] + -title.href [$package_id pretty_link -parent_id $parent_id $name] } return [t1 asHTML] } @@ -1118,7 +1113,7 @@ } set entries [list] - if {![info exists page]} {set page [$package_id get_parameter weblog_page]} + if {![info exists page]} {set page [$package_id get_parameter weblog_page]} set base_url [$package_id pretty_link $page] set href [$package_id package_url]tag/ @@ -1398,11 +1393,11 @@ set item_id [$__including_page item_id] set refs [list] - db_foreach [my qn get_references] "SELECT reference,ci.name,f.package_id \ + db_foreach [my qn get_references] "SELECT reference,ci.name,f.package_id,ci.parent_id \ from xowiki_references,cr_items ci,cr_folders f \ where page=$item_id and ci.item_id = reference and ci.parent_id = f.folder_id" { ::xowiki::Package require $package_id - lappend refs "$name" + lappend refs "$name" } set references [join $refs ", "] @@ -1940,7 +1935,6 @@ set level [expr {[regsub {[.]} $page_order . page_order] + 1}] set edit_markup "" set p [::xo::db::CrClass get_instance_from_db -item_id 0 -revision_id $page_id] - $p destroy_on_cleanup $p set unresolved_references 0 switch [$p info class] { @@ -2067,7 +2061,6 @@ $o instvar page_order title page_id name title set level [expr {[regsub -all {[.]} $page_order . page_order] + 1}] set p [::xo::db::CrClass get_instance_from_db -item_id 0 -revision_id $page_id] - $p destroy_on_cleanup $p set unresolved_references 0 #$p set render_adp 0 @@ -2132,7 +2125,7 @@ set link [$package_id make_link $package_id edit-new object_type \ return_url page_order source_item_id] } else { - set p_link [$package_id pretty_link [$page name]] + set p_link [$package_id pretty_link -parent_id [$page parent_id] [$page name]] set link [$package_id make_link -link $p_link $page $method \ return_url page_order source_item_id] } 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.48 -r1.49 --- openacs-4/packages/xowiki/tcl/link-procs.tcl 25 Sep 2008 13:38:43 -0000 1.48 +++ openacs-4/packages/xowiki/tcl/link-procs.tcl 27 Sep 2008 17:27:56 -0000 1.49 @@ -40,8 +40,14 @@ # Class create Link -superclass BaseLink -parameter { type name lang stripped_name page - folder_id package_id + parent_id package_id } + Link instproc folder_id args { + # This method is deprecated + # just for backward compatibility + my log "--deprecated [self proc] [self args]" + eval my parent_id $args + } Link instproc atts {} { set atts "" if {[my exists title]} {append atts " title='[string map [list ' {'}] [my title]]'"} @@ -59,7 +65,7 @@ } } if {![my exists label]} {my label $name} - if {![my exists folder_id]} {my folder_id [$page parent_id]} + 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" @@ -69,7 +75,7 @@ if {![regexp {(.*?)(\#|%23)+(.*)$} [my name] full_name name anchor_tag anchor]} { set name [my name] } - return [::xo::db::CrClass lookup -name $name -parent_id [my folder_id]] + return [::xo::db::CrClass lookup -name $name -parent_id [my parent_id]] } Link instproc render_found {href label} { return "$label" @@ -189,7 +195,7 @@ #my log "-- image resolve for $page returned $item_id (name=$name, label=$label) " if {$item_id} { set link [[my package_id] pretty_link -download true \ - -absolute [$page absolute_links] $name] + -absolute [$page absolute_links] -parent_id [my parent_id] $name] #my log "--l fully quali [$page absolute_links], base=$base" #set link [export_vars -base $base {{m download}} ] $page lappend references [list $item_id [my type]] @@ -254,7 +260,7 @@ set item_id [next] # my log "-- file, lookup of [my name] returned $item_id" if {$item_id == 0 && [regsub {^file:} [my name] image: name]} { - set item_id [::xo::db::CrClass lookup -name $name -parent_id [my folder_id]] + set item_id [::xo::db::CrClass lookup -name $name -parent_id [my parent_id]] } return $item_id } @@ -310,7 +316,7 @@ set item_id [next] my log "--file, lookup of [my name] returned $item_id" if {$item_id == 0 && [regsub {^swf:} [my name] file: name]} { - set item_id [::xo::db::CrClass lookup -name $name -parent_id [my folder_id]] + set item_id [::xo::db::CrClass lookup -name $name -parent_id [my parent_id]] my log "--file, 2nd lookup of $name returned $item_id" } return $item_id @@ -445,7 +451,7 @@ #::xowiki::Package initialize -package_id $id my log "--u setting package_id to $id" # lookup the item from the found folder - return [::xo::db::CrClass lookup -name [my name] -parent_id [$id set folder_id]] + return [::xo::db::CrClass lookup -name [my name] -parent_id [$id set parent_id]] } #my log "--LINK no page found [my name], [my lang], type=[my type]." return 0 @@ -464,7 +470,7 @@ Class LinkCache LinkCache instproc resolve {} { - set key link-[my type]-[my name]-[my folder_id] + set key link-[my type]-[my name]-[my parent_id] while {1} { array set r [ns_cache eval xowiki_cache $key { set id [next] 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.132 -r1.133 --- openacs-4/packages/xowiki/tcl/package-procs.tcl 25 Sep 2008 20:36:55 -0000 1.132 +++ openacs-4/packages/xowiki/tcl/package-procs.tcl 27 Sep 2008 17:27:56 -0000 1.133 @@ -85,6 +85,7 @@ Package instproc default_language {} { return [string range [my default_locale] 0 1] } + Package array set www-file { admin 1 diff 1 @@ -98,12 +99,67 @@ view-default 1 view-links 1 view-plain 1 oacs-view 1 oacs-view2 1 oacs-view3 1 download 1 } + + Package instproc get_lang_and_name {-path -name vlang vlocal_name} { + my upvar $vlang lang $vlocal_name local_name + if {[info exists path]} { + # + # Determine lang and name from a path with slashes + # + if {[regexp {^pages/(..)/(.*)$} $path _ lang local_name]} { + } elseif {[regexp {^(..)/(.*)$} $path _ lang local_name]} { + } elseif {[regexp {^(..):(.*)$} $path _ lang local_name]} { + } elseif {[regexp {^(file|image|swf|download/file|tag)/(.*)$} $path _ lang local_name]} { + } else { + set local_name $path + set lang [my default_language] + } + } elseif {[info exists name]} { + # + # Determine lang and name from a names as it stored in the database + # + if {![regexp {^(..):(.*)$} $name _ lang local_name]} { + if {![regexp {^(file|image|swf):(.*)$} $name _ lang local_name]} { + set local_name $name + set lang [my default_language] + } + } + } + } + Package instproc folder_path {{-parent_id ""}} { + # + # 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]/ + } else { + return "" + } + } + + + Package ad_instproc external_name { + {-parent_id ""} + name + } { + Generate a name with a potentially inserted parent name + + @param parent_id parent_id (for now just for download) + @param name name of the wiki page + } { + my get_lang_and_name -name $name lang stripped_name + set folder [my folder_path -parent_id $parent_id] + return ${lang}:$folder$stripped_name + } + Package ad_instproc pretty_link { {-anchor ""} {-absolute:boolean false} {-siteurl ""} {-lang ""} + {-parent_id ""} {-download false} name } { @@ -115,34 +171,45 @@ @param absolute make an absolute link (including protocol and host) @param lang use the specified 2 character language code (rather than computing the value) @param download create download link (without m=download) + @param parent_id parent_id (for now just for download) @param name name of the wiki page } { #my msg "input name=$name, lang=$lang" set default_lang [my default_language] + if {$lang eq ""} { - if {![regexp {^(..):(.*)$} $name _ lang name]} { - if {![regexp {^(file|image|swf):(.*)$} $name _ lang name]} { - set lang $default_lang - } - } + my get_lang_and_name -name $name lang name } set host [expr {$absolute ? ($siteurl ne "" ? $siteurl : [ad_url]) : ""}] if {$anchor ne ""} {set anchor \#$anchor} #my log "--LINK $lang == $default_lang [expr {$lang ne $default_lang}] $name" set package_prefix [my get_parameter package_prefix [my package_url]] if {$package_prefix eq "/" && [string length $lang]>2} { - # don't compact the the path for images etc. to avoid conflicts with e.g. //../image/* + # don't compact the the path for images etc. to avoid conflicts + # with e.g. //../image/* set package_prefix [my package_url] } #my msg "lang=$lang name=$name" + set encoded_name [string map [list %2d - %5f _ %2e .] [ns_urlencode $name]] + set folder [my folder_path -parent_id $parent_id] + if {$download} { - #set url ${host}${package_prefix}download/${lang}/$encoded_name$anchor - set url ${host}${package_prefix}download/file/$encoded_name$anchor + # + # use the special download (file) syntax + # + set url ${host}${package_prefix}download/file/$folder$encoded_name$anchor } elseif {$lang ne $default_lang || [[self class] exists www-file($name)]} { - set url ${host}${package_prefix}${lang}/$encoded_name$anchor + # + # If files are physical files in the www directory, add the + # language prefix + # + set url ${host}${package_prefix}${lang}/$folder$encoded_name$anchor } else { - set url ${host}${package_prefix}$encoded_name$anchor + # + # Use the short notation without language prefix + # + set url ${host}${package_prefix}$folder$encoded_name$anchor } return $url } @@ -163,7 +230,6 @@ (4) per instance parameters from the folder object (computable) (5) standard OpenACS package parameter } { - #my log "search for $attribute" set value [::xo::cc get_parameter $attribute] if {$value eq ""} {set value [my query_parameter $attribute]} if {$value eq "" && $attribute ne "parameter_page"} { @@ -375,7 +441,7 @@ {-object_type ::xowiki::Page} provided_name } { - my get_name_and_lang_from_path $provided_name lang local_name + my get_lang_and_name -path $provided_name lang local_name set name ${lang}:$local_name set new_link [my make_link [my id] edit-new object_type return_url name] if {$new_link ne ""} { @@ -563,70 +629,56 @@ } Package instforward check_permissions {%my set policy} %proc - Package instproc get_name_and_lang_from_path {path vlang vlocal_name} { - my upvar $vlang lang $vlocal_name local_name - if {[regexp {^pages/(..)/(.*)$} $path _ lang local_name]} { - } elseif {[regexp {^(..)/(.*)$} $path _ lang local_name]} { - } elseif {[regexp {^(..):(.*)$} $path _ lang local_name]} { - } elseif {[regexp {^(file|image|swf|download|tag)/(.*)$} $path _ lang local_name]} { - } else { - set key queryparm(lang) - if {[info exists $key]} { - set lang [set $key] - } else { - # we can't determine lang from name, or query parameter, so take default - set lang [my default_language] - } - set local_name $path - } - } - Package instproc resolve_request {{-simple false} -path method_var} { my instvar folder_id #my log "--u [self args]" [self class] instvar queryparm set item_id 0 if {$path ne ""} { - # todo: caching opportunity? + # + # Try first a direct lookup of whatever we got + # set item_id [::xo::db::CrClass lookup -name $path -parent_id $folder_id] if {$simple} { if {$item_id != 0} { - set r [::xo::db::CrClass get_instance_from_db -item_id $item_id] + return [::xo::db::CrClass get_instance_from_db -item_id $item_id] } - return [expr {$item_id ? $item_id : ""}] + return "" } + my log "--try $path ($folder_id) -> $item_id" if {$item_id == 0} { - my get_name_and_lang_from_path $path lang local_name + my get_lang_and_name -path $path lang local_name set name ${lang}:$local_name - set item_id [::xo::db::CrClass lookup -name $name -parent_id $folder_id] - #my log "--try $name -> $item_id // ::xo::db::CrClass lookup -name $name -parent_id $folder_id" - if {$item_id == 0 && $lang eq "download" - && [regexp {^([^/]+)/(.*)$} $local_name _ prefix base_name]} { - set item_id [::xo::db::CrClass lookup -name ${prefix}:$base_name -parent_id $folder_id] - if {$item_id == 0} { - set item_id [::xo::db::CrClass lookup -name image:$base_name -parent_id $folder_id] - } - if {$item_id != 0} { + + if {$lang eq "download/file" || $lang eq "file"} { + # handle subitems, currently only for files + if {[regexp {^([^/]+)/(.*)$} $local_name _ parent local_name]} { + set parent_id [::xo::db::CrClass lookup -name $parent -parent_id $folder_id] + } else { + set parent_id $folder_id + } + set item_id [::xo::db::CrClass lookup -name file:$local_name -parent_id $parent_id] + + if {$item_id != 0 && $lang eq "download/file"} { upvar $method_var method set method download } - } - if {$item_id == 0 && $lang eq "file"} { - set item_id [::xo::db::CrClass lookup -name swf:$local_name -parent_id $folder_id] - if {$item_id == 0} { - set item_id [::xo::db::CrClass lookup -name image:$local_name -parent_id $folder_id] - } - my log "--try image:$local_name -> $item_id" } + + if {$item_id == 0} { + set item_id [::xo::db::CrClass lookup -name $name -parent_id $folder_id] + #my msg "--try $name -> $item_id // ::xo::db::CrClass lookup -name $name -parent_id $folder_id" + } + if {$item_id == 0 && $lang eq "tag"} { set tag $local_name set summary [::xo::cc query_parameter summary 0] set popular [::xo::cc query_parameter popular 0] set tag_kind [expr {$popular ? "ptag" :"tag"}] set weblog_page [my get_parameter weblog_page] - my get_name_and_lang_from_path $weblog_page lang local_name + my get_lang_and_name -path $weblog_page lang local_name set name $lang:$local_name my set object $weblog_page ::xo::cc set actual_query $tag_kind=$tag&summary=$summary @@ -1035,7 +1087,21 @@ } } + # + # Perform per connection parameter caching. Using the + # per-connection cache speeds later lookups up by a factor of 15. + # Repeated parameter lookups are quite likely + # + Class ParameterCache + ParameterCache instproc get_parameter {attribute {default ""}} { + set key [list [self proc] $attribute] + if {[::xo::cc cache_exists $key]} { + return [::xo::cc cache_get $key] + } + return [::xo::cc cache_set $key [next]] + } + Package instmixin add ParameterCache # Index: openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl,v diff -u -r1.103 -r1.104 --- openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl 25 Sep 2008 20:36:55 -0000 1.103 +++ openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl 27 Sep 2008 17:27:56 -0000 1.104 @@ -238,9 +238,8 @@ if {[$data form_parameter __new_p 0] || $old_name ne $name } { - set folder_id [$data parent_id] - #my msg "exists in db [::xo::db::CrClass lookup -name $name -parent_id $folder_id]" - return [expr {[::xo::db::CrClass lookup -name $name -parent_id $folder_id] == 0}] + #my msg "exists in db [::xo::db::CrClass lookup -name $name -parent_id [$data parent_id]]" + return [expr {[::xo::db::CrClass lookup -name $name -parent_id [$data parent_id]] == 0}] } return 1 } 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.283 -r1.284 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 25 Sep 2008 20:36:55 -0000 1.283 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 27 Sep 2008 17:27:56 -0000 1.284 @@ -1405,7 +1405,7 @@ my instvar name mime_type description parent_id package_id creation_user # don't require permissions here, such that rss can present the link #set page_link [$package_id make_link -privilege public [self] download ""] - set page_link [$package_id pretty_link -download true [my name]] + set page_link [$package_id pretty_link -download true -parent_id [my parent_id] [my name]] #my log "--F page_link=$page_link ---- " set t [TableWidget new -volatile \ -columns { @@ -1417,7 +1417,7 @@ }] regsub {[.][0-9]+([^0-9])} [my set last_modified] {\1} last_modified - regexp {^([^:]+):(.*)$} $name _ link_type stripped_name + $package_id get_lang_and_name -name $name lang stripped_name set label $stripped_name $t add \ Index: openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl,v diff -u -r1.178 -r1.179 --- openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 25 Sep 2008 21:00:35 -0000 1.178 +++ openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 27 Sep 2008 17:27:57 -0000 1.179 @@ -186,8 +186,7 @@ set create_in_req_locale_link "" if {[$package_id get_parameter use_connection_locale 0]} { - $package_id get_name_and_lang_from_path \ - [$package_id set object] req_lang req_local_name + $package_id get_lang_and_name -path [$package_id set object] req_lang req_local_name set default_lang [$package_id default_language] if {$req_lang ne $default_lang} { set l [Link create new -destroy_on_cleanup \ Index: openacs-4/packages/xowiki/www/admin/list.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/list.tcl,v diff -u -r1.23 -r1.24 --- openacs-4/packages/xowiki/www/admin/list.tcl 5 Sep 2008 17:24:16 -0000 1.23 +++ openacs-4/packages/xowiki/www/admin/list.tcl 27 Sep 2008 17:27:57 -0000 1.24 @@ -23,11 +23,13 @@ set page_title "List of all kind of [$supertype set pretty_plural]" set with_subtypes true set object_type $supertype + set with_children true } else { set per_type 1 set object_types [list $object_type] set page_title "Index of [$object_type set pretty_plural]" set with_subtypes false + set with_children true } set return_url [expr {$per_type ? [export_vars -base [::$package_id url] object_type] : @@ -69,9 +71,9 @@ if {$::with_publish_status} { ImageAnchorField publish_status -orderby publish_status.src -src "" \ -width 8 -height 8 -border 0 -title "Toggle Publish Status" \ - -alt "publish status" -label [_ xowiki.publish_status] -html {style "padding: 2px;"} + -alt "publish status" -label [_ xowiki.publish_status] -html {style "padding: 2px;text-align: center;"} } - Field syndicated -label "RSS" -html {style "padding: 2px;"} + Field syndicated -label "RSS" -html {style "padding: 2px; text-align: center;"} AnchorField page_order -label [_ xowiki.Page-page_order] -orderby page_order -html {style "padding: 2px;"} AnchorField name -label [_ xowiki.Page-name] -orderby name -html {style "padding: 2px;"} AnchorField title -label [_ xowiki.Page-title] -orderby title @@ -89,8 +91,8 @@ # -page_number 1 # for content_length, we need cr_revision and cannot use the base table -set attributes [list revision_id content_length creation_user title \ - "to_char(last_modified,'YYYY-MM-DD HH24:MI:SS') as last_modified" page_order] +set attributes [list revision_id content_length creation_user title page_order parent_id \ + "to_char(last_modified,'YYYY-MM-DD HH24:MI:SS') as last_modified" ] set folder_id [::$package_id folder_id] foreach i [db_list get_syndicated { @@ -104,10 +106,12 @@ -with_subtypes $with_subtypes \ -from_clause ", xowiki_page p" \ -where_clause "p.page_id = bt.revision_id" \ + -with_children $with_children \ -select_attributes $attributes \ -orderby ci.name \ ] { - set page_link [::$package_id pretty_link $name] + set page_link [::$package_id pretty_link -parent_id $parent_id $name] + set name [::$package_id external_name -parent_id $parent_id $name] t1 add \ -name $name \