More polishing of Tcl's HTML doc converter.

author: dkf <donal.k.fellows@manchester.ac.uk> 2011-09-29 14:58:10 (GMT)
committer: dkf <donal.k.fellows@manchester.ac.uk> 2011-09-29 14:58:10 (GMT)
commit: 0322cd84698d2934ec97f97caf038e457713fa88 (patch)
tree: d9a58804c0c01d31d23bf93c51ecd96b08bccdd9
parent: 50d1e59291db05687182c0d0a0466581317e7e23 (diff)
download: tcl-0322cd84698d2934ec97f97caf038e457713fa88.zip
tcl-0322cd84698d2934ec97f97caf038e457713fa88.tar.gz
tcl-0322cd84698d2934ec97f97caf038e457713fa88.tar.bz2
3 files changed, 414 insertions, 359 deletions
diff --git a/ChangeLog b/ChangeLog
index 117246f..1bcaf49 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2011-09-29  Donal K. Fellows  <dkf@users.sf.net>
+
+	* tools/tcltk-man2html.tcl, tools/tcltk-man2html-utils.tcl: More
+	refactoring so that more of the utility code is decently out of the
+	way. Adjusted the header-material generator so that version numbers
+	are only included in locations where there is room.
+
 2011-09-28  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tclOO.h:      [RFE 3010352]: make all TclOO API functions
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index ef1f62a..c0c6a75 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -35,7 +35,7 @@ proc fatal {msg} {
     uplevel 1 [list manerror $msg]
     exit 1
 }
-
+
 ##
 ## templating
 ##
@@ -46,6 +46,7 @@ proc indexfile {} {
 	return "contents.htm"
     }
 }
+
 proc copyright {copyright {level {}}} {
     # We don't actually generate a separate copyright page anymore
     #set page "${level}copyright.htm"
@@ -54,6 +55,7 @@ proc copyright {copyright {level {}}} {
     set who [string map {@ (at)} [lrange $copyright 2 end]]
     return "Copyright &copy; [htmlize-text $who]"
 }
+
 proc copyout {copyrights {level {}}} {
     set out "<div class=\"copy\">"
     foreach c $copyrights {
@@ -62,12 +64,15 @@ proc copyout {copyrights {level {}}} {
     append out "</div>"
     return $out
 }
+
 proc CSS {{level ""}} {
     return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n"
 }
+
 proc DOCTYPE {} {
     return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
 }
+
 proc htmlhead {title header args} {
     set level ""
     if {[lindex $args end] eq "../[indexfile]"} {
@@ -93,7 +98,7 @@ proc htmlhead {title header args} {
     }
     return $out
 }
-
+
 ##
 ## parsing
 ##
@@ -187,6 +192,7 @@ proc process-text {text} {
     }
     return $text
 }
+
 ##
 ## pass 2 text input and matching
 ##
@@ -195,10 +201,12 @@ proc open-text {} {
     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]} {
@@ -209,14 +217,17 @@ proc next-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 1 $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 1 $restname rest
@@ -230,12 +241,14 @@ proc next-op-is {op restname} {
     }
     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]
@@ -275,11 +288,13 @@ proc match-text args {
     }
     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
 ##
@@ -287,7 +302,7 @@ proc man-puts {text} {
     global manual
     lappend manual(output-$manual(wing-file)-$manual(name)) $text
 }
-
+
 ##
 ## build hypertext links to tables of contents
 ##
@@ -300,6 +315,7 @@ proc long-toc {text} {
 	    "<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
     # Special case handling, oh we hate it but must do it
@@ -327,6 +343,7 @@ proc option-toc {name class switch} {
 	"<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
     return "<A NAME=\"$here\">$switch</A>"
 }
+
 proc std-option-toc {name page} {
     global manual
     if {[info exists manual(standard-option-$page-$name)]} {
@@ -340,6 +357,7 @@ proc std-option-toc {name page} {
     lappend manual(section-toc) "<DD><A HREF=\"$page.htm#$other\">$name</A>"
     return "<A HREF=\"$page.htm#$other\">$name</A>"
 }
+
 ##
 ## process the widget option section
 ## in widget and options man pages
@@ -411,7 +429,7 @@ proc output-widget-options {rest} {
     man-puts </DL>
     lappend manual(section-toc) </DL>
 }
-
+
 ##
 ## process .RS lists
 ##
@@ -455,7 +473,7 @@ proc output-RS-list {} {
     }
     man-puts </DL>
 }
-
+
 ##
 ## process .IP lists which may be plain indents,
 ## numeric lists, or definition lists
@@ -594,6 +612,7 @@ proc output-IP-list {context code rest} {
 	}
     }
 }
+
 ##
 ## handle the NAME section lines
 ## there's only one line in the NAME section,
@@ -618,6 +637,7 @@ proc output-name {line} {
 	lappend manual(name-$name) $manual(wing-file)/$manual(name)
     }
 }
+
 ##
 ## build a cross-reference link if appropriate
 ##
@@ -726,6 +746,7 @@ proc cross-reference {ref} {
     ##
     return "<A HREF=\"../$manref.htm\">$ref</A>"
 }
+
 ##
 ## reference generation errors
 ##
@@ -734,6 +755,7 @@ proc reference-error {msg text} {
     puts stderr "$manual(tail): $msg: {$text}"
     return $text
 }
+
 ##
 ## insert as many cross references into this text string as are appropriate
 ##
@@ -888,6 +910,7 @@ proc insert-cross-references {text} {
 	}
     }
 }
+
 ##
 ## process formatting directives
 ##
@@ -1169,6 +1192,7 @@ proc output-directive {line} {
 	}
     }
 }
+
 ##
 ## merge copyright listings
 ##
@@ -1206,7 +1230,361 @@ proc merge-copyrights {l1 l2} {
     }
     return [lsort -dictionary $merge]
 }
+
+##
+## foreach of the man pages in the section specified by
+## sectionDescriptor, convert manpages into hypertext in
+## the directory specified by outputDir.
+##
+proc make-manpage-section {outputDir sectionDescriptor} {
+    global manual overall_title tcltkdesc verbose
+    global excluded_pages forced_index_pages process_first_patterns
+
+    set LQ \u201c
+    set RQ \u201d
 
+    lassign $sectionDescriptor \
+	manual(wing-glob) \
+	manual(wing-name) \
+	manual(wing-file) \
+	manual(wing-description)
+    set manual(wing-copyrights) {}
+    makedirhier $outputDir/$manual(wing-file)
+    set manual(wing-toc-fp) [open $outputDir/$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 $outputDir/$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 -nocomplain $manual(wing-glob)]]
+    # Some pages have to go first so that their links override others
+    foreach pat $process_first_patterns {
+	set n [lsearch -glob $manual(pages) $pat]
+	if {$n >= 0} {
+	    set f [lindex $manual(pages) $n]
+	    puts stderr "shuffling [file tail $f] to front of processing queue"
+	    set manual(pages) \
+		[linsert [lreplace $manual(pages) $n $n] 0 $f]
+	}
+    }
+    # set manual(pages) [lrange $manual(pages) 0 5]
+    foreach manual_page $manual(pages) {
+	set manual(page) [file normalize $manual_page]
+	# whistle
+	if {$verbose} {
+	    puts stderr "scanning page $manual(page)"
+	} else {
+	    puts -nonewline stderr .
+	}
+	set manual(tail) [file tail $manual(page)]
+	set manual(name) [file root $manual(tail)]
+	set manual(section) {}
+	if {$manual(name) in $excluded_pages} {
+	    # obsolete
+	    if {!$verbose} {
+		puts stderr ""
+	    }
+	    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)
+	lappend manual(all-page-domains) $manual(wing-name)
+	manreport 100 $manual(name)
+	while {[gets $manual(infp) line] >= 0} {
+	    manreport 100 $line
+	    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 {
+		.if - .nr - .ti - .in - .ie - .el -
+		.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 {
+		    lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
+			inQuote afterwards
+		    addbuffer $LQ [unquote $inQuote] $RQ [unquote $afterwards]
+		}
+		.PQ {
+		    lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
+			inQuote punctuation afterwards
+		    addbuffer ( $LQ [unquote $inQuote] $RQ \
+			    [unquote $punctuation] ) [unquote $afterwards]
+		}
+		.QR {
+		    lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
+			rangeFrom rangeTo afterwards
+		    addbuffer $LQ [unquote $rangeFrom] "&ndash;" \
+			    [unquote $rangeTo] $RQ [unquote $afterwards]
+		}
+		.MT {
+		    addbuffer $LQ$RQ
+		}
+		.HS - .UL - .ta {
+		    flushbuffer
+		    lappend manual(text) "$code [unquote $rest]"
+		}
+		.BS - .BE - .br - .fi - .sp - .nf {
+		    flushbuffer
+		    if {$rest ne ""} {
+			if {!$verbose} {
+			    puts stderr ""
+			}
+			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)]]]} {
+			if {!$verbose} {
+			    puts stderr ""
+			}
+			manerror "ignoring $next after .TP"
+		    }
+		    if {"$next" ne {'}} {
+			lappend manual(text) ".IP [process-text $next]"
+		    }
+		}
+		.OP {
+		    flushbuffer
+		    lassign $rest cmdName dbName dbClass
+		    lappend manual(text) [concat .OP [process-text \
+			    "\\fB$cmdName\\fR \\fB$dbName\\fR \\fB$dbClass\\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)
+		    if {[llength $rest] == 0} {
+			lappend manual(text) "$code options"
+		    } else {
+			lappend manual(text) "$code [unquote $rest]"
+		    }
+		}
+		.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
+			}
+		    }
+		}
+		.. {
+		    if {!$verbose} {
+			puts stderr ""
+		    }
+		    error "found .. outside of .de"
+		}
+		default {
+		    if {!$verbose} {
+			puts stderr ""
+		    }
+		    flushbuffer
+		    manerror "unrecognized format directive: $line"
+		}
+	    }
+	}
+	flushbuffer
+	close $manual(infp)
+	# fixups
+	if {$manual(.RS) != 0} {
+	    if {!$verbose} {
+		puts stderr ""
+	    }
+	    puts "unbalanced .RS .RE"
+	}
+	if {$manual(.DS) != 0} {
+	    if {!$verbose} {
+		puts stderr ""
+	    }
+	    puts "unbalanced .DS .DE"
+	}
+	if {$manual(.CS) != 0} {
+	    if {!$verbose} {
+		puts stderr ""
+	    }
+	    puts "unbalanced .CS .CE"
+	}
+	if {$manual(.SO) != 0} {
+	    if {!$verbose} {
+		puts stderr ""
+	    }
+	    puts "unbalanced .SO .SE"
+	}
+	# output conversion
+	open-text
+	set haserror 0
+	if {[next-op-is .HS rest]} {
+	    set manual($manual(wing-file)-$manual(name)-title) \
+		"[join [lrange $rest 1 end] { }] [lindex $rest 0] manual page"
+	} elseif {[next-op-is .TH rest]} {
+	    set manual($manual(wing-file)-$manual(name)-title) \
+		"[lindex $rest 0] manual page - [join [lrange $rest 4 end] { }]"
+	} else {
+	    set haserror 1
+	    if {!$verbose} {
+		puts stderr ""
+	    }
+	    manerror "no .HS or .TH record found"
+	}
+	if {!$haserror} {
+	    while {[more-text]} {
+		set line [next-text]
+		if {[is-a-directive $line]} {
+		    output-directive $line
+		} else {
+		    man-puts $line
+		}
+	    }
+	    man-puts [copyout $manual(copyrights) "../"]
+	    set manual(wing-copyrights) [merge-copyrights \
+		    $manual(wing-copyrights) $manual(copyrights)]
+	}
+	#
+	# make the long table of contents for this page
+	#
+	set manual(toc-$manual(wing-file)-$manual(name)) \
+	    [concat <DL> $manual(section-toc) </DL>]
+    }
+    if {!$verbose} {
+	puts stderr ""
+    }
+
+    #
+    # 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 {118 / $width}]
+    set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
+    set n 0
+    catch {unset rows}
+    foreach name [lsort -dictionary $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> </td>"
+	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) [copyout $manual(wing-copyrights) "../"]
+    puts $manual(wing-toc-fp) "</BODY></HTML>"
+    close $manual(wing-toc-fp)
+    set manual(merge-copyrights) \
+	[merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
+}
+
 proc makedirhier {dir} {
     try {
 	if {![file isdirectory $dir]} {
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index e4845a6..585d76a 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -1,6 +1,4 @@
-#!/bin/sh
-# The next line is executed by /bin/sh, but not tcl \
-exec tclsh "$0" ${1+"$@"}
+#!/usr/bin/env tclsh
 
 package require Tcl 8.6
 
@@ -261,364 +259,36 @@ proc make-man-pages {html args} {
     puts $manual(short-toc-fp) "<DL class=\"keylist\">"
     set manual(merge-copyrights) {}
 
-    set LQ \u201c
-    set RQ \u201d
-
     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]
+	lassign $arg -> name file
+	if {[regexp {(.*)(?: Package)? Commands(?:, version .*)?} $name -> pkg]} {
+	    set name "$pkg Commands"
+	} elseif {[regexp {(.*)(?: Package)? C API(?:, version .*)?} $name -> pkg]} {
+	    set name "$pkg C API"
+	}
 	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 -nocomplain $manual(wing-glob)]]
-	# Some pages have to go first so that their links override others
-	foreach pat $process_first_patterns {
-	    set n [lsearch -glob $manual(pages) $pat]
-	    if {$n >= 0} {
-		set f [lindex $manual(pages) $n]
-		puts stderr "shuffling [file tail $f] to front of processing queue"
-		set manual(pages) \
-		    [linsert [lreplace $manual(pages) $n $n] 0 $f]
-	    }
-	}
-	# set manual(pages) [lrange $manual(pages) 0 5]
-	foreach manual_page $manual(pages) {
-	    set manual(page) [file normalize $manual_page]
-	    # whistle
-	    if {$verbose} {
-		puts stderr "scanning page $manual(page)"
-	    } else {
-		puts -nonewline stderr .
-	    }
-	    set manual(tail) [file tail $manual(page)]
-	    set manual(name) [file root $manual(tail)]
-	    set manual(section) {}
-	    if {$manual(name) in $excluded_pages} {
-		# obsolete
-		if {!$verbose} {
-		    puts stderr ""
-		}
-		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\)|\\\(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 {
-		    .if - .nr - .ti - .in - .ie - .el -
-		    .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 {
-			lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
-			    inQuote afterwards
-			addbuffer $LQ [unquote $inQuote] $RQ [unquote $afterwards]
-		    }
-		    .PQ {
-			lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
-			    inQuote punctuation afterwards
-			addbuffer ( $LQ [unquote $inQuote] $RQ \
-			    [unquote $punctuation] ) \
-			    [unquote $afterwards]
-		    }
-		    .QR {
-			lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
-			    rangeFrom rangeTo afterwards
-			addbuffer $LQ [unquote $rangeFrom] "&ndash;" \
-			    [unquote $rangeTo] $RQ [unquote $afterwards]
-		    }
-		    .MT {
-			addbuffer $LQ$RQ
-		    }
-		    .HS - .UL - .ta {
-			flushbuffer
-			lappend manual(text) "$code [unquote $rest]"
-		    }
-		    .BS - .BE - .br - .fi - .sp - .nf {
-			flushbuffer
-			if {$rest ne ""} {
-			    if {!$verbose} {
-				puts stderr ""
-			    }
-			    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)]]]} {
-			    if {!$verbose} {
-				puts stderr ""
-			    }
-			    manerror "ignoring $next after .TP"
-			}
-			if {"$next" ne {'}} {
-			    lappend manual(text) ".IP [process-text $next]"
-			}
-		    }
-		    .OP {
-			flushbuffer
-			lassign $rest cmdName dbName dbClass
-			lappend manual(text) [concat .OP [process-text \
-				"\\fB$cmdName\\fR \\fB$dbName\\fR \\fB$dbClass\\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)
-			if {[llength $rest] == 0} {
-			    lappend manual(text) "$code options"
-			} else {
-			    lappend manual(text) "$code [unquote $rest]"
-			}
-		    }
-		    .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
-			    }
-			}
-		    }
-		    .. {
-			if {!$verbose} {
-			    puts stderr ""
-			}
-			error "found .. outside of .de"
-		    }
-		    default {
-			if {!$verbose} {
-			    puts stderr ""
-			}
-			flushbuffer
-			manerror "unrecognized format directive: $line"
-		    }
-		}
-	    }
-	    flushbuffer
-	    close $manual(infp)
-	    # fixups
-	    if {$manual(.RS) != 0} {
-		if {!$verbose} {
-		    puts stderr ""
-		}
-		puts "unbalanced .RS .RE"
-	    }
-	    if {$manual(.DS) != 0} {
-		if {!$verbose} {
-		    puts stderr ""
-		}
-		puts "unbalanced .DS .DE"
-	    }
-	    if {$manual(.CS) != 0} {
-		if {!$verbose} {
-		    puts stderr ""
-		}
-		puts "unbalanced .CS .CE"
-	    }
-	    if {$manual(.SO) != 0} {
-		if {!$verbose} {
-		    puts stderr ""
-		}
-		puts "unbalanced .SO .SE"
-	    }
-	    # output conversion
-	    open-text
-	    set haserror 0
-	    if {[next-op-is .HS rest]} {
-		set manual($manual(wing-file)-$manual(name)-title) \
-		    "[join [lrange $rest 1 end] { }] [lindex $rest 0] manual page"
-	    } elseif {[next-op-is .TH rest]} {
-		set manual($manual(wing-file)-$manual(name)-title) \
-		    "[lindex $rest 0] manual page - [join [lrange $rest 4 end] { }]"
-	    } else {
-		set haserror 1
-		if {!$verbose} {
-		    puts stderr ""
-		}
-		manerror "no .HS or .TH record found"
-	    }
-	    if {!$haserror} {
-		while {[more-text]} {
-		    set line [next-text]
-		    if {[is-a-directive $line]} {
-			output-directive $line
-		    } else {
-			man-puts $line
-		    }
-		}
-		man-puts [copyout $manual(copyrights) "../"]
-		set manual(wing-copyrights) [merge-copyrights \
-			$manual(wing-copyrights) $manual(copyrights)]
-	    }
-	    #
-	    # make the long table of contents for this page
-	    #
-	    set manual(toc-$manual(wing-file)-$manual(name)) \
-		    [concat <DL> $manual(section-toc) </DL>]
-	}
-	if {!$verbose} {
-	    puts stderr ""
-	}
 
