summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-09-29 14:58:10 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-09-29 14:58:10 (GMT)
commit9f6d7b9f3e4e3b2920f51e94c6444e6e41c8e195 (patch)
treed9a58804c0c01d31d23bf93c51ecd96b08bccdd9
parent89b3c7f11e1bdf0e7c9b8cfe622f383ec7ca0a4d (diff)
downloadtcl-9f6d7b9f3e4e3b2920f51e94c6444e6e41c8e195.zip
tcl-9f6d7b9f3e4e3b2920f51e94c6444e6e41c8e195.tar.gz
tcl-9f6d7b9f3e4e3b2920f51e94c6444e6e41c8e195.tar.bz2
More polishing of Tcl's HTML doc converter.
-rw-r--r--ChangeLog7
-rw-r--r--tools/tcltk-man2html-utils.tcl388
-rwxr-xr-xtools/tcltk-man2html.tcl378
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: