From a9cb09e63d7fc8f8409872ca6e6830a452385c09 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 30 Oct 2007 00:14:40 +0000
Subject: Enhance the HTML generator so that it can produce multi-line option
descriptions.
---
ChangeLog | 7 +-
tools/tcltk-man2html.tcl | 501 ++++++++++++++++++++++++++---------------------
2 files changed, 283 insertions(+), 225 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 5afd9c1..7766db0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,13 @@
+2007-10-30 Donal K. Fellows <dkf@users.sf.net>
+
+ * 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 <msofer@users.sf.net>
* generic/tclUtil.c (Tcl_ConcatObj): optimise for some of the
concatenees being empty objs [Bug 1447328]
-
+
2007-10-28 Donal K. Fellows <dkf@users.sf.net>
* generic/tclEncoding.c (TclInitEncodingSubsystem): Hard code the
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index b71602c..fa22b2e 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -2,7 +2,7 @@
# The next line is executed by /bin/sh, but not tcl \
exec tclsh8.4 "$0" ${1+"$@"}
-package require Tcl 8.4
+package require Tcl 8.5
# Convert Ousterhout format man pages into highly crosslinked hypertext.
#
@@ -94,13 +94,16 @@ proc parse_command_line {} {
}
}
- if {!$build_tcl && !$build_tk} {set build_tcl 1; set build_tk 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 {
+ -directory $tcltkdir tcl$useversion]] end]
+ if {$tcldir eq ""} {
puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
exit 1
}
@@ -111,7 +114,7 @@ proc parse_command_line {} {
# Find Tk.
set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
-directory $tcltkdir tk$useversion]] end]
- if {$tkdir == ""} then {
+ if {$tkdir eq ""} {
puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
exit 1
}
@@ -121,9 +124,15 @@ proc parse_command_line {} {
# 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]"}
+ 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"
}
@@ -373,12 +382,14 @@ proc process-text {text} {
if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
{\1<I>\2</I>\\fB\3} text]} continue
# B B, I I, R R
- if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
+ 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]} {
+ {\1\\fR\2\3} ntext]
+ } then {
manerror "process-text: impotent font change: $text"
set text $ntext
continue
@@ -452,7 +463,7 @@ proc match-text args {
}
set arg [string trim $arg]
set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
- if {[string equal $arg $targ]} {
+ if {$arg eq $targ} {
incr nback
incr manual(text-pointer)
continue
@@ -508,8 +519,7 @@ proc option-toc {name class switch} {
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"]} {
+ } 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.
@@ -546,8 +556,10 @@ proc output-widget-options {rest} {
backup-text 1
set para {}
while {[next-op-is .OP rest]} {
- switch -exact [llength $rest] {
- 3 { foreach {switch name class} $rest { break } }
+ switch -exact -- [llength $rest] {
+ 3 {
+ lassign $rest switch name class
+ }
5 {
set switch [lrange $rest 0 2]
set name [lindex $rest 3]
@@ -557,12 +569,13 @@ proc output-widget-options {rest} {
fatal "bad .OP $rest"
}
}
- if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch all oswitch switch cswitch]} {
- if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} {
+ 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"
}
+ set switch "$switch1$cswitch or $oswitch$switch2"
}
if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} {
error "not Name: $name"
@@ -575,6 +588,30 @@ proc output-widget-options {rest} {
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>
@@ -604,7 +641,7 @@ proc output-RS-list {} {
set line [next-text]
if {[is-a-directive $line]} {
split-directive $line code rest
- switch -exact $code {
+ switch -exact -- $code {
.RE {
break
}
@@ -641,7 +678,7 @@ proc output-IP-list {context code rest} {
man-puts "<P>"
continue
}
- if {[lsearch -exact {.br .DS .RS} $code] >= 0} {
+ if {$code in {.br .DS .RS}} {
output-directive $line
} else {
backup-text 1
@@ -667,7 +704,7 @@ proc output-IP-list {context code rest} {
set line [next-text]
if {[is-a-directive $line]} {
split-directive $line code rest
- switch -exact $code {
+ switch -exact -- $code {
.IP {
if {$accept_RE} {
output-IP-list .IP $code $rest
@@ -798,15 +835,17 @@ proc cross-reference {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} {
+ 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 {[lsearch -exact {stdin stdout stderr end} $lref] >= 0} {
+ if {$lref in {stdin stdout stderr end}} {
# no good place to send these
# tcl tokens?
# also end
@@ -817,7 +856,7 @@ proc cross-reference {ref} {
## would be a self reference
##
foreach name $manual(name-$lref) {
- if {[lsearch -exact $name $manual(wing-file)/$manual(name)] >= 0} {
+ if {"$manual(wing-file)/$manual(name)" in $name} {
return $ref
}
}
@@ -830,11 +869,11 @@ proc cross-reference {ref} {
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"} {
+ || $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"} {
+ || $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} {
@@ -846,7 +885,7 @@ proc cross-reference {ref} {
##
## exceptions, sigh, to the rule
##
- switch $manual(tail) {
+ switch -exact -- $manual(tail) {
canvas.n {
if {$lref eq "focus"} {
upvar 1 tail tail
@@ -855,48 +894,47 @@ proc cross-reference {ref} {
return $ref
}
}
- if {[lsearch -exact {bitmap image text} $lref] >= 0} {
+ if {$lref in {bitmap image text}} {
return $ref
}
}
- checkbutton.n -
- radiobutton.n {
- if {[lsearch -exact {image} $lref] >= 0} {
+ checkbutton.n - radiobutton.n {
+ if {$lref in {image}} {
return $ref
}
}
menu.n {
- if {[lsearch -exact {checkbutton radiobutton} $lref] >= 0} {
+ if {$lref in {checkbutton radiobutton}} {
return $ref
}
}
options.n {
- if {[lsearch -exact {bitmap image set} $lref] >= 0} {
+ if {$lref in {bitmap image set}} {
return $ref
}
}
regexp.n {
- if {[lsearch -exact {string} $lref] >= 0} {
+ if {$lref in {string}} {
return $ref
}
}
source.n {
- if {[lsearch -exact {text} $lref] >= 0} {
+ if {$lref in {text}} {
return $ref
}
}
history.n {
- if {[lsearch -exact {exec} $lref] >= 0} {
+ if {$lref in {exec}} {
return $ref
}
}
return.n {
- if {[lsearch -exact {error continue break} $lref] >= 0} {
+ if {$lref in {error continue break}} {
return $ref
}
}
scrollbar.n {
- if {[lsearch -exact {set} $lref] >= 0} {
+ if {$lref in {set}} {
return $ref
}
}
@@ -965,7 +1003,7 @@ proc insert-cross-references {text} {
##
## see which we want to use
##
- switch -exact $invert([lindex $offsets 0]) {
+ switch -exact -- $invert([lindex $offsets 0]) {
anchor {
if {$offset(end-anchor) < 0} {
return [reference-error {Missing end anchor} $text]
@@ -978,13 +1016,13 @@ proc insert-cross-references {text} {
if {$offset(end-quote) < 0} {
return [reference-error "Missing end quote" $text]
}
- if {$invert([lindex $offsets 1]) == "tk"} {
+ if {$invert([lindex $offsets 1]) eq "tk"} {
set offsets [lreplace $offsets 1 1]
}
- if {$invert([lindex $offsets 1]) == "tcl"} {
+ if {$invert([lindex $offsets 1]) eq "tcl"} {
set offsets [lreplace $offsets 1 1]
}
- switch -exact $invert([lindex $offsets 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}] \
@@ -1005,14 +1043,16 @@ proc insert-cross-references {text} {
return [reference-error "Uncaught quote case" $text]
}
bold {
- if {$offset(end-bold) < 0} { return $text }
- if {$invert([lindex $offsets 1]) == "tk"} {
+ 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]) == "tcl"} {
+ if {$invert([lindex $offsets 1]) eq "tcl"} {
set offsets [lreplace $offsets 1 1]
}
- switch -exact $invert([lindex $offsets 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}] \
@@ -1069,7 +1109,7 @@ proc output-directive {line} {
global manual
# process format directive
split-directive $line code rest
- switch -exact $code {
+ switch -exact -- $code {
.BS - .BE {
# man-puts <HR>
}
@@ -1087,9 +1127,9 @@ proc output-directive {line} {
}
# some sections can simply free wheel their way through the text
# some sections can be processed in their own loops
- switch -exact $manual(section) {
+ switch -exact -- $manual(section) {
NAME {
- if {[lsearch -exact {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} {
+ 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
@@ -1111,15 +1151,19 @@ proc output-directive {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]} {
+ 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]} {
+ 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
}
@@ -1132,12 +1176,11 @@ proc output-directive {line} {
manerror "in SYNOPSIS found $more"
backup-text 1
break
- } else {
- foreach more [split $more \n] {
- man-puts $more<BR>
- if {[lsearch -exact {TclLib TkLib} $manual(wing-file)] < 0} {
- lappend manual(section-toc) <DD>$more
- }
+ }
+ foreach more [split $more \n] {
+ man-puts $more<BR>
+ if {$manual(wing-file) in {TclLib TkLib}} {
+ lappend manual(section-toc) <DD>$more
}
}
}
@@ -1253,7 +1296,7 @@ proc output-directive {line} {
}
.DS {
if {[next-op-is .ta rest]} {
-
+ # ???
}
if {[match-text @stuff .DE]} {
man-puts <PRE>$stuff</PRE>
@@ -1266,7 +1309,7 @@ proc output-directive {line} {
}
.CS {
if {[next-op-is .ta rest]} {
-
+ # ???
}
if {[match-text @stuff .CE]} {
man-puts <PRE>$stuff</PRE>
@@ -1284,7 +1327,7 @@ proc output-directive {line} {
}
.ta {
# these are tab stop settings for short tables
- switch -exact $manual(name):$manual(section) {
+ switch -exact -- $manual(name):$manual(section) {
{bind:MODIFIERS} -
{bind:EVENT TYPES} -
{bind:BINDING SCRIPTS AND SUBSTITUTIONS} -
@@ -1399,7 +1442,7 @@ proc merge-copyrights {l1 l2} {
}
foreach who [array names dates] {
set list [lsort -dictionary $dates($who)]
- if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} {
+ 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"
@@ -1415,6 +1458,21 @@ proc makedirhier {dir} {
}
}
+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
@@ -1433,13 +1491,17 @@ proc make-man-pages {html args} {
set manual(merge-copyrights) {}
foreach arg $args {
# preprocess to set up subheader for the rest of the files
- if {![llength $arg]} { continue }
+ 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 }
+ 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]
@@ -1453,8 +1515,7 @@ proc make-man-pages {html args} {
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]"]
+ $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
@@ -1463,19 +1524,21 @@ proc make-man-pages {html args} {
set manual(long-toc-n) 1
# get the manual pages for this section
set manual(pages) [lsort -dictionary [glob $manual(wing-glob)]]
- if {[set n [lsearch -glob $manual(pages) */options.n]] >= 0} {
+ 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) {
+ 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 {[lsearch -exact {case pack-old menubar} $manual(name)] >= 0} {
+ if {$manual(name) in {case pack-old menubar}} {
# obsolete
manerror "discarding $manual(name)"
continue
@@ -1503,164 +1566,151 @@ proc make-man-pages {html args} {
# comment
continue
}
- if {"$line" == {'}} {
+ if {"$line" eq {'}} {
# comment
continue
}
- if {[parse-directive $line code rest]} {
- switch -exact $code {
- .ad - .na - .so - .ne - .AS - .VE - .VS -
- . {
- # ignore
- 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]"
}
- if {"$manual(partial-text)" != {}} {
- lappend manual(text) [process-text $manual(partial-text)]
- set manual(partial-text) {}
+ .TH {
+ flushbuffer
+ lappend manual(text) "$code [unquote $rest]"
}
- 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]"
- }
- .QW {
- set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
- set s $LQ[unquote [lindex $rest 0]]$RQ[unquote [lindex $rest 1]]
- if {$manual(partial-text) == ""} {
- set manual(partial-text) $s
- } else {
- append manual(partial-text) \n$s
- }
- }
- .PQ {
- set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
- set s ($LQ[unquote [lindex $rest 0]]$RQ[unquote [lindex $rest 1]])[unquote [lindex $rest 2]]
- if {$manual(partial-text) == ""} {
- set manual(partial-text) $s
- } else {
- append manual(partial-text) \n$s
- }
- }
- .QR {
- set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
- set s $LQ[unquote [lindex $rest 0]]-[unquote [lindex $rest 1]]$RQ[unquote [lindex $rest 2]]
- if {$manual(partial-text) == ""} {
- set manual(partial-text) $s
- } else {
- append manual(partial-text) \n$s
- }
- }
- .MT {
- set s $LQ$RQ
- if {$manual(partial-text) == ""} {
- set manual(partial-text) $s
- } else {
- append manual(partial-text) \n$s
- }
- }
- .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
+ .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"
}
- .CS {
- incr manual(.CS)
- lappend manual(text) $code
+ 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"
}
- .CE {
- incr manual(.CS) -1
- lappend manual(text) $code
+ if {"$next" ne {'}} {
+ lappend manual(text) ".IP [process-text $next]"
}
- .de {
- while {[gets $manual(infp) line] >= 0} {
- if {[string match "..*" $line]} {
- break
- }
+ }
+ .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 {
- manerror "unrecognized format directive: $line"
- }
}
- } else {
- if {$manual(partial-text) == ""} {
- set manual(partial-text) $line
- } else {
- append manual(partial-text) \n$line
+ .. {
+ error "found .. outside of .de"
+ }
+ default {
+ flushbuffer
+ manerror "unrecognized format directive: $line"
}
}
}
- if {$manual(partial-text) != ""} {
- lappend manual(text) [process-text $manual(partial-text)]
- }
+ flushbuffer
close $manual(infp)
# fixups
if {$manual(.RS) != 0} {
- if {$manual(name) != "selection"} {
- puts "unbalanced .RS .RE"
- }
+ puts "unbalanced .RS .RE"
}
if {$manual(.DS) != 0} {
puts "unbalanced .DS .DE"
@@ -1764,7 +1814,9 @@ proc make-man-pages {html args} {
puts $keyfp $keyheader
foreach a $letters {
set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
- if {![llength $keys]} { continue }
+ if {![llength $keys]} {
+ continue
+ }
# Per-keyword page
set afp [open $html/Keywords/$a.htm w]
puts $afp [htmlhead "$tcltkdesc Keywords - $a" \
@@ -1828,14 +1880,15 @@ proc make-man-pages {html args} {
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)) || [lsearch -exact {
- Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType
- CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash
- GetJustify GetPixels GetVisual ParseArgv QueueEvent
- } $manual(tail)] >= 0} {
+ $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
}
--
cgit v0.12