#!/bin/sh
# the next line restarts using wish \
exec wish8.3 "$0" "$@"


#
# xml2rfc.cgi - convert technical memos written using XML to TXT/HTML
#
# (c) 1998-99 Invisible Worlds, Inc.
#


package require xml 1.8


#
# top-level parsing
#


global parser
if {![info exists parser]} {
    set parser ""
}

proc xml2rfc {input {output ""} {remote ""}} {
    global errorCode errorInfo
    global parser
    global passno
    global passmax
    global errorP
    global ifile mode ofile
    global stdout

    if {![string compare [file extension $input] ""]} {
        append input .xml
    }

    set stdin [open $input { RDONLY }]
    set inputD [file dirname [set ifile $input]]

    if {![string compare $output ""]} {
        set output [file rootname $input].txt
    }
    if {[string compare $remote ""]} {
        set ofile $remote
    } else {
        set ofile $output
    }
    set ofile [file rootname [file tail $ofile]]

    if {![string compare $input $output]} {
        error "input and output files must be different"
    }

    if {[file exists [set file [file join $inputD .xml2rfc.rc]]]} {
        source $file
    }

    switch -- [set mode [string range [file extension $output] 1 end]] {
        html -
        txt  {}

        xml {
            set stdout [open $output { WRONLY CREAT TRUNC }]

            puts -nonewline $stdout [prexml [read $stdin] $inputD]

            catch { close $stdout }
            catch { close $stdin }

            return
        }

        default {
            catch { close $stdin }
            error "unsupported output type: $mode"
        }
    }

    set code [catch {
        if {![string compare $parser ""]} {
            global emptyA

            set parser [xml::parser]
            array set emptyA {}

            $parser configure \
                        -elementstartcommand          { begin               } \
                        -elementendcommand            { end                 } \
                        -characterdatacommand         { pcdata              } \
                        -processinginstructioncommand { pi                  } \
                        -xmldeclcommand               { xmldecl             } \
                        -doctypecommand               { doctype             } \
                        -entityreferencecommand       ""                      \
                        -errorcommand                 { unexpected error    } \
                        -warningcommand               { unexpected warning  } \
                        -entityvariable               emptyA                  \
                        -final                        yes                     \
                        -reportempty                  no
        }

        set data [prexml [read $stdin] $inputD]

        set errorP 0
        set passmax 2
        set stdout ""
        for {set passno 1} {$passno <= $passmax} {incr passno} {
            if {$passno == 2} {
                set stdout [open $output { WRONLY CREAT TRUNC }]
            }
            pass start
            $parser parse $data
            pass end
            if {$errorP} {
                break
            }
        }
    } result]
    set ecode $errorCode
    set einfo $errorInfo

    catch { close $stdout }
    catch { close $stdin }

    if {$code == 1} {
        catch {
            global stack

            if {[llength $stack] > 0} {
                set text "Context: "
                foreach frame $stack {
                    append text "<[lindex $frame 0]>"
                }
                append result "\n\n$text"
            }
        }
    }

    return -code $code -errorinfo $einfo -errorcode $ecode $result
}

proc xml2txt {input} {
    xml2rfc $input [file rootname $input].txt
}

proc xml2html {input} {
    xml2rfc $input [file rootname $input].html
}

proc xml2ref {input output} {
    global errorCode errorInfo

    if {![string compare $input $output]} {
        error "input and output files must be different"
    }

    if {[file exists [set file [file join [set inputD [file dirname $input]] \
                                          .xml2rfc.rc]]]} {
        source $file
    }

    set refT [ref::init]
    if {[set code [catch { ref::transform $refT $input } result]]} {
        set ecode $errorCode
        set einfo $errorInfo

        catch { ref::fin $refT }

        return -code $code -errorinfo $einfo -errorcode $ecode $result
    }
    ref::fin $refT

    set stdout [open $output {WRONLY CREAT TRUNC }]

    set code [catch {
        puts -nonewline $stdout $result
        flush $stdout
    } result]
    set ecode $errorCode
    set einfo $errorInfo

    catch { close $stdout }

    return -code $code -errorinfo $einfo -errorcode $ecode $result
}

proc prexml {stream inputD} {
    global env tcl_platform

# an MTR hack...

#
# whenever "%include.whatever;" is encountered, act as if the DTD contains
#
#       <!ENTITY % include.whatever SYSTEM "whatever.xml">
#
# this yields a nested (and cheap-and-easy) include facility.
#
# note that we ALWAYS nuke the first two lines which SHOULD contain
#
#       <?xml version="1.0"?>
#       <!DOCTYPE whatever SYSTEM "rfc2629.dtd">
#

    if {[catch { set path $env(XML_LIBRARY) }]} {
        set path [list $inputD]
    }
    switch -- $tcl_platform(platform) {
        windows {
            set c ";"
        }

        default {
            set c ":"
        }
    }
    set path [split $path $c]

    set data ""
    set litN [string length [set litS "%include."]]
    set litO [string length [set litT ";"]]
    while {[set x [string first $litS $stream]] >= 0} {
        append data [string range $stream 0 [expr $x-1]]
        set stream [string range $stream [expr $x+$litN] end]
        if {[set x [string first $litT $stream]] < 0} {
            error "missing close to %include.*"
        }
        set y [string range $stream 0 [expr $x-1]]
        if {![regexp -nocase -- {^[a-z0-9.-]+$} $y]} {
            error "invalid %include $y"
        }
        set include ""
        foreach dir $path {
            if {(![file exists [set file [file join $dir $y]]]) \
                    && (![file exists [set file [file join $dir $y.xml]]])} {
                continue
            }
            set fd [open $file { RDONLY }]
            set include [join [lrange [split [read $fd] "\n"] 2 end] "\n"]
            catch { close $fd }
            break
        }
        if {![string compare $include ""]} {
            error "unable to find external file $y.xml"
        }
        set stream $include[string range $stream [expr $x+$litO] end]
    }
    append data $stream
    set stream $data

# because <![CDATA[ ... ]]> isn't supported in TclXML...
    set data ""
    set litN [string length [set litS "<!\[CDATA\["]]
    set litO [string length [set litT "\]\]>"]]
    while {[set x [string first $litS $stream]] >= 0} {
        append data [string range $stream 0 [expr $x-1]]
        set stream [string range $stream [expr $x+$litN] end]
        if {[set x [string first $litT $stream]] < 0} {
            error "missing close to CDATA"
        }
        set y [string range $stream 0 [expr $x-1]]
        regsub -all {&} $y {\&amp;} y
        regsub -all {<} $y {\&lt;}  y
        append data $y
        set stream [string range $stream [expr $x+$litO] end]
    }
    append data $stream

    return $data
}


#
# XML linkage
#


# globals used in parsing
#
#     counter - used for generating reference numbers
#       depth -  ..
#       elemN - index of current element
#        elem - array, indexed by elemN, having:
#               list of element attributes,
#               plus ".CHILDREN", ".COUNTER", ".CTEXT"/".CLINES", ".NAME",
#                    ".ANCHOR"
#      passno - 1 or 2 (or maybe 3, if generating a TOC)
#       stack - the stack of elements, each frame having:
#               { element-name "elemN" elemN "children" { elemN... }
#                 "ctext" yes-or-no }
#        xref - array, indexed by anchor, having:
#               { "type" element-name "elemN" elemN "value" reference-number }

proc pass {tag} {
    global options
    global counter depth elemN elem passno stack xref
    global anchorN
    global elemZ
    global erefs

    switch -- $tag {
        start {
            unexpected notice "pass $passno..."
            if {$passno == 1} {
                catch { unset counter }
                catch { unset depth }
                catch { unset elem }
                catch { unset xref }
                catch { unset erefs }
                set anchorN 0
            }
            set elemN 0
            catch { unset options }
            array set options [list compact no toc no private "" \
                                    header "" footer "" background ""]
            normalize_options
            catch { unset stack }
        }

        end {
            set elemZ $elemN
        }
    }
}


# begin element

global required ctexts categories

set required { date       { month year }
               note       { title  }
               section    { title  }
               xref       { target }
               eref       { target }
               iref       { item }
# backwards compatibility...
#               seriesInfo { name value }
             }
          
set ctexts   { title organization street city region code country phone
               facsimile email uri area workgroup keyword xref eref
               seriesInfo }

