Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -r1.180.2.72 -r1.180.2.73 --- openacs-4/packages/xowiki/xowiki.info 15 Oct 2021 10:16:02 -0000 1.180.2.72 +++ openacs-4/packages/xowiki/xowiki.info 16 Oct 2021 14:45:39 -0000 1.180.2.73 @@ -10,7 +10,7 @@ t xowiki - + Gustaf Neumann A xotcl-based enterprise wiki system with multiple object types 2021-09-15 @@ -55,7 +55,7 @@ BSD-Style 2 - + Index: openacs-4/packages/xowiki/tcl/form-field-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/form-field-procs.tcl,v diff -u -r1.284.2.172 -r1.284.2.173 --- openacs-4/packages/xowiki/tcl/form-field-procs.tcl 17 Sep 2021 19:33:56 -0000 1.284.2.172 +++ openacs-4/packages/xowiki/tcl/form-field-procs.tcl 16 Oct 2021 14:45:39 -0000 1.284.2.173 @@ -5272,6 +5272,7 @@ {parent_id *} {form} {where} + {unless} {entry_label _title} {orderby title} } @@ -5301,11 +5302,10 @@ return } - set wc {tcl true h "" vars "" sql ""} - if {[info exists :where]} { - set wc [dict merge $wc [::xowiki::FormPage filter_expression ${:where} &&]] - #:msg "where '${:where}' => wc=$wc" - } + set filters [::xowiki::FormPage compute_filter_clauses \ + {*}[expr {[info exists :unless] ? [list -unless ${:unless}] : ""}] \ + {*}[expr {[info exists :where] ? [list -where ${:where}] : ""}] \ + ] set from_package_ids {} set package_path [::${:package_id} package_path] @@ -5322,7 +5322,8 @@ -base_item_ids ${:form_object_item_ids} \ -form_fields [list] \ -publish_status ready \ - -h_where $wc \ + -h_where [dict get $filters wc] \ + -h_unless [dict get $filters uc] \ -parent_id ${:parent_id} \ -package_id ${:package_id} \ -orderby title \ Index: openacs-4/packages/xowiki/tcl/includelet-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/includelet-procs.tcl,v diff -u -r1.239.2.74 -r1.239.2.75 --- openacs-4/packages/xowiki/tcl/includelet-procs.tcl 6 Oct 2021 12:21:00 -0000 1.239.2.74 +++ openacs-4/packages/xowiki/tcl/includelet-procs.tcl 16 Oct 2021 14:45:39 -0000 1.239.2.75 @@ -4582,22 +4582,15 @@ # # Compute filter clauses # - set init_vars [list] - set uc {tcl false h "" vars "" sql ""} - if {[info exists unless]} { - set uc [dict merge $uc [::xowiki::FormPage filter_expression $unless ||]] - set init_vars [list {*}$init_vars {*}[dict get $uc vars]] - } - set wc {tcl true h "" vars "" sql ""} - if {[info exists where]} { - set wc [dict merge $wc [::xowiki::FormPage filter_expression $where &&]] - set init_vars [list {*}$init_vars {*}[dict get $wc vars]] - } - #:msg uc=$uc - #:msg wc=$wc + set filters [::xowiki::FormPage compute_filter_clauses \ + {*}[expr {[info exists unless] ? [list -unless $unless] : ""}] \ + {*}[expr {[info exists where] ? [list -where $where] : ""}]] + #:msg filters=$filters + # - # get an ordered composite of the base set (currently including extra_where clause) + # Get an ordered composite of the base set (currently including + # extra_where clause) # #:log "exists category_id [info exists category_id]" set extra_where_clause "" @@ -4611,7 +4604,8 @@ -form_fields $form_field_objs \ -publish_status $publish_status \ -extra_where_clause $extra_where_clause \ - -h_where $wc \ + -h_where [dict get $filters wc] \ + -h_unless [dict get $filters uc] \ -from_package_ids $package_ids \ -package_id $package_id] @@ -4625,7 +4619,8 @@ -parent_id $query_parent_id \ -form_fields $form_field_objs \ -publish_status $publish_status \ - -h_where $wc \ + -h_where [dict get $filters wc] \ + -h_unless [dict get $filters uc] \ -from_package_ids $package_ids \ -package_id $package_id] } @@ -4640,7 +4635,7 @@ -return_url [ad_return_url] \ -package_id $package_id \ -items $items \ - -init_vars $init_vars \ + -init_vars [dict get $filters init_vars] \ -uc $uc \ -view_field $view_field \ -buttons $buttons \ Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v diff -u -r1.542.2.112 -r1.542.2.113 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 14 Sep 2021 18:05:19 -0000 1.542.2.112 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 16 Oct 2021 14:45:40 -0000 1.542.2.113 @@ -3738,7 +3738,7 @@ # # Determine the CSS class name for xowiki forms # - set name "" + set name "" if {$margin_form} { set css [::xowiki::CSS class margin-form] if {$css ne ""} { @@ -4251,6 +4251,29 @@ return 0 } + FormPage ad_proc compute_filter_clauses {-unless -where} { + + Compute from "-unless" or "-where" specs the tcl, sql and + optionall hstore query fragments. + + @return dict containing "init_vars", "uc" (unless clauses) + and "wc" (where clauses) + } { + + set init_vars [list] + set uc {tcl false h "" vars "" sql ""} + if {[info exists unless]} { + set uc [dict merge $uc [:filter_expression $unless ||]] + set init_vars [list {*}$init_vars {*}[dict get $uc vars]] + } + set wc {tcl true h "" vars "" sql ""} + if {[info exists where]} { + set wc [dict merge $wc [:filter_expression $where &&]] + set init_vars [list {*}$init_vars {*}[dict get $wc vars]] + } + return [list init_vars $init_vars uc $uc wc $wc] + } + FormPage proc filter_expression { {-sql true} input_expr @@ -4324,11 +4347,18 @@ :msg "ignoring $clause" } } - if {[llength $tcl_clause] == 0} {set tcl_clause [list true]} + if {[llength $tcl_clause] == 0} { + set tcl_clause [list true] + } #:msg sql=$sql_clause,tcl=$tcl_clause - return [list tcl [join $tcl_clause $logical_op] h [join $h_clause ,] \ - vars $vars sql $sql_clause] - #:msg $expression + set result [list \ + tcl [join $tcl_clause $logical_op] \ + h [join $h_clause ,] \ + vars $vars \ + sql $sql_clause] + #:msg "filter_expression -sql $sql inp '$input_expr' log '$logical_op' -> $result" + + return $result } FormPage proc get_form_entries { @@ -4339,6 +4369,7 @@ {-parent_id "*"} {-extra_where_clause ""} {-h_where {tcl true h "" vars "" sql ""}} + {-h_unless {tcl true h "" vars "" sql ""}} {-always_queried_attributes ""} {-orderby ""} {-page_size 20} @@ -4419,18 +4450,30 @@ # set filter_clause "" array set wc $h_where + array set uc $h_unless set use_hstore [expr {[::xo::dc has_hstore] && [::$package_id get_parameter use_hstore 0] }] - if {$use_hstore && $wc(h) ne ""} { - set filter_clause " and '$wc(h)' <@ hkey" + set use_hstore 0 + if {$use_hstore} { + if {$wc(h) ne ""} { + set filter_clause " and '$wc(h)' <@ hkey" + } + if {$uc(h) ne ""} { + set filter_clause " and not '$uc(h)' <@ hkey" + } } - #:msg "exists sql=[info exists wc(sql)]" + #:msg "exists w sql=[info exists wc(sql)] u sql=[info exists uc(sql)] " if {$wc(sql) ne "" && $wc(h) ne ""} { foreach filter $wc(sql) { - append filter_clause "and $filter" + append filter_clause " and $filter" } } + if {$uc(sql) ne ""} { + foreach filter $uc(sql) { + append filter_clause " and not $filter" + } + } #:msg filter_clause=$filter_clause # @@ -4489,15 +4532,27 @@ -named_objects $named_objects -object_named_after "item_id" \ -object_class ::xowiki::FormPage -initialize $initialize] - 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 + #:msg "$use_hstore wc tcl $wc(tcl) uc tcl $uc(tcl)" + if {!$use_hstore && ($wc(tcl) != "true" || $uc(tcl) != "true")} { + # Make sure that the expr method is available set init_vars $wc(vars) foreach p [$items children] { $p set __ia [dict merge $init_vars [$p instance_attributes]] - if {![$p expr $wc(tcl)]} {$items delete $p} + + if {$wc(tcl) != "true"} { + if {![nsf::directdispatch $p -frame object expr $wc(tcl)]} { + #:msg "check $wc(tcl) [$p name] => where DELETE" + $items delete $p + continue + } + } + if {$uc(tcl) != "true"} { + if {[nsf::directdispatch $p -frame object ::expr $uc(tcl)]} { + #:msg "check $uc(tcl) on [$p name] => unless DELETE" + $items delete $p + } + } } } return $items