#! /bin/sh

# Brings local copy of CVS archive up-to-date.				\
exec /home/fellowsd/arch/sparc-sun-solaris/bin/tclsh8.0 "$0" -- ${1+"$@"}

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl
set EDITDIR $DOCDIR
source $SRCDIR/cvs.tcl

set code [catch {cvs -z9 update} msg]
if {[string length [string trim $msg]]} {puts $msg}
exit $code

#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}

### READ STANDARD CONFIG ###
set SRCDIR [file join [pwd] [file dir $argv0]]
source $SRCDIR/config.tcl

### NEW GLOBALS WITH POSSIBLE VALUES ###

# NOTIFYDB  = [file join [file dir $LOGFILE] notify.db]
# ID        = /usr/bin/id
# MAILX     = /usr/bin/mailx
# WEBEDITID = tclhttpd
# NOTIFYURL = ${BASEURL}notify.html

### HELPER PROCEDURES ###
proc readNotifyDB {} {
    # NB This procedure needs some kind of locking protocol...

    global NOTIFYDB
    set fid [open $NOTIFYDB r]
    set lines [read $fid]
    close $fid
    return $lines
}
proc readLogMessage {} {
    set lines {}
    set readlog 0
    while {[gets stdin line]} {
	if {$readlog} {
	    lappend lines $line
	} else {
	    set readlog [string match "Log Message:" $line]
	}
    }
    return [join $lines "\n"]
}
proc getUserID {} {
    global ID
    if {[regexp {uid=[0-9]+\([a-zA-Z0-9_]+\)} [exec $ID] -> id]} {
	return $id
    } else {
	return "unknown user"
    }
}
proc mail {address subject args} {
    global MAILX
    set body [join $args "\n\n"]
    exec $MAILX -s $subject $address << "$body\n"
}

### IMPLEMENTATION ###

# Read this first; probably ought to add some kind of locking mechanism.
set notifylines [readNotifyDB]

set logmsg [readLogMessage]

set id [getUserID]
if {![string compare $id $WEBEDITID]} {
    set mod "Modified over the web (see log message)"
} else {
    set mod "Modified by: $id"
}

# changed($file) exists if $file was changed
array set changed {}
foreach file $argv {
    set changed($file) $file
}

foreach line [split $notifylines "\n"] {
    if {[regexp "^(\[0-9\]+)\[ \t\]+(.*@.*)" $line -> tip mail]} {
	catch {
	    # if $email didn't want to be notified about any of the
	    # files mentioned in this log notification, then the
	    # reading of changed($tip.tip) will fail
	    mail $mail "\[TIP Archive] $changed($tip.tip) modified" \
		    "TIP #$tip has been modified, and you might wish to\
		    check it out.\n   $BASEURL$tip.html" "To remove your\
		    email address from the notification list for this\
		    TIP,\nvisit the page, confirm your email address and\
		    select 'Remove':\n   $NOTIFYURL?tip=$tip,email=$mail" \
		    "Log message associated with the update is as\
		    follows:\n$logmsg"
	}
    } elseif {[regexp {^\*(.*@.*)} $line -> mail]} {
	mail $mail "\[TIP Archive] update done" "Files modified: $argv\n$mod"\
		"Log message:\n$logmsg"
    }
}

exit

#! /bin/sh
# Re-execute using wish \
exec wish "$0" $*


### ATTEMPT TO LOAD PREVIOUSLY-CREATED VERSION AND SET UP SRCDIR VAR ###
set SRCDIR [file join [pwd] [file dir $argv0]]
regsub -all {/\./} $SRCDIR / SRCDIR
regsub -all {/\.$} $SRCDIR {} SRCDIR

namespace eval configure {
    variable conffile [file join $::SRCDIR config.tcl]
    variable deffile  [file join $::SRCDIR conf_def.tcl]
    variable showall \
	    [expr {[string compare [lindex $::argv 0] "-expert"] == 0}]

    variable variables      {}
    variable optional       {}
    variable pages          {}
    variable header         {}
    variable introMessage   {}
    variable postUserScript {}
}

puts "Loading old configuration: $::configure::conffile"
catch {source $::configure::conffile}

puts "Loading setup: $::configure::deffile"
source $::configure::deffile

namespace eval configure {
    namespace export runGUI writeConfig

    variable name
    set name() $introMessage
    variable kinds
    set kinds() message

    ### HELPER PROCEDURES ###
    proc selectColour {var} {
	variable name
	upvar #0 $var colourVar
	set col [tk_chooseColor -parent .t -initialcolor $colourVar \
		-title $name($var)]
	if {[string length $col]} {
	    set colourVar $col
	}
    }
    proc selectFile {var} {
	variable name
	upvar #0 $var fileVar
	set file [tk_getOpenFile -parent .t -initialdir [file dir $fileVar] \
		-title $name($var)]
	if {[string length $file]} {
	    set fileVar $file
	}
    }
    proc selectDir {var} {
	variable name
	upvar #0 $var dirVar
	set dir [tk_chooseDirectory -parent .t -initialdir $dirVar \
		-title $name($var) -mustexist 1]
	if {[string length $dir]} {
	    set dirVar $dir
	}
    }

    ### BALLOON HELP ###
    proc balloonIn {w msg} {
	if {![winfo exist .balloon]} {
	    toplevel .balloon
	    wm overrideredirect .balloon 1
	    label .balloon.l -foreground blue -background yellow \
		    -highlightthick 0 -relief solid -borderwidth 1 \
		    -font {Helvetica -10} -textvariable ::configure::balloon
	    pack .balloon.l
	}
	variable balloon $msg
	set x [expr {[winfo rootx $w]+10}]
	set y [expr {[winfo rooty $w]+[winfo height $w]+5}]
	set g [format +%d+%d $x $y]
	wm geometry .balloon $g
	wm deiconify .balloon
	wm geometry .balloon $g
	raise .balloon
	after idle "[list wm geometry .balloon $g]; raise .balloon"
    }
    proc balloonOut {} {
	if {[winfo exist .balloon]} {
	    wm withdraw .balloon
	}
    }
    proc bindBalloon {msg r args} {
	foreach w $args {
	    bind $w <Enter> [namespace code [list balloonIn $r $msg]]
	    bind $w <Leave> [namespace code balloonOut]
	}
    }

    ### HANDLE THE GUI FOR A SINGLE EDITING PAGE ###
    proc displayPage {pagedesc first last} {
	variable forwardback
	variable kinds
	variable name
	variable showall

	toplevel .t
	wm title .t [lindex $pagedesc 0]
	wm geometry .t +80+80
	set i 0
	set serif {Times 14}
	set sans  {Helvetica 14}
	set ss    {Helvetica 10 bold}
	set mono  {Courier 10}
	set bold  {Helvetica 18 bold}
	set focusmagic {}

	set havedirb [llength [info command tk_chooseDirectory]]
	set havespin [llength [info command spinbox]]

	foreach var [lrange $pagedesc 1 end] {
	    set kind $kinds($var)
	    switch $kind {
		message {#ignore}
		dir {
		    if {$havedirb} {
			set msg "Please choose a directory (you can use the\
				button at the right to summon a directory\
				browser.)"
		    } else {
			set msg "Please choose a directory."
			set kind string
		    }
		}
		file {
		    set msg "Please choose a file (you can use the\
			    button at the right to summon a file browser.)"
		}
		color - colour {
		    set msg "Please choose a $kind (you can use the button\
			    at the right to summon a $kind browser.)"
		}
		string {
		    set msg "Input a string value here."
		}
		number {
		    set msg "Input a numeric value here."
		    if {!$havespin} {set kind string}
		}
		boolean {
		    set msg "Click here to toggle this feature on or off."
		}
	    }
	    if {$showall && [string length $var]} {
		set msg "Variable: $var"
	    }
	    switch $kind {
		message {
		    pack [message .t.m$i -text $name($var) -font $serif \
			    -anchor w] -fill x -expand 1
		    bind .t <Configure> [list .t.m$i configure -width %w]
		}
		dir {
		    lappend focusmagic .t.f$i.e
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    pack .t.l$i [frame .t.f$i] -fill x -expand 1
		    entry .t.f$i.e -textvariable $var -bg white -font $mono
		    button .t.f$i.b -text "Browse" -font $ss -takefocus 0 \
			    -command [list selectDir $var] -padx 2 -pady 0
		    pack .t.f$i.e .t.f$i.b -fill both -side left
		    pack configure .t.f$i.e -expand 1
		    bindBalloon $msg .t.f$i .t.l$i .t.f$i.e .t.f$i.b
		}
		file {
		    lappend focusmagic .t.f$i.e
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    pack .t.l$i [frame .t.f$i] -fill x -expand 1
		    entry .t.f$i.e -textvariable $var -bg white -font $mono
		    button .t.f$i.b -text "Browse" -font $ss -takefocus 0 \
			    -command [list selectFile $var] -padx 2 -pady 0
		    pack .t.f$i.e .t.f$i.b -fill both -side left
		    pack configure .t.f$i.e -expand 1
		    bindBalloon $msg .t.f$i .t.l$i .t.f$i.e .t.f$i.b
		}
		color - colour {
		    lappend focusmagic .t.f$i.e
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    pack .t.l$i [frame .t.f$i] -fill x -expand 1
		    entry .t.f$i.e -textvariable $var -bg white -font $mono
		    button .t.f$i.b -text "Browse" -font $ss -takefocus 0 \
			    -command [list selectColour $var] -padx 2 -pady 0
		    pack .t.f$i.e .t.f$i.b -fill both -side left
		    pack configure .t.f$i.e -expand 1
		    bindBalloon $msg .t.f$i .t.l$i .t.f$i.e .t.f$i.b
		}
		string {
		    lappend focusmagic .t.e$i
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    entry .t.e$i -textvariable $var -bg white -font $mono
		    pack .t.l$i .t.e$i -fill x -expand 1
		    bindBalloon $msg .t.e$i .t.l$i .t.e$i
		}
		number {
		    lappend focusmagic .t.e$i
		    label .t.l$i -text $name($var) -anchor w -font $serif
		    spinbox .t.e$i -textvariable $var -bg white -font $mono
		    pack .t.l$i .t.e$i -fill x -expand 1
		    bind .t.e$i <Up>   [list incr $var]
		    bind .t.e$i <Down> [list incr $var -1]
		    bindBalloon $msg .t.e$i .t.l$i .t.e$i
		}
		boolean {
		    lappend focusmagic .t.b$i
		    pack [checkbutton .t.b$i -text $name($var) -anchor w \
			    -font $sans -variable $var] -fill x -expand 1
		    bindBalloon $msg .t.b$i .t.b$i
		}
	    }
	    incr i
	}
	pack [frame .t.bottom] -expand 1 -fill both
	button .t.bottom.left -text "<< Back" -font $bold -default normal \
		-command {set ::configure::forwardback -1}
	if {$first} {
	    .t.bottom.left configure -state disabled -font $bold
	    bind .t <Escape> {set ::configure::forwardback 0}
	} else {
	    bind .t <Escape> {set ::configure::forwardback -1}
	}
	button .t.bottom.middle -text "Cancel" -font $bold -default normal \
		-command {set ::configure::forwardback 0}
	button .t.bottom.right -text "Next >>" -font $bold -default active \
		-command {set ::configure::forwardback 1}
	if {$last} {
	    .t.bottom.right configure -text "Write Config"
	}
	pack .t.bottom.left .t.bottom.middle .t.bottom.right \
		-expand 1 -fill both -side left
	bind .t.bottom <Destroy> {set ::configure::forwardback 0}
	bind .t <Return> {set ::configure::forwardback 1}
	if {[string length $focusmagic]} {
	    focus [lindex $focusmagic 0]
	} else {
	    focus .t.bottom.right
	}
	vwait ::configure::forwardback
	if {[winfo exist .t.bottom]} {
	    bind .t.bottom <Destroy> {}
	    destroy .t
	}
	return $forwardback
    }

    ### RUN THE CONFIGURATION GUI ###
    proc runGUI {} {
	variable showall
	variable kinds
	variable variables
	variable optional
	variable pages
	variable name

	set pageidx 0
	set step 1
	array set defs {}
	while {$step && $pageidx>=0} {
	    foreach {var kind val doc} $variables {
		set name($var) $doc
		set dynamic [regexp {[\[$]} $val]
		if {$dynamic || ![info exist ::$var]} {
		    if {$dynamic} {
			set defs($var) $val
		    }
		    set ::$var [uplevel #0 [list subst $val]]
		}
		set kinds($var) $kind
	    }

	    while {$pageidx < [llength $pages]} {
		set page [lindex $pages $pageidx]
		foreach var [lrange $page 1 end] {
		    if {[string length $var] && [info exist defs($var)]} {
			set ::$var [uplevel #0 [list subst $defs($var)]]
			#puts "$var = [set ::$var]"
		    }
		}
		if {$showall || [lsearch $optional [lindex $page 1]]<0} {
		    set step [displayPage $page [expr {$pageidx==0}] \
			    [expr {$pageidx==[llength $pages]-1}]]
		}
		if {!$step} {
		    return 0
		}
		incr pageidx $step
	    }
	    set done 1
	    foreach {var ? ? ?} $variables {
		if {![string length [set ::$var]]} {
		    tk_messageBox -type ok -icon error \
			    -title "Missing value" \
			    -message "You must supply a value for all fields"
		    set done 0
		    set pageidx 1
		    set step 1
		    break
		}
	    }
	    if {$done} {break}
	}

	return [expr {$step > 0}]
    }

    ### WRITE THE NEW VERSION OF THE CONFIGURATION FILE ###
    proc writeConfig {} {
	variable conffile
	variable variables
	variable header

	set fid [open $conffile w]
	foreach line [split $header "\n"] {
	    puts $fid [string trimleft $line]
	}
	foreach {var ? ? ?} $variables {
	    puts $fid [list set $var [set ::$var]]
	}
	close $fid
    }
}

### TOP LEVEL CODE ###
wm withdraw .
if {[configure::runGUI]} {
    eval $configure::postUserScript
    puts "Writing new configuration: $::configure::conffile"
    configure::writeConfig
} else {
    puts "Cancelled; $::configure::conffile unchanged"
}
exit

#! /bin/sh
#\
exec tclsh "$0" ${1+"$@"}

set SRCDIR [file join [pwd] [file dirname $argv0]]
source $SRCDIR/config.tcl
source $SRCDIR/parse.tcl
source $SRCDIR/md5.tcl
source $SRCDIR/base64.tcl
source $SRCDIR/post.tcl
source $SRCDIR/mail.tcl

binary scan [binary format f [pid].[clock seconds]] I uniquePart

proc MD5inB64 {str} {
    return [B64encode [md5pure::md5 $str] 128]
}

proc generateNewsMessage {tipnumber extra} {
    global DOCDIR PUBLISHURL FEATURE FOOTERTEXT ENGINEURL TCLCOREMAIL
    global opts uniquePart
    set tipfile [file join $DOCDIR $tipnumber.tip]
    set docurl  $PUBLISHURL/$tipnumber.html
    set editurl $PUBLISHURL/edit/$tipnumber

    puts stderr "Loading TIP from $tipfile"
    array set h [getTIPDetails $tipfile]
    set tip [getTIPFileContents $tipfile]

    puts stderr "Generating plain text body"
    if {$FEATURE(EDIT_URL_IN_NEWS_MESSAGE)} {
	set body [formatTIPDocument $tip txt URL $docurl WebEdit $editurl]
    } else {
	set body [formatTIPDocument $tip txt URL $docurl]
    }

    puts stderr "Generating body md5 digest"
    set digest [MD5inB64 $body]

    puts stderr "Generating headers"
    append content \
	    "MIME-Version: 1.0\n" \
	    "Content-Type: text/plain; charset=iso-8859-1\n" \
	    "Content-Transfer-Encoding: 8bit\n" \
	    "Content-MD5: $digest\n"
    append content [clock format [clock seconds] -gmt 1 -format \
	    "Date: %a, %d %b %Y %H:%M:%S +0000\n"]
    append content [format "Message-Id: <tip%d.%s@%s>\n" \
	    $tipnumber $uniquePart [info hostname]]
    if {[llength $extra]} {
	append content "Subject: [join $extra] TIP #$h(TIP): $h(Title)\n"
    } else {
	append content "Subject: TIP #$h(TIP): $h(Title)\n"
    }
    regsub -all "\t" [lindex $h(Author) 0] " " a0
    regsub {^(.*[.].*[^ ]) +<(.+)>$} $a0 {"\1" <\2>} a0
    append content \
	    "Sender: TIP Editor <[email protected]>\n" \
	    "From: [string trim $a0]\n" \
	    "Errors-To: [email protected]\n"
    if {$opts(news)} {
	append content \
		"Newsgroups: comp.lang.tcl,comp.lang.tcl.announce\n" \
		"To: [email protected]\n" \
		"Reply-To: [string trim $a0]\n" \
		"Followup-To: comp.lang.tcl\n"
	# Some software seems to insist on sending email messages to
	# me in response to TIPs; this is just about as bogus as you
	# can get.  However, mail in general provides no way to say
	# that you want administrative stuff going to one address,
	# and subject-matter related stuff going to another.  This
	# sucks...
	###append content "Reply-To: $TCLCOREMAIL\n"
	set opts(news) 0
    } elseif {$opts(list)} {
	append content \
		"To: $TCLCOREMAIL\n" \
		"Reply-To: $TCLCOREMAIL\n"
	set opts(list) 0
	if {$opts(author)} {
	    set opts(author) 0
	    foreach author $h(Author) {
		regsub {^(.*[.].*[^ ]) +<(.+)>$} $author {"\1" <\2>} author
		append content "Cc: $author\n"
	    }
	}
	foreach extraAddress $opts(extra) {
	    append content "Cc: $extraAddress\n"
	}
	set opts(extra) {}
    } elseif {$opts(author)} {
	set opts(author) 0
	foreach author $h(Author) {
	    regsub {^(.*[.].*[^ ]) +<(.+)>$} $author {"\1" <\2>} author
	    append content "To: $author\n"
	}
	foreach extraAddress $opts(extra) {
	    append content "Cc: $extraAddress\n"
	}
	set opts(extra) {}
    }
    append content \
	    "Organization: Tcl Core Team\n" \
	    "X-Generated-By: $FOOTERTEXT\n" \
	    "X-Generator-Url: $ENGINEURL\n"
    if {[info exist h(Keywords)]} {
	append content "Keywords: [join $h(Keywords) {, }]\n"
    }
    append content "\n" $body

    puts stderr "Posting message"
    return $content
}

if {!$FEATURE(PUBLISHING)} {
    puts stderr "Sorry, but this installation does not support\
	    publishing of TIPs"
    exit 1
}

proc preset {ary name value} {
    upvar $ary a
    if {![info exist a($name)]} {
	set a($name) $value
    }
}
proc shift {{n 1}} {
    global argv
    set shifted [lrange $argv 0 [expr $n-1]]
    set argv [lrange $argv $n end]
    return $shifted
}

proc main {} {
    global argc argv opts argv0 TCLCOREMAIL
    if {$argc == 0} {
	puts stderr "usage: [file tail $argv0] ?options? ?--? tipNumber"
	puts stderr "Supported options are:"
	puts stderr "\t-news\t Posts to comp.lang.tcl and comp.lang.tcl.announce"
	puts stderr "\t-list\t Posts to $TCLCOREMAIL mailing list."
	puts stderr "\t-author\t Sends a copy to the (first) author of the TIP."
	puts stderr "\t-extra address"
	puts stderr "\t\t Sends the publishing message to an extra email address"
	puts stderr "\t\t (e.g. a mailing list where people have a special interest"
	puts stderr "\t\t in the TIP.)  Multiple extra email addresses can be"
	puts stderr "\t\t specificied by using this option mulktiple times."
	puts stderr "\t-test\t Prevent all posting/mailing and prints formatted on"
	puts stderr "\t\t standard output (for debugging.)"
	puts stderr "\t--\t Marks the end of the options."
	exit
    }
    array set opts {}
    while {[llength $argv]} {
	switch -- [lindex $argv 0] {
	    -news   {set opts(news) 1}
	    -list   {set opts(list) 1}
	    -author {set opts(author) 1}
	    -test   {set opts(test) 1}
	    --      {shift; break}
	    -extra  {
		shift
		lappend opts(extra) [lindex $argv 0]
	    }
	    default {break}
	}
	shift
    }
    if {![array size opts]} {
	array set opts {
	    news 1  list 1  author 1  test 0  extra {}
	}
    } else {
	preset opts news   0
	preset opts list   0
	preset opts author 0
	preset opts test   0
	preset opts extra  {}
    }

    while {[lsearch [array get opts] 1] >= 0} {
	set message [generateNewsMessage [lindex $argv 0] [lrange $argv 1 end]]
	if {$opts(test)} {
	    puts $message
	    set opts(test) 0
	    break
	} else {
	    mail::mailsend $message 1
	}
    }
}
main
exit

#! /usr/local/bin/tclsh8.0

# Regular expressions - suitable for 8.0 as well as later.
set ws "\[ \t\n\]"
set ParSepRE      "^$ws*$"
set ItemNoLeadRE  "^\[^ \t>\]"
set ItemLeadRE    "^$ws*((>$ws+)*)(\\*|\[0-9\]+\\.|\[^\t\n:\]+:)$ws"
set ItemContRE    "^($ws+>)+$ws*"
set EmailRE       {<([^<>@]+@[^<>@]+)>}
# It took lots of experiment to develop this next RE...
set URLRE {(https?|ftp|news(rc)?|mailto|gopher):[-A-Za-z0-9/_:.#+@?=&;~\\]+}

# ----------------------------------------------------------------------

proc splitIntoParagraphs {string} {
    global ParSepRE
    set paragraphs {}
    set current {}
    foreach line [split $string "\n"] {
	if {[regexp $ParSepRE $line]} {
	    # (VISUALLY) BLANK LINE = PARAGRAPH SEPARATOR
	    if {[string length $current]} {
		lappend paragraphs [string trim $current "\n"]
		set current {}
	    }
	    continue
	}
	append current "\n$line"
    }
    if {[string length $current]} {
	lappend paragraphs [string trim $current "\n"]
    }
    return $paragraphs
}

proc shortspc {string} {
    global ws
    regsub -all ${ws}+ $string " " string
    return $string
}
proc intuitParagraphKind {paragraph} {
    switch -glob -- $paragraph {
	~* {
	    set content [string range $paragraph 1 end]
	    return [list section [string trim [shortspc $content]]]
	}
	|* {
	    set lines {}
	    foreach line [split $paragraph "\n"] {
		if {![string match |* $line]} {
		    return -code error "malformatted verbatim line \"$line\""
		}
		lappend lines [string range $line 1 end]
	    }
	    return [list verbatim $lines]
	}
	#index:* {
	    set type [string trim [string range $paragraph 7 end]]
	    if {![string length $type]} {set type medium}
	    return [list index $type]
	}
	#image:* {
	    return [list image [string range $paragraph 7 end]]
	}
	---- {
	    return {separator}
	}
    }

    global ItemNoLeadRE ItemLeadRE ItemContRE

    # Hmm.  Need to figure out if we've got a list item of some kind.
    if {[regexp $ItemNoLeadRE $paragraph]} {
	return [list ordinary [shortspc $paragraph]]
    }
    if {[regexp $ItemLeadRE $paragraph head continuation ? kind]} {
        set content [string range $paragraph [string length $head] end]
        set level [llength $continuation]
        switch -glob -- $kind {
	    *: {
		set kind [string trimright $kind ":"]
		return [list description $kind $level [shortspc $content]]
	    }
	    *. {
		set kind [string trimright $kind "."]
		return [list enumeration $kind $level [shortspc $content]]
	    }
	}
	return [list bulleting $level [shortspc $content]]
    }
    if {[regexp $ItemContRE $paragraph head]} {
	set content [string range $paragraph [string length $head] end]
	return [list continuation [llength $head] [shortspc $content]]
    }
    return [list ordinary [shortspc $paragraph]]
}

# ----------------------------------------------------------------------

namespace eval tiphtml {
    variable curlev -1
    variable contexts {}
    proc enterlistcontext {level good bad1 bad2} {
	variable curlev
	variable contexts
	if {$level > $curlev} {
	    incr curlev
	    lappend contexts "</$good>"
	    puts -nonewline "<$good compact>"
	}
	switch [lindex $contexts end] "</$bad1>" - "</$bad2>" {
	    puts -nonewline [lindex $contexts end]
	    puts -nonewline "<$good compact>"
	    set contexts [lreplace $contexts end end "</$good>"]
	}
    }
    proc closecontext {{level -1}} {
	variable curlev
	variable contexts
	while {$level < $curlev} {
	    incr curlev -1
	    puts -nonewline [lindex $contexts end]
	    set contexts [lrange $contexts 0 [expr {[llength $contexts]-2}]]
	}
    }
    proc quoteLiteral {string} {
	# This would be better with [string map], but that's not in 8.0
	regsub -all &  $string {\&amp;}  string
	regsub -all <  $string {\&lt;}   string
	regsub -all >  $string {\&gt;}   string
	regsub -all \" $string {\&quot;} string
	return $string
    }

    proc section {title} {
	closecontext
	puts "<h2>[quoteLiteral $title]</h2>"
    }
    proc ordinary {string} {
	continuation -1 $string
    }
    proc bulleting {level body} {
	closecontext $level
	enterlistcontext $level ul ol dl
	puts -nonewline "<li>"
	continuation $level $body
    }
    proc description {tag level body} {
	closecontext $level
	enterlistcontext $level dl ol ul
	puts -nonewline "<dt>$tag</dt><dd>"
	continuation $level $body
    }
    proc enumeration {tag level body} {
	closecontext $level
	enterlistcontext $level ol dl ul
	if {$tag != 1} {
	    puts -nonewline "<li value=\"$tag\">"
	} else {
	    puts -nonewline "<li>"
	}
	continuation $level $body
    }
    proc continuation {level body} {
	global EmailRE URLRE
	closecontext $level
	regsub -all $EmailRE $body "\x81mailto:\\1\x82" body
	set body [quoteLiteral $body]

	regsub -all $URLRE $body "<a href=\"&\">&</a>" body

	regsub -all {''(('?[^'])+)''} $body "<em>\\1</em>" body
	regsub -all \x81 $body "\\&lt;" body
	regsub -all \x82 $body "\\&gt;" body
	variable curlev
	if {$curlev==-1 && $level==1} {
	    puts "<blockquote><p align=\"justify\">$body</p></blockquote>"
	} else {
	    puts "<p align=\"justify\">$body</p>"
	}
    }
    proc separator {} {
	closecontext
	puts "<hr>"
    }
    proc verbatim {lines} {
	puts "<pre>"
	foreach line $lines {
	    # HTML ignores formfeed chars, but we want to see them...
	    regsub -all {} [quoteLiteral $line] "<b><u>^L</u></b>" line
	    puts $line
	}
	puts -nonewline "</pre>"
    }

    proc index {kind} {
	closecontext
	puts "<p align=\"justify\"><font color=\"red\">Index\
		style \"$kind\" not yet supported!</font></p>"
    }
    proc image {bodytext} {
	closecontext
	puts "<p align=\"justify\"><font color=\"red\">Image\
		\"$bodytext\" not yet supported!</font></p>"
    }
    proc generateHTMLPars {body} {
	foreach par [splitIntoParagraphs $body] {
	    eval [intuitParagraphKind $par]
	}
    }
}

# ----------------------------------------------------------------------

if {[llength $argv]} {
    foreach arg $argv {
	set f [open $arg]
	tiphtml::generateHTMLPars [read $f]
	close $f
    }
} else {
    tiphtml::generateHTMLPars [read stdin]
}

#! /bin/sh
# \
exec tclsh8.0 $0 ${1+"$@"}

#awk '{$1=$2=$3=""; print}' ../TIP/log | sort | uniq -c | sort -n
#echo ---------------------------
#awk '{$1=$2=$3=""; print}' ../TIP/log | perl -ne 'do {print "IE\n"; next;} if /MSIE/; do {print "Netscape\n"; next;} if /Mozilla/; print "Other\n";' | sort | uniq -c | sort -n

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl

set browsers {}
array set browsermap {}

set f [open $LOGFILE r]
while {[gets $f line] >= 0} {
    foreach {ip date name browser} [split $line "\t"] {break}
    regsub -all {[ 	]+} [string trim $browser] " " browser
    append browsermap($browser) .
}
close $f

foreach {name str} [array get browsermap] {
    lappend browsers [list [string length $str] $name]
}
unset browsermap
array set browsermap {IE 0  Netscape 0  Other 0}

foreach line [lsort -integer -index 0 $browsers] {
    foreach {count browser} $line {}
    puts [format "%6d  %s" $count $browser]
    switch -glob -- $browser {
	*MSIE*    {incr browsermap(IE) $count}
	*Mozilla* {incr browsermap(Netscape) $count}
	default   {incr browsermap(Other) $count}
    }
}
puts ---------------------------
set browsers {}
foreach {class count} [array get browsermap] {
    lappend browsers [list $count $class]
}
foreach line [lsort -integer -index 0 $browsers] {
    foreach {count class} $line {}
    puts [format "%6d  %s" $count $class]
}

exit 0

#! /bin/sh
# \
exec tclsh8.0 $0 ${1+"$@"}

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl

set ips {}
array set ipmap {}
set threshold 0
if {[llength $argv]} {
    set threshold [lindex $argv 0]
}

set f [open $LOGFILE r]
while {[gets $f line] >= 0} {
    foreach {ip date name browser} [split $line "\t"] {break}
    append ipmap([string trim $ip]) .
}
close $f

set NUMRE {([0-9]?[0-9]?[0-9])}
set DQRE "^$NUMRE\.$NUMRE\.$NUMRE\.$NUMRE$"

foreach {ip str} [array get ipmap] {
    set len [string length $str]
    set domain numeric/unknown
    if {$len > $threshold} {
	set host $ip
	catch {
	    set host [lindex [lindex [split [exec host $ip] "\n"] 0] 1]
	    if {![regexp $DQRE $host]||$a>255||$b>255||$c>255||$d>255} {
		set domain [join [lrange [split $host .] 1 end] .]
	    }
	}
    }
    append dommap($domain) $str
}
unset ipmap

foreach {domain str} [array get dommap] {
    lappend ips [list [string length $str] $domain]
}
unset dommap

foreach line [lsort -integer -index 0 $ips] {
    foreach {count domain} $line {}
    puts [format "%6d  %s" $count $domain]
}

exit 0

#! /bin/sh
# \
exec tclsh8.0 $0 ${1+"$@"}

#awk '{print $3}' ../TIP/log | sort | uniq -c | sort -n

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl

set files {}
array set filemap {}

set f [open $LOGFILE r]
while {[gets $f line] >= 0} {
    foreach {ip date name browser} [split $line "\t"] {break}
    append filemap([string trim $name]) .
}
close $f

foreach {name str} [array get filemap] {
    lappend files [list [string length $str] $name]
}
unset filemap

foreach line [lsort -integer -index 0 $files] {
    foreach {count file} $line {}
    puts [format "%6d  %s" $count $file]
}

exit 0

#! /bin/sh
# \
exec tclsh8.0 $0 ${1+"$@"}

#awk '{print $1}' ../TIP/log | sort | uniq -c | sort -n

set SRCDIR [file join [pwd] [file dirname [info script]]]
source $SRCDIR/config.tcl

set ips {}
array set ipmap {}
set threshold 0
if {[llength $argv]} {
    set threshold [lindex $argv 0]
}

set f [open $LOGFILE r]
while {[gets $f line] >= 0} {
    foreach {ip date name browser} [split $line "\t"] {break}
    append ipmap([string trim $ip]) .
}
close $f

foreach {ip str} [array get ipmap] {
    lappend ips [list [string length $str] $ip]
}
unset ipmap

foreach line [lsort -integer -index 0 $ips] {
    foreach {count host} $line {}
    if {$count > $threshold} {
	catch {
	    set host [lindex [lindex [split [exec host $host] "\n"] 0] 1]
	}
    }
    puts [format "%6d  %s" $count $host]
}

exit 0

#! /usr/local/bin/tclsh8.0

set ThisFilename [file join [pwd] [info script]]
while {![string compare [file type $ThisFilename] link]} {
    # This is a symlink!
    set ThisFilename [file join [file dirname $ThisFilename] \
	    [file readlink $ThisFilename]]
}
set SRCDIR [file dirname $ThisFilename]
source $SRCDIR/config.tcl

# This is *not* configurable because changing it can require many other
# changes to be made throughout the rest of the TIP suite.  It is also
# not used outside this file.
set DOCTYPE "<!DOCTYPE HTML PUBLIC\
	\"-//W3C//DTD HTML 4.01 Transitional//EN\"\
	\"http://www.w3.org/TR/REC-html401/loose.dtd\">"
set DOCTYPE_FRAMES "<!DOCTYPE HTML PUBLIC\
	\"-//W3C//DTD HTML 4.01 Frameset//EN\"\
	\"http://www.w3.org/TR/REC-html401/frameset.dtd\">"

# Get the time when a file was last modified, in the format used by
# webservers (apparently.)
proc lastModTime {filename} {
    # Removed day-of-week spec (which is written in by the
    # webserver instead) but am not using %T since that is
    # not universally supported - DKF
    return [clock format [file mtime $filename] \
	    -format "%d %B %Y %H:%M:%S GMT" -gmt 1]
}
# MH recommends a different format for Expires headers - DGP
proc expireTime {filename} {
    # %T -> %H:%M:%S (see above) DKF
    return [clock format [file mtime $filename] \
	    -format "%a, %d %b %Y %H:%M:%S GMT" -gmt 1]
}

proc gendoc {filename kind} {
    global contenttypes

    # Head off the most common kind of "probing" error
    if {![file readable $filename]} {
	return -code error "File unreadable or non-existant"
    }

    set f [open $filename r]
    set d [read $f [file size $filename]]
    close $f

    if {![string compare $kind .htm]} {
	set kind .html
    }
    set data [formatTIPDocument $d [string trim $kind .]]
    array set info [getTIPDetails $filename]

    puts "Content-Type: $contenttypes($kind)"
    if {[info exist info(Keywords)]} {
	puts "Keywords: [file join $info(Keywords) {, }]"
    }
    # Assume we can get away with this...
    puts "Content-Length: [string length $data]"
    # Active TIPs must always be regenerated from source, so we cannot
    # supply a date of last modification.  This is because they might
    # format differently despite the source remaining unchanged.
    if {[string compare $info(State) Active]} {
	puts "Last-Modified: [lastModTime $filename]"
	puts "Expires: [expireTime $filename]"
	puts "Cache-Control: no-cache, must-revalidate"
	puts "Pragma: no-cache"
    }
    puts ""
    puts -nonewline $data
}

proc transferraw {filename kind} {
    global contenttypes

    # Head off the most common kind of "probing" error
    if {![file readable $filename]} {
	return -code error "File unreadable or non-existant"
    }

    set f [open $filename r]
    fconfigure $f -translation binary
    puts "Content-Type: $contenttypes($kind)"
    puts "Content-Length: [file size $filename]"
    puts "Last-Modified: [lastModTime $filename]"
    puts ""
    fconfigure stdout -translation binary
    fcopy $f stdout
    flush stdout
    fconfigure stdout -translation auto
    close $f
}

proc generr {title body {pfmt {}} {rcode 404} {errcode NONE}} {
    global env BASETARG BASEURL CSSURL ICONURL URI DOCTYPE

    set title "ERROR: $title"

    fconfigure stdout -translation auto

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts "Response-Code: $rcode"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>$title</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"$BASETARG\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"\
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>$title</h1><hr>"
    puts "<p align=\"justify\">An error occurred when serving $URI to you\
	    because $body.</p>"
    if {[info exist env(HTTP_REFERER)]} {
	puts "<p align=\"justify\">You might wish to inform the author of the\
		<a href=\"$env(HTTP_REFERER)\">referring page</a>.</p>"
    }
    if {[string length $pfmt]} {
	puts "<h2>Debugging Info:</h2><blockquote><pre>"
	regsub -all & $pfmt {\&amp;} pfmt
	regsub -all < $pfmt {\&lt;}  pfmt
	regsub -all > $pfmt {\&gt;}  pfmt
	puts "$pfmt"
	puts -nonewline "</pre></blockquote>"
	if {[string compare $errcode NONE]} {
	    regsub -all & $errcode {\&amp;} errcode
	    regsub -all < $errcode {\&lt;}  errcode
	    regsub -all > $errcode {\&gt;}  errcode
	    puts "<h2>Error Code Trace:</h2><p>$errcode</p>"
	}
    }
    basicHTMLfooter
    exit
}


proc serveFile {filename} {
    global renderable DOCDIR errorInfo contenttypes
    set ext [file extension $filename]
    set filename [file join $DOCDIR [file tail $filename]]
    if {![info exist contenttypes($ext)]} {
	generr "Data unservable" \
		"that view of the document is not known and/or supported"
    }
    # At this point, if the working directory $DOCDIR hasn't been
    # configured to get automatic updates on each commit, then a
    # 'cvs update' on $filename should be done here.  A 'cvs update'
    # with every web hit would be very inefficient, so set up the
    # automatic updates as indicated in config.tcl.
    #
    # If you're operating read-only, you can get away with using cron
    # to run 'cvs update' instead and take whatever lag you are
    # prepared to tolerate as a given...
    if {[lsearch -exact $renderable $ext] >= 0} {
	set filename [file rootname $filename].tip
	gendoc $filename $ext
    } else {
	transferraw $filename $ext
    }
    exit
}

proc processCGIOptions {{env env}} { # easier to test!
    upvar #0 $env e
    global URI SRCDIR FEATURE
    global bodyURL indexType orderingColumn searchTerm searchArea
    global revision0 revision1 revision2 cookie
    global searchLocus searchAuthor searchDate searchDateRelation searchSort
    global mailName mailUser mailSys mailTipNum

    set URI http://$e(SERVER_NAME)
    if {$e(SERVER_PORT) != 80} {
	append URI : $e(SERVER_PORT)
    }
    append URI $e(REQUEST_URI)

    if {[info exist e(HTTP_COOKIE)]} {
	foreach keyval [split $e(HTTP_COOKIE) ";"] {
	    regexp { *([^=]+)=(.*)} $keyval -> key val
	    set cookie($key) $val
	}
    }

    switch -- $e(REQUEST_METHOD) {
	GET - HEAD {
	    # these are OK
	}
	POST {
	    if {!$FEATURE(EDIT) && [info exist e(QUERY_STRING)]} {
		switch -glob -- $e(QUERY_STRING) {
		    /edit/* {
			generr "Unknown Request" "the request\
				$e(REQUEST_METHOD) for URL $URI is not\
				supported for that resource" {} 403
		    }
		}
	    }
	    source $SRCDIR/post.tcl
	    post::getVars $env
	}
	default {
	    generr "Unknown Request" "the request $e(REQUEST_METHOD)\
		    for URL $URI is not supported for that resource" {} 403
	}
    }

    array set query {
	body    1.html
	type    *
	sort    none
	search  ""
	where   ""
	cmpa    1.1
	cmpb    1.1
	ver     NONE
	locus   ""
	daterel ""
	author  ""
	sortby  TIP
	day     ""
	month   ""
	year    ""
	name    ""
	user    foobar
	sys     some.where
	tipnum  10000
    }
    array set multiple {
	locus 1
    }
    if {[info exist e(QUERY_STRING)]&&[string length $e(QUERY_STRING)]} {
	foreach qs [split $e(QUERY_STRING) ,&] {
	    if {
		![regexp {^(.*)=(.*)$} $qs -> key value] ||
		![info exist query($key)]
	    } then {
		generr "Unknown URI" \
			"the uri $URI is not found on this server"
	    }
	    # Decode arguments
	    regsub -all {\+} $value " " value
	    regsub -all {[]${}\\[]} $value {\\&} value
	    regsub -all {%([0-9A-Fa-f][0-9A-Fa-f])} $value \
		    {[format %c 0x\1]} value
	    if {[info exist multiple($key)]} {
		lappend query($key) [subst $value]
	    } else {
		set query($key) [subst $value]
	    }
	}
    }

    set bodyURL 1.html
    set indexType *
    set orderingColumn -1
    set searchTerm ""
    set searchArea 0
    set revision0 NONE
    set revision1 1.1
    set revision2 1.1

    if {
	![info exist e(PATH_INFO)] ||
	![string length $e(PATH_INFO)] ||
	[string match / $e(PATH_INFO)]
    } then {
	set bodyURL $query(body)
	return /index.html
    }

    set indexType $query(type)
    set orderingColumn $query(sort)
    set searchTerm $query(search)
    set searchArea [string match Also* $query(where)]
    set searchLocus [lsort $query(locus)]
    set searchAuthor $query(author)
    set searchSort $query(sortby)
    if {[lsearch -exact $query(locus) created]} {
	set searchDate $query(day)-$query(month)-$query(year)
	set searchDateRelation $query(daterel)
    } else {
	set searchDate ""
	set searchDateRelation ""
    }
    set revision0 $query(ver)
    set revision1 $query(cmpa)
    set revision2 $query(cmpb)
    set mailName $query(name)
    set mailUser $query(user)
    set mailSys $query(sys)
    set mailTipNum $query(tipnum)
    set path $e(PATH_INFO)
    if {![string length [file extension $path]]} {
	append path .html
    }

    return $path
}

proc basicHTMLfooter {} {
    global TCLLOGOURL TCLLOGOX TCLLOGOY FOOTERTEXT
    puts "<hr><img alt=\"Powered by Tcl\" src=\"$TCLLOGOURL\"\
	    width=\"$TCLLOGOX\" height=\"$TCLLOGOY\"\
	    align=\"right\"><address>$FOOTERTEXT</address></body></html>"
}

proc serveFrameset {body} {
    global BASEURL DOCTYPE_FRAMES ICONURL
    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE_FRAMES
    puts "<html><head><title>TIP Document Collection</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "<base href=\"$BASEURL\">"
    puts "</head><frameset cols=\"150,*\">"
    puts "<frame src=\"short.html#last\"><frame src=\"$body\" name=\"body\">"
    puts "<noframes><p align=\"justify\">Oh dear!  Your browser don't seem\
	    to support frames; perhaps you might wish to visit the\
	    <a href=\"1.html\">TIP index</a> by way of consolation?\
	    </p></noframes>"
    puts "</frameset></html>"
    exit
}

proc serveIndex {kind type} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL DOCTYPE
    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>TIP Index</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    source $SRCDIR/tiphtml.tcl
    tiphtml::index $kind hardError $type
    puts "<hr>"
    puts "<p><font size=\"1\">The TIP archive is available by anonymous\
	    CVS, and this <a href=\"$ENGINEURL\">TIP Rendering\
	    engine</a> is available online too.</font></p>"
    puts "<div align=\"right\"><p><a\
	    href=\"http://validator.w3.org/check/referer\"><img border=\"0\"\
	    src=\"valid-html40.gif\" alt=\"Valid HTML 4.0!\" height=\"31\"\
	    width=\"88\"></a></p></div></body></html>"
    exit
}

proc serveTclIndex {} {
    puts "Content-Type: text/plain"
    puts ""
    set outerlist {}
    foreachTIP h {
	set l {}
	foreach field {
	    TIP Type State Vote Title Created Author Version
	    Tcl-Version Keywords Obsoletes Obsoleted-By
	    Vote-By Voted-For Voted-Against Voted-Abstained
	    Abstract
	} {
	    if {[info exist h($field)]} {
		lappend l $field $h($field)
	    }
	}
	lappend outerlist $l
    }
    puts $outerlist
    exit
}

proc serveSearch {searchTerm lookInBodies} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL DOCTYPE
    source $SRCDIR/tiphtml.tcl

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>Searching for\
	    [tiphtml::quoteLiteral $searchTerm]</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    if {[string length $searchTerm]} {
	tiphtml::longidx * $searchTerm $lookInBodies
	puts -nonewline "<hr>"
    }
    puts "<form method=\"GET\" action=\"search.html\"><p\
	    >Search&nbsp;for:&nbsp;<input size=\"40\" name=\"search\"\
	    value=\"$searchTerm\"><br><input type=\"submit\" name=\"where\"\
	    value=\"Search titles, keywords and abstracts\">&nbsp;<a\
	    href=\"advancedsearch.html\">Advanced Search</a></p></form>"
    basicHTMLfooter
    exit
}

proc optMenu {var default args} {
    set s "<select name=\"$var\"><option selected>$default</option>"
    foreach arg $args {append s "<option>$arg</option>"}
    append s "</select>"
}
proc advancedSearch {} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL DOCTYPE
    source $SRCDIR/tiphtml.tcl

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>Advanced Search</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>Advanced Search of TIP Archive</h1><hr><form method=\"GET\"\
	    action=\"advancedsearchresults.html\"><p><strong\
	    >Criteria:</strong><br> Search for <input name=\"search\"> in\
	    <input type=\"checkbox\" name=\"locus\" value=\"titles\"\
	    checked> Titles <input type=\"checkbox\" name=\"locus\"\
	    value=\"keywords\" checked> Keywords <input type=\"checkbox\"\
	    name=\"locus\" value=\"abstracts\" checked> Abstracts <input\
	    type=\"checkbox\" name=\"locus\" value=\"bodies\"> Bodies<br>"
    puts "<input type=\"checkbox\" name=\"locus\" value=\"authors\"> <strong\
	    >and</strong> by an author whose name or email address includes\
	    the string: <input name=\"author\"><br>"
    puts "<input type=\"checkbox\" name=\"locus\" value=\"created\"> <strong\
	    >and</strong> created [optMenu daterel on before after] the date\
	    [optMenu day 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17\
	    18 19 20 21 22 23 24 25 26 27 28 29 30 31]-[optMenu month Jan Feb\
	    Mar Apr May Jun Jul Aug Sep Oct Nov Dec]-[optMenu year 2000 2001\
	    2002 2003 2004 2005]</p>"
    puts "<p><strong>Options:</strong><br>\
	    [srchCB locus nofinal  {Ignore Final TIPs}]\
	    [srchCB locus nodraft  {Ignore Draft TIPs}]\
	    [srchCB locus project  {Ignore Non-Project TIPs}]\
	    [srchCB locus noreject {Ignore Rejected and Withdrawn TIPs}]</p>"
    puts "<p><strong>Sort result:</strong><br><input type=\"radio\"\
	    name=\"sortby\" value=\"TIP\" checked> Series ID <input\
	    type=\"radio\" name=\"sortby\" value=\"Title\"> Title <input\
	    type=\"radio\" name=\"sortby\" value=\"State\"> State <input\
	    type=\"radio\" name=\"sortby\" value=\"Type\"> Type <input\
	    type=\"radio\" name=\"sortby\" value=\"Vote\"> Voting Status<p\
	    ><input type=\"submit\" value=\"Search Archive\"></form>"
    basicHTMLfooter
    exit
}
proc srchCB {name value label} {
    regsub -all " " $label {\&nbsp;} label
    format "<input type=\"checkbox\" name=\"%s\" value=\"%s\">&nbsp;%s" \
	    $name $value $label
}
proc serveSearch2 {locus pat1 pat2 date daterel order} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL DOCTYPE
    source $SRCDIR/tiphtml.tcl

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>Results of Advanced Search</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    tiphtml::longidx2 $locus $pat1 $pat2 $date $daterel $order
    puts -nonewline "<hr>"
    puts "<form method=\"GET\" action=\"search.html\"><p\
	    >Search&nbsp;for:&nbsp;<input size=\"40\" name=\"search\"\
	    value=\"$pat1\"><br><input type=\"submit\" name=\"where\"\
	    value=\"Search titles, keywords and abstracts\"></p></form>"
    basicHTMLfooter
    exit
}

proc serveHistory {tipnumber} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL EDITDIR DOCDIR DOCTYPE
    set EDITDIR $DOCDIR
    source $SRCDIR/history.tcl

    if {![regexp {^[0-9]+$} $tipnumber]} {
	generr "Unknown TIP number" "TIPs must be numbered"
    }
    set leh [history::fmtlogentries $tipnumber]

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>CVS History for TIP #$tipnumber</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>CVS History for TIP #$tipnumber</h1>"

    puts "<div align=\"center\">$leh</div>"

    basicHTMLfooter
    exit
}

proc serveDiff {tipnumber revision1 revision2} {
    global BASEURL CSSURL ICONURL SRCDIR ENGINEURL EDITDIR DOCDIR DOCTYPE
    set EDITDIR $DOCDIR
    source $SRCDIR/history.tcl

    if {![regexp {^[0-9]+$} $tipnumber]} {
	generr "Unknown TIP number" "TIPs must be numbered"
    }
    set dlh [history::fmtdifflines $tipnumber $revision1 $revision2]

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts $DOCTYPE
    puts "<html><head><title>Comparing version $revision1 and $revision2\
	    for TIP #$tipnumber</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>Comparing version $revision1 and $revision2 for\
	    TIP #$tipnumber</h1>"
    variable history::addbg
    variable history::delbg
    puts "<p>Note that these changes are shown as applied to the source\
	    document, and not as applied to the rendering into any\
	    particular display format. <span style=\"background-color:\
	    $addbg\">Added lines are highlighted like this,</span> and\
	    <span style=\"background-color: $delbg\">deleted lines are\
	    highlighted like this.</span></p><hr>"

    puts $dlh

    basicHTMLfooter
    exit
}

proc serveRevision {tipnumber version} {
    global EDITDIR DOCDIR SRCDIR
    set EDITDIR $DOCDIR
    source $SRCDIR/history.tcl

    if {![regexp {^[0-9]+$} $tipnumber]} {
	generr "Unknown TIP number" "TIPs must be numbered"
    }
    if {![regexp {^[0-9]+(\.[0-9]+)+$} $version]} {
	generr "Unknown revision" "this server will not retrieve TIPs by tags"
    }
    set content [history::fmtrevision $tipnumber $version]
    puts "Content-Type: text/html; charset=iso-8859-1"
    puts "Content-Length: [string length $content]"
    puts ""
    puts $content
    exit
}

proc logAccess {what} {
    global env LOGFILE
    set RA ?.?.?.?
    set UA ?
    catch {set RA $env(REMOTE_ADDR)}
    catch {set UA $env(HTTP_USER_AGENT)}
    if {[catch {set f [open $LOGFILE a]}]} {return}
    puts $f [format "%-15s\t%-10d\t%-15s\t%s" $RA [clock seconds] $what $UA]
    flush $f
    close $f
}

catch {
    if {[catch {
	source $SRCDIR/parse.tcl

	set what [processCGIOptions]
	logAccess $what
	if {[info exist cookie(chongqid)]} {
	    generr "Temporary access problem" \
		    "Temporary access problem detected; do try later." 402
	}
	switch -glob -- $what {
	    / - /index.html {
		set cmd [list serveFrameset $bodyURL]
	    }
	    /tclIndex.txt {
		set cmd serveTclIndex
	    }
	    /short.html - /medium.html - /long.html {
		set cmd [list serveIndex \
			[file rootname [file tail $what]] $indexType  ]
	    }
	    /search.html {
		set cmd [list serveSearch $searchTerm $searchArea]
	    }
	    /advancedsearch.html {
		set cmd [list advancedSearch]
	    }
	    /advancedsearchresults.html {
		set cmd [list serveSearch2 $searchLocus $searchTerm \
			$searchAuthor $searchDate $searchDateRelation \
			$searchSort]
	    }
	    /edit/* {
		if {!$FEATURE(EDIT)} {
		    generr "Feature Not Supported" \
			    "editing is not supported on this server"
		}
		source $SRCDIR/edit.tcl
		set cmd [list \
			editTIP [file rootname [string range $what 6 end]]  ]
	    }
	    /compare/* {
		if {0&!$FEATURE(CVSWEB)} {
		    generr "Feature Not Supported" "CVS history inspection\
			    is not supported on this server"
		}
		set cmd [list serveDiff \
			[file rootname [string range $what 9 end]] \
			$revision1 $revision2]
	    }
	    /history/* {
		if {0&!$FEATURE(CVSWEB)} {
		    generr "Feature Not Supported" "CVS history inspection\
			    is not supported on this server"
		}
		set cmd [list serveHistory \
			[file rootname [string range $what 9 end]]]
	    }
	    /view/* {
		if {0&!$FEATURE(CVSWEB)} {
		    generr "Feature Not Supported" "CVS history inspection\
			    is not supported on this server"
		}
		set cmd [list serveRevision \
			[file rootname [string range $what 6 end]] \
			$revision0]
	    }
	    /mail.html {
		source $SRCDIR/mail.tcl
		set cmd [list mail::mailform $mailName $mailUser $mailSys \
			$mailTipNum]
	    }
	    /sendmail.html {
		source $SRCDIR/mail.tcl
		set cmd [list mail::mailformaccept]
	    }
	    default {
		set cmd [list serveFile $what]
	    }
	}
    } error]} {
	generr "Internal Error" "unexpected condition \"$error\" occurred" \
		$errorInfo 500 $errorCode
    }
    if {[catch $cmd error]} {
	generr "Internal Error" "unexpected condition \"$error\" occurred" \
		$errorInfo 500 $errorCode
    }
}
exit 0

#! /usr/local/bin/tclsh8.0

set SRCDIR [file join [pwd] [file dirname [info script]]]
set convert {}
set pwd [pwd]
catch {
    source $SRCDIR/config.tcl
    source $SRCDIR/parse.tcl
    source $SRCDIR/tiptex.tcl

    proc tiptex::puts {args} {
	global convert
	switch [llength $args] {
	    2 {append convert [lindex $args 1]}
	    1 {append convert [lindex $args 0] "\n"}
	}
    }
    tiptex::generateWholeArchive
    switch -- [lindex $argv 1] {
	ps {
	    linkEPSImagesForDocument all $pwd
	}
	pdf {
	    makePDFImagesForDocument all $pwd
	}
    }

    set f [open [file join $pwd [lindex $argv 0]] w]
    puts -nonewline $f $convert
    close $f
    exit
}
puts $errorInfo
exit 1

### GENERAL CONFIGURATION OF THE CONFIGURATION CODE ###

namespace eval configure {

    # For each value that this file describes how to configure...
    #
    #   var_name var_type default_value documentation_string
    #
    # The default values will be [subst]ed before assignment, and this
    # operation will be applied in order to the variables.
    variable variables {
	DOCDIR      dir    {}     \
		"Path to directory containing TIP archive checked out of CVS"
	EDITDIR     dir    {}     "Path to directory to use for web editing"
	BASETARG    string _self  "Name of target window for links in HTML"
	BASEURL     string {}     \
		"URL which CGI script will operate as, with trailing '/'"
	CSSURL      string http://www.cs.man.ac.uk/~fellowsd/std.css \
		"URL for style sheet to apply to HTML"
	ICONURL	    string http://www.tcl.tk/favicon.ico \
		"URL for link icon to apply to all HTML documents"
	ENGINEURL   string http://sourceforge.net/projects/tiprender/ \
		"URL for TIP Renderer project on SourceForge"
	TCLLOGOURL  string http://tcl.sourceforge.net/images/tclp.gif \
		"URL of Tcl logo image"
	TCLLOGOX    number 42     "Horizontal size of Tcl logo image"
	TCLLOGOY    number 64     "Vertical size of Tcl logo image"
	TCLCOREMAIL string [email protected] \
		"General email address for correspondence w.r.t. TIP contents"
	FOOTERTEXT  string "TIP AutoGenerator - written by Donal K. Fellows" \
		"Text footer of formatted pages; not HTML, must be HTML-safe"
	LOGFILE     file   {}     \
		"Path to log file (must be writable by CGI script)"
	CVS_CLIENT  file   {[locateBinary cvs      /usr/bin/cvs]} \
		"Path to cvs client binary"
	SENDMAIL    file   {[locateBinary sendmail /usr/lib/sendmail]} \
		"Path to sendmail (or compatible) binary"
	GS	    file   {[locateBinary gs       /usr/bin/gs]} \
		"Path to ghostscript binary"
	PDFLATEX    file   {[locateBinary pdflatex /usr/bin/pdflatex]} \
		"Path to PDFLaTeX binary"
	PUBLISHURL  string http://purl.org/tcl/tip \
		"Base URL for publishing"
	EDITURLBASE string http://purl.org/tcl/tip/edit \
		"Base URL for web editing"
	CVSWEBURL   string {[set BASEURL]history/%d} \
		"URL for cvsweb access; passed through format"
	SENDMAILURL string {[set BASEURL]sendmail.html} \
		"URL for web-to-mail form to target"
	TESTINGTIP  number 10000  "Number of TIP used for testing"
	ISSUEBASE   string {https://sourceforge.net/support/tracker.php?aid=}\
		"(Partial) URL for where to look up bugs/patches"

	FEATURE(EDIT)          boolean 0 "Support web editing"
	COOKIEPATH  string {[pathComponent $BASEURL /]} \
		"Path control value for cookies generated, with trailing '/'"
	FEATURE(CVSWEB)        boolean 1 "Support history inspection"
	FEATURE(EDIT_URL_IN_NEWS_MESSAGE) boolean 1 \
		"Put edit URL in published news msgs"
	FEATURE(EDIT_URL_HTML) boolean 1 "Put edit URL in HTML page"
	FEATURE(PUBLISHING)    boolean 0 \
		"Can publish announcements of new TIPs"

	history::infobg colour #80ff80 "Colour of log entries"
	history::logbg  colour #b0d0ff "Colour of history details"
	history::addbg  colour #80ff80 "Colour of added lines"
	history::delbg  colour #ffa0a0 "Colour of deleted lines"
    }


    # Which values are optional (configurable only if the -expert option is
    # passed to makeconfig.tcl) as the defaults are typically good enough.
    variable optional {
	BASETARG CSSURL ICONURL ENGINEURL TCLLOGOURL TCLLOGOX TCLLOGOY
	FOOTERTEXT ISSUEBASE
	PUBLISHURL EDITURLBASE CVSWEBURL TESTINGTIP COOKIEPATH TCLCOREMAIL
	FEATURE(EDIT) FEATURE(EDIT_URL_IN_NEWS_MESSAGE) FEATURE(PUBLISHING)
	history::logbg history::infobg history::addbg history::delbg
	SENDMAILURL
    }


    # Organize the values into pages (using a list of lists). The first
    # element of each sublist is the title of the page/window, and the other
    # elements are the variables to configure on that page. Note that the
    # first page should usually be written pretty much as-is and the empty
    # "variable" is actually not a variable at all but rather a way of putting
    # a message up (its kind is always message) with the content of the
    # message taken from the introMessage variable (below.)
    # 
    # If the first variable on a page is optional, the whole page is optional.
    variable pages {
	{
	    "Configuring TIP Renderer"
	    ""
	}
	{
	    "Basic Locations"
	    DOCDIR EDITDIR BASEURL TCLCOREMAIL
	}
	{
	    "Self Advertising"
	    BASETARG CSSURL ICONURL ENGINEURL FOOTERTEXT TESTINGTIP
	}
	{
	    "Tcl Powered Logo"
	    TCLLOGOURL TCLLOGOX TCLLOGOY
	}
	{
	    "Editing Features"
	    EDITURLBASE CVSWEBURL FEATURE(EDIT) COOKIEPATH
	}
	{
	    "Publishing Features"
	    FEATURE(PUBLISHING) PUBLISHURL FEATURE(EDIT_URL_IN_NEWS_MESSAGE)
	}
	{
	    "Advanced Reporting"
	    FEATURE(CVSWEB) FEATURE(EDIT_URL_HTML)
	}
	{
	    "CVS-Web Colours"
	    history::infobg history::logbg history::addbg history::delbg
	}
	{
	    "Mail Control"
	    SENDMAILURL TCLCOREEMAIL
	}
	{
	    "Executables and Logs"
	    CVS_CLIENT SENDMAIL GS PDFLATEX LOGFILE
	}
    }


    # Introductory message for the first page that the user sees. Should
    # mention the -expert option and any other options that you define.
    variable introMessage "Welcome to the TIP Rendering engine configuration\
	    wizard. Please supply a value for all empty fields and check\
	    that all other fields are set to sensible values. Many more\
	    fields are available to edit if you start this script with the\
	    -expert option. Once you have chosen values for everything,\
	    this script will write a suitable config.tcl for you into the\
	    current directory."


    # String to write at the front of the configuration file. Contains bits
    # that are needed always (typically things that are only ever configured
    # by the code author). Leading whitespace from each line will be
    # stripped...
    variable header {
	# Both $DOCDIR and $EDITDIR should be working directories checked out
	# from the same CVS repository if web-editing is enabled. The CGI
	# process needs write access to $EDITDIR, and commit privileges to
	# CVS. $DOCDIR must be configured to receive updates each time a
	# change is committed.
	# (See Appendix C, Section C.7.2 of the CVS manual).

	set URI ???
	namespace eval ::history {}

	array set contenttypes {
	    .tip   "text/x-tcl-tip; charset=iso-8859-1"
	    .html  "text/html; charset=iso-8859-1"
	    .htm   "text/html; charset=iso-8859-1"
	    .txt   "text/plain; charset=iso-8859-1"
	    .patch "text/plain; charset=iso-8859-1"
	    .tex   "application/x-latex; charset=iso-8859-1"
	    .xml   "text/xml; charset=iso-8859-1"
	    .gif   "image/gif"
	    .jpg   "image/jpeg"
	    .jpeg  "image/jpeg"
	    .jpe   "image/jpeg"
	    .png   "image/png"
	    .ppm   "image/x-portable-pixmap"
	    .ps    "application/postscript"
	    .eps   "application/postscript"
	    .fig   "application/x-fig"
	    .tcl   "application/x-tcl; charset=iso-8859-1"
	    .dtd   "application/xml-dtd; charset=iso-8859-1"
	    .xml   "text/xml; charset=iso-8859-1"
	    .ms    "application/x-troff; charset=iso-8859-1"
	    .rtf   "text/rtf; charset=iso-8859-1"
	}

	set renderable {}
	set renderexts {}
	foreach ext [array names contenttypes] {
	    if {[file exists $SRCDIR/tip[string trim $ext .].tcl]} {
		lappend renderable $ext
		lappend renderexts [string trim $ext .]
	    }
	}
    }

    catch {
	if {[string match *Name:*.cs.man.ac.uk* \
		[exec nslookup [info hostname]]]} {
	    append header {
		### UGLY HACK ALERT!  Fix access to suitable .cvspass file ###
		set ::env(HOME) $SRCDIR/cvshack
		if {[catch {exec $SRCDIR/cvshack/fix} msg]} {
		    puts "Content-Type: text/plain\n\nERROR: $msg"
		    exit
		}
	    }
	}
    }
}

### CODE THAT IS NEEDED FOR THIS PARTICULAR CONFIGURATION ###

# Procedure to derive proper command paths from the name of the command and
# the current path (UNIX-specific.)
proc locateBinary {name fallback} {
    global env
    set pwd [pwd]
    foreach dir [split $env(PATH) ":"] {
	set fn [file join $pwd $dir $name]
	if {[file isfile $fn] && [file executable $fn]} {
	    return $fn
	}
    }
    return $fallback
}

# Procedure to extract the path part of a URL.
proc pathComponent {url fallback} {
    if {[regexp {^[^/]+//[^/]+(/.*)$} $url -> path]} {
	return $path
    }
    return $fallback
}

# Hack to make sure that setting variables directly into namespaces works...
namespace eval ::history {}

# I like greys, and this undoes all sorts of CDE nastiness...
tk_setPalette grey85

# Points into local copy of CVS archive
set DOCDIR	/home/fellowsd/lang/tcl/tip

# Both $DOCDIR and $EDITDIR should be working directories checked out
# from the same CVS repository.  The CGI process needs write access
# to $EDITDIR, and commit privileges to CVS.  $DOCDIR must be
# configured to receive updates each time a change is committed.
# (See Appendix C, Section C.7.2 of the CVS manual).
##set DOCDIR     $SRCDIR/tips
set EDITDIR	$SRCDIR/tipedit

set BASETARG	_self
set BASEURL	http://www.cs.man.ac.uk/fellowsd-bin/TIP/
set CSSURL	http://www.cs.man.ac.uk/~fellowsd/std.css
set ICONURL	http://www.tcl.tk/favicon.ico
set ENGINEURL	http://sourceforge.net/projects/tiprender/
set TCLLOGOURL	http://tcl.sourceforge.net/images/tclp.gif
# Size of image at above URL
set TCLLOGOX	42
set TCLLOGOY	64
set FOOTERTEXT	"TIP AutoGenerator - written by Donal K. Fellows"
set URI		???
set LOGFILE	/home/fellowsd/lang/tcl/TIP/log
### More complex because I want to run on several platforms at once!
switch $tcl_platform(os) {
    SunOS {
	set CVS_CLIENT	/home/fellowsd/arch/sparc-sun-solaris/bin/cvs
	set SENDMAIL	/usr/lib/sendmail
	set GS		/opt/cs/bin/gs
	set PDFLATEX	/opt/cs/bin/pdflatex
    }
    Linux {
	set CVS_CLIENT	/usr/bin/cvs
	set SENDMAIL	/usr/sbin/sendmail
	set GS		/usr/bin/gs
	set PDFLATEX	/usr/bin/pdflatex
    }
}
# Separate, since might be a PURL
set PUBLISHURL  http://purl.org/tcl/tip
# Separate, since might not reside on same server.
set EDITURLBASE	http://purl.org/tcl/tip/edit
set CVSWEBURL	${BASEURL}history/%d
set TESTINGTIP	10000
set COOKIEPATH	/fellowsd-bin/TIP/
set TCLCOREMAIL [email protected]
set SENDMAILURL http://www.cs.man.ac.uk/fellowsd-bin/TIP/sendmail.html
set ISSUEBASE	https://sourceforge.net/support/tracker.php?aid=

array set FEATURE {
    EDIT 0
    CVSWEB 1
    EDIT_URL_IN_NEWS_MESSAGE 1
    EDIT_URL_HTML 1
    PUBLISHING 1
}

### UGLY HACK ALERT!  Gives access to suitable .cvspass file ###
set ::env(HOME) $SRCDIR/cvshack
set msg {}
foreach exe [list fix_$tcl_platform(machine)_$tcl_platform(os) fix] {
    if {![catch {exec $SRCDIR/cvshack/$exe} msg]} {
	break
    }
}
if {[string length $msg]} {
    puts "Content-Type: text/plain\n\nERROR: $msg"
    exit
}

namespace eval history {
    # Assorted configurable parameters for the history management mechanism.
    variable cmpurl compare
    variable logbg  #b0d0ff
    variable infobg #80ff80
    variable addbg  #80ff80
    variable delbg  #ffa0a0
}
array set contenttypes {
    .tip   "text/x-tcl-tip; charset=iso-8859-1"
    .html  "text/html; charset=iso-8859-1"
    .htm   "text/html; charset=iso-8859-1"
    .txt   "text/plain; charset=iso-8859-1"
    .patch "text/plain; charset=iso-8859-1"
    .tex   "application/x-latex; charset=iso-8859-1"
    .xml   "text/xml; charset=iso-8859-1"
    .gif   "image/gif"
    .jpg   "image/jpeg"
    .jpeg  "image/jpeg"
    .jpe   "image/jpeg"
    .png   "image/png"
    .ppm   "image/x-portable-pixmap"
    .ps    "application/postscript"
    .eps   "application/postscript"
    .fig   "application/x-fig"
    .tcl   "application/x-tcl; charset=iso-8859-1"
    .dtd   "application/xml-dtd; charset=iso-8859-1"
    .xml   "text/xml; charset=iso-8859-1"
    .ms    "application/x-troff; charset=iso-8859-1"
    .rtf   "text/rtf; charset=iso-8859-1"
}

set renderable {}
set renderexts {}
foreach ext [array names contenttypes] {
    if {[file exists $SRCDIR/tip[string trim $ext .].tcl]} {
	lappend renderable $ext
	lappend renderexts [string trim $ext .]
    }
}

# FILE: cvs.tcl
#
# Routines that interface to the CVS client program and manage file locks

proc acquireLock {tip} {
    global EDITDIR

    # Write our lock file -- overwrite any left by prior owners of our pid
    set lockFile      [file join $EDITDIR .$tip.lock]
    set myLockFile    [file join $EDITDIR .$tip.[pid].lock]
    set myReleaseFile [file join $EDITDIR .$tip.[pid].release]
    file delete -- $myReleaseFile
    set f [open $myLockFile w]
    puts $f $myReleaseFile
    close $f

    set tries 30
    while {[incr tries -1]} {
	# Try to claim the lock by renaming our lock file to the lock
	# file for the TIP we want to lock.  Only one process can win
	# this race.
	if {![catch {file rename -- $myLockFile $lockFile}]} {

	    # Here we might try setting up child process to release
	    # the lock in case we are killed before we release it.
	    # (CGI spec allows the CGI script to be killed at any time.)

	    # We got the lock!  acquireLock can return
	    return
	}

	# Someone else holds the lock.  Read it.
	set f [open $lockFile]
	set releaseFile [gets $f]
	close $f
        # How old is it?
	if {![catch {file mtime $lockFile} lockTime]
		&& ([clock seconds] - $lockTime) > 120} {
	    # The lock is more than 5 minutes old.  Assume that
	    # the process that acquired the lock died without
	    # releasing it.  We'll release it instead.
	    #
	    # Release the lock file by renaming it so that only
	    # one process can succeed in releasing it.
	    catch {file rename -- $lockFile $releaseFile}
	}

	# Wait a couple seconds, then try again to acquire the lock.
	after 2000
    }

    # After several tries, we never acquired the lock
    file delete -- $myLockFile
    return -code error "could not acquire lock"
}

proc releaseLock {tip} {
    global EDITDIR
    set lockFile [file join $EDITDIR .$tip.lock]

    # If a child process was launched as a safeguard to release
    # our lock, cancel it.

    # Release my lock.
    file delete -- $lockFile
}

proc cvs {args} {
    global EDITDIR CVS_CLIENT errorCode

    if {[catch {
	cd $EDITDIR
	uplevel 1 [linsert $args 0 exec $CVS_CLIENT -q]
    } result]} {
	# CVS writes lots of messages to stderr.  Don't treat those
	# messages as errors.  Only raise an error on a non-zero exit
	# status.
	if {[string match CHILDSTATUS [lindex $errorCode 0]]} {
	    return -code error "$result (exit code was [lindex $errorCode 2])"
	}
    }
    return $result
}

# FILE: edit.tcl
#
# Routines to manage the editing of a TIP via the web.

proc setPOSTdefaults {array} {
    global SRCDIR
    upvar 1 $array h

    # When is the TIP available for editing through the web?
    #    If the State is Draft, and the vote is still pending.
    # Might adjust these conditions to taste...
    if {[notEditable? h]} {
	refuseToEdit h
    }
    if {![info exists ::post::operation]} {
	source $SRCDIR/post.tcl
    }

    if {![info exists ::post::revision]} {
	regexp {^\$([^:]+): (.*)\$$} $h(Version) -> keyword expansion
	switch [string tolower $keyword] {
	    id {
		regexp {tip,v ([0-9.]+)} $expansion -> ::post::revision
	    }
	    revision {
		set ::post::revision [string trim $expansion]
	    }
	    default {
		return -code error "Header field Version: must be\
			a CVS keyword expansion of Revision: or Id:"
	    }
	}
    }

    if {![info exists ::post::abstract]} {
	set ::post::abstract $h(RawAbstract)
    }
    if {![info exists ::post::body]} {
	set ::post::body [join $h(Body) \n\n]
    }
    if {![info exists ::post::log]} {
	set ::post::log {}
    }
}

proc cookieHeader {key value} {
    global EDITURLBASE COOKIEPATH
    binary scan $value H* hexvalue
    return "Set-Cookie: $key=$hexvalue; path=$COOKIEPATH;\
	    expires=Sunday, 01-Jan-2034 00:00:00 GMT"
    # Expires line is extracted from Netscrape cookie documentation...
}
proc getCookie {key} {
    global cookie
    set value {}
    catch {
	# Fails if malformatted or non-existant, but that's OK
	set value [binary format H* $cookie($key)]
    }
    return $value
}

proc editTIP {id} {
    global DOCDIR URI 

    set filename [file join $DOCDIR $id.tip]
    if {![file readable $filename]} {
	generr "Not Found" "that document is not available on this server."
    }

    array set details [getTIPDetails $filename]
    setPOSTdefaults details
    switch -exact -- $::post::operation {
	edit {
	    if {![string length $::post::email]} {
		set ::post::email [getCookie tipwebEMAIL]
	    }
	    if {![string length $::post::name]} {
		set ::post::name [getCookie tipwebNAME]
	    }
	    presentForm details
	}
	commit {
	    attemptCommit details
	}
	default {
	    generr "Invalid Request" "the request POST for URL $URI provided\
		invalid value '$::post::operation' for form variable\
		'operation'." {} 403
	}
    }
}

proc refuseToEdit {array} {
    global BASEURL CSSURL ICONURL FOOTERTEXT
    upvar 1 $array h

    puts "Content-Type: text/html; charset=iso-8859-1"
    puts ""
    puts "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"\
            \"http://www.w3.org/TR/REC-html40/loose.dtd\">"
    puts "<html><head><title>TIP #$h(TIP): Editing Refused</title>"
    puts "<meta http-equiv=\"Content-Type\"\
	    content=\"text/html; charset=iso-8859-1\">"
    puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
    puts "<base href=\"$BASEURL\" target=\"body\">"
    puts "<link rel=\"stylesheet\" type=\"text/css\"\
	    title=\"My standard style\" href=\"$CSSURL\">"
    puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
    puts "</head><body bgcolor=\"#d9d9d9\">"
    puts "<h1>TIP #$h(TIP): $h(Title)</h1><hr>"

    puts -nonewline "<p align=\"justify\">TIP #$h(TIP) may not be edited\
	    through the web because "
    if {[string match "In progress" $h(Vote)]} {
	puts "a vote is in progress.</p>"
    } else {
	puts "its State is $h(State).</p>"
    }
    puts "<p align=\"justify\">View the current revision of \
	    <a href=\"$BASEURL/$h(TIP).html\">TIP #$h(TIP)</a>.</p>"
    puts "<hr><address>$FOOTERTEXT</address></body></html>"
    exit
}

proc presentForm {array {msg ""}} {
    global SRCDIR BASEURL FOOTERTEXT ENGINEURL
    upvar 1 $array h
    variable ::post::abstract
    variable ::post::revision
    variable ::post::body
    variable ::post::email
    variable ::post::name
    variable ::post::log

    puts "Content-Type: text/html; charset=iso-8859-1\n"
    source $SRCDIR/tiphtml.tcl
    tiphtml::generateTIPHeader [array get h]
    if {[string length $msg]} {
	puts "<p align=\"justify\"><font\
		color=\"red\"><strong>$msg</strong></font>"
    }
    puts "<p align=\"justify\">Please enter your e-mail address (required),\
	    your name (optional), make your edits to this TIP and its\
	    Abstract, and <strong>Submit</strong> them.  See <a\
	    href=\"3.html\">TIP 3</A> for a description of the TIP\
	    format.</p>"
    puts "<p align=\"justify\"><strong>You are advised to copy the text of\
	    the TIP into an editor, make your edits there, and then paste\
	    back.</strong></p>"
    puts "<form method=\"POST\" action=\"edit/$h(TIP)\"><table>"
    puts "<tr><td align=\"right\"><strong>E-mail:</strong></td><td>"
    puts "<input size=\"40\" name=\"email\" value=\"$email\">"
    puts "</td><td align=\"center\"><input type=\"reset\" name=\"reset\"\
	    value=\"Reset\"></td></tr><tr><td\
	    align=\"right\"><strong>Name:</strong></td><td>"
    puts "<input size=\"40\" name=\"name\" value=\"$name\">"
    puts "</td><td align=\"center\"><input type=\"submit\" name=\"submit\"\
	    value=\"Submit\"></td></tr></table><br><table><tr><td\
	    valign=\"top\"><strong>Abstract:</strong></td><td valign=\"top\">"
    puts "<textarea cols=\"72\" rows=\"4\"\
	    name=\"abstract\">$abstract</textarea>"
    puts "</td></tr><tr><td valign=\"top\"><strong>Body:</strong></td><td>"
    puts "<textarea cols=\"72\" rows=\"25\" name=\"body\">$body</textarea>"
    puts "<input type=\"hidden\" name=\"revision\" value=\"$revision\"><input\
	    type=\"hidden\" name=\"operation\"\
	    value=\"commit\"></td></tr>"
    puts "<tr><td valign=\"top\"><strong>Log:</strong></td><td\
	    valign=\"top\"><textarea cols=\"72\" rows=\"2\"\
	    name=\"log\">$log</textarea><p><em>This is a supplement to the\
	    main log message to allow you to add extra notes if you\
	    wish.</em></p></td></tr>"
    puts "</table></form><p align=\"justify\"><font size=\"1\">Note that\
	    when you submit this form, the server will attempt to store\
	    your personal details (<i>i.e.</i> name and email address) as\
	    cookies in your browser so that next time you edit a TIP, you\
	    do not need to retype this info. We do not retain the information\
	    on our server (other than as logged in the TIP itself and in\
	    the CVS log) and you can delete it without ill-effect if you\
	    wish. <a href=\"$ENGINEURL\">You are invited to study the\
	    implementation code</a> if you wish to understand exactly how\
	    the information is stored in your browser.</font></p><hr\
	    ><address>$FOOTERTEXT</address></body></html>"
    exit
}

proc attemptCommit {array} {
    global EmailRE EDITDIR BASEURL SRCDIR DOCDIR
    upvar 1 $array h

    if {![regexp $EmailRE <$::post::email>]} {
	presentForm h "You must provide a valid e-mail address!"
    }

    set pars [splitIntoParagraphs [string trim $::post::body]]

    # Force Abstract into a single paragraph and heading and stick
    # it at the beginning.
    set pars [linsert $pars 0 "~ Abstract" [join [splitIntoParagraphs \
	    [string trim $::post::abstract]] \n]]

    # Double-check we did that right...
    if {[string compare {section Abstract 1} \
	    [intuitParagraphKind [lindex $pars 0]]]} {
	presentForm h "Each TIP must begin with an Abstract!"
    }

    # For wiki-spam, we adopt an evil approach; we pretend that we've
    # successfully checked in the change but in fact we've done
    # nothing of the sort and just format the page that the user
    # submitted so that it appears they were successful.
    if {[isWikispam h $pars]} {
	global COOKIEPATH
	array set oldHeaders [getTIPDetails $DOCDIR/$h(TIP).tip]
	set oldHeaders(Post-History) \
		"<span style=\"foreground:red\">Wikispam detected: $why</span>\
		Contact <a href=\"mailto:[email protected]>the\
		TIP Editor</a> for help, including the change this TIP."
	set ohpar [constructTIPHeader [array get oldHeaders]]
	set data [formatTIPDocument $ohpar\n\n[join $pars \n\n]]
	puts "Content-Type: text/html"
	puts "Content-Length: [string length $data]"
	puts [cookieHeader chongqid $::post::name]
	puts ""
	puts -nonewline $data
	exit
    }

    # Remove any CVS keyword expansion from the new TIP body to avoid
    # conflict false alarms.
    #
    # At this point we could do any additional consistency or format
    # checking on the new TIP body, and return bad TIPs to submitter
    # for more editing.
    #
    set newBody [join $pars \n\n]
    foreach keyword [list Author Date Header Id Name Locker Log RCSfile \
	    Revision Source State] {
	regsub -all -- \\$$keyword:?.*\\$ $newBody $$keyword$ newBody
    }

    # Change to the working directory for editing, so cvs commands
    # will work, and filenames can be relative.
    cd $EDITDIR

    # OK, now comes the tricky part.  We need exclusive access to the
    # .tip file in $EDITDIR so we can update, merge, and commit the new
    # changes in the TIP without interference from other CGI processes
    # trying to do the same thing.  So, we use a locking mechanism.
    # See cvs.tcl for details.
    source $SRCDIR/cvs.tcl
    
    # The next command will block until it can aquire the lock it needs.
    if {[catch {acquireLock $h(TIP)}]} {
	presentForm h "Could not acquire a lock on a working copy of\
		$h(TIP).tip.  Please wait a moment and try your\
		submission again."
    }

    # Retrieve from CVS the revision on which the new edits are based.
    set file $h(TIP).tip
    file delete -- $file
    cvs update -r $::post::revision -kk $file

    # Replace the old body with the new body.  Keep the old headers so we
    # avoid any merging conflicts in the headers.
#    set newTIP [constructTIPHeader [getTIPDetails $file]]\n\n[join $pars \n\n]
    set newTIP [constructTIPHeader [getTIPDetails $file]]\n\n$newBody
    file delete -- $file
    set f [open $file w]
    puts $f $newTIP
    close $f

    # Merge in the other changes from the HEAD revision.  Record whether
    # there was a conflict, and read in the merged result.
    set conflict [string match "*C $file*" [cvs update -A -kk $file]]
    array set details [array get h]
    array set details [getTIPDetails $file]

    # Add submitter as a new Author in headers, if necessary
    set newAuthor 1
    foreach author $details(Author) {
	if {[string match *<$::post::email>* $author]} {
	    set newAuthor 0
	    break
	}
    }
    if $newAuthor {
	lappend details(Author) "$::post::name <$::post::email>"
	set newTIP [constructTIPHeader [array get details]]
	append newTIP "\n\n~ Abstract\n\n$details(RawAbstract)"
	append newTIP \n\n[join $details(Body) \n\n]
	file delete -- $file
	set f [open $file w]
	puts $f $newTIP
	close $f
    }

    if {$conflict} {
	regexp {revision:[ \t]*([0-9.]+)} [cvs status $file] -> ::post::revision

	# After releasing the lock, send a form back to
	# submitter to resolve the conflict.
	set postReleaseScript {
	    unset ::post::abstract
	    unset ::post::body
	    setPOSTdefaults details
	    presentForm details "Your changes conflicted with changes from\
		    someone else.  Please resolve the conflict and submit\
		    again."
	}

    } else {
	# No conflict.  Try to commit the new revision to CVS

	set msg "Revision through web from $::post::name <$::post::email>"
	if {[info exists ::post::log] && [string length $::post::log]} {
	    append msg "\n" [string trim $::post::log]
	}

	if {[catch {cvs commit -m $msg $file} msg]} {

	    # A failed 'cvs commit' after a successful 'cvs update' probably
	    # means another 'cvs commit'  occurred (from somewhere other than
	    # the web interface) since our 'cvs update'.  Try again.
	    set postReleaseScript {
		attemptCommit h
	    }

	} else {
	    # Successful commit.
	    # Give it a second to push through, then redirect to the HTML
	    # rendering of the new revision.
	    set postReleaseScript {
	        after 2100
		puts "Location: $BASEURL$details(TIP).html"
		puts [cookieHeader tipwebEMAIL $::post::email]
		puts [cookieHeader tipwebNAME  $::post::name]
		puts ""
	    }
	}
    }

    releaseLock $h(TIP)
    eval $postReleaseScript
}

proc isWikispam {headerArray paragraphs {whyVar why}} {
    upvar 1 $headerArray h $whyVar why
    global DOCDIR

    # Spammers are lazy, real contributors are (usually) not.

    if {[llength [split $::post::name]] < 2} {
	set why "short real name"
	return 1
    }

    # Count the number of http urls in the original and the new
    # version. Note that these searches are *very* simple-minded, but
    # that should be enough.

    set old [getTIPFileContents [file join $DOCDIR $h(TIP).tip]]
    set oldCount 0
    set idx 0
    while {[set idx [string first http: $old $idx]] >= 0} {
	incr oldCount
	incr idx
    }

    set new [join $paragraphs]
    set newCount 0
    set idx 0
    while {[set idx [string first http: $new $idx]] >= 0} {
	incr newCount
	incr idx
    }

    # It's spam if more than two things that look vaguely like http
    # URIs are added in a single update
    if {$newCount > $oldCount + 2} {
	set why "too many added URLs"
	return 1
    }
    return 0
}

source $SRCDIR/cvs.tcl

proc history::logentries {file} {
    set entries {}
    set gotfirst 0
    set pattern1 ----------------------------
    set pattern0 =============================================================================
    foreach line [split [string trim [cvs log -N $file]] "\n"] {
	if {[string match $pattern0 $line]} {
	    lappend entries $accum
	    break
	}
	if {[string match $pattern1 $line]} {
	    if {$gotfirst} {
		lappend entries $accum
	    } else {
		set gotfirst 1
	    }
	    set accum {}
	    continue
	}
	lappend accum $line
    }
    set revisions {}
    array set info {}
    foreach entry $entries {
	regexp {revision (.*)} [lindex $entry 0] -> revision
	lappend revisions $revision
	foreach kv [split [lindex $entry 1] ";"] {
	    set kv [string trim $kv]
	    if {![string length $kv]} {continue}
	    regexp {([^:]+): +(.*)} $kv -> key value
	    set info($revision,$key) $value
	}
	# Trim off unwanted lines
	set log [lrange $entry 2 end]
	while {[string match {branches: *;} [lindex $log 0]]} {
	    set log [lrange $log 1 end]
	}
	set info($revision,logmsg) [join $log "\n"]
    }
    return [list $revisions [array get info]]
}

proc history::difflines {file r1 r2} {
    set lines {}
    set inheader 1
    set seppat @@*@@
    catch {cvs diff -u -b -r$r1 -r$r2 $file} msg
    foreach line [split [string trim $msg] \n] {
	if {[string match $seppat $line]} {
	    if {!$inheader} {
		lappend lines sep
	    } else {
		set inheader 0
	    }
	} elseif {!$inheader} {
	    regexp {(.)(.*)} $line -> type content
	    while {[regexp -indices "\t" $content tabpos]} {
		set tabpos [lindex $tabpos 0]
		set pre [string range $content 0 [expr {$tabpos-1}]]
		set post [string range $content [expr {$tabpos+1}] end]
		### [string repeat] is not available in 8.0
		append pre " "
		while {[string length $pre]%8} {append pre " "}
		set content $pre$post
	    }
	    switch -- $type {
		-   {lappend lines [list del $content]}
		+   {lappend lines [list add $content]}
		" " {lappend lines [list ctx $content]}
	    }
	}
    }
    return $lines
}

proc history::quoteEnt {string} {
    regsub -all &  $string {\&}  string
    regsub -all \" $string {\"} string
    regsub -all <  $string {\&lt;}   string
    regsub -all >  $string {\&gt;}   string
    return $string
}
proc history::quoteEmail1 {string} {
    global EmailRE
    regsub -all $EmailRE $string "<\x80\\1\x81>" string
    return $string
}
proc history::quoteEmail2 {string tip} {
    while {[regexp -indices "\x80\[^\x80\x81\]+\x81" $string locn]} {
	foreach {first last} $locn {}
	set mail [string range $string [expr {$first+1}] [expr {$last-1}]]
	foreach {user sys} [split $mail @] {break}
	regsub -all {\.} $user " <span class=\"midmail\">dot</span> " user
	regsub -all {\.} $sys " <span class=\"midmail\">dot</span> " sys
	set newstring [string range $string 0 [expr {$first-1}]]
	append newstring "$user <span class=\"midmail\">at</span> $sys"
	set string $newstring[string range $string [expr {$last+1}] end]
    }
    return $string
}

proc history::fmtlogentries {tipid} {
    set loginfo [logentries $tipid.tip]
    array set info [lindex $loginfo 1]

    variable infobg
    variable logbg

    append puts "<table><tr><th width=\"1\">Version</th><th\
	    width=\"1\">Author</th><th width=\"1\">Date</th><th\
	    width=\"1\">Quick Comparison</th></tr>\n"
    set vs [lsort -dictionary [lindex $loginfo 0]]
    foreach v $vs {
	# hardcoded value!
	if {![string compare $info($v,author) "tclhttpd"]} {
	    set info($v,author) "<i>WebEdit</i>"
	}
	append puts "<tr><td bgcolor=\"$infobg\">$v</td><td\
		bgcolor=\"$infobg\">$info($v,author)</td><td\
		bgcolor=\"$infobg\">$info($v,date)</td>\n"
	append puts "<td bgcolor=\"$infobg\"><a href=\"view/$tipid?ver=$v\"\
		onmouseover=\"window.status='View this version';return\
		true\"><b>View this version</b></a></td>\n"
	append puts "</tr>\n"
	append puts "<tr><td colspan=\"4\"><table border width=\"100%\"\
		bgcolor=\"$logbg\"><tr><td><b>Log Message</b><pre>\n"
	set loglines [quoteEmail1 $info($v,logmsg)]
	set loglines [join [split [quoteEnt $loglines] "\n"] "\n  "]
	set loglines [quoteEmail2 $loglines $tipid]
	append puts "  $loglines</pre></td></tr></table></td></tr>\n"
    }
    append puts "<tr><td colspan=\"4\" align=\"center\"><form method=\"get\"\
	    action=\"compare/$tipid\">\n"
    append puts "<select name=\"cmpa\"><option\
	    selected>[lindex $vs 0]</option>"
    foreach v [lrange $vs 1 end] {
	append puts "<option>$v</option>"
    }
    append puts "\n</select><input type=\"submit\" value=\"compared\
	    with\"><select name=\"cmpb\">\n"
    foreach v [lrange $vs 0 [expr {[llength $vs]-2}]] {
	append puts "<option>$v</option>"
    }
    append puts "<option selected>[lindex $vs end]</option></select>\n"
    append puts "</form></td></tr>"
    append puts "</table>"
}

proc history::fmtdifflines {tipid r1 r2} {
    variable addbg
    variable delbg

    set old {}
    set lineinfo [difflines $tipid.tip $r1 $r2]
    set maxl 0

    if {![llength $lineinfo]} {
	return "<p>No differences or at least one version non-existent.</p>"
    }

    foreach line $lineinfo {
	set len [string length [lindex $line 1]]
	if {$len>$maxl} {set maxl $len}
    }
    append puts "<pre>\n"
    foreach line $lineinfo {
	set c [quoteEnt [format %-*s $maxl [lindex $line 1]]]
	append puts $old
	set old {}
	switch [lindex $line 0] {
	    sep {append puts "<hr width=\"75%\" align=\"left\" noshade>"}
	    ctx {append puts "$c\n"}
	    add {
		append puts "<span style=\"background-color: $addbg\">$c\n"
		set old "</span>"
	    }
	    del {
		append puts "<span style=\"background-color: $delbg\">$c\n"
		set old "</span>"
	    }
	    default {append puts ==$line==\n}
	}
    }
    append puts "</pre>"
}

proc history::fmtrevision {tipid revision} {
    set document [cvs update -pr $revision $tipid.tip 2>/dev/null]
    formatTIPDocument $document html $revision
}

#source $SRCDIR/post.tcl
namespace eval ::mail {
    namespace export mailform mailformaccept mailsend

    proc row {c1 c2 args} {
	if {[string length $c1]} {
	    puts -nonewline "<tr><th align=\"left\">$c1</th><td\
		    valign=\"top\">"
	} else {
	    puts -nonewline "<tr><td></td><td valign=\"top\">"
	}
	puts [eval [list format "$c2</td></tr>"] $args]
    }
    proc row_a {c1 c2 args} {
	if {[string length $c1]} {
	    puts -nonewline "<tr><th align=\"left\"\
		    valign=\"top\">$c1</th><td valign=\"top\">"
	} else {
	    puts -nonewline "<tr><td></td><td valign=\"top\">"
	}
	puts [eval [list format "$c2</td></tr>"] $args]
    }

    proc dotify {str} {
	regsub -all {\.} $str " <span class=\"midmail\">dot</span> " str
	return $str
    }

    proc mailform {name user sys tipnum} {
	global BASEURL CSSURL ICONURL DOCTYPE DOCDIR TCLCOREMAIL SENDMAILURL
	if {![string length $name]} {
	    set syntheticName 1
	    set hname "${user}_at_${sys}"
	    set name [dotify "$user <span class=\"midmail\">at</span> $sys"]
	} else {
	    set hname $name
	}
	puts "Content-Type: text/html; charset=iso-8859-1"
	puts ""
	puts $DOCTYPE
	puts "<html><head><title>Compose Mail to $hname About\
		TIP#$tipnum</title>"
	puts "<meta http-equiv=\"Content-Type\"\
		content=\"text/html; charset=iso-8859-1\">"
	puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
	puts "<base href=\"$BASEURL\" target=\"body\">"
	puts "<link rel=\"stylesheet\" type=\"text/css\" \
		title=\"My standard style\" href=\"$CSSURL\">"
	puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
	puts "</head><body bgcolor=\"#d9d9d9\">"
	puts "<h1>Composing Email Message to $name About TIP#$tipnum</h1><hr>"
	puts "<form method=\"POST\" action=\"$SENDMAILURL\"><table>"
	set hide [list user $user sys $sys tipnum $tipnum]
	if {![info exist syntheticName]} {
	    lappend hide name $name
	}
	row From: "<input type=\"text\" name=\"from\">"
	row "" "<p align=\"justify\">Please note that you will be Cc'ed with\
		whatever message you create here, so you can retain a record\
		of your messages if you wish.</p>"
	row To: "%s &lt;%s <span class=\"midmail\">at</span> %s&gt;" \
		$name [dotify $user] [dotify $sys]
	foreach {tc_user tc_sys} [split $TCLCOREMAIL @] {break}
	if {
	    [string compare $user $tc_user] ||
	    [string compare $sys $tc_sys]
	} then {
	    row "" "<input type=\"checkbox\" name=\"cccore\"\
		    value=\"cccore\"> Send <b>Cc:</b> to %s <span\
		    class=\"midmail\">at</span> %s" \
		    [dotify $tc_user] [dotify $tc_sys]
	}
	if {[regexp {^[0-9]+$} $tipnum]} {
	    array set tipd [getTIPDetails [file join $DOCDIR $tipnum.tip]]
	    row Subject: "Re: TIP#%d: %s" $tipnum $tipd(Title)
	    lappend hide subject "Re: TIP#${tipnum}: $tipd(Title)"
	} else {
	    row Subject: "<input type=\"text\" name=\"subject\">"
	}
	row_a Body: "<textarea name=\"body\" rows=\"12\" cols=\"72\"\
		wrap=\"physical\"></textarea>"
	puts "<tr><td colspan=\"2\"><input type=\"submit\"\
		value=\"Send Email\"> &nbsp; <input type=\"reset\"\
		></td></tr></table>"
	if {[info exist ::env(HTTP_REFERER)]} {
	    lappend hide ref $::env(HTTP_REFERER)
	} else {
	    lappend hide ref $BASEURL/$tipnum
	}
	foreach {key val} $hide {
	    regsub -all & $val {\&amp;} val
	    regsub -all < $val {\&lt;} val
	    regsub -all > $val {\&gt;} val
	    regsub -all \" $val {\&quot;} val
	    puts "<input type=\"hidden\" name=\"$key\" value=\"$val\">"
	}
	puts -nonewline "</form>"
	basicHTMLfooter
	exit
    }

    proc mailformaccept {} {
	variable ::post::name	 ;#"NO NAME"
	variable ::post::user	 ;#no.name
	variable ::post::sys	 ;#all
	variable ::post::tipnum  ;#-1
	variable ::post::from	 ;#[email protected]
	variable ::post::subject ;#TEST
	variable ::post::body	 ;#"TESTING...\r\n1, 2, 3, 4, 5\r\n"
	variable ::post::ref     ;#$::BASEURL
	variable ::post::cccore  ;#{}

	if {![regexp {^[^,]+@[^,]+\.[^,]+$} $from]} {
	    generr "Bad From Email Address" \
		    "this system will not send mail purporting to come\
		    from $from"
	}
	if {[regexp {[^a-zA-Z0-9_.]} $user]||[regexp {[^a-zA-Z0-9_.]} $sys]} {
	    generr "Bad To Email Address" \
		    "this system will not send mail to [dotify $user] <span\
		    class=\"midmail\">at</span> [dotify $sys]"
	}

	#::post::getVars
	set cccore [expr {[info exist cccore] && [string length $cccore]}]
	if {![info exist name]} {
	    set name {}
	}
	# Apply the CRLF->LF translation ourselves
	regsub -all "\r\n" $body "\n" body
	processmail $name $user $sys $tipnum $from $subject $body $ref $cccore
    }

    proc addmailhdr {var key val} {
	# Effectively a sanitised append
	upvar 1 $var v
	regsub -all "\[\r\n\t \]+" $val " " val
	append v "${key}: $val\n"
    }
    proc processmail {name user sys tipnum from subject body ref cccore} {
	global env TCLCOREMAIL

	set hdr ""
	addmailhdr hdr From $from
	addmailhdr hdr Cc $from
	addmailhdr hdr To "$name <$user@$sys>"
	addmailhdr hdr Subject $subject
	if {$cccore} {
	    addmailhdr hdr Cc $TCLCOREMAIL
	}
	addmailhdr hdr Errors-To [email protected]
	addmailhdr hdr X-Tip-Number $tipnum
	addmailhdr hdr MIME-Version 1.0
	addmailhdr hdr Content-Type {text/plain; charset=iso-8859-1}
	addmailhdr hdr Content-Transfer-Encoding 8bit
	addmailhdr hdr Date [clock format [clock seconds] -gmt 1 -format \
		"%a, %d %b %Y %H:%M:%S +0000\n"]
	addmailhdr hdr X-Note "Message generated through web interface"
	catch {addmailhdr hdr X-Submitting-Ip $env(REMOTE_ADDR)}
	catch {addmailhdr hdr X-Submitting-User-Agent $env(HTTP_USER_AGENT)}

	mailsend $hdr\n[string trim $body \n]\n

	# Redirect back to where we originally came from
	puts "Location: $ref\n"
    }

    proc mailsend {message {redir 0}} {
	global SENDMAIL
	if {$redir} {
	    exec $SENDMAIL -oi -t <<$message >@stdout 2>@stderr
	} else {
	    exec $SENDMAIL -oi -t <<$message
	}
    }
}

#! /usr/local/bin/tclsh8.0

# Regular expressions - suitable for 8.0 as well as later.
set ws "\[ \t\n\]"
set ParSepRE      "^$ws*$"
set RFC822ContRE  "^$ws"
set RFC822DataRE  "^(\[^ \t:\]+):$ws+(.*)$"
set RFC822EmptyRE "^(\[^ \t:\]+):$"
set ItemNoLeadRE  "^\[^ \t>\]"
set ItemLeadRE "^$ws*((>$ws+)*)(\\*|\[0-9\]+\\.|(\[^\t\n:\]|:\[^:\t\n\])+:)$ws"
set ItemContRE "^($ws+>)+$ws*"
# RE's for (optional) use in paragraphs
set AuthorRE "(.*$ws+)?<(\[^:@\]+@\[^:@\]+)>"
set ImageRE "^(\[^ \t\n\]+)$ws*(.*)$"
set EmailRE {<([^<>@]+@[^<>@]+)>}
set URLRE {(https?|ftp|news(rc)?|mailto|gopher):([-A-Za-z0-9/_:.%#+@?=&;~\\]+)}
set TIPURLRE {tip:([0-9]+)}
set ShortTIPRE {\[([0-9]+)\]}
set ISSUEURLRE {issue:([0-9]+)}

# # Regular expressions - suitable for 8.1 and later only. It is easier to
# # understand the above by looking at the below and translating...  :^)
# 
# set ParSepRE      {^\s*$}
# set RFC822ContRE  {^\s}
# set RFC822DataRE  {^([^\s:]+):\s*(.*)$}
# set RFC822EmptyRE {^([^\s:]+):\s*$}
# set ItemNoLeadRE  {^[\s>]}
# set ItemLeadRE    {^\s*((>\s+)*)(\*|\d+\.|(?:[^\t\n:]|:(?=\S))+:)\s}
# set ItemContRE    {^(\s+>)+\s*}
# # RE's for (optional) use in paragraphs
# set AuthorRE {(.*\s+)?<(.*?@.*)>}
# set ImageRE {^(\S+)\s*(.*)$}
# set EmailRE {<([^<>@]+@[^<>@]+)>}
# set URLRE {(https?|ftp|news(?:rc)?|mailto|gopher):([-A-Za-z0-9/_:.#+@?=&;~\\]+)}
# set TIPURLRE {tip:(\d+)}
# set ShortTIPRE {\[(\d+)\]}
# set ISSUEURLRE {issue:(\d+)}
# 
# # Note that ItemLeadRE would be clearer if written as:
# #     ^\s*((?:>\s+)*)(\*|\d+\.|(?:[^\t\n:]|:(?=\S))+:)\s
# # but that would be incompatible with the 8.0 version.

proc splitIntoParagraphs {string} {
    global ParSepRE
    set paragraphs {}
    set current {}
    foreach line [split $string "\n"] {
	if {[regexp $ParSepRE $line]} {
	    # (VISUALLY) BLANK LINE = PARAGRAPH SEPARATOR
	    if {[string length $current]} {
		lappend paragraphs [string trim $current "\n"]
		set current {}
	    }
	    continue
	}
	append current "\n$line"
    }
    if {[string length $current]} {
	lappend paragraphs [string trim $current "\n"]
    }
    return $paragraphs
}

proc splitRFC822Header {paragraph} {
    global RFC822ContRE RFC822DataRE RFC822EmptyRE
    set properlines {}
    set current {}
    foreach line [split $paragraph "\n"] {
	if {[regexp $RFC822ContRE $line]} {
	    append current $line
	    continue
	}
	if {[string length $current]} {
	    if {[regexp $RFC822DataRE $current -> tag value]} {
		lappend properlines $tag $value
	    } elseif {[regexp $RFC822EmptyRE $current -> tag]} {
		lappend properlines $tag {}
	    } else {
		return -code error "header \"$current\" malformatted"
	    }
	}
	set current $line
    }
    if {[string length $current]} {
	if {[regexp $RFC822DataRE $current -> tag value]} {
	    lappend properlines $tag $value
	} elseif {[regexp $RFC822EmptyRE $current -> tag]} {
	    lappend properlines $tag {}
	} else {
	    return -code error "header \"$current\" malformatted"
	}
    }
    return $properlines
}

proc TIPHeaderSpecification {permitted required} {
    upvar 1 $permitted formatREs $required neededHeaders
    # A header is only permitted if it is a key in this array, and the value
    # in the array is the regexp that the value in the field (after
    # un-stuffing) must satisfy.
    array set formatREs {
	TIP		{^[0-9]+$}
	Title		{.}
	Version		{^\$.*\$ *$}
	Author		{<.+@.+\..+>}
	State		{^(Draft|Active|Accepted|Deferred|Final|Rejected|Withdrawn)$}
	Type		{^(Process|Project|Informati(ve|on(al)?))$}
	Vote		{^(Pending|In progress|Done|No voting)$}
	Created		{^[0-3][0-9]-[A-Z][a-z][a-z]-2[0-9][0-9][0-9]$}
	Post-History	{.*}
	Tcl-Version	{^[0-9]+\.[0-9]+([ab.][0-9]+)?$}
	Discussions-To	{.}
	Obsoletes	{^[0-9]+$}
	Obsoleted-By	{^[0-9]+$}
	Keywords	{.}
	Vote-By		{^[0-9]+$}
	Voted-For	{.}
	Voted-Against	{.}
	Voted-Abstained	{.}
    }
    # A list of headers that *must* be present in a conforming TIP.
    set neededHeaders {
	TIP Title Version Author State Type Vote Created Post-History
    }
    ## Headers that may occur multiple times in a conforming TIP. All others
    ## must occur at most once.
    #set multipleHeaders {
    #	 Author
    #}
}

# takes output of splitRFC822Header
proc verifyTIPheader {headerlines} {
    array set headers {}
    TIPHeaderSpecification permitted required

    foreach {tag value} $headerlines {
	if {![info exists permitted($tag)]} {
	    return -code error "header \"${tag}: $value\" not understood"
	}
	if {![regexp $permitted($tag) $value]} {
	    return -code error "header \"${tag}: $value\" malformatted"
	}
	if {[string compare $tag Author]} {
	    if {[info exists headers($tag)]} {
		return -code error "header for \"${tag}:\" can only occur once"
	    }
	    set headers($tag) $value
	} else {
	    lappend headers($tag) $value
	}
    }
    foreach tag $required {
	if {![info exist headers($tag)]} {
	    return -code error "header for \"${tag}:\" is required"
	}
    }
    if {[string match Info* $headers(Type)]} {
	set headers(Type) Informative
    }
    if {[info exist headers(Keywords)]} {
	set kws {}
	foreach keyword [split $headers(Keywords) ","] {
	    regsub -all "\[ \t\n\]+" $keyword " " keyword
	    lappend kws [string trim $keyword]
	}
	set headers(Keywords) $kws
    }
    # This check is complex...
    if {[info exist headers(Tcl-Version)] != ![string compare $headers(Type) Project]} {
	return -code error "header \"Tcl-Version:\" iff a project TIP"
    }
    # Force the created header into processable form
    regsub -all -- (.+)-(.+)-(.+) $headers(Created) {\2 \1, \3} date
    set headers(Created) [clock scan $date -gmt 1]
    # Now return as association list
    return [array get headers]
}

proc makeHeaderLine {tag value} {
    set line $tag:
    set numSpaces [expr {16 - [string length $tag]}]
    while {[incr numSpaces -1]} {
        append line " "
    }
    append line $value
    return $line
}

proc constructTIPHeader {headerData} {
    array set headers $headerData
    # Remove RawAbstract, Abstract and Body entries, if any
    catch {unset headers(RawAbstract)}
    catch {unset headers(Abstract)}
    catch {unset headers(Body)}

    TIPHeaderSpecification permitted required
    set headerLines [list]
    foreach tag $required {
	if {![info exists headers($tag)]} {
	    return -code error "header for \"${tag}\" is required"
	}
	set value $headers($tag)
	# Created tag needs restoration to standard form
	if {[string match Created $tag]} {
	    set value [clock format $value -format %d-%b-%Y -gmt 1]
	}
	if {![regexp $permitted($tag) $value]} {
	    return -code error "header \"${tag}: $value\" malformatted"
	}
	# Author tag needs special handling
	if {[string match Author $tag]} {
	    foreach author $value {
		if {![regexp $permitted($tag) $author]} {
		    return -code error "header \"${tag}: $value\" malformatted"
		}
		lappend headerLines [makeHeaderLine Author $author]
	    }
	    unset headers($tag)
	    continue
	}
	lappend headerLines [makeHeaderLine $tag $value]
	unset headers($tag)
    }
    foreach tag [lsort [array names headers]] {
	if {![info exists permitted($tag)]} {
	    return -code error "header \"${tag}: $value\" not understood"
	}
	set value $headers($tag)
	if {![regexp $permitted($tag) $value]} {
	    return -code error "header \"${tag}: $value\" malformatted"
	}
	if {[string match Keywords $tag]} {
	    lappend headerLines [makeHeaderLine $tag [join $value ","]]
	} else {
	    lappend headerLines [makeHeaderLine $tag $value]
	}
    }
    return [join $headerLines \n]
}

proc notEditable? {headerArray} {
    upvar 1 $headerArray h
    expr {[string compare Draft $h(State)]||[string compare Pending $h(Vote)]}
}

proc shortspc {string} {
    regsub -all {[ 	
    ]+} $string " " string
    return $string
}
proc intuitParagraphKind {paragraph} {
    switch -glob -- $paragraph {
	~* {
	    # easier to express in 8.1 as {^((?:~ *){1,3})(.*)}
	    regexp {^(~( *~)?( *~)?) *(.*)$} $paragraph -> \
		    levelmark ? ? content
	    # Count the number of tildes in the level-mark
	    set level [regsub -all ~ $levelmark x levelmark]
	    return [list section [string trim [shortspc $content]] $level]
	}
	|* {
	    set lines {}
	    foreach line [split $paragraph "\n"] {
		if {![string match |* $line]} {
		    variable DEBUG_VERBATIM
		    if {$DEBUG_VERBATIM} {
			return -code error "malformatted verbatim line \"$line\""
		    }
		    lappend lines $line
		} else {
		    lappend lines [string range $line 1 end]
		}
	    }
	    return [list verbatim $lines]
	}
	#index:* {
	    set type [string trim [string range $paragraph 7 end]]
	    if {![string length $type]} {set type medium}
	    return [list index $type]
	}
	#image:* {
	    return [list image [string range $paragraph 7 end]]
	}
	---- {
	    return {separator}
	}
    }

    global ItemNoLeadRE ItemLeadRE ItemContRE

    # Hmm.  Need to figure out if we've got a list item of some kind.
    if {[regexp $ItemNoLeadRE $paragraph]} {
	return [list ordinary [shortspc $paragraph]]
    }
    if {[regexp $ItemLeadRE $paragraph head continuation ? kind]} {
        set content [string range $paragraph [string length $head] end]
        set level [llength $continuation]
        switch -glob -- $kind {
	    *: {
		set kind [string trimright $kind ":"]
		return [list description $kind $level [shortspc $content]]
	    }
	    *. {
		set kind [string trimright $kind "."]
		return [list enumeration $kind $level [shortspc $content]]
	    }
	}
	return [list bulleting $level [shortspc $content]]
    }
    if {[regexp $ItemContRE $paragraph head]} {
	set content [string range $paragraph [string length $head] end]
	return [list continuation [llength $head] [shortspc $content]]
    }
    return [list ordinary [shortspc $paragraph]]
}

array set contentsCache {}
proc getTIPFileContents {filename} {
    global contentsCache
    if {[info exist contentsCache($filename)]} {
	return $contentsCache($filename)
    }
    set f [open $filename r]
    set content [read $f [file size $filename]]
    close $f
    set contentsCache($filename) $content
}
proc readTIPDetailsFromFile {filename} {
    variable DEBUG_VERBATIM
    if {![info exist DEBUG_VERBATIM]} {
	set DEBUG_VERBATIM 0
    }
    set pars [splitIntoParagraphs [getTIPFileContents $filename]]
    foreach {headers title abstract} $pars {break}
    set heads [verifyTIPheader [splitRFC822Header $headers]]
    if {[string compare [intuitParagraphKind $title] {section Abstract 1}]} {
	error "Must start with abstract..."
    }
    lappend heads Abstract [lindex [intuitParagraphKind $abstract] 1]
    lappend heads RawAbstract $abstract
    lappend heads Body [lrange $pars 3 end]
}
array set tipdetails {}
proc getTIPDetails {filename} {
    global tipdetails contentsCache
    if {![info exist tipdetails(time:$filename)]
	|| ([file mtime $filename] > $tipdetails(time:$filename))} {
	set tipdetails(time:$filename) [file mtime $filename]
	catch {unset contentsCache($filename)}
	set tipdetails(file:$filename) [readTIPDetailsFromFile $filename]
    }
    return $tipdetails(file:$filename)
}
proc getTIPFilenames {} {
    global DOCDIR FEATURE TESTINGTIP
    cd $DOCDIR
    set tips [lsort -dictionary [glob *.tip]]
    # Assume the testing TIP (only visible when editing enabled) is at end!
    if {
	!$FEATURE(EDIT) &&
	![string compare [lindex $tips end] ${TESTINGTIP}.tip]
    } then {
	# Don't remove TIP 10000 if editing is enabled.
	set tips [lreplace $tips end end]
    }
    return $tips
}
proc foreachTIP {arrayname script} {
    upvar 1 $arrayname ary
    foreach file [getTIPFilenames] {
	array set ary [getTIPDetails $file]
	uplevel 1 $script
	unset ary
    }
}
proc foreachTIPreverse {arrayname script} {
    upvar 1 $arrayname ary
    set files [getTIPFilenames]
    for {set idx [llength $files]} {[incr idx -1] >= 0} {} {
	array set ary [getTIPDetails [lindex $files $idx]]
	uplevel 1 $script
	unset ary
    }
}

proc convert {in out {type html}} {
    set cwd [pwd]
    set document [formatTIPDocument [getTIPFileContents $in] $type]

    set fout [open [file join $cwd $out] w]
    puts -nonewline $fout $document
    flush $fout
    close $fout
}

proc formatTIPDocument {string {type html} args} {
    global SRCDIR
    set ns tip${type}
    source $SRCDIR/$ns.tcl

    variable DEBUG_VERBATIM
    if {![info exist DEBUG_VERBATIM]} {
	set DEBUG_VERBATIM 0
    }
    set pars  [splitIntoParagraphs $string]
    set heads [verifyTIPheader [splitRFC822Header [lindex $pars 0]]]
    set par1  [intuitParagraphKind [lindex $pars 1]]
    if {[string compare $par1 {section Abstract 1}]} {
	array set h $heads
	return -code error "TIP $h(TIP) must start with abstract..."
    }

    global convert
    set convert {}
    proc ${ns}::puts {args} {
	global convert
	switch [llength $args] {
	    2 {append convert [lindex $args 1]}
	    1 {append convert [lindex $args 0] "\n"}
	}
    }
    if {[llength $args]} {
	${ns}::generateDocument $heads [lrange $pars 1 end] $args
    } else {
	${ns}::generateDocument $heads [lrange $pars 1 end]
    }

    return $convert
}

if {![info exist SRCDIR]} {
    set SRCDIR     [file join [pwd] [file dirname [info script]]]
    source $SRCDIR/config.tcl

    append convertRE {^([0-9]+).} ([join $renderexts |]) {$}
    if {[regexp $convertRE [lindex $argv 0] out id type]} {
	catch {
	    set src [file join $DOCDIR $id.tip]
	    puts -nonewline "converting $src to $out..."
	    flush stdout
	    convert $src $out $type
	    puts " done"
	    exit
	}
	puts $errorInfo
	exit 1
    }
}

# FILE: post.tcl
#
# Routines to process the HTTP POST method, gathering HTML form input
# values from stdin, and storing it in namespace variables post::* .

namespace eval post {
    variable operation edit
    variable email ""
    variable name ""
}

proc post::UrlDecode {str} {
    regsub -all {\+} $str { } str
    regsub -all {[][\\\$]} $str {\\&} str
    regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $str {[format %c 0x\1]} str
    set str [subst $str]
    regsub -all "\r\n" $str "\n" str
    return $str
}

# Local variables in this proc have a leading underscore so they do
# not interfere with the namespace variables.
proc post::getVars {{env env}} {
    upvar #0 $env _e
    upvar #0 URI _URI

    if {![info exists _e(CONTENT_TYPE)]} {
	generr "Bad Request" "the request $_e(REQUEST_METHOD) for URL\
		$_URI did not provide a Content-Type." {} 400
    }
    if {![info exists _e(CONTENT_LENGTH)] 
	    || ![regexp {^[0-9]+$} [string trim $_e(CONTENT_LENGTH)]]} {
	generr "Bad Request" "the request $_e(REQUEST_METHOD) for URL\
		$_URI did not provide a valid Content-Length." {} 411
    }
    if {[string compare application/x-www-form-urlencoded $_e(CONTENT_TYPE)]} {
	generr "Unsupported Request" "the request $_e(REQUEST_METHOD) for URL\
		$_URI provided Content-Type '$_e(CONTENT_TYPE)' instead of \
		'application/x-www-form-urlencoded'." {} 415
    }
    set _query [read stdin $_e(CONTENT_LENGTH)]
    foreach _def [split $_query &] {
	set _pair [split $_def =]
	if {[llength $_pair] != 2} {
	    generr "Bad Request" "the request $_e(REQUEST_METHOD) for URL\
		$_URI provided improperly encoded form data" {} 400
	}
	set _varName [UrlDecode [lindex $_pair 0]]
	if {[string match _* $_varName]} {
	    generr "Forbidden Request" "the request $_e(REQUEST_METHOD) for\
		URL $_URI provided form variables with leading underscores." \
		{} 403
	}
	if {[regexp {[^a-zA-Z0-9_]} $_varName]} {
	    generr "Forbidden Request" "the request $_e(REQUEST_METHOD) for\
		URL $_URI provided form variables containing non-alphanumeric\
		characters." {} 403
	}
	variable $_varName
	set $_varName [UrlDecode [lindex $_pair 1]]
    }

    # Disable multiple calls of this command
    rename [lindex [info level 0] 0] {}
} 

namespace eval tiphtml {
    variable curlev -1
    variable contexts {}
    variable nextrefcounter 0

    proc codechar {c} {
	scan $c %c char
	format %%%02x [expr {$char & 0xff}]
    }
    proc formcode {key args} {
	regsub -all {[^a-zA-Z0-9]} [join $args] {[codechar \\&]} str
	return $key=[subst $str]
    }
    proc nextrefnum {} {
	variable nextrefcounter
	incr nextrefcounter
    }
    proc xformdots {str} {
	regsub -all {[.]} $str " <span class=\"midmail\">dot</span> " str
	return $str
    }
    proc xformmailto {str {tip {}}} {
	global BASEURL
	set url ${BASEURL}mail.html?
	regsub -all {[];${}\\[]} $str {\\&} str
	# Make nameless subst
	regsub -all "href=\"mailto:(\[^@]+)@(\[^\",]+)\"" $str \
		"href=\"$url\[formcode user \\1],\[formcode sys\
		\\2],tipnum=$tip\"" str
	# Make named subst
	regsub -all "href=\"mailto:(\[^@]+)@(\[^\",]+),(\[^\"]+)\"" $str \
		"href=\"$url\[formcode user \\1],\[\
		formcode sys \\2],\[formcode name \\3],tipnum=$tip\"" str
	# Perform substitutions
	subst $str
    }
    proc xformauthor {name email tip {longFmt 0}} {
	set name [string trim $name]
	foreach {user sys} [split $email @] {break}
	set user [xformdots $user]
	set sys [xformdots $sys]
	if {$longFmt} {
	    if {[string length $name]} {
		set link "$name &lt;<a title=\"Click to contact $name by\
			email\" onmouseover=\"window.status='Click to\
			contact $name by email';return true\"\
			href=\"mailto:$email,$name\">${user} <span\
			class=\"midmail\">at</span> ${sys}</a>&gt;"
	    } else {
		set link "<a title=\"Click to contact this author by\
			email\" onmouseover=\"window.status='Click to\
			contact this author by email';return true\"\
			href=\"mailto:$email\">${user} <span\
			class=\"midmail\">at</span> ${sys}</a>"
	    }
	} elseif {[string length $name]} {
	    set link "<a title=\"Click to contact $name by email\"\
		    onmouseover=\"window.status='Click to contact\
		    $name by email';return true\"\
		    href=\"mailto:$email,$name\">$name</a>"
	} else {
	    set link "<a title=\"Click to contact this author by\
		    email\" onmouseover=\"window.status='Click to\
		    contact this author by email';return true\"\
		    href=\"mailto:$email\">$user <span\
		    class=\"midmail\">at</span> $sys</a>"
	}
	return [xformmailto $link $tip]
    }

    proc enterlistcontext {level good bad1 bad2} {
	variable curlev
	variable contexts
	if {$level > $curlev} {
	    incr curlev
	    lappend contexts "</$good>"
	    puts -nonewline "<$good compact>"
	}
	switch [lindex $contexts end] "</$bad1>" - "</$bad2>" {
	    puts -nonewline [lindex $contexts end]
	    puts -nonewline "<$good compact>"
	    set contexts [lreplace $contexts end end "</$good>"]
	}
    }
    proc closecontext {{level -1}} {
	variable curlev
	variable contexts
	while {$level < $curlev} {
	    incr curlev -1
	    puts -nonewline [lindex $contexts end]
	    set contexts [lrange $contexts 0 [expr {[llength $contexts]-2}]]
	}
    }
    proc quoteLiteral {string} {
	# In 8.3 or later, we'd use [string map] for this.  But this
	# code has to work with 8.0 so we're stuck with [regsub -all]
	regsub -all &  $string {\&amp;}  string
	regsub -all <  $string {\&lt;}   string
	regsub -all >  $string {\&gt;}   string
	regsub -all \" $string {\&quot;} string
	regsub -all \xa0 $string {\&nbsp;} string
	return $string
    }

    proc section {title {level 1}} {
	closecontext
	incr level
	puts "<h$level>[quoteLiteral $title]</h$level>"
    }
    proc ordinary {string} {
	continuation -1 $string
    }
    proc bulleting {level body} {
	closecontext $level
	enterlistcontext $level ul ol dl
	puts -nonewline "<li>"
	continuation $level $body
    }
    proc description {tag level body} {
	closecontext $level
	enterlistcontext $level dl ol ul
	puts -nonewline "<dt>$tag</dt><dd>"
	continuation $level $body
    }
    proc enumeration {tag level body} {
	closecontext $level
	enterlistcontext $level ol dl ul
	if {$tag != 1} {
	    puts -nonewline "<li value=\"$tag\">"
	} else {
	    puts -nonewline "<li>"
	}
	continuation $level $body
    }
    proc continuation {level body} {
	global EmailRE URLRE TIPURLRE ShortTIPRE BASEURL ISSUEBASE ISSUEURLRE
	variable thisTIPnumber

	closecontext $level
	regsub -all $EmailRE $body "\x81mailto:\\1\x82" body
	regsub -all $TIPURLRE $body "$BASEURL\\1.html" body
	regsub -all $ISSUEURLRE $body "$ISSUEBASE\\1" body
	set body [quoteLiteral $body]

	#regsub -all {[][\\ $;]} $body {\\&} body
	#regsub -all $URLRE $body "<a href=\"&\">\[addwbr &\]</a>" body
	#set body [subst -novar $body]
	regsub -all {\[\[} $body \x83 body
	regsub -all {\]\]} $body \x84 body
	regsub -all \\\[($URLRE)\\\] $body "\x83<a href=\"\\2\x86\\4\">\x85</a>\x84" body
	regsub -all $URLRE $body "<a href=\"&\">&</a>" body

	regsub -all {'''(('?[^'])+)'''} $body "<b>\x87\\1</b>" body
	regsub -all {''(('?[^'\x87])+)''} $body "<i>\\1</i>" body
	regsub -all $ShortTIPRE $body "<a href=\"\\1.html\">TIP #\\1</a>" body
	regsub -all {\[} $body \x83 body
	regsub -all {\]} $body \x84 body
	#mail address monkeying...
	if {[info exist thisTIPnumber]} {
	    set body [xformmailto $body $thisTIPnumber]
	} else {
	    set body [xformmailto $body]
	}
	regsub -all {>mailto:([^][{};\\$<>@]+)@([^][{};\\$<>@]+)<} $body \
		">\[xformdots \\1\] <span\
		class=\"midmail\">at</span> \[xformdots \\2\]<" body
	regsub -all \x85 $body {[nextrefnum]} body
	regsub -all \x81 [subst -novar -noback $body] "\\&lt;" body
	regsub -all \x82 $body "\\&gt;" body
	regsub -all \x83 $body \[ body
	regsub -all \x84 $body \] body
	regsub -all \x86 $body : body
	regsub -all \x87 $body {} body
	variable curlev
	if {$curlev==-1 && $level==1} {
	    puts "<blockquote><p align=\"justify\">$body</p></blockquote>"
	} else {
	    puts "<p align=\"justify\">$body</p>"
	}
    }
    proc separator {} {
	closecontext
	puts "<hr>"
    }
    proc verbatim {lines} {
	puts "<pre>"
	foreach line $lines {
	    # HTML ignores formfeed chars, but we want to see them...
	    regsub -all {} [quoteLiteral $line] "<b><u>^L</u></b>" line
	    puts $line
	}
	puts -nonewline "</pre>"
    }

    # Helpers to generate 'long' style indices
    proc tr {c1 c2 {size 1}} {
	puts -nonewline "<tr><td align=\"right\" valign=\"top\"><font\
		size=\"$size\">$c1"
	puts "</font></td><td><font size=\"$size\">$c2</font></td></tr>"
    }
    proc longidx {tpat {srch ""} {searchbody 0}} {
	set matched 0
	if {[string match 8.0* [info tclversion]] && [string length $srch]} {
	    regsub -all {[^a-zA-Z0-9]} $srch {\\&} RE
	} else {
	    set RE ***=$srch
	}
	foreachTIP d {
	    # must match type pattern and 
	    if {
		![string match $tpat [string tolower $d(Type)]] ||
		([string length $srch] &&
		 ![regexp $RE "TIP #$d(TIP): $d(Title)"] &&
		 (![info exist d(Keywords)] ||
		  [lsearch -regexp $d(Keywords) $RE] < 0) &&
		 ![regexp $RE $d(Abstract)] &&
		 (!$searchbody || [lsearch -regexp $d(Body) $RE] < 0))
	    } then {
		continue
	    }
	    set matched 1
	    puts "<p><table width=\"99%\"><tr><td valign=\"top\">"

	    puts -nonewline "<a href=\"$d(TIP).html\">"
	    puts "<strong><font size=\"4\">TIP #$d(TIP):\
		    $d(Title)</font></strong>"
	    puts "</a><dl><dt><tt>$d(Version)</tt></dt><dd>"
	    ordinary $d(Abstract)
	    puts "</dd></dl>"

	    puts "</td><td valign=\"top\"><table border><tr><td><table>"
	    set at "Author:"
	    global AuthorRE
	    foreach a $d(Author) {
		regexp "^$AuthorRE" $a -> name mail
		tr $at [xformauthor $name $mail $d(TIP)]
		#tr $at "<a href=\"mailto:$mail\">$name</a>"
		set at ""
	    }
	    tr Type: $d(Type)
	    if {[info exist d(Tcl-Version)]} {
		tr "Tcl Version:" $d(Tcl-Version)
	    }
	    tr State: $d(State)
	    tr Vote: $d(Vote)
	    tr Created: [clock format $d(Created) -format "%d %b %Y" -gmt 1]
	    tr "Posting History:" [join [split $d(Post-History) ","] "<br>"]
	    if {[info exist d(Discussions-To)]} {
		set dtlink {}
		foreach dt [split $d(Discussions-To) ,] {
		    regsub "^(mailto|news):" $dt "" dtnproto
		    lappend dtlink "<a href=\"$dt\">$dtnproto</a>"
		}
		tr "Discussions To:" [join $dtlink "<br>"]
	    }
	    if {[info exist d(Obsoletes)]} {
		tr Obsoletes: "<a title=\"Visit the obsoleted TIP\"\
			href=\"$d(Obsoletes).html\">TIP #$d(Obsoletes)</a>"
	    }
	    if {[info exist d(Obsoleted-By)]} {
		tr "Obsoleted By:" "<a title=\"Visit the obsoleting TIP\"\
			href=\"$d(Obsoleted-By).html\"\
			>TIP #$d(Obsoleted-By)</a>"
	    }
	    if {[info exist d(Vote-By)]} {
		if {$d(Vote-By) > [clock seconds]} {
		    tr Vote: [clock format $d(Vote-By) -gmt 1 \
			    -format "%d %b %Y, %H:%M GMT"]
		} else {
		    tr Vote-By: [clock format $d(Vote-By) -gmt 1 \
			    -format "%d %b %Y, %H:%M GMT (closed)"]
		}
	    }
	    if {[info exist d(Votes-For)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Votes-Against)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Votes-Abstained)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Keywords)]} {
		set kws {}
		set kwl 0
		set comma ""
		foreach k $d(Keywords) {
		    append kws $comma $k
		    incr kwl [string length $k]
		    if {$kwl > 12} {
			set kwl 0
			set comma ",<br>"
		    } else {
			set comma ", "
		    }
		}
		tr Keywords: $kws
	    }
	    puts "</table></td></tr></table></td></tr></table>"
	}
	if {!$matched} {
	    puts "<p align=\"justify\">No existing TIPs matched your\
		    search criteria.</p>"
	}
    }
    proc stest {flagname state} {
	upvar 1 flag flagAry d headers
	expr {$flagAry($flagname) && ![string compare $headers(State) $state]}
    }
    proc longidx2 {locus pat1 pat2 dateLimit daterel order} {
	array set flag {
	    titles 0
	    keywords 0
	    abstracts 0
	    bodies 0
	    authors 0
	    created 0
	    nofinal 0
	    nodraft 0
	    project 0
	    noreject 0
	}
	foreach feature $locus {set flag($feature) 1}
	set matched {}
	if {[string match 8.0* [info tclversion]]} {
	    regsub -all {[^a-zA-Z0-9]} $pat1 {\\&} RE1
	    regsub -all {[^a-zA-Z0-9]} $pat2 {\\&} RE2
	} else {
	    set RE1 ***=$pat1
	    set RE2 ***=$pat2
	}
	if {$flag(created)} {
	    regsub -- (.+)-(.+)-(.+) $dateLimit {\2 \1, \3} dateLimit
	    set dateLimit [clock scan $dateLimit -gmt 1]
	}
	foreachTIP d {
	    # skip some TIPs if requested
	    if {
		[stest nofinal  Final]    || [stest nodraft  Draft]     ||
		[stest noreject Rejected] || [stest noreject Withdrawn] ||
		($flag(project) && [string compare $d(Type) Project])
	    } then {
		continue
	    }
	    # Perform main search
	    if {
		[string length $pat1] &&
		(!$flag(titles) || ![regexp $RE1 "TIP #$d(TIP): $d(Title)"]) &&
		(!$flag(keywords) || [info exist d(Keywords)] && [lsearch -regexp $d(Keywords) $RE1]<0) &&
		(!$flag(abstracts) || ![regexp $RE1 $d(Abstract)]) &&
		(!$flag(bodies) || [lsearch -regexp $d(Body) $RE1]<0)
	    } then {
		continue
	    }
	    # Perform author filtering
	    if {$flag(authors) && [lsearch -regexp $d(Author) $RE2]<0} {
		continue
	    }
	    # Perform date filtering
	    if {$flag(created)} {
		switch -- $daterel {
		    on {
			if {$d(Created) != $dateLimit} {continue}
		    }
		    before {
			if {$d(Created) >= $dateLimit} {continue}
		    }
		    after {
			if {$d(Created) <= $dateLimit} {continue}
		    }
		    default {
			continue
		    }
		}
	    }
	    lappend matched [list $d($order) [array get d]]
	}
	if {[array exists d]} {
	    unset d
	}
	foreach match [lsort -dictionary -index 0 $matched] {
	    array set d [lindex $match 1]
	    puts "<p><table width=\"99%\"><tr><td valign=\"top\">"

	    puts -nonewline "<a href=\"$d(TIP).html\">"
	    puts "<strong><font size=\"4\">TIP #$d(TIP):\
		    $d(Title)</font></strong>"
	    puts "</a><dl><dt><tt>$d(Version)</tt></dt><dd>"
	    ordinary $d(Abstract)
	    puts "</dd></dl>"

	    puts "</td><td valign=\"top\"><table border><tr><td><table>"
	    set at "Author:"
	    global AuthorRE
	    foreach a $d(Author) {
		regexp "^$AuthorRE" $a -> name mail
		tr $at [xformauthor $name $mail $d(TIP)]
		#tr $at "<a href=\"mailto:$mail\">$name</a>"
		set at ""
	    }
	    tr Type: $d(Type)
	    if {[info exist d(Tcl-Version)]} {
		tr "Tcl Version:" $d(Tcl-Version)
	    }
	    tr State: $d(State)
	    tr Vote: $d(Vote)
	    tr Created: [clock format $d(Created) -format "%d %b %Y" -gmt 1]
	    tr "Posting History:" [join [split $d(Post-History) ","] "<br>"]
	    if {[info exist d(Discussions-To)]} {
		set dtlink {}
		foreach dt [split $d(Discussions-To) ,] {
		    regsub "^(mailto|news):" $dt "" dtnproto
		    lappend dtlink "<a href=\"$dt\">$dtnproto</a>"
		}
		tr "Discussions To:" [join $dtlink "<br>"]
	    }
	    if {[info exist d(Obsoletes)]} {
		tr Obsoletes: "<a href=\"$d(Obsoletes).html\"\
			>TIP #$d(Obsoletes)</a>"
	    }
	    if {[info exist d(Obsoleted-By)]} {
		tr "Obsoleted By:" "<a href=\"$d(Obsoleted-By).html\"\
			>TIP #$d(Obsoleted-By)</a>"
	    }
	    if {[info exist d(Vote-By)]} {
		if {$d(Vote-By) > [clock seconds]} {
		    tr Vote: [clock format $d(Vote-By) -gmt 1 \
			    -format "%d %b %Y, %H:%M GMT"]
		} else {
		    tr Vote-By: [clock format $d(Vote-By) -gmt 1 \
			    -format "%d %b %Y, %H:%M GMT (closed)"]
		}
	    }
	    if {[info exist d(Votes-For)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Votes-Against)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Votes-Abstained)]} {
		tr Votes-For: $d(Votes-For)
	    }
	    if {[info exist d(Keywords)]} {
		set kws {}
		set kwl 0
		set comma ""
		foreach k $d(Keywords) {
		    append kws $comma $k
		    incr kwl [string length $k]
		    if {$kwl > 12} {
			set kwl 0
			set comma ",<br>"
		    } else {
			set comma ", "
		    }
		}
		tr Keywords: $kws
	    }
	    puts "</table></td></tr></table></td></tr></table>"
	    unset d
	}
	if {![llength $matched]} {
	    puts "<p align=\"justify\">No existing TIPs matched your\
		    search criteria.</p>"
	}
    }

    # Helpers to generate 'medium' style indices
    proc medcell {size colour style link content {hover ""}} {
	set content [quoteLiteral $content]
	if {[string length $style]} {
	    set content <$style>$content</$style>
	}
	set title ""
	if {[string length $hover]} {
	    set title "title=\"$hover\""
	}
	return "<td valign=\"baseline\"><a href=\"$link\" $title><font\
		color=\"$colour\" size=\"$size\">$content</font></a></td>"
    }
    proc medhdr {link content} {
	puts "<th><a href=\"$link\" title=\"Click to sort by $content\"\
		onmouseover=\"window.status='Click to\
		sort by $content';return true\"><font size=\"2\"\
		color=\"black\">$content</font></a></th>"
    }
    proc getStyle {type vote state} {
	upvar d d split split
	switch -glob -- $type {
	    Info*   {set ty i;set style i}
	    Project {set ty j;set style ""}
	    Process {set ty c;set style b}
	}
	set ty2 $ty
	if {$split} {set style ""}
	switch $vote {
	    "In progress" {
		set bgcol yellow
		append ty2 v
	    }
	    Pending {
		set bgcol white
		append ty2 p
	    }
	    Done - "No voting" {
		set bgcol ""
		append ty2 f
	    }
	}
	switch $state {
	    Draft {
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} elseif {$bgcol != "yellow"} {
		    set col #006000
		} else {
		    set col black
		}
		append ty2 .
	    }
	    Withdrawn - Rejected {
		set bgcol #c0c0c0
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} else {
		    set col #404040
		}
		append ty2 x
	    }
	    Accepted {
		set bgcol #CCCCFF
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} else {
		    set col black
		}
		append ty2 !
	    }
	    Deferred {
		set bgcol #CCFFCC
		set col black
		append ty2 d
	    }
	    Final {
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} else {
		    set col black
		}
		append ty2 F
	    }
	    default {
		if {[info exist d(Obsoleted-By)]} {
		    set col #606060
		} else {
		    set col black
		}
		append ty2 -
	    }
	}
	if {[info exist d(Obsoleted-By)]} {
	    append ty2 o
	}
	list $ty $col $bgcol $style $ty2
    }
    proc medidx {tpat order url} {
	set split [expr \
		{![string compare $order none] && ![string compare $tpat *]}]
	set HR "<tr><td colspan=\"4\"><hr></td></tr>"

	set url [string trimleft $url /]?type=$tpat,sort
	medhdr $url[expr {$order=="0"?"=-":"="}]0 "Series&nbsp;ID"
	medhdr $url[expr {$order=="1"?"=-":"="}]1 "Type"
	medhdr $url[expr {$order=="2"?"=-":"="}]2 "State"
	medhdr $url[expr {$order=="3"?"=-":"="}]3 "Title"
	puts -nonewline "</tr>$HR"
	array set rows {}
	if {[regexp {^-([0-3])} $order -> digit]} {
	    set rev -decreasing
	    set order $digit
	} else {
	    set rev -increasing
	}
	foreachTIP d {
	    if {![string match $tpat [string tolower $d(Type)]]} {
		continue
	    }
	    foreach {ty col bgcol style ty2} \
		    [getStyle $d(Type) $d(Vote) $d(State)] {}

	    set hover ""
	    switch -glob -- $ty2 {
		*v*  {set hover "A vote is in progress on this TIP"}
		j*d* {set hover "This TIP has been deferred"}
		j*!* {set hover "This TIP awaits implementation"}
		j*.* {set hover "This TIP is still in discussion"}
		j*F* {set hover "This TIP is in the core, version $d(Tcl-Version)"}
		*x*  {set hover "This TIP was not adopted by the TCT"}
		*o   {set hover "This TIP is obsolete"}
	    }

	    set cols {}
	    lappend cols $d(TIP) \
		    [medcell 2 $col $style $d(TIP).html TIP\ #$d(TIP) $hover]
	    if {![string compare $d(Type) Project]} {
		lappend cols $d(Type) \
			[medcell 1 $col $style $d(TIP).html \
			$d(Type)\xa0($d(Tcl-Version)) $hover]
	    } else {
		lappend cols $d(Type) \
			[medcell 1 $col $style $d(TIP).html $d(Type) $hover]
	    }
	    lappend cols $d(State) \
		    [medcell 1 $col $style $d(TIP).html $d(State) $hover]
	    lappend cols $d(Title) \
		    [medcell 2 $col $style $d(TIP).html $d(Title) $hover]
	    lappend cols $bgcol {}
	    lappend rows(all) $cols
	    lappend rows($ty) $cols
	}

	if {!$split} {
	    set index 0
	    catch {
		if {$order>=0 && $order<4} {
		    set index [expr {int($order*2)}]
		}
	    }
	    foreach row [lsort -dictionary $rev -index $index $rows(all)] {
		set bgcol [lindex $row 8]
		if {[string length $bgcol]} {
		    puts "<tr bgcolor=\"$bgcol\">"
		} else {
		    puts "<tr>"
		}
		foreach {index col} $row {
		    if {[string length $col]} {
			puts $col
		    }
		}
		puts -nonewline "</tr>"
	    }
	    puts -nonewline $HR
	    return
	}

	set sep ""
	foreach {ty Name} {
	    c "Process TIPs"
	    i "Informational TIPs"
	    j "Project TIPs"
	} {
	    if {![info exist rows($ty)]} {continue}
	    puts "<tr><td colspan=\"4\"><b>$Name</b></td></tr>"
	    foreach row $rows($ty) {
		set bgcol [lindex $row 8]
		if {[string length $bgcol]} {
		    puts "<tr bgcolor=\"$bgcol\">"
		} else {
		    puts "<tr>"
		}
		foreach {index col} $row {
		    if {[string length $col]} {
			puts $col
		    }
		}
		puts -nonewline "</tr>"
	    }
	    puts -nonewline $HR
	}
	puts "<tr><td colspan=\"4\"><table width=\"99%\" border><tr><td\
		align=\"center\">"
	puts "<form method=\"GET\" action=\"search.html\"><p>Search archive\
		for TIPs containing: <input size=\"25\" name=\"search\"><br>\
		<input type=\"submit\" name=\"where\"\
		value=\"Search titles, keywords and abstracts\">&nbsp;<a\
		href=\"advancedsearch.html\">Advanced Search</a></p></form>"
	puts "</td></tr></table></td></tr>"
    }
    variable shortIndexLastAnchor 0
    proc index {kind {errorKind soft} {tpat *}} {
	global AuthorRE
	closecontext
	# Kinds of indices?  short, medium, long, bibtex
	switch -- $kind {
	    short {
		variable shortIndexLastAnchor
		foreachTIPreverse d {
		    if {![string match $tpat [string tolower $d(Type)]]} {
			continue
		    }
		    puts -nonewline "<p><a href=\"$d(TIP).html\" "
		    if {$d(TIP) != 10000 && !$shortIndexLastAnchor} {
			set shortIndexLastAnchor 1
			puts -nonewline "id=\"last\" "
		    }
		    set a [lindex $d(Author) 0]
		    regexp "^$AuthorRE" $a -> name
		    puts "title=\"Author: $name"
		    puts "Type: $d(Type)"
		    puts "State: $d(State)"
		    puts -nonewline "Voting: $d(Vote)\""
		    puts -nonewline "><font size=\"2\">TIP #$d(TIP):"
		    switch -glob -- $d(State),$d(Vote) {
			"*,In progress" {
			    puts -nonewline " <font\
				    color=\"yellow\">Voting</font>"
			}
			"Draft,No voting" {
			    # No special tag
			}
			Accepted,* {
			    puts -nonewline " <font\
				    color=\"#a0a0f0\">Accepted</font>"
			}
			Draft,* {
			    puts -nonewline " <font\
				    color=\"green\">Draft</font>"
			}
			Rejected,* {
			    puts -nonewline " <font\
				    color=\"red\">Rejected</font>"
			}
			Withdrawn,* {
			    puts -nonewline " <font\
				    color=\"red\">Withdrawn</font>"
			}
		    }
		    puts "<br>$d(Title)</font></a></p>"
		}
	    }
	    medium {
		global orderingColumn what
		puts "<blockquote><table width=\"85%\"><tr align=\"left\">"
		medidx $tpat $orderingColumn $what
		puts "</table></blockquote>"
	    }
	    long {
		longidx $tpat
	    }
	    default {
		if {[string compare $errorKind soft]} {
		    return -code error "Index style $kind not supported"
		}
		puts "<p align=\"justify\"><font color=\"red\">Index\
			style \"$kind\" not yet supported!</font></p>"
	    }
	}
    }

    if {![llength [info command ::imwidth::getImageWidth]]} {
	source $SRCDIR/imwidth.tcl
    }
    proc image {bodytext} {
	global ImageRE DOCDIR contenttypes
	closecontext
	set caption {}
	set w 0
	regexp $ImageRE [string trim $bodytext] -> url caption
	if {[regexp {^[-_a-zA-Z0-9]+$} $url]} {
	    foreach {ext type} [array get contenttypes] {
		# Order is random, but shouldn't matter.
		if {
		    [string match image/* $type] && 
		    [file exists [set f [file join $DOCDIR $url$ext]]]
		} then {
		    set w [::imwidth::getImageWidth $f]
		    set url $url$ext
		    break
		}
	    }
	}
	set imgtag [format {img src="%s"} $url]
	if {[string length $caption]} {
	    append imgtag " alt=\"[quoteLiteral $caption]\""
	}
	if {$w > 450} {
	    set imgtag "a href=\"$url\"><$imgtag width=\"85%\"></a"
	} elseif {$w > 0} {
	    append imgtag " width=\"$w\""
	}
	puts "<div align=\"center\"><p><$imgtag></p></div>"
    }

    proc fmtauthor {author tip} {
	global AuthorRE
	regexp "^$AuthorRE$" $author -> name email
	return [xformauthor $name $email $tip 1]
    }

    proc generateTIPHeader {head {revisioninfo {}}} {
	# generate HTML header
	array set h $head
	global BASETARG BASEURL CSSURL ICONURL
	puts "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"\
		\"http://www.w3.org/TR/REC-html40/loose.dtd\">"
	if {[string length $revisioninfo]} {
	    set title "TIP #$h(TIP) Version $revisioninfo: $h(Title)"
	} else {
	    set title "TIP #$h(TIP): $h(Title)"
	}
	puts "<html><head><title>$title</title>"
	puts "<meta http-equiv=\"Content-Type\"\
		content=\"text/html; charset=iso-8859-1\">"
	puts "<meta http-equiv=\"charset\" content=\"iso-8859-1\">"
	puts "<base href=\"$BASEURL\" target=\"$BASETARG\">"
	if {[info exist h(Keywords)]} {
	    set keywords [join $h(Keywords) ", "]
	    puts "<meta name=\"Keywords\" content=\"$keywords\">"
	}
	puts "<link rel=\"stylesheet\" type=\"text/css\"\
		title=\"My standard style\" href=\"$CSSURL\">"
	puts "<link rel=\"SHORTCUT ICON\" href=\"$ICONURL\">"
	puts "</head><body bgcolor=\"#d9d9d9\">"
	if {[string length $revisioninfo]} {
	    puts "<h1>$title</h1><p align=\"justify\"><em>This is not\
		    necessarily the <a href=\"$h(TIP).html\"\
		    onmouseover=\"window.status='View current version';\
		    return true\">current version</a> of this\
		    TIP.</em></p><hr><table>"
	} else {
	    puts "<h1>$title</h1><hr><table>"
	}
	variable thisTIPnumber $h(TIP)
	puts "<tr><td align=\"right\">TIP:</td><td>$h(TIP)</td></tr>"
	puts "<tr><td align=\"right\">Title:</td><td>$h(Title)</td></tr>"
	puts "<tr><td align=\"right\">Version:</td\
		><td><tt>$h(Version)</tt></td></tr>"
	switch [llength $h(Author)] {
	    0 {}
	    1 {
		set a [fmtauthor [lindex $h(Author) 0] $h(TIP)]
		puts "<tr><td align=\"right\">Author:</td><td>$a</td></tr>"
	    }
	    default {
		puts "<tr><td align=\"right\"\
			valign=\"baseline\">Authors:</td><td>"
		foreach a $h(Author) {puts "[fmtauthor $a $h(TIP)]<br>"}
		puts "</td></tr>"
	    }
	}
	foreach tag {State Type Tcl-Version Vote Votes-For Votes-Against Votes-Abstained} {
	    if {[info exist h($tag)] && [string length $h($tag)]} {
		puts "<tr><td\
			align=\"right\">${tag}:</td><td>$h($tag)</td></tr>"
	    }
	}
	set t [clock format $h(Created) -format {%A, %d %B %Y} -gmt 1]
	puts "<tr><td align=\"right\">Created:</td><td>$t</td></tr>"
	if {[info exist h(Vote-By)]} {
	    set t [clock format $h(Vote-By) -gmt 1 \
		    -format {%A, %d %B %Y, %H:%M GMT}]
	    if {$h(Vote-By) > [clock seconds]} {
		puts "<tr><td align=\"right\">Vote-By:</td><td>$t</td></tr>"
	    } else {
		puts "<tr><td align=\"right\">Vote-By:</td><td>$t\
			<i>(Vote Closed)</i></td></tr>"
	    }
	}
	foreach tag {Post-History} {
	    if {[string length $h($tag)]} {
		puts "<tr><td\
			align=\"right\">${tag}:</td><td>$h($tag)</td></tr>"
	    }
	}
	if {
	    [info exist h(Discussions-To)] &&
	    [string length $h(Discussions-To)]
	} {
	    foreach dt [split $h(Discussions-To) ,] {
		set dt [string trim $dt]
		puts -nonewline "<tr><td\
			align=\"right\">Discussions To:</td><td>"
		global URLRE
		if {[regexp ^$URLRE$ $dt]} {
		    puts "<a href=\"$dt\">$dt</a></td></tr>"
		} else {
		    puts "$dt</td></tr>"
		}
	    }
	}
	foreach tag {Obsoletes Obsoleted-By} {
	    if {[info exist h($tag)] && [string length $h($tag)]} {
		puts "<tr><td align=\"right\">${tag}:</td><td><a\
			href=\"$h($tag)\">TIP #$h($tag)</a></td></tr>"
	    }
	}
	if {[info exist h(Keywords)]} {
	    puts "<tr><td align=\"right\" valign=\"baseline\"\
		    >Keywords:</td><td>[join $h(Keywords) {, }]</td></tr>"
	}
	puts "</table><hr>"
    }

    proc clickelem {url mouseover text} {
	upvar elems elems
	regsub -all { } $text {\&nbsp;} text
	lappend elems [format "\[<a href=\"%s\"\
		title=\"%s\" onmouseover=\"window.status='%s';\
		return true\">%s</a>\]" $url $mouseover $mouseover $text]
    }
    proc generateDocument {head body {revision ""}} {
	array set h $head
	generateTIPHeader $head $revision

	# generate HTML body
	foreach par $body {
	    eval [intuitParagraphKind $par]
	}

	# generate HTML footer
	separator
	global FOOTERTEXT FEATURE CVSWEBURL EDITURLBASE
	global TCLLOGOURL TCLLOGOX TCLLOGOY
	if {[string length $revision]} {
	    puts "<p align=\"justify\"><img alt=\"Powered by Tcl\"\
		    src=\"$TCLLOGOURL\" width=\"$TCLLOGOX\"\
		    height=\"$TCLLOGOY\" align=\"right\"><em>This is not\
		    necessarily the <a href=\"$h(TIP).html\"\
		    onmouseover=\"window.status='View current version';\
		    return true\">current version</a> of this\
		    TIP.</em></p><address>$FOOTERTEXT</address></body></html>"
	    return
	}
	set elems {}
	clickelem 1.html "Go to the index page" Index
	if {$FEATURE(CVSWEB)} {
	    clickelem [format $CVSWEBURL $h(TIP)] \
		    "Go to document history" History
	}
	if {($FEATURE(EDIT) || $FEATURE(EDIT_URL_HTML))&& ![notEditable? h]} {
	    clickelem $EDITURLBASE/$h(TIP) "Edit this TIP" Edit
	}
	clickelem $h(TIP).html "Format as HTML" "HTML Format"
	clickelem $h(TIP).tip "View source" "Source Format"
	clickelem $h(TIP).tex "Format as LaTeX" "LaTeX Format"
	clickelem $h(TIP).txt "Format as plain text" "Text Format"
	clickelem $h(TIP).xml "Format as XML" "XML Format"
	clickelem $h(TIP).ms "Format as *roff with -ms macro package" \
		"*roff Format <i>(experimental)</i>"
	clickelem $h(TIP).rtf "Format as rich text" \
		"RTF Format <i>(experimental)</i>"
	puts "<p><img alt=\"Powered by Tcl\" src=\"$TCLLOGOURL\"\
		width=\"$TCLLOGOX\" height=\"$TCLLOGOY\"\
		align=\"right\">[join $elems]</p>"
	puts "<address>$FOOTERTEXT</address></body></html>"
    }
}

namespace eval tipms {
    proc putspar {string} {
	global TIPURLRE BASEURL ShortTIPRE ISSUEBASE ISSUEURLRE
	regsub -all {'''(('?[^'])+)'''} $string "\x82\\fB\\1\\fR" string
	regsub -all {''(('?[^'\x82])+)''} $string "\\fI\\1\\fR" string
	regsub -all $TIPURLRE $string "$BASEURL\\1.html" string
	regsub -all $ISSUEURLRE $string "$ISSUEBASE\\1" string
	regsub -all {\[\[} $string \x80 string
	regsub -all {\]\]} $string \x81 string
	regsub -all $ShortTIPRE $string "\[TIP #\\1\]" string
	regsub -all \x80 $string \[ string
	regsub -all \x81 $string \] string
	regsub -all \x82 $string {} string
	if {[string match .* $string]} {
	    puts "\\$string"
	} else {
	    puts $string
	}
    }

    variable counters {}
    proc manageListCounters {level num} {
	variable counters
	if {
	    [regexp {^1$} $num] &&
	    $level < [llength $counters] &&
	    [lindex $counters $level] != "*"
	} then {
	    set num [lindex $counters $level]
	    incr num
	}
	set counters [lrange [linsert $counters $level $num] 0 $level]
	return [lindex $counters end]
    }
    variable incontext -1

    proc setcontext {{level -1}} {
	variable incontext
	for {} {$incontext > $level} {incr incontext -1} {puts .RE}
	for {} {$incontext < $level} {incr incontext} {puts .RS}
    }
    proc endcount {} {
	variable counters {}
    }

    proc section {title {level 1}} {
	setcontext
	endcount
	puts ".NH $level\n\\fB$title\\fR"
    }
    proc ordinary {string} {
	endcount
	continuation -1 $string
    }
    proc item {tag level body} {
	incr level -1
	setcontext $level
	puts ".IP $tag"
	putspar $body
    }
    proc bulleting {level body} {
	manageListCounters $level *
	set s [lindex {bu sq hy} [expr {$level % 3}]]
	item "\\ \\($s" $level $body
    }
    proc enumeration {tag level body} {
	set tag [manageListCounters $level $tag]
	item "\" ${tag}: \"" $level $body
    }
    proc description {tag level body} {
	manageListCounters $level *
	item "\"$tag \"" $level $body
    }
    proc continuation {level body} {
	variable incontext
	if {$level != -1 && $incontext<0} {
	    puts .QP
	} else {
	    if {$level > 0} {
		setcontext [expr {$level-1}]
	    } else {
		setcontext $level
	    }
	    puts .LP
	}
	putspar $body
    }
    proc separator {} {
	endcount
	setcontext
	puts .Hl
    }
    proc verbatim {lines} {
	puts .LD
	foreach string $lines {
	    regsub -all "\[ \t\]" $string {\\&} string
	    if {[string match .* $string]} {
		puts "\\$string"
	    } else {
		puts $string
	    }
	}
	puts .DE
    }
    proc index {kind {errorKind soft} {tpat *}} {
	endcount
	setcontext
	switch -- $kind {
	    medium {
		puts ".TS H\ncenter;\nlb|lb|lb|lb."
		puts "Series ID\tType\tState\tTitle\n_\n.TH"
		puts ".T&\nl|l|l|lw(3.5i)."
		foreachTIP d {
		    if {[string compare $d(Vote) "In progress"]} {
			set v $d(State)
		    } else {
			set v Voting
		    }
		    set t $d(Type)
		    if {[string match Info* $t]} {set t Info.}
		    puts "TIP #$d(TIP)\t$t\t$v\t\\fI$d(Title)\\fR"
		}
		puts ".TE"
	    }
	    short {
		puts ".CD\n.TS\nc l.\n\\fBSeries ID\\fR\t\\fBTitle\\fR"
		foreachTIP d {
		    puts "TIP #$d(TIP)\t$d(Title)"
		}
		puts ".TE\n.DE"
	    }
	    default {
		if {[string compare $errorKind soft]} {
		    return -code error "Index style $kind not supported"
		}
		set msg "*Index style \"$kind\" not yet supported*"
		regsub -all . $msg * stars
		puts ".CD\n$stars\n$msg\n$stars\n.DE"
	    }
	}
    }
    proc image {bodytext} {
	endcount
	setcontext
	global ImageRE
	puts .CD
	if {
	    [regexp $ImageRE $bodytext -> url caption] &&
	    [regexp {^[-_a-zA-Z0-9]+$} $url]
	} then {
	    global DOCDIR
	    set fn [file join $DOCDIR $url.txt]
	    if {[file isfile $fn] && [file readable $fn]} {
		set f [open $fn r]
		set lines [split [read -nonewline $f] "\n"]
		close $f
		foreach line $lines {
		    puts " $line"
		}
		puts ""
		putspar $caption
	    }
	} elseif {[info exist url] && [info exist caption]} {
	    puts "<URL:$url>"
	    putspar $caption
	} else {
	    puts "<<$bodytext>>"
	}
	puts .DE
    }
    proc generateDocument {head body} {
	array set h $head
	puts {.\" t
.\" Note that this file *must* be preprocessed with tbl before being
.\" passed to *roff.  Fail to do this and things will break...
.de Hl
.br
\l'\\n(.lu-\\n(.iu'
.sp
..}
	puts ".TL\nTIP #$h(TIP): $h(Title)\n"
	puts ".AU\n[join $h(Author) ,\n]"
	puts [clock format $h(Created) -format ".DA \"%d %b %Y\"" -gmt 1]
        switch $h(State) {
	    Accepted - Final - Active {
		puts ".AI\nTcl Core Team"
	    }
	    Draft {
		puts ".AI\n.BX DRAFT"
	    }
	}
	puts .AB
	putspar [lindex [intuitParagraphKind [lindex $body 1]] 1]
	puts .AE
	puts ".TS\nbox;\nlb | lb.\nTIP #$h(TIP):\t$h(Title)"
	puts "_\n.T&\nl | l."
	foreach hdr {
	    Type State Vote Version Tcl-Version Post-History Discussions-To
	    Obsoletes Obsoleted-By Keywords Votes-For Votes-Against
	    Votes-Abstained
	} {
	    if {![info exist h($hdr)]} {continue}
	    puts "${hdr}:\t$h($hdr)"
	}
	if {[info exist h(Vote-By)]} {
	    puts [clock format $h(Vote-By) -gmt 1 \
		    -format "Vote-By:\t%d %b %Y, %H:%M GMT"]
	}
	puts .TE
	puts .1C
	foreach par [lrange $body 2 end] {
	    eval [intuitParagraphKind $par]
	}
	puts ".SH\nColophon\n.LP"
	global FOOTERTEXT
	puts $FOOTERTEXT
    }
}

# TIP to RTF generator v0.1
# No indices nor images supported
# No TIP headers generation
# Juan C. Gil <mailto:[email protected]>
namespace eval tiprtf {
    variable FONT
    array set FONT {SANS 0 SERIF 1 TYPE 2 SYMB 3}

    # The indent amount
    variable indent 426

    # Enumeration counters
    variable counters [list]

    # Generates the RTF header
    proc RTF-documentHeader {tipnum title} {
	puts "\{\\rtf1\\ansi\\ansicpg1252\\deff0\\deflang3082\
		\n{\\fonttbl\n{\\f0\\fswiss\\fcharset0\
		Arial;}\n{\\f1\\froman\\fprq2\\fcharset0 Times New\
		Roman;}\n{\\f2\\fmodern\\fprq1\\fcharset0 Courier\
		New;}\n{\\f3\\fnil\\fcharset2 Symbol;}\n}\
		\n\\viewkind4\\uc1\
		\n\\paperw11907\\paperh16840\\margl1797\\margr1797\n"
	RTF-paragraph SANS 32 200 0 0 "\\b TIP #${tipnum}: $title\\b0"
	separator
    }

    # Generates the RTF header
    proc RTF-documentTrailer {} {
	puts \}
    }

    # Generates a section heading
    proc section {title {level 1}} {
	variable counters [list]
	if {$level > 4} {set level 4}
	set size [lindex {32 24 20 16 14} $level]
	RTF-paragraph SANS $size [expr {int($size*12)}] 0 0 $title
    }

    # Generates an RTF paragraph heading
    # f  = font
    # fs = font size
    # sb = space between paragraphs
    # li = left indent
    # fi = first line indent
    proc RTF-paragraph-heading {f fs sb li fi} {
	variable FONT
	puts [format {\pard\f%s\fs%s\sb%s\li%s\fi%s} \
		$FONT($f) $fs $sb $li $fi]
    }
    # Generates an RTF paragraph with leading and trailing matter
    # All args as above, plus:
    # str = body of the paragraph
    proc RTF-paragraph {f fs sb li fi str} {
	RTF-paragraph-heading $f $fs $sb $li $fi
	puts "$str\\par\n"
    }

    if {[catch {string repeat _ 77}]} {
	proc strrep {str count} {
	    regsub -all " " [format %*s $count ""] $str var
	    set var
	}
    } else {
	interp alias {} [namespace current]::strrep {} string repeat
    }
    # Generates a separator
    proc separator {} {
	variable counters [list]
	RTF-paragraph SERIF 20 0 0 0 [strrep _ 77]
    }

    # Generates a verbatim paragraph
    proc verbatim {lines} {
	variable indent
	set sb 120
	foreach line $lines {
	    RTF-paragraph TYPE 20 $sb $indent 0 $line
	    set sb 0
	}
    }

    # Generates a paragraph
    proc paragraph {body {level 0} {bullet 0} {outdent 0} {usesTabs 0}} {
	variable indent

	# NEED PROCESSING FOR BACKSLASH CHARACTERS AND OTHER ESCAPES!

	# Bold and emphasis
	regsub -all {'''(('?[^'])+)'''} $body "\x81\\b \\1\\b0 " body
	regsub -all {''(('?[^'\x81])+)''} $body "\\i \\1\\i0 " body
	regsub -all \x81 $body "" body

	set li [expr {$level * $indent}]
	if {$outdent} {
	    incr li $indent
	    RTF-paragraph-heading SERIF 20 120 $li -$indent
	} else {
	    RTF-paragraph-heading SERIF 20 120 $li 0
	}
	if {$usesTabs} {
	    set tab $indent
	    foreach i {1 2 3 4 5} {
		puts -nonewline [format {\tx%s} $tab]
		incr tab $indent
	    }
	    puts {}
	}
	if {$bullet} {
	    puts {{\*\pn\pnlvlblt\pnf3\pnindent0{\pntxtb\'B7}}}
	}
	puts "$body\\par\n"
    }

    # Manages the enumeration counters
    proc manage-counters {level number} {
	variable counters
	if {
	    ![string compare $number 1] &&
	    $level < [llength $counters] &&
	    [string compare [lindex $counters $level] *]
	} then {
	    set number [lindex $counters $level]
	    incr number
	}
	set counters [lrange [linsert $counters $level $number] 0 $level]
	return [lindex $counters end]
    }

    # Generates an enumerated item
    proc enumeration {tag level body} {
	paragraph "[manage-counters $level $tag].\\tab $body" $level 0 1 1
    }

    # Generates a description item
    proc description {tag level body} {
	manage-counters $level *
	paragraph "\\b $tag\\b0\\tab $body" $level 0 1 1
    }

    # Generates a bulleted item
    proc bulleting {level body} {
	manage-counters $level *
	paragraph $body $level 1 1
    }

    # Generates a continuation paragraph
    proc continuation {level body} {
	paragraph $body $level
    }

    # Generates an ordinary paragraph
    proc ordinary {body} {
	variable counters [list]
	paragraph $body
    }

    proc index {args} {
	RTF-paragraph SANS 10 120 0 0 "indexes not implemented"
    }
    proc image {args} {
	RTF-paragraph SANS 10 120 0 0 "images not implemented"
    }

    proc RTF-tablerow {part1 part2 {font SERIF}} {
	variable FONT
	RTF-paragraph SERIF 11 0 0 0 "${part1}:\\tab{\\f$FONT($font) $part2}"
    }

    # Generates the RTF document
    proc generateDocument {head body} {
	array set header $head

	# Generate the RTF header
	RTF-documentHeader $header(TIP) $header(Title)

	# Generate the content header table
	puts "\{\\tx1440"
	RTF-tablerow TIP     $header(TIP)
	RTF-tablerow Title   $header(Title)
	RTF-tablerow Version $header(Version) TYPE
	RTF-tablerow Authors [join $header(Author) "\\line\\tab "]
	RTF-tablerow State   $header(State)
	RTF-tablerow Type    $header(Type)
	if {[info exist header(Tcl-Version)]} {
	    RTF-tablerow Tcl-Version $header(Tcl-Version)
	}
	RTF-tablerow Vote    $header(Vote)
	RTF-tablerow Created [clock format $header(Created)]
	if {[info exist header(Keywords)]} {
	    RTF-tablerow Keywords [join $header(Keywords) ", "]
	}
	puts "\}"

	# Loop over paragraphs
	foreach par $body {
	    eval [intuitParagraphKind $par]
	}

	# Generate the content trailer
	global   FOOTERTEXT
	separator
	section  Colophon
	ordinary $FOOTERTEXT

	# Generate the RTF trailer
	RTF-documentTrailer
    }
}

source $SRCDIR/imwidth.tcl
source $SRCDIR/epstopdf.tcl
namespace eval tiptex {
    variable idxnum 0
    variable citations
    array set citations {}
    proc quote {body {dbs 0}} {
	if {$dbs} {
	    regsub -all {\\} $body {\(\backslash\)} body
	    regsub -all {([{}])} $body {\\\1} body
	}
	regsub -all {LaTeX } $body {LaTeX\\ } body
	regsub -all {LaTeX[^a-zA-Z]} $body {\\&} body
	regsub -all <    $body {\tiplangle{}} body
	regsub -all >    $body {\tiprangle{}} body
	regsub -all {\|} $body {\tipbar{}} body
	#regsub -all {[<>|]} $body {\(&\)} body
	regsub -all {\^} $body {\textasciicircum{}} body
	regsub -all {([%&_$#])} $body {\\\1} body
	regsub -all ~ $body {\~{}} body
	regsub -all { - } $body " \x80 " body
	regsub -all {([0-9])--([0-9])} $body "\\1\x81\\2" body
	while {[regsub -- -- $body "-{}-" body]} {}
	regsub -all "\x80" $body --- body
	regsub -all "\x81" $body -- body
	# TeX does not use a standard encoding.  Damn!
	regsub -all "\xa9" $body {(c)} body
	regsub -all "\xe1" $body {\'{a}} body
	regsub -all "\xe9" $body {\'{e}} body
	regsub -all "\xef" $body {\"{\i}} body
	regsub -all "\xf1" $body {\~{n}} body
	regsub -all "\xf3" $body {\'{o}} body
	regsub -all "\xf4" $body {\^{o}} body
	return $body
    }
    proc paragraph {body} {
	global EmailRE URLRE TIPURLRE ShortTIPRE BASEURL ISSUEBASE ISSUEURLRE
	variable mode
	regsub -all $EmailRE $body "\x82\\1\x83" body
	regsub -all $TIPURLRE $body "$BASEURL\\1.tex" body
	regsub -all $ISSUEURLRE $body "$ISSUEBASE\\1" body
	regsub -all {\\} $body {\(\backslash\)} body
	regsub -all {([{}])} $body {\\\1} body
	regsub -all {'''(('?[^'])+)'''} $body "\x89\\textbf{\\1}" body
	regsub -all {''(('?[^'\x89])+)''} $body "\\textit{\\1}" body
	regsub -all \x89 $body {} body
	regsub -all {''+} $body {\(&\)} body
	regsub -all "\"(\[^\"\]+)\"" $body "``\\1''" body

	set txt $body
	set body {}
	while {[regexp -indices $URLRE $txt match]} {
	    foreach {f t} $match {}
	    set pre [string range $txt 0 [expr {$f-1}]]
	    set url [string range $txt $f $t]
	    set post [string range $txt [expr {$t+1}] end]
	    regsub -all ~ $url "\x84" url
	    regsub -all & $url "\x85" url
	    regsub -all _ $url "\x86" url
	    append body $pre "\\url{" $url "}"
	    set txt $post
	}
	append body $txt

	regsub -all {\[\[} $body \x87 body
	regsub -all {\]\]} $body \x88 body
	switch $mode {
	    one {
		regsub -all $ShortTIPRE $body "\\cite{tip\\1}" body
	    }
	    all {
	    	 regsub -all $ShortTIPRE $body \
	    		 "\\hyperlink{tip\\1}{TIP ##\\1}" body
	    }
	    default {
		error "unknown mode \"$mode\""
	    }
	}

	set body [quote $body]
	while {[regsub "(\x82\[^\x82\x83\]*)\\\\_(\[^\x82\x83\]*\x83)" $body \
		{\1_\2} body]} {
	    # Underscores must not be quoted inside a \tipmail command
	}
	regsub -all "\x82(\[^ @\x82\x83]+)@(\[^ @\x82\x83]+)\x83" $body \
		"\\tipmail{\\1}{\\2}" body
	regsub -all "\x84" $body ~   body
	regsub -all "\x85" $body \\& body
	regsub -all "\x86" $body _   body
	regsub -all "\x87" $body \[ body
	regsub -all "\x88" $body \] body
	puts $body
	# now, we need to find the citations made...
	variable citations
	while {[regexp -indices {\\cite{tip([0-9]+)}} $body -> idxpair]} {
	    foreach {x y} $idxpair {}
	    set cite [string range $body $x $y]
	    set body [string range $body $y end]
	    set citations($cite) 1
	}
    }

    variable contexts {}
    proc closecontext {} {
	variable contexts
	foreach c $contexts {
	    puts "\\end{$c}"
	}
	puts ""
	set contexts {}
    }
    proc closetolevel {level} {
	variable contexts
	while {[llength $contexts] > $level} {
	    set c [lindex $contexts 0]
	    set contexts [lrange $contexts 1 end]
	    puts "\\end{$c}"
	}
    }
    proc startcontext {type} {
	variable contexts
	set contexts [linsert $contexts 0 $type]
	puts "\\begin{$type}"
    }
    proc changecontext {type} {
	variable contexts
	set cold [lindex $contexts 0]
	if {[string compare $type $cold]} {
	    puts "\\end{$cold}\n\\begin{$type}"
	    set contexts [lreplace $contexts 0 0 $type]
	}
    }
    proc liststart {level type} {
	closetolevel [incr level]
	variable contexts
	if {[llength $contexts] == $level} {
	    changecontext $type
	} else {
	    startcontext $type
	}
    }

    proc bulleting {level body} {
	liststart $level itemize
	puts "\\item{}"
	paragraph $body
    }
    proc description {tag level body} {
	liststart $level description
	puts "\\item\[[quote $tag 1]\]"
	paragraph $body
    }
    proc enumeration {tag level body} {
	liststart $level enumerate
	if {$tag != 1} {
	    incr tag -1
	    set d 0
	    variable contexts
	    foreach c $contexts {if {![string compare $c enumerate]} {incr d}}
	    switch $d {
		1 {puts "\\setcounter{enumi}{$tag}"}
		2 {puts "\\setcounter{enumii}{$tag}"}
		3 {puts "\\setcounter{enumiii}{$tag}"}
		4 {puts "\\setcounter{enumiv}{$tag}"}
	    }
	}
	puts "\\item{}"
	paragraph $body
    }
    proc continuation {level body} {
	variable contexts
	if {[llength $contexts] == 0 && $level == 1} {
	    puts "\n\\begin{quote}"
	    paragraph $body
	    puts "\\end{quote}"
	    return
	}
	closetolevel $level
	puts ""
	paragraph $body
    }

    proc section {title {level 1}} {
	variable idxnum
	closecontext
	set cmd {}
	for {set i 1} {$i<$level} {incr i} {append cmd sub}
	puts "\\[append cmd section]{[quote $title 1]}"
    }
    proc image {bodytext} {
	global ImageRE DOCDIR BASEURL
	variable idxnum
	regexp $ImageRE [string trim $bodytext] -> url caption
	closecontext
	puts "\\begin{figure}\[htbp\]\\begin{center}\\leavevmode"
	if {
	    [regexp {^[-_a-zA-Z0-9]+$} $url] &&
	    [file exists [set fn [file join $DOCDIR $url.eps]]]
	} then {
	    puts "\\tipimage{$url}{[::imwidth::getImageWidth $fn]pt}"
	} else {
	    puts "\\fbox{\\tiny\\url{$url}}"
	}
	puts "\\caption{[quote $caption 1]}"
	puts "\\end{center}\\end{figure}"
    }
    proc ordinary {body} {
	closecontext
	paragraph $body
    }
    proc separator {} {
	closecontext
	puts "\\vspace{3ex}\\hrule\\vspace{1.5ex}"
    }
    proc verbatim {lines} {
	puts "\\begingroup\\small\\begin{verbatim}"
	foreach line $lines {
	    # Ugh!  LaTeX chokes on formfeed characters in verbatim,
	    # which tend to be common in quoted patches to the core...
	    regsub -all {} $line ^L line
	    puts $line
	}
	puts "\\end{verbatim}\n\\endgroup"
    }
    proc shorten {length string} {
	if {$length+2 >= [string length $string]} {return $string}
	return [string range $string 0 $length].
    }
    proc index {kind {errorKind soft}} {
	closecontext
	switch -- $kind {
	    short {
		foreachTIP d {
		    set num "TIP #$d(TIP):"
		    switch $d(State) {
			Draft - Rejected - Withdrawn {
			    set state "(\\emph{$d(State)})"
			}
			default {set state ""}
		    }
		    puts "[quote $num] $state"
		    paragraph $d(Title)
		    puts ""
		}
	    }
	    medium {
		puts "\\begin{center}\\begin{supertabular}{c|ll|p{2.5in}}"
		puts "\\textbf{TIP ID}&\\textbf{Type}&\\textbf{State}&\
			\\textbf{Title}\\\\\\hline"
		foreachTIP d {
		    puts -nonewline "\\small TIP \\#$d(TIP)&\\small\
			    [shorten 5 $d(Type)]&\\small\
			    [shorten 4 $d(State)]&\\small "
		    paragraph $d(Title)
		    puts -nonewline "\\\\"
		}
		puts "\\end{supertabular}\\end{center}"
	    }
	    long {
		puts "\\begin{center}\\begin{supertabular}{|lp{3.3in}|}\\hline"
		set docsep ""
		foreachTIP d {
		    puts $docsep
		    puts -nonewline "\\textbf{TIP \\#$d(TIP)}:&"
		    puts "\\textbf{[quote $d(Title)]}\\\\"
		    puts "Version:&\\tipversion$d(Version)\\\\"

		    regsub -all "\t" $d(Author) " " authorNotab
		    if {[llength $d(Author)] == 1} {
			puts -nonewline "Author:&"
			paragraph [lindex $authorNotab 0]
			puts "\\\\"
		    } else {
			puts -nonewline "Authors:&"
			paragraph [lindex $authorNotab 0]
			foreach a [lrange $authorNotab 1 end] {
			    puts -nonewline "\\par "
			    paragraph $a
			}
			puts "\\\\"
		    }

		    puts "State:&$d(State)\\\\Type:&$d(Type)\\\\"
		    if {[info exist d(Tcl-Version)]} {
			puts "Tcl Version:&$d(Tcl-Version)\\\\"
		    }
		    puts "Vote:&$d(Vote)\\\\"
		    puts [clock format $d(Created) -gmt 1 \
			    -format "Created:&%d %B %Y\\\\"]
		    puts "Posting History:&"
		    set ph ""
		    foreach event [split $d(Post-History) ","] {
			puts $ph[quote [string trim $event]]
			set ph "\\par "
		    }
		    puts "\\\\"
		    if {[info exist d(Discussions-To)]} {
			regsub -all {,} $d(Discussions-To) {, } dt
			puts "Discussions To:&[quote $dt]\\\\"
		    }
		    if {[info exist d(Obsoletes)]} {
			puts "Obsoletes:&TIP \\#$d(Obsoletes)\\\\"
		    }
		    if {[info exist d(Obsoleted-By)]} {
			puts "Obsoleted By:&TIP \\#$d(Obsoleted-By)\\\\"
		    }
		    if {[info exist d(Vote-By)]} {
			if {$d(Vote-By) > [clock seconds]} {
			    set inf ""
			} else {
			    set inf " (closed)"
			}
			puts [clock format $d(Vote-By) -gmt 1 \
				-format "Vote By:&%d %B %Y, %H:%M GMT$inf\\\\"]
		    }
		    if {[info exist d(Votes-For)]} {
			puts "Votes For:&$d(Votes-For)\\\\"
		    }
		    if {[info exist d(Votes-Against)]} {
			puts "Votes Against:&$d(Votes-Against)\\\\"
		    }
		    if {[info exist d(Votes-Abstained)]} {
			puts "Votes Abstained:&$d(Votes-Abstained)\\\\"
		    }
		    if {[info exist d(Keywords)]} {
			puts "Keywords:&[quote [join $d(Keywords) {, }]]\\\\"
		    }
		    puts "&\\\\Abstract:&"
		    paragraph $d(Abstract)
		    set docsep "\\\\\\hline\\hline"
		}
		puts "\\\\\\hline\\end{supertabular}\\end{center}"
	    }
	    default {
		puts "\\fbox{\\textbf{Index ``$kind'' not yet supported}}"
	    }
	}
    }

    proc generateDocumentHeader {headerArrayName {emptyPage 1} {targ {}}} {
	upvar $headerArrayName h

	puts "\\begin{center}\\begin{tabularx}{\\linewidth}{|r@{: }X|}\\hline"
	if {[string length $targ]} {
	    puts [format {\hypertarget{%s}{\textbf{%s}}&\textbf{%s}\\\hline} \
		    $targ [quote "TIP #$h(TIP)" 1] [quote $h(Title) 1]]
	} else {
	    puts [format "\\textbf{%s}&\\textbf{%s}\\\\\\hline" \
		    [quote "TIP #$h(TIP)" 1] [quote $h(Title) 1]]
	}
	puts [quote Author 1]&
	set sep ""
	foreach a $h(Author) {
	    puts $sep; set sep "\\par"
	    paragraph $a
	}
	puts "\\\\"
	set d [clock format $h(Created) -gmt 1 -format %d]
	switch $d {
	    01 - 21 - 31 { set ord st }
	    02 - 22      { set ord nd }
	    03 - 23      { set ord rd }
	    default      { set ord th }
	}
	set d [string trimleft $d 0]
	puts [clock format $h(Created) -gmt 1 -format \
		"Created&%A, \\(\\text{$d}^{\\text{$ord}}\\) %B %Y\\\\"]
	puts "Type&$h(Type)\\\\"
	if {[info exist h(Tcl-Version)]} {
	    regsub a $h(Tcl-Version) \\alpha h(Tcl-Version)
	    regsub b $h(Tcl-Version) \\beta  h(Tcl-Version)
	    puts "Tcl Version&\\($h(Tcl-Version)\\)\\\\"
	    unset h(Tcl-Version)
	}
	puts "State&$h(State)\\\\"
	puts "Vote&$h(Vote)\\\\"
	puts "Version&\\tipversion$h(Version)\\\\"
	if {[info exist h(Keywords)]} {
	    puts "Keywords&[quote [join $h(Keywords) {, }] 1]\\\\"
	    unset h(Keywords)
	}
	if {[info exist h(Vote-By)]} {
	    if {$h(Vote-By) > [clock seconds]} {
		set inf ""
	    } else {
		set inf " (closed)"
	    }
	    puts [clock format $h(Vote-By) -gmt 1 \
		    -format "Vote By:&%d %B %Y, %H:%M GMT$inf\\\\"]
	    unset h(Vote-By)
	}

	unset h(TIP) h(Title) h(Author) h(Created)
	unset h(Version) h(Type) h(State) h(Vote)
	# Do any fields I've forgotten!
	foreach {key val} [array get h] {
	    regsub -all -- {-} $key { } key
	    puts [format {%s&%s\\} [quote $key 1] [quote $val 1]]
	}
	puts "\\hline\\end{tabularx}\\end{center}"
	if {$emptyPage} {puts "\\thispagestyle{empty}\\pagestyle{empty}"}
    }

    proc generateDocRefs {{reflevel section}} {
	global PUBLISHURL DOCDIR
	variable citations
	if {[array size citations]} {
	    puts "\\begin{thebibliography}{TIP \\#[array size citations]}"
	    puts "\\addcontentsline{toc}{$reflevel}{References}"
	    foreach cite [lsort -dictionary [array names citations]] {
		array set dtl [getTIPDetails [file join $DOCDIR $cite.tip]]
		puts "\\bibitem\[TIP \\#$cite\]{tip$cite}"
		foreach a $dtl(Author) {
		    regsub {<.*} $a {} a
		    puts "[quote [string trim $a] 1],"
		}
		puts "\\emph{[quote $dtl(Title) 1]},"
		puts "on-line at \\url{$PUBLISHURL/$cite.html}"
		unset dtl
	    }
	    puts "\\end{thebibliography}"
	}
    }

    # The static part of the header, used to define things that would
    # otherwise be extremely backslash-heavy.
    variable tipdefs {
	\urlstyle{sf}
	\setlength{\parskip}{1ex}
	\setlength{\parindent}{0pt}
	\def\tipversion$#1${\texttt{\$#1\$}}
	\def\tiplangle#1{\ensuremath{<}}
	\def\tiprangle#1{\ensuremath{>}}
	\def\tipbar#1{\ensuremath{|}}
	\def\tipmail#1#2{\(\langle\){\small\expandafter\url{#1@#2}}\(\rangle\)}
	\ifx\pdfoutput\undefined
	\newcommand{\tipimage}[2]{%
	    \typeout{Make sure you download #1.eps}\ifthenelse{%
	    \lengthtest{0.8\textwidth>#2}\and\lengthtest{0pt<#2}}{%
	    \includegraphics{#1.eps}}{%
	    \includegraphics[width=0.8\textwidth]{#1.eps}}}
	\newcommand{\tipxref}[1]{}
	\newcommand{\tipxrefend}{}
	\else
	\newcommand{\tipimage}[2]{%
	    \typeout{Make sure you create #1.pdf}\ifthenelse{%
	    \lengthtest{0.8\textwidth>#2}\and\lengthtest{0pt<#2}}{%
	    \includegraphics{#1.pdf}}{%
	    \includegraphics[width=0.8\textwidth]{#1.pdf}}}
	\pdfcatalog{/PageMode /UseOutlines}
	\newcommand{\tipxref}[1]{\pdfannotlink %
	    attr {/C [0.5 0.5 1.0] /Border [0 0 1]} %
	    goto name {#1}}
	\newcommand{\tipxrefend}{\pdfendlink}
	\fi
	\newenvironment{tipabstract}{%
	    \begin{abstract}}{\end{abstract}}
    }

    proc generateLaTeXPreamble {title author {date {}} {class article}} {
	global env
	variable tipdefs
	set ltxopts {}
	set ltxpkg {}
	if {[info exist env(LATEXOPTS)]} {
	    set ltxopts [split $env(LATEXOPTS) ,]
	}
	#set ltxopts [linsert $ltxopts 0 dvips]
	if {[info exist env(LATEXPACKAGES)]} {
	    set ltxpkg [split $env(LATEXPACKAGES) ,]
	}
	set ltxpkg [linsert $ltxpkg 0 \
		amsmath graphicx supertabular hyperref tabularx ifthen]
	puts "\\documentclass\[[join $ltxopts ,]\]{$class}"
	puts "\\usepackage{[join $ltxpkg ,]}"
	puts "\\title{[quote $title 1]}"
	if {[string length $date]} {
	    puts "\\date{[quote $date 1]}"
	}
	puts "\\author{[quote $author 1]}"
	regsub -all "\n\[ \t]+" [string trim $tipdefs] "\n" strippedTD
	regsub -all "%\n" $strippedTD {} strippedTD
	puts $strippedTD
	puts "\\begin{document}\\maketitle"
    }

    proc generateDocument {head body} {
	global FOOTERTEXT
	variable mode one
	array set h $head

	set authors {}
	set sep ""
	foreach a $h(Author) {
	    regsub -all "\[ \t\]*<.*" $a "" a
	    append authors "$sep$a"
	    set sep ", "
	}

	generateLaTeXPreamble "TIP #$h(TIP): $h(Title)" $authors \
		[clock format $h(Created) -gmt 1 -format "%B %d, %Y"]

	generateDocumentHeader h
	puts "\\begin{tipabstract}"
	eval [intuitParagraphKind [lindex $body 1]]
	puts "\\end{tipabstract}"

	puts "\\tableofcontents\\setcounter{page}{0}\\clearpage\\pagestyle{plain}"
	foreach par [lrange $body 2 end] {
	    eval [intuitParagraphKind $par]
	}
	section "Colophon"
	ordinary ''$FOOTERTEXT''
	generateDocRefs
	puts "\\end{document}"
    }

    variable imageURLCache
    array set imageURLCache {}
    proc getImageURLs {tipNumber} {
	global DOCDIR
	variable imageURLCache
	if {[info exist imageURLCache($tipNumber)]} {
	    return $imageURLCache($tipNumber)
	}
	set images {}
	if {$tipNumber == "all"} {
	    foreach tip [getTIPFilenames] {
		array set dtl [getTIPDetails $tip]
		foreach par $dtl(Body) {
		    set cmd [intuitParagraphKind $par]
		    if {[lindex $cmd 0] == "image"} {
			lappend images [lindex $cmd 1]
		    }
		}
	    }
	} else {
	    array set dtl [getTIPDetails [file join $DOCDIR $tipNumber.tip]]
	    foreach par $dtl(Body) {
		set cmd [intuitParagraphKind $par]
		if {[lindex $cmd 0] == "image"} {
		    lappend images [lindex $cmd 1]
		}
	    }
	}
	set imageURLCache($tipNumber) $images
    }
    proc linkEPSImagesForDocument {tipNumber targetDir} {
	foreach url [getImageURLs $tipNumber] {
	    if {
		[regexp {^[-_a-zA-Z0-9]+$} $url] &&
		[file exists [set src [file join $DOCDIR $url.eps]]]
	    }
	    if {![file exists [set dst [file join $targetDir $url.eps]]]} {
		exec ln -s $src $dst
	    }
	}
    }
    proc makePDFImagesForDocument {tipNumber targetDir} {
	set urls [getImageURLs $tipNumber]
	linkEPSImagesForDocument $tipNumber $targetDir
	foreach url $urls {
	    if {
		![regexp {^[-_a-zA-Z0-9]+$} $url] ||
		![file exists [set src [file join $targetDir $url.eps]]]
	    } {
		continue
	    }
	    set dst [file join $targetDir $url.pdf]
	    if {[file exists $dst] && [file mtime $dst]>[file mtime $src]} {
		continue
	    }
	    epstopdf::epstopdf $src $dst
	}
    }

    proc generateWholeArchive {} {
	variable mode all
	variable idxnum
	variable citations
	set tips [getTIPFilenames]
	set t1 [file rootname [file tail [lindex $tips 0]]]
	set tn [file rootname [file tail [lindex $tips end]]]
	generateLaTeXPreamble \
		[format {Tcl Improvement Proposals: TIPs %d--%d} $t1 $tn] \
		{The Tcl Community} {} report
	puts "\\renewcommand{\\bibname}{References}"
	puts "\\renewcommand{\\chaptername}{TIP \\#}"
	puts "\\addtocounter{chapter}{-1}"
	puts "\\tableofcontents\\listoffigures"

	foreach tip $tips {
	    ::puts -nonewline stderr \[
	    set pars [splitIntoParagraphs [getTIPFileContents $tip]]
	    array set h [verifyTIPheader \
		    [splitRFC822Header [lindex $pars 0]]]
	    set kinds {}
	    foreach par [lrange $pars 2 end] {
		lappend kinds [intuitParagraphKind $par]
	    }

	    ::puts -nonewline stderr $h(TIP)
	    puts "\\chapter{[quote $h(Title) 1]}"
	    generateDocumentHeader h 0 tip$h(TIP)
	    puts "\\section{Abstract}"
	    eval [lindex $kinds 0]
	    puts "\\clearpage"
	    unset h
	    foreach par [lrange $kinds 1 end] { eval $par }
	    closecontext
	    ::puts -nonewline stderr "\] "
	}
	::puts stderr ""
	if {[array size citations]} {
	    puts "\\clearpage"
	    set idx [incr idxnum]
	    puts "\\ifx\\pdfoutput\\undefined\\relax\\else\\pdfdest\
		    num $idx xyz\\pdfoutline goto num $idx {References}\\fi"
	    generateDocRefs chapter
	}
	puts "\\end{document}"
    }
}

namespace eval tipview {
    proc section {title {level 1}} {
	variable w
	$w insert end $title\n section$level
    }
    proc formattedInsert {string tag} {
	variable w
	regsub -all {'''(('?[^'])+)'''} $string \x81\\1\x81 string
	regsub -all {''(('?[^'])+)''} $string \x80\\1\x80 string
	set idx [$w index end]
	$w insert end $s\n $tag
	while {1} {
	    set idx [$w search -regexp "\x80|\x81" $idx end]
	    if {$idx eq ""} break
	    set c [$w get $idx]
	    set idx2 [$w search -exact $c $idx+1c end]
	    switch [$w get $idx] {
		\x80 {$w tag add ${tag}_i $idx $idx2}
		\x81 {$w tag add ${tag}_b $idx $idx2}
	    }
	    $w delete $idx2
	    $w delete $idx
	}
    }
    proc ordinary {string} {
	formattedInsert $string plain
    }
    proc bulleting {level body} {
	formattedInsert *\t$body list[expr {$level+1}]
    }
    proc description {tag level body} {
	formattedInsert ${tag}:\t$body list[expr {$level+1}]
    }
    proc enumeration {tag level body} {
	formattedInsert $tag.\t$body list[expr {$level+1}]
    }
    proc continuation {level body} {
	formattedInsert $body cont$level
    }
    proc separator {} {
	variable w
	variable sep
	if {![info exist sep]} {
	    set wide [expr {[winfo reqwidth $w]-25}]
	    set sep [::image create photo -width $wide -height 1]
	    $sep put black -to 0 0 $wide 1
	}
	$w image create end -image $sep -padx 5 -pady 5
	$w insert end \n
    }
    proc verbatim {lines} {
	variable w
	$w insert end \n[join $lines \n]\n\n verbatim
    }
    proc index {kind} {
	variable w
	$w insert end "Index $kind not supported by this renderer\n"
    }
    proc image {bodytext} {
	variable w
	if {[regexp {^([^./ ]+) +(.*)} $bodytext -> f caption]} {
	    global DOCDIR
	    set f [file join $DOCDIR $f.gif]
	    if {[file exist $f]} {
		variable img
		if {![info exist img($f)]} {
		    set wide [expr {[winfo reqwidth $w]-25}]
		    set img($f) [::image create photo -file $f]
		    while {[::image width $img($f)] > $wide} {
			set i [::image create photo]
			$i copy $img($f) -subsample 2 2
			::image delete $img($f)
			set img($f) $i
		    }
		}
		$w image create end -image $img($f) -padx 5 -pady 5
		$w insert end \n {} $caption caption \n
		return
	    }
	}
	$w insert end "Image $bodytext not supported by this renderer\n"
    }

    proc generateTIPHeader {hName w} {
	upvar 1 $hName h
	set l $w.top
	set hi [expr {[array size h]-1+[llength $h(Author)]}]
	pack [text $l -height $hi -wrap word -font {Times -14}] \
		-side top -fill x -expand 1
	$l tag configure key -font {Times -14 bold}
	set wide 1
	set font {Times -14 bold}
	foreach n [array names h] {
	    set nw [font measure $font ${n}:]
	    if {$nw>$wide} {set wide $nw}
	}
	incr wide 4
	$l configure -tabs $wide
	$l tag configure head -lmargin1 0 -lmargin2 $wide
	array set done {TIP . Title . Author . Created .}
	$l insert end TIP: {head key} \t$h(TIP)\n head
	$l insert end Title: {head key} \t$h(Title)\n head
	$l insert end Created: {head key} [clock format $h(Created) -gmt 1 \
		-format "\t%A %d %B %Y\n"] head
	$l insert end Authors: {head key} "\t[join $h(Author) \n\t]\n" head
	foreach n [lsort [array names h]] {
	    if {[info exist done($n)]} {continue}
	    $l insert end ${n}: {head key} \t$h($n)\n head
	}
	$l delete end-1c
	$l configure -state disabled
    }
    proc viewTIP {tipnumber} {
	global DOCDIR
	set file  [file join $DOCDIR $tipnumber.tip]
	set data  [getTIPFileContents $file]
	set pars  [splitIntoParagraphs $data]
	set heads [verifyTIPheader [splitRFC822Header [lindex $pars 0]]]
	set par1  [intuitParagraphKind [lindex $pars 1]]
	array set h $heads
	if {[string compare $par1 {section Abstract 1}]} {
	    return -code error "TIP $h(TIP) must start with abstract..."
	}

	set t .t$h(TIP)
	catch {destroy $t}
	toplevel $t
	wm title $t "TIP #$h(TIP): $h(Title)"
	wm iconname $t "TIP #$h(TIP)"

	generateTIPHeader h $t

	variable w $t.bot
	pack [text $w -wrap word] \
		-side top -fill both -expand 1

	$w tag configure section1 -font {Helvetica -18 bold} \
		-lmargin1 1m -rmargin 1m -spacing1 1m -spacing3 1m
	$w tag configure section2 -font {Helvetica -14 bold} \
		-lmargin1 1m -rmargin 1m -spacing1 1m -spacing3 1m
	$w tag configure section3 -font {Helvetica -12 bold} \
		-lmargin1 1m -rmargin 1m -spacing1 1m -spacing3 1m
	$w tag configure verbatim -font {Courier 10}
	$w tag configure plain -font {Times 10} \
		-lmargin1 2m -lmargin2 2m -rmargin 2m -spacing3 1m
	$w tag configure plain_i -font {Times 10 italic}
	$w tag configure plain_b -font {Times 10 bold}
	for {set i 1} {$i<5} {incr i} {
	    $w tag configure list$i -font {Times 10} \
		    -lmargin1 [expr {$i*4+1}]m -lmargin2 [expr {$i*4+5}]m \
		    -rmargin 2m -spacing3 1m -tabs 5m
	    $w tag configure list${i}_i -font {Times 10 italic}
	    $w tag configure list${i}_b -font {Times 10 bold}
	    $w tag configure cont$i -font {Times 10} \
		    -lmargin1 [expr {$i*4+5}]m -lmargin2 [expr {$i*4+5}]m \
		    -rmargin 2m -spacing3 1m
	    $w tag configure cont${i}_i -font {Times 10 italic}
	    $w tag configure cont${i}_b -font {Times 10 bold}
	}

	# generate HTML body
	foreach par [lrange $pars 1 end] {
	    eval [intuitParagraphKind $par]
	}
    }
}

if {![string compare [file join [pwd] $::argv0] [file join [pwd] [info script]]]} {
    # test mode!
    set SRCDIR [file dirname [file join [pwd] [info script]]]
    source $SRCDIR/config.tcl
    source $SRCDIR/parse.tcl

    package require Tk
    pack [listbox .l -width 5 -yscroll {.s set}] \
	    [scrollbar .s -orient vertical -command {.l yview}] \
	    -side left -expand 1 -fill both
    foreachTIP t {
	.l insert end $t(TIP)
    }
    bind .l <Double-1> {tipview::viewTIP [.l get @%x,%y]}
}

namespace eval tiptxt {
    proc fmtPar {firsthead nexthead body} {
	puts ""
	set str ""
	set body "$firsthead $body"
	# Apply standard transformations here...
	global URLRE TIPURLRE ShortTIPRE BASEURL ISSUEBASE ISSUEURLRE
	regsub -all $TIPURLRE   $body "$BASEURL\\1.txt" body
	regsub -all $ISSUEURLRE $body "$ISSUEBASE\\1" body
	regsub -all $URLRE      $body "<URL:&>" body
	regsub -all {\[\[}      $body \x80 body
	regsub -all {\]\]}      $body \x81 body
	regsub -all $ShortTIPRE $body "\[TIP #\\1\]" body
	regsub -all '''		$body {*} body
	regsub -all ''          $body {/} body
	regsub -all \x80        $body \[ body
	regsub -all \x81        $body \] body
	foreach word [split $body] {
	    if {[string length $str$word] > 72} {
		puts $str
		set str "$nexthead "
	    }
	    append str $word " "
	}
	puts $str
    }

    variable counters {}
    proc manageListCounters {level num} {
	variable counters
	if {
	    [regexp {^1$} $num] &&
	    $level < [llength $counters] &&
	    [lindex $counters $level] != "*"
	} then {
	    set num [lindex $counters $level]
	    incr num
	}
	set counters [lrange [linsert $counters $level $num] 0 $level]
	return [lindex $counters end]
    }
    proc setupIndents {level {msg ""}} {
	format "%*s" [expr {$level>=0?($level+1)*7-1:0}] $msg
    }

    proc bulleting {level body} {
	manageListCounters $level *
	set ind [setupIndents $level]
	regsub {.$} $ind * ind1
	fmtPar $ind1 $ind $body
    }
    proc description {tag level body} {
	set tag " ${tag}:"
	set body [string trim $body]
	manageListCounters $level *
	set ind1 [setupIndents [expr {$level-1}]]
	set ind [setupIndents $level]
	set tagspace [expr {[string length $ind]-[string length $ind1]}]
	if {$tagspace*2 < [string length $tag]} {
	    puts -nonewline \n$ind1$tag
	    fmtPar $ind $ind $body
	} elseif {$tagspace < [string length $tag]} {
	    fmtPar $ind1$tag $ind $body
	} else {
	    fmtPar [format %s%-*s $ind1 $tagspace $tag] $ind $body
	}
    }
    proc enumeration {tag level body} {
	set indt [setupIndents $level [manageListCounters $level $tag].]
	set inds [setupIndents $level]
	fmtPar $indt $inds $body
    }
    proc continuation {level string} {
	set indent [setupIndents [expr {$level-1}]]
	fmtPar $indent $indent $string
    }
    proc ordinary {string} {
	variable counters {}
	continuation -1 $string
    }

    proc section {title {level 1}} {
	variable counters {}
	switch $level {
	    1 {
		regsub -all . $title = uline
		puts "\n [string toupper $title] \n=$uline="
	    }
	    2 {
		regsub -all . $title - uline
		puts "\n [string toupper $title] \n-$uline-"
	    }
	    3 {
		puts "\n [string toupper $title] "
	    }
	    default {
		regsub -all " " $title _ title
		puts "\n_$title_"
	    }
	}
    }
    proc separator {} {
	variable counters {}
	puts -nonewline "\n------------------------------"
	puts "-------------------------------------------"
    }
    proc verbatim {lines} {
	# It's actually quite awkward, since we have to convert tabs to spaces
	puts ""
	foreach line $lines {
	    set bits [split $line \t]
	    set txt [lindex $bits 0]
	    foreach bit [lrange $bits 1 end] {
		append txt " "
		while {[string length $txt] % 8} {append txt " "}
		append txt $bit
	    }
	    puts "   $txt"
	}
    }
    proc centre {lines} {
	puts ""
	set untabbed {}
	set width 0
	foreach line $lines {
	    set bits [split $line \t]
	    set txt [lindex $bits 0]
	    foreach bit [lrange $bits 1 end] {
		append txt " "
		while {[string length $txt] % 8} {append txt " "}
		append txt $bit
	    }
	    lappend untabbed $txt
	    if {[string length $txt]>$width} {set width [string length $txt]}
	}
	if {$width >= 70} {
	    foreach line $untabbed {
		puts $line
	    }
	} else {
	    set ind [expr {(72-$width)/2}]
	    foreach line $untabbed {
		puts [format %*s%s $ind "" $line]
	    }
	}
    }
    proc image {bodytext} {
	variable counters {}
	global ImageRE
	if {
	    [regexp $ImageRE $bodytext -> url caption] &&
	    [regexp {^[-_a-zA-Z0-9]+$} $url]
	} then {
	    global DOCDIR
	    set fn [file join $DOCDIR $url.txt]
	    if {[file isfile $fn] && [file readable $fn]} {
		set f [open $fn r]
		set lines [split [read -nonewline $f] "\n"]
		close $f
		centre $lines
		centre [list $caption]
		return
	    }
	} elseif {[info exist url] && [info exist caption]} {
	    centre [list "<URL:$url>" ]
	    centre [list $caption]
	} else {
	    centre [list "<<$bodytext>>"]
	}
    }
    proc index {kind {errorKind soft}} {
	variable counters {}
	switch $kind {
	    short {
		puts ""
		foreachTIP d {
		    puts -nonewline " TIP #$d(TIP):"
		    switch $d(State) {
			Draft - Rejected {
			    puts -nonewline " ([string index $d(State) 0])"
			}
			default {
			    puts -nonewline "    "
			}
		    }
		    puts " $d(Title)"
		}
	    }
	    medium {
		array set w {1 9 2 4 3 5 4 5}
		foreachTIP d {
		    foreach {name col i} {
			TIP   1 5
			Type  2 0
			State 3 0
			Title 4 0
		    } {
			if {[string length $d($name)] > $w($col)+$i} {
			    set w($col) [expr {[string length $d($name)]+$i}]
			}
		    }
		}
		puts ""
		set format "| %-$w(1)s | %-$w(2)s | %-$w(3)s | %-$w(4)s |"
		set sep [format $format " " " " " " " "]
		regsub -all " " $sep - sep
		regsub -all "\[|\]" $sep + sep
		puts $sep
		puts [format $format "Series ID" "Type" "State" "Title"]
		puts $sep
		foreachTIP d {
		    puts [format $format "TIP #$d(TIP)" \
			    $d(Type) $d(State) $d(Title)]
		}
		puts $sep
	    }
	    long {
		foreachTIP d {
		    puts ""
		    set rows {}
		    lappend rows "TIP #$d(TIP):" $d(Title)
		    lappend rows Version: $d(Version)
		    regsub -all "\t" $d(Author) " " authorNotab
		    if {[llength $d(Author)] == 1} {
			regsub @ [lindex $authorNotab 0] _at_ a
			lappend rows Author: $a
		    } else {
			regsub @ [lindex $authorNotab 0] _at_ a
			lappend rows Authors: $a
			foreach a [lrange $authorNotab 1 end] {
			    regsub @ $a _at_ a
			    lappend rows "" $a
			}
		    }
		    lappend rows  State: $d(State)  Type: $d(Type)
		    if {[info exist d(Tcl-Version)]} {
			lappend rows "Tcl Version:" $d(Tcl-Version)
		    }
		    lappend rows  Vote: $d(Vote)
		    lappend rows  Created: [clock format $d(Created) \
			    -format "%d %b %Y" -gmt 1]
		    set ph "Posting History:"
		    foreach event [split $d(Post-History) ","] {
			lappend rows $ph [string trim $event]
			set ph ""
		    }
		    if {[info exist d(Discussions-To)]} {
			set dt [join [split $d(Discussions-To) ,] ", "]
			regsub -all -- { +} $dt { } dt
			lappend rows "Discussions To:" $dt
		    }
		    if {[info exist d(Obsoletes)]} {
			lappend rows Obsoletes: "TIP #$d(Obsoletes)"
		    }
		    if {[info exist d(Obsoleted-By)]} {
			lappend rows "Obsoleted By:" "TIP #$d(Obsoleted-By)"
		    }
		    if {[info exist d(Vote-By)]} {
			if {$d(Vote-By) > [clock seconds]} {
			    lappend rows  Vote-By: [clock format $d(Vote-By) \
				    -format "%d %b %Y, %H:%M GMT" -gmt 1]
			} else {
			    lappend rows  Vote-By: [clock format $d(Vote-By) \
				    -format "%d %b %Y, %H:%M GMT (closed)" \
				    -gmt 1]
			}
		    }
		    if {[info exist d(Votes-For)]} {
			lappend rows "Votes For:" $d(Votes-For)
		    }
		    if {[info exist d(Votes-Against)]} {
			lappend rows "Votes Against:" $d(Votes-Against)
		    }
		    if {[info exist d(Votes-Abstained)]} {
			lappend rows "Votes Abstained:" $d(Votes-Abstained)
		    }
		    if {[info exist d(Keywords)]} {
			lappend rows Keywords: [join $d(Keywords) ", "]
		    }
		    set width 1
		    foreach {tag ?} $rows {
			if {[string length $tag]>$width} {
			    set width [string length $tag]
			}
		    }
		    foreach {tag val} $rows {
			puts [format "%-*s %s" $width $tag $val]
		    }
		    set indent [format "%*s" $width ""]
		    fmtPar $indent $indent $d(Abstract)
		}
	    }
	    default {
		if {[string compare $errorKind soft]} {
		    return -code error "Index style $kind not supported"
		}
		set msg "*Index style \"$kind\" bit yet supported*"
		regsub -all . $msg * stars
		centre [list $stars $msg $stars]
	    }
	}
    }

    proc generateDocument {head body {extra {}}} {
	global BASEURL
	array set header $head
	section "TIP #$header(TIP): $header(Title)"
	set lines [list Version: $header(Version)]
	set indent 8
	if {[info exist header(Author)]} {
	    set at Author:
	    foreach a $header(Author) {
		regsub @ $a _at_ a
		lappend lines $at $a
		set at ""
	    }
	}
	foreach h {State Type Tcl-Version Vote} {
	    if {[info exist header($h)]} {
		lappend lines ${h}: $header($h)
		if {[string length $h]+1>$indent} {
		    set indent [expr {[string length $h]+1}]
		}
	    }
	}
	lappend lines Created: [clock format $header(Created) \
		-format {%A, %d %B %Y} -gmt 1]
	if {[string compare [lindex $extra 0] URL]} {
	    lappend lines URL: $BASEURL$header(TIP).html
	}
	foreach {key value} $extra {lappend lines ${key}: $value}
	if {[info exist header(Discussions-To)]} {
	    set h Discussions-To:
	    foreach dt [split $header(Discussions-To) ","] {
		lappend lines $h [string trim $dt]
		if {[string length $h]>$indent} {
		    set indent [string length $h]
		}
		set h ""
	    }
	}
	if {[info exist header(Post-History)]} {
	    lappend lines Post-History: $header(Post-History)
	    if {[string length Post-History]+1>$indent} {
		set indent [expr {[string length Post-History]+1}]
	    }
	}
	foreach h {Obsoletes Obsoleted-By} {
	    if {[info exist header($h)]} {
		lappend lines ${h}: "TIP #$header($h)"
		if {[string length $h]+1>$indent} {
		    set indent [expr {[string length $h]+1}]
		}
	    }
	}
	if {[info exist header(Vote-By)]} {
	    lappend lines Vote-By: [clock format $header(Vote-By) -gmt 1 \
		    -format {%A, %d %B %Y, %H:%M GMT}]
	}
	foreach h {Votes-For Votes-Against Votes-Abstained} {
	    if {[info exist header($h)]} {
		lappend lines ${h}: $header($h)
		if {[string length $h]+1>$indent} {
		    set indent [expr {[string length $h]+1}]
		}
	    }
	}
	foreach {key value} $lines {
	    regsub -all "\t" $value " " value
	    puts [format " %-*s %s" $indent $key $value]
	}
	separator
	foreach par $body {
	    eval [intuitParagraphKind $par]
	}
	separator
	global FOOTERTEXT
	ordinary $FOOTERTEXT
    }
}