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.132 -r1.133
--- openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl 12 Aug 2013 19:46:50 -0000 1.132
+++ openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl 27 Oct 2014 16:42:05 -0000 1.133
@@ -1,9 +1,9 @@
::xo::library doc {
- XoWiki - form classes
+ XoWiki - form classes
- @creation-date 2006-04-10
- @author Gustaf Neumann
- @cvs-id $Id$
+ @creation-date 2006-04-10
+ @author Gustaf Neumann
+ @cvs-id $Id$
}
namespace eval ::xowiki {
@@ -14,13 +14,13 @@
Class create WikiForm -superclass ::Generic::Form \
-parameter {
- {field_list {item_id name page_order title creator text description nls_language}}
- {f.item_id {item_id:key}}
- {f.name "="}
- {f.page_order "="}
+ {field_list {item_id name page_order title creator text description nls_language}}
+ {f.item_id {item_id:key}}
+ {f.name "="}
+ {f.page_order "="}
{f.title "="}
{f.creator "="}
- {f.text "= richtext,editor=xinha"}
+ {f.text "= richtext,editor=xinha"}
{f.description "="}
{f.nls_language "="}
{validate {
@@ -35,15 +35,15 @@
{autoname 0}
} -ad_doc {
Form Class for XoWiki Pages.
-
- You can manipulate the form elements shown by editing the field_list.
- The following elements are mandatory in field_list
+
+ You can manipulate the form elements shown by editing the field_list.
+ The following elements are mandatory in field_list
and should never be left out:
-
-
name
-
item_id
-
-
+
+
name
+
item_id
+
+
}
WikiForm instproc mkFields {} {
@@ -67,30 +67,30 @@
[$data istype ::xowiki::PlainPage] && $__field eq "text"
|| [$data istype ::xowiki::File] && $__field eq "text"
} {
- set s ""
+ set s ""
} else {
- set s [$data get_rich_text_spec $__field ""]
+ set s [$data get_rich_text_spec $__field ""]
}
if {$s ne ""} {
#my msg "we got richtext spec for $__field = '$s'"
- set __spec $s
- set __wspec [lindex $__spec 0]
- # old style folder spec substituion. ugly.
+ set __spec $s
+ set __wspec [lindex $__spec 0]
+ # old style folder spec substituion. ugly.
if {[my folderspec] ne ""} {
# append the folder spec to its options
set __newspec [list $__wspec]
foreach __e [lrange $__spec 1 end] {
- foreach {__name __value} $__e break
- if {$__name eq "options"} {eval lappend __value [my folderspec]}
+ lassign $__e __name __value
+ if {$__name eq "options"} {lappend __value {*}[my folderspec]}
lappend __newspec [list $__name $__value]
}
#my msg "--F rewritten spec is '$__newspec'"
set __spec $__newspec
}
} elseif {[lindex $__wspec 0] eq "="} {
- #
- # get the information from the attribute definitions & given specs
- #
+ #
+ # get the information from the attribute definitions & given specs
+ #
set f [$data create_raw_form_field \
-name $__field \
@@ -137,7 +137,7 @@
# Reorder the locales and put the connection locale to the front
# in case we have a connection
#
- set defpos [lsearch $locales [lang::conn::locale]]
+ set defpos [lsearch -exact $locales [lang::conn::locale]]
set locales [linsert [lreplace $locales $defpos $defpos] 0 \
[lang::conn::locale]]
}
@@ -153,7 +153,7 @@
-folder_id $folder_id \
-with_subtypes false \
-select_attributes {name}]
- db_foreach [$form qn get_page_templates] $q {
+ xo::dc foreach get_page_templates $q {
lappend lpairs [list $name $item_id]
} if_no_rows {
lappend lpairs [list "(No Page Template available)" ""]
@@ -182,18 +182,18 @@
proc ::xowiki::guesstype {fn} {
set mime [ns_guesstype $fn]
if {$mime eq "*/*"
- || $mime eq "application/octet-stream"
- || $mime eq "application/force-download"} {
+ || $mime eq "application/octet-stream"
+ || $mime eq "application/force-download"} {
# ns_guesstype was failing
switch [file extension $fn] {
.xotcl {set mime text/plain}
.mp3 {set mime audio/mpeg}
.cdf {set mime application/x-netcdf}
.flv {set mime video/x-flv}
- .swf {set mime application/x-shockwave-flash}
+ .swf {set mime application/x-shockwave-flash}
.pdf {set mime application/pdf}
.wmv {set mime video/x-ms-wmv}
- .class - .jar {set mime application/java}
+ .class - .jar {set mime application/java}
default {set mime application/octet-stream}
}
}
@@ -244,12 +244,12 @@
#
set package_id [$cc package_id]
set computed_link [export_vars -base [$package_id package_url] {{edit-new 1} name
- {object_type ::xowiki::File}}]
+ {object_type ::xowiki::File}}]
set granted [$package_id check_permissions -link $computed_link $package_id edit-new]
#$data msg computed_link=$computed_link,granted=$granted
if {!$granted} {
- util_user_message -message "User not authorized to to create a file named $name"
- return 0
+ util_user_message -message "User not authorized to to create a file named $name"
+ return 0
}
} else {
$data name $name
@@ -270,19 +270,19 @@
|| $old_name ne $name
} {
if {[::xo::db::CrClass lookup -name $name -parent_id [$data parent_id]] == 0} {
- # the provided name is really new
+ # the provided name is really new
return 1
}
if {[$data istype ::xowiki::PageInstance]} {
- # The entry might be autonamed. In case of imports from other
- # xowiki instances, we might have name clashes. Therefore, we
- # compute a fresh name here.
- set anon_instances [$data get_from_template anon_instances f]
- if {$anon_instances} {
- set basename [::xowiki::autoname basename [[$data page_template] name]]
- $data name [::xowiki::autoname new -name $basename -parent_id [$data parent_id]]
- return 1
- }
+ # The entry might be autonamed. In case of imports from other
+ # xowiki instances, we might have name clashes. Therefore, we
+ # compute a fresh name here.
+ set anon_instances [$data get_from_template anon_instances f]
+ if {$anon_instances} {
+ set basename [::xowiki::autoname basename [[$data page_template] name]]
+ $data name [::xowiki::autoname new -name $basename -parent_id [$data parent_id]]
+ return 1
+ }
}
return 0
}
@@ -315,23 +315,23 @@
return 1
}
-## We could strip the language prefix from the name, since it is essentially
-## ignored... but we keep it for informational purposes
-#
-# WikiForm instproc set_form_data {} {
-# next
-# #my msg "name in form=[my var name]"
-# set name_in_form [my var name]
-# if {[regexp {^..:(.*)$} $name_in_form _ stripped_name]} {
-# # use stripped "name" in form to avoid possible confusions
-# my var name $stripped_name
-# }
-# }
+ ## We could strip the language prefix from the name, since it is essentially
+ ## ignored... but we keep it for informational purposes
+ #
+ # WikiForm instproc set_form_data {} {
+ # next
+ # #my msg "name in form=[my var name]"
+ # set name_in_form [my var name]
+ # if {[regexp {^..:(.*)$} $name_in_form _ stripped_name]} {
+ # # use stripped "name" in form to avoid possible confusions
+ # my var name $stripped_name
+ # }
+ # }
WikiForm instproc tidy {} {
upvar #[template::adp_level] text text
if {[info exists text]} {
- foreach {text format} [my var text] break
+ lassign [my var text] text format
if {[info exists format]} {
my var text [list [list [::xowiki::tidy clean $text] $format]]
}
@@ -395,7 +395,7 @@
}
}
-
+
WikiForm instproc new_request {} {
my instvar data
#
@@ -472,7 +472,7 @@
Class create FileForm -superclass WikiForm \
-parameter {
{html { enctype multipart/form-data }} \
- {field_list {item_id name page_order text title creator description}}
+ {field_list {item_id name page_order text title creator description}}
{f.name "= optional,help_text=#xowiki.File-name-help_text#"}
{f.title "= optional"}
{f.text
@@ -481,13 +481,13 @@
{html {size 30}} }}
{validate {
{upload_file {\[::xowiki::validate_file\]} {For new entries, \
- a upload file must be provided}}
+ a upload file must be provided}}
{page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
- might only contain upper and lower case letters, underscore, digits and dots}}
+ might only contain upper and lower case letters, underscore, digits and dots}}
{name {\[::xowiki::validate_name\]} {Another item with this name exists \
- already in this folder}}
- }}
- }
+ already in this folder}}
+ }}
+ }
FileForm instproc tidy {} {
# nothing
}
@@ -501,11 +501,11 @@
$data set upload_file $upload_file
$data set import_file [$data form_parameter upload_file.tmpfile]
set mime_type [$data form_parameter upload_file.content-type]
- if {[::xo::db_0or1row check_mimetype {
- select 1 from cr_mime_types where mime_type = :mime_type
+ if {[::xo::dc 0or1row check_mimetype {
+ select 1 from cr_mime_types where mime_type = :mime_type
}] == 0
- || $mime_type eq "application/octet-stream"
- || $mime_type eq "application/force-download"} {
+ || $mime_type eq "application/octet-stream"
+ || $mime_type eq "application/force-download"} {
set guessed_mime_type [::xowiki::guesstype $upload_file]
#my msg guess=$guessed_mime_type
if {$guessed_mime_type ne "*/*"} {
@@ -538,35 +538,35 @@
return [next]
}
-# {f.pub_date
-# {pub_date:date,optional {format "YYYY MM DD HH24 MI"} {html {id date}}
-# {after_html { Y-M-D}
-# }}
-# }
+ # {f.pub_date
+ # {pub_date:date,optional {format "YYYY MM DD HH24 MI"} {html {id date}}
+ # {after_html { Y-M-D}
+ # }}
+ # }
Class create PodcastForm -superclass FileForm \
-parameter {
{html { enctype multipart/form-data }} \
- {field_list {item_id name page_order text title subtitle creator pub_date duration keywords
- description}}
+ {field_list {item_id name page_order text title subtitle creator pub_date duration keywords
+ description}}
{validate {
{upload_file {\[::xowiki::validate_file\]} {For new entries, \
- a upload file must be provided}}
+ a upload file must be provided}}
{name {\[::xowiki::validate_name\]} {Another item with this name exists \
- already in this folder}}
+ already in this folder}}
{page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
- might only contain upper and lower case letters, underscore, digits and dots}}
+ might only contain upper and lower case letters, underscore, digits and dots}}
{duration {\[::xowiki::validate_duration\]} {Check duration and provide default}}
- }}
+ }}
}
-# {help_text {E.g. 9:16 means 9 minutes 16 seconds (if ffmpeg is installed and configured, it will get the value automatically)}}
+ # {help_text {E.g. 9:16 means 9 minutes 16 seconds (if ffmpeg is installed and configured, it will get the value automatically)}}
PodcastForm instproc to_timestamp {widgetinfo} {
if {$widgetinfo ne ""} {
- foreach {y m day hour min} $widgetinfo break
+ lassign $widgetinfo y m day hour min
set t [clock scan "${hour}:$min $m/$day/$y"]
#
# be sure to avoid bad side effects from LANG environment variable
@@ -633,7 +633,7 @@
ObjectForm instproc new_request {} {
my instvar data
permission::require_permission \
- -party_id [ad_conn user_id] -object_id [$data set parent_id] \
+ -party_id [ad_conn user_id] -object_id [$data set parent_id] \
-privilege "admin"
next
}
@@ -657,10 +657,10 @@
#
Class create PageTemplateForm -superclass WikiForm \
-parameter {
- {field_list {
- item_id name page_order title creator text anon_instances
+ {field_list {
+ item_id name page_order title creator text anon_instances
description nls_language
- }}
+ }}
}
#
@@ -737,21 +737,24 @@
my log "-- "
my instvar page_instance_form_atts data
next
- array set __ia [$data set instance_attributes]
+
+ set __ia [$data set instance_attributes]
foreach var $page_instance_form_atts {
- if {[info exists __ia($var)]} {my var $var [list $__ia($var)]}
+ if {[dict exists $__ia $var]} {my var $var [list [dict get $__ia $var]]}
}
}
PageInstanceEditForm instproc edit_data {} {
my log "-- "
my instvar page_instance_form_atts data
- array set __ia [$data set instance_attributes]
+
+ set __ia [$data set instance_attributes]
foreach var $page_instance_form_atts {
- set __ia($var) [my var $var]
+ dict set __ia $var [my var $var]
}
- $data set instance_attributes [array get __ia]
+ $data set instance_attributes $__ia
+
set item_id [next]
my log "-- edit_data item_id=$item_id"
return $item_id
@@ -807,14 +810,14 @@
if {$text eq ""} { return 1 }
if {[llength $text] != 2} { return 0 }
regsub -all "" $text "" text ;# get rid of strange utf-8 characters hex C2AD (firefox bug?)
- foreach {content mime} $text break
+ lassign $text content mime
if {$content eq ""} {return 1}
#ns_log notice "VALUE='$content'"
set clean_content $content
regsub -all " " $clean_content "" clean_content
regsub -all "?p */?>" $clean_content "" clean_content
#ns_log notice "--validate_form_content '$content' clean='$clean_content', \
- # stripped='[string trim $clean_content]'"
+ # stripped='[string trim $clean_content]'"
if {[string trim $clean_content] eq ""} { set text [list "" $mime]}
#my log "final text='$text'"
return 1
@@ -829,43 +832,43 @@
}
Class create FormForm -superclass ::xowiki::PageTemplateForm \
- -parameter {
- {field_list {item_id name page_order title creator text form form_constraints
- anon_instances description nls_language}}
- {f.text "= richtext,height=150px,label=#xowiki.Form-template#"}
- {f.form "= richtext,height=150px"}
- {f.form_constraints "="}
- {validate {
- {name {\[::xowiki::validate_name\]} {Another item with this name exists \
- already in this folder}}
- {text {\[::xowiki::validate_form_text\]} {Form must contain a valid template}}
- {page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
- might only contain upper and lower case letters, underscore, digits and dots}}
- {form {\[::xowiki::validate_form_form\]} {Form must contain a toplevel HTML form element}}
- {form_constraints {\[::xowiki::validate_form_field form_constraints\]} {Invalid form constraints}}
- }}
- }
+ -parameter {
+ {field_list {item_id name page_order title creator text form form_constraints
+ anon_instances description nls_language}}
+ {f.text "= richtext,height=150px,label=#xowiki.Form-template#"}
+ {f.form "= richtext,height=150px"}
+ {f.form_constraints "="}
+ {validate {
+ {name {\[::xowiki::validate_name\]} {Another item with this name exists \
+ already in this folder}}
+ {text {\[::xowiki::validate_form_text\]} {Form must contain a valid template}}
+ {page_order {\[::xowiki::validate_form_field page_order\]} {Page Order invalid;
+ might only contain upper and lower case letters, underscore, digits and dots}}
+ {form {\[::xowiki::validate_form_form\]} {Form must contain a toplevel HTML form element}}
+ {form_constraints {\[::xowiki::validate_form_field form_constraints\]} {Invalid form constraints}}
+ }}
+ }
FormForm instproc new_data {} {
my instvar data
set item_id [next]
# provide unique ids and names, if form is provided
-# set form [$data set form]
-# if {$form ne ""} {
-# dom parse -simple -html [lindex $form 0] doc
-# $doc documentElement root
-# set id ID$item_id
-# $root setAttribute id $id
-# set fields [$root selectNodes "//*\[@name != ''\]"]
-# foreach field $fields {
-# $field setAttribute name $id.[$field getAttribute name]
-# }
-# # updating is rather crude. we need the item_id in advance to fill it
-# # into the items, but it is returned from saving the file.
-# my log "item_id=$item_id form=[$root asHTML] [$data serialize]"
-# $data update_content [$data revision_id] [list [$root asHTML] [lindex $form 1] ]
-# }
+ # set form [$data set form]
+ # if {$form ne ""} {
+ # dom parse -simple -html [lindex $form 0] doc
+ # $doc documentElement root
+ # set id ID$item_id
+ # $root setAttribute id $id
+ # set fields [$root selectNodes "//*\[@name != ''\]"]
+ # foreach field $fields {
+ # $field setAttribute name $id.[$field getAttribute name]
+ # }
+ # # updating is rather crude. we need the item_id in advance to fill it
+ # # into the items, but it is returned from saving the file.
+ # my log "item_id=$item_id form=[$root asHTML] [$data serialize]"
+ # $data update_content [$data revision_id] [list [$root asHTML] [lindex $form 1] ]
+ # }
return $item_id
}
@@ -874,3 +877,9 @@
}
::xo::library source_dependent
+#
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 2
+# indent-tabs-mode: nil
+# End: