#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec tclsh8.4 "$0" ${1+"$@"}

package require Tcl 8.4

# Convert Ousterhout format man pages into highly crosslinked
# hypertext.
#
# Along the way detect many unmatched font changes and other odd
# things.
#
# Note well, this program is a hack rather than a piece of software
# engineering.  In that sense it's probably a good example of things
# that a scripting language, like Tcl, can do well.  It is offered as
# an example of how someone might convert a specific set of man pages
# into hypertext, not as a general solution to the problem.  If you
# try to use this, you'll be very much on your own.
#
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
# 
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# 
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
# Revisions:
#  May 15, 1995 - initial release
#  May 16, 1995 - added a back to home link to toplevel table of
#	contents.
#  May 18, 1995 - broke toplevel table of contents into separate
#	pages for each section, and broke long table of contents
#	into a one page for each man page.
#  Mar 10, 1996 - updated for tcl7.5b3/tk4.1b3
#  Apr 14, 1996 - incorporated command line parsing from Tom Tromey,
#		  <tromey@creche.cygnus.com> -- thanks Tom.
#		- updated for tcl7.5/tk4.1 final release.
#		- converted to same copyright as the man pages.
#  Sep 14, 1996 - made various modifications for tcl7.6b1/tk4.2b1
#  Oct 18, 1996 - added tcl7.6/tk4.2 to the list of distributions.
#  Oct 22, 1996 - major hacking on indentation code and elsewhere.
#  Mar  4, 1997 - 
#  May 28, 1997 - added tcl8.0b1/tk8.0b1 to the list of distributions
#		- cleaned source for tclsh8.0 execution
#		- renamed output files for windoze installation
#		- added spaces to tables
#  Oct 24, 1997 - moved from 8.0b1 to 8.0 release
#

set Version "0.32"

proc parse_command_line {} {
    global argv Version

    # These variables determine where the man pages come from and where
    # the converted pages go to.
    global tcltkdir tkdir tcldir webdir build_tcl build_tk

    # Set defaults based on original code.
    set tcltkdir ../..
    set tkdir {}
    set tcldir {}
    set webdir ../html
    set build_tcl 0
    set build_tk 0
    # Default search version is a glob pattern
    set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}

    # Handle arguments a la GNU:
    #   --version
    #   --useversion=<version>
    #   --help
    #   --srcdir=/path
    #   --htmldir=/path

    foreach option $argv {
	switch -glob -- $option {
	    --version {
		puts "tcltk-man-html $Version"
		exit 0
	    }

	    --help {
		puts "usage: tcltk-man-html \[OPTION\] ...\n"
		puts "  --help              print this help, then exit"
		puts "  --version           print version number, then exit"
		puts "  --srcdir=DIR        find tcl and tk source below DIR"
		puts "  --htmldir=DIR       put generated HTML in DIR"
		puts "  --tcl               build tcl help"
		puts "  --tk                build tk help"
		puts "  --useversion        version of tcl/tk to search for"
		exit 0
	    }

	    --srcdir=* {
		# length of "--srcdir=" is 9.
		set tcltkdir [string range $option 9 end]
	    }

	    --htmldir=* {
		# length of "--htmldir=" is 10
		set webdir [string range $option 10 end]
	    }

	    --useversion=* {
		# length of "--useversion=" is 13
		set useversion [string range $option 13 end]
	    }

	    --tcl {
		set build_tcl 1
	    }

	    --tk {
		set build_tk 1
	    }

	    default {
		puts stderr "tcltk-man-html: unrecognized option -- `$option'"
		exit 1
	    }
	}
    }

    if {!$build_tcl && !$build_tk} {set build_tcl 1; set build_tk 1}

    if {$build_tcl} {
	# Find Tcl.
	set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
				       -directory $tcltkdir tcl$useversion]] end]
	if {$tcldir == ""} then {
	    puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
	    exit 1
	}
	puts "using Tcl source directory $tcldir"
    }

    if {$build_tk} {
	# Find Tk.
	set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
				      -directory $tcltkdir tk$useversion]] end]
	if {$tkdir == ""} then {
	    puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
	    exit 1
	}
	puts "using Tk source directory $tkdir"
    }

    # the title for the man pages overall
    global overall_title
    set overall_title ""
    if {$build_tcl} {append overall_title "[capitalize $tcldir]"}
    if {$build_tcl && $build_tk} {append overall_title "/"}
    if {$build_tk} {append overall_title "[capitalize $tkdir]"}
    append overall_title " Manual"
}

proc capitalize {string} {
    return [string toupper $string 0]
}

##
##
##
set manual(report-level) 1

proc manerror {msg} {
    global manual
    set name {}
    set subj {}
    if {[info exists manual(name)]} {
	set name $manual(name)
    }
    if {[info exists manual(section)] && [string length $manual(section)]} {
	puts stderr "$name: $manual(section):  $msg"
    } else {
	puts stderr "$name: $msg"
    }
}

proc manreport {level msg} {
    global manual
    if {$level < $manual(report-level)} {
	manerror $msg
    }
}

