+ append footer $html
} set categories_includelet [my set __last_includelet] } @@ -1978,31 +2060,32 @@ foreach tag {h1 h2 h3 h4 h5 b strong} { foreach {match words} [regexp -all -inline "<$tag>(\[^<\]+)$tag>" $html] { - foreach w [split $words] { - if {$w eq ""} continue - set word($w) 1 - } + foreach w [split $words] { + if {$w eq ""} continue + set word($w) 1 + } } } foreach tag [::xowiki::Page get_tags -package_id [my package_id] -item_id [my item_id]] { set word($tag) 1 } - #my log [list html $html keywords [array names work]] - return [list html $html keywords [array names work]] + #my log [list html $html keywords [array names word]] + return [list mime text/html html $html keywords [array names word] text ""] } Page instproc record_last_visited {-user_id} { my instvar item_id package_id if {![info exists user_id]} {set user_id [::xo::cc set untrusted_user_id]} if {$user_id > 0} { # only record information for authenticated users - db_dml [my qn update_last_visisted] \ - "update xowiki_last_visited set time = current_timestamp, count = count + 1 \ - where page_id = :item_id and user_id = :user_id" - if {[db_resultrows] < 1} { - db_dml [my qn insert_last_visisted] \ + set rows [xo::dc dml update_last_visisted { + update xowiki_last_visited set time = now(), count = count + 1 + where page_id = :item_id and user_id = :user_id + }] + if {$rows ne "" && $rows < 1} { + ::xo::dc dml insert_last_visisted \ "insert into xowiki_last_visited (page_id, package_id, user_id, count, time) \ - values (:item_id, :package_id, :user_id, 1, current_timestamp)" + values (:item_id, :package_id, :user_id, 1, now())" } } } @@ -2015,8 +2098,8 @@ # OpenACS templating widget or directly. If the list is not # well-formed, it must be contained directly. if {![catch {set l [llength $content]}] - && $l == 2 - && [string match "text/*" [lindex $content 1]]} { + && $l == 2 + && [string match "text/*" [lindex $content 1]]} { return [lindex $content 0] } return $content @@ -2054,16 +2137,16 @@ foreach name_and_spec [my get_form_constraints] { regexp {^([^:]+):(.*)$} $name_and_spec _ spec_name short_spec if {[string match $spec_name $name]} { - set f [my create_form_fields_from_form_constraints [list $name:$short_spec]] - set $key $f - return $f + set f [my create_form_fields_from_form_constraints [list $name:$short_spec]] + set $key $f + return $f } } if {$name ni {fontname fontsize formatblock}} { set names [list] foreach f $form_fields {lappend names [$f name]} my msg "No form field with name '$name' found\ - (available fields: [lsort [array names ::_form_field_names]])" + (available fields: [lsort [array names ::_form_field_names]])" } set f [my create_form_fields_from_form_constraints [list $name:text]] set $key $f @@ -2094,10 +2177,6 @@ Page instproc translate {-from -to text} { set langpair $from|$to set ie UTF8 - #set r [xo::HttpRequest new -url http://translate.google.com/translate_t \ - -post_data [export_vars {langpair text ie}] \ - -content_type application/x-www-form-urlencoded] - #my msg url=http://translate.google.com/#$from/$to/$text set r [xo::HttpRequest new -url http://translate.google.com/#$from/$to/$text] #my msg status=[$r set status] if {[$r set status] eq "finished"} { @@ -2155,7 +2234,7 @@ } # Make sure to load the instance attributes - $f array set __ia [$f instance_attributes] + #$f array set __ia [$f instance_attributes] # Call the application specific initialization, when a FormPage is # initially created. This is used to control the life-cycle of @@ -2261,15 +2340,33 @@ if {![my exists full_file_name]} { if {[my exists item_id]} { my instvar text mime_type package_id item_id revision_id - set storage_area_key [::xo::db_string get_storage_key \ - "select storage_area_key from cr_items where item_id=$item_id"] + set storage_area_key [::xo::dc get_value get_storage_key \ + "select storage_area_key from cr_items where item_id=:item_id"] my set full_file_name [cr_fs_path $storage_area_key]/$text #my log "--F setting FILE=[my set full_file_name]" } } return [my set full_file_name] } + File instproc search_render {} { + # array set "" {mime text/html text "" html "" keywords ""} + set mime [my set mime_type] + if {$mime eq "text/plain"} { + set result [next] + } else { + if {[info commands "::search::convert::binary_to_text"] ne ""} { + set txt [search::convert::binary_to_text -filename [my full_file_name] -mime_type $mime] + set result [list text $txt mime text/plain] + } else { + set result [list text "" mime text/plain] + } + } + + #ns_log notice "search_render returns $result" + return $result + } + File instproc html_content {{-add_sections_to_folder_tree 0} -owner} { set parent_id [my parent_id] set fileName [my full_file_name] @@ -2299,43 +2396,43 @@ foreach n [$root selectNodes //img] { set src [$n getAttribute src] if {[regexp {^[^/]} $src]} { - $n setAttribute src $prefix/$src - #my msg "setting src to $prefix/$src" + $n setAttribute src $prefix/$src + #my msg "setting src to $prefix/$src" } } # # In case, the switch is activated, and we have a menubar, add the # top level section # - if {$add_sections_to_folder_tree && [info command ::__xowiki__MenuBar] ne ""} { + if {$add_sections_to_folder_tree && [info commands ::__xowiki__MenuBar] ne ""} { $owner set book_mode 1 set pages [::xo::OrderedComposite new -destroy_on_cleanup] if {$add_sections_to_folder_tree == 1} { - set selector //h2 + set selector //h2 } else { - set selector {//h2 | //h3} + set selector {//h2 | //h3} } set order 0 foreach n [$root selectNodes $selector] { - if {[$n hasAttribute id]} { - set name [$n getAttribute id] - } else { - set name "section $n" - } - set o [::xotcl::Object new] - $o set page_order [incr $order] - $o set title [$n asText] - - set e [$doc createElement a] - $e setAttribute name $name - [$n parentNode] insertBefore $e $n + if {[$n hasAttribute id]} { + set name [$n getAttribute id] + } else { + set name "section $n" + } + set o [::xotcl::Object new] + $o set page_order [incr $order] + $o set title [$n asText] + + set e [$doc createElement a] + $e setAttribute name $name + [$n parentNode] insertBefore $e $n - $o set name $name - $pages add $o + $o set name $name + $pages add $o } - + #$o instvar page_order title name ::__xowiki__MenuBar additional_sub_menu -kind folder -pages $pages -owner $owner @@ -2349,7 +2446,7 @@ return $content } - + File instproc render_content {} { my instvar name mime_type description parent_id package_id item_id creation_user # don't require permissions here, such that rss can present the link @@ -2387,16 +2484,16 @@ switch -glob $mime_type { image/* { - set l [Link new -volatile \ - -page [self] -query $query \ - -type image -name $name -lang "" \ - -stripped_name $stripped_name -label $label \ - -parent_id $parent_id -item_id $item_id -package_id $package_id] - set preview "
[::xowiki::Includelet html_encode $text]" + set text [::xowiki::read_file [my full_file_name]] + set preview "
[::xowiki::Includelet html_encode $text]" } default {set preview ""} } @@ -2432,31 +2529,31 @@ {-publish_status ready} } { return [::xowiki::PageTemplate count_usages -package_id $package_id -parent_id $parent_id \ - -item_id [my item_id] -publish_status $publish_status] + -item_id [my item_id] -publish_status $publish_status] } PageTemplate proc count_usages { - {-package_id:integer 0} - {-parent_id:integer 0} - -item_id:required - {-publish_status ready} - } { + {-package_id:integer 0} + {-parent_id:integer 0} + -item_id:required + {-publish_status ready} + } { set publish_status_clause [::xowiki::Includelet publish_status_clause -base_table i $publish_status] if {$package_id} { set bt "xowiki_page_instancei" - set package_clause "and object_package_id = $package_id" + set package_clause "and object_package_id = :package_id" } else { set bt "xowiki_page_instance" set package_clause "" } if {$parent_id} { - set parent_id_clause "and parent_id = $parent_id" + set parent_id_clause "and parent_id = :parent_id" } else { set parent_id_clause "" } - set count [::xo::db_string [my qn count_usages] \ - "select count(page_instance_id) from $bt, cr_items i \ - where page_template = $item_id \ + set count [::xo::dc get_value count_usages \ + "select count(page_instance_id) from $bt, cr_items i \ + where page_template = $item_id \ $publish_status_clause $package_clause $parent_id_clause \ and page_instance_id = coalesce(i.live_revision,i.latest_revision)"] return $count @@ -2468,7 +2565,11 @@ # We need this acually only for PageTemplate and FormPage, but # aliases will require XOTcl 2.0.... so we define it for the time # being on ::xowiki::Page - set name [expr {$margin_form ? "margin-form " : ""}] + if {[parameter::get_global_value -package_key xowiki -parameter PreferredCSSToolkit -default yui] ne "bootstrap"} { + set name [expr {$margin_form ? "margin-form " : ""}] + } else { + set name "" + } set CSSname [my name] # Remove language prefix, if used. @@ -2526,7 +2627,7 @@ #my msg "fc of [self] [my name] = $form_constraints" if {$form_constraints ne ""} { set s [::xowiki::PageInstance get_short_spec_from_form_constraints \ - -name $name -form_constraints $form_constraints] + -name $name -form_constraints $form_constraints] #my msg "get_short_spec $name c=$form_constraints => '$s'" return $s } @@ -2549,7 +2650,7 @@ # for a field with a specified name in a specified page template my instvar package_id foreach {s widget_spec} [$package_id get_parameter WidgetSpecs] { - foreach {template_name var_name} [split $s ,] break + lassign [split $s ,] template_name var_name #ns_log notice "--w template_name $template_name, given '$given_template_name' varname=$var_name name=$name" if {([string match $template_name $given_template_name] || $given_template_name eq "") && [string match $var_name $name]} { @@ -2594,7 +2695,7 @@ # PageInstances have no form_constraints return "" } - + #FormPage instproc save args { # my debug_msg [my set instance attributes] # my log "IA=[my set instance_attributes]" @@ -2683,19 +2784,18 @@ PageInstance instproc adp_subst {content} { # initialize template variables (in case, new variables are added to template) - array set __ia [my template_vars $content] - # add extra variables as instance attributes - array set __ia [my set instance_attributes] + # and add extra variables from instance attributes + set __ia [dict merge [my template_vars $content] [my set instance_attributes]] - foreach var [array names __ia] { + foreach var [dict keys $__ia] { #my log "-- set $var [list $__ia($var)]" # TODO: just for the lookup, whether a field is a richt text field, # there should be a more efficient and easier way... if {[string match "richtext*" [my get_field_type $var text]]} { # ignore the text/html info from htmlarea - set value [lindex $__ia($var) 0] + set value [lindex [dict get $__ia $var] 0] } else { - set value $__ia($var) + set value [dict get $__ia $var] } # the value might not be from the form attributes (e.g. title), don't clear it. if {$value eq "" && [my exists $var]} continue @@ -2710,7 +2810,7 @@ {-publish_status ready} } { return [::xowiki::PageTemplate count_usages -package_id $package_id \ - -parent_id $parent_id -item_id [my item_id] -publish_status $publish_status] + -parent_id $parent_id -item_id [my item_id] -publish_status $publish_status] } # @@ -2791,7 +2891,9 @@ $doc documentElement root my dom_disable_input_fields -with_submit $with_submit $root set form [lindex [$root selectNodes //form] 0] - Form add_dom_attribute_value $form class "margin-form" + if {[parameter::get_global_value -package_key xowiki -parameter PreferredCSSToolkit -default yui] ne "bootstrap"} { + Form add_dom_attribute_value $form class "margin-form" + } return [$root asHTML] } @@ -2816,7 +2918,7 @@ if {[lindex $text 0] ne ""} { my do_substitutions 0 set html ""; set mime "" - foreach {html mime} [my set text] break + lassign [my set text] html mime set content [my substitute_markup $html] } elseif {[lindex $form 0] ne ""} { set content [[self class] disable_input_fields [lindex $form 0]] @@ -2846,9 +2948,9 @@ #my msg "checking spec '$short_spec' for form field '$spec_name'" lappend form_fields [my create_raw_form_field \ - -name $spec_name \ - -slot [my find_slot $spec_name] \ - -spec $short_spec] + -name $spec_name \ + -slot [my find_slot $spec_name] \ + -spec $short_spec] } return $form_fields } @@ -2894,11 +2996,19 @@ #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] + # + # The Form might come from a different package type (e.g. a + # workflow) make sure, the source package is available. + # + # Note, that global pages (site_wide_pages) might not belong to + # a package and have therefore an empty package_id. + # + set package_id [$p package_id] + if {$package_id ne ""} { + ::xo::Package require $package_id + } } - my array set __ia [my instance_attributes] + #my array set __ia [my instance_attributes] next } FormPage instproc initialize {} { @@ -2922,10 +3032,10 @@ } FormPage proc filter_expression { - {-sql true} - input_expr - logical_op - } { + {-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}} @@ -2941,7 +3051,7 @@ 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 |] + 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]} { @@ -2953,28 +3063,28 @@ } 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" + 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}" + 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)" + 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 "\[dict get \$__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 {[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 @@ -2995,20 +3105,20 @@ } FormPage 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 ""} - } { + -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) # @@ -3033,7 +3143,7 @@ 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 \ @@ -3084,7 +3194,7 @@ # set filter_clause "" array set wc $h_where - set use_hstore [expr {[::xo::db::has_hstore] && + set use_hstore [expr {[::xo::dc has_hstore] && [$package_id get_parameter use_hstore 0] }] if {$use_hstore && $wc(h) ne ""} { @@ -3102,9 +3212,11 @@ # Build package clause # if {$from_package_ids eq ""} { - set package_clause "and object_package_id = $package_id" + set package_clause "and object_package_id = :package_id" } elseif {$from_package_ids eq "*"} { set package_clause "" + } elseif {[llength $from_package_ids] == 1} { + set package_clause "and object_package_id = :from_package_ids" } else { set package_clause "and object_package_id in ([join $from_package_ids ,])" } @@ -3118,17 +3230,17 @@ # 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 \ + -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 @@ -3141,27 +3253,26 @@ -named_objects $named_objects -object_named_after "item_id" \ -object_class ::xowiki::FormPage -initialize $initialize] - if {!$use_hstore && $wc(tcl) ne "true"} { + if {!$use_hstore && $wc(tcl) != "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] + set __ia [dict merge $init_vars [$p instance_attributes]] if {![$p expr $wc(tcl)]} {$items delete $p} } } return $items } - + FormPage proc get_folder_children { - -folder_id:required - {-publish_status ready} - {-object_types {::xowiki::Page ::xowiki::Form ::xowiki::FormPage}} - {-extra_where_clause true} - } { + -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] @@ -3170,17 +3281,17 @@ "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 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] + -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 + $result add $i } } return $result @@ -3196,7 +3307,7 @@ 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} + if {$ref ni $aggregated_folder_refs} {lappend additional_folder_refs $ref} } } # @@ -3208,17 +3319,17 @@ 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] + [FormPage get_super_folders $package_id [$page item_id] $aggregated_folder_refs] } return $aggregated_folder_refs } FormPage proc get_all_children { - -folder_id:required - {-publish_status ready} - {-object_types {::xowiki::Page ::xowiki::Form ::xowiki::FormPage}} - {-extra_where_clause true} - } { + -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] @@ -3234,32 +3345,32 @@ 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]." + my log "Error: Could not resolve parameter folder page '$item_ref' of FormPage [self]." } else { - lappend list_of_folders [$folder item_id] + 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 - } + 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 @@ -3268,79 +3379,92 @@ # part of the code copied from Package->get_parameter # see xowiki/www/prototypes/folder.form.page FormPage 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) - } - } - } + # 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]} { + set __ia [$page set instance_attributes] + if {[dict exists $__ia $attribute]} { + set value [dict get $__ia $attribute] + } + } } - - - if {$value eq {}} {set value [next $attribute $default]} - return $value + } + + + if {$value eq {}} {set value [next $attribute $default]} + return $value } # # begin property management # - FormPage instproc property_key {name} { + #FormPage instproc property_key {name} { + # if {[regexp {^_([^_].*)$} $name _ varname]} { + # return $varname + # } { + # return __ia($name) + # } + #} + + FormPage instproc exists_property {name} { if {[regexp {^_([^_].*)$} $name _ varname]} { - return $varname - } { - return __ia($name) + return [my exists $varname] } + my instvar instance_attributes + return [dict exists $instance_attributes $name] } - FormPage instproc exists_property {name} { - return [my exists [my property_key $name]] - } - FormPage 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] + + if {[regexp {^_([^_].*)$} $name _ varname]} { + if {[my exists $varname]} { + return [my set $varname] + } + return $default } + + my instvar instance_attributes + if {[dict exists $instance_attributes $name]} { + return [dict get $instance_attributes $name] + } return $default } FormPage 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" + } + my set $key $value + + } else { + + my instvar instance_attributes + if {!$new && ![dict exists $instance_attributes $name]} { + error "property '$name' does not exist. \ + you might use flag '-new 1' for set_property to create new properties" + } + dict set instance_attributes $name $value } - 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 } @@ -3359,22 +3483,21 @@ # The passed value is a tuple of the form # {property-name operator property-value} # - foreach {property_name op property_value} $value break + lassign $value property_name op property_value 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] + set __ia [dict merge $wc(vars) [my instance_attributes]] #my log "expr $wc(tcl) returns => [expr $wc(tcl)]" return [expr $wc(tcl)] } # # end property management # - + FormPage instproc set_publish_status {value} { if {$value ni {production ready}} { error "invalid value '$value'; use 'production' or 'ready'" @@ -3397,10 +3520,10 @@ } -# FormPage instproc form_attributes {} { -# my log "DEPRECATRED, use 'field_names_from_form' instead " -# return [my field_names_from_form] -# } + # FormPage instproc form_attributes {} { + # my log "DEPRECATRED, use 'field_names_from_form' instead " + # return [my field_names_from_form] + # } FormPage instproc field_names_from_form {{-form ""}} { # @@ -3419,9 +3542,9 @@ 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 - } + if {$var ni $allvars && $var ni $field_names} { + lappend field_names $var + } } set from_HTML_form 0 } else { @@ -3434,13 +3557,13 @@ set fields [$root selectNodes "//*\[@name != ''\]"] foreach field $fields { set node_name [$field nodeName] - if {$node_name ne "input" + if {$node_name ne "input" && $node_name ne "textarea" && $node_name ne "select" } continue - set att [$field getAttribute name] + set att [$field getAttribute name] #if {[string match _* $att]} continue - if {$att ni $field_names} { lappend field_names $att } + if {$att ni $field_names} { lappend field_names $att } } set from_HTML_form 1 } @@ -3462,23 +3585,23 @@ } switch [$page_template name] { en:folder.form { - return [list text "" is_richtext true] + return [list text "" 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 " \ - " is_richtext true] - } - if {$link_type eq "folder_link"} { - return [list text " \ - " is_richtext true] - } - return [list text "" is_richtext true] + 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 " \ + " is_richtext true] + } + if {$link_type eq "folder_link"} { + return [list text " \ + " is_richtext true] + } + return [list text "" is_richtext true] } default { - return [list text [$page_template title] is_richtext false] + return [list text [$page_template title] is_richtext false] } } } @@ -3509,11 +3632,11 @@ 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] - } + 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 } @@ -3529,35 +3652,37 @@ catch {set text [lindex $text 0]} } if {$text ne ""} { - #my msg "we have a template text='$text'" + #my log "we have a template text='$text'" # we have a template return [next] } else { - #my msg "we have a form '[my get_form]'" + #my log "we have a form '[my get_form]'" set form [my get_form] if {$form eq ""} {return ""} - ::xowiki::Form requireFormCSS + my setCSSDefaults - foreach {form_vars field_names} [my field_names_from_form -form $form] break + lassign [my field_names_from_form -form $form] form_vars field_names 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}] + [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] + my log "render-content" + Form add_dom_attribute_value $form_node role form 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 @@ -3586,19 +3711,19 @@ # 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]] + # + # 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 + # + # 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]} { @@ -3617,7 +3742,7 @@ # 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"}] + {my get_value -field_spec $field_spec -cr_field_spec $cr_field_spec "\\\1" "\2"}] return [string range $content 1 end] } @@ -3668,7 +3793,7 @@ Page instproc unset_temporary_instance_variables {} { # don't marshall/save/cache the following vars - my array unset __ia + #my array unset __ia my array unset __field_in_form my array unset __field_needed } @@ -3685,7 +3810,7 @@ my instvar package_id name - db_transaction { + ::xo::dc transaction { # # if the newly created item was in production mode, but ordinary entries # are not, change on the first save the status to ready @@ -3698,9 +3823,7 @@ my map_categories $category_ids my save -use_given_publish_date $use_given_publish_date - #my log "-- old_name $old_name, name $name" if {$old_name ne $name} { - #my msg "do rename from $old_name to $name" $package_id flush_name_cache -name $old_name -parent_id [my parent_id] my rename -old_name $old_name -new_name $name } @@ -3712,3 +3835,9 @@ ::xo::library source_dependent +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: