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.320 -r1.321
--- openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 12 Aug 2013 19:46:50 -0000 1.320
+++ openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 27 Oct 2014 16:42:06 -0000 1.321
@@ -1,10 +1,10 @@
::xo::library doc {
- XoWiki - www procs. These procs are the methods called on xowiki pages via
- the web interface.
+ XoWiki - www procs. These procs are the methods called on xowiki pages via
+ the web interface.
- @creation-date 2006-04-10
- @author Gustaf Neumann
- @cvs-id $Id$
+ @creation-date 2006-04-10
+ @author Gustaf Neumann
+ @cvs-id $Id$
}
::xo::library require xowiki-procs
@@ -29,9 +29,9 @@
# the page_name is the name exactly as stored in the content repository
set item_id [::xo::db::CrClass lookup -name $page_name -parent_id [my item_id]]
if {$item_id == 0} {
- # when the pasted item was from a child-resources includelet
- # included on e.g. a plain page. we look for a sibling.
- set item_id [::xo::db::CrClass lookup -name $page_name -parent_id [my parent_id]]
+ # when the pasted item was from a child-resources includelet
+ # included on e.g. a plain page. we look for a sibling.
+ set item_id [::xo::db::CrClass lookup -name $page_name -parent_id [my parent_id]]
}
#my msg "want to copy $page_name // $item_id"
if {$item_id ne 0} {lappend ids $item_id}
@@ -59,11 +59,11 @@
util_user_message -message "Clipboard empty"
} else {
foreach item_id $clipboard {
- if {[::xo::db::CrClass get_instance_from_db -item_id $item_id] ne ""} {
- util_user_message -message [$item_id pretty_link]
- } else {
- util_user_message -message "item $item_id deleted"
- }
+ if {[::xo::db::CrClass get_instance_from_db -item_id $item_id] ne ""} {
+ util_user_message -message [$item_id pretty_link]
+ } else {
+ util_user_message -message "item $item_id deleted"
+ }
}
}
::$package_id returnredirect [my query_parameter "return_url" [::xo::cc url]]
@@ -76,13 +76,13 @@
my instvar package_id
set clipboard [::xowiki::clipboard get]
set item_ids [::xowiki::exporter include_needed_objects $clipboard]
- set content [::xowiki::exporter marshall_all $item_ids]
+ set content [::xowiki::exporter marshall_all -mode copy $item_ids]
if {[catch {namespace eval ::xo::import $content} error]} {
my msg "Error: $error\n$::errorInfo"
return
}
set msg [$package_id import -replace 0 -create_user_ids 1 \
- -parent_id [my item_id] -objects $item_ids]
+ -parent_id [my item_id] -objects $item_ids]
util_user_message -html -message $msg
::xowiki::clipboard clear
::$package_id returnredirect [my query_parameter "return_url" [::xo::cc url]]
@@ -206,6 +206,7 @@
::xowiki::FormPage get_instance_from_db -item_id $id
$f copy_content_vars -from_object $id
$f item_id $id
+
$f save
}
}
@@ -262,8 +263,8 @@
::xo::cc set queryparm(includelet_key) $includelet_key
# call the includelet
my view [my include [list form-usages -field_names $attributes \
- -extra_form_constraints _creation_user:numeric,format=%d \
- -form_item_id [my item_id] -generate csv]]
+ -extra_form_constraints _creation_user:numeric,format=%d \
+ -form_item_id [my item_id] -generate csv]]
}
#
@@ -280,7 +281,7 @@
if {$(item_id) == 0} { error "cannot lookup page $formName" }
::xo::db::CrClass get_instance_from_db -item_id $(item_id)
if {[info command ::$(item_id)] eq ""
- || "::xowiki::PageTemplate" ni [$(item_id) info precedence]} {
+ || "::xowiki::PageTemplate" ni [$(item_id) info precedence]} {
error "OK $formName is not suited to be used as template. Should be a Form!"
}
if {[my page_template] == $(item_id)} {
@@ -327,7 +328,7 @@
Page instproc delete-revision {} {
my instvar revision_id package_id item_id
- ::xo::db_1row get_revision {
+ ::xo::dc 1row get_revision {
select latest_revision,live_revision from cr_items where item_id = :item_id
}
# do real deletion via package
@@ -337,7 +338,7 @@
[export_vars -base [$package_id url] {{m revisions}}]]
if {$live_revision == $revision_id} {
# latest revision might have changed by delete_revision, so we have to fetch here
- xo::db_1row [my qn get_revision] "select latest_revision from cr_items where item_id = $item_id"
+ xo::dc 1row get_revision "select latest_revision from cr_items where item_id = :item_id"
if {$latest_revision eq ""} {
# we are out of luck, this was the final revision, delete the item
my instvar package_id name
@@ -349,7 +350,7 @@
if {$latest_revision ne ""} {
# otherwise, "delete" did already the redirect
::$package_id returnredirect [my query_parameter "return_url" \
- [export_vars -base [$package_id url] {{m revisions}}]]
+ [export_vars -base [$package_id url] {{m revisions}}]]
}
}
@@ -439,7 +440,7 @@
set l [lindex $lines1 $i]
incr i; incr j
#puts "B\t$i\t$j\t$l"
- append out "$l\n"
+ append out "$l\n"
}
}
while { $i < [llength $lines1] } {
@@ -466,7 +467,7 @@
# determine the delivery method
#
set use_bg_delivery [expr {![catch {ns_conn contentsentlength}] &&
- [info command ::bgdelivery] ne ""}]
+ [info commands ::bgdelivery] ne ""}]
#
# The package where the object is coming from might be different
# from the package on which it is delivered. Use the latter one
@@ -485,27 +486,27 @@
set geometry [::xo::cc query_parameter geometry ""]
if {[string match "image/*" $mime_type] && $geometry ne ""} {
if {![file isdirectory /tmp/$geometry]} {
- file mkdir /tmp/$geometry
+ file mkdir /tmp/$geometry
}
set scaled_image /tmp/$geometry/[my revision_id]
if {![file readable $scaled_image]} {
- set cmd [::util::which convert]
- if {$cmd ne ""} {
- if {![catch {exec $cmd -geometry $geometry -interlace None -sharpen 1x2 \
- $full_file_name $scaled_image}]} {
- return $scaled_image
- }
- }
+ set cmd [::util::which convert]
+ if {$cmd ne ""} {
+ if {![catch {exec $cmd -geometry $geometry -interlace None -sharpen 1x2 \
+ $full_file_name $scaled_image}]} {
+ return $scaled_image
+ }
+ }
} else {
- return $scaled_image
+ return $scaled_image
}
}
set modtime [file mtime $full_file_name]
set cmptime [ns_set iget [ns_conn headers] If-Modified-Since]
if {$cmptime ne ""} {
if {[clock scan $cmptime] >= $modtime} {
- ns_returnnotice 304 "Not modified" "not modified"
- return ""
+ ns_returnnotice 304 "Not modified" "not modified"
+ return ""
}
}
ns_set put [ns_conn outputheaders] Last-Modified [ns_httptime $modtime]
@@ -519,15 +520,15 @@
# forwarder methods like the following:
#
-# FormPage instproc download {} {
-# # If there is a link to a file, it can be downloaded as well
-# set target [my get_target_from_link_page]
-# if {$target ne "" && [$target istype ::xowiki::File]} {
-# $target download
-# } else {
-# [my package_id] error_msg "Method 'download' not implemented for this kind of object"
-# }
-# }
+ # FormPage instproc download {} {
+ # # If there is a link to a file, it can be downloaded as well
+ # set target [my get_target_from_link_page]
+ # if {$target ne "" && [$target istype ::xowiki::File]} {
+ # $target download
+ # } else {
+ # [my package_id] error_msg "Method 'download' not implemented for this kind of object"
+ # }
+ # }
#
# helper methods for externally callable method: edit
@@ -588,8 +589,8 @@
# We have to do template mangling here; ad_form_template writes
# form variables into the actual parselevel, so we have to be in
# our own level in order to access an pass these.
- variable ::template::parse_level
- lappend parse_level [info level]
+ lappend ::template::parse_level [info level]
+
set action_vars [expr {$new ? "{edit-new 1} object_type return_url" : "{m edit} return_url"}]
#my log "--formclass=[$object_type getFormClass -data [self]] ot=$object_type"
@@ -647,10 +648,35 @@
-form f1 \
-variables {item_id parent_id edit_form_page_title context formTemplate
view_link back_link rev_link index_link property_doc}]
- template::util::lpop parse_level
+ template::util::lpop ::template::parse_level
#my log "--edit html length [string length $html]"
return $html
}
+
+ FormPage instproc setCSSDefaults {} {
+ my log setCSSDefaults
+ # check empty
+ if {[parameter::get_global_value -package_key xowiki -parameter PreferredCSSToolkit -default yui] eq "bootstrap"} {
+ ::xowiki::formfield::FormField parameter {
+ {CSSclass form-control}
+ {form_item_wrapper_CSSclass form-group}
+ {form_widget_CSSclass ""}
+ {form_button_CSSclass "btn btn-default"}
+ {form_button_wrapper_CSSclass ""}
+ {form_help_text_CSSclass help-block}
+ }
+ } else {
+ ::xowiki::formfield::FormField parameter {
+ {CSSclass}
+ {form_widget_CSSclass form-widget}
+ {form_item_wrapper_CSSclass form-item-wrapper}
+ {form_button_CSSclass ""}
+ {form_button_wrapper_CSSclass form-button}
+ {form_help_text_CSSclass form-help-text}
+ }
+ ::xowiki::Form requireFormCSS
+ }
+ }
FormPage instproc edit {
{-validation_errors ""}
@@ -660,7 +686,7 @@
my instvar page_template doc root package_id
#my log "edit [self args]"
- ::xowiki::Form requireFormCSS
+ my setCSSDefaults
my include_header_info -prefix form_edit
if {[::xo::cc mobile]} {my include_header_info -prefix mobile}
@@ -723,7 +749,7 @@
#
# we have to valiate and save the form data
#
- foreach {validation_errors category_ids} [my get_form_data $form_fields] break
+ lassign [my get_form_data $form_fields] validation_errors category_ids
if {$validation_errors != 0} {
#my msg "$validation_errors errors in $form_fields"
@@ -741,11 +767,11 @@
lappend errors [list field [$f name] value [$f set value] error [$f error_msg]]
}
}
- set evaluation_errors ""
- if {[$package_id exists __evaluation_error]} {
- set evaluation_errors "\nEvaluation error: [$package_id set __evaluation_error]"
- $package_id unset __evaluation_error
- }
+ set evaluation_errors ""
+ if {[$package_id exists __evaluation_error]} {
+ set evaluation_errors "\nEvaluation error: [$package_id set __evaluation_error]"
+ $package_id unset __evaluation_error
+ }
error "[llength $errors] validation error(s): $errors $evaluation_errors"
}
# reset the name in error cases to the original one
@@ -757,28 +783,28 @@
my save_data \
-use_given_publish_date [expr {"_publish_date" in $field_names}] \
[::xo::cc form_parameter __object_name ""] $category_ids
- #
+ #
# The data might have references. Perform the rendering here to compute
- # the references instead on every view (which would be safer, but slower). This is
+ # the references instead on every view (which would be safer, but slower). This is
# roughly the counterpart to edit_data and save_data in ad_forms.
- #
+ #
set content [my render -update_references true]
- #my msg "after save refs=[expr {[my exists references]?[my set references] : {NONE}}]"
+ #my log "after save refs=[expr {[my exists references]?[my set references] : {NONE}}]"
- set redirect_method [my form_parameter __form_redirect_method "view"]
- if {$redirect_method eq "__none"} {
- return
- } else {
+ set redirect_method [my form_parameter __form_redirect_method "view"]
+ if {$redirect_method eq "__none"} {
+ return
+ } else {
if {$redirect_method ne "view"} {set qp "?m=$redirect_method"} {set qp ""}
- set url [my pretty_link]$qp
- set return_url [$package_id get_parameter return_url $url]
- # We had query_parameter here. however, to be able to
- # process the output of ::xo::cc set_parameter ...., we
- # changed it to "parameter".
- #my log "[my name]: url=$url, return_url=$return_url"
- $package_id returnredirect $return_url
+ set url [my pretty_link]$qp
+ set return_url [$package_id get_parameter return_url $url]
+ # We had query_parameter here. however, to be able to
+ # process the output of ::xo::cc set_parameter ...., we
+ # changed it to "parameter".
+ #my log "[my name]: url=$url, return_url=$return_url"
+ $package_id returnredirect $return_url
return
- }
+ }
}
} elseif {[my form_parameter __form_action ""] eq "view-form-data" && ![my exists __feedback_mode]} {
# We have nothing to save (maybe everything is read-only). Check
@@ -792,19 +818,11 @@
# display the current values
#
if {[my is_new_entry [my name]]} {
- my set creator [::xo::get_user_name [::xo::cc user_id]]
- my set nls_language [ad_conn locale]
- #my set name [$package_id query_parameter name ""]
- # TODO: maybe use __object_name to for POST url to make code
- # more straightworward
- #set n [$package_id query_parameter name \
- # [::xo::cc form_parameter __object_name ""]]
- #if {$n ne ""} {
- # my name $n
- #}
+ my set creator [::xo::get_user_name [::xo::cc user_id]]
+ my set nls_language [ad_conn locale]
}
- array set __ia [my set instance_attributes]
+ #array set __ia [my set instance_attributes]
my load_values_into_form_fields $form_fields
foreach f $form_fields {set ff([$f name]) $f }
@@ -822,8 +840,8 @@
$ff(_name) value [$ff(_name) default]
}
if {![$ff(_title) istype ::xowiki::formfield::hidden]} {
- $ff(_title) value [$ff(_title) default]
- }
+ $ff(_title) value [$ff(_title) default]
+ }
foreach var [list title detail_link text description] {
if {[my exists_query_parameter $var]} {
set value [my query_parameter $var]
@@ -853,8 +871,8 @@
# The following command would be correct, but does not work due to a bug in
# tdom.
# set form [my regsub_eval \
- # [template::adp_variable_regexp] $form \
- # {my form_field_as_html -mode edit "\\\1" "\2" $form_fields}]
+ # [template::adp_variable_regexp] $form \
+ # {my form_field_as_html -mode edit "\\\1" "\2" $form_fields}]
# Due to this bug, we program around and replace the at-character
# by \x003 to avoid conflict withe the input and we replace these
# magic chars finally with the fields resulting from tdom.
@@ -885,6 +903,7 @@
# Normally, the root node is the formNode, fcn is the first
# child (often a TEXT_NODE), but ic can be even empty.
}
+
#
# prepend some fields above the HTML contents of the form
@@ -899,7 +918,7 @@
#if {$formgiven && ![string match _* $att]} continue
if {[my exists __field_in_form($att)]} continue
set f [my lookup_form_field -name $att $form_fields]
- #my msg "insert auto_field $att"
+ #my msg "insert auto_field $att"
$f render_item
}
} $fcn
@@ -917,9 +936,9 @@
$f render_item
} elseif {[$f has_instance_variable editor wym]} {
set button_class(wym) "wymupdate"
- } elseif {[$f has_instance_variable editor xinha]} {
+ } elseif {[$f has_instance_variable editor xinha]} {
set button_class(xinha) "xinhaupdate"
- }
+ }
if {[$f has_instance_variable type file]} {
set has_file 1
}
@@ -937,10 +956,11 @@
if {$formNode ne ""} {
if {[my exists_query_parameter "return_url"]} {
- set return_url [my query_parameter "return_url"]
+ set return_url [my query_parameter "return_url"]
}
- set url [export_vars -base [my pretty_link] {{m "edit"} return_url}]
- $formNode setAttribute action $url method POST
+ set m [my form_parameter __form_redirect_method "edit"]
+ set url [export_vars -base [my pretty_link] {m return_url}]
+ $formNode setAttribute action $url method POST role form
if {$has_file} {$formNode setAttribute enctype multipart/form-data}
Form add_dom_attribute_value $formNode class [$page_template css_class_name]
}
@@ -962,6 +982,7 @@
}
}
my post_process_dom_tree $doc $root $form_fields
+
set html [$root asHTML]
set html [my regsub_eval \
{(^|[^\\])\x003([a-zA-Z0-9_:]+)\x003} $html \
@@ -1008,7 +1029,7 @@
set page_id [my query_parameter "page_id"]
::xo::clusterwide ns_cache flush xotcl_object_cache ::$item_id
::$package_id returnredirect [my query_parameter "return_url" \
- [export_vars -base [$package_id url] {{m revisions}}]]
+ [export_vars -base [$package_id url] {{m revisions}}]]
}
#
@@ -1022,16 +1043,16 @@
set href [$package_id pretty_link $weblog_page]?summary=1
set entries [list]
- db_foreach [my qn get_popular_tags] \
- [::xo::db::sql select \
- -vars "count(*) as nr, tag" \
- -from "xowiki_tags" \
- -where "item_id=$item_id" \
- -groupby "tag" \
- -orderby "nr" \
- -limit $limit] {
- lappend entries "$tag ($nr)"
- }
+ xo::dc foreach get_popular_tags \
+ [::xo::dc select \
+ -vars "count(*) as nr, tag" \
+ -from "xowiki_tags" \
+ -where "item_id = :item_id" \
+ -groupby "tag" \
+ -orderby "nr" \
+ -limit $limit] {
+ lappend entries "$tag ($nr)"
+ }
ns_return 200 text/html "[_ xowiki.popular_tags_label]: [join $entries {, }]"
}
@@ -1041,7 +1062,7 @@
Page ad_instproc save-attributes {} {
The method save-attributes is typically callable over the
- REST interface. It allows to save attributes of a
+ REST interface. It allows to save attributes of a
page without adding a new revision.
} {
my instvar package_id
@@ -1132,11 +1153,11 @@
Page instproc save-tags {} {
my instvar package_id item_id revision_id
::xowiki::Page save_tags \
- -user_id [::xo::cc user_id] \
- -item_id $item_id \
- -revision_id $revision_id \
+ -user_id [::xo::cc user_id] \
+ -item_id $item_id \
+ -revision_id $revision_id \
-package_id $package_id \
- [my form_parameter new_tags]
+ [my form_parameter new_tags]
::$package_id returnredirect \
[my query_parameter "return_url" [$package_id url]]
@@ -1226,20 +1247,20 @@
set notification_type [notification::type::get_type_id -short_name xowiki_notif]
set notification_text "Subscribe the XoWiki instance"
set notification_subscribe_link \
- [export_vars -base /notifications/request-new \
- {{return_url $notifications_return_url}
- {pretty_name $notification_text}
- {type_id $notification_type}
- {object_id $context_package_id}}]
+ [export_vars -base /notifications/request-new \
+ {{return_url $notifications_return_url}
+ {pretty_name $notification_text}
+ {type_id $notification_type}
+ {object_id $context_package_id}}]
set notification_image \
- "
"
+ ""
}
}
# the menubar is work in progress
set mb [$context_package_id get_parameter "MenuBar" 0]
- if {$mb ne "0" && [info command ::xowiki::MenuBar] ne ""} {
+ if {$mb ne "0" && [info commands ::xowiki::MenuBar] ne ""} {
set clipboard_size [::xowiki::clipboard size]
set clipboard_label [expr {$clipboard_size ? "Clipboard ($clipboard_size)" : "Clipboard"}]
@@ -1251,7 +1272,7 @@
$mb add_menu -name Package -label [$context_package_id instance_name]
$mb add_menu -name New
$mb add_menu -name Clipboard -label $clipboard_label
- $mb add_menu -name Page
+ $mb add_menu -name Page -label [_ xowiki.menu-Page]
$mb add_menu_item -name Package.Startpage \
-item [list text #xowiki.index# url $index_link]
$mb add_menu_item -name Package.Subscribe \
@@ -1271,8 +1292,8 @@
$mb add_menu_item -name Page.Delete \
-item [list text #xowiki.delete# url $delete_link]
if {[acs_user::site_wide_admin_p]} {
- $mb add_menu_item -name Page.Show \
- -item [list text "Show Object" url $page_show_link]
+ $mb add_menu_item -name Page.Show \
+ -item [list text "Show Object" url $page_show_link]
}
}
@@ -1307,13 +1328,13 @@
if {$showFolders} {
set folderhtml [my include {folders -style folders}]
} else {
- set folderhtml ""
+ set folderhtml ""
}
#
# At this place, the menu should be complete, we can render it
#
- append top_includelets \n "" [$mb render-yui]
+ append top_includelets \n "" [$mb render-preferred]
}
if {[$context_package_id get_parameter "with_user_tracking" 1]} {
@@ -1322,7 +1343,7 @@
# Deal with the views package (many thanks to Malte for this snippet!)
if {[$context_package_id get_parameter with_views_package_if_available 1]
- && [apm_package_installed_p "views"]} {
+ && [apm_package_installed_p "views"]} {
views::record_view -object_id $item_id -viewer_id [::xo::cc user_id]
array set views_data [views::get -object_id $item_id]
}
@@ -1354,13 +1375,13 @@
# $context_package_id get_lang_and_name -path [$context_package_id set object] req_lang req_local_name
# set default_lang [$page_package_id default_language]
# if {$req_lang ne $default_lang} {
- # set l [Link create new -destroy_on_cleanup \
- # -page [self] -type language -stripped_name $req_local_name \
- # -name ${default_lang}:$req_local_name -lang $default_lang \
- # -label $req_local_name -parent_id [my parent_id] -item_id 0 \
- # -package_id $context_package_id -init \
- # -return_only undefined]
- # $l render
+ # set l [Link create new -destroy_on_cleanup \
+ # -page [self] -type language -stripped_name $req_local_name \
+ # -name ${default_lang}:$req_local_name -lang $default_lang \
+ # -label $req_local_name -parent_id [my parent_id] -item_id 0 \
+ # -package_id $context_package_id -init \
+ # -return_only undefined]
+ # $l render
# }
# }
@@ -1375,37 +1396,59 @@
# the cache flush (next line) is not pretty here and should be supported from xotcl-core
catch {::xo::cc unset cache([list $context_package_id get_parameter template_file])}
set template_file [my query_parameter "template_file" \
- [::$context_package_id get_parameter template_file view-default]]
+ [::$context_package_id get_parameter template_file view-default]]
# if the template_file does not have a path, assume it in xowiki/www
if {![regexp {^[./]} $template_file]} {
- set template_file /packages/xowiki/www/$template_file
+ set template_file /packages/xowiki/www/$template_file
}
#
# initialize and set the template variables, to be used by
# a. adp_compile/ adp_eval
# b. return_page/ adp_include
#
-
+ ::xo::Page requireCSS /resources/xowiki/xowiki.css
+ if {$footer ne ""} {
+ ::xo::Page requireJS {
+ function get_popular_tags(popular_tags_link, prefix) {
+ var http = getHttpObject();
+ http.open('GET', popular_tags_link, true);
+ http.onreadystatechange = function() {
+ if (http.readyState == 4) {
+ if (http.status != 200) {
+ alert('Something wrong in HTTP request, status code = ' + http.status);
+ } else {
+ var e = document.getElementById(prefix + '-popular_tags');
+ e.innerHTML = http.responseText;
+ e.style.display = 'block';
+ }
+ }
+ };
+ http.send(null);
+ }
+ }
+ }
set header_stuff [::xo::Page header_stuff]
- if {[info command ::template::head::add_meta] ne ""} {
- set meta(language) [my lang]
- set meta(description) [my description]
- set meta(keywords) ""
- if {[my istype ::xowiki::FormPage]} {
- set meta(keywords) [string trim [my property keywords]]
- if {[my property html_title] ne ""} {
- ::xo::Page set_property doc title [my property html_title]
- }
- }
- if {$meta(keywords) eq ""} {
- set meta(keywords) [$context_package_id get_parameter keywords ""]
- }
- foreach i [array names meta] {
- # don't set empty meta tags
- if {$meta($i) eq ""} continue
- template::head::add_meta -name $i -content $meta($i)
- }
+ if {![my exists description]} {my set description [my get_description $content]}
+
+ if {[info commands ::template::head::add_meta] ne ""} {
+ set meta(language) [my lang]
+ set meta(description) [my description]
+ set meta(keywords) ""
+ if {[my istype ::xowiki::FormPage]} {
+ set meta(keywords) [string trim [my property keywords]]
+ if {[my property html_title] ne ""} {
+ ::xo::Page set_property doc title [my property html_title]
+ }
+ }
+ if {$meta(keywords) eq ""} {
+ set meta(keywords) [$context_package_id get_parameter keywords ""]
+ }
+ foreach i [array names meta] {
+ # don't set empty meta tags
+ if {$meta($i) eq ""} continue
+ template::head::add_meta -name $i -content $meta($i)
+ }
}
#
@@ -1416,23 +1459,23 @@
array set property_doc [::xo::Page get_property doc]
if {$page_package_id != $context_package_id} {
- set page_context [$page_package_id instance_name]
+ set page_context [$page_package_id instance_name]
}
if {$template ne ""} {
set __including_page $page
set __adp_stub [acs_root_dir]/packages/xowiki/www/view-default
set template_code [template::adp_compile -string $template]
- #
- # make sure that and tags are processed
- #
- append template_code {
- if { [info exists __adp_master] } {
- set __adp_output [template::adp_parse $__adp_master \
- [concat [list __adp_slave $__adp_output] \
- [array get __adp_properties]]]
- }
- }
+ #
+ # make sure that and tags are processed
+ #
+ append template_code {
+ if { [info exists __adp_master] } {
+ set __adp_output [template::adp_parse $__adp_master \
+ [concat [list __adp_slave $__adp_output] \
+ [array get __adp_properties]]]
+ }
+ }
if {[catch {set content [template::adp_eval template_code]} errmsg]} {
ns_return 200 text/html "Error in Page $name: $errmsg
$template"
} else {
@@ -1441,14 +1484,14 @@
} else {
# use adp file
#my log "use adp"
- set package_id $context_package_id
+ set package_id $context_package_id
$context_package_id return_page -adp $template_file -variables {
name title item_id context header_stuff return_url
content footer package_id page_package_id page_context
rev_link edit_link delete_link new_link admin_link index_link view_link
notification_subscribe_link notification_image
top_includelets page views_data property_body property_doc
- folderhtml
+ folderhtml
}
}
} else {
@@ -1466,10 +1509,10 @@
#
FormPage proc get_table_form_fields {
- -base_item
- -field_names
- -form_constraints
- } {
+ -base_item
+ -field_names
+ -form_constraints
+ } {
array set __att [list publish_status 1]
foreach att [::xowiki::FormPage array names db_slot] {set __att($att) 1}
@@ -1478,15 +1521,15 @@
}
# set cr_field_spec [::xowiki::PageInstance get_short_spec_from_form_constraints \
- # -name @cr_fields \
- # -form_constraints $form_constraints]
+ # -name @cr_fields \
+ # -form_constraints $form_constraints]
# if some fields are hidden in the form, there might still be values (creation_user, etc)
# maybe filter hidden? ignore for the time being.
set cr_field_spec ""
set field_spec [::xowiki::PageInstance get_short_spec_from_form_constraints \
- -name @fields \
- -form_constraints $form_constraints]
+ -name @fields \
+ -form_constraints $form_constraints]
foreach field_name $field_names {
set short_spec [::xowiki::PageInstance get_short_spec_from_form_constraints \
@@ -1605,7 +1648,7 @@
}
- FormPage instproc create_category_fields {} {
+ FormPage instproc create_category_fields {} {
set category_spec [my get_short_spec @categories]
# Per default, no category fields in FormPages, since the can be
# handled in more detail via form-fields.
@@ -1623,14 +1666,14 @@
#my msg "mapped category ids=$category_ids"
foreach category_tree $category_trees {
- foreach {tree_id tree_name subtree_id assign_single_p require_category_p} $category_tree break
+ lassign $category_tree tree_id tree_name subtree_id assign_single_p require_category_p
set options [list]
#if {!$require_category_p} {lappend options [list "--" ""]}
set value [list]
foreach category [::xowiki::Category get_category_infos \
-subtree_id $subtree_id -tree_id $tree_id] {
- foreach {category_id category_name deprecated_p level} $category break
+ lassign $category category_id category_name deprecated_p level
if {$category_id in $category_ids} {lappend value $category_id}
set category_name [ad_quotehtml [lang::util::localize $category_name]]
if { $level>1 } {
@@ -1667,28 +1710,28 @@
# Handling first TEXTARA
#
if {[$field nodeName] eq "textarea"} {
- return [$field nodeValue]
+ return [$field nodeValue]
}
if {[$field nodeName] ne "input"} continue
#
# Handling now just INPUT types (only one needed so far)
#
set type [expr {[$field hasAttribute type] ? [$field getAttribute type] : "text"}]
switch $type {
- checkbox {
- #my msg "get_form_value not implemented for $type"
- }
- radio {
- #my msg "get_form_value not implemented for $type"
- }
- hidden -
- password -
- text {
- if {[$field hasAttribute value]} {
- return [$field getAttribute value]
- }
- }
- default {
+ checkbox {
+ #my msg "get_form_value not implemented for $type"
+ }
+ radio {
+ #my msg "get_form_value not implemented for $type"
+ }
+ hidden -
+ password -
+ text {
+ if {[$field hasAttribute value]} {
+ return [$field getAttribute value]
+ }
+ }
+ default {
#my log "can't handle $type so far $att=$value"
}
}
@@ -1711,12 +1754,12 @@
# We handle textarea and input fields
#
if {[$field nodeName] eq "textarea"} {
- #
- # For TEXTAREA, delete the existing content and insert the new
- # content as text
- #
- foreach node [$field childNodes] {$node delete}
- $field appendFromScript {::html::t $value}
+ #
+ # For TEXTAREA, delete the existing content and insert the new
+ # content as text
+ #
+ foreach node [$field childNodes] {$node delete}
+ $field appendFromScript {::html::t $value}
}
if {[$field nodeName] ne "input"} continue
#
@@ -1758,10 +1801,10 @@
hidden -
password -
text {
- if { ![$field getAttribute rep "0"] } {
- $field setAttribute value $value
- }
- }
+ if { ![$field getAttribute rep "0"] } {
+ $field setAttribute value $value
+ }
+ }
default {my log "can't handle $type so far $att=$value"}
}
}
@@ -1771,16 +1814,17 @@
Store the instance attributes or default values in the form.
} {
::require_html_procs
+ my instvar instance_attributes
- array set __ia [my instance_attributes]
+ #array set __ia [my instance_attributes]
foreach f $form_fields {
set att [$f name]
# just handle fields of the form entry
if {![my exists __field_in_form($att)]} continue
- #my msg "set form_value to form-field $att __ia($att) [info exists __ia($att)]"
- if {[info exists __ia($att)]} {
- #my msg "my set_form_value from ia $att '$__ia($att)', external='[$f convert_to_external $__ia($att)]' f.value=[$f value]"
- my set_form_value $att [$f convert_to_external $__ia($att)]
+ #my msg "set form_value to form-field $att [dict exists $instance_attributes $att]"
+ if {[dict exists $instance_attributes $att]} {
+ #my msg "my set_form_value from ia $att '[dict get $instance_attributes $att]', external='[$f convert_to_external [dict get $instance_attributes $att]]' f.value=[$f value]"
+ my set_form_value $att [$f convert_to_external [dict get $instance_attributes $att]]
} else {
# do we have a value in the form? If yes, keep it.
set form_value [my get_form_value $att]
@@ -1794,14 +1838,29 @@
}
Page instproc mutual_overwrite_occurred {} {
- util_user_message -html \
- -message "User [::xo::get_user_name [my set modifying_user]] has modifyed this page \
- while you were editing it.\
- Open modified page in new window or press OK again to save this page."
+ util_user_message -html \
+ -message "User [::xo::get_user_name [my set modifying_user]] has modifyed this page \
+ while you were editing it.\
+ Open modified page in new window or press OK again to save this page."
# return 1 to flag validation error, 0 to ignore this fact
return 1
}
+ Page instproc validate=form_input_fields {form_fields} {
+ #
+ # This is the form-level validator, which might be used to perform
+ # validation based on e.g. multiple depending formfields. The
+ # validator can be used to test inter-dependencies between
+ # form-fields and should set the error fields of the reporting
+ # form field(s) via
+ #
+ # $f error_msg "some error...."
+ #
+ # This method can be refined by e.g. a workflow.
+ #
+ return 1
+ }
+
Page ad_instproc get_form_data {-field_names form_fields} {
Get the values from the form and store it in the form fields and
@@ -1812,12 +1871,12 @@
set validation_errors 0
set category_ids [list]
array set containers [list]
- my instvar __ia package_id
+ my instvar __ia package_id instance_attributes
set cc [$package_id context]
- if {[my exists instance_attributes]} {
- array unset __ia
- array set __ia [my set instance_attributes]
- }
+ #if {[my exists instance_attributes]} {
+ # array unset __ia
+ # array set __ia [my set instance_attributes]
+ #}
if {![info exists field_names]} {
set field_names [$cc array names form_parameter]
@@ -1841,19 +1900,19 @@
__* {
# other internal variables (like __object_name) are ignored
}
- _* {
- # instance attribute fields
- set f [my lookup_form_field -name $att $form_fields]
- set value [$f value [string trim [$cc form_parameter $att]]]
- set varname [string range $att 1 end]
- # get rid of strange utf-8 characters hex C2AD (firefox bug?)
- # ns_log notice "FORM_DATA var=$varname, value='$value' s=$s"
- if {$varname eq "text"} {regsub -all "" $value "" value}
- #ns_log notice "FORM_DATA var=$varname, value='$value'"
- if {![string match *.* $att]} {my set $varname $value}
- }
+ _* {
+ # instance attribute fields
+ set f [my lookup_form_field -name $att $form_fields]
+ set value [$f value [string trim [$cc form_parameter $att]]]
+ set varname [string range $att 1 end]
+ # get rid of strange utf-8 characters hex C2AD (firefox bug?)
+ # ns_log notice "FORM_DATA var=$varname, value='$value' s=$s"
+ if {$varname eq "text"} {regsub -all "" $value "" value}
+ #ns_log notice "FORM_DATA var=$varname, value='$value'"
+ if {![string match "*.*" $att]} {my set $varname $value}
+ }
default {
- # user form content fields
+ # user form content fields
if {[regexp {^(.+)[.](tmpfile|content-type)} $att _ file field]} {
set f [my lookup_form_field -name $file $form_fields]
$f $field [string trim [$cc form_parameter $att]]
@@ -1862,13 +1921,13 @@
set f [my lookup_form_field -name $att $form_fields]
set value [$f value [string trim [$cc form_parameter $att]]]
#my msg "value of $att ($f) = '$value' exists=[$cc exists_form_parameter $att]"
- if {![string match *.* $att]} {set __ia($att) $value}
+ if {![string match "*.*" $att]} {dict set instance_attributes $att $value}
if {[$f exists is_category_field]} {foreach v $value {lappend category_ids $v}}
}
}
}
- if {[string match *.* $att]} {
- foreach {container component} [split $att .] break
+ if {[string match "*.*" $att]} {
+ lassign [split $att .] container component
lappend containers($container) $component
}
}
@@ -1891,8 +1950,8 @@
set f [my lookup_form_field -name $c $form_fields]
set processed($c) 1
#my msg "container $c: compute value of $c [$f info class]"
- set __ia($c) [$f value]
- #my msg "container $c: __ia($c) is set to '$__ia($c)'"
+ dict set instance_attributes $c [$f value]
+ #my msg "container $c: is set to '[dict get $instance_attributes $c]'"
}
}
}
@@ -1905,41 +1964,41 @@
foreach f $form_fields {
#my msg "validate $f [$f name] [info exists processed([$f name])]"
set att [$f name]
-
+
# Certain form field types (e.g. checkboxes) are not transmitted, if not
# checked. Therefore, we have not processed these fields above and
# have to do it now.
if {![info exists processed($att)]} {
- #my msg "form field $att not yet processed"
- switch -glob -- $att {
- __* {
- # other internal variables (like __object_name) are ignored
- }
- _* {
- # instance attribute fields
- set varname [string range $att 1 end]
+ #my msg "form field $att not yet processed"
+ switch -glob -- $att {
+ __* {
+ # other internal variables (like __object_name) are ignored
+ }
+ _* {
+ # instance attribute fields
+ set varname [string range $att 1 end]
set default ""
if {[my exists $varname]} {set default [my set $varname]}
set v [$f value_if_nothing_is_returned_from_form $default]
set value [$f value $v]
if {$v ne $default} {
- if {![string match *.* $att]} {my set $varname $value}
+ if {![string match "*.*" $att]} {my set $varname $value}
}
- }
- default {
- # user form content fields
+ }
+ default {
+ # user form content fields
set default ""
# The reason, why we set in the next line the default to
# the old value is due to "show-solution" in the qti
# use-case. Maybe one should alter this use-case to
# simplify the semantics here.
- if {[info exists __ia($att)]} {set default $__ia($att)}
+ if {[dict exists $instance_attributes $att]} {set default [dict get $instance_attributes $att]}
set v [$f value_if_nothing_is_returned_from_form $default]
#my msg "value_if_nothing_is_returned_from_form '$default' => '$v' (type=[$f info class])"
set value [$f value $v]
- if {![string match *.* $att]} {set __ia($att) $value}
- }
+ if {![string match "*.*" $att]} {dict set instance_attributes $att $value}
+ }
}
}
@@ -1948,23 +2007,27 @@
#
set validation_error [$f validate [self]]
if {$validation_error ne ""} {
- #my msg "validation of $f [$f name] with value '[$f value]' returns '$validation_error'"
+ #my msg "validation of $f [$f name] with value '[$f value]' returns '$validation_error'"
$f error_msg $validation_error
incr validation_errors
}
}
#my msg "validation returns $validation_errors errors"
- set current_revision_id [::xo::cc form_parameter __current_revision_id ""]
+ set current_revision_id [$cc form_parameter __current_revision_id ""]
if {$validation_errors == 0 && $current_revision_id ne "" && $current_revision_id != [my revision_id]} {
set validation_errors [my mutual_overwrite_occurred]
}
+ if {[my validate=form_input_fields $form_fields] == 0} {
+ incr validation_errors
+ }
+
if {$validation_errors == 0} {
#
# Postprocess based on form fields based on form-fields methods.
#
foreach f $form_fields {
- $f convert_to_internal
+ $f convert_to_internal
}
} else {
my log validation_errors=$validation_errors
@@ -1976,13 +2039,13 @@
# would cause an interpretation of an uploaded empty file. Maybe
# a new method "reset-to-default" would be a good idea.
foreach f $form_fields {
- if {[$f type] eq "file"} {
- $f set value ""
+ if {[$f type] eq "file"} {
+ $f set value ""
}
}
}
- my instance_attributes [array get __ia]
+ #my instance_attributes [array get __ia]
#my msg category_ids=$category_ids
return [list $validation_errors [lsort -unique $category_ids]]
}
@@ -1996,13 +2059,13 @@
set f [my create_raw_form_field -name $name -slot [my find_slot $name]]
}
- #my msg "$found $name mode=$mode type=[$f set type] value=[$f value] disa=[$f exists disabled]"
+ #my msg "$found $name mode=$mode type=[$f set type] value=[$f value] disa=[$f exists disabled] display_field=[$f display_field]"
if {$mode eq "edit" || [$f display_field]} {
set html [$f asHTML]
} else {
set html @$name@
}
- #my msg "$name $html"
+ #my msg "RESULT: $name <$html>"
return ${before}$html
}
@@ -2051,7 +2114,7 @@
FormPage instproc field_names {{-form ""}} {
my instvar package_id
- foreach {form_vars needed_attributes} [my field_names_from_form -form $form] break
+ lassign [my field_names_from_form -form $form] form_vars needed_attributes
#my msg "form=$form, form_vars=$form_vars needed_attributes=$needed_attributes"
my array unset __field_in_form
my array unset __field_needed
@@ -2066,11 +2129,11 @@
set reduced_attributes $needed_attributes
foreach f $auto_fields {
- set p [lsearch $reduced_attributes $f]
+ set p [lsearch -exact $reduced_attributes $f]
if {$p > -1} {
- #if {$form_vars} {
- #set auto_field_in_form($f) 1
- #}
+ #if {$form_vars} {
+ #set auto_field_in_form($f) 1
+ #}
set reduced_attributes [lreplace $reduced_attributes $p $p]
}
}
@@ -2109,7 +2172,7 @@
}
FormPage instproc load_values_into_form_fields {form_fields} {
- array set __ia [my set instance_attributes]
+ my instvar instance_attributes
foreach f $form_fields {
set att [$f name]
switch -glob $att {
@@ -2119,20 +2182,21 @@
$f value [$f convert_to_external [my set $varname]]
}
default {
- if {[info exists __ia($att)]} {
- #my msg "setting $f ([$f info class]) value $__ia($att)"
- $f value [$f convert_to_external $__ia($att)]
+ if {[dict exists $instance_attributes $att]} {
+ #my msg "setting $f ([$f info class]) value [dict get $instance_attributes $att]"
+ $f value [$f convert_to_external [dict get $instance_attributes $att]]
}
}
}
}
}
FormPage instproc render_form_action_buttons {{-CSSclass ""}} {
- ::html::div -class form-button {
- set f [::xowiki::formfield::submit_button new -destroy_on_cleanup \
- -name __form_button_ok \
- -CSSclass $CSSclass]
+ set f [::xowiki::formfield::submit_button new -destroy_on_cleanup \
+ -name __form_button_ok \
+ -CSSclass $CSSclass]
+
+ ::html::div -class [$f form_button_wrapper_CSSclass] {
$f render_input
}
}
@@ -2180,3 +2244,10 @@
}
::xo::library source_dependent
+
+#
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 2
+# indent-tabs-mode: nil
+# End: