Tcl Source Code

2007-10-30  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (output-widget-options): Enhance the HTML
	generator so that it can produce multi-line option descriptions.

2007-10-28  Miguel Sofer  <[email protected]>

	* generic/tclUtil.c (Tcl_ConcatObj): optimise for some of the
	concatenees being empty objs [Bug 1447328]

2007-10-28  Donal K. Fellows  <[email protected]>

	* generic/tclEncoding.c (TclInitEncodingSubsystem): Hard code the
	iso8859-1 encoding, as it's needed for more than just text (especially
	binary encodings...) Note that other encodings rely on the encoding
	being a table encoding (!) so we can't use more efficient encoding
	mapping functions.

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

package require Tcl 8.5

# 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

	    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 eq ""} {
	    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 eq ""} {
	    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 " Documentation"
}

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

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

    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 {$arg eq $targ} {
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	if {[regexp {^@(\w+)$} $arg all name]} {
	    upvar 1 $name var
	    set var $targ

proc option-toc {name class switch} {
    global manual
    if {[string match "*OPTIONS" $manual(section)]} {
	# 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 {"$manual(name):$manual(section)" eq "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>"

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 {
		lassign $rest switch name class
	    }
	    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"


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

	if {[next-op-is .RS rest]} {
	    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>
    lappend manual(section-toc) </DL>
}

##
## process .RS lists

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

	    set line [next-text]
	    if {[is-a-directive $line]} {
		split-directive $line code rest
		if {$code eq ".IP" && $rest eq {}} {
		    man-puts "<P>"
		    continue
		}
		if {$code in {.br .DS .RS}} {
		    output-directive $line
		} else {
		    backup-text 1
		    break
		}
	    } else {
		man-puts $line

	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 {$manual(section) eq "ARGUMENTS" || \
				[regexp {^\[\d+\]$} $rest]} {

    } 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)] && \
		    $manual(tail) ne "$name.n"} {
		return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
	    }
	}
	if {$lref in {stdin stdout stderr end}} {
	    # no good place to send these
	    # tcl tokens?
	    # also end
	}
	return $ref
    }
    ##
    ## would be a self reference
    ##
    foreach name $manual(name-$lref) {
	if {"$manual(wing-file)/$manual(name)" in $name} {
	    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) eq "TclCmd"
		|| $manual(wing-file) eq "TclLib"} {
	    return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
	}
	if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd"
		|| $manual(wing-file) eq "TkLib"} {
	    return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
	}
	if {$lref eq "exit" && $manual(tail) eq "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 -exact -- $manual(tail) {
	canvas.n {
	    if {$lref eq "focus"} {
		upvar 1 tail tail
		set clue [string first command $tail]
		if {$clue < 0 ||  $clue > 5} {
		    return $ref
		}
	    }
	    if {$lref in {bitmap image text}} {
		return $ref
	    }
	}
	checkbutton.n - radiobutton.n {
	    if {$lref in {image}} {

		return $ref
	    }
	}
	menu.n {
	    if {$lref in {checkbutton radiobutton}} {
		return $ref
	    }
	}
	options.n {
	    if {$lref in {bitmap image set}} {
		return $ref
	    }
	}
	regexp.n {
	    if {$lref in {string}} {
		return $ref
	    }
	}
	source.n {
	    if {$lref in {text}} {
		return $ref
	    }
	}
	history.n {
	    if {$lref in {exec}} {
		return $ref
	    }
	}
	return.n {
	    if {$lref in {error continue break}} {
		return $ref
	    }
	}
	scrollbar.n {
	    if {$lref in {set}} {
		return $ref
	    }
	}
    }
    ##
    ## return the cross reference
    ##

    ##
    ## 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]) eq "tk"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    if {$invert([lindex $offsets 1]) eq "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]) eq "tk"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    if {$invert([lindex $offsets 1]) eq "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]"

##
## 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 {$code ne ".SS"} {
		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 {$manual(tail) in {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3}} {
			# these manual pages have two NAME sections
			if {[info exists manual($manual(tail)-NAME)]} {
			    return
			}
			set manual($manual(tail)-NAME) 1
		    }
		    set names {}

			    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]
			} then {
			    continue
			}
			if {
			    [next-op-is .SH rest]
			    || [next-op-is .SS rest]
			    || [next-op-is .BE rest]
			    || [next-op-is .SO rest]
			} then {
			    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

			}
			foreach more [split $more \n] {
			    man-puts $more<BR>
			    if {$manual(wing-file) in {TclLib TkLib}} {
				lappend manual(section-toc) <DD>$more

			    }
			}
		    }
		    lappend manual(section-toc) </DL>
		    return
		}
		{SEE ALSO} {

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

		continue
	    }
	}
	puts "oops: $copyright"
    }
    foreach who [array names dates] {
	set list [lsort -dictionary $dates($who)]
	if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} {
	    lappend merge "Copyright © [lindex $list 0] $who"
	} else {
	    lappend merge "Copyright © [lindex $list 0]-[lrange $list end end] $who"
	}
    }
    return [lsort -dictionary $merge]
}

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

proc addbuffer {args} {
    global manual
    if {$manual(partial-text) ne ""} {
	append manual(partial-text) \n
    }
    append manual(partial-text) [join $args ""]
}
proc flushbuffer {} {
    global manual
    if {$manual(partial-text) ne ""} {
	lappend manual(text) [process-text $manual(partial-text)]
	set manual(partial-text) ""
    }
}

