Index: openacs-4/packages/acs-templating/tcl/parse-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/parse-procs.tcl,v diff -u -r1.48.2.7 -r1.48.2.8 --- openacs-4/packages/acs-templating/tcl/parse-procs.tcl 14 Oct 2013 06:02:38 -0000 1.48.2.7 +++ openacs-4/packages/acs-templating/tcl/parse-procs.tcl 7 Jul 2014 19:13:08 -0000 1.48.2.8 @@ -1,63 +1,63 @@ ad_library { - ADP to Tcl Compiler for the ArsDigita Templating System, - Based on the original ADP to Tcl compiler by Jon Salz (jsalz@mit.edu) + ADP to Tcl Compiler for the ArsDigita Templating System, + Based on the original ADP to Tcl compiler by Jon Salz (jsalz@mit.edu) - Copyright (C) 1999-2000 ArsDigita Corporation + Copyright (C) 1999-2000 ArsDigita Corporation - This is free software distributed under the terms of the GNU Public - License. Full text of the license is available from the GNU Project: - http://www.fsf.org/copyleft/gpl.html + This is free software distributed under the terms of the GNU Public + License. Full text of the license is available from the GNU Project: + http://www.fsf.org/copyleft/gpl.html - @author Karl Goldstein - @author Stanislav Freidin + @author Karl Goldstein + @author Stanislav Freidin - @cvs-id $Id$ + @cvs-id $Id$ } namespace eval template {} ad_proc -public template::adp_include { - {-uplevel 1} - src - varlist + {-uplevel 1} + src + varlist } { - return a the output of a tcl/adp pair as a string. adp_level is - set to the calling procedure so that pass by reference works. - and example of using this is in the search indexer for various content - types: -
+ return a the output of a tcl/adp pair as a string. adp_level is + set to the calling procedure so that pass by reference works. + and example of using this is in the search indexer for various content + types: +- The [list &book "bookdata" ...] tells adp_include to pass the book array by reference to the adp include, where it is - refered to via @book.field@. + The [list &book "bookdata" ...] tells adp_include to pass the book array by reference to the adp include, where it is + refered to via @book.field@. - @param uplevel how far up the stack should the adp_level be set to - (default is the calling procedures level) - @param src should be the path to the tcl/adp pair relative to the server root, as - with the src attribute to the include tag. - @param varlist a list of {key value key value ... } varlist can also be &var foo - for things passed by reference (arrays and multirows) + @param uplevel how far up the stack should the adp_level be set to + (default is the calling procedures level) + @param src should be the path to the tcl/adp pair relative to the server root, as + with the src attribute to the include tag. + @param varlist a list of {key value key value ... } varlist can also be &var foo + for things passed by reference (arrays and multirows) - @return the string generated by the tcl/adp pair. + @return the string generated by the tcl/adp pair. - @author Jeff Davis davis@xarg.net - @creation-date 2004-06-02 + @author Jeff Davis davis@xarg.net + @creation-date 2004-06-02 - @see template::adp_parse + @see template::adp_parse } { - # set the stack frame at which the template is being parsed so that - # other procedures can reference variables cleanly - lappend ::template::parse_level [expr {[info level] - $uplevel}] + # set the stack frame at which the template is being parsed so that + # other procedures can reference variables cleanly + lappend ::template::parse_level [expr {[info level] - $uplevel}] - set __adp_out [template::adp_parse [template::util::url_to_file $src] $varlist] + set __adp_out [template::adp_parse [template::util::url_to_file $src] $varlist] - # pop off parse level - template::util::lpop ::template::parse_level + # pop off parse level + template::util::lpop ::template::parse_level - return $__adp_out + return $__adp_out } ad_proc -private template::adp_parse { __adp_stub __args } { @@ -67,180 +67,180 @@ strings from adp files. @param __adp_stub The root (without the file extension) of the - absolute path to the template and associated code. + absolute path to the template and associated code. @param __args One list containing any number of key-value pairs - passed to an included template from its container. - All data sources may be passed by reference. - @see template::adp_include + passed to an included template from its container. + All data sources may be passed by reference. + @see template::adp_include } { - # declare any variables passed in to an include or master - # TODO: call adp_set_vars instead. + # declare any variables passed in to an include or master + # TODO: call adp_set_vars instead. - foreach {__key __value} $__args { - if {[string match "&*" $__key]} { # "&" triggers call by reference - if {"&" ne $__key } { - set __name [string range $__key 1 end] - } else { - set __name $__value - } - upvar \#[adp_level] $__value $__name \ - $__value:rowcount $__name:rowcount \ - $__value:columns $__name:columns - # upvar :rowcount and :columns just in case it is a multirow - if { [info exists $__name:rowcount] } { - for { set __i 0 } { $__i <= [set $__name:rowcount] } { incr __i } { - upvar \#[adp_level] $__value:$__i $__name:$__i - } - } - } else { # not "&" => normal arg (no reference) - set $__key $__value + foreach {__key __value} $__args { + if {[string match "&*" $__key]} { # "&" triggers call by reference + if {"&" ne $__key } { + set __name [string range $__key 1 end] + } else { + set __name $__value + } + upvar \#[adp_level] $__value $__name \ + $__value:rowcount $__name:rowcount \ + $__value:columns $__name:columns + # upvar :rowcount and :columns just in case it is a multirow + if { [info exists $__name:rowcount] } { + for { set __i 0 } { $__i <= [set $__name:rowcount] } { incr __i } { + upvar \#[adp_level] $__value:$__i $__name:$__i + } + } + } else { # not "&" => normal arg (no reference) + set $__key $__value + } } - } - - # set the stack frame at which the template is being parsed so that - # other procedures can reference variables cleanly - lappend ::template::parse_level [info level] - - # execute the code to prepare the data sources for a template - set return_code [catch { - set found_script_p [adp_prepare] + + # set the stack frame at which the template is being parsed so that + # other procedures can reference variables cleanly + lappend ::template::parse_level [info level] + + # execute the code to prepare the data sources for a template + set return_code [catch { + set found_script_p [adp_prepare] - # if we get here, adp_prepare ran without throwing an error. + # if we get here, adp_prepare ran without throwing an error. - # initialize the ADP output - set __adp_output "" + # initialize the ADP output + set __adp_output "" - set mime_type [get_mime_type] - set template_extension [get_mime_template_extension $mime_type] + set mime_type [get_mime_type] + set template_extension [get_mime_template_extension $mime_type] - # generate ADP output if a template exists (otherwise assume plain Tcl page) + # generate ADP output if a template exists (otherwise assume plain Tcl page) - set templated_p 0 - if { [ad_conn locale] ne "" - && [file exists "$__adp_stub.[ad_conn locale].$template_extension"]} { - # it's a localized version of a templated page - set templated_p 1 - append __adp_stub ".[ad_conn locale]" - } elseif {[file exists "$__adp_stub.$template_extension"]} { - # it's a regular templated page - set templated_p 1 - } + set templated_p 0 + if { [ad_conn locale] ne "" + && [file exists "$__adp_stub.[ad_conn locale].$template_extension"]} { + # it's a localized version of a templated page + set templated_p 1 + append __adp_stub ".[ad_conn locale]" + } elseif {[file exists "$__adp_stub.$template_extension"]} { + # it's a regular templated page + set templated_p 1 + } - if { [info commands ::ds_page_fragment_cache_enabled_p] ne "" - && [::ds_enabled_p] - && [::ds_page_fragment_cache_enabled_p] - && [::ds_collection_enabled_p] } { - ns_cache get ds_page_bits [ad_conn request] template_list - lappend template_list $__adp_stub.$template_extension - ns_cache set ds_page_bits [ad_conn request] $template_list - } + if { [info commands ::ds_page_fragment_cache_enabled_p] ne "" + && [::ds_enabled_p] + && [::ds_page_fragment_cache_enabled_p] + && [::ds_collection_enabled_p] } { + ns_cache get ds_page_bits [ad_conn request] template_list + lappend template_list $__adp_stub.$template_extension + ns_cache set ds_page_bits [ad_conn request] $template_list + } - if { $templated_p } { + if { $templated_p } { - # ensure that template output procedure exists and is up-to-date - template::adp_init $template_extension $__adp_stub + # ensure that template output procedure exists and is up-to-date + template::adp_init $template_extension $__adp_stub - # get result of template output procedure into __adp_output, and properties into __adp_properties - template::code::${template_extension}::$__adp_stub + # get result of template output procedure into __adp_output, and properties into __adp_properties + template::code::${template_extension}::$__adp_stub - # JCD: Lets keep a copy of all the page fragments! WooHoo. - if { [info commands ::ds_page_fragment_cache_enabled_p] ne "" - && [::ds_enabled_p] - && [::ds_page_fragment_cache_enabled_p] - && [::ds_collection_enabled_p] } { - ns_cache set ds_page_bits "[ad_conn request]:$__adp_stub.$template_extension" $__adp_output - } + # JCD: Lets keep a copy of all the page fragments! WooHoo. + if { [info commands ::ds_page_fragment_cache_enabled_p] ne "" + && [::ds_enabled_p] + && [::ds_page_fragment_cache_enabled_p] + && [::ds_collection_enabled_p] } { + ns_cache set ds_page_bits "[ad_conn request]:$__adp_stub.$template_extension" $__adp_output + } - # call the master template if one has been defined - if { [info exists __adp_master] } { - # pass properties on to master template - set __adp_output [template::adp_parse $__adp_master \ - [concat [list __adp_slave $__adp_output] [array get __adp_properties]]] - } - } else { - # no template; found_script_p tells us if adp_prepare at least found a script. - if { !$found_script_p } { - # No template. Perhaps there is an html file. - if { [file exists $__adp_stub.html] } { - ns_log debug "getting output from ${__adp_stub}.html" - set __adp_output [template::util::read_file "${__adp_stub}.html"] - } elseif { [file exists $__adp_stub.htm] } { - ns_log debug "getting output from ${__adp_stub}.htm" - set __adp_output [template::util::read_file "${__adp_stub}.htm"] + # call the master template if one has been defined + if { [info exists __adp_master] } { + # pass properties on to master template + set __adp_output [template::adp_parse $__adp_master \ + [concat [list __adp_slave $__adp_output] [array get __adp_properties]]] + } } else { - error "No script or template found for page '$__adp_stub'" + # no template; found_script_p tells us if adp_prepare at least found a script. + if { !$found_script_p } { + # No template. Perhaps there is an html file. + if { [file exists $__adp_stub.html] } { + ns_log debug "getting output from ${__adp_stub}.html" + set __adp_output [template::util::read_file "${__adp_stub}.html"] + } elseif { [file exists $__adp_stub.htm] } { + ns_log debug "getting output from ${__adp_stub}.htm" + set __adp_output [template::util::read_file "${__adp_stub}.htm"] + } else { + error "No script or template found for page '$__adp_stub'" + } + } } - } - } - return $__adp_output ; # empty in non-templated page - } return_value] + return $__adp_output ; # empty in non-templated page + } return_value] - set s_errorInfo $::errorInfo - set s_errorCode $::errorCode + set s_errorInfo $::errorInfo + set s_errorCode $::errorCode - # Always pop off the parse_level no matter how we exit - template::util::lpop ::template::parse_level + # Always pop off the parse_level no matter how we exit + template::util::lpop ::template::parse_level - switch $return_code { - 0 - 2 { - # CODE executed without a non-local exit -- return what it - # evaluated to. - return $return_value + switch $return_code { + 0 - 2 { + # CODE executed without a non-local exit -- return what it + # evaluated to. + return $return_value + } + 1 { + # Error + return -code error -errorinfo $s_errorInfo -errorcode $s_errorCode $return_value + } + default { + if {$return_value eq "ADP_ABORT"} { + # return without rendering any HTML if the code aborts + return "" + } else { + return -code $return_code $return_value + } + } } - 1 { - # Error - return -code error -errorinfo $s_errorInfo -errorcode $s_errorCode $return_value - } - default { - if {$return_value eq "ADP_ABORT"} { - # return without rendering any HTML if the code aborts - return "" - } else { - return -code $return_code $return_value - } - } - } } ad_proc -private template::adp_set_vars {} { Set variables passes from a container template, including onerow and multirow data sources. This code must be executed in the same stack frame as adp_parse, but is in a separate proc to improve code readability. } { - uplevel { - set __adp_level [adp_level 2] - foreach {__adp_key __adp_value} $args { + uplevel { + set __adp_level [adp_level 2] + foreach {__adp_key __adp_value} $args { - set __adp_expr {^@([A-Za-z0-9_]+)\.\*@$} - if { [regexp $__adp_expr $__adp_value __adp_x __adp_name] } { + set __adp_expr {^@([A-Za-z0-9_]+)\.\*@$} + if { [regexp $__adp_expr $__adp_value __adp_x __adp_name] } { - upvar #$__adp_level $__adp_name $__adp_key - if { ! [array exists $__adp_key] } { + upvar #$__adp_level $__adp_name $__adp_key + if { ! [array exists $__adp_key] } { - upvar #$__adp_level $__adp_name:rowcount $__adp_key:rowcount + upvar #$__adp_level $__adp_name:rowcount $__adp_key:rowcount - if { [info exists $__adp_key:rowcount] } { + if { [info exists $__adp_key:rowcount] } { - set size [set $__adp_key:rowcount] + set size [set $__adp_key:rowcount] - for { set i 1 } { $i <= [set $__adp_key:rowcount] } { incr i } { - upvar #$__adp_level $__adp_name:$i $__adp_key:$i - } - } - } - } else { - set $__adp_key $__adp_value - } + for { set i 1 } { $i <= [set $__adp_key:rowcount] } { incr i } { + upvar #$__adp_level $__adp_name:$i $__adp_key:$i + } + } + } + } else { + set $__adp_key $__adp_value + } + } } - } } # Terminates processing of a template and throws away all output. ad_proc -public template::adp_abort {} { - Terminates processing of a template and throws away all output. + Terminates processing of a template and throws away all output. } { - error ADP_ABORT + error ADP_ABORT } ad_proc -public template::adp_eval { coderef } { @@ -250,13 +250,13 @@ @return The output produced by the compiled template code. } { - upvar $coderef code __adp_output output - lappend ::template::parse_level [expr {[info level]-1}] + upvar $coderef code __adp_output output + lappend ::template::parse_level [expr {[info level]-1}] - uplevel $code + uplevel $code - template::util::lpop ::template::parse_level - return $output + template::util::lpop ::template::parse_level + return $output } ad_proc -public template::adp_level { { up "" } } { @@ -265,36 +265,36 @@ as well template objects such as forms and wizards @param up A relative reference to the "parse level" of interest. - Useful in the context of an included template to reach into the - stack frame in which the container template is being parsed, for - accessing data sources or other objects. The default is the - highest parse level. + Useful in the context of an included template to reach into the + stack frame in which the container template is being parsed, for + accessing data sources or other objects. The default is the + highest parse level. @return A number, as returned by [info level], representing the stack frame - in which a template is being parsed. + in which a template is being parsed. } { - set result "" + set result "" - # when serving a page, this variable is always defined. - # but we need to check it for the case of isolated compilation + # when serving a page, this variable is always defined. + # but we need to check it for the case of isolated compilation - if { [info exists ::template::parse_level] } { - if {$up eq ""} { - set result [lindex $::template::parse_level end] - } else { - set result [lindex $::template::parse_level [llength $::template::parse_level]-$up] + if { [info exists ::template::parse_level] } { + if {$up eq ""} { + set result [lindex $::template::parse_level end] + } else { + set result [lindex $::template::parse_level [llength $::template::parse_level]-$up] + } } - } - return $result + return $result } ad_proc -public template::adp_levels {} { @return all stack frame levels } { - if { [info exists ::template::parse_level] } {return $::template::parse_level} - return "" + if { [info exists ::template::parse_level] } {return $::template::parse_level} + return "" } ad_proc -private template::adp_prepare {} { @@ -307,55 +307,55 @@ @return boolean (0 or 1): whether the (ultimate) script was found. } { - uplevel { + uplevel { - if { [file exists $__adp_stub.tcl] } { + if { [file exists $__adp_stub.tcl] } { - # ensure that data source preparation procedure exists and is up-to-date - adp_init tcl $__adp_stub + # ensure that data source preparation procedure exists and is up-to-date + adp_init tcl $__adp_stub - # remember the file_stub in case the procedure changes it - set __adp_remember_stub $__adp_stub + # remember the file_stub in case the procedure changes it + set __adp_remember_stub $__adp_stub - # execute data source preparation procedure - code::tcl::$__adp_stub + # execute data source preparation procedure + code::tcl::$__adp_stub - # propagate aborting - if {[info exists ::request_aborted]} { - ns_log warning "propagating abortion from $__adp_remember_stub.tcl\ + # propagate aborting + if {[info exists ::request_aborted]} { + ns_log warning "propagating abortion from $__adp_remember_stub.tcl\ (status [lindex $::request_aborted 0]): '[lindex $::request_aborted 1]')" - unset ::request_aborted - ad_script_abort - #adp_abort + unset ::request_aborted + ad_script_abort + #adp_abort + return 0 + } + + # if the file has changed than prepare again + if { $__adp_stub ne $__adp_remember_stub } { + adp_prepare; # propagate result up + } { return 1 } + } return 0 - } - - # if the file has changed than prepare again - if { $__adp_stub ne $__adp_remember_stub } { - adp_prepare; # propagate result up - } { return 1 } } - return 0 - } } ad_proc -public template::set_file { path } { Set the path of the template to render. This is typically used to implement multiple "skins" on a common set of data sources. The initial code (which may be in a .tcl file not associated with a .adp - file) sets up any number of data sources, and then calls set_file to + file) sets up any number of data sources, and then calls set_file to specify the template to actually render. Any code associated with the specified template is executed in the same stack frame as the initial code, so that each "skin" may reference additional specific data or logic as necessary. @param path The root (sans file extension) of the absolute path to the - next template to parse. + next template to parse. } { - set level [adp_level] + set level [adp_level] - upvar #$level __adp_stub file_stub - set file_stub $path + upvar #$level __adp_stub file_stub + set file_stub $path } ad_proc -private template::adp_init { type file_stub } { @@ -368,50 +368,50 @@ @param type Either adp (template) or tcl (code) @param file_stub The root (sans file extension) of the absolute path - to the .adp or .tcl file to source. + to the .adp or .tcl file to source. } { - # this will return the name of the proc if it exists - set proc_name [info commands ::template::mtimes::${type}::$file_stub] + # this will return the name of the proc if it exists + set proc_name [info commands ::template::mtimes::${type}::$file_stub] - set pkg_id [apm_package_id_from_key acs-templating] - set refresh_cache [parameter::get -package_id $pkg_id -parameter RefreshCache -default "as needed"] + set pkg_id [apm_package_id_from_key acs-templating] + set refresh_cache [parameter::get -package_id $pkg_id -parameter RefreshCache -default "as needed"] - if {$proc_name eq "" || $refresh_cache ne "never" } { - set mtime [file mtime $file_stub.$type] - if {$proc_name eq "" - || $mtime != [$proc_name] - || $refresh_cache eq "always"} { + if {$proc_name eq "" || $refresh_cache ne "never" } { + set mtime [file mtime $file_stub.$type] + if {$proc_name eq "" + || $mtime != [$proc_name] + || $refresh_cache eq "always"} { - # either the procedure does not already exist or is not up-to-date + # either the procedure does not already exist or is not up-to-date - switch -exact $type { + switch -exact $type { - tcl { - set code [template::util::read_file $file_stub.tcl] - } - default { - set code [adp_compile -file $file_stub.$type] - } - } + tcl { + set code [template::util::read_file $file_stub.tcl] + } + default { + set code [adp_compile -file $file_stub.$type] + } + } - # wrap the code for both types of files within an uplevel in - # the declared procedure, so that data sources are set in the - # same frame as the code that outputs the template. + # wrap the code for both types of files within an uplevel in + # the declared procedure, so that data sources are set in the + # same frame as the code that outputs the template. - # Here we add profiling calls if developer support exists on the - # system. - if {[info commands ::ds_enabled_p] ne ""} { - proc ::template::code::${type}::$file_stub {} "if {\[::ds_enabled_p\] && \[::ds_collection_enabled_p\] && \[::ds_profiling_enabled_p\]} { ds_profile start $file_stub.$type } + # Here we add profiling calls if developer support exists on the + # system. + if {[info commands ::ds_enabled_p] ne ""} { + proc ::template::code::${type}::$file_stub {} "if {\[::ds_enabled_p\] && \[::ds_collection_enabled_p\] && \[::ds_profiling_enabled_p\]} { ds_profile start $file_stub.$type } uplevel { -$code + $code } if {\[::ds_enabled_p\] && \[::ds_collection_enabled_p\] &&\[::ds_profiling_enabled_p\]} { ds_profile stop $file_stub.$type }\n" } else { proc ::template::code::${type}::$file_stub {} " - uplevel { - $code - }\n" +uplevel { + $code +}\n" } proc ::template::mtimes::${type}::$file_stub {} "return $mtime" @@ -420,216 +420,206 @@ } ad_proc -public template::expand_percentage_signs { message } { - Expand variables marked with percentage signs in caller's scope. + Expand variables marked with percentage signs in caller's scope. - Some examples - if example and array(variable) has the values Erik - and Oluf in the caller's scope - the following expansion will occur: + Some examples - if example and array(variable) has the values Erik + and Oluf in the caller's scope - the following expansion will occur: Here is an %example% variable. -> Here is an Erik variable. Here is an %array.variable% for you -> Here is an Oluf for you - author Christian Hvid + author Christian Hvid } { - set remaining_message $message - set formatted_message "" - while { [regexp [lang::message::embedded_vars_regexp] $remaining_message match before_percent percent_match remaining_message] } { - append formatted_message $before_percent + set remaining_message $message + set formatted_message "" + while { [regexp [lang::message::embedded_vars_regexp] $remaining_message match before_percent percent_match remaining_message] } { + append formatted_message $before_percent - if {$percent_match eq "%%"} { - # A quoted percentage sing - set substitution "%" - } else { - # An embedded variable + if {$percent_match eq "%%"} { + # A quoted percentage sing + set substitution "%" + } else { + # An embedded variable - # Remove any noquote instruction - set quote_p 1 - if { [regsub {;noquote} $percent_match {} substitution] } { - # We removed a noquote instruction so don't quote - set quote_p 0 - } + # Remove any noquote instruction + set quote_p 1 + if { [regsub {;noquote} $percent_match {} substitution] } { + # We removed a noquote instruction so don't quote + set quote_p 0 + } - # Convert syntax to TCL syntax: - # It's either an array variable or a tcl variable - # array variables - # TODO: ad_quotehtml - # TODO: lang::util::localize - regsub -all {[\]\[\{\}\"]\\$} $substitution {\\&} substitution - if { [regexp {^%([a-zA-Z0-9_]+)\.([a-zA-Z0-9_]+)%$} $substitution match arr key] } { - # the array key name is substitured by the tcl parser s - regsub -all {[\]\[\{\}\"]\\$} $key {\\&} key - set command "set ${arr}(${key})" - set substitution [uplevel $command] - } - if { [regexp {^%([a-zA-Z0-9_:]+)%$} $substitution match var] } { - set command "set $var" - set substitution [uplevel $command] - } + # Convert syntax to TCL syntax: + # It's either an array variable or a tcl variable + # array variables + # TODO: ad_quotehtml + # TODO: lang::util::localize + regsub -all {[\]\[\{\}\"]\\$} $substitution {\\&} substitution + if { [regexp {^%([a-zA-Z0-9_]+)\.([a-zA-Z0-9_]+)%$} $substitution match arr key] } { + # the array key name is substitured by the tcl parser s + regsub -all {[\]\[\{\}\"]\\$} $key {\\&} key + set command "set ${arr}(${key})" + set substitution [uplevel $command] + } + if { [regexp {^%([a-zA-Z0-9_:]+)%$} $substitution match var] } { + set command "set $var" + set substitution [uplevel $command] + } + } + + append formatted_message $substitution } - append formatted_message $substitution - } + append formatted_message $remaining_message - append formatted_message $remaining_message - - return $formatted_message - - -# - - - - - - + return $formatted_message } ad_proc -public template::adp_compile { source_type source } { Converts an ADP template into a chunk of Tcl code. Caching this code avoids the need to reparse the ADP template with each request. @param source_type Indicates the source of the Tcl code to compile. - Valid options are -string or -file - @param source A string containing either the template itself (for - -string) or the path to the file containing the - template (for -file) + Valid options are -string or -file + @param source A string containing either the template itself + (for -string) or the path to the file containing the template (for -file) @return The compiled code. } { - variable parse_list - # initialize the compiled code - set parse_list [list "set __adp_output {}; set __ad_conn_locale \[ad_conn locale\]"] + variable parse_list + # initialize the compiled code + set parse_list [list "set __adp_output {}; set __ad_conn_locale \[ad_conn locale\]"] - switch -exact -- $source_type { - -file { set chunk [template::util::read_file $source] } - -string { set chunk $source } - default { error "Source type must be -string or -file" } - } + switch -exact -- $source_type { + -file { set chunk [template::util::read_file $source] } + -string { set chunk $source } + default { error "Source type must be -string or -file" } + } - # substitute <% ... %> blocks with registered tags so they can be handled - # by our proc rather than evaluated. + # substitute <% ... %> blocks with registered tags so they can be handled + # by our proc rather than evaluated. - regsub -all {<%} $chunk {bookshelf::book::get -book_id $book_id -array bookdata set body [template::adp_include /packages/bookshelf/lib/one-book \ - [list &book "bookdata" base $base style feed]] -+ [list &book "bookdata" base $base style feed]] +
- set tag [template::enclosing_tag <tag-type>] - set attribute [template::tag_attribute tag <attribute>] + set tag [template::enclosing_tag <tag-type>] + set attribute [template::tag_attribute tag <attribute>]@param tag The name of the enclosing tag to look for. - @see template::enclosing_tag - @see template::tag_attribute + @see template::enclosing_tag + @see template::tag_attribute } { - set name "" + set name "" - variable tag_stack + variable tag_stack - set last [expr {[llength $tag_stack] - 1}] + set last [expr {[llength $tag_stack] - 1}] - for { set i $last } { $i >= 0 } { incr i -1 } { + for { set i $last } { $i >= 0 } { incr i -1 } { - set pair [lindex $tag_stack $i] + set pair [lindex $tag_stack $i] - if {[lindex $pair 0] eq $tag} { - set name [ns_set get [lindex $pair 1] name] - break + if {[lindex $pair 0] eq $tag} { + set name [ns_set get [lindex $pair 1] name] + break + } } - } - return $name + return $name } ad_proc -private template::get_attribute { tag params name { default "ERROR" } } { @@ -846,26 +836,30 @@ @param params The ns_set passed to the tag handler. @param name The name of the attribute. @param default A default value to return if the the attribute is - not specified in the template. A default value of - "ERROR" will cause the proc - to throw an error if the attribute wasn't supplied. + not specified in the template. A default value of + "ERROR" will cause the proc + to throw an error if the attribute wasn't supplied. @return The value of the attribute. } { - set value [ns_set iget $params $name] + set value [ns_set iget $params $name] - if {$value eq ""} { - if { $default eq "ERROR" } { - error "Missing [string toupper $name] property\ + if {$value eq ""} { + if { $default eq "ERROR" } { + error "Missing [string toupper $name] property\ in [string toupper $tag] tag" - } else { - set value $default + } else { + set value $default + } } - } - return $value + return $value } -# Local Variables: -# tcl-indent-level: 2 +# +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil # End: + 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.2.1 -r1.18.2.2 --- openacs-4/packages/acs-templating/tcl/tag-procs.tcl 29 Sep 2013 18:49:59 -0000 1.18.2.1 +++ openacs-4/packages/acs-templating/tcl/tag-procs.tcl 7 Jul 2014 19:13:08 -0000 1.18.2.2 @@ -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,212 @@ 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 -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" } { + append condition "! (" + set close_paren ")" + set op [lindex $args 2] + 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 $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 { + # 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" + } + append condition "\[template::util::is_nil $arg1\]" + } + 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