doc_adp_compile (public)

 doc_adp_compile adp

Defined in packages/acs-tcl/tcl/adp-parser-procs.tcl

Compiles a block of ADP code.

Parameters:

adp (required)

Returns:

a value which can be passed to doc_adp_execute to run the ADP.

Partial Call Graph (max 5 caller/called nodes):

Testcases:

No testcase defined.

Source code:

    # A buffer of literal text to output.
    set text_buffer ""

    # A stack of tags for which we expect to see end tags.
    set balanced_tag_stack [list]

    # The current offset in the $adp character string.
    set index 0

    # The code buffer we're going to return.
    set code ""

    set adp_length [string length $adp]

    while { 1 } {
    set lt_index [string first "<" $adp $index]
    if { $lt_index < 0 } {
        append text_buffer [string range $adp $index end]
        break
    }

    # Append to the text buffer any text before the "<".
    append text_buffer [string range $adp $index $lt_index-1]
    set index $lt_index

    if { [info exists tag] } {
        unset tag
    }

    # Note that literal_tag may be set at this point, indicating that we shouldn't
    # process any tags right now (we should just be looking for the end tag named
    # </$literal_tag>.

    # Currently index points to a "<".
    incr index
    if { [string index $adp $index] eq "/" } {
        set end_tag_p 1
        incr index
    } elseif { ![info exists literal_tag]
           && [string index $adp $index] eq "%"
    } {
        doc_adp_flush_text_buffer

        incr index
        if { [string index $adp $index] eq "=" } {
        incr index
        set puts_p 1
        } else {
        set puts_p 0
        }
        set tcl_code_begin $index

        while { $index < [string length $adp]
            && ([string index $adp $index] ne "%" || [string index $adp $index+1] ne ">")
        } {
        incr index
        }
        if { $index >= [string length $adp] } {
        return -code error "Unbalanced Tcl evaluation block"
        }

        set tcl_code [string range $adp $tcl_code_begin $index-1]
        if { $puts_p } {
        doc_adp_append_code "doc_adp_puts \[subst [doc_adp_quote_tcl_string $tcl_code]\]"
        } else {
        doc_adp_append_code $tcl_code
        }

        # Skip the %> at the end.
        incr index 2

        continue
    } elseif { ![info exists literal_tag] && [string index $adp $index] eq "$" } {
        incr index
        set tag "var"
        set end_tag_p 0
    } else {
        set end_tag_p 0
    }

    if { ![info exists tag] } {
        # Find the next non-word character.
        set tag_begin $index
        while { [string index $adp $index] eq "-"
            || [string is wordchar -strict [string index $adp $index]]
        } {
        incr index
        }
        set tag [string range $adp $tag_begin $index-1]
    }

    if { (![info exists literal_tag] || ($end_tag_p && $tag eq $literal_tag))
         && [nsv_exists doc_adptags $tag]
     } {
        doc_adp_flush_text_buffer

        if { [info exists literal_tag] } {
        unset literal_tag
        }
        array set tag_info [nsv_get doc_adptags $tag]

        # It's a registered tag. Parse the attribute list.

        set attributes [ns_set create]

        while { 1 } {
        # Skip whitespace.
        while { [string is space -strict [string index $adp $index]] } {
            incr index
        }

        # If it's a >, we're done.
        if { [string index $adp $index] eq ">" } {
            # Done with attribute list.
            incr index
            break
        }

        # Not a > - must be an attribute name.
        set attr_name_begin $index
        while { $index < $adp_length
            && [string index $adp $index] ne ">"
            && [string index $adp $index] ne "="
            && ![string is space -strict [string index $adp $index]]
            } {
            incr index
        }
        if { $attr_name_begin eq $index } {
            return -code error "Weird attribute format to tag \"$tag\""
        }

        set attr_name [string range $adp $attr_name_begin $index-1]

        if { [string index $adp $index] eq "=" } {
            incr index
            while { [string is space -strict [string index $adp $index]] } {
            incr index
            }
            if { [string index $adp $index] eq "\"" } {
            # Quoted string.
            set value_begin [incr index]
            while { $index < $adp_length && [string index $adp $index] ne "\"" } {
                incr index
            }
            set value_end $index
            incr index
            } else {
            set value_begin $index
            while { $index < $adp_length
                && [string index $adp $index] ne ">"
                && [string index $adp $index] ne "="
                && ![string is space -strict [string index $adp $index]]
                } {
                incr index
            }
            set value_end $index
            }
            ns_set put $attributes $attr_name [string range $adp $value_begin $value_end-1]
        } else {
            ns_set put $attributes $attr_name $attr_name
        }
        }

        if { $end_tag_p } {
        if { [llength $balanced_tag_stack] == 0 } {
            return -code error "Unexpected end tag </$tag>"
        }
        if { $tag ne [lindex $balanced_tag_stack end] } {
            return -code error "Expected end tag to be </[lindex $balanced_tag_stack end]>, not </$tag>"
        }
        set balanced_tag_stack [lrange $balanced_tag_stack 0 [llength $balanced_tag_stack]-2]
        doc_adp_append_code "\}"
        } else {
        doc_adp_append_code "set __doc_attributes \[ns_set create\]"
                foreach {key value} [ns_set array $attributes] {
            doc_adp_append_code "ns_set put \$__doc_attributes [doc_adp_quote_tcl_string $key] [doc_adp_quote_tcl_string $value]"
        }

        if { $tag_info(balanced_p) } {
            doc_adp_append_code "$tag_info(handler) \$__doc_attributes \{"
            lappend balanced_tag_stack $tag
            if { $tag_info(literal_p) } {
            # Remember that we're inside a literal tag.
            set literal_tag $tag
            }
        } else {
            doc_adp_append_code "$tag_info(handler) \$__doc_attributes"
        }
        }
    } else {
        append text_buffer [string range $adp $lt_index $index-1]
    }
    }

    if { [llength $balanced_tag_stack] > 0 } {
    return -code error "Expected end tag </[lindex $balanced_tag_stack end]> but got end of file"
    }

    doc_adp_flush_text_buffer

    return $code

XQL Not present:

Generic, PostgreSQL, Oracle