xotcl.wu-wien.ac.at
Begin main content
Methods: Source: Variables:
[All Methods | Documented Methods | Hide Methods] [Display Source | Hide Source] [Show Variables | Hide Variables]

::xo::db::CrClass[i] ::xowiki::FormPage

Class Hierarchy of ::xowiki::FormPage

  • ::xotcl::Object[i]
    Meta-class:
    ::xotcl::Class[i]
    Methods for instances:
    __api_make_doc, __api_make_forward_doc, __timediff, abstract, ad_doc, ad_forward, ad_proc, appendC, arrayC, asHTML, autonameC, check, classC, cleanupC, configureC, containsC, copyC, db_0or1rowC, db_1rowC, debug, defaultmethodC, destroyC, destroy_on_cleanup, ds, evalC, existsC, extractConfigureArg, filterC, filterguardC, filtersearch, forward, hasclass, incrC, infoC, init, instvarC, invarC, isclass, ismetaclass, ismixin, isobject, istype, lappendC, log, method, mixinC, mixinguardC, moveC, msg, noinitC, objectparameter, parametercmdC, proc, procsearch, qn, requireNamespaceC, residualargsC, self, serialize, setC, set_instance_vars_defaults, show-object, substC, traceC, unknown, unsetC, uplevelC, upvarC, volatileC, vwait
    Methods to be applied on the class (in addition to the methods provided by the meta-class):
    getExitHandler, setExitHandler, unsetExitHandler
    • ::xo::db::Object[i]
      Meta-class:
      ::xo::db::Class[i]
      Methods for instances:
      db_1row, delete, initialize_loaded_object, insert, object_idC, object_titleC, save, save_new
      Methods to be applied on the class:
      Methods provided by the meta-class
      • ::xo::db::CrItem[i]
        Meta-class:
        ::xo::db::CrClass[i]
        Parameter for instances:
        package_id, parent_id (default "-100"), publish_status (default "ready")
        Methods for instances:
        current_user_id, delete, descriptionC, fix_content, initialize_loaded_object, item_idC, mime_typeC, nameC, nls_languageC, privilege=creator, publish_dateC, rename, revision_idC, revisions, save, save_new, set_live_revision, textC, titleC, update_attribute_from_slot, update_content, update_revision
        Methods to be applied on the class:
        Methods provided by the meta-class
        • ::xowiki::Page[i]
          Meta-class:
          ::xo::db::CrClass[i]
          Parameter for instances:
          absolute_links (default "0"), do_substitutions (default "1"), render_adp (default "1")
          Methods for instances:
          adp_subst, anchor, build_instance_attribute_map, build_name, category_export, category_import, check_adp_include_path, clipboard-add, clipboard-clear, clipboard-content, clipboard-copy, clipboard-export, condition=match, condition=regexp, copy_content_vars, create-new, create-or-use, create_form_field, create_form_fields, create_form_fields_from_form_constraints, create_form_page_instance, create_link, create_raw_form_field, creation_userC, creatorC, css_class_name, csv-dump, default_instance_attributes, delete, delete-revision, demarshall, descriptionC, detail_link, diff, div, edit, edit_set_default_values, edit_set_file_selector_folder, error_during_render, error_in_includelet, exists_form_parameterC, exists_query_parameterC, field_names, find_slot, footer, form_field_index, form_parameterC, get_anchor_and_query, get_content, get_description, get_folder, get_form_data, get_html_from_content, get_instance_attributes, get_nls_language_from_lang, get_property_from_link_page, get_rich_text_spec, get_target_from_link_page, htmlFooter, include, include_content, initialize_loaded_object, instantiate_includelet, is_folder_page, is_form, is_link_page, is_new_entry, item_refC, lang, last_modifiedC, list, lookup_cached_form_field, lookup_form_field, make-live-revision, map_categories, map_party, marshall, mime_typeC, mutual_overwrite_occurred, nameC, new_link, nls_languageC, normalize_internal_link_name, page_idC, page_orderC, physical_package_id, physical_parent_id, popular-tags, pretty_link, pretty_name, publish_dateC, query_parameterC, record_last_visited, references_update, regsub_eval, render, render_content, render_icon, render_includelet, reset_resolve_context, resolve_included_page_name, reverse_map_party, reverse_map_party_attribute, revisions, save, save-attributes, save-tags, save_data, save_new, search_render, set_content, set_resolve_context, show_fields, substitute_markup, textC, titleC, translate, unescape, unset_temporary_instance_variables, validate-attribute, validate=form_constraints, validate=name, validate=page_order, view
          Methods to be applied on the class (in addition to the methods provided by the meta-class):
          container_already_rendered, find_slot, get_tags, import, quoted_html_content, save_tags
          • ::xowiki::PageInstance[i]
            Meta-class:
            ::xo::db::CrClass[i]
            Methods for instances:
            adp_subst, count_usages, create_raw_form_field, demarshall, get_field_label, get_field_type, get_form, get_form_constraints, get_from_template, get_short_spec, get_template_object, instance_attributesC, mime_typeC, page_instance_idC, page_templateC, render_content, template_vars, use-template, widget_spec_from_folder_object
            Methods to be applied on the class (in addition to the methods provided by the meta-class):
            get_list_from_form_constraints, get_short_spec_from_form_constraints
            • ::xowiki::FormPage[i]
              Meta-class:
              ::xo::db::CrClass[i]
              Methods for instances:
              adp_subst, assigneeC, compute_link_properties, condition=in_state, condition=is_true, create_category_fields, create_form_field, create_form_fields, demarshall, edit, exists_property, field_names, field_names_from_form, footer, form_field_as_html, form_fields_sanity_check, get_anon_instances, get_form_constraints, get_form_value, get_parameter, get_property, get_value, group_assign, group_require, include_header_info, initialize, initialize_loaded_object, is_folder_page, is_form, is_link_page, load_values_into_form_fields, map_value, map_values, marshall, mime_typeC, new_link, post_process_dom_tree, post_process_form_fields, pretty_name, property, property_key, render_content, render_form_action_buttons, render_icon, reverse_map_value, reverse_map_values, set_form_data, set_form_value, set_property, set_publish_status, stateC, xowiki_form_page_idC
              Methods to be applied on the class (in addition to the methods provided by the meta-class):
              filter_expression, get_all_children, get_folder_children, get_form_entries, get_super_folders, get_table_form_fields, h_double_quote

Class Relations

  • superclass: ::xowiki::PageInstance[i]
::xo::db::CrClass create ::xowiki::FormPage \
     -superclass ::xowiki::PageInstance

