parse-procs.tcl

ADP to Tcl Compiler for the ArsDigita Templating System,

Location:

packages/acs-templating/tcl/parse-procs.tcl

Authors:

Karl Goldstein

Stanislav Freidin

Jon Salz

CVS Identification:

$Id: parse-procs.tcl,v 1.68 2024/11/13 08:40:51 gustafn Exp $

Procedures in this file

• template::adp_abort (public)
• template::adp_append_code (public)
• template::adp_append_string (private)
• template::adp_array_variable_regexp (public)
• template::adp_array_variable_regexp_literal (public)
• template::adp_array_variable_regexp_noi18n (public)
• template::adp_array_variable_regexp_noquote (public)
• template::adp_compile (public)
• template::adp_compile_chunk (public)
• template::adp_eval (public)
• template::adp_include (public)
• template::adp_init (public)
• template::adp_level (public)
• template::adp_levels (public, deprecated)
• template::adp_parse (public)
• template::adp_parse_tags (public)
• template::adp_parse_tags_and_localize (private)
• template::adp_prepare (private)
• template::adp_puts (private)
• template::adp_quote_chunk (private)
• template::adp_set_vars (private)
• template::adp_tag_init (private)
• template::adp_variable_regexp (public)
• template::adp_variable_regexp_literal (public)
• template::adp_variable_regexp_noi18n (public)
• template::adp_variable_regexp_noquote (public)
• template::current_tag (private)
• template::enclosing_tag (private)
• template::expand_percentage_signs (public)
• template::get_attribute (public)
• template::set_file (public)
• template::tag_attribute (private)

Detailed information

 template::adp_abort

 template::adp_append_code code [ nobreak ]

 template::adp_append_string s

 template::adp_array_variable_regexp

 template::adp_array_variable_regexp_literal

 template::adp_array_variable_regexp_noi18n

 template::adp_array_variable_regexp_noquote

 template::adp_compile [ -file file ] [ -string string ]

 template::adp_compile_chunk chunk

 template::adp_eval coderef

 template::adp_include [ -uplevel uplevel ] src varlist

 template::adp_init type file_stub

 template::adp_level [ up ]

 template::adp_levels

 template::adp_parse __adp_stub __args

 template::adp_parse_tags HTML

 template::adp_parse_tags_and_localize HTML

 template::adp_prepare

 template::adp_puts text

 template::adp_quote_chunk chunk_var_name quoted_var_name

 template::adp_set_vars

 template::adp_tag_init [ tag_name ]

 template::adp_variable_regexp

 template::adp_variable_regexp_literal

 template::adp_variable_regexp_noi18n

 template::adp_variable_regexp_noquote

 template::current_tag

 template::enclosing_tag tag

 template::expand_percentage_signs message

 template::get_attribute tag params name [ default ]

 template::set_file path

 template::tag_attribute tag attribute

Content File Source

ad_library {
    ADP to Tcl Compiler for the ArsDigita Templating System,

    @author Karl Goldstein
    @author Stanislav Freidin
    @author Jon Salz

    @cvs-id $Id: parse-procs.tcl,v 1.68 2024/11/13 08:40:51 gustafn Exp $
}

# Based on the original ADP to Tcl compiler by Jon Salz (jsalz@mit.edu)

# 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


namespace eval template {}

d_proc -public template::adp_include {
    {-uplevel 1}
    src
    varlist
} {
    return 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:
    <pre>
    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]]
    </pre>

    The [list &book "bookdata" ...] tells adp_include to pass the book array
    by reference to the adp include, where it is referred 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)

    @return the string generated by the Tcl/ADP pair.

    @author Jeff Davis davis@xarg.net
    @creation-date 2004-06-02

    @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 __adp_out [template::adp_parse [template::util::url_to_file $src] $varlist]

    # pop off parse level
    template::util::lpop ::template::parse_level

    return $__adp_out
}

ad_proc -public template::adp_parse { __adp_stub __args } {
    Execute procedures to prepare data sources and then to output
    template.  Assumes adp_level is set on entry.  in general the
    public version template::adp_include should be used for generating
    strings from adp files.

    @param __adp_stub   The root (without the file extension) of the
                        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
} {
    # declare any variables passed in to an include or master
    # TODO: call adp_set_vars instead.

    foreach {__key __value} $__args {
        #
        # Keys starting with "&" trigger call by reference.
        #
        if {[string range $__key 0 0] eq "&"} {
            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 {
            #
            # Key does not start with "&" => 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]

        # if we get here, adp_prepare ran without throwing an error.

        # initialize the ADP output
        set __adp_output ""

        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)
        #
        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 { [namespace which ::ds_page_fragment_cache_enabled_p] ne ""
             && [::ds_enabled_p]
             && [::ds_page_fragment_cache_enabled_p]
             && [::ds_collection_enabled_p] } {
            ns_cache lappend ds_page_bits [ad_conn request] \
                $__adp_stub.$template_extension
        }

        if { $templated_p } {
            #
            # Ensure that template output procedure exists and is
            # up-to-date. By executing the reset, get result of
            # template output procedure into __adp_output, and
            # properties into __adp_properties
            #
            [template::adp_init $template_extension $__adp_stub]

            # JCD: Lets keep a copy of all the page fragments!  WooHoo.
            if { [namespace which ::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"]
                } else {
                    error "No script or template found for page '$__adp_stub'"
                }
            }
        }

        return $__adp_output                ; # empty in non-templated page
    } return_value]

    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

    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
            }
        }
    }
}

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 {

            set __adp_expr {^@([[:alnum:]_]+)\.\*@$}
            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:rowcount $__adp_key:rowcount

                    if { [info exists $__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
            }
        }
    }
}
# 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.
} {
    error ADP_ABORT
}

ad_proc -public template::adp_eval { coderef } {
    Evaluates a chunk of compiled template code in the calling stack frame.
    The resulting output is placed in __adp_output in the calling frame,
    and also returned for convenience.

    @return The output produced by the compiled template code.
} {
    upvar $coderef code __adp_output output
    lappend ::template::parse_level [expr {[info level]-1}]

    uplevel $code

    template::util::lpop ::template::parse_level
    return $output
}

ad_proc -public template::adp_level { { up "" } } {
    Get the stack frame level at which the template is being evaluated.
    This is used extensively for obtaining references to data sources,
    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.

    @return A number, as returned by [info level], representing the stack frame
    in which a template is being parsed.
} {
    set result ""

    # 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]
        }
    }

    return $result
}


ad_proc -deprecated template::adp_levels {} {
    @return all stack frame levels
    @see template::adp_level
} {
    if { [info exists ::template::parse_level] } {return $::template::parse_level}
    return ""
}

ad_proc -private template::adp_prepare {} {
    Executes the code to prepare the data sources for a template.  The
    code is executed in the stack frame of the calling procedure
    (adp_parse) so that variables are accessible when the compiled
    template code is executed.  If the preparation code executes the
    set_file command, the procedure will recurse and execute the code
    for the next template as well.

    @return boolean (0 or 1): whether the (ultimate) script was found.
} {
    uplevel {

        if { [file exists $__adp_stub.tcl] } {

            # Remember the file_stub in case the procedure changes it
            set __adp_remember_stub $__adp_stub

            # Ensure that data source preparation procedure exists and
            # is up-to-date and execute it.
            [adp_init tcl $__adp_stub]

            # 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 then 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
    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.
} {
    set level [adp_level]

    upvar #$level __adp_stub file_stub
    set file_stub $path
}

ad_proc -public template::adp_init { type file_stub } {
    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
    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 file_stub  The root (sans file extension) of the absolute path
                      to the .adp or .tcl file to source.
} {
    #
    # Depending on the iconset, the result of the compiled template
    # might be different. So, cache per iconset
    #
    set cache [iconset]-$type
    #
    # Check, if the compiled proc exists already.
    #
    set proc_name [namespace which ::template::mtimes::${cache}::$file_stub]
    #ns_log notice "$type $file_stub -> '$proc_name'"
    
    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"} {
            #
            # Either the procedure does not already exist or is not
            # up-to-date
            #
            namespace eval ::template::code::${cache} {}
            switch -exact $type {

                tcl {
                    set code [template::util::read_file $file_stub.tcl]
                }
                default {
                    set code [adp_compile -file $file_stub.$type]
                }
            }
            #ns_log notice "$type $file_stub -> compiled '$code'"

            #
            # 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 {[namespace which ::ds_enabled_p] ne ""} {
                proc ::template::code::${cache}::$file_stub {} "if {\[::ds_enabled_p\] && \[::ds_collection_enabled_p\] && \[::ds_profiling_enabled_p\]} { ds_profile start $file_stub.$type }
uplevel {
    $code
}
if {\[::ds_enabled_p\] && \[::ds_collection_enabled_p\] &&\[::ds_profiling_enabled_p\]} { ds_profile stop $file_stub.$type }\n"
      } else {
        proc ::template::code::${cache}::$file_stub {} "
uplevel {
    $code
}\n"
      }
      namespace eval ::template::mtimes::${cache} {}
      proc ::template::mtimes::${cache}::$file_stub {} "return $mtime"
    }
  }
  return ::template::code::${cache}::$file_stub
}