-	#
-	# 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 {118 / $width}]
-	set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
-	set n 0
-        catch {unset rows}
-	foreach name [lsort -dictionary $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> </td>"
-	    incr n
-	}
-	puts $manual(wing-toc-fp) <table>
-        foreach row [lsort -integer [array names rows]] {
-	    puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
+    ##
+    ## parse the manpages in a section of the docs (split by
+    ## package) and construct formatted manpages
+    ##
+    foreach arg $args {
+	if {[llength $arg]} {
+	    make-manpage-section $html $arg
 	}
-	puts $manual(wing-toc-fp) </table>
-
-	#
-	# insert wing copyrights
-	#
-	puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"]
-	puts $manual(wing-toc-fp) "</BODY></HTML>"
-	close $manual(wing-toc-fp)
-	set manual(merge-copyrights) [merge-copyrights \
-		$manual(merge-copyrights) $manual(wing-copyrights)]
     }
 
     ##
     ## build the keyword index.
     ##
+    if {!$verbose} {
+	puts stderr "Assembling index"
+    }
     file delete -force -- $html/Keywords
     makedirhier $html/Keywords
     set keyfp [open $html/Keywords/[indexfile] w]
@@ -688,9 +358,9 @@ proc make-man-pages {html args} {
     ##
     unset manual(section)
     if {!$verbose} {
-	puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links"
+	puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links and write out"
     }
-    foreach path $manual(all-pages) {
+    foreach path $manual(all-pages) wing_name $manual(all-page-domains) {
 	set manual(wing-file) [file dirname $path]
 	set manual(tail) [file tail $path]
 	set manual(name) [file root $manual(tail)]
@@ -714,7 +384,7 @@ proc make-man-pages {html args} {
 	    }
 	    set outfd [open $html/$manual(wing-file)/$manual(name).htm w]
 	    puts $outfd [htmlhead "$manual($manual(wing-file)-$manual(name)-title)" \
-		    $manual(name) $manual(wing-file) "[indexfile]" \
+		    $manual(name) $wing_name "[indexfile]" \
 		    $overall_title "../[indexfile]"]
 	    if {($ntext > 60) && ($ntoc > 32)} {
 		foreach item $toc {
@@ -789,7 +459,7 @@ proc plus-pkgs {type args} {
 		    "The additional commands provided by the $name package."
 	    }
 	    3 {
-		set title "$name Package Library"
+		set title "$name Package C API"
 		if {$version ne ""} {
 		    append title ", version $version"
 		}
@@ -990,9 +660,9 @@ try {
 	[plus-base $build_tk $tkdir/doc/*.n {Tk Commands} TkCmd \
 	     "The additional commands which the <B>wish</B> interpreter implements."] \
 	{*}[plus-pkgs n {*}$packageDirNameMap] \
-	[plus-base $build_tcl $tcldir/doc/*.3 {Tcl Library} TclLib \
+	[plus-base $build_tcl $tcldir/doc/*.3 {Tcl C API} TclLib \
 	     "The C functions which a Tcl extended C program may use."] \
-	[plus-base $build_tk $tkdir/doc/*.3 {Tk Library} TkLib \
+	[plus-base $build_tk $tkdir/doc/*.3 {Tk C API} TkLib \
 	     "The additional C functions which a Tk extended C program may use."] \
 	{*}[plus-pkgs 3 {*}$packageDirNameMap]
 } on error {msg opts} {
@@ -1001,7 +671,7 @@ try {
     puts $msg\n[dict get $opts -errorinfo]
     exit 1
 }
-
+
 # Local-Variables:
 # mode: tcl
 # End:
author	dkf <donal.k.fellows@manchester.ac.uk>	2011-09-29 14:58:10 (GMT)
committer	dkf <donal.k.fellows@manchester.ac.uk>	2011-09-29 14:58:10 (GMT)
commit	0322cd84698d2934ec97f97caf038e457713fa88 (patch)
tree	d9a58804c0c01d31d23bf93c51ecd96b08bccdd9
parent	50d1e59291db05687182c0d0a0466581317e7e23 (diff)
download	tcl-0322cd84698d2934ec97f97caf038e457713fa88.zip tcl-0322cd84698d2934ec97f97caf038e457713fa88.tar.gz tcl-0322cd84698d2934ec97f97caf038e457713fa88.tar.bz2