proc fc_decode
::329560 proc fc_decode string {
return [string map [list __COMMA__ ,] $string]
}
proc fc_encode
::329560 proc fc_encode string {
return [string map [list , __COMMA__] $string]
}
proc get_from_name
::329560 proc get_from_name {object name} {
#
# Get a form field via name. The provided names are unique for a
# form. If multiple forms should be rendered simultaneously, we
# have to extend the addressing mechanism.
#
# todo: we could speed this up by an index if needed
foreach f [::xowiki::formfield::FormField info instances -closure] {
if {[$f name] eq $name} {
if {![$f exists object]} {
my msg "strange, $f [$f name] was created without object but fits name"
return $f
} elseif {$object eq [$f object]} {
return $f
}
}
}
#my msg not-found-$object-$name
return ""
}
proc get_single_spec
::329560 proc get_single_spec {-package_id -object string} {
if {[regexp [my set cond_regexp] $string _ condition true_spec false_spec]} {
if {[my interprete_condition -package_id $package_id -object $object $condition]} {
return [my get_single_spec -package_id $package_id -object $object $true_spec]
} else {
return [my get_single_spec -package_id $package_id -object $object $false_spec]
}
}
return $string
}
proc interprete_condition
::329560 proc interprete_condition {-package_id -object cond} {
if {[::xo::cc info methods role=$cond] ne ""} {
if {$cond eq "creator"} {
set success [::xo::cc role=$cond -object $object -user_id [::xo::cc user_id] -package_id $package_id]
} else {
set success [::xo::cc role=$cond -user_id [::xo::cc user_id] -package_id $package_id]
}
} else {
set success 0
}
return $success
}
instproc answer_check=answer_words
::329560 instproc answer_check=answer_words {} {
set value [regsub -all { +} [my value] " "]
if {[string match "*lower*" [lindex [my correct_when] 1]]} {
set value [string tolower $value]
}
return [expr {$value eq [my answer]}]
}
instproc answer_check=btwn
::329560 instproc answer_check=btwn {} {
my instvar value
set arg1 [lindex [my correct_when] 1]
set arg2 [lindex [my correct_when] 2]
return [expr {$value >= $arg1 && $value <= $arg2}]
}
instproc answer_check=eq
::329560 instproc answer_check=eq {} {
my instvar value
set arg1 [lindex [my correct_when] 1]
return [expr {$value eq $arg1}]
}
instproc answer_check=ge
::329560 instproc answer_check=ge {} {
my instvar value
set arg1 [lindex [my correct_when] 1]
return [expr {$value >= $arg1}]
}
instproc answer_check=gt
::329560 instproc answer_check=gt {} {
my instvar value
set arg1 [lindex [my correct_when] 1]
return [expr {$value > $arg1}]
}
instproc answer_check=in
::329560 instproc answer_check=in {} {
my instvar value
set values [lrange [my correct_when] 1 end]
return [expr {[lsearch -exact $values $value] > -1}]
}
instproc answer_check=le
::329560 instproc answer_check=le {} {
my instvar value
set arg1 [lindex [my correct_when] 1]
return [expr {$value <= $arg1}]
}
instproc answer_check=lt
::329560 instproc answer_check=lt {} {
my instvar value
set arg1 [lindex [my correct_when] 1]
return [expr {$value < $arg1}]
}
instproc answer_check=match
::329560 instproc answer_check=match {} {
return [string match [lindex [my correct_when] 1] [my value]]
}
instproc answer_is_correct
::329560 instproc answer_is_correct {} {
#my msg "[my name] ([my info class]): value=[my value], answer=[expr {[my exists answer]?[my set answer]:{NONE}}]"
if {[my exists correct_when]} {
set op [lindex [my correct_when] 0]
if {[my procsearch answer_check=$op] ne ""} {
set r [my answer_check=$op]
if {$r == 0} {return -1} {return 1}
} else {
error "invalid operator '$op'"
}
} elseif {![my exists answer]} {
return 0
} elseif {[my value] ne [my answer]} {
#my msg "v='[my value]' NE a='[my answer]'"
return -1
} else {
return 1
}
}
instproc asWidgetSpec
::329560 instproc asWidgetSpec {} {
my instvar widget_type options label help_text format html display_html
set spec $widget_type
if {[my exists spell]} {append spec ",[expr {[my spell] ? {} : {no}}]spell"}
if {![my required]} {append spec ",optional"}
if {[my exists editor]} {append spec " {options {editor [my set editor]}} "}
append spec " {label " [list $label] "} "
if {[my exists html]} {
append spec " {html {"
foreach {key value} [array get html] {
append spec $key " " [list $value] " "
}
append spec "}} "
}
if {[my exists options]} {
append spec " {options " [list $options] "} "
}
if {[my exists format]} {
append spec " {format " [list $format] "} "
}
if {$help_text ne ""} {
if {[string match "#*#" $help_text]} {
set internationalized [my localize $help_text]
append spec " {help_text {$internationalized}}"
} else {
append spec " {help_text {$help_text}}"
}
}
return $spec
}
instproc behavior
::329560 instproc behavior mixin {
#
# Specify the behavior of a form field via
# per object mixins
#
set obj [my object]
set pkgctx [[$obj package_id] context]
if {[$pkgctx exists embedded_context]} {
set ctx [$pkgctx set embedded_context]
set classname ${ctx}::$mixin
#my msg ctx=$ctx-viewer=$mixin,found=[my isclass $classname]
# TODO: search different places for the mixin. Special namespace?
if {[my isclass $classname]} {
if {[my exists per_object_behavior]} {
my mixin delete [my set per_object_behavior]
}
my mixin add $classname
my set per_object_behavior $classname
} else {
my msg "Could not find mixin '$mixin'"
}
}
}
instproc config_from_spec
::329560 instproc config_from_spec spec {
#my log "spec=$spec [my info class] [[my info class] exists abstract]"
my instvar type
if {[[my info class] exists abstract]} {
# had earlier here: [my info class] eq [self class]
# Check, wether the actual class is a concrete class (mapped to
# concrete field type) or an abstact class. Since
# config_from_spec can be called multiple times, we want to do
# the reclassing only once.
if {[my isclass ::xowiki::formfield::$type]} {
my class ::xowiki::formfield::$type
} else {
my class ::xowiki::formfield::text
}
# set missing instance vars with defaults
my set_instance_vars_defaults
}
regsub -all {,\s+} $spec , spec
foreach s [split $spec ,] {
my interprete_single_spec [FormField fc_decode $s]
}
#my msg "[my name]: after specs"
my set __state after_specs
my initialize
#
# It is possible, that a default value of a form field is changed through a spec.
# Since only the configuration might set values, checking value for "" seems safe here.
#
if {[my value] eq "" && [my exists default] && [my default] ne ""} {
#my msg "+++ reset value to [my default]"
my value [my default]
}
if {[lang::util::translator_mode_p]} {
my mixin add "::xo::TRN-Mode"
}
}
instproc convert_to_external
::329560 instproc convert_to_external value {
# to be overloaded
return $value
}
instproc convert_to_internal
::329560 instproc convert_to_internal {} {
# to be overloaded
}
instproc field_value
::329560 instproc field_value v {
if {[my exists show_raw_value]} {
return $v
} else {
return [my pretty_value $v]
}
}
instproc has_instance_variable
::329560 instproc has_instance_variable {var value} {
if {[my exists $var] && [my set $var] eq $value} {return 1}
return 0
}
instproc init
::329560 instproc init {} {
if {![my exists label]} {my label [string totitle [my name]]}
if {![my exists id]} {my id [my name]}
my set html(id) [my id]
#if {[my exists default]} {my set value [my default]}
my config_from_spec [my spec]
}
instproc initialize
::329560 instproc initialize {} next
instproc interprete_single_spec
::329560 instproc interprete_single_spec s {
if {$s eq ""} return
set object [my object]
set package_id [$object package_id]
set s [::xowiki::formfield::FormField get_single_spec -object $object -package_id $package_id $s]
switch -glob -- $s {
optional {my set required false}
required {my set required true; my remove_omit}
omit {my mixin add ::xowiki::formfield::omit}
noomit {my remove_omit}
disabled {my set_disabled true}
enabled {my set_disabled false}
label=* {my label [lindex [split $s =] 1]}
help_text=* {my help_text [lindex [split $s =] 1]}
*=* {
set p [string first = $s]
set attribute [string range $s 0 [expr {$p-1}]]
set value [string range $s [expr {$p+1}] end]
set definition_class [lindex [my procsearch $attribute] 0]
set method [my info methods $attribute]
if {[string match "::xotcl::*" $definition_class] || $method eq ""} {
error [_ xowiki.error-form_constraint-unknown_attribute [list class [my info class] name [my name] entry $attribute]]
}
if {[catch {
#
# We want to allow a programmer to use e.g. options=[xowiki::locales]
#
# Note: do not allow users to use [] via forms, since they might
# execute arbitrary commands. The validator for the form fields
# makes sure, that the input specs are free from square brackets.
#
if {[string match {\[*\]} $value]} {
set value [subst $value]
}
my $attribute $value
} errMsg]} {
error "Error during setting attribute '$attribute' to value '$value': $errMsg"
}
}
default {
# Check, if the spec value $s is a class.
set old_class [my info class]
# Don't allow to use namespaced values, since we would run
# into a recursive loop for richtext::wym (could be altered there as well).
if {[my isclass ::xowiki::formfield::$s] && ![string match "*:*" $s]} {
my class ::xowiki::formfield::$s
my remove_omit
if {$old_class ne [my info class]} {
#my msg "[my name]: reset class from $old_class to [my info class]"
my reset_parameter
my set __state reset
my initialize
}
} else {
if {$s ne ""} {
error [_ xowiki.error-form_constraint-unknown_spec_entry [list name [my name] entry $s x "Unknown spec entry for entry '$s'"]]
}
}
}
}
}
instproc localize
::329560 instproc localize v {
# We localize in pretty_value the message keys in the
# language of the item (not the connection item).
if {[regexp "^#(.*)#$" $v _ key]} {
return [lang::message::lookup [my locale] $key]
}
return $v
}
instproc pretty_image
::329560 instproc pretty_image {-parent_id:required entry_name} {
if {$entry_name eq ""} return
if {[my set value] eq ""} return
my instvar object value
array set "" [$object item_ref -default_lang [$object lang] -parent_id $parent_id $entry_name]
set label [my label] ;# the label is used for alt und title
if {$label eq $(stripped_name)} {
# The label is apparently the default. For Photo.form instances,
# this is always "image". In such cases, use the title of the
# parent object as label.
set label [[my object] title]
}
set l [::xowiki::Link create new -destroy_on_cleanup -page $object -type "image" -lang $(prefix) [list -stripped_name $(stripped_name)] [list -label $label] -parent_id $(parent_id) -item_id $(item_id)]
if {[my istype file]} {
set revision_id [my get_from_value $value revision_id]
if {$revision_id ne ""} {
$l revision_id $revision_id
}
}
foreach option {
href cssclass
float width height
padding padding-right padding-left padding-top padding-bottom
margin margin-left margin-right margin-top margin-bottom
border border-width position top botton left right
geometry
} {
if {[my exists $option]} {$l set $option [my set $option]}
}
set html [$l render]
return $html
}
instproc pretty_value
::329560 instproc pretty_value v {
#my log "mapping $v"
return [string map [list & "&" < "<" > ">" \" """ ' "'" @ "@"] $v]
}
instproc remove_omit
::329560 instproc remove_omit {} {
set m ::xowiki::formfield::omit
if {[my ismixin $m]} {my mixin delete $m}
}
instproc render
::329560 instproc render {} {
# In case, we use an asHTML of a FormField, we use this
# render definition
if {[my inline]} {
# with label, error message, help text
my render_form_widget
} else {
# without label, error message, help text
my render_item
}
my set __rendered 1
}
instproc render_error_msg
::329560 instproc render_error_msg {} {
if {[my error_msg] ne "" && ![my exists error_reported]} {
::html::div -class form-error {
my instvar label
::html::t [::xo::localize [my error_msg]]
my render_localizer
my set error_reported 1
}
}
}
instproc render_form_widget
::329560 instproc render_form_widget {} {
# This method provides the form-widget wrapper
set CSSclass [my form_widget_CSSclass]
if {[my error_msg] ne ""} {append CSSclass " form-widget-error"}
set atts [list class $CSSclass]
if {[my inline]} {lappend atts style "display: inline;"}
::html::div $atts { my render_input }
}
instproc render_help_text
::329560 instproc render_help_text {} {
set text [my help_text]
if {$text ne ""} {
html::div -class form-help-text {
html::img -src "/shared/images/info.gif" -alt {[i]} -title {Help text} -width "12" -height 9 -border 0 -style "margin-right: 5px" {}
html::t $text
}
}
}
instproc render_input
::329560 instproc render_input {} {
#
# This is the most general widget content renderer.
# If no special renderer is defined, we fall back to this one,
# which is in most cases a simple input fied of type string.
#
if {[my mode] ne "edit"} {
html::t -disableOutputEscaping [my pretty_value [my value]]
return
}
if {[my exists validate_via_ajax] && [my validator] ne ""} {
set ajaxhelper 1
::xowiki::Includelet require_YUI_JS -ajaxhelper 0 "yahoo/yahoo-min.js"
::xowiki::Includelet require_YUI_JS -ajaxhelper 0 "dom/dom-min.js"
::xowiki::Includelet require_YUI_JS -ajaxhelper 0 "event/event-min.js"
::xowiki::Includelet require_YUI_JS -ajaxhelper 0 "connection/connection-min.js"
::xo::Page requireJS "/resources/xowiki/yui-form-field-validate.js"
set package_url [[[my object] package_id] package_url]
::xo::Page requireJS "YAHOO.xo_form_field_validate.add('[my id]','$package_url');"
}
set pairs [list [list CSSclass class]]
# Special handling of HTML boolean attributes, since they require a
# different coding; it would be nice, if tdom would care for this.
set booleanAtts [list required readonly disabled multiple formnovalidate autofocus]
foreach att $booleanAtts {
if {[my exists $att] && [my set $att]} {
my set __#$att $att
lappend pairs [list __#$att $att]
}
}
::html::input [eval my get_attributes type size maxlength id name value pattern placeholder $pairs] {}
foreach att $booleanAtts {
if {[my exists __#$att]} {my unset __#$att}
}
#
# Disabled fieds are not returned by the browsers. For some
# fields, we require to be sent. therefore we include in these
# cases the value in an additional hidden field. Maybe we should
# change in the future the "name" of the disabled entry to keep
# some hypothetical html-checker quiet.
#
if {[my exists disabled] && [my exists transmit_field_always]} {
::html::input [list type hidden name [my name] value [my set value]] {}
}
my set __rendered 1
}
instproc render_item
::329560 instproc render_item {} {
::html::div -class [my form_item_wrapper_CSSclass] {
if {[my error_msg] ne ""} {
set CSSclass form-label-error
} else {
set CSSclass form-label
}
::html::div -class $CSSclass {
::html::label -for [my id] {
::html::t [my label]
}
if {[my required] && [my mode] eq "edit"} {
::html::div -class form-required-mark {
::html::t " (required)"
}
}
}
my render_form_widget
my render_help_text
my render_error_msg
html::t \n
}
}
instproc render_localizer
::329560 instproc render_localizer {} {
# Just an empty fall-back method.
# This method will be overloaded in trn mode by a mixin.
}
instproc repeat
::329560 instproc repeat range {
if {[my exists __initialized_repeat]} return
set oldClass [my info class]
my class ::xowiki::formfield::repeatContainer
if {$oldClass ne [my info class]} {
my reset_parameter
my set __state reset
}
if {$range ne ""} {
my instvar min max
if {[regexp {^(\d*)[.][.](\d*)$} $range _ low high]} {
if {$low ne ""} {set min $low}
if {$high ne ""} {set max $high}
if {$min > $max} {
error "invalid range '$range' specified (lower limit $min must not be larger than higher limit $max)"
}
if {$min < 0 || $max < 1} {
error "invalid range '$range' specified (max $max must be at least 1) "
}
} else {
error "invalid range '$range' specified (must be of form 'min..max')"
}
}
my initialize
}
instproc reset_parameter
::329560 instproc reset_parameter {} {
# reset application specific parameters (defined below ::xowiki::formfield::FormField)
# such that searchDefaults will pick up the new defaults, when a form field
# is reclassed.
if {[my exists per_object_behavior]} {
# remove per-object mixin from the "behavior"
my mixin delete [my set per_object_behavior]
my unset per_object_behavior
}
#my msg "reset along [my info precedence]"
foreach c [my info precedence] {
if {$c eq "::xowiki::formfield::FormField"} break
foreach s [$c info slots] {
if {![$s exists default]} continue
set var [$s name]
set key processed($var)
if {[info exists $key]} continue
my set $var [$s default]
set $key 1
}
}
if {[my exists disabled]} {
my set_disabled 0
}
}
instproc same_value
::329560 instproc same_value {v1 v2} {
if {$v1 eq $v2} {return 1}
return 0
}
instproc set_disabled
::329560 instproc set_disabled disable {
#my msg "[my name] set disabled $disable"
if {$disable} {
my set disabled true
} else {
my unset -nocomplain disabled
}
}
instproc set_is_repeat_template
::329560 instproc set_is_repeat_template is_template {
# my msg "[my name] set is_repeat_template $is_template"
if {$is_template} {
my set is_repeat_template true
} else {
my unset -nocomplain is_repeat_template
}
}
instproc validate
::329560 instproc validate obj {
my instvar name required
# use the 'value' method to deal e.g. with compound fields
set value [my value]
#my msg "[my info class] value=$value req=$required // [my set value] //"
if {$required && $value eq "" && ![my istype ::xowiki::formfield::hidden]} {
my instvar label
return [_ acs-templating.Element_is_required]
}
#
#my msg "++ [my name] [my info class] validator=[my validator] ([llength [my validator]]) value=$value"
foreach validator [my validator] {
set errorMsg ""
#
# The validator might set the variable errorMsg in this scope.
#
set success 1
set validator_method check=$validator
set proc_info [my procsearch $validator_method]
#my msg "++ [my name]: field-level validator exists '$validator_method' ? [expr {$proc_info ne {}}]"
if {$proc_info ne ""} {
# we have a slot checker, call it
#my msg "++ call-field level validator $validator_method '$value'"
set success [my validation_check $validator_method $value]
}
if {$success == 1} {
# the previous check was ok, check now for a validator on the
# object level
set validator_method validate=$validator
set proc_info [$obj procsearch $validator_method]
#my msg "++ [my name]: page-level validator exists ? [expr {$proc_info ne {}}]"
if {$proc_info ne ""} {
set success [$obj $validator_method $value]
#my msg "++ call page-level validator $validator_method '$value' returns $success"
}
}
if {$success == 0} {
#
# We have an error message. Get the class name from procsearch and construct
# a message key based on the class and the name of the validator.
#
set cl [namespace tail [lindex $proc_info 0]]
return [_ xowiki.$cl-validate_$validator [list value $value errorMsg $errorMsg]]
#return [::lang::message::lookup "" xowiki.$cl-validate_$validator %errorMsg% [list value $value errorMsg $errorMsg] 1]
}
}
return ""
}
instproc validation_check
::329560 instproc validation_check {validator_method value} {
return [my $validator_method $value]
}
instproc value_if_nothing_is_returned_from_form
::329560 instproc value_if_nothing_is_returned_from_form default {
return $default
}
![[i]](/resources/acs-subsite/ZoomIn16.gif)
::xowiki::formfield::FormField