proc fatal {msg} {
    global manual
    manerror $msg
    exit 1
}
##
## parsing
##
proc unquote arg {
    return [string map [list \" {}] $arg]
}

proc parse-directive {line codename restname} {
    upvar $codename code $restname rest
    return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]
}

proc process-text {text} {
    global manual
    # preprocess text
    set text [string map [list \
	    {\&}	"\t" \
	    {&}		{&amp;} \
	    {\\}	{&#92;} \
	    {\e}	{&#92;} \
	    {\ }	{&nbsp;} \
	    {\|}	{&nbsp;} \
	    {\0}	{ } \
	    {\%}	{} \
	    "\\\n"	"\n" \
	    \"		{&quot;} \
	    {<}		{&lt;} \
	    {>}		{&gt;} \
	    {\(+-}	{&#177;} \
	    {\fP}	{\fR} \
	    {\.}	. \
	    {\(bu}	{&#8226;} \
	    ] $text]
    regsub -all {\\o'o\^'} $text {\&ocirc;} text; # o-circumflex in re_syntax.n
    regsub -all {\\-\\\|\\-} $text -- text;	# two hyphens
    regsub -all -- {\\-\\\^\\-} $text -- text;	# two hyphens
    regsub -all {\\-} $text - text;		# a hyphen
    regsub -all "\\\\\n" $text "\\&#92;\n" text; # backslashed newline
    while {[string first "\\" $text] >= 0} {
	# C R
	if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \
		{\1<TT>\2</TT>\3} text]} continue
	# B R
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
		{\1<B>\2</B>\3} text]} continue
	# B I
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
		{\1<B>\2</B>\\fI\3} text]} continue
	# I R
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
		{\1<I>\2</I>\3} text]} continue
	# I B
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
		{\1<I>\2</I>\\fB\3} text]} continue
	# B B, I I, R R
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
		{\1\\fB\2\3} ntext]
	    || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \
		    {\1\\fI\2\3} ntext]
	    || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \
		    {\1\\fR\2\3} ntext]} {
	    manerror "process-text: impotent font change: $text"
	    set text $ntext
	    continue
	}
	# unrecognized
	manerror "process-text: uncaught backslash: $text"
	set text [string map [list "\\" "#92;"] $text]
    }
    return $text
}
##
## pass 2 text input and matching
##
proc open-text {} {
    global manual
    set manual(text-length) [llength $manual(text)]
    set manual(text-pointer) 0
}
proc more-text {} {
    global manual
    return [expr {$manual(text-pointer) < $manual(text-length)}]
}
proc next-text {} {
    global manual
    if {[more-text]} {
	set text [lindex $manual(text) $manual(text-pointer)]
	incr manual(text-pointer)
	return $text
    }
    manerror "read past end of text"
    error "fatal"
}
proc is-a-directive {line} {
    return [string match .* $line]
}
proc split-directive {line opname restname} {
    upvar $opname op $restname rest
    set op [string range $line 0 2]
    set rest [string trim [string range $line 3 end]]
}
proc next-op-is {op restname} {
    global manual
    upvar $restname rest
    if {[more-text]} {
	set text [lindex $manual(text) $manual(text-pointer)]
	if {[string equal -length 3 $text $op]} {
	    set rest [string range $text 4 end]
	    incr manual(text-pointer)
	    return 1
	}
    }
    return 0
}
proc backup-text {n} {
    global manual
    if {$manual(text-pointer)-$n >= 0} {
	incr manual(text-pointer) -$n
    }
}
proc match-text args {
    global manual
    set nargs [llength $args]
    if {$manual(text-pointer) + $nargs > $manual(text-length)} {
	return 0
    }
    set nback 0
    foreach arg $args {
	if {![more-text]} {
	    backup-text $nback
	    return 0
	}
	set arg [string trim $arg]
	set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
	if {[string equal $arg $targ]} {
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	if {[regexp {^@(\w+)$} $arg all name]} {
	    upvar $name var
	    set var $targ
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\
		&& [string equal $op [lindex $targ 0]]} {
	    upvar $name var
	    set var [lrange $targ 1 end]
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	backup-text $nback
	return 0
    }
    return 1
}
proc expand-next-text {n} {
    global manual
    return [join [lrange $manual(text) $manual(text-pointer) \
	    [expr {$manual(text-pointer)+$n-1}]] \n\n]
}
##
## pass 2 output
##
proc man-puts {text} {
    global manual
    lappend manual(output-$manual(wing-file)-$manual(name)) $text
}

##
## build hypertext links to tables of contents
##
proc long-toc {text} {
    global manual
    set here M[incr manual(section-toc-n)]
    set there L[incr manual(long-toc-n)]
    lappend manual(section-toc) \
	    "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
    return "<A NAME=\"$here\">$text</A>"
}
proc option-toc {name class switch} {
    global manual
    if {[string equal $manual(section) "WIDGET-SPECIFIC OPTIONS"]} {
	# link the defined option into the long table of contents
	set link [long-toc "$switch, $name, $class"]
	regsub -- "$switch, $name, $class" $link "$switch" link
	return $link
    } elseif {[string equal $manual(name):$manual(section) \
	    "options:DESCRIPTION"]} {
	# link the defined standard option to the long table of
	# contents and make a target for the standard option references
	# from other man pages.
	set first [lindex $switch 0]
	set here M$first
	set there L[incr manual(long-toc-n)]
	set manual(standard-option-$first) "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>"
	lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
	return "<A NAME=\"$here\">$switch</A>"
    } else {
	error "option-toc in $manual(name) section $manual(section)"
    }
}
proc std-option-toc {name} {
    global manual
    if {[info exists manual(standard-option-$name)]} {
	lappend manual(section-toc) <DD>$manual(standard-option-$name)
	return $manual(standard-option-$name)
    }
    set here M[incr manual(section-toc-n)]
    set there L[incr manual(long-toc-n)]
    set other M$name
    lappend manual(section-toc) "<DD><A HREF=\"options.htm#$other\">$name</A>"
    return "<A HREF=\"options.htm#$other\">$name</A>"
}
##
## process the widget option section
## in widget and options man pages
##
proc output-widget-options {rest} {
    global manual
    man-puts <DL>
    lappend manual(section-toc) <DL>
    backup-text 1
    set para {}
    while {[next-op-is .OP rest]} {
	switch -exact [llength $rest] {
	    3 { foreach {switch name class} $rest { break } }
	    5 {
		set switch [lrange $rest 0 2]
		set name [lindex $rest 3]
		set class [lindex $rest 4]
	    }
	    default {
		fatal "bad .OP $rest"
	    }
	}
	if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch all oswitch switch cswitch]} {
	    if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} {
		error "not Switch: $switch"
	    } else {
		set switch "$switch1$cswitch or $oswitch$switch2"
	    }
	}
	if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} {
	    error "not Name: $name"
	}
	if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} {
	    error "not Class: $class"
	}
	man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
	man-puts "<DT>Database Name: $oname$name$cname"
	man-puts "<DT>Database Class: $oclass$class$cclass"
	man-puts <DD>[next-text]
	set para <P>
    }
    man-puts </DL>
    lappend manual(section-toc) </DL>
}

##
## process .RS lists
##
proc output-RS-list {} {
    global manual
    if {[next-op-is .IP rest]} {
	output-IP-list .RS .IP $rest
	if {[match-text .RE .sp .RS @rest .IP @rest2]} {
	    man-puts <P>$rest
	    output-IP-list .RS .IP $rest2
	}
	if {[match-text .RE .sp .RS @rest .RE]} {
	    man-puts <P>$rest
	    return
	}
	if {[next-op-is .RE rest]} {
	    return
	}
    }
    man-puts <DL><DD>
    while {[more-text]} {
	set line [next-text]
	if {[is-a-directive $line]} {
	    split-directive $line code rest
	    switch -exact $code {
		.RE {
		    break
		}
		.SH - .SS {
		    manerror "unbalanced .RS at section end"
		    backup-text 1
		    break
		}
		default {
		    output-directive $line
		}
	    }
	} else {
	    man-puts $line
	}
    }	
    man-puts </DL>
}

##
## process .IP lists which may be plain indents,
## numeric lists, or definition lists
##
proc output-IP-list {context code rest} {
    global manual
    if {![string length $rest]} {
	# blank label, plain indent, no contents entry
	man-puts <DL><DD>
	while {[more-text]} {
	    set line [next-text]
	    if {[is-a-directive $line]} {
		split-directive $line code rest
		if {[string equal $code ".IP"] && [string equal $rest {}]} {
		    man-puts "<P>"
		    continue
		}
		if {[lsearch {.br .DS .RS} $code] >= 0} {
		    output-directive $line
		} else {
		    backup-text 1
		    break
		}
	    } else {
		man-puts $line
	    }
	}
	man-puts </DL>
    } else {
	# labelled list, make contents
	if {
	    [string compare $context ".SH"] &&
	    [string compare $context ".SS"]
	} then {
	    man-puts <P>
	}
	man-puts <DL>
	lappend manual(section-toc) <DL>
	backup-text 1
	set accept_RE 0
	set para {}
	while {[more-text]} {
	    set line [next-text]
	    if {[is-a-directive $line]} {
		split-directive $line code rest
		switch -exact $code {
		    .IP {
			if {$accept_RE} {
			    output-IP-list .IP $code $rest
			    continue
			}
			if {[string equal $manual(section) "ARGUMENTS"] || \
				[regexp {^\[\d+\]$} $rest]} {
			    man-puts "$para<DT>$rest<DD>"
			} elseif {[string equal {&#8226;} $rest]} {
			   man-puts "$para<DT><DD>$rest&nbsp;"
			} else {
			    man-puts "$para<DT>[long-toc $rest]<DD>"
			}
			if {[string equal $manual(name):$manual(section) \
				"selection:DESCRIPTION"]} {
			    if {[match-text .RE @rest .RS .RS]} {
				man-puts <DT>[long-toc $rest]<DD>
			    }
			}
		    }
		    .sp -
		    .br -
		    .DS -
		    .CS {
			output-directive $line
		    }
		    .RS {
			if {[match-text .RS]} {
			    output-directive $line
			    incr accept_RE 1
			} elseif {[match-text .CS]} {
			    output-directive .CS
			    incr accept_RE 1
			} elseif {[match-text .PP]} {
			    output-directive .PP
			    incr accept_RE 1
			} elseif {[match-text .DS]} {
			    output-directive .DS
			    incr accept_RE 1
			} else {
			    output-directive $line
			}
		    }
		    .PP {
			if {[match-text @rest1 .br @rest2 .RS]} {
			    # yet another nroff kludge as above
			    man-puts "$para<DT>[long-toc $rest1]"
			    man-puts "<DT>[long-toc $rest2]<DD>"
			    incr accept_RE 1
			} elseif {[match-text @rest .RE]} {
			    # gad, this is getting ridiculous
			    if {!$accept_RE} {
				man-puts "</DL><P>$rest<DL>"
				backup-text 1
				set para {}
				break
			    } else {
				man-puts "<P>$rest"
				incr accept_RE -1
			    }
			} elseif {$accept_RE} {
			    output-directive $line
			} else {
			    backup-text 1
			    break
			}
		    }
		    .RE {
			if {!$accept_RE} {
			    backup-text 1
			    break
			}
			incr accept_RE -1
		    }
		    default {
			backup-text 1
			break
		    }
		}
	    } else {
		man-puts $line
	    }
	    set para <P>
	}
	man-puts "$para</DL>"
	lappend manual(section-toc) </DL>
	if {$accept_RE} {
	    manerror "missing .RE in output-IP-list"
	}
    }
}
##
## handle the NAME section lines
## there's only one line in the NAME section,
## consisting of a comma separated list of names,
## followed by a hyphen and a short description.
##
proc output-name {line} {
    global manual
    # split name line into pieces
    regexp {^([^-]+) - (.*)$} $line all head tail
    # output line to manual page untouched
    man-puts $line
    # output line to long table of contents
    lappend manual(section-toc) <DL><DD>$line</DL>
    # separate out the names for future reference
    foreach name [split $head ,] {
	set name [string trim $name]
	if {[llength $name] > 1} {
	    manerror "name has a space: {$name}\nfrom: $line"
	}
	lappend manual(wing-toc) $name
	lappend manual(name-$name) $manual(wing-file)/$manual(name)
    }
}
##
## build a cross-reference link if appropriate
##
proc cross-reference {ref} {
    global manual
    if {[string match Tcl_* $ref]} {
	set lref $ref
    } elseif {[string match Tk_* $ref]} {
	set lref $ref
    } elseif {[string equal $ref "Tcl"]} {
	set lref $ref
    } else {
	set lref [string tolower $ref]
    }
    ##
    ## nothing to reference
    ##
    if {![info exists manual(name-$lref)]} {
	foreach name {array file history info interp string trace
	after clipboard grab image option pack place selection tk tkwait update winfo wm} {
	    if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
		    [info exists manual(name-$name)] && \
		    [string compare $manual(tail) "$name.n"]} {
		return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
	    }
	}
	if {[lsearch {stdin stdout stderr end} $lref] >= 0} {
	    # no good place to send these
	    # tcl tokens?
	    # also end
	}
	return $ref
    }
    ##
    ## would be a self reference
    ##
    foreach name $manual(name-$lref) {
	if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} {
	    return $ref
	}
    }
    ##
    ## multiple choices for reference
    ##
    if {[llength $manual(name-$lref)] > 1} {
	set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]
	set tcl_ref [lindex $manual(name-$lref) $tcl_i]
	set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
	set tk_ref [lindex $manual(name-$lref) $tk_i]
	if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} \
		||  "$manual(wing-file)" == {TclLib}} {
	    return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
	}
	if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} \
		|| "$manual(wing-file)" == {TkLib}} {
	    return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
	}
	if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} {
	    return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
	}
	puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"
	return $ref
    }
    ##
    ## exceptions, sigh, to the rule
    ##
    switch $manual(tail) {
	canvas.n {
	    if {$lref == {focus}} {
		upvar tail tail
		set clue [string first command $tail]
		if {$clue < 0 ||  $clue > 5} {
		    return $ref
		}
	    }
	    if {[lsearch {bitmap image text} $lref] >= 0} {
		return $ref
	    }
	}
	checkbutton.n -
	radiobutton.n {
	    if {[lsearch {image} $lref] >= 0} {
		return $ref
	    }
	}
	menu.n {
	    if {[lsearch {checkbutton radiobutton} $lref] >= 0} {
		return $ref
	    }
	}
	options.n {
	    if {[lsearch {bitmap image set} $lref] >= 0} {
		return $ref
	    }
	}
	regexp.n {
	    if {[lsearch {string} $lref] >= 0} {
		return $ref
	    }
	}
	source.n {
	    if {[lsearch {text} $lref] >= 0} {
		return $ref
	    }
	}
	history.n {
	    if {[lsearch {exec} $lref] >= 0} {
		return $ref
	    }
	}
	return.n {
	    if {[lsearch {error continue break} $lref] >= 0} {
		return $ref
	    }
	}
	scrollbar.n {
	    if {[lsearch {set} $lref] >= 0} {
		return $ref
	    }
	}
    }
    ##
    ## return the cross reference
    ##
    return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"
}
##
## reference generation errors
##
proc reference-error {msg text} {
    global manual
    puts stderr "$manual(tail): $msg: {$text}"
    return $text
}
##
## insert as many cross references into this text string as are appropriate
##
proc insert-cross-references {text} {
    global manual
    ##
    ## we identify cross references by:
    ##     ``quotation''
    ##    <B>emboldening</B>
    ##    Tcl_ prefix
    ##    Tk_ prefix
    ##	  [a-zA-Z0-9]+ manual entry
    ## and we avoid messing with already anchored text
    ##
    ##
    ## find where each item lives
    ##
    array set offset [list \
	    anchor [string first {<A } $text] \
	    end-anchor [string first {</A>} $text] \
	    quote [string first {``} $text] \
	    end-quote [string first {''} $text] \
	    bold [string first {<B>} $text] \
	    end-bold [string first {</B>} $text] \
	    tcl [string first {Tcl_} $text] \
	    tk [string first {Tk_} $text] \
	    Tcl1 [string first {Tcl manual entry} $text] \
	    Tcl2 [string first {Tcl overview manual entry} $text] \
	    ]
    ##
    ## accumulate a list
    ##
    foreach name [array names offset] {
	if {$offset($name) >= 0} {
	    set invert($offset($name)) $name
	    lappend offsets $offset($name)
	}
    }
    ##
    ## if nothing, then we're done.
    ##
    if {![info exists offsets]} {
	return $text
    }
    ##
    ## sort the offsets
    ##
    set offsets [lsort -integer $offsets]
    ##
    ## see which we want to use
    ##
    switch -exact $invert([lindex $offsets 0]) {
	anchor {
	    if {$offset(end-anchor) < 0} {
		return [reference-error {Missing end anchor} $text]
	    }
	    set head [string range $text 0 $offset(end-anchor)]
	    set tail [string range $text [expr {$offset(end-anchor)+1}] end]
	    return $head[insert-cross-references $tail]
	}
	quote {
	    if {$offset(end-quote) < 0} {
		return [reference-error "Missing end quote" $text]
	    }
	    if {$invert([lindex $offsets 1]) == "tk"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    if {$invert([lindex $offsets 1]) == "tcl"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    switch -exact $invert([lindex $offsets 1]) {
		end-quote {
		    set head [string range $text 0 [expr {$offset(quote)-1}]]
		    set body [string range $text [expr {$offset(quote)+2}] \
			    [expr {$offset(end-quote)-1}]]
		    set tail [string range $text \
			    [expr {$offset(end-quote)+2}] end]
		    return "$head``[cross-reference $body]''[insert-cross-references $tail]"
		}
		bold -
		anchor {
		    set head [string range $text \
			    0 [expr {$offset(end-quote)+1}]]
		    set tail [string range $text \
			    [expr {$offset(end-quote)+2}] end]
		    return "$head[insert-cross-references $tail]"
		}
	    }
	    return [reference-error "Uncaught quote case" $text]
	}
	bold {
	    if {$offset(end-bold) < 0} { return $text }
	    if {$invert([lindex $offsets 1]) == "tk"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    if {$invert([lindex $offsets 1]) == "tcl"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    switch -exact $invert([lindex $offsets 1]) {
		end-bold {
		    set head [string range $text 0 [expr {$offset(bold)-1}]]
		    set body [string range $text [expr {$offset(bold)+3}] \
			    [expr {$offset(end-bold)-1}]]
		    set tail [string range $text \
			    [expr {$offset(end-bold)+4}] end]
		    return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]"
		}
		anchor {
		    set head [string range $text \
			    0 [expr {$offset(end-bold)+3}]]
		    set tail [string range $text \
			    [expr {$offset(end-bold)+4}] end]
		    return "$head[insert-cross-references $tail]"
		}
	    }
	    return [reference-error "Uncaught bold case" $text]
	}
	tk {
	    set head [string range $text 0 [expr {$offset(tk)-1}]]
	    set tail [string range $text $offset(tk) end]
	    if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} {
		return [reference-error "Tk regexp failed" $text]
	    }
	    return $head[cross-reference $body][insert-cross-references $tail]
	}
	tcl {
	    set head [string range $text 0 [expr {$offset(tcl)-1}]]
	    set tail [string range $text $offset(tcl) end]
	    if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} {
		return [reference-error {Tcl regexp failed} $text]
	    }
	    return $head[cross-reference $body][insert-cross-references $tail]
	}
	Tcl1 -
	Tcl2 {
	    set off [lindex $offsets 0]
	    set head [string range $text 0 [expr {$off-1}]]
	    set body Tcl
	    set tail [string range $text [expr {$off+3}] end]
	    return $head[cross-reference $body][insert-cross-references $tail]
	}
	end-anchor -
	end-bold -
	end-quote {
	    return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
	}
    }
}
##
## process formatting directives
##
proc output-directive {line} {
    global manual
    # process format directive
    split-directive $line code rest
    switch -exact $code {
	.BS -
	.BE {
	    # man-puts <HR>
	}
	.SH - .SS {
	    # drain any open lists
	    # announce the subject
	    set manual(section) $rest
	    # start our own stack of stuff
	    set manual($manual(name)-$manual(section)) {}
	    lappend manual(has-$manual(section)) $manual(name)
	    if {[string compare .SS $code]} {
		man-puts "<H3>[long-toc $manual(section)]</H3>"
	    } else {
		man-puts "<H4>[long-toc $manual(section)]</H4>"
	    }
	    # some sections can simply free wheel their way through the text
	    # some sections can be processed in their own loops
	    switch -exact $manual(section) {
		NAME {
		    if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} {
			# these manual pages have two NAME sections
			if {[info exists manual($manual(tail)-NAME)]} {
			    return
			}
			set manual($manual(tail)-NAME) 1
		    }
		    set names {}
		    while {1} {
			set line [next-text]
			if {[is-a-directive $line]} {
			    backup-text 1
			    output-name [join $names { }]
			    return
			} else {
			    lappend names [string trim $line]
			}
		    }
		}
		SYNOPSIS {
		    lappend manual(section-toc) <DL>
		    while {1} {
			if {[next-op-is .nf rest]
			 || [next-op-is .br rest]
			 || [next-op-is .fi rest]} {
			    continue
			}
			if {[next-op-is .SH rest]
		         || [next-op-is .SS rest]
		         || [next-op-is .BE rest]
			 || [next-op-is .SO rest]} {
			    backup-text 1
			    break
			}
			if {[next-op-is .sp rest]} {
			    #man-puts <P>
			    continue
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "in SYNOPSIS found $more"
			    backup-text 1
			    break
			} else {
			    foreach more [split $more \n] {
				man-puts $more<BR>
				if {[lsearch {TclLib TkLib} $manual(wing-file)] < 0} {
				    lappend manual(section-toc) <DD>$more
				}
			    }
			}
		    }
		    lappend manual(section-toc) </DL>
		    return
		}
		{SEE ALSO} {
		    while {[more-text]} {
			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
			    backup-text 1
			    return
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "$more"
			    backup-text 1
			    return
			}
			set nmore {}
			foreach cr [split $more ,] {
			    set cr [string trim $cr]
			    if {![regexp {^<B>.*</B>$} $cr]} {
				set cr <B>$cr</B>
			    }
			    if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
				set cr <B>$name</B>
			    }
			    lappend nmore $cr
			}
			man-puts [join $nmore {, }]
		    }
		    return
		}
		KEYWORDS {
		    while {[more-text]} {
			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
			    backup-text 1
			    return
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "$more"
			    backup-text 1
			    return
			}
			set keys {}
			foreach key [split $more ,] {
			    set key [string trim $key]
			    lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm]
			    set initial [string toupper [string index $key 0]]
			    lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
			}
			man-puts [join $keys {, }]
		    }
		    return
		}
	    }
	    if {[next-op-is .IP rest]} {
		output-IP-list $code .IP $rest
		return
	    }
	    if {[next-op-is .PP rest]} {
		return
	    }
	    return
	}
	.SO {
	    if {[match-text @stuff .SE]} {
		output-directive {.SH STANDARD OPTIONS}
		set opts {}
		foreach line [split $stuff \n] {
		    foreach option [split $line \t] {
			lappend opts $option
		    }
		}
		man-puts <DL>
		lappend manual(section-toc) <DL>
		foreach option [lsort $opts] {
		    man-puts "<DT><B>[std-option-toc $option]</B>"
		}
		man-puts </DL>
		lappend manual(section-toc) </DL>
	    } else {
		manerror "unexpected .SO format:\n[expand-next-text 2]"
	    }
	}
	.OP {
	    output-widget-options $rest
	    return
	}
	.IP {
	    output-IP-list .IP .IP $rest
	    return
	}
	.PP {
	    man-puts <P>
	}
	.RS {
	    output-RS-list
	    return
	}
	.RE {
	    manerror "unexpected .RE"
	    return
	}
	.br {
	    man-puts <BR>
	    return
	}
	.DE {
	    manerror "unexpected .DE"
	    return
	}
	.DS {
	    if {[next-op-is .ta rest]} {
		
	    }
	    if {[match-text @stuff .DE]} {
		man-puts <PRE>$stuff</PRE>
	    } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} {
		man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>"
	    } else {
		manerror "unexpected .DS format:\n[expand-next-text 2]"
	    }
	    return
	}
	.CS {
	    if {[next-op-is .ta rest]} {
		
	    }
	    if {[match-text @stuff .CE]} {
		man-puts <PRE>$stuff</PRE>
	    } else {
		manerror "unexpected .CS format:\n[expand-next-text 2]"
	    }
	    return
	}
	.CE {
	    manerror "unexpected .CE"
	    return
	}
	.sp {
	    man-puts <P>
	}
	.ta {
	    # these are tab stop settings for short tables
	    switch -exact $manual(name):$manual(section) {
		{bind:MODIFIERS} -
		{bind:EVENT TYPES} -
		{bind:BINDING SCRIPTS AND SUBSTITUTIONS} -
		{expr:OPERANDS} -
		{expr:MATH FUNCTIONS} -
		{history:DESCRIPTION} -
		{history:HISTORY REVISION} -
		{switch:DESCRIPTION} -
		{upvar:DESCRIPTION} {
		    return;			# fix.me
		}
		default {
		    manerror "ignoring $line"
		}
	    }
	}
	.nf {
	    if {[match-text @more .fi]} {
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
	    } elseif {[match-text .RS @more .RE .fi]} {
		man-puts <DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts </DL>
	    } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} {
		man-puts <DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts <DL><DD>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		}
		man-puts </DL></DL>
	    } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} {
		man-puts <DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts <DL><DD>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		}
		man-puts </DL><DD>
		foreach more3 [split $more3 \n] {
		    man-puts $more3<BR>
		}
		man-puts </DL>
	    } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} {
		man-puts <P><DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts <DL><DD>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		}
		man-puts </DL></DL><P>
	    } elseif {[match-text .RS .sp @more .sp .RE .fi]} {
		man-puts <P><DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts </DL><P>
	    } else {
		manerror "ignoring $line"
	    }
	}
	.fi {
	    manerror "ignoring $line"
	}
	.na -
	.ad -
	.UL -
	.ne {
	    manerror "ignoring $line"
	}
	default {
	    manerror "unrecognized format directive: $line"
	}
    }
}
##
## merge copyright listings
## 
proc merge-copyrights {l1 l2} {
    foreach copyright [concat $l1 $l2] {
	if {[regexp {^Copyright +\(c\) +(\d+) +(by +)?(\w.*)$} $copyright all date by who]} {
	    lappend dates($who) $date
	    continue
	}
	if {[regexp {^Copyright +\(c\) +(\d+)-(\d+) +(by +)?(\w.*)$} $copyright all from to by who]} {
	    for {set date $from} {$date <= $to} {incr date} {
		lappend dates($who) $date
	    }
	    continue
	}
	if {[regexp {^Copyright +\(c\) +(\d+), *(\d+) +(by +)?(\w.*)$} $copyright all date1 date2 by who]} {
	    lappend dates($who) $date1 $date2
	    continue
	}
	puts "oops: $copyright"
    }
    foreach who [array names dates] {
	set list [lsort $dates($who)]
	if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} {
	    lappend merge "Copyright (c) [lindex $list 0] $who"
	} else {
	    lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who"
	}
    }
    return [lsort $merge]
}

