Index: openacs-4/packages/acs-templating/tcl/tag-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/tag-procs.tcl,v
diff -u -r1.18 -r1.19
--- openacs-4/packages/acs-templating/tcl/tag-procs.tcl 30 Mar 2013 17:53:58 -0000 1.18
+++ openacs-4/packages/acs-templating/tcl/tag-procs.tcl 27 Oct 2014 16:40:12 -0000 1.19
@@ -1,8 +1,8 @@
# Auxiliary Procs for Tag Handlers for the ArsDigita Templating System
# Copyright (C) 1999-2000 ArsDigita Corporation
-# Authors: Karl Goldstein (karlg@arsdigita.com)
-# Stanislav Freidin (sfreidin@arsdigita.com)
+# Authors: Karl Goldstein (karlg@arsdigita.com)
+# Stanislav Freidin (sfreidin@arsdigita.com)
# Christian Brechbuehler (chrisitan@arsdigita.com)
# $Id$
@@ -13,208 +13,236 @@
ad_proc -private template_tag_if_condition { chunk params condition_type } {
- set condition "$condition_type \{"
+ set condition "$condition_type \{"
- # parse simplified conditional expression
- set args [template_tag_if_concat_params $params]
+ # parse simplified conditional expression
+ set args [template_tag_if_concat_params $params]
- if [catch {
+ if [catch {
- while { 1 } {
+ while { 1 } {
- # process the conditional expression
- template_tag_if_interp_expr
+ # process the conditional expression
+ template_tag_if_interp_expr
- # Stop when we run out of args
- if { [llength $args] == 0 } { break }
+ # Stop when we run out of args
+ if { [llength $args] == 0 } { break }
- set conjunction [lindex $args 0]
+ set conjunction [lindex $args 0]
- switch $conjunction {
-
- and { append condition " && " }
- or { append condition " || " }
+ switch $conjunction {
+
+ and { append condition " && " }
+ or { append condition " || " }
- default {
- error "Invalid conjunction $conjunction in
+ default {
+ error "Invalid conjunction $conjunction in
$condition_type tag"
- }
- }
-
- set args [lrange $args 1 end]
- }
+ }
+ }
+
+ set args [lrange $args 1 end]
+ }
- } errorMsg] {
+ } errorMsg] {
- set condition "$condition_type \{ 1 "
- set chunk $errorMsg
- }
+ set condition "$condition_type \{ 1 "
+ set chunk $errorMsg
+ }
- append condition "\} \{"
+ append condition "\} \{"
- switch $condition_type {
- if {template::adp_append_code $condition}
- elseif {template::adp_append_code $condition -nobreak}
- }
+ switch $condition_type {
+ if {template::adp_append_code $condition}
+ elseif {template::adp_append_code $condition -nobreak}
+ }
- # Done evaluating condition; evaluate body
- template::adp_compile_chunk $chunk
+ # Done evaluating condition; evaluate body
+ template::adp_compile_chunk $chunk
- # Add closing code
- template::adp_append_code "\}"
+ # Add closing code
+ template::adp_append_code "\}"
}
ad_proc -public template_tag_if_concat_params { params } {
- append all the tags together and then eval as a list to restore
- quotes
+ append all the tags together and then eval as a list to restore
+ quotes
} {
- set size [ns_set size $params]
+ set size [ns_set size $params]
- for { set i 0 } { $i < $size } { incr i } {
- set key [ns_set key $params $i]
- set value [ns_set value $params $i]
- if {$key eq $value} {
- lappend tokens $key
- } else {
- lappend tokens "$key=$value"
- }
- }
+ for { set i 0 } { $i < $size } { incr i } {
+ set key [ns_set key $params $i]
+ set value [ns_set value $params $i]
+ if {$key eq $value} {
+ lappend tokens $key
+ } else {
+ lappend tokens "$key=$value"
+ }
+ }
- # LARS: The 'eval' statement here breaks if any key or value above contains a semicolon,
- # since this causes eval to treat whatever comes after the semicolon as a new command.
- # I'm not sure why we need to eval here at all, there ought to be another solution,
- # but it's not clear what the intention of below statement is.
+ # LARS: The 'eval' statement here breaks if any key or value above contains a semicolon,
+ # since this causes eval to treat whatever comes after the semicolon as a new command.
+ # I'm not sure why we need to eval here at all, there ought to be another solution,
+ # but it's not clear what the intention of below statement is.
- #set tokens [eval [concat list [join $tokens " "]]]
- set tokens [join $tokens " "]
+ #set tokens [eval [concat list [join $tokens " "]]]
+ set tokens [join $tokens " "]
- return $tokens
+ return $tokens
}
+ad_proc -private template_tag_subst_reference {arg} {
+ substitute variable references
+ @return variable name
+} {
+ if { [regsub {^"@([a-zA-Z0-9_]+)\.([a-zA-Z0-9_.]+)@"$} $arg {\1(\2)} arg1] } {
+ } elseif { [regsub {^"@([a-zA-Z0-9_:]+)@"$} $arg {\1} arg1] } {
+ } else {
+ set arg1 ""
+ }
+ return $arg1
+}
+
+
ad_proc -public template_tag_if_interp_expr {} {
- Interpret an expression as part of the simplified IF syntax
+ Interpret an expression as part of the simplified IF syntax
} {
- upvar args args condition condition
+ upvar args args condition condition
- # append condition "\[expr "
+ # append condition "\[expr "
- set op [lindex $args 1]
+ set op [lindex $args 1]
- if { $op eq "not" } {
- append condition "! ("
- set close_paren ")"
- set op [lindex $args 2]
- set i 3
- } else {
- set close_paren ""
- set i 2
- }
+ if { $op eq "not" } {
+ #
+ # Optimize common case "@arg@ no nil"
+ #
+ set op [lindex $args 2]
+ set arg1 \"[lindex $args 0]\"
+ if {$op eq "nil" && [string first @ $arg1] > -1} {
+ set arg1 [template_tag_subst_reference $arg1]
+ append condition "\[info exists $arg1\] && \${$arg1} ne {}"
+ set args [lrange $args 3 end]
+ return
+ } else {
+ append condition "! ("
+ set close_paren ")"
+ }
+ set i 3
+ } else {
+ set close_paren ""
+ set i 2
+ }
- set arg1 "\"[lindex $args 0]\""
+ set arg1 "\"[lindex $args 0]\""
- # build the conditional expression
+ # build the conditional expression
- switch $op {
+ switch $op {
- gt {
- append condition "$arg1 > \"[lindex $args $i]\""
- set next [expr {$i + 1}]
- }
- ge {
- append condition "$arg1 >= \"[lindex $args $i]\""
- set next [expr {$i + 1}]
- }
- lt {
- append condition "$arg1 < \"[lindex $args $i]\""
- set next [expr {$i + 1}]
- }
- le {
- append condition "$arg1 <= \"[lindex $args $i]\""
- set next [expr {$i + 1}]
- }
- eq {
- append condition "$arg1 eq \"[lindex $args $i]\""
- set next [expr {$i + 1}]
- }
- ne {
- append condition "$arg1 ne \"[lindex $args $i]\""
- set next [expr {$i + 1}]
- }
+ gt {
+ append condition "$arg1 > \"[lindex $args $i]\""
+ set next [expr {$i + 1}]
+ }
+ ge {
+ append condition "$arg1 >= \"[lindex $args $i]\""
+ set next [expr {$i + 1}]
+ }
+ lt {
+ append condition "$arg1 < \"[lindex $args $i]\""
+ set next [expr {$i + 1}]
+ }
+ le {
+ append condition "$arg1 <= \"[lindex $args $i]\""
+ set next [expr {$i + 1}]
+ }
+ eq {
+ append condition "$arg1 eq \"[lindex $args $i]\""
+ set next [expr {$i + 1}]
+ }
+ ne {
+ append condition "$arg1 ne \"[lindex $args $i]\""
+ set next [expr {$i + 1}]
+ }
- in {
- set expr "^([join [lrange $args $i end] "|"])\$"
- append condition "\[regexp \"$expr\" $arg1\] "
- set next [llength $args]
- }
+ in {
+ set expr "^([join [lrange $args $i end] "|"])\$"
+ append condition "\[regexp \"$expr\" $arg1\] "
+ set next [llength $args]
+ }
- between {
- set expr1 "$arg1 >= \"[lindex $args $i]\""
- set expr2 "$arg1 <= \"[lindex $args [expr {$i + 1}]]\""
- append condition "($expr1 && $expr2)"
- set next [expr {$i + 2}]
- }
+ between {
+ set expr1 "$arg1 >= \"[lindex $args $i]\""
+ set expr2 "$arg1 <= \"[lindex $args $i+1]\""
+ append condition "($expr1 && $expr2)"
+ set next [expr {$i + 2}]
+ }
- nil {
- if { [string first @ $arg1] == -1 } {
- # We're assuming this is a static string, not a variable
- append condition "$arg1 eq {}"
- } else {
- # substitute array variables
- if {! ( [regsub {^"@([a-zA-Z0-9_]+)\.([a-zA-Z0-9_.]+)(;\w+)?@"$} $arg1 {\1(\2)} arg1]
- || [regsub {^"@([a-zA-Z0-9_:]+)(;\w+)?@"$} $arg1 {\1} arg1] ) } {
- error "IF tag nil test uses string not variable for $arg1"
+ nil {
+ if { [string first @ $arg1] == -1 } {
+ # We're assuming this is a static string, not a variable
+ append condition "$arg1 eq {}"
+ } else {
+ set arg [template_tag_subst_reference $arg1]
+ if {$arg eq ""} {
+ error "IF tag nil test uses string not variable for $arg1"
+ }
+ #append condition "\[template::util::is_nil $arg\]"
+ append condition "!\[info exists $arg\] || \${$arg} eq {}"
+ }
+ set next $i
}
- append condition "\[template::util::is_nil $arg1\]"
- }
- set next $i
- }
- defined {
- # substitute variable references
- if { ! ( [regsub {^"@([a-zA-Z0-9_]+)\.([a-zA-Z0-9_.]+)@"$} $arg1 {\1(\2)} arg1]
- || [regsub {^"@([a-zA-Z0-9_:]+)@"$} $arg1 {\1} arg1] )} {
- error "IF tag defined test uses string not variable for $arg1"
- }
+ defined {
+ # substitute variable references
+ if { ! ( [regsub {^"@([a-zA-Z0-9_]+)\.([a-zA-Z0-9_.]+)@"$} $arg1 {\1(\2)} arg1]
+ || [regsub {^"@([a-zA-Z0-9_:]+)@"$} $arg1 {\1} arg1] )} {
+ error "IF tag defined test uses string not variable for $arg1"
+ }
- append condition "\[info exists $arg1\]"
- set next $i
- }
+ append condition "\[info exists $arg1\]"
+ set next $i
+ }
- odd {
- append condition "\[expr {$arg1 % 2}\]"
- set next $i
- }
+ odd {
+ append condition "\[expr {$arg1 % 2}\]"
+ set next $i
+ }
- even {
- append condition "! \[expr {$arg1 % 2}\]"
- set next $i
- }
-
- true {
- append condition "\[template::util::is_true $arg1\]"
- set next $i
- }
-
- false {
- append condition "!\[template::util::is_true $arg1\]"
- set next $i
- }
+ even {
+ append condition "! \[expr {$arg1 % 2}\]"
+ set next $i
+ }
+
+ true {
+ append condition "\[template::util::is_true $arg1\]"
+ set next $i
+ }
+
+ false {
+ append condition "!\[template::util::is_true $arg1\]"
+ set next $i
+ }
- default {
- # treat as a shortcut for
- append condition "\[template::util::is_true $arg1\]"
- set next [expr {$i - 1}]
+ default {
+ # treat as a shortcut for
+ append condition "\[template::util::is_true $arg1\]"
+ set next [expr {$i - 1}]
+ }
}
- }
- append condition $close_paren
- # append condition "]"
+ append condition $close_paren
+ # append condition "]"
- set args [lrange $args $next end]
+ set args [lrange $args $next end]
}
-# Local Variables:
-# tcl-indent-level: 2
+#
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 4
+# indent-tabs-mode: nil
# End:
+