Methods

  • proc filter_expression

    ::963321 proc filter_expression {{-sql true} input_expr logical_op} {
        array set tcl_op {= eq < < > > >= >= <= <=}
        array set sql_op {= =  < < > > >= >= <= <=}
        array set op_map {contains,sql {$lhs_var like '%$rhs%'} contains,tcl {[lsearch $lhs_var {$rhs}] > -1}}
        #my msg unless=$unless
        #example for unless: wf_current_state = closed|accepted || x = 1
        set tcl_clause [list]
        set h_clause [list]
        set vars [list]
        set sql_clause [list]
        foreach clause [split [string map [list $logical_op \x00] $input_expr] \x00] {
          if {[regexp {^(.*[^<>])\s*([=<>]|<=|>=|contains)\s*([^=]?.*)$} $clause _ lhs op rhs_expr]} {
            set lhs [string trim $lhs]
            set rhs_expr [string trim $rhs_expr]
            if {[string range $lhs 0 0] eq "_"} {
              set lhs_var [string range $lhs 1 end]
    	  set rhs [split $rhs_expr |] 
              if {[info exists op_map($op,sql)]} {
                lappend sql_clause [subst -nocommands $op_map($op,sql)]
                if {[my exists $lhs_var]} {
                  set lhs_var "\[my set $lhs_var\]"
                  lappend tcl_clause [subst -nocommands $op_map($op,tcl)]
                } else {
                  my msg "ignoring unknown variable $lhs_var in expression"
                }
              } elseif {[llength $rhs]>1} {
                lappend sql_clause "$lhs_var in ('[join $rhs ',']')"
                # the following statement is only needed, when we rely on tcl-only
    	    lappend tcl_clause "\[lsearch -exact {$rhs} \[my property $lhs\]\] > -1"
              } else {
                lappend sql_clause "$lhs_var $sql_op($op) '$rhs'"
                # the following statement is only needed, when we rely on tcl-only
    	    lappend tcl_clause "\[my property $lhs\] $tcl_op($op) {$rhs}"
              }
            } else {
              set hleft [my h_double_quote $lhs]
              lappend vars $lhs ""
    	  if {$op eq "contains"} {
    	    #make approximate query
    	    set lhs_var instance_attributes
    	    set rhs $rhs_expr
    	    lappend sql_clause [subst -nocommands $op_map($op,sql)]
    	  }
              set lhs_var "\$__ia($lhs)"
              foreach rhs [split $rhs_expr |] {
    	    if {[info exists op_map($op,tcl)]} {
    	      lappend tcl_clause [subst -nocommands $op_map($op,tcl)]
    	    } else {
    	      lappend tcl_clause "$lhs_var $tcl_op($op) {$rhs}"
    	    }
                if {$op eq "="} {
                  # TODO: think about a solution for other operators with
                  # hstore maybe: extracting it by a query via hstore and
                  # compare in plain SQL
                  lappend h_clause "$hleft=>[my h_double_quote $rhs]"
                }
              }
            }
          } else {
            my msg "ignoring $clause"
          }
        }
        if {[llength $tcl_clause] == 0} {set tcl_clause [list true]}
        #my msg sql=$sql_clause,tcl=$tcl_clause
        return [list tcl [join $tcl_clause $logical_op] h [join $h_clause ,]  vars $vars sql $sql_clause]
        #my msg $expression
      }
    
  • proc get_all_children

    ::963321 proc get_all_children {-folder_id:required {-publish_status ready} {-object_types {::xowiki::Page ::xowiki::Form ::xowiki::FormPage}} {-extra_where_clause true}} {
    
        set folder [::xo::db::CrClass get_instance_from_db -item_id $folder_id -revision_id 0]
        set package_id [$folder package_id]
    
        set publish_status_clause [::xowiki::Includelet publish_status_clause $publish_status]
        set result [::xo::OrderedComposite new -destroy_on_cleanup]
        $result set folder_ids ""
    
        set list_of_folders [list $folder_id]
        set inherit_folders [FormPage get_super_folders $package_id $folder_id]
        my log inherit_folders=$inherit_folders
    
        foreach item_ref $inherit_folders {
          set folder [::xo::cc cache [list $package_id get_page_from_item_ref $item_ref]]
          if {$folder eq ""} {
    	my log "Error: Could not resolve parameter folder page '$item_ref' of FormPage [self]."
          } else {
    	lappend list_of_folders [$folder item_id]
          }
        }
    
        $result set folder_ids $list_of_folders
    
        foreach folder_id $list_of_folders {
          foreach object_type $object_types {
    	set attributes [list revision_id creation_user title parent_id page_order  "to_char(last_modified,'YYYY-MM-DD HH24:MI') as last_modified" ]
    	set base_table [$object_type set table_name]i
    	if {$object_type eq "::xowiki::FormPage"} {
    	  set attributes "* $attributes"
    	}
    	set items [$object_type get_instances_from_db  -folder_id $folder_id  -with_subtypes false  -select_attributes $attributes  -where_clause "$extra_where_clause $publish_status_clause"  -base_table $base_table]
    	
    	foreach i [$items children] {
    	  $result add $i
    	}
          }
        }
        return $result
      }
    
  • proc get_folder_children

    ::963321 proc get_folder_children {-folder_id:required {-publish_status ready} {-object_types {::xowiki::Page ::xowiki::Form ::xowiki::FormPage}} {-extra_where_clause true}} {
        set publish_status_clause [::xowiki::Includelet publish_status_clause $publish_status]
        set result [::xo::OrderedComposite new -destroy_on_cleanup]
    
        foreach object_type $object_types {
          set attributes [list revision_id creation_user title parent_id page_order  "to_char(last_modified,'YYYY-MM-DD HH24:MI') as last_modified" ]
          set base_table [$object_type set table_name]i
          if {$object_type eq "::xowiki::FormPage"} {
    	set attributes "* $attributes"
          }
          set items [$object_type get_instances_from_db  -folder_id $folder_id  -with_subtypes false  -select_attributes $attributes  -where_clause "$extra_where_clause $publish_status_clause"  -base_table $base_table]
    
          foreach i [$items children] {
    	$result add $i
          }
        }
        return $result
      }
    
  • proc get_form_entries

    ::963321 proc get_form_entries {-base_item_ids:required -package_id:required -form_fields:required {-publish_status ready} {-parent_id "*"} {-extra_where_clause ""} {-h_where {tcl true h "" vars "" sql ""}} {-always_queried_attributes ""} {-orderby ""} {-page_size 20} {-page_number ""} {-initialize true} {-from_package_ids ""}} {
        #
        # Get query attributes for all tables (to allow e.g. sorting by time)
        #
        # The basic essential fields item_id, name, object_type and
        # publish_status are always automatically fetched from the
        # instance_select_query. Add the query attributes, we want to
        # obtain as well automatically.
        #
        # "-parent_id *"  means to get instances, regardless of 
        # parent_id. Under the assumption, page_template constrains
        # the query enough to make it fast...
        #
        # "-from_package_ids {}" means get pages from the instance
        # provided via package_id, "*" means from all
        # packages. Forthermore, a list of package_ids can be given.
        #
        # "-always_queried_attributes *" means to obtain enough attributes
        # to allow a save operatons etc. on the instances.
        #
        
        set sql_atts [list ci.parent_id bt.revision_id bt.instance_attributes  bt.creation_date bt.creation_user bt.last_modified  "bt.object_package_id as package_id" bt.title  bt.page_template bt.state bt.assignee 
                         ]
        if {$always_queried_attributes eq "*"} {
          lappend sql_atts  bt.object_type bt.object_id  bt.description bt.publish_date bt.mime_type nls_language "bt.data as text"  bt.creator bt.page_order bt.page_id  bt.page_instance_id bt.xowiki_form_page_id
        } else {
          foreach att $always_queried_attributes {
            set name [string range $att 1 end]
            lappend sql_atts bt.$name
          }
        }
    
        #
        # Compute the list of field_names from the already covered sql
        # attributes
        #
        set covered_attributes [list _name _publish_status _item_id _object_type]
        foreach att $sql_atts {
          regexp {[.]([^ ]+)} $att _ name
          lappend covered_attributes _$name
        }
    
        #
        # Collect SQL attributes from form_fields
        #
        foreach f $form_fields {
          if {![$f exists __base_field]} continue
          set field_name [$f name]
          if {$field_name in $covered_attributes} {
            continue
          }
          if {$field_name eq "_text"} {
            lappend sql_atts "bt.data as text"
          } else {
            lappend sql_atts bt.[$f set __base_field]
          }
        }
        #my msg sql_atts=$sql_atts
    
        #
        # Build parts of WHERE clause 
        # 
        set publish_status_clause [::xowiki::Includelet publish_status_clause -base_table ci $publish_status]
    
        #
        # Build filter clause (uses hstore if configured)
        #
        set filter_clause ""
        array set wc $h_where
        set use_hstore [expr {[::xo::db::has_hstore] && 
                              [$package_id get_parameter use_hstore 0] 
                            }]
        if {$use_hstore && $wc(h) ne ""} {
          set filter_clause " and '$wc(h)' <@ bt.hkey"
        }
        #my msg "exists sql=[info exists wc(sql)]"
        if {$wc(sql) ne "" && $wc(h) ne ""} {
          foreach filter $wc(sql) {
            append filter_clause "and $filter"
          }
        }
        #my msg filter_clause=$filter_clause
    
        #
        # Build package clause
        #
        if {$from_package_ids eq ""} {
          set package_clause "and object_package_id = $package_id"
        } elseif {$from_package_ids eq "*"} {
          set package_clause ""
        } else {
          set package_clause "and object_package_id in ([join $from_package_ids ,])"
        }
    
        if {$parent_id eq "*"} {
          # instance_select_query expects "" for all parents, but for the semantics
          # of this method, "*" looks more appropriate
          set parent_id ""
        }
        #
        # transform all into an SQL query
        #
        set sql  [::xowiki::FormPage instance_select_query  -select_attributes $sql_atts  -from_clause ""  -where_clause " bt.page_template in ([join $base_item_ids ,])  $publish_status_clause $filter_clause $package_clause  $extra_where_clause"  -orderby $orderby  -with_subtypes false  -parent_id $parent_id  -page_size $page_size  -page_number $page_number  -base_table xowiki_form_pagei  ]
        #my ds $sql
    
        #
        # When we query all attributes, we return objects named after the
        # item_id (like for single fetches)
        #
        set named_objects [expr {$always_queried_attributes eq "*"}]
        set items [::xowiki::FormPage instantiate_objects -sql $sql  -named_objects $named_objects -object_named_after "item_id"  -object_class ::xowiki::FormPage -initialize $initialize]
    
        if {!$use_hstore && $wc(tcl) ne "true"} {
          # Make sure, that the expr method is available; 
          # in xotcl 2.0 this will not be needed
          ::xotcl::alias ::xowiki::FormPage expr -objscope ::expr
          
          set init_vars $wc(vars)
          foreach p [$items children] {
            array set __ia $init_vars
            array set __ia [$p instance_attributes]
            if {![$p expr $wc(tcl)]} {$items delete $p}
          }
        }
        return $items
      }
    
  • proc get_super_folders

    ::963321 proc get_super_folders {package_id folder_id {aggregated_folder_refs {}}} {
        #
        # Compute the set of folder_refs configured in the referenced
        # folders.  Get first the folder_refs configured in the actual
        # folder, which are not yet in aggregated_folder_refs.
        #
        set additional_folder_refs ""    
        set folder [::xo::db::CrClass get_instance_from_db -item_id $folder_id -revision_id 0]
        if {[$folder istype ::xowiki::FormPage]} {
          foreach ref [$folder property inherit_folders] {
    	if {$ref ni $aggregated_folder_refs} {lappend additional_folder_refs $ref}
          }
        }
        #
        # Process the computed additional folder refs recursively to obtain
        # the transitive set of configured item_refs (pointing to folders).
        #
        lappend aggregated_folder_refs {*}$additional_folder_refs
        foreach item_ref $additional_folder_refs {
          set page [$package_id get_page_from_item_ref $item_ref]
          if {$page eq ""} {error "configured inherited folder $item_ref cannot be resolved"}
          set aggregated_folder_refs  [FormPage get_super_folders $package_id [$page item_id] $aggregated_folder_refs]
        }
        return $aggregated_folder_refs
      }
    
  • proc get_table_form_fields

    ::963321 proc get_table_form_fields {-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}
        foreach att [list last_modified creation_user] {
          set __att($att) 1
        }
        
        # set cr_field_spec [::xowiki::PageInstance get_short_spec_from_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]
    
        foreach field_name $field_names {
          set short_spec [::xowiki::PageInstance get_short_spec_from_form_constraints  -name $field_name  -form_constraints $form_constraints]
    
          switch -glob -- $field_name {
            __* {error not_allowed}
            _* {
              set varname [string range $field_name 1 end]
              if {![info exists __att($varname)]} {
                error "unknown attribute $field_name"
              }
              set f [$base_item create_raw_form_field  -name $field_name  -slot [$base_item find_slot $varname]  -spec $cr_field_spec,$short_spec]
              $f set __base_field $varname
            }
            default {
              set f [$base_item create_raw_form_field  -name $field_name  -slot ""  -spec $field_spec,$short_spec]
            }
          }
          lappend form_fields $f
        }
        return $form_fields
      }
    
  • proc h_double_quote

    ::963321 proc h_double_quote value {
        if {[regexp {[ ,\"\\=>]} $value]} {
          set value \"[string map [list \" \\\\\" \\ \\\\ ' \\\\'] $value]\"
        }
        return $value
      }
    
  • instproc adp_subst

    ::963321 instproc adp_subst content {
        # Get the default field specs once and pass it to every field creation
        set field_spec [my get_short_spec @fields]
        set cr_field_spec [my get_short_spec @cr_fields]
        # Iterate over the variables for substitution
        set content [my regsub_eval -noquote true  [template::adp_variable_regexp] " $content"  {my get_value -field_spec $field_spec -cr_field_spec $cr_field_spec "\\\1" "\2"}]
        return [string range $content 1 end]
      }
    
  • instproc compute_link_properties

    ::963321 instproc compute_link_properties item_ref {
        my instvar package_id
        set page [$package_id get_page_from_item_ref  -default_lang [my lang]  -parent_id [my parent_id]  $item_ref]
        if {$page ne ""} {
          set item_id [$page item_id]
          set link_type [expr {[$page is_folder_page] ? "folder_link" : "link"}]
          set cross_package [expr {$package_id != [$page package_id]}]
        } else {
          set item_id 0
          set link_type "unresolved"
          set cross_package 0
        }
        #my msg [list item_ref $item_ref item_id $item_id link_type $link_type cross_package $cross_package]
        return [list item_ref $item_ref item_id $item_id link_type $link_type cross_package $cross_package]
      }
    
  • instproc condition=in_state

    ::963321 instproc condition=in_state {query_context value} {
        # possible values can be or-ed together (e.g. initial|final)
        foreach v [split $value |] {
          #my msg "check [my state] eq $v"
          if {[my state] eq $v} {return 1}
        }
        return 0
      }
    
  • instproc condition=is_true

    ::963321 instproc condition=is_true {query_context value} {
        # 
        # This condition maybe called from the policy rules. 
        # The passed value is a tuple of the form 
        #     {property-name operator property-value}
        #
        foreach {property_name op property_value} $value break
        if {![info exists property_value]} {return 0}
    
        #my log "$value => [my adp_subst $value]"
        array set wc [::xowiki::FormPage filter_expression [my adp_subst $value] &&]
        #my log "wc= [array get wc]"
        array set __ia $wc(vars)
        array set __ia [my instance_attributes]
        #my log "expr $wc(tcl) returns => [expr $wc(tcl)]"
        return [expr $wc(tcl)]
      }
    
  • instproc create_category_fields

    ::963321 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.
        if {$category_spec eq ""} {return [list]}
    
        # a value of "off" turns the off as well
        foreach f [split $category_spec ,] {
          if {$f eq "off"} {return [list]}
        }
        
        set category_fields [list]
        set container_object_id [my package_id]
        set category_trees [category_tree::get_mapped_trees $container_object_id]
        set category_ids [category::get_mapped_categories [my item_id]]
        #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
    
          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
            if {[lsearch $category_ids $category_id] > -1} {lappend value $category_id}
            set category_name [ad_quotehtml [lang::util::localize $category_name]]
            if { $level>1 } {
              set category_name "[string repeat {&nbsp;} [expr {2*$level-4}]]..$category_name"
            }
            lappend options [list $category_name $category_id]
          }
          set f [::xowiki::formfield::FormField new  -name "__category_${tree_name}_$tree_id"  -locale [my nls_language]  -label $tree_name  -type select  -value $value  -required $require_category_p]
          #my msg "category field [my name] created, value '$value'"
          $f destroy_on_cleanup
          $f options $options
          $f multiple [expr {!$assign_single_p}]
          lappend category_fields $f
        }
        return $category_fields
      }
    
  • instproc create_form_field

    ::963321 instproc create_form_field {{-cr_field_spec ""} {-field_spec ""} field_name} {
        if {$cr_field_spec eq ""} {set cr_field_spec [my get_short_spec @cr_fields]}
        if {$field_spec eq ""} {set field_spec [my get_short_spec @fields]}
        return [next -cr_field_spec $cr_field_spec -field_spec $field_spec $field_name]
      }
    
  • instproc create_form_fields

    ::963321 instproc create_form_fields field_names {
        set form_fields   [my create_category_fields]
        foreach att $field_names {
          if {[string match "__*" $att]} continue
          lappend form_fields [my create_form_field  -cr_field_spec [my get_short_spec @cr_fields]  -field_spec [my get_short_spec @fields] $att]
        }
        return $form_fields
      }
    
  • instproc demarshall

    ::963321 instproc demarshall {-parent_id -package_id -creation_user {-create_user_ids 0}} {
        # reverse map assingees
        my reverse_map_party_attribute -attribute assignee -create_user_ids $create_user_ids
        #
        # The function will compute the category_ids, which are were used
        # to categorize this objects in the source instance.
        set category_ids [list]
    
        #my msg "[my name] check cm=[info exists ::__xowiki_reverse_category_map] && iam=[my exists __instance_attribute_map]"
    
        if {[info exists ::__xowiki_reverse_category_map] 
            && [my exists __instance_attribute_map]
          } {
          #my msg "we have a instance_attribute_map"
    
          #
          # replace all symbolic category values by the mapped IDs
          #
          set ia [list]
          array set use [my set __instance_attribute_map]
          array set multiple_index [list category 2 party_id 1]
          foreach {name value} [my instance_attributes] {
            #my msg "use($name) --> [info exists use($name)]"
            if {[info exists use($name)]} {
    	  #my msg "try to map value '$value' (category tree: $use($name))"
              set map_type [lindex $use($name) 0]
              set multiple [lindex $use($name) $multiple_index($map_type)]
              if {$multiple eq ""} {set multiple 1}
              if {$multiple} {
                lappend ia $name [my reverse_map_values  -creation_user $creation_user -create_user_ids $create_user_ids  $map_type $value category_ids]
              } else {
                lappend ia $name [my reverse_map_value  -creation_user $creation_user -create_user_ids $create_user_ids  $map_type $value category_ids]
              }
            } else {
              # nothing to map
              lappend ia $name $value
            }
          }
          my set instance_attributes $ia
          #my msg  "[my name] saving instance_attributes $ia"
        }
        set r [next]
        my set __category_ids [lsort -unique $category_ids]
        return $r
      }
    
  • instproc edit

    ::963321 instproc edit {{-validation_errors ""} {-disable_input_fields 0} {-view true}} {
        my instvar page_template doc root package_id
        #my log "edit [self args]"
    
        ::xowiki::Form requireFormCSS
        my include_header_info -prefix form_edit
        if {[::xo::cc mobile]} {my include_header_info -prefix mobile}
    
        set form [my get_form]
        set anon_instances [my get_anon_instances]
        #my log form=$form
        #my log anon_instances=$anon_instances
        
        set field_names [my field_names -form $form]
        #my msg field_names=$field_names
        set form_fields [my create_form_fields $field_names]
    
        if {$form eq ""} {
          #
          # Since we have no form, we create it on the fly
          # from the template variables and the form field specifications.
          #
          set form "<form></form>"
          set formgiven 0
        } else {
          set formgiven 1
        }
        #my log formgiven=$formgiven
    
        # check name field: 
        #  - if it is for anon instances, hide it,
        #  - if it is required but hidden, show it anyway 
        #    (might happen, when e.g. set via @cr_fields ... hidden)
        set name_field [my lookup_form_field -name _name $form_fields]
        if {$anon_instances} {
          #$name_field config_from_spec hidden
        } else {
          if {[$name_field istype ::xowiki::formfield::hidden] && [$name_field required] == true} {
            $name_field config_from_spec text,required
            $name_field type text
          }
        }
    
        # include _text only, if explicitly needed (in form needed(_text)]"
    
        if {![my exists __field_needed(_text)]} {
          #my msg "setting text hidden"
          set f [my lookup_form_field -name _text $form_fields]
          $f config_from_spec hidden
        }
    
        if {[my exists_form_parameter __disabled_fields]} {
          # Disable some form-fields since these are disabled in the form
          # as well.
          foreach name [my form_parameter __disabled_fields] {
            set f [my lookup_form_field -name $name $form_fields]
            $f disabled disabled
          }
        }
    
        #my show_fields $form_fields
        #my log "__form_action [my form_parameter __form_action {}]"
        if {[my form_parameter __form_action ""] eq "save-form-data"} {
          #my msg "we have to validate"
          #
          # we have to valiate and save the form data
          #
          foreach {validation_errors category_ids} [my get_form_data $form_fields] break
    
          if {$validation_errors != 0} {
            #my msg "$validation_errors errors in $form_fields"
            #foreach f $form_fields { my log "$f: [$f name] '[$f set value]' err: [$f error_msg] " }
            #
            # In case we are triggered internally, we might not have a 
            # a connection, so we don't present the form with the 
            # error messages again, but we return simply the validation
            # problems.
            #
            if {[$package_id exists __batch_mode]} {
              set errors [list]
              foreach f $form_fields { 
                if {[$f error_msg] ne ""} {
                  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
    	  }
              error "[llength $errors] validation error(s): $errors $evaluation_errors"
            }
            # reset the name in error cases to the original one
            my set name [my form_parameter __object_name]
          } else {
            #
            # we have no validation errors, so we can save the content
            #
            my save_data  -use_given_publish_date [expr {[lsearch $field_names _publish_date] > -1}]  [::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
            # 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}}]"
    
    	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
              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
          # __feedback_mode to prevent recursive loops.
          set redirect_method [my form_parameter __form_redirect_method "view"]
          #my log "__redirect_method=$redirect_method"
          return [my view]
        } else {
    
          # 
          # 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 
            #}
          }
    
          array set __ia [my set instance_attributes]
          my load_values_into_form_fields $form_fields
          foreach f $form_fields {set ff([$f name]) $f }
    
          # For named entries, just set the entry fields to empty,
          # without changing the instance variables
    
          #my log "my is_new_entry [my name] = [my is_new_entry [my name]]"
          if {[my is_new_entry [my name]]} {
            if {$anon_instances} {
              set basename [::xowiki::autoname basename [$page_template name]]
              set name [::xowiki::autoname new -name $basename -parent_id [my parent_id]]
              #my log "generated name=$name, page_template-name=[$page_template name]"
              $ff(_name) value $name
            } else {
              $ff(_name) value [$ff(_name) default]
            }
            if {![$ff(_title) istype ::xowiki::formfield::hidden]} {
    	  $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]
                switch -- $var {
                  detail_link {
                    set f [my lookup_form_field -name $var $form_fields]
                    $f value [$f convert_to_external $value]
                  }
                  title - text - description {
                    set f [my lookup_form_field -name _$var $form_fields]
                  }
                }
                $f value [$f convert_to_external $value]
              }
            }
          }
    
          $ff(_name) set transmit_field_always 1
          $ff(_nls_language) set transmit_field_always 1
        }
    
    
        # some final sanity checks
        my form_fields_sanity_check $form_fields
        my post_process_form_fields $form_fields
    
        # 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}]
        # 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.
        
        set form [my substitute_markup $form]
        set form [string map [list @ \x003] $form]
        #my msg form=$form
    
        dom parse -simple -html $form doc
        $doc documentElement root
    
        if {$root eq ""} {
          error "form '$form' is not valid"
        }
    
        ::require_html_procs
        $root firstChild fcn
        #my msg "orig fcn $fcn, root $root [$root nodeType] [$root nodeName]"
    
        set formNode [lindex [$root selectNodes //form] 0]
        if {$formNode eq ""} {
          my msg "no form found in page [$page_template name]"
          set rootNode $root
          $rootNode firstChild fcn
        } else {
          set rootNode $formNode
          $rootNode firstChild fcn
          # 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
        #
        $rootNode insertBeforeFromScript {
          ::html::input -type hidden -name __object_name -value [my name]
          ::html::input -type hidden -name __form_action -value save-form-data
          ::html::input -type hidden -name __current_revision_id -value [my revision_id]
    
          # insert automatic form fields on top 
          foreach att $field_names {
            #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"
            $f render_item
          }
        } $fcn
        #
        # append some fields after the HTML contents of the form 
        #
        set button_class(wym) ""
        set button_class(xinha) ""
        set has_file 0
        $rootNode appendFromScript {
          # append category fields
          foreach f $form_fields {
            #my msg "[$f name]: is wym? [$f has_instance_variable editor wym]"
            if {[string match "__category_*" [$f name]]} {
              $f render_item
            } elseif {[$f has_instance_variable editor wym]} {
              set button_class(wym) "wymupdate"
    	} elseif {[$f has_instance_variable editor xinha]} {
              set button_class(xinha) "xinhaupdate"
    	}
            if {[$f has_instance_variable type file]} {
              set has_file 1
            }
          }
    
          # insert unreported errors 
          foreach f $form_fields {
            if {[$f set error_msg] ne "" && ![$f exists error_reported]} {
              $f render_error_msg
            }
          }
          # add a submit field(s) at bottom
          my render_form_action_buttons -CSSclass [string trim "$button_class(wym) $button_class(xinha)"]
        }
    
        if {$formNode ne ""} {
          if {[my exists_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
          if {$has_file} {$formNode setAttribute enctype multipart/form-data}
          Form add_dom_attribute_value $formNode class [$page_template css_class_name]
        }
    
        my set_form_data $form_fields
        if {$disable_input_fields} {
          # (a) disable explicit input fields
          foreach f $form_fields {$f disabled 1}
          # (b) disable input in HTML-specified fields
          set disabled [Form dom_disable_input_fields $rootNode]
          #
          # Collect these variables in a hiddden field to be able to
          # distinguish later between e.g. un unchecked checkmark and an
          # disabled field. Maybe, we have to add the fields from case (a)
          # as well.
          #
          $rootNode appendFromScript {
            ::html::input -type hidden -name "__disabled_fields" -value $disabled
          }
        }
        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  {my form_field_as_html -mode edit "\\\1" "\2" $form_fields}]
        # replace unbalanced @ characters
        set html [string map [list \x003 @] $html]
    
        #my log "calling VIEW with HTML [string length $html]"
        if {$view} {
          my view $html
        } else {
          return $html
        }
      }
    
  • instproc exists_property

    ::963321 instproc exists_property name {
        return [my exists [my property_key $name]]
      }
    
  • instproc field_names

    ::963321 instproc field_names {{-form ""}} {
        my instvar package_id
        foreach {form_vars needed_attributes} [my field_names_from_form -form $form] break
        #my msg "form=$form, form_vars=$form_vars needed_attributes=$needed_attributes"
        my array unset __field_in_form
        my array unset __field_needed
        if {$form_vars} {foreach v $needed_attributes {my set __field_in_form($v) 1}}
        foreach v $needed_attributes {my set __field_needed($v) 1}
        
        # 
        # Remove the fields already included in auto_fields form the needed_attributes.
        # The final list field_names determines the order of the fields in the form.
        #
        set auto_fields [list _name _page_order _title _creator _assignee _text _description _nls_language]
        set reduced_attributes $needed_attributes
        
        foreach f $auto_fields {
          set p [lsearch $reduced_attributes $f]
          if {$p > -1} {
    	#if {$form_vars} {
    	  #set auto_field_in_form($f) 1
    	#}
            set reduced_attributes [lreplace $reduced_attributes $p $p]
          } 
        }
        #my msg reduced_attributes(after)=$reduced_attributes 
        #my msg fields_from_form=[my array names __field_in_form]
    
        set field_names [list _name]
        if {[$package_id show_page_order]}  { lappend field_names _page_order }
        lappend field_names _title _creator _assignee
        foreach fn $reduced_attributes                     { lappend field_names $fn }
        foreach fn [list _text _description _nls_language] { lappend field_names $fn }
        #my msg final-field_names=$field_names
        return $field_names
      }
    
  • instproc field_names_from_form

    ::963321 instproc field_names_from_form {{-form ""}} {
        #
        # this method returns the form attributes (including _*)
        #
        my instvar page_template
        set allvars [concat [[my info class] array names db_slot]  [::xo::db::CrClass set common_query_atts]]
    
        set template [my get_html_from_content [my get_from_template text]]
        #my msg template=$template
    
        #set field_names [list _name _title _description _creator _nls_language _page_order]
        set field_names [list]
        if {$form eq ""} {set form [my get_form]}
        if {$form eq ""} {
          foreach {var _} [my template_vars $template] {
            #if {[string match _* $var]} continue
    	if {$var ni $allvars && $var ni $field_names} {
    	  lappend field_names $var
    	}
          }
          set from_HTML_form 0
        } else {
          foreach {match 1 att} [regexp -all -inline [template::adp_variable_regexp] $form] {
            #if {[string match _* $att]} continue
            lappend field_names $att
          }
          dom parse -simple -html $form doc
          $doc documentElement root
          set fields [$root selectNodes "//*\[@name != ''\]"]
          foreach field $fields {
            set node_name [$field nodeName]
    	if {$node_name ne "input" 
                && $node_name ne "textarea" 
                && $node_name ne "select" 
              } continue
    	set att [$field getAttribute name]
            #if {[string match _* $att]} continue
    	if {$att ni $field_names} { lappend field_names $att }
          }
          set from_HTML_form 1
        }
        return [list $from_HTML_form $field_names]
      }
    
  • instproc footer

    ::963321 instproc footer {} {
        if {[my exists __no_form_page_footer]} {
          next
        } else {
          set is_form [my property is_form__ 0]
          if {[my is_form]} {
            return [my include [list form-menu -form_item_id [my item_id]  -buttons [list new answers [list form [my page_template]]]]]
          } else {
            return [my include [list form-menu -form_item_id [my page_template] -buttons form]]
          }
        }
      }
    
  • instproc form_field_as_html

    ::963321 instproc form_field_as_html {{-mode edit} before name form_fields} {
        set found 0
        foreach f $form_fields {
          if {[$f name] eq $name} {set found 1; break}
        } 
        if {!$found} {
          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]"
        if {$mode eq "edit" || [$f display_field]} {
          set html [$f asHTML]
        } else {
          set html @$name@
        }
        #my msg "$name $html"
        return ${before}$html
      }
    
  • instproc form_fields_sanity_check

    ::963321 instproc form_fields_sanity_check form_fields {
        foreach f $form_fields {
          if {[$f exists disabled]} {
            # don't mark disabled fields as required
            if {[$f required]} {
              $f required false
            }
            #don't show the help-text, if you cannot input
            if {[$f help_text] ne ""} {
              $f help_text ""
            }
          }
          if {[$f exists transmit_field_always] 
              && [lsearch [$f info mixin] ::xowiki::formfield::omit] > -1} {
            # Never omit these fields, this would cause problems with
            # autonames and empty languages. Set these fields to hidden
            # instead.
            $f remove_omit
            $f class ::xowiki::formfield::hidden
            $f initialize
            #my msg "$f [$f name] [$f info class] [$f info mixin]"
          }
        }
      }
    
  • instproc get_anon_instances

    ::963321 instproc get_anon_instances {} {
        # maybe overloaded from WorkFlow
        my get_from_template anon_instances f
      }
    
  • instproc get_form_constraints

    ::963321 instproc get_form_constraints {{-trylocal false}} {
        # We define it as a method to ease overloading.
        #my msg "is_form=[my is_form]"
        if {$trylocal && [my is_form]} {
          return [my property form_constraints]
        } else {
          #my msg "get_form_constraints returns '[my get_from_template form_constraints]'"
          return [my get_from_template form_constraints]
        }
      }
    
  • instproc get_form_value

    ::963321 instproc get_form_value att {
        #
        # Return the value contained in an HTML input field of the FORM
        # provided via the instance variable root.
        #
        my instvar root item_id
        set fields [$root selectNodes "//form//*\[@name='$att'\]"] 
        if {$fields eq ""} {return ""}
        foreach field $fields {
          #
          # Handling first TEXTARA 
          #
          if {[$field nodeName] eq "textarea"} {
    	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 {
              #my log "can't handle $type so far $att=$value"
            }
          }
        }
        return ""
      }
    
  • instproc get_parameter

    ::963321 instproc get_parameter {attribute {default {}}} {
          # TODO: check whether the following comment applies here
          # Try to get the parameter from the parameter_page.  We have to
          # be very cautious here to avoid recursive calls (e.g. when
          # resolve_page_name needs as well parameters such as
          # use_connection_locale or subst_blank_in_name, etc.).
          #
          set value ""
          set pp [my property ParameterPages]
          if {$pp ne {}} {
    	  if {![regexp {/?..:} $pp]} {
    	      my log "Error: Name of parameter page '$pp' of FormPage [self] must contain a language prefix"
    	  } else {
    	      set page [::xo::cc cache [list [my package_id] get_page_from_item_ref $pp]]
    	      if {$page eq ""} {
    		  my log "Error: Could not resolve parameter page '$pp' of FormPage [self]."
    	      }
    	      
    	      if {$page ne "" && [$page exists instance_attributes]} {
    		  array set __ia [$page set instance_attributes]
    		  if {[info exists __ia($attribute)]} {
    		      set value $__ia($attribute)
    		  }
    	      }
    	  }
          }
    
          
          if {$value eq {}} {set value [next $attribute $default]}
          return $value
      }
    
  • instproc get_property

    ::963321 instproc get_property {-source -name:required {-default ""}} {
        if {![info exists source]} {
          set page [self]
        } else {
          set page [my resolve_included_page_name $source]
        }
        return [$page property $name $default]
      }
    
  • instproc get_value

    ::963321 instproc get_value {{-field_spec ""} {-cr_field_spec ""} before varname} {
        #
        # Read a property (instance attribute) and return
        # its pretty value in variable substitution.
        #
        # We check for special variable names here (such as current_user
        # or current_url). We provide a value from the current connection
        # context.
        if {$varname eq "current_user"} {
          set value [::xo::cc set untrusted_user_id]
        } elseif {$varname eq "current_url"} {
          set value [::xo::cc url]
        } else {
          #
          # First check to find an existing form-field with that name
          #
          set f [::xowiki::formfield::FormField get_from_name [self] $varname]
          if {$f ne ""} {
    	#
    	# the form field exists already, we just fill in the actual
    	# value (needed e.g. in weblogs, when the same form field is
    	# used for multiple page instances in a single request)
    	#
    	set value [$f value [my property $varname]]
          } else {
    	#
    	# create a form-field from scratch
    	#
    	set value [my property $varname]
    	set f [my create_form_field -cr_field_spec $cr_field_spec -field_spec $field_spec $varname]
    	$f value $value
          }
    
          if {[$f hide_value]} {
            set value ""
          } elseif {![$f exists show_raw_value]} {
            set value [$f pretty_value $value]
          }
        }
        return $before$value
      }
    
  • instproc group_assign

    ::963321 instproc group_assign {-group_id:integer,required -members:required {-rel_type membership_rel} {-member_state ""}} {
        set old_members [group::get_members -group_id $group_id]
        foreach m $members {
          if {$m ni $old_members} {
            #my msg "we have to add $m"
            group::add_member -group_id $group_id -user_id $m  -rel_type $rel_type -member_state $member_state
          }
        }
        foreach m $old_members {
          if {$m ni $members} {
            #my msg "we have to remove $m"
            group::remove_member -group_id $group_id -user_id $m
          }
        }
      }
    
  • instproc group_require

    ::963321 instproc group_require {} {
        #
        # Create a group if necessary associated to the current form
        # page. Since the group_names are global, the group name contains
        # the parent_id of the FormPage.
        #
        set group_name "fpg-[my parent_id]-[my name]"
        set group_id [group::get_id -group_name $group_name]
        if {$group_id eq ""} {
          # group::new does not flush the chash - sigh!  Therefore we have
          # to flush the old cache entry here manually.
          ns_cache flush util_memoize  "group::get_id_not_cached -group_name $group_name -subsite_id {} -application_group_id {}"
          set group_id [group::new -group_name $group_name]
        }
        return $group_id
      }
    
  • instproc include_header_info

    ::963321 instproc include_header_info {{-prefix ""} {-js ""} {-css ""}} {
        if {$css eq ""} {set css [my get_from_template ${prefix}_css]}
        if {$js eq ""}  {set js [my get_from_template ${prefix}_js]}
        foreach line [split $js \n] {::xo::Page requireJS [string trim $line]}
        foreach line [split $css \n] {
          set line [string trim $line]
          set order 1
          if {[llength $line]>1} {
    	set e1 [lindex $line 0]
    	if {[string is integer -strict $e1]} {
    	  set order $e1
    	  set line [lindex $line 1]
    	}
          }
          ::xo::Page requireCSS -order $order $line
        }
      }
    
  • instproc initialize

    ::963321 instproc initialize {} {
        # can be overloaded
      }
    
  • instproc initialize_loaded_object

    ::963321 instproc initialize_loaded_object {} {
        #my msg "[my name] [my info class]"
        if {[my exists page_template]} {
          set p [::xo::db::CrClass get_instance_from_db -item_id [my page_template]]
          # The Form might come from a different package type (e.g. a workflow)
          # make sure, the source package is available
          ::xo::Package require [$p package_id]
        }
        my array set __ia [my instance_attributes]
        next
      }
    
  • instproc is_folder_page

    ::963321 instproc is_folder_page {{-include_folder_links true}} {
        set page_template_name [[my page_template] name]
        if {$page_template_name eq "en:folder.form"} {return 1}
        if {$include_folder_links && $page_template_name eq "en:link.form"} {
          set link_type [my get_property_from_link_page link_type]
          return [expr {$link_type eq "folder_link"}]
        }
        return 0
      }
    
  • instproc is_form

    ::963321 instproc is_form {} {
        return [my exists_property form_constraints]
      }
    
  • instproc is_link_page

    ::963321 instproc is_link_page {} {
        return [expr {[[my page_template] name] eq "en:link.form"}]
      }
    
  • instproc load_values_into_form_fields

    ::963321 instproc load_values_into_form_fields form_fields {
        array set __ia [my set instance_attributes]
        foreach f $form_fields {
          set att [$f name]
          switch -glob $att {
            __* {}
            _* {
              set varname [string range $att 1 end]
              $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)]
              }
            }
          }
        }
      }
    
  • instproc map_value

    ::963321 instproc map_value {map_type value} {
        my log "map_value $map_type, $value"
        if {$map_type eq "category" && $value ne ""} {
          #
          # map a category item
          #
          array set cm [my set __category_map]
          return $cm($value)
        } elseif {$map_type eq "party_id" && $value ne ""} {
          #
          # map a party_id
          #
          return [my map_party -property $map_type $value]
        } else {
          return $value
        }
      }
    
  • instproc map_values

    ::963321 instproc map_values {map_type values} {
        # Map a list of values (for multi-valued form fields) 
        # my log "map_values $map_type, $values"
        set mapped_values [list]
        foreach value $values {lappend mapped_values [my map_value $map_type $value]}
        return $mapped_values
      }
    
  • instproc marshall

    ::963321 instproc marshall {} {
        #
        # Handle mapping from IDs to symbolic representations in
        # form-field values. We perform the mapping on xowiki::FormPages
        # and not on xowiki::Forms, since a single xowiki::FormPages might
        # use different xowiki::Forms in its life-cycle.
        #
        # Note, that only types of form-fields implied by the derived form
        # constraints are recognized. E.g. in workflows, it might be
        # necessary to move e.g. category definitions into the global form
        # constraints.
        #
        set form_fields [my create_form_fields_from_form_constraints  [my get_form_constraints]]
        my build_instance_attribute_map $form_fields
        
        # In case we have a mapping from IDs to external values, use it
        # and rewrite instance attributes. Note, that the marshalled
        # objects have to be flushed from memory later since the
        # representation of instances_attributes is changed by this
        # method.
        #
        if {[my exists __instance_attribute_map]} {
          # my log "+++ we have an instance_attribute_map for [my name]"
          # my log "+++ starting with instance_attributes [my instance_attributes]"
          array set use [my set __instance_attribute_map]
          array set multiple_index [list category 2 party_id 1]
          set ia [list]
          foreach {name value} [my instance_attributes] {
            #my log "marshall check $name $value [info exists use($name)]"
            if {[info exists use($name)]} {
              set map_type [lindex $use($name) 0]
              set multiple [lindex $use($name) $multiple_index($map_type)]
              #my log "+++ marshall check $name $value m=?$multiple"
    
              if {$multiple} {
                lappend ia $name [my map_values $map_type $value]
              } else {
                lappend ia $name [my map_value $map_type $value]
              }
            } else {
              # nothing to map
              lappend ia $name $value
            }
          }
          my set instance_attributes $ia
          #my log "+++ setting instance_attributes $ia"
        }
        set old_assignee [my assignee]
        my set assignee  [my map_party -property assignee $old_assignee]
        set r [next]
        my set assignee  $old_assignee
        return $r
      }
    
  • instproc new_link

    ::963321 instproc new_link {-name -title -nls_language -parent_id -return_url page_package_id} {
        set template_id [my page_template]
        if {![info exists parent_id]} {set parent_id [$page_package_id folder_id]}
        set form [$page_package_id pretty_link -parent_id $parent_id [$template_id name]]
        return [$page_package_id make_link -with_entities 0 -link $form $template_id  create-new return_url name title nls_language]
      }
    
  • instproc post_process_dom_tree

    ::963321 instproc post_process_dom_tree {dom_doc dom_root form_fields} {
        # Part of the input fields comes from HTML, part comes via $form_fields
        # We offer here the possibility to iterate over the dom tree before it
        # is presented; can be overloaded
      }
    
  • instproc post_process_form_fields

    ::963321 instproc post_process_form_fields form_fields {
        # We offer here the possibility to iterate over the form fields before it
        # before they are rendered
      }
    
  • instproc pretty_name

    ::963321 instproc pretty_name {} {
        set anon_instances [my get_from_template anon_instances f]
        if {$anon_instances} {
          return [my title]
        }
        return [my name]
      }
    
  • instproc property

    ::963321 instproc property {name {default {}}} {
        set key  [my property_key $name]
        #my msg "$key [my exists $key] //[my array names __ia]//"
        if {[my exists $key]} {
          return [my set $key]
        }
        return $default
      }
    
  • instproc property_key

    ::963321 instproc property_key name {
        if {[regexp {^_([^_].*)$} $name _ varname]} {
          return $varname
        } {
          return __ia($name)
        }
      }
    
  • instproc render_content

    ::963321 instproc render_content {} {
        my instvar doc root package_id page_template
        my include_header_info -prefix form_view
        if {[::xo::cc mobile]} {my include_header_info -prefix mobile}
    
        set text [my get_from_template text]
        if {$text ne ""} {
          catch {set text [lindex $text 0]}
        }
        if {$text ne ""} {
          #my msg "we have a template text='$text'"
          # we have a template
          return [next]
        } else {
          #my msg "we have a form '[my get_form]'"
          set form [my get_form]
          if {$form eq ""} {return ""}
    
          ::xowiki::Form requireFormCSS
    
          foreach {form_vars field_names} [my field_names_from_form -form $form] break
          my array unset __field_in_form
          if {$form_vars} {foreach v $field_names {my set __field_in_form($v) 1}}
          set form_fields [my create_form_fields $field_names]
          my load_values_into_form_fields $form_fields
            
          # deactivate form-fields and do some final sanity checks
          foreach f $form_fields {$f set_disabled 1}
          my form_fields_sanity_check $form_fields
    
          set form [my regsub_eval   [template::adp_variable_regexp] $form  {my form_field_as_html -mode display "\\\1" "\2" $form_fields}]
          
          # we parse the form just for the margin-form.... maybe regsub?
          dom parse -simple -html $form doc
          $doc documentElement root
          set form_node [lindex [$root selectNodes //form] 0]
    
          Form add_dom_attribute_value $form_node class [$page_template css_class_name]
          # The following two commands are for non-generated form contents
          my set_form_data $form_fields
          Form dom_disable_input_fields $root 
          # Return finally the result
          return [$root asHTML]
        }
      }
    
  • instproc render_form_action_buttons

    ::963321 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]
          $f render_input
        }
      }
    
  • instproc render_icon

    ::963321 instproc render_icon {} {
        set page_template [my page_template]
        if {[$page_template istype ::xowiki::FormPage]} {
          return [list text [$page_template property icon_markup] is_richtext true]
        } 
        switch [$page_template name] {
          en:folder.form {
    	return [list text "<img src='/resources/file-storage/folder.gif' width='12'>" is_richtext true]
          }
          en:link.form {
    	set link_type [my get_property_from_link_page link_type "unresolved"]
    	set link_icon "http://www.ejoe.at/typo3/sysext/rtehtmlarea/res/accessibilityicons/img/internal_link.gif"
    	if {$link_type eq "unresolved"} {
    	  return [list text "<img src='$link_icon' width='12'>  <img src='http://www.deeptrawl.com/images/icons/brokenLinks.png' width='15'>" is_richtext true]
    	} 
    	if {$link_type eq "folder_link"} {
    	  return [list text "<img src='$link_icon' width='12'>  <img src='/resources/file-storage/folder.gif' width='12'>" is_richtext true]
    	}
    	return [list text "<img src='$link_icon' width='12'>" is_richtext true]
          }
          default {
    	return [list text [$page_template title] is_richtext false]
          }
        }
      }
    
  • instproc reverse_map_value

    ::963321 instproc reverse_map_value {-creation_user -create_user_ids map_type value category_ids_name} {
        # Perform the inverse function of map_value. During export, internal
        # representations are exchanged by string representations, which are
        # mapped here again to internal representations
        my upvar $category_ids_name category_ids
        if {[info exists ::__xowiki_reverse_category_map($value)]} {
          #my msg "map value '$value' (category tree: $use($name)) of [my name] to an ID"
          lappend category_ids $::__xowiki_reverse_category_map($value)
          return $::__xowiki_reverse_category_map($value)
        } elseif {$map_type eq "party_id"} {
          return [my reverse_map_party  -entry $value  -default_party $creation_user  -create_user_ids $create_user_ids]
        } elseif {$value eq ""} {
          return ""
        } else {
          my msg "cannot map value '$value' (map_type $map_type) of [my name] to an ID; maybe there is some same_named category tree with less entries..."
          my msg "reverse category map has values [lsort [array names ::__xowiki_reverse_category_map]]"
          return ""
        }
      }
    
  • instproc reverse_map_values

    ::963321 instproc reverse_map_values {-creation_user -create_user_ids map_type values category_ids_name} {
        # Apply reverse_map_value to a list of values (for multi-valued
        # form fields)
        my upvar $category_ids_name category_ids
        set mapped_values [list]
        foreach value $values {
          lappend mapped_values [my reverse_map_value  -creation_user $creation_user -create_user_ids $create_user_ids  $map_type $value category_ids]
        }
        return $mapped_values
      }
    
  • instproc set_form_data (public)

    <instance of ::xowiki::FormPage[i]> set_form_data form_fields
    Store the instance attributes or default values in the form.

    Parameters:
    form_fields
    ::963321 instproc set_form_data form_fields {
        ::require_html_procs
    
        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)]
          } else {
            # do we have a value in the form? If yes, keep it.
            set form_value [my get_form_value $att]
            #my msg "no instance attribute, set form_value $att '[$f value]' form_value=$form_value"
            if {$att eq ""} {
              # we have no instance attributes, use the default value from the form field
              my set_form_value $att [$f convert_to_external [$f value]]
            }
          }
        }
      }
    
  • instproc set_form_value

    ::963321 instproc set_form_value {att value} {
        #my msg "set_form_value '$att' to '$value'"
        #
        # Feed the provided value into an HTML form provided via the
        # instance variable root.
        #
        my instvar root item_id
        set fields [$root selectNodes "//form//*\[@name='$att'\]"]
        #my msg "found field = $fields xp=//*\[@name='$att'\]"
    
        foreach field $fields {
          #
          # 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}
          }
          if {[$field nodeName] ne "input"} continue
          #
          # We handle now only INPUT types, but we have to differntiate
          # between different kinds of inputs.
          #
          set type [expr {[$field hasAttribute type] ? [$field getAttribute type] : "text"}]
          # the switch should be really different objects ad classes...., but thats HTML, anyhow.
          switch $type {
            checkbox {
              #my msg "$att: CHECKBOX value='$value', [$field hasAttribute checked], [$field hasAttribute value]"
              if {[$field hasAttribute value]} {
                set form_value [$field getAttribute value]
                #my msg "$att: form_value=$form_value, my value=$value"
                if {[lsearch -exact $value $form_value] > -1} {
                  $field setAttribute checked true
                } elseif {[$field hasAttribute checked]} {
                  $field removeAttribute checked
                }
              } else {
                #my msg "$att: CHECKBOX entry has no value"
                if {[catch {set f [expr {$value ? 1 : 0}]}]} {set f 1}
                if {$value eq "" || $f == 0} {
                  if {[$field hasAttribute checked]} {
                    $field removeAttribute checked
                  }
                } else {
                  $field setAttribute checked true
                }
              }
            }
            radio {
              set inputvalue [$field getAttribute value]
              #my msg "radio: compare input '$inputvalue' with '$value'"
              if {$inputvalue eq $value} {
                $field setAttribute checked true
              }
            }
            hidden -
            password -
            text {
    	  if { ![$field getAttribute rep "0"] } {
    	    $field setAttribute value $value
    	  }
    	}
            default {my log "can't handle $type so far $att=$value"}
          }
        }
      }
    
  • instproc set_property

    ::963321 instproc set_property {{-new 0} name value} {
        if {[string match "_*" $name]} {
          set key [string range $name 1 end]
          set instance_attributes_refresh 0
        } {
          set key  __ia($name)
          set instance_attributes_refresh 1
        }
        if {!$new && ![my exists $key]} {
          error "property '$name' ($key) does not exist.  you might use flag '-new 1' for set_property to create new properties\n[lsort [my info vars]]"
        }
        my set $key $value
        #my msg "[self] set $key $value"
        if {$instance_attributes_refresh} {
          my instance_attributes [my array get __ia]
        }
        return $value
      }
    
  • instproc set_publish_status

    ::963321 instproc set_publish_status value {
        if {$value ni {production ready}} {
          error "invalid value '$value'; use 'production' or 'ready'"
        }
        my set publish_status $value
      }
    

Methods: Source: Variables:
[All Methods | Documented Methods | Hide Methods] [Display Source | Hide Source] [Show Variables | Hide Variables]