proc makedirhier {dir} {
    if {![file isdirectory $dir] && \
	    [catch {file mkdir $dir} error]} {
	return -code error "cannot create directory $dir: $error"
    }
}

##
## foreach of the man directories specified by args
## convert manpages into hypertext in the directory
## specified by html.
##
proc make-man-pages {html args} {
    global env manual overall_title tcltkdesc
    makedirhier $html
    set manual(short-toc-n) 1
    set manual(short-toc-fp) [open $html/contents.htm w]
    puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>"
    puts $manual(short-toc-fp) "<BODY><HR><H3>$overall_title</H3><HR><DL>"
    set manual(merge-copyrights) {}
    foreach arg $args {
	if {$arg == ""} {continue}
	set manual(wing-glob) [lindex $arg 0]
	set manual(wing-name) [lindex $arg 1]
	set manual(wing-file) [lindex $arg 2]
	set manual(wing-description) [lindex $arg 3]
	set manual(wing-copyrights) {}
	makedirhier $html/$manual(wing-file)
	set manual(wing-toc-fp) [open $html/$manual(wing-file)/contents.htm w]
	# whistle
	puts stderr "scanning section $manual(wing-name)"
	# put the entry for this section into the short table of contents
	puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/contents.htm\">$manual(wing-name)</A><DD>$manual(wing-description)"
	# initialize the wing table of contents
	puts $manual(wing-toc-fp) "<HTML><HEAD><TITLE>$manual(wing-name) Manual</TITLE></HEAD>"
	puts $manual(wing-toc-fp) "<BODY><HR><H3>$manual(wing-name)</H3><HR>"
	# initialize the short table of contents for this section
	set manual(wing-toc) {}
	# initialize the man directory for this section
	makedirhier $html/$manual(wing-file)
	# initialize the long table of contents for this section
	set manual(long-toc-n) 1
	# get the manual pages for this section
	set manual(pages) [lsort [glob $manual(wing-glob)]]
	if {[lsearch -glob $manual(pages) */options.n] >= 0} {
	    set n [lsearch $manual(pages) */options.n]
	    set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
	}
	# set manual(pages) [lrange $manual(pages) 0 5]
	foreach manual(page) $manual(pages) {
	    # whistle
	    puts stderr "scanning page $manual(page)"
	    set manual(tail) [file tail $manual(page)]
	    set manual(name) [file root $manual(tail)]
	    set manual(section) {}
	    if {[lsearch {case pack-old menubar} $manual(name)] >= 0} {
		# obsolete
		manerror "discarding $manual(name)"
		continue
	    }
	    set manual(infp) [open $manual(page)]
	    set manual(text) {}
	    set manual(partial-text) {}
	    foreach p {.RS .DS .CS .SO} {
		set manual($p) 0
	    }
	    set manual(stack) {}
	    set manual(section) {}
	    set manual(section-toc) {}
	    set manual(section-toc-n) 1
	    set manual(copyrights) {}
	    lappend manual(all-pages) $manual(wing-file)/$manual(tail)
	    manreport 100 $manual(name)
	    while {[gets $manual(infp) line] >= 0} {
		manreport 100 $line
		if {[regexp {^[`'][/\\]} $line]} {
		    if {[regexp {Copyright \(c\).*$} $line copyright]} {
			lappend manual(copyrights) $copyright
		    }
		    # comment
		    continue
		}
		if {"$line" == {'}} {
		    # comment
		    continue
		}
		if {[parse-directive $line code rest]} {
		    switch -exact $code {
			.ad - .na - .so - .ne - .AS - .VE - .VS -
			. {
			    # ignore
			    continue
			}
		    }
		    if {"$manual(partial-text)" != {}} {
			lappend manual(text) [process-text $manual(partial-text)]
			set manual(partial-text) {}
		    }
		    switch -exact $code {
			.SH - .SS {
			    if {[llength $rest] == 0} {
				gets $manual(infp) rest
			    }
			    lappend manual(text) "$code [unquote $rest]"
			}
			.TH {
			    lappend manual(text) "$code [unquote $rest]"
			}
			.HS - .UL -
			.ta {
			    lappend manual(text) "$code [unquote $rest]"
			}
			.BS - .BE - .br - .fi - .sp -
			.nf {
			    if {"$rest" != {}} {
				manerror "unexpected argument: $line"
			    }
			    lappend manual(text) $code
			}
			.AP {
			    lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
			}
			.IP {
			    regexp {^(.*) +\d+$} $rest all rest
			    lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
			}
			.TP {
			    while {[is-a-directive [set next [gets $manual(infp)]]]} {
			    	manerror "ignoring $next after .TP"
			    }
			    if {"$next" != {'}} {
				lappend manual(text) ".IP [process-text $next]"
			    }
			}
			.OP {
			    lappend manual(text) [concat .OP [process-text \
				    "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
			}
			.PP -
			.LP {
			    lappend manual(text) {.PP}
			}
			.RS {
			    incr manual(.RS)
			    lappend manual(text) $code
			}
			.RE {
			    incr manual(.RS) -1
			    lappend manual(text) $code
			}
			.SO {
			    incr manual(.SO)
			    lappend manual(text) $code
			}
			.SE {
			    incr manual(.SO) -1
			    lappend manual(text) $code
			}
			.DS {
			    incr manual(.DS)
			    lappend manual(text) $code
			}
			.DE {
			    incr manual(.DS) -1
			    lappend manual(text) $code
			}
			.CS {
			    incr manual(.CS)
			    lappend manual(text) $code
			}
			.CE {
			    incr manual(.CS) -1
			    lappend manual(text) $code
			}
			.de {
			    while {[gets $manual(infp) line] >= 0} {
				if {[string match "..*" $line]} {
				    break
				}
			    }
			}
			.. {
			    error "found .. outside of .de"
			}
			default {
			    manerror "unrecognized format directive: $line"
			}
		    }
		} else {
		    if {$manual(partial-text) == ""} {
			set manual(partial-text) $line
		    } else {
			append manual(partial-text) \n$line
		    }
		}
	    }
	    if {$manual(partial-text) != ""} {
		lappend manual(text) [process-text $manual(partial-text)]
	    }
	    close $manual(infp)
	    # fixups
	    if {$manual(.RS) != 0} {
		if {$manual(name) != "selection"} {
		    puts "unbalanced .RS .RE"
		}
	    }
	    if {$manual(.DS) != 0} {
		puts "unbalanced .DS .DE"
	    }
	    if {$manual(.CS) != 0} {
		puts "unbalanced .CS .CE"
	    }
	    if {$manual(.SO) != 0} {
		puts "unbalanced .SO .SE"
	    }
	    # output conversion
	    open-text
	    if {[next-op-is .HS rest]} {
		set manual($manual(name)-title) \
			"[lrange $rest 1 end] [lindex $rest 0] manual page"
		while {[more-text]} {
		    set line [next-text]
		    if {[is-a-directive $line]} {
			output-directive $line
		    } else {
			man-puts $line
		    }
		}
		man-puts <HR><PRE>
		foreach copyright $manual(copyrights) {
		    man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
		}
		man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr.</PRE>"
		set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
	    } elseif {[next-op-is .TH rest]} {
		set manual($manual(name)-title) "[lrange $rest 4 end] - [lindex $rest 0] manual page"
		while {[more-text]} {
		    set line [next-text]
		    if {[is-a-directive $line]} {
			output-directive $line
		    } else {
			man-puts $line
		    }
		}
		man-puts <HR><PRE>
		foreach copyright $manual(copyrights) {
		    man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
		}
		man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr.</PRE>"
		set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
	    } else {
		manerror "no .HS or .TH record found"
	    }
	    #
	    # make the long table of contents for this page
	    #
	    set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL><HR>]
	}

	#
	# make the wing table of contents for the section
	#
	set width 0
	foreach name $manual(wing-toc) {
	    if {[string length $name] > $width} {
		set width [string length $name]
	    }
	}
	set perline [expr {120 / $width}]
	set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
	set n 0
        catch {unset rows}
	foreach name [lsort $manual(wing-toc)] {
	    set tail $manual(name-$name)
	    if {[llength $tail] > 1} {
		manerror "$name is defined in more than one file: $tail"
		set tail [lindex $tail [expr {[llength $tail]-1}]]
	    }
	    set tail [file tail $tail]
	    append rows([expr {$n%$nrows}]) \
		    "<td> <a href=\"$tail.htm\">$name</a>"
	    incr n
	}
	puts $manual(wing-toc-fp) <table>
        foreach row [lsort -integer [array names rows]] {
	    puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
	}
	puts $manual(wing-toc-fp) </table>

	#
	# insert wing copyrights
	#
	puts $manual(wing-toc-fp) "<HR><PRE>"
	foreach copyright $manual(wing-copyrights) {
	    puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
	}
	puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
	puts $manual(wing-toc-fp) "</PRE></BODY></HTML>"
	close $manual(wing-toc-fp)
	set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
    }

    ##
    ## build the keyword index.
    ##
    proc strcasecmp {a b} { return [string compare -nocase $a $b] }
    set keys [lsort -command strcasecmp [array names manual keyword-*]]
    makedirhier $html/Keywords
    catch {eval file delete -- [glob $html/Keywords/*]}
    puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/contents.htm\">Keywords</A><DD>The keywords from the $tcltkdesc man pages."
    set keyfp [open $html/Keywords/contents.htm w]
    puts $keyfp "<HTML><HEAD><TITLE>$tcltkdesc Keywords</TITLE></HEAD>"
    puts $keyfp "<BODY><HR><H3>$tcltkdesc Keywords</H3><HR><H2>"
    foreach a {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
	puts $keyfp "<A HREF=\"$a.htm\">$a</A>"
	set afp [open $html/Keywords/$a.htm w]
	puts $afp "<HTML><HEAD><TITLE>$tcltkdesc Keywords - $a</TITLE></HEAD>"
	puts $afp "<BODY><HR><H3>$tcltkdesc Keywords - $a</H3><HR><H2>"
	foreach b {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
	    puts $afp "<A HREF=\"$b.htm\">$b</A>"
	}
	puts $afp "</H2><HR><DL>"
	foreach k $keys {
	    if {[string match -nocase "keyword-${a}*" $k]} {
		set k [string range $k 8 end]
		puts $afp "<DT><A NAME=\"$k\">$k</A><DD>"
		set refs {}
		foreach man $manual(keyword-$k) {
		    set name [lindex $man 0]
		    set file [lindex $man 1]
		    lappend refs "<A HREF=\"../$file\">$name</A>"
		}
		puts $afp [join $refs {, }]
	    }
	}
	puts $afp "</DL><HR><PRE>"
	# insert merged copyrights
	foreach copyright $manual(merge-copyrights) {
	    puts $afp "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
	}
	puts $afp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
	puts $afp "</PRE></BODY></HTML>"
	close $afp
    }
    puts $keyfp "</H2><HR><PRE>"

    # insert merged copyrights
    foreach copyright $manual(merge-copyrights) {
	puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
    }
    puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
    puts $keyfp </PRE><HR></BODY></HTML>
    close $keyfp

    ##
    ## finish off short table of contents
    ##
    puts $manual(short-toc-fp) {<DT><A HREF="http://www.elf.org">Source</A><DD>More information about these man pages.}
    puts $manual(short-toc-fp) "</DL><HR><PRE>"
    # insert merged copyrights
    foreach copyright $manual(merge-copyrights) {
	puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
    }
    puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
    puts $manual(short-toc-fp) "</PRE></BODY></HTML>"
    close $manual(short-toc-fp)

    ##
    ## output man pages
    ##
    unset manual(section)
    foreach path $manual(all-pages) {
	set manual(wing-file) [file dirname $path]
	set manual(tail) [file tail $path]
	set manual(name) [file root $manual(tail)]
	set text $manual(output-$manual(wing-file)-$manual(name))
	set ntext 0
	foreach item $text {
	    incr ntext [llength [split $item \n]]
	    incr ntext
	}
	set toc $manual(toc-$manual(wing-file)-$manual(name))
	set ntoc 0
	foreach item $toc {
	    incr ntoc [llength [split $item \n]]
	    incr ntoc
	}
	puts stderr "rescanning page $manual(name) $ntoc/$ntext"
	set manual(outfp) [open $html/$manual(wing-file)/$manual(name).htm w]
	puts $manual(outfp) "<HTML><HEAD><TITLE>$manual($manual(name)-title)</TITLE></HEAD><BODY>"
	if {($ntext > 60) && ($ntoc > 32) || [lsearch {
	    Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType
	    CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash
	    GetJustify GetPixels GetVisual ParseArgv QueueEvent
	} $manual(tail)] >= 0} {
	    foreach item $toc {
		puts $manual(outfp) $item
	    }
	}
	foreach item $text {
	    puts $manual(outfp) [insert-cross-references $item]
	}
	puts $manual(outfp) </BODY></HTML>
	close $manual(outfp)
    }
    return {}
}

parse_command_line

set tcltkdesc ""; set cmdesc ""; set appdir ""
if {$build_tcl} {append tcltkdesc "Tcl"; append cmdesc "Tcl"; append appdir "$tcldir"}
if {$build_tcl && $build_tk} {append tcltkdesc "/"; append cmdesc " and "; append appdir ","}
if {$build_tk} {append tcltkdesc "Tk"; append cmdesc "Tk"; append appdir "$tkdir"}

set usercmddesc "The interpreters which implement $cmdesc."
set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.}
set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.}
set tcllibdesc {The C functions which a Tcl extended C program may use.}
set tklibdesc {The additional C functions which a Tk extended C program may use.}
		
if {1} {
    if {[catch {
	make-man-pages $webdir \
	    "$tcltkdir/{$appdir}/doc/*.1 \"$tcltkdesc Applications\" UserCmd {$usercmddesc}" \
	    [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" : ""}] \
	    [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" : ""}] \
	    [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" : ""}] \
	    [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" : ""}]
    } error]} {
	puts $error\n$errorInfo
    }
}