set categories \
             { {std  "Standards Track" STD
"This document specifies an Internet standards track protocol for the Internet
community, and requests discussion and suggestions for improvements.
Please refer to the current edition of the &quot;Internet Official Protocol
Standards&quot; (STD 1) for the standardization state and status of this
protocol.
Distribution of this memo is unlimited."}

               {bcp      "Best Current Practice" BCP
"This document specifies an Internet Best Current Practice for the Internet
Community, and requests discussion and suggestions for improvements.
Distribution of this memo is unlimited."}

               {info     "Informational" FYI
"This memo provides information for the Internet community.
It does not specify an Internet standard of any kind.
Distribution of this memo is unlimited."}

               {exp      "Experimental" EXP
"This memo defines an Experimental Protocol for the Internet community.
It does not specify an Internet standard of any kind.
Discussion and suggestions for improvement are requested.
Distribution of this memo is unlimited."}

               {historic "Historic" ""
"This memo describes a historic protocol for the Internet community.
It does not specify an Internet standard of any kind.
Distribution of this memo is unlimited."} }

set iprstatus \
             { {full2026
"in full conformance with all provisions of Section 10 of RFC2026."}

               {noDerivativeWorks2026
"in full conformance with all provisions of Section 10 of RFC2026
except that the right to produce derivative works is not granted."}

               {noDerivativeWorksNow
"in full conformance with all provisions of Section 10 of RFC2026
except that the right to produce derivative works is not granted.
(If this document becomes part of an IETF working group activity,
then it will be brought into full compliance with Section 10 of RFC2026.)"}

               {none
"NOT offered in accordance with Section 10 of RFC2026,
and the author does not provide the IETF with any rights other
than to publish as an Internet-Draft."} }

proc begin {name {av {}}} {
    global counter depth elemN elem passno stack xref
    global anchorN
    global required ctexts categories iprstatus

# because TclXML... quotes attribute values containing "]"
    set kv ""
    foreach {k v} $av {
        lappend kv $k
        regsub -all {\\\[} $v {[} v
        lappend kv $v
    }
    set av $kv

    incr elemN

    if {$passno == 1} {
        set elem($elemN) $av
        array set attrs $av

        foreach { n a } $required {
            switch -- [string compare $n $name] {
                -1 {
                     continue
                }

                0 {
                    foreach v $a {
                        if {[catch { set attrs($v) }]} {
                            unexpected error \
                                "missing $v attribute in $name element"
                        }
                    }
                    break
                }

                1 {
                    break
                }
            }
        }

        switch -- [set type $name] {
            rfc {
                if {![catch { set attrs(category) }]} {
                    if {[lsearch0 $categories $attrs(category)] < 0} {
                        unexpected error \
                            "category attribute unknown: $attrs(category)"
                    }
                    if {(![string compare $attrs(category) historic]) \
                            && (![catch { set attrs(seriesNo) }])} {
                        unexpected error \
                            "historic documents have no document series"
                    }
                }
                if {![catch { set attrs(ipr) }]} {
                    if {[lsearch0 $iprstatus $attrs(ipr)] < 0} {
                        unexpected error \
                            "ipr attribute unknown: $attrs(ipr)"
                    }
                }
                global entities oentities
                if {[ catch { set number $attrs(number) }]} {
                    set number XXXX
                }
                set entities [linsert $oentities 0 "&rfc.number;" $number]
            }

            back {
                catch { unset depth(section) }
            }

            section {
                if {[catch { incr depth(section) }]} {
                    set depth(section) 1
                    set counter(section) 0
                }
                set counter(section) \
                         [counting $counter(section) $depth(section)]
                set l [split $counter(section) .]
                if {[lsearch0 $stack back] >= 0} {
                    set type appendix
                    set l [lreplace $l 0 0 \
                                [string index " ABCDEFGHIJKLMNOPQRSTUVWXYZ" \
                                    [lindex $l 0]]]
                }
                set attrs(.COUNTER) [set value [join $l .]]
                if {[catch { set attrs(anchor) }]} {
                    set attrs(anchor) anchor[incr anchorN]
                }
                set attrs(.ANCHOR) $attrs(anchor)
                set elem($elemN) [array get attrs]
            }

            list {
                if {[catch { incr depth(list) }]} {
                    set depth(list) 1
                    set counter(list) 0
                }
            }

            t {
                if {[lsearch0 $stack list] >= 0} {
                    set counter(list) [counting $counter(list) $depth(list)]
                    set attrs(.COUNTER) $counter(list)
                    set elem($elemN) [array get attrs]
                }
            }

            figure {
                if {[catch { incr counter(figure) }]} {
                    set counter(figure) 1
                }
                set attrs(.COUNTER) [set value $counter(figure)]
                set elem($elemN) [array get attrs]
            }

            reference {
                if {[catch { incr counter(reference) }]} {
                    set counter(reference) 1
                }
                set attrs(.COUNTER) [set value $counter(reference)]
                set elem($elemN) [array get attrs]
            }
        }

        if {![catch { set anchor $attrs(anchor) }]} {
            if {![catch { set xref($anchor) }]} {
                unexpected error "anchor attribute already in use: $anchor"
            }
            set xref($anchor) [list type $type elemN $elemN value $value]
        }

        if {$elemN > 1} {
            set frame [lindex $stack end]
            set children [lindex $frame 4]
            lappend children $elemN
            set frame [lreplace $frame 4 4 $children]
            set stack [lreplace $stack end end $frame]
        }
    } else {
        if {![string compare $passno/$name 2/eref]} {
            array set attrs $elem($elemN)

            if {[catch { incr counter(reference) }]} {
                set counter(reference) 1
            }
            set attrs(.COUNTER) $counter(reference)
            set elem($elemN) [array get attrs]
        }
        switch -- $name {
            rfc {
                pass2begin_$name $elemN
            }

            front
                -
            abstract
                -
            note
                -
            section
                -
            t
                -
            list
                -
            figure
                -
            preamble
                -
            postamble
                -
            xref
                -
            eref
                -
            iref
                -
            vspace
                -
            back {
                if {[lsearch0 $stack references] < 0} {
                    pass2begin_$name $elemN
                }
            }
        }
    }

    if {[lsearch -exact $ctexts $name] >= 0} {
        set ctext yes
        if {$passno == 1} {
            set attrs(.CTEXT) ""
            set elem($elemN) [array get attrs]
        }
    } else {
        set ctext no
    }
    lappend stack [list $name elemN $elemN children "" ctext $ctext]
}

proc counting {tcount tdepth} {
    set x [llength [set l [split $tcount .]]]

    if {$x > $tdepth} {
        set l [lrange $l 0 [expr $tdepth-1]]
        set x $tdepth
    } elseif {$x < $tdepth} {
        lappend l 0
        incr x
    }
    incr x -1
    set l [lreplace $l $x $x [expr [lindex $l $x]+1]]
    return [join $l .]
}

# end element

proc end {name} {
    global counter depth elemN elem passno stack xref

    set frame [lindex $stack end]
    set stack [lreplace $stack end end]

    array set av [lrange $frame 1 end]
    set elemX $av(elemN)

    if {$passno == 1} {
        array set attrs $elem($elemX)

        set attrs(.CHILDREN) $av(children)
        set attrs(.NAME) $name
        set elem($elemX) [array get attrs]

        switch -- $name {
            section {
                incr depth(section) -1
            }

            list {
                if {[incr depth(list) -1] == 0} {
                    set counter(list) 0
                }
            }
        }

        return
    }

    switch -- $name {
        rfc
            -
        front
            -
        t
            -
        list
            -
        preamble
            -
        postamble {
            if {[lsearch0 $stack references] < 0} {
                pass2end_$name $elemX
            }
        }
    }
}


# character data

proc pcdata {text} {
    global counter depth elemN elem passno stack xref
    global mode

    if {[string length [set chars [string trim $text]]] <= 0} {
        return
    }

    regsub -all "\r" $text "\n" text

    set frame [lindex $stack end]

    if {$passno == 1} {
        array set av [lrange $frame 1 end]

        set elemX $av(elemN)
        array set attrs $elem($elemX)
        if {![string compare $av(ctext) yes]} {
            append attrs(.CTEXT) $chars
        } else {
            set attrs(.CLINES) [llength [split $text "\n"]]
        }
        set elem($elemX) [array get attrs]

        return
    }

    if {[lsearch0 $stack references] >= 0} {
        return
    }

    switch -- [lindex $frame 0] {
        artwork {
            set pre 1
        }

        t
            -
        preamble
            -
        postamble {
            set pre 0
        }

        default {
            return
        }
    }

    pcdata_$mode $text $pre
}


# processing instructions

proc pi {args} {
    global options
    global counter depth elemN elem passno stack xref

    switch -- [lindex $args 0]/[llength $args] {
        xml/2 {
            if {([string first "version=\"1.0\"" [lindex $args 1]] < 0) \
                    && ([string first "version='1.0'" [lindex $args 1]] < 0)} {
                unexpected error "unexpected <?xml ...?>"
            }
        }

        DOCTYPE/4 {
            if {![string match "-public -system rfc*.dtd" \
                        [lrange $args 1 end]]} {
                unexpected error "unexpected DOCTYPE: [lindex $args 2]"
            }
        }

        rfc/2 {
            set text [string trim [lindex $args 1]]
            if {[catch { 
                if {[llength [set params [split $text =]]] != 2} {
                    error ""
                }
                set key [lindex $params 0]
                set value [lindex $params 1]
                regsub -- {^"([^"]*)"$} $value {\1} value
                set options($key) $value
            }]} {
                unexpected error "invalid rfc instruction: $text"
            }
            normalize_options
        }

        default {
            set text [join $args " "]
            unexpected warning "unknown PI: $text"
        }
    }
}

proc normalize_options {} {
    global passmax
    global options
    global mode

    foreach {o O} {compact .COMPACT toc .TOC} {
        set options($O) 0
        switch -- $options($o) {
            yes - true - 1 {
                set options($O) 1
            }
        }
    }
    foreach {o O} {private .PRIVATE header .HEADER footer .FOOTER} {
        set options($O) 0
        if {[string compare $options($o) ""]} {
            set options($O) 1
        }
    }

    if {(![string compare $mode txt]) && $options(.TOC)} {
        set passmax 3
    }
    if {$options(.PRIVATE)} {
        set options(.HEADER) 1
        set options(.FOOTER) 1
    }
}


# xml and dtd declaration

proc xmldecl {version encoding standalone} {
    if {[string compare $version 1.0]} {
        unexpected error "invalid XML version: $version"
    }
}


proc doctype {element public system internal} {
    if {[string compare $element rfc] \
            || [string compare $public ""] \
            || ([string compare $system "rfc2629.dtd"] \
                    && [string compare $system "rfc2629-bis.dtd"] \
                    && [string compare $system "rfcXXXX.dtd"])} {
        unexpected error "invalid DOCTYPE: $element+$public+$system+$internal"
    }
}


# the unexpected ...

proc unexpected {args} {
    global guiP

    set text [join [lrange $args 1 end] " "]

    switch -- [set type [lindex $args 0]] {
        error {
            global errorP

            set errorP 1
            return -code error $text
        }

        notice {
            if {$guiP == -1} {
                puts stdout $text
            }
        }

        default {
            switch -- $guiP {
                1 {
                    tk_dialog .unexpected "xml2rfc: $type" $text $type 0 OK
                }

                -1 {
                    puts stdout "$type: $text"
                }
            }
        }
    }
}


#
# specific elements
#


# the whole document

global copylong

set copylong {
"Copyright (C) The Internet Society (%YEAR%). All Rights Reserved."

"This document and translations of it may be copied and furnished to
others, and derivative works that comment on or otherwise explain it
or assist in its implementation may be prepared, copied, published and
distributed, in whole or in part, without restriction of any kind,
provided that the above copyright notice and this paragraph are
included on all such copies and derivative works. However, this
document itself may not be modified in any way, such as by removing
the copyright notice or references to the Internet Society or other
Internet organizations, except as needed for the purpose of
developing Internet standards in which case the procedures for
copyrights defined in the Internet Standards process must be
followed, or as required to translate it into languages other than
English."

"The limited permissions granted above are perpetual and will not be
revoked by the Internet Society or its successors or assigns."

"This document and the information contained herein is provided on an
&quot;AS IS&quot; basis and THE INTERNET SOCIETY AND THE INTERNET ENGINEERING
TASK FORCE DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING
BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION
HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF
MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE."
}

global funding

set funding \
"Funding for the RFC editor function is currently provided by the
Internet Society."


proc pass2begin_rfc {elemX} {
    global counter depth elemN elem passno stack xref
    global options copyrightP

    array set attrs [list number ""     obsoletes "" updates "" \
                          category info seriesNo  "" ipr     ""]
    array set attrs $elem($elemX)
    set elem($elemX) [array get attrs]

    if {(!$options(.PRIVATE)) \
            && (![string compare $attrs(number) ""]) \
            && (![string compare $attrs(ipr) ""])} {
        unexpected error \
                   "rfc element needs either a number or ipr attribute"
    }
    if {![string compare $attrs(ipr) none]} {
        set copyrightP 0
    } else {
        set copyrightP 1
    }
}

proc pass2end_rfc {elemX} {
    global counter depth elemN elem passno stack xref
    global elemZ
    global mode
    global copylong

    array set attrs $elem($elemX)

    set front [find_element front $attrs(.CHILDREN)]
    array set fv $elem($front)

    set date [find_element date $fv(.CHILDREN)]
    array set dv $elem($date)

    regsub -all %YEAR% $copylong $dv(year) copying

    if {![catch { set who $attrs(disclaimant) }]} {
        lappend copying \
"%WHO% expressly disclaims any and all warranties regarding this 
contribution including any warranty that (a) this contribution does 
not violate the rights of others, (b) the owners, if any, of other 
rights in this contribution have been informed of the rights and 
permissions granted to IETF herein, and (c) any required 
authorizations from such owners have been obtained.
This document and the information contained herein is provided on 
an &quot;AS IS&quot; basis and %UWHO% DISCLAIMS ALL WARRANTIES, EXPRESS OR 
IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE 
OFTHE INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY 
IMPLIED WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR 
PURPOSE." \
 \
"IN NO EVENT WILL %UWHO% BE LIABLE TO ANY OTHER PARTY INCLUDING 
THE IETF AND ITS MEMBERS FOR THE COST OF PROCURING SUBSTITUTE GOODS 
OR SERVICES, LOST PROFITS, LOSS OF USE, LOSS OF DATA, OR ANY 
INCIDENTAL, CONSEQUENTIAL, INDIRECT, OR SPECIAL DAMAGES WHETHER 
UNDER CONTRACT, TORT, WARRANTY, OR OTHERWISE, ARISING IN ANY WAY 
OUT OF THIS OR ANY OTHER AGREEMENT RELATING TO THIS DOCUMENT, 
WHETHER OR NOT SUCH PARTY HAD ADVANCE NOTICE OF THE POSSIBILITY OF 
SUCH DAMAGES."

        regsub -all %WHO% $copying $who copying    
        regsub -all %UWHO% $copying [string toupper $who] copying
    }

    array set index ""
    for {set elemY 1} {$elemY <= $elemZ} {incr elemY} {
        catch { unset iv }
        array set iv $elem($elemY)

        if {[string compare $iv(.NAME) iref]} {
            continue
        }
        lappend index($iv(item)+$iv(subitem)) $iv(.ANCHOR)
    }
    set items [lsort -dictionary [array names index]]

    set irefs ""
    set L ""
    set K ""
    foreach item $items {
        set iref ""
        foreach {key subkey} [split $item +] { break }
        if {[string compare [set c [string toupper [string index $key 0]]] \
                    $L]} {
            lappend iref [set L $c]
            set K ""
        } else {
            lappend iref ""
        }
        if {[string compare $key $K]} {
            lappend iref [set K $key]
        } else {
            lappend iref ""
        }
        lappend iref $subkey
        lappend iref $index($item)
        lappend irefs $iref
    }


    set attrs(.ANCHOR) [rfc_$mode $irefs $copying]
    set elem($elemX) [array get attrs]
}


# the front (either for the rfc or a reference)

global copyshort idinfo

set copyshort \
"Copyright (C) The Internet Society (%YEAR%). All Rights Reserved."

set idinfo {
    {
"This document is an Internet-Draft and is %IPR%"

"Internet-Drafts are working documents of the Internet Engineering
Task Force (IETF), its areas, and its working groups.
Note that other groups may also distribute working documents as
Internet-Drafts."

"Internet-Drafts are draft documents valid for a maximum of six months
and may be updated, replaced, or obsoleted by other documents at any time.
It is inappropriate to use Internet-Drafts as reference material or to cite
them other than as \"work in progress.\""

"The list of current Internet-Drafts can be accessed at
http://www.ietf.org/ietf/1id-abstracts.txt."

"The list of Internet-Draft Shadow Directories can be accessed at
http://www.ietf.org/shadow.html."

"This Internet-Draft will expire on %EXPIRES%."
    }

    {
"This document is an Internet-Draft and is %IPR%"

"Internet-Drafts are working documents of the Internet Engineering
Task Force (IETF), its areas, and its working groups.
Note that other groups may also distribute working documents as
Internet-Drafts."

"Internet-Drafts are draft documents valid for a maximum of six months
and may be updated, replaced, or obsoleted by other documents at any time.
It is inappropriate to use Internet-Drafts as reference material or to cite
them other than as \"work in progress.\""

"To view the entire list of Internet-Drafts Shadow Directories,
see
<a href='http://www.ietf.org/shadow.html'>http://www.ietf.org/shadow.html</a>."

"The list of current Internet-Drafts can be accessed at
<a href='http://www.ietf.org/ietf/1id-abstracts.txt'>http://www.ietf.org/ietf/1id-abstracts.txt</a>."

"The list of Internet-Draft Shadow Directories can be accessed at
<a href='http://www.ietf.org/shadow.html'>http://www.ietf.org/shadow.html</a>."

"This Internet-Draft will expire on %EXPIRES%."
    }
}

proc pass2begin_front {elemX} {
    global counter depth elemN elem passno stack xref
    global elemZ
    global options
    global ifile mode ofile
    global categories copyshort idinfo iprstatus

    array set attrs $elem($elemX)

    set title [find_element title $attrs(.CHILDREN)]
    array set tv [list abbrev ""]
    array set tv $elem($title)
    if {([string length $tv(.CTEXT)] > 42) \
            && (![string compare $tv(abbrev) ""])} {
        unexpected error "title element needs an abbrev attribute"
    }
    if {![string compare $tv(abbrev) ""]} {
        set tv(abbrev) $tv(.CTEXT)
    }
    set title [list $tv(.CTEXT)]

    set date [find_element date $attrs(.CHILDREN)]
    array set dv $elem($date)
    if {[catch { set dv(day) }]} {
        set now [clock seconds]
        set three [clock format $now -format "%B %Y %d"]
        if {(![string compare $dv(month) [lindex $three 0]]) \
                && (![string compare $dv(year) [lindex $three 1]])} {
            set dv(day) [string trimleft [lindex $three 2] 0]
        }
    }

    array set rv $elem(1)
    catch { set ofile $rv(docName) }

    if {$options(.PRIVATE)} {
        lappend left $options(private)
#        lappend left $ofile

        set status ""
    } else {
        lappend left "Network Working Group"
        if {[string compare $rv(number) ""]} {
            lappend left "Request for Comments: $rv(number)"

            if {[string compare $rv(obsoletes) ""]} {
                lappend left "Obsoletes: $rv(obsoletes)"
            }
            if {[string compare $rv(updates) ""]} {
                lappend left "Updates: $rv(updates)"
            }
            set cindex [lsearch0 $categories $rv(category)]
            if {[string compare $rv(seriesNo) ""]} {
                lappend left \
                        "[lindex [lindex $categories $cindex] 2]: $rv(seriesNo)"
            }
            set category [lindex [lindex $categories $cindex] 1]
            lappend left "Category: $category"
            set status [list [lindex [lindex $categories $cindex] 3]]
        } else {
            lappend left "Internet-Draft"
            if {[catch { set day $dv(day) }]} {
                set day 1
            }
            set secs [clock scan "$dv(month) $day, $dv(year)" -gmt true]
            incr secs [expr (182*86400)+43200]
            set day [string trimleft \
                            [clock format $secs -format "%d" -gmt true] 0]
            set expires [clock format $secs -format "%B $day, %Y" -gmt true]
            lappend left "Expires: $expires"
            set category "Expires $expires"
            if {[string compare $mode txt]} {
                set iindex 1
            } else {
                set iindex 0
            }
            set status [lindex $idinfo $iindex]
            regsub -all %IPR% $status \
                   [lindex [lindex $iprstatus \
                                   [lsearch0 $iprstatus $rv(ipr)]] 1] status
            regsub -all %EXPIRES% $status $expires status
        }
    }

    set authors ""
    foreach child [find_element author $attrs(.CHILDREN)] {
        array set av [list initials "" surname "" fullname ""]
        array set av $elem($child)

        set organization [find_element organization $av(.CHILDREN)]
        array set ov [list abbrev ""]
        array set ov $elem($organization)

        if {![string compare $ov(abbrev) ""]} {
            set ov(abbrev) $ov(.CTEXT)
        }
        set av(abbrev) "$av(initials) $av(surname)"
        if {[string length $av(abbrev)] == 1} {
            set av(abbrev) ""
            lappend names $ov(abbrev)
        } else {
            lappend names $av(surname)
        }
        set authors [linsert $authors 0 [list $av(abbrev) $ov(abbrev)]]
    }

    set lastO ""
    set right ""
    foreach author $authors {
        if {[string compare [set value [lindex $author 1]] $lastO]} {
            set right [linsert $right 0 [set lastO $value]]
        }
        if {[string compare [set value [lindex $author 0]] ""]} {
            set right [linsert $right 0 $value]
        }
    }
    set day ""
    if {(![string compare $rv(number) ""]) \
            && (![catch { set day $dv(day) }])} {
        set day "$day, "
    }
    lappend right "$dv(month) $day$dv(year)"

    if {$options(.HEADER)} {
        lappend top $options(header)
    } elseif {[string compare $rv(number) ""]} {
        lappend top "RFC $rv(number)"
    } else {
        lappend top "Internet-Draft"
        lappend title $ofile
    }
    lappend top $tv(abbrev)
    lappend top "$dv(month) $dv(year)"

    switch -- [llength $names] {
        1 {
            lappend bottom [lindex $names 0]
        }

        2 {
            lappend bottom "[lindex $names 0] &amp; [lindex $names 1]"
        }

        default {
            lappend bottom "[lindex $names 0], et. al."
        }
    }
    if {$options(.FOOTER)} {
        lappend bottom $options(footer)
    } else {
        lappend bottom $category
    }

    regsub -all %YEAR% $copyshort $dv(year) copying

    front_${mode}_begin $left $right $top $bottom $title $status $copying
}

proc pass2end_front {elemX} {
    global counter depth elemN elem passno stack xref
    global elemZ
    global options copyrightP
    global mode

    set toc ""
    set irefP 0
    if {$options(.TOC)} {
        set last ""
        for {set elemY 1} {$elemY <= $elemZ} {incr elemY} {
            catch { unset cv }
            array set cv $elem($elemY)

            switch -- $cv(.NAME) {
                rfc {
                    if {(!$options(.PRIVATE)) && $copyrightP} {
                        if {[catch { set anchor $cv(.ANCHOR) }]} {
                            set anchor rfc.copyright
                            set label "&#167;"
                        } else {
                            set label ""
                        }
                        set last [list $label "Full Copyright Statement" \
                                       $anchor]
                    }
                }

                section {
                    if {[string first . [set label $cv(.COUNTER)]] < 0} {
                        append label .
                    }
                    lappend toc [list $label $cv(title) $cv(.ANCHOR)]
                }

                back {
                    if {[catch { set anchor $cv(.ANCHOR) }]} {
                        set anchor rfc.authors
                        set label "&#167;"
                    } else {
                        set label ""
                    }
                    array set fv $elem(2)
                    set n [llength [find_element author $fv(.CHILDREN)]]
                    if {$n == 1} {
                        set title "Author's Address"
                    } else {
                        set title "Authors' Addresses"
                    }
                    lappend toc [list $label $title $anchor]
                }

                references {
                    if {[catch { set anchor $cv(.ANCHOR) }]} {
                        set anchor rfc.references
                        set label "&#167;"
                    } else {
                        set label ""
                    }
                    set toc [linsert $toc [expr [llength $toc]-1] \
                                     [list $label References $anchor]]
                }

                iref {
                    set irefP 1
                }
            }
        }
        if {[string compare $last ""]} {
            lappend toc $last
        }
    }

    front_${mode}_end $toc $irefP
}

# the abstract/note elements

proc pass2begin_abstract {elemX} {
    global mode
    abstract_$mode
}

proc pass2begin_note {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs $elem($elemX)

    note_$mode $attrs(title)
}

# the section element

proc pass2begin_section {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs [list anchor ""]
    array set attrs $elem($elemX)

    if {[lsearch0 $stack section] < 0} {
        set top 1
    } else {
        set top 0
    }

    set prefix ""
    set s $attrs(.COUNTER)
    if {$top} {
        append s .
    }
    if {([lsearch0 $stack back] >= 0) && ($top)} {
        set prefix "Appendix "
    }
    set title $attrs(title)

    set lines 0
    if {[llength $attrs(.CHILDREN)] > 0} {
        set elemY [lindex $attrs(.CHILDREN) 0]
        array set cv $elem($elemY)

        if {![string compare $cv(.NAME) figure]} {
            set lines [pass2begin_figure $elemY 1]
        }
    }

    set attrs(.ANCHOR) \
        [section_$mode $prefix$s $top $title $lines $attrs(anchor)]

    set elem($elemX) [array get attrs]
}


# the t element

proc pass2begin_t {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs [list .COUNTER "" style "" hangText ""]
    array set attrs $elem($elemX)
    set elem($elemX) [array get attrs]

    if {[string compare $attrs(.COUNTER) ""]} {
        set frame [lindex $stack end]
        array set av [lrange $frame 1 end]

        set elemY $av(elemN)
        array set av $elem($elemY)

        set attrs(style) $av(style)
        set elem($elemX) [array get attrs]
    }

    t_$mode begin $attrs(.COUNTER) $attrs(style) $attrs(hangText)
}

proc pass2end_t {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs $elem($elemX)

    t_$mode end $attrs(.COUNTER) $attrs(style) $attrs(hangText)
}

# the list element

proc pass2begin_list {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    set style empty
    foreach frame $stack {
        if {[string compare [lindex $frame 0] list]} {
            continue
        }
        array set av [lrange $frame 1 end]

        set elemY $av(elemN)
        array set av $elem($elemY)

        set style $av(style)
    }
    array set attrs $elem($elemX)
    catch { set style $attrs(style) }
    array set attrs [list style $style]
    set elem($elemX) [array get attrs]

    set counters ""
    foreach child [find_element t $attrs(.CHILDREN)] {
        array set tv $elem($child)

        lappend counters $tv(.COUNTER)
    }

    list_$mode begin $counters $attrs(style)
}

proc pass2end_list {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs $elem($elemX)

    list_$mode end "" $attrs(style)
}


# the figure element

proc pass2begin_figure {elemX {internal 0}} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs [list anchor ""]
    array set attrs $elem($elemX)

    set lines 0
    foreach p {preamble postamble} {
        if {[llength [find_element $p $attrs(.CHILDREN)]] == 1} {
            incr lines 3
        }
    }
    if {$lines > 5} {
        set lines 5
    }

    set artwork [find_element artwork $attrs(.CHILDREN)]
    array set av $elem($artwork)

# if artwork is empty!
    catch { incr lines $av(.CLINES) }

    if {$internal} {
        return $lines
    }

    figure_$mode $lines $attrs(anchor)
}


# the preamble/postamble elements

proc pass2begin_preamble {elemX} {
    global mode

    preamble_$mode begin
}

proc pass2end_preamble {elemX} {
    global mode

    preamble_$mode end
}

proc pass2begin_postamble {elemX} {
    global mode

    postamble_$mode begin
}

proc pass2end_postamble {elemX} {
    global mode

    postamble_$mode end
}


# the xref element

proc pass2begin_xref {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

# pageno is ignored for now...
    array set attrs [list pageno false]
    array set attrs $elem($elemX)

    set anchor $attrs(target)
    xref_$mode $attrs(.CTEXT) $xref($anchor) $anchor
}


# the eref element

proc pass2begin_eref {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs $elem($elemX)

    eref_$mode $attrs(.CTEXT) $attrs(.COUNTER) $attrs(target)
}


# the iref element

proc pass2begin_iref {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs [list subitem ""]
    array set attrs $elem($elemX)

    set attrs(.ANCHOR) [iref_$mode $attrs(item) $attrs(subitem)]

    set elem($elemX) [array get attrs]
}


# the vspace element

proc pass2begin_vspace {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs [list blankLines 0]
    array set attrs $elem($elemX)
    set elem($elemX) [array get attrs]

    vspace_$mode $attrs(blankLines)
}


# the references/reference elements

# we intercept the back element so we can put the Author's addresses
# after the References section (if any) and before any Appendices

proc pass2begin_back {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs $elem($elemX)

    foreach child [find_element references $attrs(.CHILDREN)] {
        pass2begin_references $child
    }

    array set fv $elem(2)

    set authors ""
    foreach child [find_element author $fv(.CHILDREN)] {
        array set av [list initials "" surname "" fullname ""]
        array set av $elem($child)

        set organization [find_element organization $av(.CHILDREN)]
        array set ov [list abbrev ""]
        array set ov $elem($organization)

        set block1 ""
        if {[string compare $av(fullname) ""]} {
            lappend block1 $av(fullname)
        }
        lappend block1 $ov(.CTEXT)

        set address [find_element address $av(.CHILDREN)]
        set block2 ""
        if {[llength $address] == 1} {
            array set bv $elem($address)

            set postal [find_element postal $bv(.CHILDREN)]
            if {[llength $postal] == 1} {
                array set pv $elem($postal)

                foreach street [find_element street $pv(.CHILDREN)] {
                    array set sv $elem($street)
    
                    lappend block1 $sv(.CTEXT)
                }

                set s ""
                foreach e {city region code} t {"" ", " "  "} {
                    set f [find_element $e $pv(.CHILDREN)]
                    if {[llength $f] == 1} {
                        catch { unset fv }
                        array set fv $elem($f)
    
                        if {[string compare $s ""]} {
                            append s $t
                        }
                        append s $fv(.CTEXT)
                    }
                }
                if {[string compare $s ""]} {
                    lappend block1 $s
                }
                set f [find_element country $pv(.CHILDREN)]
                if {[llength $f] == 1} {
                    catch { unset fv }
                    array set fv $elem($f)
    
                    lappend block1 $fv(.CTEXT)
                }
            }

            set block2 ""
            foreach e {phone facsimile email uri} {
                set f [find_element $e $bv(.CHILDREN)]
                if {[llength $f] == 1} {
                    catch { unset fv }
                    array set fv $elem($f)

                    lappend block2 [list $e $fv(.CTEXT)]
                }
            }
        }

        lappend authors [list $block1 $block2]
    }

    set attrs(.ANCHOR) [back_$mode $authors]
    set elem($elemX) [array get attrs]
}

proc pass2begin_references {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs [list title References]
    array set attrs $elem($elemX)

    set attrs(.ANCHOR) [references_$mode begin $attrs(title)]
    set elem($elemX) [array get attrs]
    foreach child [find_element reference $attrs(.CHILDREN)] {
        pass2begin_reference $child
    }
    references_$mode end
}

proc pass2begin_reference {elemX} {
    global counter depth elemN elem passno stack xref
    global mode

    array set attrs [list anchor "" target ""]
    array set attrs $elem($elemX)

    set front [find_element front $attrs(.CHILDREN)]
    array set fv $elem($front)

    set childN [llength [set children [find_element author $fv(.CHILDREN)]]]

    set childA 0
    foreach child [find_element author $fv(.CHILDREN)] {
        incr childA

        array set av [list initials "" surname "" fullname ""]
        array set av $elem($child)

        set organization [find_element organization $av(.CHILDREN)]
        array set ov [list abbrev ""]
        array set ov $elem($organization)
        if {![string compare $ov(abbrev) ""]} {
            set ov(abbrev) $ov(.CTEXT)
        }

        set mref ""
        set uref ""
        set address [find_element address $av(.CHILDREN)]
        if {[llength $address] == 1} {
            array set bv $elem($address)

            foreach {k v p} {email mref mailto: uri uref ""} {
                set u [find_element $k $bv(.CHILDREN)]
                if {[llength $u] == 1} {
                    catch { unset uv }
                    array set uv $elem($u)

                    set $v $p$uv(.CTEXT)
                }
            }
        }
        if {![string compare $mref ""]} {
            set mref $uref
        } elseif {![string compare $uref ""]} {
            set uref $mref
        }

        if {($childA > 1) && ($childA == $childN)} {
            set av(abbrev) "$av(initials) $av(surname)"
        } else {
            set av(abbrev) "$av(surname), $av(initials)"
        }
        if {[string length $av(abbrev)] == 2} {
            lappend names [list $ov(.CTEXT) $uref]
        } else {
            lappend names [list $av(abbrev) $mref]
        }
    }
    
    set title [find_element title $fv(.CHILDREN)]
    array set tv [list abbrev ""]
    array set tv $elem($title)
    set title $tv(.CTEXT)

    set series ""
    foreach child [find_element seriesInfo $attrs(.CHILDREN)] {
# backwards compatibility...
        array set sv $elem($child)
        if {([info exists sv(name)]) && ([info exists sv(value)])} {
            lappend series "$sv(name) $sv(value)"
        } else {
            lappend series $sv(.CTEXT)
        }
    }

    set date [find_element date $fv(.CHILDREN)]
    array set dv $elem($date)
    if {[string compare $dv(month) ""]} {
        set date "$dv(month) $dv(year)"
    } else {
        set date $dv(year)
    }

    reference_$mode $attrs(.COUNTER) $names $title $series $date \
                    $attrs(anchor) $attrs(target)
}

proc find_element {name children} {
    global counter depth elemN elem passno stack xref

    set result ""
    foreach child $children {
        array set attrs $elem($child)

        if {![string compare $attrs(.NAME) $name]} {
            lappend result $child
        }
    }

    return $result
}

# could use "lsearch -glob" followed by a "string compare", but there are
# some amusing corner cases with that...

proc lsearch0 {list exact} {
    set x 0
    foreach elem $list {
        if {![string compare [lindex $elem 0] $exact]} {
            return $x
        }
        incr x
    }

    return -1
}


#
# text output
#


proc rfc_txt {irefs copying} {
    global options copyrightP
    global funding
    global header footer lineno pageno blankP
    global indexpg

    end_page

    if {[llength $irefs] > 0} {
        set indexpg $pageno

        write_line "Index"

        foreach iref $irefs {
            foreach {L item subitem pages} $iref { break }

            if {[string compare $L ""]} {
                write_line ""
                write_line $L           
            }

            if {[string compare $item ""]} {
                write_text $item
                if {[string compare $subitem ""]} {
                    flush_text
                    write_text "   $subitem"
                }
            } else {
                write_text "   $subitem"
            }

            set s "  "
            foreach page $pages {
                write_text "$s$page"
                set s ", "
            }
            flush_text  
        }

        end_page
    }

    if {(!$options(.PRIVATE)) && $copyrightP} {
        set result $pageno

        write_line "Full Copyright Statement"

        foreach para $copying {
            write_line ""
            pcdata_txt $para
        }
        write_line ""

        if {![have_lines 4]} {
            end_page
        }
        write_line "Acknowledgement"
        write_line ""
        pcdata_txt $funding

        end_page
    } else {
        set result ""
    }

    return $result
}

proc front_txt_begin {left right top bottom title status copying} {
    global options copyrightP
    global ifile mode ofile
    global header footer lineno pageno blankP
    global eatP
    global passno indexpg

    set header [three_parts $top]
    set footer [string trimright [three_parts $bottom]]
    set lineno 1
    set pageno 1
    set blankP 0
    set eatP 0

    if {$passno == 2} {
        set indexpg 0
    }

    for {set i 0} {$i < 4} {incr i} {
        write_line "" -1
    }
    set left [munge_long $left]
    set right [munge_long $right]
    foreach l $left r $right {
        set l [chars_expand $l]
        set r [chars_expand $r]
        set len [expr 72-[string length $l]]
        write_line [format %s%*.*s $l $len $len $r]
    }
    write_line "" -1
    write_line "" -1

    foreach line $title {
        write_text [chars_expand $line] c
    }

    write_line "" -1

    if {!$options(.PRIVATE)} {
        write_line "Status of this Memo"
        foreach para $status {
            write_line ""
            pcdata_txt $para
        }
    }

    if {(!$options(.PRIVATE)) && $copyrightP} {
        write_line "" -1
        write_line "Copyright Notice"
        write_line "" -1
        pcdata_txt $copying
    }
    incr lineno -1
}

proc front_txt_end {toc irefP} {
    global options
    global header footer lineno pageno blankP
    global indexpg

    if {$options(.TOC)} {
        set last [lindex $toc end]
        if {[string compare [lindex $last 1] "Full Copyright Statement"]} {
            set last ""
        } else {
            set toc [lreplace $toc end end]
        }
        if {$irefP} {
            lappend toc [list "" Index $indexpg]
        }
        if {[string compare $last ""]} {
            lappend toc $last
        }

        if {(![have_lines [expr [llength $toc]+3]]) || ($lineno > 17)} {
            end_page
        } else {
            write_line "" -1
        }
        write_line "Table of Contents"
        write_line "" -1

        set len1 0
        set len2 0
        foreach c $toc {
            if {[set x [string length [lindex $c 0]]] > $len1} {
                set len1 $x
            }
            if {[set x [string length [lindex $c 2]]] > $len2} {
                set len2 $x
            }
        }
        set mid [expr 72-($len1+$len2+5)]

        foreach c $toc {
            set s1 [format "   %-*.*s " $len1 $len1 [lindex $c 0]]
            set s2 [format " %*.*s" $len2 $len2 [lindex $c 2]]
            set title [chars_expand [string trim [lindex $c 1]]]
            while {[set i [string length $title]] > $mid} {
                set phrase [string range $title 0 [expr $mid-1]]
                if {[set x [string last " " $phrase]] < 0} {
                    if {[set x [string first " " $title]] < 0} {
                        break
                    }
                }
                write_toc $s1 [string range $title 0 [expr $x-1]] \
                        [format " %-*.*s" $len2 $len2 ""] $mid 0
                set s1 [format "   %-*.*s " $len1 $len1 ""]
                set title [string trimleft [string range $title $x end]]
            }
            write_toc $s1 $title $s2 $mid 1
        }
    }

    if {($options(.TOC) || !$options(.COMPACT))} {
        end_page
    }
}

proc write_toc {s1 title s2 len dot} {
    set x [string length $title]
    if {($dot) && ($x < $len)} {
        if {$x%2} {
            append title " "
            incr x
        }
        while {$x < $len} {
            append title " ."
            incr x 2
        }
    }

    write_line [format "%s%-*.*s%s" $s1 $len $len $title $s2]
}

proc abstract_txt {} {
    write_line "" -1
    write_line "Abstract"
    write_line "" -1
}

proc note_txt {title} {
    write_line "" -1
    write_line [chars_expand $title]
    write_line "" -1
}

proc section_txt {prefix top title lines anchor} {
    global options
    global header footer lineno pageno blankP

    if {($top && !$options(.COMPACT)) || (![have_lines [expr $lines+5]])} {
        end_page
    } else {
        write_line ""
    }

    push_indent -3
    write_text "$prefix "
    push_indent [expr [string length $prefix]+1]
    write_text [chars_expand $title]
    flush_text
    pop_indent
    pop_indent

    return $pageno
}

proc t_txt {tag counter style hangText} {
    global options
    global eatP

    if {![string compare $tag end]} {
        return
    }

    if {[string compare $counter ""]} {
        set pos [pop_indent]
        set l [split $counter .]
        switch -- $style {
            numbers {
                set counter "[lindex $l end]. "
            }

            symbols {
                set counter "[lindex { - o * + } [expr [llength $l]%4]] "
            }

            hanging {
                set counter $hangText
            }

            default {
                set counter "  "
            }
        }
        flush_text
        if {!$options(.COMPACT)} {
            write_line ""
        }
        write_text "$counter "
        push_indent $pos
    } else {
        write_line ""
    }

    set eatP 1
}

proc list_txt {tag counters style} {
    global options
    global eatP

    switch -- $tag {
        begin {
            switch -- $style {
                numbers {
                    set i 0
                    foreach counter $counters {
                        if {[set j [string length \
                                           [lindex [split $counter .] end]]] \
                                > $i} {
                            set i $j
                        }
                    }
                    incr i 1
                }

                symbols {
                    set i 1
                }

                default {
                    set i 1
                }
            }
            push_indent [expr $i+2]
        }

        end {
            flush_text
            if {!$options(.COMPACT)} {
                write_line ""
            }
            pop_indent

            set eatP 1
        }
    }
}

proc figure_txt {lines anchor} {
    if {![have_lines $lines]} {
        end_page
    }
}

proc preamble_txt {tag} {
    switch -- $tag {
        begin {
            write_line ""
        }
    }
}

proc postamble_txt {tag} {
}

proc xref_txt {text av target} {
    global eatP

    array set attrs $av    

    switch -- $attrs(type) {
        section {
            set line "Section $attrs(value)"
        }

        appendix {
            set line "Appendix $attrs(value)"
        }

        figure {
            set line "Figure $attrs(value)"
        }

        default {
            set line "\[$attrs(value)\]"
        }
    }
    if {[string compare $text ""]} {
        switch -- $attrs(type) {
            section
                -
            appendix
                -
            figure {
                set line "[chars_expand $text] ($line)"
            }

            default {
                set line "[chars_expand $text]$line"
            }
        }       
    }
    write_text $line

    set eatP 0
}

proc eref_txt {text counter target} {
    global eatP
    global erefs

    if {[string compare $text ""]} {
        set line "[chars_expand $text]"
    }
    if {([string first "#" $target] < 0) \
            && ([string compare $text $target])} {
        set erefs($counter) $target
        append line "\[$counter\]"
    }
    write_text $line

    set eatP 0
}

proc iref_txt {item subitem} {
    global header footer lineno pageno blankP

    return $pageno
}

proc vspace_txt {lines} {
    global header footer lineno pageno blankP
    global eatP

    flush_text
    if {$lineno+$lines >= 52} {
        end_page
    } else {
        while {$lines > 0} {
            incr lines -1

            write_it ""
            incr lineno
        }
    }

    set eatP 1
}

proc references_txt {tag {title ""}} {
    global options
    global header footer lineno pageno blankP

    switch -- $tag {
        begin {
            if {$options(.COMPACT)} {
                write_line ""
            } else {
                end_page
            }
            write_line $title

            return $pageno
        }

        end {
            global erefs

            foreach eref [lsort -integer [array names erefs]] {
                write_line ""

                set i [expr [string length [set prefix "\[$eref\]"]]+2]
                write_text $prefix

                push_indent $i

                write_text "  $erefs($eref)"

                pop_indent
            }
        }
    }
}

proc reference_txt {prefix names title series date anchor target} {
    write_line ""

    set i [expr [string length [set prefix "\[$prefix\]"]]+2]
    write_text $prefix

    push_indent $i

    set hack $names
    set names ""
    # carl hack...
    foreach name $hack {
        if {[string compare [lindex $name 0] ""]} {     
            lappend names $name
        }
    }
    set nameN [llength $names]

    set s "  "
    set nameA 1
    foreach name $names {
        incr nameA
        write_text $s[chars_expand [lindex $name 0]]
        if {$nameA == $nameN} {
            set s " and "
        } else {
            set s ", "
        }
    }
    write_text "$s\"[chars_expand $title]\""
    foreach serial $series {
        if {[regexp -nocase -- "internet-draft (draft-.*)" $serial x n] == 1} {
            set serial "$n (work in progress)"
        }
        write_text ", [chars_expand $serial]"
    }
# carl hack...
    if {[string compare $date ""]} {
        write_text ", $date"
    }
    if {[string compare $target ""]} {
        write_text ", <$target>"
    }
    write_text .

    pop_indent
}

global contacts

set contacts { {phone Phone} {facsimile Fax} {email EMail} {uri URI} }

proc back_txt {authors} {
    global options
    global header footer lineno pageno blankP
    global contacts

    set lines 5
    set author [lindex $authors 0]
    incr lines [llength [lindex $author 0]]
    incr lines [llength [lindex $author 1]]
    if {![have_lines $lines]} {
        end_page
    } elseif {$lineno != 3} {
        write_line "" -1
        write_line "" -1
    }
    set result $pageno

    if {[llength $authors] > 1} {
        set s1 "s'"
        set s2 es
    } else {
        set s1 "'s"
        set s2 ""
    }
    set s "Author$s1 Address$s2"

    set firstP 1
    foreach author $authors {
        set block1 [lindex $author 0]
        set block2 [lindex $author 1]

        set lines 3
        incr lines [llength $block1]
        incr lines [llength $block2]
        if {![have_lines $lines]} {
            end_page
        }

        if {[string compare $s ""]} {
            write_line $s
            set s ""
        } else {
            write_line "" -1
        }
        write_line "" -1

        foreach line $block1 {
            write_line "   [chars_expand $line]"
        }

        if {[llength $block2] > 0} {
            write_line ""
            foreach contact $block2 {
                set key [lindex $contact 0]
                set value [lindex [lindex $contacts \
                                          [lsearch0 $contacts $key]] 1]
                set value [format %-6s $value:]
                write_line "   $value [chars_expand [lindex $contact 1]]"
            }
        }
    }

    return $result
}

proc pcdata_txt {text {pre 0}} {
    global eatP

    if {(!$pre) && ($eatP)} {
        set text [string trimleft $text]
    }
    set eatP 0

    if {!$pre} {
        regsub -all "\n\[ \t\n\]*" $text "\n" text
        regsub -all "\[ \t\]*\n\[ \t\]*" $text "\n" text
        set prefix ""
    }

    foreach line [split $text "\n"] {
        set line [chars_expand $line]
        if {$pre} {
            write_line [string trimright $line] 1
        } else {
            write_text $prefix$line
            set prefix " "
        }
    }
}


# low-level formatting

proc start_page {} {
    global stdout
    global header footer lineno pageno blankP

    write_it $header
    write_it ""
    write_it ""
    set lineno 3
    set blankP 1
}

proc end_page {} {
    global stdout
    global header footer lineno pageno blankP

    flush_text

    if {$lineno <= 0} {
        return
    }
    while {$lineno < 54} {
        write_it ""
        incr lineno
    }

    set text [format "\[Page %d\]" $pageno]
    incr pageno
    set len [string length $text]
    set len [expr (72-[string length $footer])-$len]
    if {$len < 4} {
        set len 4
    }
    write_it [format %s%*.*s%s $footer $len $len "" $text]
    write_it "\f"

    set lineno 0
}

proc three_parts {stuff} {
    set result [chars_expand [lindex $stuff 0]]
    set len [string length $result]

    set text [chars_expand [lindex $stuff 1]]
    set len [expr (72-[string length $text])/2-$len]
    if {$len < 4} {
        set len 4
    }
    append result [format %*.*s%s $len $len "" $text]
    set len [string length [set text [chars_expand [lindex $stuff 2]]]]
    set len [expr (72-[string length $result])-$len]
    append result [format %*.*s%s $len $len "" $text]

    return $result
}

global rfcTxtHome idTxtHome

set rfcTxtHome ftp://ftp.isi.edu/in-notes
set idTxtHome http://www.ietf.org/internet-drafts

proc munge_long {lines} {
    global mode

    set result ""

    foreach buffer $lines {
        set linkP 0
        if {(![string compare $mode html]) \
                && (([string match Obsoletes:* $buffer])
                        || ([string match Updates:* $buffer]))} {
            set linkP 1
        }
        while {[set i [string length $buffer]] > 34} {
            set line [string range $buffer 0 33]
            if {[set x [string last " " $line]] < 0} {
                if {[set x [string first " " $buffer]] < 0} {
                    break
                }
            }
            set line [string range $buffer 0 [expr $x-1]]
            if {$linkP} {
                set line [munge_line $line]
            }
            lappend result $line
            set buffer [string trimleft [string range $buffer $x end]]
        }

        if {$linkP} {
            set buffer [munge_line $buffer]
        }
        lappend result $buffer
    }

    return $result
}

proc munge_line {line} {
    global rfcTxtHome
    global rfcHtmlHome

    if {[set y [string first : $line]] >= 0} {
        set start [string range $line 0 $y]
        set line [string range $line [expr $y+1] end]
    } else {
        set start ""
    }

    set s ""
    foreach n [split $line ,] {
        set n [string trim $n]
        if {[catch { set rfcHtmlHome }]} {
            append start $s "<a href='$rfcTxtHome/rfc$n.txt'>$n</a>"
        } else {
            append start $s "<a href='$rfcHtmlHome/rfc$n.html'>$n</a>"
        }
        set s ", "
    }

    return $start
}

global buffer indent

set buffer ""
set indent 3

proc push_indent {pos} {
    global indent indents

    lappend indents $pos
    incr indent $pos
}

proc flush_text {} {
    global buffer

    if {[string compare $buffer ""]} {
        set rest $buffer
        set buffer ""
        write_line $rest
    }
}

proc write_text {text {direction l}} {
    global buffer
    global indents indent

    if {![string compare $buffer ""]} {
        set buffer [format %*.*s $indent $indent ""]    
    }
    append buffer $text

    set flush [string compare $direction l]
    while {([set i [string length $buffer]] > 72) || ($flush)} {
        if {$i > 72} {
            set line [string range $buffer 0 71]
            if {[set x [string last " " $line]] < 0} {
                if {[set x [string first " " $buffer]] < 0} {
                    set x $i
                }
            } elseif {$x+1 == $indent} {
                set x $i
            }
            set text [string range $buffer 0 [expr $x-1]]
            set rest [string trimleft [string range $buffer $x end]]
        } else {
            set text $buffer
            set rest ""
        }
        set buffer ""

        if {![string compare $direction c]} {
            set text [string trimleft $text]
            set len [expr (72-[string length $text])/2]
            set text [format %*.*s%s $len $len "" $text]
        }
        write_line $text

        if {[string compare $rest ""]} {
            set buffer [format %*.*s%s $indent $indent "" $rest]
        } else {
            break
        }
    }
}

proc pop_indent {} {
    global indent indents

    set pos [lindex $indents end]
    incr indent -$pos
    set indents [lreplace $indents end end]

    return $pos
}

proc have_lines {cnt} {
    global header footer lineno pageno blankP

    if {($cnt < 40) && ($lineno+$cnt > 52)} {
        return 0
    }
    return 1
}

proc write_line {line {pre 0}} {
    global stdout
    global header footer lineno pageno blankP
    global buffer

    flush_text
    if {$lineno == 0} {
        start_page
    }
    if {![set x [string compare $line ""]]} {
        set blankO $blankP
        set blankP 1
        if {($blankO) && (!$pre || $lineno == 3)} {
            return
        }
    } else {
        set blankP 0
    }
    if {($pre) && ($x)} {
        set pre "   "
    } else {
        set pre ""
    }
    write_it $pre$line
    incr lineno
    if {$lineno >= 52} {
        end_page
    }
}

proc write_it {line} {
    global passno
    global options
    global stdout
    global header footer lineno pageno blankP

    if {(!$options(.TOC)) || ($passno == 3)} {
        puts $stdout $line
    }
}

global oentities

# &amp; must always be last...
set oentities { {&lt;}     {<} {&gt;}  {>}
                {&apos;}   {'} {&quot;} {"}
                {&#8211;}  {-} {&#151;} {--}
                {&endash;} {-} {&emdash;} {--}
                {&amp;} {\&} }

proc chars_expand {text {flatten 1}} {
    global entities

    foreach {entity chars} $entities {
        regsub -all -nocase $entity $text $chars text
    }
    if {$flatten} {
        regsub -all "\n\[ \t\]*" $text " " text
    }

    return $text
}


#
# html output
#


# don't need to return anything even though rfc_txt does...

proc rfc_html {irefs copying} {
    global options copyrightP
    global funding
    global stdout

    if {[llength $irefs] > 0} {
        toc_html rfc.index
        puts $stdout "<h3>Index</h3>"

        puts $stdout "<table>"
        foreach iref $irefs {
            foreach {L item subitem pages} $iref { break }

            if {[string compare $L ""]} {
                puts $stdout "<tr><td><b>$L</b></td><td>&nbsp;</td></tr>"
            }
            
            if {[string compare $subitem ""]} {
                if {[string compare $item ""]} {
                    puts $stdout "<tr><td>&nbsp;</td><td>$item</td></tr>"
                }
                set key $subitem
                set t "&nbsp;&nbsp;"
            } else {
                set key $item
                set t ""
            }

            if {[llength $pages] == 1} {
                set key "<a href=\"#[lindex $pages 0]\">$key</a>"
            } else {
                set i 0
                set s "  "
                foreach page $pages {
                    append key "$s<a href=\"#$page\">[incr i]</a>"
                    set s ", "
                }
            }

            puts $stdout "<tr><td>&nbsp;</td><td>$t$key</td></tr>"
        }
        puts $stdout "</table>"
    }

    if {(!$options(.PRIVATE)) && $copyrightP} {
        toc_html rfc.copyright
        puts $stdout "<h3>Full Copyright Statement</h3>"

        foreach para $copying {
            puts $stdout "<p class='copyright'>"
            pcdata_html $para
            puts $stdout "</p>"
        }

        puts $stdout "<h3>Acknowledgement</h3>"
        puts $stdout "<p class='copyright'>"
        pcdata_html $funding
        puts $stdout "</p>"
    }

    puts $stdout "</font></body></html>"

    return ""
}

global htmlstyle

set htmlstyle \
"<STYLE type='text/css'>
    .title { color: #990000; font-size: 22px; line-height: 22px; font-weight: bold; text-align: right;
             font-family: helvetica, arial, sans-serif }
    .filename { color: #666666; font-size: 18px; line-height: 28px; font-weight: bold; text-align: right;
                  font-family: helvetica, arial, sans-serif }
    p.copyright { color: #000000; font-size: 10px;
                  font-family: verdana, charcoal, helvetica, arial, sans-serif }
    p { margin-left: 2em; margin-right: 2em; }
    ol { margin-left: 2em; margin-right: 2em; }
    ul.text { margin-left: 2em; margin-right: 2em; }
    pre { margin-left: 3em; color: #333333 }
    ul.toc { color: #000000; line-height: 16px;
             font-family: verdana, charcoal, helvetica, arial, sans-serif }
    H3 { color: #333333; font-size: 16px; line-height: 16px; font-family: helvetica, arial, sans-serif }
    H4 { color: #000000; font-size: 14px; font-family: helvetica, arial, sans-serif }
    TD.header { color: #ffffff; font-size: 10px; font-family: arial, helvetica, san-serif; valign: top }
    TD.author-text { color: #000000; font-size: 10px;
                     font-family: verdana, charcoal, helvetica, arial, sans-serif }
    TD.author { color: #000000; font-weight: bold; margin-left: 4em; font-size: 10px; font-family: verdana, charcoal, helvetica, arial, sans-serif }
    A:link { color: #990000; font-size: 10px; text-transform: uppercase; font-weight: bold;
             font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif }
    A:visited { color: #333333; font-weight: bold; font-size: 10px; text-transform: uppercase;
                font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif }
    A:name { color: #333333; font-weight: bold; font-size: 10px; text-transform: uppercase;
             font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif }
    .link2 { color:#ffffff; font-weight: bold; text-decoration: none;
             font-family: monaco, charcoal, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif;
             font-size: 9px }
    .RFC { color:#666666; font-weight: bold; text-decoration: none;
           font-family: monaco, charcoal, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif;
           font-size: 9px }
    .hotText { color:#ffffff; font-weight: normal; text-decoration: none;
               font-family: charcoal, monaco, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif;
               font-size: 9px }
</style>"


proc front_html_begin {left right top bottom title status copying} {
    global options copyrightP
    global stdout
    global htmlstyle
    global hangP

    set hangP 0

    puts -nonewline $stdout "<html><head><title>"
    if {$options(.PRIVATE)} {
        pcdata_html "$options(private): "
    }
    pcdata_html [lindex $title 0]
    puts $stdout "</title>"
    if {$options(.PRIVATE)} {
        puts -nonewline $stdout "<meta http-equiv=\"Expires\" content=\""
        puts -nonewline $stdout [clock format [clock seconds] \
                                      -format "%a, %d %b %Y %T +0000" \
                                      -gmt true]
        puts $stdout "\">"
    }
    puts $stdout "$htmlstyle\n</head>"
    puts -nonewline $stdout "<body bgcolor=\"#ffffff\""
    if {[string compare $options(background) ""]} {
        puts -nonewline $stdout " background=\"$options(background)\""
    }
    puts $stdout "alink=\"#000000\" vlink=\"#666666\" link=\"#990000\">" 

    xxxx_html

    puts $stdout "<table width=\"66%\" border=\"0\" cellpadding=\"0\" cellspacing=\"0\"><tr><td><table width=\"100%\" border=\"0\" cellpadding=\"2\" cellspacing=\"1\">"
    set left [munge_long $left]
    set right [munge_long $right]
    set lc ""
    set rc ""
    foreach l $left r $right {
        if {[string compare $l ""]} {
            set l $l
        } else {
            set l "&nbsp;"
        }
        if {[string compare $r ""]} {
            set r $r
        } else {
            set r "&nbsp;"
        }
        puts $stdout "<tr valign=\"top\"><td width=\"33%\" bgcolor=\"#666666\" class=\"header\">$l</td><td width=\"33%\" bgcolor=\"#666666\" class=\"header\">$r</td></tr>"
    }
    puts $stdout "</table></td></tr></table>"

    set color 990000
    set size 3
    set br <br>
    set class title
    foreach line $title {
        puts -nonewline $stdout "<div align=\"right\"><font face=\"monaco, MS Sans Serif\" color=\"#$color\" size=\"+$size\"><b>$br<span class=\"$class\">"
        pcdata_html $line
        puts $stdout "</span></b></font></div>"
        set color 666666
        set size 2
        set br ""
        set class filename
    }
    puts $stdout "<font face=\"verdana, helvetica, arial, sans-serif\" size=\"2\">"

    if {!$options(.PRIVATE)} {
        puts $stdout ""
        puts $stdout "<h3>Status of this Memo</h3>"
        foreach para $status {
            puts $stdout "<p>"
            pcdata_html $para
            puts $stdout "</p>"
        }
    }

    if {(!$options(.PRIVATE)) && $copyrightP} { 
        puts $stdout ""
        puts $stdout "<h3>Copyright Notice</h3>"
        puts $stdout "<p>"
        pcdata_html $copying
        puts $stdout "</p>"
    }
}

proc front_html_end {toc irefP} {
    global options copyrightP
    global stdout

    if {!$options(.TOC)} {
        return
    }

    xxxx_html toc

    puts $stdout "<h3>Table of Contents</h3>"
    puts $stdout "<ul compact class=\"toc\">"
    set last [lindex $toc end]
    if {[string compare [lindex $last 1] "Full Copyright Statement"]} {
        set last ""
    } else {
        set toc [lreplace $toc end end]
    }
    if {$irefP} {
        lappend toc [list "&#167;" Index rfc.index]
    }
    if {[string compare $last ""]} {
        lappend toc $last
    }
    foreach c $toc {
        puts -nonewline $stdout "<b><a href=\"#[lindex $c 2]\">"
        pcdata_html [lindex $c 0]
        puts $stdout "</a>&nbsp;"
        pcdata_html [lindex $c 1]
        puts $stdout "<br></b>"
    }
    puts $stdout "</ul>"
    puts $stdout "<br clear=\"all\">"
}

proc abstract_html {} {
    global stdout

    puts $stdout ""
    puts $stdout "<h3>Abstract</h3>"
}

proc note_html {title} {
    global stdout

    puts $stdout ""
    puts -nonewline $stdout "<h3>"
    pcdata_html $title
    puts $stdout "</h3>"
}

proc section_html {prefix top title {lines 0} anchor} {
    global stdout

    puts $stdout ""
    if {[string match *. $prefix]} {
        toc_html $anchor
        puts -nonewline $stdout "<h3>$prefix&nbsp;"
        pcdata_html $title
        puts $stdout "</h3>"
    } else {
        puts -nonewline $stdout "<h4><a name=\"$anchor\">$prefix</a>&nbsp;"
        pcdata_html $title
        puts $stdout "</h4>"
    }

    return $anchor
}

proc t_html {tag counter style hangText} {
    global stdout
    global hangP

    if {[string compare $tag begin]} {
        set s /
    } else {
        set s ""
    }
    puts $stdout ""
    if {![string compare $style "hanging"]} {
        if {![string compare $tag begin]} {
            puts $stdout "<dt>$hangText</dt>"
        }
        puts $stdout "<${s}dd>"

        set hangP 1
    } elseif {([string compare $counter ""]) \
                    && ([string compare $style empty])} {
        puts $stdout "<${s}li>"

        set hangP 0
    } else {
        puts $stdout "<${s}p>"

        set hangP 0
    }
}

proc list_html {tag counters style} {
    global stdout
    global hangP

    if {[string compare $tag begin]} {
        set s /
        set c ""
    } else {
        set s ""
        set c " class=\"text\""
    }
    puts $stdout ""
    switch -- $style {
        numbers {
            puts $stdout "<${s}ol$c>"
        }

        symbols {
            puts $stdout "<${s}ul$c>"
        }

        hanging {
            if {[string compare $tag begin]} {
                puts $stdout "</dl></blockquote>"
            } else {
                puts $stdout "<blockquote$c><dl>"
            }
        }

        default {
            puts $stdout "<${s}blockquote$c>"
        }
    }

    set hangP 0
}

proc figure_html {lines anchor} {
    global stdout

    if {[string compare $anchor ""]} {
        puts $stdout "<a name=\"$anchor\"></a>"
    }
}

proc preamble_html {tag} {
    t_html $tag "" "" ""
}

proc postamble_html {tag} {
    t_html $tag "" "" ""
}

proc xref_html {text av target} {
    global elem
    global stdout

    array set attrs $av    

    set elemY $attrs(elemN)
    array set tv [list title ""]
    array set tv $elem($elemY)

    switch -- $attrs(type) {
        section {
            set line "Section $attrs(value)"
        }

        appendix {
            set line "Appendix $attrs(value)"
        }

        figure {
            set line "Figure $attrs(value)"
        }

        default {
            set line "\[$attrs(value)\]"
        }
    }

    if {![string compare $text ""]} {
        set text $tv(title)
    }
    set post ""
    if {[string compare $text ""]} {
        switch -- $attrs(type) {
            section
                -
            appendix
                -
            figure {
            }

            default {
                set post $line
            }
        }
    } else {
        set text $line
    }

    puts -nonewline $stdout "<a href=\"#$target\">$text</a>$post"
}

proc eref_html {text counter target} {
    global stdout

    if {![string compare $text ""]} {
        set text $target
    }

    puts -nonewline $stdout "<a href=\"$target\">$text</a>"
}

proc iref_html {item subitem} {
    global anchorN
    global stdout

    set anchor anchor[incr anchorN]

    puts -nonewline $stdout "<a name=\"$anchor\"></a>"

    return $anchor
}

proc vspace_html {lines} {
    global stdout
    global hangP

    if {$lines > 5} {
        return
    }
    incr lines -$hangP
    while {$lines >= 0} {
        incr lines -1
        puts $stdout "<br>"
    }

    set hangP 0
}

# don't need to return anything even though back_txt does...

proc references_html {tag {title ""}} {
    global stdout

    switch -- $tag {
        begin {
            toc_html rfc.references
            puts $stdout "<h3>"
            pcdata_html $title
            puts $stdout "</h3>"

            puts $stdout "<table width=\"99%\" border=\"0\">"
        }

        end {
            puts $stdout "</table>"
        }
    }
}

proc reference_html {prefix names title series date anchor target} {
    global rfcTxtHome idTxtHome
    global rfcHtmlHome
    global stdout

    if {[string compare $anchor ""]} {
        set prefix "<a name=\"$anchor\">\[$prefix\]</a>"
    }
    puts $stdout "<tr><td class=\"author-text\" valign=\"top\"><b>$prefix</b></td>"

    set hack $names
    set names ""
    # carl hack...
    foreach name $hack {
        if {[string compare [lindex $name 0] ""]} {     
            lappend names $name
        }
    }
    set nameN [llength $names]

    set s ""
    set text ""
    set nameA 1
    foreach name $names {
        incr nameA
        if {[string compare [set eref [lindex $name 1]] ""]} {
            set name "<a href=\"$eref\">[lindex $name 0]</a>"
        } else {
            set name [lindex $name 0]
        }
        append text $s$name
        if {$nameA == $nameN} {
            set s " and "
        } else {
            set s ", "
        }
    }

    if {![string compare $target ""]} {
        foreach serial $series {
            if {[regexp -nocase -- "rfc (\[0-9\]*)" $serial x n] == 1} {
                if {[catch { set rfcHtmlHome }]} {
                    set target $rfcTxtHome/rfc$n.txt
                } else {
                    set target $rfcHtmlHome/rfc$n.html
                }
                break
            }
            if {[regexp -nocase -- "internet-draft (draft-.*)" $serial x n] \
                    == 1} {
                set target $idTxtHome/$n.txt
                break
            }
        }
    }
    if {[string compare $target ""]} {
        set title "<a href=\"$target\">$title</a>"
    }
    append text "$s\"$title\""
    foreach serial $series {
        if {[regexp -nocase -- "internet-draft (draft-.*)" $serial x n] == 1} {
            set serial "$n (work in progress)"
        }
        append text ", $serial"
    }
# carl hack...
    if {[string compare $date ""]} {
        append text ", $date"
    }
    append text .
    puts -nonewline $stdout "<td class=\"author-text\">"
    pcdata_html $text
    puts $stdout "</td></tr>"
}

# don't need to return anything even though back_txt does...

proc back_html {authors} {
    global stdout
    global contacts

    if {[llength $authors] > 1} {
        set s1 "s'"
        set s2 "es"
    } else {
        set s1 "'s"
        set s2 ""
    }
    puts $stdout ""

    toc_html rfc.authors
    puts $stdout "<h3>Author$s1 Address$s2</h3>"

    puts $stdout \
         "<table width=\"99%\" border=\"0\" cellpadding=\"0\" cellspacing=\"0\">"
    set s ""
    foreach author $authors {
        set block1 [lindex $author 0]
        set block2 [lindex $author 1]

        if {[string compare $s ""]} {
            puts $stdout $s
        }
        foreach line $block1 {
            puts $stdout "<tr><td class=\"author-text\">&nbsp;</td>"
            puts $stdout "<td class=\"author-text\">$line</td></tr>"
        }
        foreach contact $block2 {
            set key [lindex $contact 0]
            set value [lindex [lindex $contacts \
                                      [lsearch0 $contacts $key]] 1]
            puts $stdout "<tr><td class=\"author\" align=\"right\">$value:&nbsp;</td>"
            set value [lindex $contact 1]
            switch -- $key {
                email {
                    set value "<a href=\"mailto:$value\">$value</a>"
                }

                uri {
                    set value "<a href=\"$value\">$value</a>"
                }
            }
            puts $stdout "<td class=\"author-text\">$value</td></tr>"
        }
        set s "<tr cellpadding=\"3\"><td>&nbsp;</td><td>&nbsp;</td></tr>"
    }
    puts $stdout "</table>"

    return ""
}

proc xxxx_html {{anchor {}}} {
    global elem
    global options
    global stdout

    if {$options(.PRIVATE)} {
        toc_html $anchor
        return
    } else {
        array set rv $elem(1)
        if {![string compare [set number $rv(number)] ""]} {
            toc_html $anchor
            return
        }
    }                               

    if {[string compare $anchor ""]} {
        puts $stdout "<a name=\"$anchor\"><hr size=\"1\" shade=\"0\"></a>"
    }

    puts $stdout "
<table border=\"0\" cellpadding=\"0\" cellspacing=\"2\" width=\"30\" height=\"30\" align=\"right\">
    <tr>
        <td bgcolor=\"#000000\" align=\"center\" valign=\"center\" width=\"30\" height=\"30\">
            <font face=\"monaco, MS Sans Serif\" color=\"#666666\" size=\"1\">
                <b><span class=\"RFC\">&nbsp;RFC&nbsp;</span></b>
            </font>
            <font face=\"charcoal, MS Sans Serif, helvetica, arial, sans-serif\" size=\"1\" color=\"#ffffff\">
                <span class=\"hotText\">$number</span>
            </font>
        </td>
    </tr>"

    if {$options(.TOC)} {
        puts $stdout "    <tr><td bgcolor=\"#990000\" align=\"center\" width=\"30\" height=\"15\"><a href=\"#toc\" CLASS=\"link2\"><font face=\"monaco, MS Sans Serif\" color=\"#ffffff\" size=\"1\"><b>&nbsp;TOC&nbsp;</b></font></a><br></td></tr>"
    }
    puts $stdout "</table>"
}

proc toc_html {anchor} {
    global options
    global stdout

    if {[string compare $anchor ""]} {
        puts $stdout "<a name=\"$anchor\"><br><hr size=\"1\" shade=\"0\"></a>"
    }

    if {!$options(.TOC)} {
        return
    }

    puts $stdout "<table border=\"0\" cellpadding=\"0\" cellspacing=\"2\" width=\"30\" height=\"15\" align=\"right\"><tr><td bgcolor=\"#990000\" align=\"center\" width=\"30\" height=\"15\"><a href=\"#toc\" CLASS=\"link2\"><font face=\"monaco, MS Sans Serif\" color=\"#ffffff\" size=\"1\"><b>&nbsp;TOC&nbsp;</b></font></a><br></td></tr></table>"
}

proc pcdata_html {text {pre 0}} {
    global stdout

    regsub -all -nocase {&apos;} $text {\&#039;} text
    if {$pre} {
# this hack is tells us that the architecture has something wrong in it...
        global entities

        regsub -all "&rfc.number;" $text [lindex $entities 1] text
        puts $stdout "</font><pre>$text</pre><font face=\"verdana, helvetica, arial, sans-serif\" size=\"2\">"
    } else {
        puts -nonewline $stdout $text
    }
}


#
# xml2ref support
#

namespace eval ref {
    variable ref
    array set ref { uid 0 }

    variable parser [xml::parser]

    variable context
    #              element       verbatim        beginF  endF
    set context { {dummy/-1}
                  {rfc/0         no              yes     yes}
                  {front/1}
                  {title/2}
                  {author/2}
                  {organization/3}
                  {address/3}
                  {postal/4}
                  {street/5}
                  {city/5}
                  {region/5}
                  {code/5}
                  {country/5}
                  {phone/4}
                  {facsimile/4}
                  {email/4}
                  {uri/4}
                  {date/2}
                  {area/2}
                  {workgroup/2}
                  {keyword/2}
                  {abstract/2    yes}
                  {note/2        yes}
                }

    namespace export init fin transform
}

proc ref::init {} {
    variable ref

    set token [namespace current]::[incr ref(uid)]

    variable $token
    upvar 0 $token state

    array set state {}

    return $token
}

proc ref::fin {token} {
    variable $token
    upvar 0 $token state

    foreach name [array names state] {
        unset state($name)
    }
    unset $token
}

proc ref::transform {token file} {
    global errorCode errorInfo

    variable $token
    upvar 0 $token state

    array set emptyA {}

    variable parser
    $parser configure \
            -elementstartcommand    "ref::element_start $token" \
            -elementendcommand      "ref::element_end   $token" \
            -characterdatacommand   "ref::cdata         $token" \
            -entityreferencecommand ""                          \
            -errorcommand           ref::oops                   \
            -entityvariable         emptyA                      \
            -final                  yes                         \
            -reportempty            no

    set fd [open $file { RDONLY }]
    set data [prexml [read $fd] [file dirname $file]]

    if {[catch { close $fd } result]} {
        log::entry $logT system $result
    }

    set state(stack)    ""
    set state(body)     ""
    set state(verbatim) 0
    set state(silent) 0

    set code [catch { $parser parse $data } result]
    set ecode $errorCode
    set einfo $errorInfo

    switch -- $code {
        0 {
            set result $state(body)
        }

        1 {
            if {[llength $state(stack)] > 0} {
                set text "File:    $file\nContext: "
                foreach frame $state(stack) {
                    append text "<[lindex $frame 0]>"
                }
                append result "\n\n$text"
            }
        }
    }

    unset state(stack)    \
          state(body)     \
          state(verbatim) \
          state(silent)

    return -code $code -errorinfo $einfo -errorcode $ecode $result
}

proc ref::element_start {token name {av {}}} {
    variable $token
    upvar 0 $token state

    variable context

    set depth [llength $state(stack)]

    if {[set idx [lsearch -glob $context $name/$depth*]] >= 0} {
        set info [lindex $context $idx] 
        if {[string compare [lindex $info 0] $name/$depth]} {
            set idx -1
        } elseif {![string compare [lindex $info 1] yes]} {
            set state(verbatim) 1
        }
    }

    set state(silent) 0
    if {($idx < 0) && ($state(verbatim))} {
        set idx 0
        set info ""
        if {[lsearch -exact {xref eref iref vspace} $name] >= 0} {
            set state(silent) 1
        }
    }

    if {$idx >= 0} {
        if {![string compare [lindex $info 2] yes]} {
            ref::start_$name $token $av
        } elseif {!$state(silent)} {
            append state(body) "\n<$name"
            foreach {n v} $av {
                regsub -all {'} $v {\&apos;} v
                regsub -all {"} $v {\&quot;} v
                append state(body) " $n='$v'"
            }
            append state(body) >
        }
    }

    lappend state(stack) [list $name $av $idx ""]
}

proc ref::element_end {token name} {
    variable $token
    upvar 0 $token state

    variable context

    set frame [lindex $state(stack) end]
    set state(stack) [lreplace $state(stack) end end]

    if {[set idx [lindex $frame 2]] >= 0} {
        set info [lindex $context $idx]
        if {![string compare [lindex $info 3] yes]} {
            ref::end_$name $token $frame
        } elseif {!$state(silent)} {
            append state(body) </$name>
        }

        if {![string compare [lindex $info 1] yes]} {
            set state(verbatim) 0
        }
    }
    set state(silent) 0
}

proc ref::cdata {token text} {
    variable $token
    upvar 0 $token state

    if {[string length [string trim $text]] <= 0} {
        return
    }

    set frame [lindex $state(stack) end]
    if {[set idx [lindex $frame 2]] < 0} {
        return
    }

    regsub -all "\r" $text "\n" text

    append state(body) $text
}

proc ref::oops {args} {
    return -code error [join $args " "]
}

proc ref::start_rfc {token av} {
    variable $token
    upvar 0 $token state

    array set rfc [list obsoletes "" updates "" category info seriesNo ""]
    array set rfc $av
    if {[catch { set rfc(number) }]} {
        ref::oops "missing number attribute in rfc element"
    }

    set state(body) "<?xml version='1.0'?>
<!DOCTYPE reference SYSTEM 'rfc2629.dtd'>

<reference anchor='RFC[format %04d $rfc(number)]'>
"
}

proc ref::end_rfc {token frame} {
    variable $token
    upvar 0 $token state

    array set rfc [list obsoletes "" updates "" category info seriesNo ""]
    array set rfc [lindex $frame 1]

    append state(body) "

<seriesInfo name='RFC' value='$rfc(number)' />
"
    if {([string compare [set x $rfc(category)] info]) \
            && ([string compare [set y $rfc(seriesNo)] ""])} {
        append state(body) "<seriesInfo name='[string toupper $x]' "
        append state(body) "value='$y' />
"
    }
    append state(body) "</reference>
"
}


#
# tclsh/wish linkage
#


global guiP
if {[info exists guiP]} {
    return
}
set guiP 0
if {![info exists tk_version]} {
    if {$tcl_interactive} {
        set guiP -1
        puts stdout ""
        puts stdout "invoke as \"xml2rfc input-file output-file\""
        puts stdout "       or \"xml2txt input-file\""
        puts stdout "       or \"xml2html input-file\""
    }
} elseif {[llength $argv] > 0} {
    switch -- [llength $argv] {
        2 {
            set file [lindex $argv 1]
            if {![string compare $tcl_platform(platform) windows]} {
                set f ""
                foreach c [split $file ""] {
                    switch -- $c {
                        "\\" { append f "\\\\" }

                        "\a" { append f "\\a" }

                        "\b" { append f "\\b" }

                        "\f" { append f "\\f" }

                        "\n" { append f "\\n" }

                        "\r" { append f "\\r" }

                        "\v" { append f "\\v" }

                        default {
                            append f $c
                        }
                    }
                }
                set file $f
            }

            eval [file tail [lindex $argv 0]] $file
        }

        3 {
            xml2rfc [lindex $argv 1] [lindex $argv 2]
        }
    }

    exit 0
} else {
    set guiP 1

    proc convert {w} {
        if {![string compare [set input [.input.ent get]] ""]} {
            tk_dialog .error "xml2rfc: oops!" "no input filename specified" \
                      error 0 OK
            return
        }
        set output [.output.ent get]

        if {[catch { xml2rfc $input $output } result]} {
            tk_dialog .error "xml2rfc: oops!" $result error 0 OK
        }
    }

    proc fileDialog {w ent operation} {
        set input {
            {"XML files"                .xml                    }
            {"All files"                *                       }
        }
        set output {
            {"HTML files"               .html                   }
            {"Text files"               .txt                    }
        }
        if {![string compare $operation "input"]} {
            set file [tk_getOpenFile -filetypes $input -parent $w]
        } else {
            if {[catch { set input [.input.ent get] }]} {
                set input Untitled
            } else {
                set input [file rootname $input]
            }
            set file [tk_getSaveFile -filetypes $output -parent $w \
                            -initialfile $input -defaultextension .txt]
        }
        if [string compare $file ""] {
            $ent delete 0 end
            $ent insert 0 $file
            $ent xview end
        }
    }

    eval destroy [winfo child .]

    wm title . xml2rfc
    wm iconname . xml2rfc
    wm geometry . +300+300

    label .msg -font "Helvetica 14" -wraplength 4i -justify left \
          -text "Convert XML to RFC"
    pack .msg -side top

    frame .buttons
    pack .buttons -side bottom -fill x -pady 2m
    pack \
        [button .buttons.code -text Convert -command "convert ."] \
        [button .buttons.dismiss -text Quit -command "destroy ."] \
        -side left -expand 1
    
    foreach i {input output} {
        set f [frame .$i]
        label $f.lab -text "Select $i file: " -anchor e -width 20
        entry $f.ent -width 20
        button $f.but -text "Browse ..." -command "fileDialog . $f.ent $i"
        pack $f.lab -side left
        pack $f.ent -side left -expand yes -fill x
        pack $f.but -side left
        pack $f -fill x -padx 1c -pady 3
    }
}
