Index: openacs-4/packages/xowf/tcl/atjob-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/atjob-procs.tcl,v diff -u -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/xowf/tcl/atjob-procs.tcl 2 Sep 2014 13:03:01 -0000 1.1.2.1 +++ openacs-4/packages/xowf/tcl/atjob-procs.tcl 2 Sep 2014 13:09:03 -0000 1.1.2.2 @@ -83,45 +83,45 @@ #my log "---run xowf jobs START" set items [::xowiki::FormPage instantiate_objects \ - -object_class ::xowiki::FormPage \ - -sql "select i.item_id, i.name, i.parent_id, i.publish_status, o.creation_user, + -object_class ::xowiki::FormPage \ + -sql "select i.item_id, i.name, i.parent_id, i.publish_status, o.creation_user, i.live_revision as revision_id, page_template, instance_attributes - from cr_items i, xowiki_page_instance t, acs_objects o - where i.item_id in ([join $item_ids ,]) and - i.live_revision = t.page_instance_id and o.object_id = i.item_id"] + from cr_items i, xowiki_page_instance t, acs_objects o + where i.item_id in ([join $item_ids ,]) and + i.live_revision = t.page_instance_id and o.object_id = i.item_id"] if {[llength [$items children]] > 0} { - + my log "--at we got [llength [$items children]] scheduled items" foreach item [$items children] { - #my log "--at *** job=[$item serialize] ***\n" - set owner_id [$item parent_id] - set party_id [$item creation_user] - set __ia [$item instance_attributes] - if {![dict exists $__ia cmd]} { - #ns_log notice "--at ignore strange entry [$item serialize]" - ns_log notice "--at ignore strange entry, no cmd in [$item instance_attributes]" - continue - } - set cmd [dict get $__ia cmd] + #my log "--at *** job=[$item serialize] ***\n" + set owner_id [$item parent_id] + set party_id [$item creation_user] + set __ia [$item instance_attributes] + if {![dict exists $__ia cmd]} { + #ns_log notice "--at ignore strange entry [$item serialize]" + ns_log notice "--at ignore strange entry, no cmd in [$item instance_attributes]" + continue + } + set cmd [dict get $__ia cmd] - # We assume, the owner object is a cr-item - ::xo::db::CrClass get_instance_from_db -item_id $owner_id + # We assume, the owner object is a cr-item + ::xo::db::CrClass get_instance_from_db -item_id $owner_id - # We assume, the package is from the xowiki family; make sure, the url looks like real - ::xo::Package initialize \ - -package_id [$owner_id package_id] \ - -user_id $party_id \ - -init_url 0 -actual_query "" - $package_id set_url -url [$package_id package_url][$owner_id name] + # We assume, the package is from the xowiki family; make sure, the url looks like real + ::xo::Package initialize \ + -package_id [$owner_id package_id] \ + -user_id $party_id \ + -init_url 0 -actual_query "" + $package_id set_url -url [$package_id package_url][$owner_id name] - my log "--at executing atjob $cmd" - if {[catch {eval $owner_id $cmd} errorMsg]} { - ns_log error "\n*** atjob $owner_id $cmd lead to error ***\n$errorMsg" - } else { - $item set_live_revision -revision_id [$item revision_id] -publish_status "expired" - } + my log "--at executing atjob $cmd" + if {[catch {eval $owner_id $cmd} errorMsg]} { + ns_log error "\n*** atjob $owner_id $cmd lead to error ***\n$errorMsg" + } else { + $item set_live_revision -revision_id [$item revision_id] -publish_status "expired" + } } my log "---run xowf jobs END" } @@ -156,7 +156,7 @@ and i2.name = 'en:atjob-form' and r.publish_date $op to_timestamp(:ansi_time,'YYYY-MM-DD HH24:MI') and i.publish_status = 'production' - and o.package_id is not null + and o.package_id is not null " ] my log "--at we got [llength $item_ids] scheduled items" @@ -170,14 +170,20 @@ # splitting the list and run multiple jobs in parallel. # if {[llength $item_ids]} { - set queue xowfatjobs - if {$queue ni [ns_job queues]} { - ns_job create $queue - } - ns_job queue -detached $queue [list ::xowf::atjob run_jobs $item_ids] + set queue xowfatjobs + if {$queue ni [ns_job queues]} { + ns_job create $queue + } + ns_job queue -detached $queue [list ::xowf::atjob run_jobs $item_ids] } my log "--at END" } - } + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/xowf/tcl/test-item-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/test-item-procs.tcl,v diff -u -r1.1 -r1.1.2.1 --- openacs-4/packages/xowf/tcl/test-item-procs.tcl 28 Aug 2014 08:24:56 -0000 1.1 +++ openacs-4/packages/xowf/tcl/test-item-procs.tcl 2 Sep 2014 13:09:03 -0000 1.1.2.1 @@ -79,13 +79,13 @@ # switch -- [my question_type] { mc { # we should support as well: minChoices, maxChoices, shuffle - set interaction_class mc_interaction - set options nr_choices=[my nr_choices] - } + set interaction_class mc_interaction + set options nr_choices=[my nr_choices] + } sc { # we should support as well: minChoices, maxChoices, shuffle - set interaction_class mc_interaction - set options nr_choices=[my nr_choices],multiple=false - } + set interaction_class mc_interaction + set options nr_choices=[my nr_choices],multiple=false + } ot { set interaction_class text_interaction } default {error "unknown question type: [my question_type]"} } @@ -191,7 +191,7 @@ append form "
$intro_text
\n" #my msg " input_field_names=[my set input_field_names]" - + if {![my multiple]} { set correct_field_name [my get_named_sub_component_value correct] } @@ -271,8 +271,8 @@ } if {[my feedback_level] eq "full"} { set feedback_fields { - {feedback_correct {textarea,cols=60,label=#xowf.feedback_correct#}} - {feedback_incorrect {textarea,cols=60,label=#xowf.feedback_incorrect#}} + {feedback_correct {textarea,cols=60,label=#xowf.feedback_correct#}} + {feedback_incorrect {textarea,cols=60,label=#xowf.feedback_incorrect#}} } } else { set feedback_fields "" @@ -403,17 +403,17 @@ set alt_inputs [list] set alt_values [list] foreach html_type {input textarea} { - foreach n [$root selectNodes "//$html_type\[@name != ''\]"] { - set alt_input [$n getAttribute name] - $n setAttribute name $prefix-$alt_input - if {$html_type eq "input"} { - set alt_value [$n getAttribute value] - } else { - set alt_value "" - } - lappend alt_inputs $alt_input - lappend alt_values $alt_value - } + foreach n [$root selectNodes "//$html_type\[@name != ''\]"] { + set alt_input [$n getAttribute name] + $n setAttribute name $prefix-$alt_input + if {$html_type eq "input"} { + set alt_value [$n getAttribute value] + } else { + set alt_value "" + } + lappend alt_inputs $alt_input + lappend alt_values $alt_value + } } # We have to drop the toplevel
of the included form foreach n [$root childNodes] {append form [$n asHTML]} @@ -423,17 +423,17 @@ # foreach f [dict get $__ia form_constraints] { if {[regexp {^([^:]+):(.*)$} $f _ field_name definition]} { - if {[string match @* $field_name]} continue + if {[string match @* $field_name]} continue # keep all form-constraints for which we have altered the name - #my msg "old fc=$f, [list lsearch -exact $alt_inputs $field_name] => [lsearch -exact $alt_inputs $field_name] $alt_values" - set ff [[my object] create_raw_form_field -name $field_name -spec $definition] - #my msg "ff answer => '[$ff answer]'" + #my msg "old fc=$f, [list lsearch -exact $alt_inputs $field_name] => [lsearch -exact $alt_inputs $field_name] $alt_values" + set ff [[my object] create_raw_form_field -name $field_name -spec $definition] + #my msg "ff answer => '[$ff answer]'" if {$field_name in $alt_inputs} { - lappend fc $prefix-$f - } elseif {[$ff exists answer] && $field_name eq [$ff answer]} { - # this rules is for single choice - lappend fc $prefix-$f - } + lappend fc $prefix-$f + } elseif {[$ff exists answer] && $field_name eq [$ff answer]} { + # this rules is for single choice + lappend fc $prefix-$f + } } } } @@ -449,3 +449,10 @@ #my msg "fc=$fc" } } + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/xowf/tcl/xowf-calllback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/Attic/xowf-calllback-procs.tcl,v diff -u -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/xowf/tcl/xowf-calllback-procs.tcl 2 Sep 2014 10:51:44 -0000 1.1.2.1 +++ openacs-4/packages/xowf/tcl/xowf-calllback-procs.tcl 2 Sep 2014 13:09:03 -0000 1.1.2.2 @@ -8,45 +8,52 @@ namespace eval ::xowf { - ad_proc after-instantiate {-package_id:required } { - Callback when this an xowf instance is created - } { - ns_log notice "++++ BEGIN ::xowf::after-instantiate -package_id $package_id" - # General setup - ::xo::Package initialize -package_id $package_id - set folder_id [::$package_id folder_id] - - # - # Create a parameter page for conveniance - # - set pform_id [::xowiki::Weblog instantiate_forms -forms en:Parameter.form \ - -package_id $package_id] + ad_proc after-instantiate {-package_id:required } { + Callback when this an xowf instance is created + } { + ns_log notice "++++ BEGIN ::xowf::after-instantiate -package_id $package_id" + # General setup + ::xo::Package initialize -package_id $package_id + set folder_id [::$package_id folder_id] + + # + # Create a parameter page for conveniance + # + set pform_id [::xowiki::Weblog instantiate_forms -forms en:Parameter.form \ + -package_id $package_id] - ::xo::db::sql::content_item set_live_revision \ - -revision_id [$pform_id revision_id] \ - -publish_status production + ::xo::db::sql::content_item set_live_revision \ + -revision_id [$pform_id revision_id] \ + -publish_status production - set ia { - MenuBar t top_includelet none production_mode t with_user_tracking t with_general_comments f - with_digg f with_tags f - ExtraMenuEntries {{entry -name New.Extra.Workflow -label "New Workflow" -form /en:Workflow.form}} - with_delicious f with_notifications f security_policy ::xowiki::policy1 - } - - set parameter_page_name en:xowf-default-parameter - set p [$pform_id create_form_page_instance \ - -name $parameter_page_name \ - -nls_language en_US \ - -default_variables [list title "XoWf Default Parameter" parent_id $folder_id \ - package_id $package_id instance_attributes $ia]] - $p save_new + set ia { + MenuBar t top_includelet none production_mode t with_user_tracking t with_general_comments f + with_digg f with_tags f + ExtraMenuEntries {{entry -name New.Extra.Workflow -label "New Workflow" -form /en:Workflow.form}} + with_delicious f with_notifications f security_policy ::xowiki::policy1 + } + + set parameter_page_name en:xowf-default-parameter + set p [$pform_id create_form_page_instance \ + -name $parameter_page_name \ + -nls_language en_US \ + -default_variables [list title "XoWf Default Parameter" parent_id $folder_id \ + package_id $package_id instance_attributes $ia]] + $p save_new - # - # Make the paramter page the default - # - parameter::set_value -package_id $package_id -parameter parameter_page -value $parameter_page_name - callback subsite::parameter_changed -package_id $package_id -parameter parameter_page -value $parameter_page_name + # + # Make the paramter page the default + # + parameter::set_value -package_id $package_id -parameter parameter_page -value $parameter_page_name + callback subsite::parameter_changed -package_id $package_id -parameter parameter_page -value $parameter_page_name - ns_log notice "++++ END ::xowf::after-instantiate -package_id $package_id" - } + ns_log notice "++++ END ::xowf::after-instantiate -package_id $package_id" + } } + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/xowf/tcl/xowf-includelet-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowf/tcl/xowf-includelet-procs.tcl,v diff -u -r1.1 -r1.1.2.1 --- openacs-4/packages/xowf/tcl/xowf-includelet-procs.tcl 28 Aug 2014 08:24:56 -0000 1.1 +++ openacs-4/packages/xowf/tcl/xowf-includelet-procs.tcl 2 Sep 2014 13:09:03 -0000 1.1.2.1 @@ -39,8 +39,8 @@ set sql { select assignee,xowiki_form_page_id,state,i.publish_status,page_template, - p.creation_date, p.last_modified, p,description, - i2.name as wf_name,p.title,i.name,i.parent_id,o.package_id as pid + p.creation_date, p.last_modified, p,description, + i2.name as wf_name,p.title,i.name,i.parent_id,o.package_id as pid from xowiki_form_pagei p,cr_items i, cr_items i2, acs_objects o where (assignee = :user_id or acs_group__member_p(:user_id,assignee, 'f')) and i.live_revision = xowiki_form_page_id @@ -59,21 +59,21 @@ # //package/ # if {[regexp {^/(/.*)/$} $workflow _ package]} { - # all workflows from this package + # all workflows from this package ::xowf::Package initialize -url $package #my msg "using package_id=$package_id" append sql " and o.package_id = :package_id" } else { - if {[regexp {^/(/[^/]+)(/.+)$} $workflow _ package path]} { - ::xowf::Package initialize -url $package - #my msg "using package_id=$package_id" - } else { - set path $workflow - } - set parent_id [[my set __including_page] parent_id] - set wf_page [$package_id get_page_from_item_ref -parent_id $parent_id $path] + if {[regexp {^/(/[^/]+)(/.+)$} $workflow _ package path]} { + ::xowf::Package initialize -url $package + #my msg "using package_id=$package_id" + } else { + set path $workflow + } + set parent_id [[my set __including_page] parent_id] + set wf_page [$package_id get_page_from_item_ref -parent_id $parent_id $path] if {$wf_page eq ""} { - my msg "cannot resolve page $workflow" + my msg "cannot resolve page $workflow" set package_id -1; set page_template -1 } else { set page_template [$wf_page item_id] @@ -136,3 +136,10 @@ } } + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/xowiki/tcl/lcs-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/lcs-procs.tcl,v diff -u -r1.4.2.1 -r1.4.2.2 --- openacs-4/packages/xowiki/tcl/lcs-procs.tcl 11 Oct 2013 10:14:01 -0000 1.4.2.1 +++ openacs-4/packages/xowiki/tcl/lcs-procs.tcl 2 Sep 2014 13:12:47 -0000 1.4.2.2 @@ -3,148 +3,155 @@ # 'http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/tcllib/tcllib/license.terms' # for terms and conditions of redistribution. - namespace eval list { namespace export longestCommonSubsequence } +namespace eval list { namespace export longestCommonSubsequence } - # Do a compatibility version of [lset] for pre-8.4 versions of Tcl. - # This version does not do multi-arg [lset]! +# Do a compatibility version of [lset] for pre-8.4 versions of Tcl. +# This version does not do multi-arg [lset]! - if { [package vcompare [package provide Tcl] 8.4] < 0 } { - proc list::K { x y } { set x } - proc list::lset { var index arg } { - upvar 1 $var list - set list [lreplace [K $list [set list {}]] $index $index $arg] - } - } +if { [package vcompare [package provide Tcl] 8.4] < 0 } { + proc list::K { x y } { set x } + proc list::lset { var index arg } { + upvar 1 $var list + set list [lreplace [K $list [set list {}]] $index $index $arg] + } +} - # list::longestCommonSubsequence -- - # - # Computes the longest common subsequence of two lists. - # - # Parameters: - # sequence1, sequence2 -- Two lists to compare. - # - # Results: - # Returns a list of two lists of equal length. - # The first sublist is of indices into sequence1, and the - # second sublist is of indices into sequence2. Each corresponding - # pair of indices corresponds to equal elements in the sequences; - # the sequence returned is the longest possible. - # - # Side effects: - # None. +# list::longestCommonSubsequence -- +# +# Computes the longest common subsequence of two lists. +# +# Parameters: +# sequence1, sequence2 -- Two lists to compare. +# +# Results: +# Returns a list of two lists of equal length. +# The first sublist is of indices into sequence1, and the +# second sublist is of indices into sequence2. Each corresponding +# pair of indices corresponds to equal elements in the sequences; +# the sequence returned is the longest possible. +# +# Side effects: +# None. - proc list::longestCommonSubsequence { sequence1 sequence2 } { +proc list::longestCommonSubsequence { sequence1 sequence2 } { - set seta [list] - set setb [list] + set seta [list] + set setb [list] - # Construct a set of equivalence classes of lines in file 2 + # Construct a set of equivalence classes of lines in file 2 - set index 0 - foreach string $sequence2 { - lappend eqv($string) $index - incr index - } + set index 0 + foreach string $sequence2 { + lappend eqv($string) $index + incr index + } - # K holds descriptions of the common subsequences. - # Initially, there is one common subsequence of length 0, - # with a fence saying that it includes line -1 of both files. - # The maximum subsequence length is 0; position 0 of - # K holds a fence carrying the line following the end - # of both files. + # K holds descriptions of the common subsequences. + # Initially, there is one common subsequence of length 0, + # with a fence saying that it includes line -1 of both files. + # The maximum subsequence length is 0; position 0 of + # K holds a fence carrying the line following the end + # of both files. - lappend K [list -1 -1 {}] - lappend K [list [llength $sequence1] [llength $sequence2] {}] - set k 0 + lappend K [list -1 -1 {}] + lappend K [list [llength $sequence1] [llength $sequence2] {}] + set k 0 - # Walk through the first file, letting i be the index of the line and - # string be the line itself. + # Walk through the first file, letting i be the index of the line and + # string be the line itself. - set i 0 - foreach string $sequence1 { + set i 0 + foreach string $sequence1 { - # Consider each possible corresponding index j in the second file. + # Consider each possible corresponding index j in the second file. - if { [info exists eqv($string)] } { + if { [info exists eqv($string)] } { - # c is the candidate match most recently found, and r is the - # length of the corresponding subsequence. + # c is the candidate match most recently found, and r is the + # length of the corresponding subsequence. - set c [lindex $K 0] - set r 0 + set c [lindex $K 0] + set r 0 - foreach j $eqv($string) { + foreach j $eqv($string) { - # Perform a binary search to find a candidate common - # subsequence to which may be appended this match. + # Perform a binary search to find a candidate common + # subsequence to which may be appended this match. - set max $k - set min $r - set s [expr { $k + 1 }] - while { $max >= $min } { - set mid [expr { ( $max + $min ) / 2 }] - set bmid [lindex $K $mid 1] - if { $j == $bmid } { - break - } elseif { $j < $bmid } { - set max [expr {$mid - 1}] - } else { - set s $mid - set min [expr { $mid + 1 }] - } - } + set max $k + set min $r + set s [expr { $k + 1 }] + while { $max >= $min } { + set mid [expr { ( $max + $min ) / 2 }] + set bmid [lindex $K $mid 1] + if { $j == $bmid } { + break + } elseif { $j < $bmid } { + set max [expr {$mid - 1}] + } else { + set s $mid + set min [expr { $mid + 1 }] + } + } - # Go to the next match point if there is no suitable - # candidate. + # Go to the next match point if there is no suitable + # candidate. - if { $j == [lindex $K $mid 1] || $s > $k} { - continue - } + if { $j == [lindex $K $mid 1] || $s > $k} { + continue + } - # s is the sequence length of the longest sequence - # to which this match point may be appended. Make - # a new candidate match and store the old one in K - # Set r to the length of the new candidate match. + # s is the sequence length of the longest sequence + # to which this match point may be appended. Make + # a new candidate match and store the old one in K + # Set r to the length of the new candidate match. - set newc [list $i $j [lindex $K $s]] - lset K $r $c - set c $newc - set r [expr {$s + 1}] + set newc [list $i $j [lindex $K $s]] + lset K $r $c + set c $newc + set r [expr {$s + 1}] - # If we've extended the length of the longest match, - # we're done; move the fence. + # If we've extended the length of the longest match, + # we're done; move the fence. - if { $s >= $k } { - lappend K [lindex $K end] - incr k - break - } + if { $s >= $k } { + lappend K [lindex $K end] + incr k + break + } - } + } - # Put the last candidate into the array + # Put the last candidate into the array - lset K $r $c + lset K $r $c - } + } - incr i + incr i - } + } - set q [lindex $K $k] + set q [lindex $K $k] - for { set i 0 } { $i < $k } {incr i } { - lappend seta {} - lappend setb {} - } - while { [lindex $q 0] >= 0 } { - incr k -1 - lset seta $k [lindex $q 0] - lset setb $k [lindex $q 1] - set q [lindex $q 2] - } + for { set i 0 } { $i < $k } {incr i } { + lappend seta {} + lappend setb {} + } + while { [lindex $q 0] >= 0 } { + incr k -1 + lset seta $k [lindex $q 0] + lset setb $k [lindex $q 1] + set q [lindex $q 2] + } - return [list $seta $setb] + return [list $seta $setb] - } +} + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/xowiki/tcl/menu-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/menu-procs.tcl,v diff -u -r1.7.2.7 -r1.7.2.8 --- openacs-4/packages/xowiki/tcl/menu-procs.tcl 1 Sep 2014 11:24:47 -0000 1.7.2.7 +++ openacs-4/packages/xowiki/tcl/menu-procs.tcl 2 Sep 2014 13:12:47 -0000 1.7.2.8 @@ -56,7 +56,7 @@ style linkclass target - {group ""} + {group ""} } @@ -133,15 +133,15 @@ if {[info commands ::dict] ne ""} { ::xowiki::MenuBar instproc get_prop {dict key {default ""}} { if {![dict exists $dict $key]} { - return $default + return $default } return [dict get $dict $key] } } else { ::xowiki::MenuBar instproc get_prop {dict key {default ""}} { array set "" $dict if {![info exists ($key)]} { - return $default + return $default } return [set ($key)] } @@ -246,36 +246,36 @@ set properties [lrange $me 1 end] switch $kind { - clear_menu { - my clear_menu -menu [dict get $properties -menu] - } - - form_link - - entry { - # sample entry: entry -name New.YouTubeLink -label YouTube -form en:YouTube.form - if {$kind eq "form_link"} { - my log "$me, name 'form_link' is deprecated, use 'entry' instead" - } - if {[dict exists $properties -form]} { - set link [$package_id make_form_link \ + clear_menu { + my clear_menu -menu [dict get $properties -menu] + } + + form_link - + entry { + # sample entry: entry -name New.YouTubeLink -label YouTube -form en:YouTube.form + if {$kind eq "form_link"} { + my log "$me, name 'form_link' is deprecated, use 'entry' instead" + } + if {[dict exists $properties -form]} { + set link [$package_id make_form_link \ -form [dict get $properties -form] \ - -parent_id $parent_id \ - -nls_language $nls_language -return_url $return_url] - } elseif {[dict exists $properties -object_type]} { - set link [$package_id make_link -with_entities 0 \ - $package_id edit-new \ - [list object_type [dict get $properties -object_type]] \ - parent_id return_url autoname template_file] - } else { - my log "Warning: no link specified" - set link "" - } - set item [list url $link] - if {[dict exists $properties -label]} {lappend item text [dict get $properties -label]} - my add_menu_item -name [dict get $properties -name] -item $item - } - - default { error "unknown kind of menu entry: $kind" } + -parent_id $parent_id \ + -nls_language $nls_language -return_url $return_url] + } elseif {[dict exists $properties -object_type]} { + set link [$package_id make_link -with_entities 0 \ + $package_id edit-new \ + [list object_type [dict get $properties -object_type]] \ + parent_id return_url autoname template_file] + } else { + my log "Warning: no link specified" + set link "" + } + set item [list url $link] + if {[dict exists $properties -label]} {lappend item text [dict get $properties -label]} + my add_menu_item -name [dict get $properties -name] -item $item + } + + default { error "unknown kind of menu entry: $kind" } } } } Index: openacs-4/packages/xowiki/tcl/yui-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/yui-procs.tcl,v diff -u -r1.1.2.2 -r1.1.2.3 --- openacs-4/packages/xowiki/tcl/yui-procs.tcl 15 Apr 2014 07:15:09 -0000 1.1.2.2 +++ openacs-4/packages/xowiki/tcl/yui-procs.tcl 2 Sep 2014 13:12:47 -0000 1.1.2.3 @@ -36,7 +36,7 @@ header footer shadow - {autorender false} + {autorender false} {configuration {{}}} } @@ -60,9 +60,9 @@ foreach e $list { set gn [$e group] if {$gn ne $group_name} { - lappend result $group_list - set group_name $gn - set group_list [list] + lappend result $group_list + set group_name $gn + set group_list [list] } lappend group_list $e } @@ -90,11 +90,11 @@ # Body html::t \n html::div -class "bd" { - foreach group [my split_menu_groups [my children]] { - html::ul { - foreach menuitemlist $group {$menuitemlist render} - } - } + foreach group [my split_menu_groups [my children]] { + html::ul { + foreach menuitemlist $group {$menuitemlist render} + } + } } # Footer if {[my exists footer]} { @@ -127,7 +127,7 @@ ::xo::tdom::Class create YUIMenuItem \ -superclass MenuItem \ -parameter { - {href "#"} + {href "#"} helptext } @@ -217,9 +217,9 @@ my append CSSclass " yuimenu" html::div [my get_attributes id {CSSclass class}] { html::div -class "bd" { - html::ul { - foreach li [my children] {$li render} - } + html::ul { + foreach li [my children] {$li render} + } } html::script -type "text/javascript" { html::t "var [my js_name] = new YAHOO.widget.ContextMenu('[my id]', { trigger: '[my set trigger]' } );" @@ -253,8 +253,8 @@ if {[string match {[a-z]*} $item_att]} continue set text [my get_prop $item text] set url [my get_prop $item url] - set group [my get_prop $item group] - #my msg "ia=$item_att group '$group' // t=$text item=$item" + set group [my get_prop $item group] + #my msg "ia=$item_att group '$group' // t=$text item=$item" ::xowiki::YUIMenuItem -text $text -href $url -group $group {} } }