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 -r1.49
--- openacs-4/packages/acs-templating/tcl/parse-procs.tcl 30 Mar 2013 17:53:58 -0000 1.48
+++ openacs-4/packages/acs-templating/tcl/parse-procs.tcl 27 Oct 2014 16:40:11 -0000 1.49
@@ -1,64 +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:
+
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]]
+
- 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
- variable parse_level
- lappend 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 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 } {
@@ -68,182 +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
- variable parse_level
- lappend 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]
- global errorInfo errorCode
- 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 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 } {
@@ -253,21 +250,13 @@
@return The output produced by the compiled template code.
} {
- upvar $coderef code
+ upvar $coderef code __adp_output output
+ lappend ::template::parse_level [expr {[info level]-1}]
- eval "uplevel {
+ uplevel $code
- variable ::template::parse_level
- lappend ::template::parse_level \[info level\]
-
- $code
-
template::util::lpop ::template::parse_level
- }"
-
- upvar __adp_output output
-
- return $output
+ return $output
}
ad_proc -public template::adp_level { { up "" } } {
@@ -276,38 +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 ""
- variable parse_level
- # 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 parse_level] } {
- if {$up eq ""} {
- set result [lindex $parse_level end]
- } else {
- set result [lindex $parse_level [expr {[llength $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
} {
- variable parse_level
- if { [info exists parse_level] } {return $parse_level}
- return ""
+ if { [info exists ::template::parse_level] } {return $::template::parse_level}
+ return ""
}
ad_proc -private template::adp_prepare {} {
@@ -320,108 +307,111 @@
@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
- global request_aborted
- if {[info exists request_aborted]} {
- ns_log warning "propagating abortion from $__adp_remember_stub.tcl\
- (status [lindex $request_aborted 0]): '[lindex $request_aborted 1]')"
- adp_abort
- }
-
- # if the file has changed than prepare again
- if { $__adp_stub ne $__adp_remember_stub } {
- adp_prepare; # propagate result up
- } { return 1 }
+ # 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
+ 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
}
- 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 } {
- Ensures that both data source tcl files and compiled adp templates
+ Ensures that both data source Tcl files and compiled ADP templates
are wrapped in procedures in the current interpreter. Procedures
are cached in byte code form in the interpreter, so this is more
- efficient than sourcing a tcl file or parsing the template every
+ efficient than sourcing a Tcl file or parsing the template every
time. Also checks the modification time on the source file to
ensure that the procedure is up-to-date.
- @param type Either adp (template) or tcl (code)
+ @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"
@@ -430,250 +420,263 @@
}
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 {} chunk
- # avoid substituting when it is a percentage attribute to an HTML tag.
- regsub -all {([^0-9])%>} $chunk {\1} chunk
- # warn about the first ambiguity in the source
- if [regexp {[0-9]+%>} $chunk match] {
- ns_log warning "ambiguous '$match'; write tcl escapes with a space like\
+ regsub -all {<%} $chunk {} chunk
+ # avoid substituting when it is a percentage attribute to an HTML tag.
+ regsub -all {([^0-9])%>} $chunk {\1} chunk
+ # warn about the first ambiguity in the source
+ if [regexp {[0-9]+%>} $chunk match] {
+ ns_log warning "ambiguous '$match'; write Tcl escapes with a space like\
<% set x 50 %> and HTML tags with proper quoting, like
\
when compiling ADP source: template::adp_compile $source_type {$source}"
- }
+ }
- # recursively parse the template
- adp_compile_chunk $chunk
+ # recursively parse the template
+ adp_compile_chunk $chunk
- # ensure that code returns with the output
- lappend parse_list "set __adp_output"
+ # ensure that code returns with the output
+ lappend parse_list "set __adp_output"
- # the parse list now contains the code
- set code [join $parse_list "\n"]
+ # the parse list now contains the code
+ set code [join $parse_list "\n"]
- # Substitute #foo# message keys with values from the message catalog
+ # Substitute #foo# message keys with values from the message catalog
- # Since messages may read the variables of the adp page they go trough
- # expand_percentage_signs which amongst other things does an uplevel subst
- while {[regsub -all {([^\\])\#([-a-zA-Z0-9_:\.]+)\#} $code {\1[template::expand_percentage_signs [lang::message::lookup $__ad_conn_locale {\2} {TRANSLATION MISSING} {} -1]]} code]} {}
+ # Since messages may read the variables of the adp page they go trough
+ # expand_percentage_signs which amongst other things does an uplevel subst
+ while {[regsub -all {([^\\])\#([-a-zA-Z0-9_:\.]+)\#} $code {\1[template::expand_percentage_signs [lang::message::lookup $__ad_conn_locale {\2} {TRANSLATION MISSING} {} -1]]} code]} {}
- # We do each substitution set in two pieces, separately for normal
- # variables and for variables with ";noquote" attached to them.
- # Specifically, @x@ gets translated to [ad_quotehtml ${x}], whereas
- # @x;noquote@ gets translated to ${x}. The same goes for array
- # variable references.
+ # We do each substitution set in two pieces, separately for normal
+ # variables and for variables with ";noquote" attached to them.
+ # Specifically, @x@ gets translated to [ad_quotehtml ${x}], whereas
+ # @x;noquote@ gets translated to ${x}. The same goes for array
+ # variable references.
- # substitute array variable references
- while {[regsub -all [template::adp_array_variable_regexp_noquote] $code {\1[lang::util::localize $\2(\3)]} code]} {}
- while {[regsub -all [template::adp_array_variable_regexp_literal] $code {\1$\2(\3)} code]} {}
- while {[regsub -all [template::adp_array_variable_regexp] $code {\1[ns_quotehtml [lang::util::localize $\2(\3)]]} code]} {}
+ # substitute array variable references
+ while {[regsub -all [template::adp_array_variable_regexp_noquote] $code {\1[lang::util::localize $\2(\3)]} code]} {}
+ while {[regsub -all [template::adp_array_variable_regexp_literal] $code {\1$\2(\3)} code]} {}
+ #
+ # Some aolservers have broken implementations of ns_quotehtml
+ # (returning for the empty string input a one byte output). If this
+ # happens, we fall back to the "manual" ad_quotehtml. However, we
+ # prefer to use the faster (C-implemented) ns_quotehtml, since the
+ # actual subsitutions occur at page-view time, and they are called
+ # therefore very often.
+ #
+ if {[ns_quotehtml ""] eq ""} {
+ while {[regsub -all [template::adp_array_variable_regexp] $code {\1[ns_quotehtml [lang::util::localize $\2(\3)]]} code]} {}
+ } else {
+ while {[regsub -all [template::adp_array_variable_regexp] $code {\1[ad_quotehtml [lang::util::localize $\2(\3)]]} code]} {}
+ }
- # substitute simple variable references
- while {[regsub -all [template::adp_variable_regexp_noquote] $code {\1[lang::util::localize ${\2}]} code]} {}
- while {[regsub -all [template::adp_variable_regexp_literal] $code {\1${\2}} code]} {}
- while {[regsub -all [template::adp_variable_regexp] $code {\1[ns_quotehtml [lang::util::localize ${\2}]]} code]} {}
+ # substitute simple variable references
+ while {[regsub -all [template::adp_variable_regexp_noquote] $code {\1[lang::util::localize ${\2}]} code]} {}
+ while {[regsub -all [template::adp_variable_regexp_literal] $code {\1${\2}} code]} {}
+ if {[ns_quotehtml ""] eq ""} {
+ while {[regsub -all [template::adp_variable_regexp] $code {\1[ns_quotehtml [lang::util::localize ${\2}]]} code]} {}
+ } else {
+ while {[regsub -all [template::adp_variable_regexp] $code {\1[ad_quotehtml [lang::util::localize ${\2}]]} code]} {}
+ }
- # unescape protected # references
- # unescape protected @ references
- set code [string map { \\@ @ \\# #} $code]
+ # unescape protected # references
+ # unescape protected @ references
+ set code [string map { \\@ @ \\# #} $code]
- return $code
+ return $code
}
ad_proc -public template::adp_array_variable_regexp {} {
- The regexp pattern used to find adp array variables in
- a piece of text (i.e. @array_name.variable_name@). Captures the character preceeding
- the first @ in \1, the array_name in \2, and variable_name in \3
-
- @author Peter Marklund (peter@collaboraid.biz)
- @creation-date 25 October 2002
+ The regexp pattern used to find adp array variables in
+ a piece of text (i.e. @array_name.variable_name@). Captures the character preceeding
+ the first @ in \1, the array_name in \2, and variable_name in \3
+
+ @author Peter Marklund (peter@collaboraid.biz)
+ @creation-date 25 October 2002
} {
- return {(^|[^\\])@([a-zA-Z0-9_:]+)\.([a-zA-Z0-9_\.:]+)@}
+ return {(^|[^\\])@([a-zA-Z0-9_:]+)\.([a-zA-Z0-9_\.:]+)@}
}
ad_proc -public template::adp_array_variable_regexp_noquote {} {
- adp_array_variable_regexp's pattern augmented by "noquote"
+ adp_array_variable_regexp's pattern augmented by "noquote"
- @author Dirk Gomez (openacs@dirkgomez.de)
- @creation-date 12 February 2003
+ @author Dirk Gomez (openacs@dirkgomez.de)
+ @creation-date 12 February 2003
} {
- return {(^|[^\\])@([a-zA-Z0-9_:]+)\.([a-zA-Z0-9_:\.]+);noquote@}
+ return {(^|[^\\])@([a-zA-Z0-9_:]+)\.([a-zA-Z0-9_:\.]+);noquote@}
}
ad_proc -public template::adp_array_variable_regexp_literal {} {
- adp_array_variable_regexp's pattern augmented by "literal"
+ adp_array_variable_regexp's pattern augmented by "literal"
- @author Gustaf Neumann
- @creation-date December 2012
+ @author Gustaf Neumann
+ @creation-date December 2012
} {
- return {(^|[^\\])@([a-zA-Z0-9_:]+)\.([a-zA-Z0-9_:\.]+);literal@}
+ return {(^|[^\\])@([a-zA-Z0-9_:]+)\.([a-zA-Z0-9_:\.]+);literal@}
}
ad_proc -public template::adp_variable_regexp {} {
- The regexp pattern used to find adp variables in
- a piece of text, i.e. occurenceis of @variable_name@.
- Captures the character preceeding the first @ in \1 and
- the variable_name in \2.
+ The regexp pattern used to find adp variables in
+ a piece of text, i.e. occurenceis of @variable_name@.
+ Captures the character preceeding the first @ in \1 and
+ the variable_name in \2.
- @author Peter Marklund (peter@collaboraid.biz)
- @creation-date 25 October 2002
+ @author Peter Marklund (peter@collaboraid.biz)
+ @creation-date 25 October 2002
} {
- return {(^|[^\\])@([a-zA-Z0-9_:]+)@}
+ return {(^|[^\\])@([a-zA-Z0-9_:]+)@}
}
ad_proc -public template::adp_variable_regexp_noquote {} {
- adp_variable_regexp augmented by "noquote"
+ adp_variable_regexp augmented by "noquote"
- @author Dirk Gomez (openacs@dirkgomez.de)
- @creation-date 12 February 2003
+ @author Dirk Gomez (openacs@dirkgomez.de)
+ @creation-date 12 February 2003
} {
- return {(^|[^\\])@([a-zA-Z0-9_:]+);noquote@}
+ return {(^|[^\\])@([a-zA-Z0-9_:]+);noquote@}
}
ad_proc -public template::adp_variable_regexp_literal {} {
- adp_variable_regexp augmented by "literal"
+ adp_variable_regexp augmented by "literal"
- @author Gustaf Neumann
- @creation-date Dezember 2012
+ @author Gustaf Neumann
+ @creation-date Dezember 2012
} {
- return {(^|[^\\])@([a-zA-Z0-9_:]+);literal@}
+ return {(^|[^\\])@([a-zA-Z0-9_:]+);literal@}
}
+# Naviserver requires for disambiguation of flags and values at the
+# end of the argument processing a terminating "--" (like for other
+# commands). AOLserver does not allow the "--".
+if {[ns_info name] eq "NaviServer"} {
+ ad_proc template::adp_parse_string { chunk } {Parse string as ADP} {ns_adp_parse -string -- $chunk}
+} else {
+ ad_proc template::adp_parse_string { chunk } {Parse string as ADP} {ns_adp_parse -string $chunk}
+}
+
ad_proc -private template::adp_compile_chunk { chunk } {
Parses a single chunk of a template. A chunk is either the entire
template or the portion of a template contained within a balanced
tag. This procedure does not return the compiled chunk; compiled
code is assembled in the template::parse_list variable.
@param chunk A string containing markup, potentially with embedded
- ATS tags.
+ ATS tags.
} {
- # parse the template chunk inside the tag
- set remaining [ns_adp_parse -string $chunk]
+ # parse the template chunk inside the tag
+ set remaining [adp_parse_string $chunk]
- # add everything from either the beginning of the chunk or the
- # last balanced tag in the chunk to the list
+ # add everything from either the beginning of the chunk or the
+ # last balanced tag in the chunk to the list
- if { ! [string is space $remaining] } {
-
- adp_quote_chunk remaining remaining_quoted
-
- adp_append_string $remaining_quoted
- }
+ if { ! [string is space $remaining] } {
+ adp_quote_chunk remaining remaining_quoted
+ adp_append_string $remaining_quoted
+ }
}
ad_proc -private template::adp_quote_chunk { chunk_var_name quoted_var_name } {
- Quotes (precedes by backslash) all square brackets, curly braces,
- double quotes, backslashes, and dollar signs in a chunk of adp.
+ Quotes (precedes by backslash) all square brackets, curly braces,
+ double quotes, backslashes, and dollar signs in a chunk of adp.
- @param chunk_var_name The name of the variable to quote
- @param quoted_var_name The name of the variable to put the quoted result in
+ @param chunk_var_name The name of the variable to quote
+ @param quoted_var_name The name of the variable to put the quoted result in
- @author Peter Marklund (peter@collaboraid.biz)
+ @author Peter Marklund (peter@collaboraid.biz)
- @creation-date 2002-10-16
+ @creation-date 2002-10-16
} {
- upvar $chunk_var_name chunk $quoted_var_name quoted
+ upvar $chunk_var_name chunk $quoted_var_name quoted
- regsub -all {[\]\[\{\}\"\\$]} $chunk {\\&} quoted
+ regsub -all {[\]\[\{\}\"\\$]} $chunk {\\&} quoted
}
ad_proc -private template::adp_append_string { s } {
Adds a line of code that appends a string to the Tcl output
from the compiler.
@param s A string containing markup that does not contain any embedded
- ATS tags. Variable references and procedure calls are
- interpreted as for any double-quoted string in Tcl.
+ ATS tags. Variable references and procedure calls are
+ interpreted as for any double-quoted string in Tcl.
} {
- adp_append_code "append __adp_output \"$s\""
+ adp_append_code "append __adp_output \"$s\""
}
ad_proc -private template::adp_append_code { code { nobreak "" } } {
@@ -682,24 +685,24 @@
@param code A line of Tcl code
@option nobreak Flag indicating that code should be appended to the
- current last line rather than adding a new line, for
- cases where code must continue on the same line, such
- as the else tag
+ current last line rather than adding a new line, for
+ cases where code must continue on the same line, such
+ as the else tag
} {
- if { [string is space $code] } { return }
+ if { [string is space $code] } { return }
- variable parse_list
+ variable parse_list
- if {$nobreak eq "-nobreak"} {
+ if {$nobreak eq "-nobreak"} {
- set last_line [lindex $parse_list end]
- append last_line " $code"
- set parse_list [lreplace $parse_list end end $last_line]
+ set last_line [lindex $parse_list end]
+ append last_line " $code"
+ set parse_list [lreplace $parse_list end end $last_line]
- } else {
+ } else {
- lappend parse_list $code
- }
+ lappend parse_list $code
+ }
}
ad_proc -private template::adp_puts { text } {
@@ -708,9 +711,9 @@
@param text A string containing text or markup.
} {
- upvar __adp_output __adp_output
+ upvar __adp_output __adp_output
- append __adp_output $text
+ append __adp_output $text
}
ad_proc -private template::adp_tag_init { {tag_name ""} } {
@@ -719,20 +722,20 @@
@param tag_name The name of the tag. Used for debugging purposes only.
} {
- # add everything either from the beginning of the template or from
- # the last balanced tag up to the current point in the template
+ # add everything either from the beginning of the template or from
+ # the last balanced tag up to the current point in the template
- set chunk [ns_adp_dump]
+ set chunk [ns_adp_dump]
- if { ! [string is space $chunk] } {
- adp_quote_chunk chunk chunk_quoted
- adp_append_string $chunk_quoted
- }
+ if { ! [string is space $chunk] } {
+ adp_quote_chunk chunk chunk_quoted
+ adp_append_string $chunk_quoted
+ }
- # flush the output buffer so that the next dump will only catch
- # the next chunk of the template
+ # flush the output buffer so that the next dump will only catch
+ # the next chunk of the template
- ns_adp_trunc
+ ns_adp_trunc
}
ad_proc -private template::tag_attribute {
@@ -759,11 +762,11 @@
@return the tag from the top of the tag stack.
} {
- variable tag_stack
+ variable tag_stack
- return [lindex [lindex $tag_stack end] 1]
+ return [lindex $tag_stack end 1]
}
-
+
ad_proc -private template::enclosing_tag {
tag
} {
@@ -778,57 +781,57 @@
@return the tag identifier for the enclosing tag
@param tag the type (eg. multiple) of the enclosing tag to look for.
} {
- set name ""
+ set name ""
- variable tag_stack
+ variable tag_stack
- set last [expr {[llength $tag_stack] - 2}]
+ set last [expr {[llength $tag_stack] - 2}]
- 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 [lindex $pair 1]
- break
+ if {[lindex $pair 0] eq $tag} {
+ set name [lindex $pair 1]
+ break
+ }
}
- }
- return $name
+ return $name
}
ad_proc -private -deprecated template::get_enclosing_tag { tag } {
Reach back into the tag stack for the last enclosing instance of a tag.
Typically used where the usage of a tag depends on its context, such
as the "group" tag within a "multiple" tag.
-
+
Deprecated, use:
- 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" } } {
@@ -840,26 +843,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 { [string equal $default {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:
+