From a9cb09e63d7fc8f8409872ca6e6830a452385c09 Mon Sep 17 00:00:00 2001 From: dkf 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 + + * 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 * generic/tclUtil.c (Tcl_ConcatObj): optimise for some of the concatenees being empty objs [Bug 1447328] - + 2007-10-28 Donal K. Fellows * 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\2\\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 "
Database Class: $oclass$class$cclass" man-puts
[next-text] set para

+ + 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 lappend manual(section-toc) @@ -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 "

" 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 "$ref" } } - 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 "$ref" } if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd" - || $manual(wing-file) eq "TkLib"} { + || $manual(wing-file) eq "TkLib"} { return "$ref" } 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

} @@ -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)
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
- if {[lsearch -exact {TclLib TkLib} $manual(wing-file)] < 0} { - lappend manual(section-toc)
$more - } + } + foreach more [split $more \n] { + man-puts $more
+ if {$manual(wing-file) in {TclLib TkLib}} { + lappend manual(section-toc)
$more } } } @@ -1253,7 +1296,7 @@ proc output-directive {line} { } .DS { if {[next-op-is .ta rest]} { - + # ??? } if {[match-text @stuff .DE]} { man-puts 
$stuff
@@ -1266,7 +1309,7 @@ proc output-directive {line} { } .CS { if {[next-op-is .ta rest]} { - + # ??? } if {[match-text @stuff .CE]} { man-puts 
$stuff
@@ -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) "
$manual(wing-name)
$manual(wing-description)
" # 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