##
## 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 manual overall_title tcltkdesc
    makedirhier $html
    set cssfd [open $html/$::CSSFILE w]
    puts $cssfd [gencss]
    close $cssfd
    set manual(short-toc-n) 1
    set manual(short-toc-fp) [open $html/[indexfile] w]
    puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title]
    puts $manual(short-toc-fp) "<DL class=\"keylist\">"
    set manual(merge-copyrights) {}
    foreach arg $args {
	# preprocess to set up subheader for the rest of the files
	if {![llength $arg]} {
	    continue
	}
	set name [lindex $arg 1]
	set file [lindex $arg 2]
	lappend manual(subheader) $name $file
    }
    foreach arg $args {
	if {![llength $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)/[indexfile] 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)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>"
	# initialize the wing table of contents
	puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \
		$manual(wing-name) $overall_title "../[indexfile]"]

	# 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 -dictionary [glob $manual(wing-glob)]]
	set n [lsearch -glob $manual(pages) */options.n]
	if {$n >= 0} {
	    set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
	}
	# set manual(pages) [lrange $manual(pages) 0 5]
	set LQ \u201c
	set RQ \u201d
	foreach manual_page $manual(pages) {
	    set manual(page) $manual_page
	    # 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 {$manual(name) in {case pack-old menubar}} {
		# obsolete
		manerror "discarding $manual(name)"
		continue
	    }
	    set manual(infp) [open $manual(page)]
	    set manual(text) {}
	    set manual(partial-text) {}

		if {[regexp {^[`'][/\\]} $line]} {
		    if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} {
			lappend manual(copyrights) $copyright
		    }
		    # comment
		    continue
		}
		if {"$line" eq {'}} {
		    # comment
		    continue
		}
		if {![parse-directive $line code rest]} {
		    addbuffer $line
		    continue
		}
		switch -exact -- $code {
		    .ad - .na - .so - .ne - .AS - .VE - .VS - . {

			# ignore
			continue
		    }
		}




		switch -exact -- $code {
		    .SH - .SS {
			flushbuffer
			if {[llength $rest] == 0} {
			    gets $manual(infp) rest
			}
			lappend manual(text) "$code [unquote $rest]"
		    }
		    .TH {
			flushbuffer
			lappend manual(text) "$code [unquote $rest]"
		    }
		    .QW {
			set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
			addbuffer $LQ [unquote [lindex $rest 0]] $RQ \


			    [unquote [lindex $rest 1]]

		    }

		    .PQ {
			set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
			addbuffer ( $LQ [unquote [lindex $rest 0]] $RQ \







			    [unquote [lindex $rest 1]] ) \
			    [unquote [lindex $rest 2]]




		    }
		    .QR {
			set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
			addbuffer $LQ [unquote [lindex $rest 0]] - \
			    [unquote [lindex $rest 1]] $RQ \
			    [unquote [lindex $rest 2]]
		    }
		    .MT {
			addbuffer $LQ$RQ




		    }

		    .HS - .UL - .ta {

			flushbuffer
			lappend manual(text) "$code [unquote $rest]"
		    }
		    .BS - .BE - .br - .fi - .sp - .nf {
			flushbuffer
			if {"$rest" ne {}} {
			    manerror "unexpected argument: $line"
			}
			lappend manual(text) $code
		    }
		    .AP {
			flushbuffer
			lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
		    }
		    .IP {
			flushbuffer
			regexp {^(.*) +\d+$} $rest all rest
			lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
		    }
		    .TP {
			flushbuffer
			while {[is-a-directive [set next [gets $manual(infp)]]]} {
			    manerror "ignoring $next after .TP"
			}
			if {"$next" ne {'}} {
			    lappend manual(text) ".IP [process-text $next]"
			}
		    }
		    .OP {
			flushbuffer
			lappend manual(text) [concat .OP [process-text \
				"\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
		    }
		    .PP - .LP {

			flushbuffer
			lappend manual(text) {.PP}
		    }
		    .RS {
			flushbuffer
			incr manual(.RS)
			lappend manual(text) $code
		    }
		    .RE {
			flushbuffer
			incr manual(.RS) -1
			lappend manual(text) $code
		    }
		    .SO {
			flushbuffer
			incr manual(.SO)
			lappend manual(text) $code
		    }
		    .SE {
			flushbuffer
			incr manual(.SO) -1
			lappend manual(text) $code
		    }
		    .DS {
			flushbuffer
			incr manual(.DS)
			lappend manual(text) $code
		    }
		    .DE {
			flushbuffer
			incr manual(.DS) -1
			lappend manual(text) $code
		    }
		    .CS {
			flushbuffer
			incr manual(.CS)
			lappend manual(text) $code
		    }
		    .CE {
			flushbuffer
			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 {
			flushbuffer
			manerror "unrecognized format directive: $line"
		    }
		}





	    }





	    flushbuffer
	    close $manual(infp)
	    # fixups
	    if {$manual(.RS) != 0} {

		puts "unbalanced .RS .RE"

	    }
	    if {$manual(.DS) != 0} {
		puts "unbalanced .DS .DE"
	    }
	    if {$manual(.CS) != 0} {
		puts "unbalanced .CS .CE"
	    }

	    lappend keyheader $a
	}
    }
    set keyheader "<H3>[join $keyheader " |\n"]</H3>"
    puts $keyfp $keyheader
    foreach a $letters {
	set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
	if {![llength $keys]} {
	    continue
	}
	# Per-keyword page
	set afp [open $html/Keywords/$a.htm w]
	puts $afp [htmlhead "$tcltkdesc Keywords - $a" \
		       "$tcltkdesc Keywords - $a" \
		       $overall_title "../[indexfile]"]
	puts $afp $keyheader
	puts $afp "<DL class=\"keylist\">"

	foreach item $toc {
	    incr ntoc [llength [split $item \n]]
	    incr ntoc
	}
	puts stderr "rescanning page $manual(name) $ntoc/$ntext"
	set outfd [open $html/$manual(wing-file)/$manual(name).htm w]
	puts $outfd [htmlhead "$manual($manual(name)-title)" \

		$manual(name) $manual(wing-file) "[indexfile]" \
		$overall_title "../[indexfile]"]
	if {
	    (($ntext > 60) && ($ntoc > 32)) || $manual(tail) in {
		Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType
		CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash
		GetJustify GetPixels GetVisual ParseArgv QueueEvent
	    }
	} then {
	    foreach item $toc {
		puts $outfd $item
	    }
	}
	foreach item $text {
	    puts $outfd [insert-cross-references $item]
	}