ad_proc -public template::expand_percentage_signs { message } {
    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:

    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

} {
    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 sign
            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
            }

            # Convert syntax to Tcl syntax:
            # It's either an array variable or a Tcl variable
            #   array variables
            # TODO: ns_quotehtml
            # TODO: lang::util::localize
            regsub -all -- {[\]\[\{\}\"]\\$} $substitution {\\&} substitution
            if { [regexp {^%([[:alnum:]_]+)\.([[:alnum:]_]+)%$} $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 {^%([[:alnum:]_:]+)%$} $substitution match var] } {
                set command "set $var"
                set substitution [uplevel $command]
            }
            if {$quote_p} {
                set substitution [ns_quotehtml $substitution]
            }
        }

        append formatted_message $substitution
    }

    append formatted_message $remaining_message

    return $formatted_message
}

d_proc -public template::adp_compile {
    {-file ""}
    {-string ""}
} {
    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 file The filename of the source
    @param string string to be compiled
    @return The compiled code.

    Valid options are either -string or -file
} {
    variable parse_list
    # initialize the compiled code
    set parse_list [list "set __adp_output {}; set __ad_conn_locale \[ad_conn locale\]"]

    if {$file ne "" && $string ne ""} {
        error "you must specify either -file or -string"
    } elseif {$file ne ""} {
        set chunk [template::util::read_file $file]
    } else {
        set chunk $string
    }

    # substitute <% ... %> blocks with registered tags so they can be handled
    # by our proc rather than evaluated.

    regsub -all -- {<%} $chunk {<tcl>} chunk
    # avoid substituting when it is a percentage attribute to an HTML tag.
    regsub -all -- {([^0-9])%>} $chunk {\1</tcl>} 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 <hr width="50%">} \
            "when compiling ADP source: " \
            [list template::adp_compile -file $file -string $string]
    }

    # recursively parse the template
    adp_compile_chunk $chunk

    # 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"]

    #ns_log notice "CODE before i18n\n$code\n"

    # Substitute #foo# message keys with values from the message catalog

    # Since messages may read the variables of the adp page they go through
    # expand_percentage_signs which amongst other things does an uplevel subst
    while {[regsub -all \
                {([^\\])\#([-[:alnum:]_:]+[.][-[:alnum:]_:]+)\#} \
                $code \
                {\1[template::expand_percentage_signs [lang::message::lookup $__ad_conn_locale {\2} {TRANSLATION MISSING} {} -1]]} \
                code]} {}

    #
    # We do each substitution set in several pieces, separately for
    # normal variables and for variables having ";noquote", ";no18n",
    # and ";literal" attached to them.  Specifically, @x@ gets
    # translated to [ns_quotehtml ${x}], whereas @x;noquote@ gets
    # translated to ${x}.  The same goes for array variable
    # references.
    #
    # The approach with several regexp operations can be optimized,
    # but since this is happening only at ADP compile time, this does
    # not seem critical.

    # substitute array variable references
    while {[regsub -all -- [adp_array_variable_regexp_noquote] $code {\1[template::adp_parse_tags_and_localize $\2(\3)]} code]} {}
    while {[regsub -all -- [template::adp_array_variable_regexp_noi18n] $code {\1[ns_quotehtml $\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 simple variable references
    while {[regsub -all -- [adp_variable_regexp_noquote] $code {\1[template::adp_parse_tags_and_localize ${\2}]} code]} {}
    while {[regsub -all -- [template::adp_variable_regexp_noi18n] $code {\1[ns_quotehtml ${\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]} {}


    # unescape protected "#" and "@" references
    set code [string map { \\@ @ \\# #} $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 preceding
    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 {(^|[^\\])@([[:alnum:]_:]+)\.([[:alnum:]_\.:]+)@}
}

ad_proc -public template::adp_array_variable_regexp_noquote {} {
    adp_array_variable_regexp's pattern augmented by "noquote"

    @author Dirk Gomez (openacs@dirkgomez.de)
    @creation-date 12 February 2003
} {
    return {(^|[^\\])@([[:alnum:]_:]+)\.([[:alnum:]_:\.]+);noquote@}
}

ad_proc -public template::adp_array_variable_regexp_literal {} {
    adp_array_variable_regexp's pattern augmented by "literal"

    @author Gustaf Neumann
    @creation-date December 2012
} {
    return {(^|[^\\])@([[:alnum:]_:]+)\.([[:alnum:]_:\.]+);literal@}
}

ad_proc -public template::adp_array_variable_regexp_noi18n {} {
    adp_array_variable_regexp's pattern augmented by "noi18n"

    @author Gustaf Neumann
    @creation-date June 2015
} {
    return {(^|[^\\])@([[:alnum:]_:]+)\.([[:alnum:]_:\.]+);noi18n@}
}

ad_proc -public template::adp_variable_regexp {} {
    The regexp pattern used to find adp variables in
    a piece of text, i.e. occurrences of @variable_name@.
    Captures the character preceding the first @ in \1 and
    the variable_name in \2.

    @author Peter Marklund (peter@collaboraid.biz)
    @creation-date 25 October 2002
} {
    return {(^|[^\\])@([[:alnum:]_:]+)@}
}

ad_proc -public template::adp_variable_regexp_noquote {} {
    adp_variable_regexp augmented by "noquote"

    @author Dirk Gomez (openacs@dirkgomez.de)
    @creation-date 12 February 2003
} {
    return {(^|[^\\])@([[:alnum:]_:]+);noquote@}
}

ad_proc -public template::adp_variable_regexp_literal {} {
    adp_variable_regexp augmented by "literal"

    @author Gustaf Neumann
    @creation-date December 2012
} {
    return {(^|[^\\])@([[:alnum:]_:]+);literal@}
}

ad_proc -public template::adp_variable_regexp_noi18n {} {
    adp_variable_regexp augmented by "noi18n"

    @author Gustaf Neumann
    @creation-date June 2015
} {
    return {(^|[^\\])@([[:alnum:]_:]+);noi18n@}
}

ad_proc -public 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
    ADP tags.
} {
    # 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

    if { ! [string is space $remaining] } {
        adp_quote_chunk remaining remaining_quoted
        adp_append_string $remaining_quoted
    }
}

ad_proc -public template::adp_parse_tags {HTML} {

    Parse the tags of the provided HTML text.  This function is
    similar to

    <blockquote>
       template::adp_compile -string $HTML
    </blockquote>

    but it just performs tag substitution, but not ADP variable
    substitution, since this is done differently in some contextes on
    the provided HTML chunk.  An example for specialized handling is
    the handling of instance attributes in xowiki.

    @param HTML text containing potentially ADP tags
    @return HTML text with substituted ADP tags
} {
    #
    #ns_log notice "adp_parse_tags BEGIN [info exists ::template::parse_list]: $HTML"
    if {[string is space $HTML]} {
        return $HTML
    }
    set old_parse_list [expr {[info exists ::template::parse_list] ? $::template::parse_list : ""}]
    set ::template::parse_list ""
    #
    # The following exception handler is just for safety to achieve a
    # high-level of backward compatibility. In case
    # "adp_compile_chunk" and or the evaluation of the resulting code
    # fails, fall back to the original behavior without ADP tag
    # substitution.
    #
    try {
        template::adp_compile_chunk $HTML
        lappend ::template::parse_list {set __adp_output}
        #ns_log notice "adp_parse_tags parse list '[join $::template::parse_list \n]'"
        set HTML [eval [join $::template::parse_list \n]]
    } on error {errorMsg} {
        ad_log warning "adp_parse_tags failed on parsing:\n'$HTML'"
    }
    set ::template::parse_list $old_parse_list
    #ns_log notice "adp_parse_tags END: $HTML"
    return $HTML
}

ad_proc -private template::adp_parse_tags_and_localize {HTML} {

    Helper proc to combine "adp_parse_tags" and "lang::util::localize"
    as used in the regsub operations for resolving template variables.

} {
    if {$HTML ne ""} {
        #ns_log notice "YYYY adp_parse_tags_and_localize called with '$HTML'"
        return [::lang::util::localize [adp_parse_tags $HTML]]
    }
}


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.

    @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)

    @creation-date 2002-10-16
} {
    upvar $chunk_var_name chunk $quoted_var_name 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.
} {
    adp_append_code "append __adp_output \"$s\""
}

ad_proc -public template::adp_append_code { code { nobreak "" } } {
    Adds a line of code to the Tcl output from the compiler.

    Called by basically any adp custom tag implementation and also
    from developer support.

    @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.
} {
    if { [string is space $code] } { return }

    variable parse_list

    if {$nobreak eq "-nobreak"} {

        set last_line [lindex $parse_list end]
        append last_line " $code"
        lset parse_list end $last_line

    } else {

        lappend parse_list $code
    }
}

ad_proc -private template::adp_puts { text } {
    Add text to the ADP currently being rendered.  Maybe used within escaped
    Tcl code in the template to add to the output.

    @param text A string containing text or markup.
} {
    upvar __adp_output __adp_output

    append __adp_output $text
}

ad_proc -private template::adp_tag_init { {tag_name ""} } {
    Called at the beginning of every tag handler to flush the ADP buffer of
    output accumulated from the last tag (or from the beginning of the file).

    @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

    set chunk [ns_adp_dump]

    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

    ns_adp_trunc
}

d_proc -private template::tag_attribute {
    tag
    attribute
} {
    Return an attribute from a tag that has already been processed.

    @author Lee Denison (lee@runtime-collective.com)
    @creation-date 2002-01-30

    @return the value of the tag's attribute
    @param tag the tag identifier
    @param attribute the attribute name
} {
    return [ns_set iget $tag $attribute]
}

ad_proc -private template::current_tag {} {
    Return the top level tag from the stack.

    @author Lee Denison (lee@runtime-collective.com)
    @creation-date 2002-01-30

    @return the tag from the top of the tag stack.
} {
    variable tag_stack

    return [lindex $tag_stack end 1]
}

d_proc -private template::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.

    @author Lee Denison (lee@runtime-collective.com)
    @creation-date 2002-01-30

    @return the tag identifier for the enclosing tag
    @param tag the type (e.g. multiple) of the enclosing tag to look for.
} {
    set name ""

    variable tag_stack

    set last [expr {[llength $tag_stack] - 2}]

    for { set i $last } { $i >= 0 } { incr i -1 } {

        set pair [lindex $tag_stack $i]

        if {[lindex $pair 0] eq $tag} {
            set name [lindex $pair 1]
            break
        }
    }

    return $name
}

ad_proc -public template::get_attribute { tag params name { default "ERROR" } } {
    Retrieves a named attribute value from the parameter set passed to a
    tag handler.  If a default is not specified, assumes the attribute
    is required and throws an error.

    @param tag      The name of the tag.
    @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 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.

    @return The value of the attribute.
} {
    set value [ns_set iget $params $name]

    if {$value eq ""} {
        if { $default eq "ERROR" } {
            error "Missing [string toupper $name] property\
             in [string toupper $tag] tag"
        } else {
            set value $default
        }
    }

    return $value
}

#
# Local variables:
#    mode: tcl
#    tcl-indent-level: 4
#    indent-tabs-mode: nil
# End: