tcl/tools/tcltk-man2html.tcl

   1 #!/bin/sh
   2 # The next line is executed by /bin/sh, but not tcl \
   3 exec tclsh8.2 "$0" ${1+"$@"}
   4
   5 package require Tcl 8.2
   6
   7 # Convert Ousterhout format man pages into highly crosslinked
   8 # hypertext.
   9 #
  10 # Along the way detect many unmatched font changes and other odd
  11 # things.
  12 #
  13 # Note well, this program is a hack rather than a piece of software
  14 # engineering.  In that sense it's probably a good example of things
  15 # that a scripting language, like Tcl, can do well.  It is offered as
  16 # an example of how someone might convert a specific set of man pages
  17 # into hypertext, not as a general solution to the problem.  If you
  18 # try to use this, you'll be very much on your own.
  19 #
  20 # Copyright (c) 1995-1997 Roger E. Critchlow Jr
  21 #
  22 # The authors hereby grant permission to use, copy, modify, distribute,
  23 # and license this software and its documentation for any purpose, provided
  24 # that existing copyright notices are retained in all copies and that this
  25 # notice is included verbatim in any distributions. No written agreement,
  26 # license, or royalty fee is required for any of the authorized uses.
  27 # Modifications to this software may be copyrighted by their authors
  28 # and need not follow the licensing terms described here, provided that
  29 # the new terms are clearly indicated on the first page of each file where
  30 # they apply.
  31 #
  32 # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
  33 # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
  34 # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
  35 # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
  36 # POSSIBILITY OF SUCH DAMAGE.
  37 #
  38 # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
  39 # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
  40 # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
  41 # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
  42 # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
  43 # MODIFICATIONS.
  44 #
  45 # Revisions:
  46 #  May 15, 1995 - initial release
  47 #  May 16, 1995 - added a back to home link to toplevel table of
  48 #       contents.
  49 #  May 18, 1995 - broke toplevel table of contents into separate
  50 #       pages for each section, and broke long table of contents
  51 #       into a one page for each man page.
  52 #  Mar 10, 1996 - updated for tcl7.5b3/tk4.1b3
  53 #  Apr 14, 1996 - incorporated command line parsing from Tom Tromey,
  54 #                 <tromey@creche.cygnus.com> -- thanks Tom.
  55 #               - updated for tcl7.5/tk4.1 final release.
  56 #               - converted to same copyright as the man pages.
  57 #  Sep 14, 1996 - made various modifications for tcl7.6b1/tk4.2b1
  58 #  Oct 18, 1996 - added tcl7.6/tk4.2 to the list of distributions.
  59 #  Oct 22, 1996 - major hacking on indentation code and elsewhere.
  60 #  Mar  4, 1997 -
  61 #  May 28, 1997 - added tcl8.0b1/tk8.0b1 to the list of distributions
  62 #               - cleaned source for tclsh8.0 execution
  63 #               - renamed output files for windoze installation
  64 #               - added spaces to tables
  65 #  Oct 24, 1997 - moved from 8.0b1 to 8.0 release
  66 #
  67
  68 set Version "0.30"
  69
  70 proc parse_command_line {} {
  71     global argv Version
  72
  73     # These variables determine where the man pages come from and where
  74     # the converted pages go to.
  75     global tcltkdir tkdir tcldir webdir
  76
  77     # Set defaults based on original code.
  78     set tcltkdir ../..
  79     set tkdir {}
  80     set tcldir {}
  81     set webdir ../html
  82
  83     # Directory names for Tcl and Tk, in priority order.
  84     set tclDirList {tcl8.4 tcl8.3 tcl8.2 tcl8.1 tcl8.0 tcl}
  85     set tkDirList {tk8.4 tk8.3 tk8.2 tk8.1 tk8.0 tk}
  86
  87     # Handle arguments a la GNU:
  88     #   --version
  89     #   --help
  90     #   --srcdir=/path
  91     #   --htmldir=/path
  92
  93     foreach option $argv {
  94         switch -glob -- $option {
  95             --version {
  96                 puts "tcltk-man-html $Version"
  97                 exit 0
  98             }
  99
 100             --help {
 101                 puts "usage: tcltk-man-html \[OPTION\] ...\n"
 102                 puts "  --help              print this help, then exit"
 103                 puts "  --version           print version number, then exit"
 104                 puts "  --srcdir=DIR        find tcl and tk source below DIR"
 105                 puts "  --htmldir=DIR       put generated HTML in DIR"
 106                 exit 0
 107             }
 108
 109             --srcdir=* {
 110                 # length of "--srcdir=" is 9.
 111                 set tcltkdir [string range $option 9 end]
 112             }
 113
 114             --htmldir=* {
 115                 # length of "--htmldir=" is 10
 116                 set webdir [string range $option 10 end]
 117             }
 118
 119             default {
 120                 puts stderr "tcltk-man-html: unrecognized option -- `$option'"
 121                 exit 1
 122             }
 123         }
 124     }
 125
 126     # Find Tcl.
 127     foreach dir $tclDirList {
 128         if {[file isdirectory $tcltkdir/$dir]} then {
 129             set tcldir $dir
 130             break
 131         }
 132     }
 133     if {$tcldir == ""} then {
 134         puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
 135         exit 1
 136     }
 137
 138     # Find Tk.
 139     foreach dir $tkDirList {
 140         if {[file isdirectory $tcltkdir/$dir]} then {
 141             set tkdir $dir
 142             break
 143         }
 144     }
 145     if {$tkdir == ""} then {
 146         puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
 147         exit 1
 148     }
 149
 150     # the title for the man pages overall
 151     global overall_title
 152     set overall_title "[capitalize $tcldir]/[capitalize $tkdir] Manual"
 153 }
 154
 155 proc capitalize {string} {
 156     return [string toupper $string 0]
 157 }
 158
 159 ##
 160 ##
 161 ##
 162 set manual(report-level) 1
 163
 164 proc manerror {msg} {
 165     global manual
 166     set name {}
 167     set subj {}
 168     if {[info exists manual(name)]} {
 169         set name $manual(name)
 170     }
 171     if {[info exists manual(section)] && [string length $manual(section)]} {
 172         puts stderr "$name: $manual(section):  $msg"
 173     } else {
 174         puts stderr "$name: $msg"
 175     }
 176 }
 177
 178 proc manreport {level msg} {
 179     global manual
 180     if {$level < $manual(report-level)} {
 181         manerror $msg
 182     }
 183 }
 184
 185 proc fatal {msg} {
 186     global manual
 187     manerror $msg
 188     exit 1
 189 }
 190 ##
 191 ## parsing
 192 ##
 193 proc unquote arg {
 194     return [string map [list \" {}] $arg]
 195 }
 196
 197 proc parse-directive {line codename restname} {
 198     upvar $codename code $restname rest
 199     return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]
 200 }
 201
 202 proc process-text {text} {
 203     global manual
 204     # preprocess text
 205     set text [string map [list \
 206             {\&}        "\t" \
 207             {&}         {&amp;} \
 208             {\\}        {&#92;} \
 209             {\e}        {&#92;} \
 210             {\ }        {&nbsp;} \
 211             {\|}        {&nbsp;} \
 212             {\0}        { } \
 213             {\%}        {} \
 214             "\\\n"      "\n" \
 215             \"          {&quot;} \
 216             {<}         {&lt;} \
 217             {>}         {&gt;} \
 218             {\(+-}      {&#177;} \
 219             {\fP}       {\fR} \
 220             {\.}        . \
 221             ] $text]
 222     regsub -all {\\o'o\^'} $text {\&ocirc;} text; # o-circumflex in re_syntax.n
 223     regsub -all {\\-\\\|\\-} $text -- text;     # two hyphens
 224     regsub -all -- {\\-\\\^\\-} $text -- text;  # two hyphens
 225     regsub -all {\\-} $text - text;             # a hyphen
 226     regsub -all "\\\\\n" $text "\\&#92;\n" text; # backslashed newline
 227     while {[string first "\\" $text] >= 0} {
 228         # C R
 229         if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \
 230                 {\1<TT>\2</TT>\3} text]} continue
 231         # B R
 232         if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
 233                 {\1<B>\2</B>\3} text]} continue
 234         # B I
 235         if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
 236                 {\1<B>\2</B>\\fI\3} text]} continue
 237         # I R
 238         if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
 239                 {\1<I>\2</I>\3} text]} continue
 240         # I B
 241         if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
 242                 {\1<I>\2</I>\\fB\3} text]} continue
 243         # B B, I I, R R
 244         if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
 245                 {\1\\fB\2\3} ntext]
 246             || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \
 247                     {\1\\fI\2\3} ntext]
 248             || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \
 249                     {\1\\fR\2\3} ntext]} {
 250             manerror "process-text: impotent font change: $text"
 251             set text $ntext
 252             continue
 253         }
 254         # unrecognized
 255         manerror "process-text: uncaught backslash: $text"
 256         set text [string map [list "\\" "#92;"] $text]
 257     }
 258     return $text
 259 }
 260 ##
 261 ## pass 2 text input and matching
 262 ##
 263 proc open-text {} {
 264     global manual
 265     set manual(text-length) [llength $manual(text)]
 266     set manual(text-pointer) 0
 267 }
 268 proc more-text {} {
 269     global manual
 270     return [expr {$manual(text-pointer) < $manual(text-length)}]
 271 }
 272 proc next-text {} {
 273     global manual
 274     if {[more-text]} {
 275         set text [lindex $manual(text) $manual(text-pointer)]
 276         incr manual(text-pointer)
 277         return $text
 278     }
 279     manerror "read past end of text"
 280     error "fatal"
 281 }
 282 proc is-a-directive {line} {
 283     return [string match .* $line]
 284 }
 285 proc split-directive {line opname restname} {
 286     upvar $opname op $restname rest
 287     set op [string range $line 0 2]
 288     set rest [string trim [string range $line 3 end]]
 289 }
 290 proc next-op-is {op restname} {
 291     global manual
 292     upvar $restname rest
 293     if {[more-text]} {
 294         set text [lindex $manual(text) $manual(text-pointer)]
 295         if {[string equal -length 3 $text $op]} {
 296             set rest [string range $text 4 end]
 297             incr manual(text-pointer)
 298             return 1
 299         }
 300     }
 301     return 0
 302 }
 303 proc backup-text {n} {
 304     global manual
 305     if {$manual(text-pointer)-$n >= 0} {
 306         incr manual(text-pointer) -$n
 307     }
 308 }
 309 proc match-text args {
 310     global manual
 311     set nargs [llength $args]
 312     if {$manual(text-pointer) + $nargs > $manual(text-length)} {
 313         return 0
 314     }
 315     set nback 0
 316     foreach arg $args {
 317         if {![more-text]} {
 318             backup-text $nback
 319             return 0
 320         }
 321         set arg [string trim $arg]
 322         set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
 323         if {[string equal $arg $targ]} {
 324             incr nback
 325             incr manual(text-pointer)
 326             continue
 327         }
 328         if {[regexp {^@(\w+)$} $arg all name]} {
 329             upvar $name var
 330             set var $targ
 331             incr nback
 332             incr manual(text-pointer)
 333             continue
 334         }
 335         if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\
 336                 && [string equal $op [lindex $targ 0]]} {
 337             upvar $name var
 338             set var [lrange $targ 1 end]
 339             incr nback
 340             incr manual(text-pointer)
 341             continue
 342         }
 343         backup-text $nback
 344         return 0
 345     }
 346     return 1
 347 }
 348 proc expand-next-text {n} {
 349     global manual
 350     return [join [lrange $manual(text) $manual(text-pointer) \
 351             [expr {$manual(text-pointer)+$n-1}]] \n\n]
 352 }
 353 ##
 354 ## pass 2 output
 355 ##
 356 proc man-puts {text} {
 357     global manual
 358     lappend manual(output-$manual(wing-file)-$manual(name)) $text
 359 }
 360
 361 ##
 362 ## build hypertext links to tables of contents
 363 ##
 364 proc long-toc {text} {
 365     global manual
 366     set here M[incr manual(section-toc-n)]
 367     set there L[incr manual(long-toc-n)]
 368     lappend manual(section-toc) \
 369             "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
 370     return "<A NAME=\"$here\">$text</A>"
 371 }
 372 proc option-toc {name class switch} {
 373     global manual
 374     if {[string equal $manual(section) "WIDGET-SPECIFIC OPTIONS"]} {
 375         # link the defined option into the long table of contents
 376         set link [long-toc "$switch, $name, $class"]
 377         regsub -- "$switch, $name, $class" $link "$switch" link
 378         return $link
 379     } elseif {[string equal $manual(name):$manual(section) \
 380             "options:DESCRIPTION"]} {
 381         # link the defined standard option to the long table of
 382         # contents and make a target for the standard option references
 383         # from other man pages.
 384         set first [lindex $switch 0]
 385         set here M$first
 386         set there L[incr manual(long-toc-n)]
 387         set manual(standard-option-$first) "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>"
 388         lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
 389         return "<A NAME=\"$here\">$switch</A>"
 390     } else {
 391         error "option-toc in $manual(name) section $manual(section)"
 392     }
 393 }
 394 proc std-option-toc {name} {
 395     global manual
 396     if {[info exists manual(standard-option-$name)]} {
 397         lappend manual(section-toc) <DD>$manual(standard-option-$name)
 398         return $manual(standard-option-$name)
 399     }
 400     set here M[incr manual(section-toc-n)]
 401     set there L[incr manual(long-toc-n)]
 402     set other M$name
 403     lappend manual(section-toc) "<DD><A HREF=\"options.htm#$other\">$name</A>"
 404     return "<A HREF=\"options.htm#$other\">$name</A>"
 405 }
 406 ##
 407 ## process the widget option section
 408 ## in widget and options man pages
 409 ##
 410 proc output-widget-options {rest} {
 411     global manual
 412     man-puts <DL>
 413     lappend manual(section-toc) <DL>
 414     backup-text 1
 415     set para {}
 416     while {[next-op-is .OP rest]} {
 417         switch -exact [llength $rest] {
 418             3 { foreach {switch name class} $rest { break } }
 419             5 {
 420                 set switch [lrange $rest 0 2]
 421                 set name [lindex $rest 3]
 422                 set class [lindex $rest 4]
 423             }
 424             default {
 425                 fatal "bad .OP $rest"
 426             }
 427         }
 428         if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch all oswitch switch cswitch]} {
 429             if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} {
 430                 error "not Switch: $switch"
 431             } else {
 432                 set switch "$switch1$cswitch or $oswitch$switch2"
 433             }
 434         }
 435         if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} {
 436             error "not Name: $name"
 437         }
 438         if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} {
 439             error "not Class: $class"
 440         }
 441         man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
 442         man-puts "<DT>Database Name: $oname$name$cname"
 443         man-puts "<DT>Database Class: $oclass$class$cclass"
 444         man-puts <DD>[next-text]
 445         set para <P>
 446     }
 447     man-puts </DL>
 448     lappend manual(section-toc) </DL>
 449 }
 450
 451 ##
 452 ## process .RS lists
 453 ##
 454 proc output-RS-list {} {
 455     global manual
 456     if {[next-op-is .IP rest]} {
 457         output-IP-list .RS .IP $rest
 458         if {[match-text .RE .sp .RS @rest .IP @rest2]} {
 459             man-puts <P>$rest
 460             output-IP-list .RS .IP $rest2
 461         }
 462         if {[match-text .RE .sp .RS @rest .RE]} {
 463             man-puts <P>$rest
 464             return
 465         }
 466         if {[next-op-is .RE rest]} {
 467             return
 468         }
 469     }
 470     man-puts <DL><P><DD>
 471     while {[more-text]} {
 472         set line [next-text]
 473         if {[is-a-directive $line]} {
 474             split-directive $line code rest
 475             switch -exact $code {
 476                 .RE {
 477                     break
 478                 }
 479                 .SH {
 480                     manerror "unbalanced .RS at section end"
 481                     backup-text 1
 482                     break
 483                 }
 484                 default {
 485                     output-directive $line
 486                 }
 487             }
 488         } else {
 489             man-puts $line
 490         }
 491     }
 492     man-puts </DL>
 493 }
 494
 495 ##
 496 ## process .IP lists which may be plain indents,
 497 ## numeric lists, or definition lists
 498 ##
 499 proc output-IP-list {context code rest} {
 500     global manual
 501     if {![string length $rest]} {
 502         # blank label, plain indent, no contents entry
 503         man-puts <DL><P><DD>
 504         while {[more-text]} {
 505             set line [next-text]
 506             if {[is-a-directive $line]} {
 507                 split-directive $line code rest
 508                 if {[string equal $code ".IP"] && [string equal $rest {}]} {
 509                     man-puts "<P>"
 510                     continue
 511                 }
 512                 if {[lsearch {.br .DS .RS} $code] >= 0} {
 513                     output-directive $line
 514                 } else {
 515                     backup-text 1
 516                     break
 517                 }
 518             } else {
 519                 man-puts $line
 520             }
 521         }
 522         man-puts </DL>
 523     } else {
 524         # labelled list, make contents
 525         if {[string compare $context ".SH"]} {
 526             man-puts <P>
 527         }
 528         man-puts <DL>
 529         lappend manual(section-toc) <DL>
 530         backup-text 1
 531         set accept_RE 0
 532         while {[more-text]} {
 533             set line [next-text]
 534             if {[is-a-directive $line]} {
 535                 split-directive $line code rest
 536                 switch -exact $code {
 537                     .IP {
 538                         if {$accept_RE} {
 539                             output-IP-list .IP $code $rest
 540                             continue
 541                         }
 542                         if {[string equal $manual(section) "ARGUMENTS"] || \
 543                                 [regexp {^\[\d+\]$} $rest]} {
 544                             man-puts "<P><DT>$rest<DD>"
 545                         } else {
 546                             man-puts "<P><DT>[long-toc $rest]<DD>"
 547                         }
 548                         if {[string equal $manual(name):$manual(section) \
 549                                 "selection:DESCRIPTION"]} {
 550                             if {[match-text .RE @rest .RS .RS]} {
 551                                 man-puts <DT>[long-toc $rest]<DD>
 552                             }
 553                         }
 554                     }
 555                     .sp -
 556                     .br -
 557                     .DS -
 558                     .CS {
 559                         output-directive $line
 560                     }
 561                     .RS {
 562                         if {[match-text .RS]} {
 563                             output-directive $line
 564                             incr accept_RE 1
 565                         } elseif {[match-text .CS]} {
 566                             output-directive .CS
 567                             incr accept_RE 1
 568                         } elseif {[match-text .PP]} {
 569                             output-directive .PP
 570                             incr accept_RE 1
 571                         } elseif {[match-text .DS]} {
 572                             output-directive .DS
 573                             incr accept_RE 1
 574                         } else {
 575                             output-directive $line
 576                         }
 577                     }
 578                     .PP {
 579                         if {[match-text @rest1 .br @rest2 .RS]} {
 580                             # yet another nroff kludge as above
 581                             man-puts "<P><DT>[long-toc $rest1]"
 582                             man-puts "<DT>[long-toc $rest2]<DD>"
 583                             incr accept_RE 1
 584                         } elseif {[match-text @rest .RE]} {
 585                             # gad, this is getting ridiculous
 586                             if {!$accept_RE} {
 587                                 man-puts "</DL><P>$rest<DL>"
 588                                 backup-text 1
 589                                 break
 590                             } else {
 591                                 man-puts "<P>$rest"
 592                                 incr accept_RE -1
 593                             }
 594                         } elseif {$accept_RE} {
 595                             output-directive $line
 596                         } else {
 597                             backup-text 1
 598                             break
 599                         }
 600                     }
 601                     .RE {
 602                         if {!$accept_RE} {
 603                             backup-text 1
 604                             break
 605                         }
 606                         incr accept_RE -1
 607                     }
 608                     default {
 609                         backup-text 1
 610                         break
 611                     }
 612                 }
 613             } else {
 614                 man-puts $line
 615             }
 616         }
 617         man-puts <P></DL>
 618         lappend manual(section-toc) </DL>
 619         if {$accept_RE} {
 620             manerror "missing .RE in output-IP-list"
 621         }
 622     }
 623 }
 624 ##
 625 ## handle the NAME section lines
 626 ## there's only one line in the NAME section,
 627 ## consisting of a comma separated list of names,
 628 ## followed by a hyphen and a short description.
 629 ##
 630 proc output-name {line} {
 631     global manual
 632     # split name line into pieces
 633     regexp {^([^-]+) - (.*)$} $line all head tail
 634     # output line to manual page untouched
 635     man-puts $line
 636     # output line to long table of contents
 637     lappend manual(section-toc) <DL><DD>$line</DL>
 638     # separate out the names for future reference
 639     foreach name [split $head ,] {
 640         set name [string trim $name]
 641         if {[llength $name] > 1} {
 642             manerror "name has a space: {$name}\nfrom: $line"
 643         }
 644         lappend manual(wing-toc) $name
 645         lappend manual(name-$name) $manual(wing-file)/$manual(name)
 646     }
 647 }
 648 ##
 649 ## build a cross-reference link if appropriate
 650 ##
 651 proc cross-reference {ref} {
 652     global manual
 653     if {[string match Tcl_* $ref]} {
 654         set lref $ref
 655     } elseif {[string match Tk_* $ref]} {
 656         set lref $ref
 657     } elseif {[string equal $ref "Tcl"]} {
 658         set lref $ref
 659     } else {
 660         set lref [string tolower $ref]
 661     }
 662     ##
 663     ## nothing to reference
 664     ##
 665     if {![info exists manual(name-$lref)]} {
 666         foreach name {array file history info interp string trace
 667         after clipboard grab image option pack place selection tk tkwait update winfo wm} {
 668             if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
 669                     [string compare $manual(tail) "$name.n"]} {
 670                 return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
 671             }
 672         }
 673         if {[lsearch {stdin stdout stderr end} $lref] >= 0} {
 674             # no good place to send these
 675             # tcl tokens?
 676             # also end
 677         }
 678         return $ref
 679     }
 680     ##
 681     ## would be a self reference
 682     ##
 683     foreach name $manual(name-$lref) {
 684         if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} {
 685             return $ref
 686         }
 687     }
 688     ##
 689     ## multiple choices for reference
 690     ##
 691     if {[llength $manual(name-$lref)] > 1} {
 692         set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]
 693         set tcl_ref [lindex $manual(name-$lref) $tcl_i]
 694         set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
 695         set tk_ref [lindex $manual(name-$lref) $tk_i]
 696         if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} \
 697                 ||  "$manual(wing-file)" == {TclLib}} {
 698             return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
 699         }
 700         if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} \
 701                 || "$manual(wing-file)" == {TkLib}} {
 702             return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
 703         }
 704         if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} {
 705             return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
 706         }
 707         puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"
 708         return $ref
 709     }
 710     ##
 711     ## exceptions, sigh, to the rule
 712     ##
 713     switch $manual(tail) {
 714         canvas.n {
 715             if {$lref == {focus}} {
 716                 upvar tail tail
 717                 set clue [string first command $tail]
 718                 if {$clue < 0 ||  $clue > 5} {
 719                     return $ref
 720                 }
 721             }
 722             if {[lsearch {bitmap image text} $lref] >= 0} {
 723                 return $ref
 724             }
 725         }
 726         checkbutton.n -
 727         radiobutton.n {
 728             if {[lsearch {image} $lref] >= 0} {
 729                 return $ref
 730             }
 731         }
 732         menu.n {
 733             if {[lsearch {checkbutton radiobutton} $lref] >= 0} {
 734                 return $ref
 735             }
 736         }
 737         options.n {
 738             if {[lsearch {bitmap image set} $lref] >= 0} {
 739                 return $ref
 740             }
 741         }
 742         regexp.n {
 743             if {[lsearch {string} $lref] >= 0} {
 744                 return $ref
 745             }
 746         }
 747         source.n {
 748             if {[lsearch {text} $lref] >= 0} {
 749                 return $ref
 750             }
 751         }
 752         history.n {
 753             if {[lsearch {exec} $lref] >= 0} {
 754                 return $ref
 755             }
 756         }
 757         return.n {
 758             if {[lsearch {error continue break} $lref] >= 0} {
 759                 return $ref
 760             }
 761         }
 762         scrollbar.n {
 763             if {[lsearch {set} $lref] >= 0} {
 764                 return $ref
 765             }
 766         }
 767     }
 768     ##
 769     ## return the cross reference
 770     ##
 771     return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"
 772 }
 773 ##
 774 ## reference generation errors
 775 ##
 776 proc reference-error {msg text} {
 777     global manual
 778     puts stderr "$manual(tail): $msg: {$text}"
 779     return $text
 780 }
 781 ##
 782 ## insert as many cross references into this text string as are appropriate
 783 ##
 784 proc insert-cross-references {text} {
 785     global manual
 786     ##
 787     ## we identify cross references by:
 788     ##     ``quotation''
 789     ##    <B>emboldening</B>
 790     ##    Tcl_ prefix
 791     ##    Tk_ prefix
 792     ##    [a-zA-Z0-9]+ manual entry
 793     ## and we avoid messing with already anchored text
 794     ##
 795     ##
 796     ## find where each item lives
 797     ##
 798     array set offset [list \
 799             anchor [string first {<A } $text] \
 800             end-anchor [string first {</A>} $text] \
 801             quote [string first {``} $text] \
 802             end-quote [string first {''} $text] \
 803             bold [string first {<B>} $text] \
 804             end-bold [string first {</B>} $text] \
 805             tcl [string first {Tcl_} $text] \
 806             tk [string first {Tk_} $text] \
 807             Tcl1 [string first {Tcl manual entry} $text] \
 808             Tcl2 [string first {Tcl overview manual entry} $text] \
 809             ]
 810     ##
 811     ## accumulate a list
 812     ##
 813     foreach name [array names offset] {
 814         if {$offset($name) >= 0} {
 815             set invert($offset($name)) $name
 816             lappend offsets $offset($name)
 817         }
 818     }
 819     ##
 820     ## if nothing, then we're done.
 821     ##
 822     if {![info exists offsets]} {
 823         return $text
 824     }
 825     ##
 826     ## sort the offsets
 827     ##
 828     set offsets [lsort -integer $offsets]
 829     ##
 830     ## see which we want to use
 831     ##
 832     switch -exact $invert([lindex $offsets 0]) {
 833         anchor {
 834             if {$offset(end-anchor) < 0} {
 835                 return [reference-error {Missing end anchor} $text]
 836             }
 837             set head [string range $text 0 $offset(end-anchor)]
 838             set tail [string range $text [expr {$offset(end-anchor)+1}] end]
 839             return $head[insert-cross-references $tail]
 840         }
 841         quote {
 842             if {$offset(end-quote) < 0} {
 843                 return [reference-error "Missing end quote" $text]
 844             }
 845             if {$invert([lindex $offsets 1]) == "tk"} {
 846                 set offsets [lreplace $offsets 1 1]
 847             }
 848             if {$invert([lindex $offsets 1]) == "tcl"} {
 849                 set offsets [lreplace $offsets 1 1]
 850             }
 851             switch -exact $invert([lindex $offsets 1]) {
 852                 end-quote {
 853                     set head [string range $text 0 [expr {$offset(quote)-1}]]
 854                     set body [string range $text [expr {$offset(quote)+2}] \
 855                             [expr {$offset(end-quote)-1}]]
 856                     set tail [string range $text \
 857                             [expr {$offset(end-quote)+2}] end]
 858                     return "$head``[cross-reference $body]''[insert-cross-references $tail]"
 859                 }
 860                 bold -
 861                 anchor {
 862                     set head [string range $text \
 863                             0 [expr {$offset(end-quote)+1}]]
 864                     set tail [string range $text \
 865                             [expr {$offset(end-quote)+2}] end]
 866                     return "$head[insert-cross-references $tail]"
 867                 }
 868             }
 869             return [reference-error "Uncaught quote case" $text]
 870         }
 871         bold {
 872             if {$offset(end-bold) < 0} { return $text }
 873             if {$invert([lindex $offsets 1]) == "tk"} {
 874                 set offsets [lreplace $offsets 1 1]
 875             }
 876             if {$invert([lindex $offsets 1]) == "tcl"} {
 877                 set offsets [lreplace $offsets 1 1]
 878             }
 879             switch -exact $invert([lindex $offsets 1]) {
 880                 end-bold {
 881                     set head [string range $text 0 [expr {$offset(bold)-1}]]
 882                     set body [string range $text [expr {$offset(bold)+3}] \
 883                             [expr {$offset(end-bold)-1}]]
 884                     set tail [string range $text \
 885                             [expr {$offset(end-bold)+4}] end]
 886                     return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]"
 887                 }
 888                 anchor {
 889                     set head [string range $text \
 890                             0 [expr {$offset(end-bold)+3}]]
 891                     set tail [string range $text \
 892                             [expr {$offset(end-bold)+4}] end]
 893                     return "$head[insert-cross-references $tail]"
 894                 }
 895             }
 896             return [reference-error "Uncaught bold case" $text]
 897         }
 898         tk {
 899             set head [string range $text 0 [expr {$offset(tk)-1}]]
 900             set tail [string range $text $offset(tk) end]
 901             if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} {
 902                 return [reference-error "Tk regexp failed" $text]
 903             }
 904             return $head[cross-reference $body][insert-cross-references $tail]
 905         }
 906         tcl {
 907             set head [string range $text 0 [expr {$offset(tcl)-1}]]
 908             set tail [string range $text $offset(tcl) end]
 909             if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} {
 910                 return [reference-error {Tcl regexp failed} $text]
 911             }
 912             return $head[cross-reference $body][insert-cross-references $tail]
 913         }
 914         Tcl1 -
 915         Tcl2 {
 916             set off [lindex $offsets 0]
 917             set head [string range $text 0 [expr {$off-1}]]
 918             set body Tcl
 919             set tail [string range $text [expr {$off+3}] end]
 920             return $head[cross-reference $body][insert-cross-references $tail]
 921         }
 922         end-anchor -
 923         end-bold -
 924         end-quote {
 925             return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
 926         }
 927     }
 928 }
 929 ##
 930 ## process formatting directives
 931 ##
 932 proc output-directive {line} {
 933     global manual
 934     # process format directive
 935     split-directive $line code rest
 936     switch -exact $code {
 937         .BS -
 938         .BE {
 939             # man-puts <HR>
 940         }
 941         .SH {
 942             # drain any open lists
 943             # announce the subject
 944             set manual(section) $rest
 945             # start our own stack of stuff
 946             set manual($manual(name)-$manual(section)) {}
 947             lappend manual(has-$manual(section)) $manual(name)
 948             man-puts "<H3>[long-toc $manual(section)]</H3>"
 949             # some sections can simply free wheel their way through the text
 950             # some sections can be processed in their own loops
 951             switch -exact $manual(section) {
 952                 NAME {
 953                     if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} {
 954                         # these manual pages have two NAME sections
 955                         if {[info exists manual($manual(tail)-NAME)]} {
 956                             return
 957                         }
 958                         set manual($manual(tail)-NAME) 1
 959                     }
 960                     set names {}
 961                     while {1} {
 962                         set line [next-text]
 963                         if {[is-a-directive $line]} {
 964                             backup-text 1
 965                             output-name [join $names { }]
 966                             return
 967                         } else {
 968                             lappend names [string trim $line]
 969                         }
 970                     }
 971                 }
 972                 SYNOPSIS {
 973                     lappend manual(section-toc) <DL>
 974                     while {1} {
 975                         if {[next-op-is .nf rest]
 976                          || [next-op-is .br rest]
 977                          || [next-op-is .fi rest]} {
 978                             continue
 979                         }
 980                         if {[next-op-is .SH rest]
 981                          || [next-op-is .BE rest]
 982                          || [next-op-is .SO rest]} {
 983                             backup-text 1
 984                             break
 985                         }
 986                         if {[next-op-is .sp rest]} {
 987                             #man-puts <P>
 988                             continue
 989                         }
 990                         set more [next-text]
 991                         if {[is-a-directive $more]} {
 992                             manerror "in SYNOPSIS found $more"
 993                             backup-text 1
 994                             break
 995                         } else {
 996                             foreach more [split $more \n] {
 997                                 man-puts $more<BR>
 998                                 if {[lsearch {TclLib TkLib} $manual(wing-file)] < 0} {
 999                                     lappend manual(section-toc) <DD>$more
1000                                 }
1001                             }
1002                         }
1003                     }
1004                     lappend manual(section-toc) </DL>
1005                     return
1006                 }
1007                 {SEE ALSO} {
1008                     while {[more-text]} {
1009                         if {[next-op-is .SH rest]} {
1010                             backup-text 1
1011                             return
1012                         }
1013                         set more [next-text]
1014                         if {[is-a-directive $more]} {
1015                             manerror "$more"
1016                             backup-text 1
1017                             return
1018                         }
1019                         set nmore {}
1020                         foreach cr [split $more ,] {
1021                             set cr [string trim $cr]
1022                             if {![regexp {^<B>.*</B>$} $cr]} {
1023                                 set cr <B>$cr</B>
1024                             }
1025                             if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
1026                                 set cr <B>$name</B>
1027                             }
1028                             lappend nmore $cr
1029                         }
1030                         man-puts [join $nmore {, }]
1031                     }
1032                     return
1033                 }
1034                 KEYWORDS {
1035                     while {[more-text]} {
1036                         if {[next-op-is .SH rest]} {
1037                             backup-text 1
1038                             return
1039                         }
1040                         set more [next-text]
1041                         if {[is-a-directive $more]} {
1042                             manerror "$more"
1043                             backup-text 1
1044                             return
1045                         }
1046                         set keys {}
1047                         foreach key [split $more ,] {
1048                             set key [string trim $key]
1049                             lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm]
1050                             set initial [string toupper [string index $key 0]]
1051                             lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
1052                         }
1053                         man-puts [join $keys {, }]
1054                     }
1055                     return
1056                 }
1057             }
1058             if {[next-op-is .IP rest]} {
1059                 output-IP-list .SH .IP $rest
1060                 return
1061             }
1062             if {[next-op-is .PP rest]} {
1063                 return
1064             }
1065             return
1066         }
1067         .SO {
1068             if {[match-text @stuff .SE]} {
1069                 output-directive {.SH STANDARD OPTIONS}
1070                 set opts {}
1071                 foreach line [split $stuff \n] {
1072                     foreach option [split $line \t] {
1073                         lappend opts $option
1074                     }
1075                 }
1076                 man-puts <DL>
1077                 lappend manual(section-toc) <DL>
1078                 foreach option [lsort $opts] {
1079                     man-puts "<DT><B>[std-option-toc $option]</B>"
1080                 }
1081                 man-puts </DL>
1082                 lappend manual(section-toc) </DL>
1083             } else {
1084                 manerror "unexpected .SO format:\n[expand-next-text 2]"
1085             }
1086         }
1087         .OP {
1088             output-widget-options $rest
1089             return
1090         }
1091         .IP {
1092             output-IP-list .IP .IP $rest
1093             return
1094         }
1095         .PP {
1096             man-puts <P>
1097         }
1098         .RS {
1099             output-RS-list
1100             return
1101         }
1102         .RE {
1103             manerror "unexpected .RE"
1104             return
1105         }
1106         .br {
1107             man-puts <BR>
1108             return
1109         }
1110         .DE {
1111             manerror "unexpected .DE"
1112             return
1113         }
1114         .DS {
1115             if {[next-op-is .ta rest]} {
1116
1117             }
1118             if {[match-text @stuff .DE]} {
1119                 man-puts <PRE>$stuff</PRE>
1120             } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} {
1121                 man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>"
1122             } else {
1123                 manerror "unexpected .DS format:\n[expand-next-text 2]"
1124             }
1125             return
1126         }
1127         .CS {
1128             if {[next-op-is .ta rest]} {
1129
1130             }
1131             if {[match-text @stuff .CE]} {
1132                 man-puts <PRE>$stuff</PRE>
1133             } else {
1134                 manerror "unexpected .CS format:\n[expand-next-text 2]"
1135             }
1136             return
1137         }
1138         .CE {
1139             manerror "unexpected .CE"
1140             return
1141         }
1142         .sp {
1143             man-puts <P>
1144         }
1145         .ta {
1146             # these are tab stop settings for short tables
1147             switch -exact $manual(name):$manual(section) {
1148                 {bind:MODIFIERS} -
1149                 {bind:EVENT TYPES} -
1150                 {bind:BINDING SCRIPTS AND SUBSTITUTIONS} -
1151                 {expr:OPERANDS} -
1152                 {expr:MATH FUNCTIONS} -
1153                 {history:DESCRIPTION} -
1154                 {history:HISTORY REVISION} -
1155                 {switch:DESCRIPTION} -
1156                 {upvar:DESCRIPTION} {
1157                     return;                     # fix.me
1158                 }
1159                 default {
1160                     manerror "ignoring $line"
1161                 }
1162             }
1163         }
1164         .nf {
1165             if {[match-text @more .fi]} {
1166                 foreach more [split $more \n] {
1167                     man-puts $more<BR>
1168                 }
1169             } elseif {[match-text .RS @more .RE .fi]} {
1170                 man-puts <DL><DD>
1171                 foreach more [split $more \n] {
1172                     man-puts $more<BR>
1173                 }
1174                 man-puts </DL>
1175             } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} {
1176                 man-puts <DL><DD>
1177                 foreach more [split $more \n] {
1178                     man-puts $more<BR>
1179                 }
1180                 man-puts <DL><DD>
1181                 foreach more2 [split $more2 \n] {
1182                     man-puts $more2<BR>
1183                 }
1184                 man-puts </DL></DL>
1185             } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} {
1186                 man-puts <DL><DD>
1187                 foreach more [split $more \n] {
1188                     man-puts $more<BR>
1189                 }
1190                 man-puts <DL><DD>
1191                 foreach more2 [split $more2 \n] {
1192                     man-puts $more2<BR>
1193                 }
1194                 man-puts </DL><DD>
1195                 foreach more3 [split $more3 \n] {
1196                     man-puts $more3<BR>
1197                 }
1198                 man-puts </DL>
1199             } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} {
1200                 man-puts <P><DL><DD>
1201                 foreach more [split $more \n] {
1202                     man-puts $more<BR>
1203                 }
1204                 man-puts <DL><DD>
1205                 foreach more2 [split $more2 \n] {
1206                     man-puts $more2<BR>
1207                 }
1208                 man-puts </DL></DL><P>
1209             } elseif {[match-text .RS .sp @more .sp .RE .fi]} {
1210                 man-puts <P><DL><DD>
1211                 foreach more [split $more \n] {
1212                     man-puts $more<BR>
1213                 }
1214                 man-puts </DL><P>
1215             } else {
1216                 manerror "ignoring $line"
1217             }
1218         }
1219         .fi {
1220             manerror "ignoring $line"
1221         }
1222         .na -
1223         .ad -
1224         .UL -
1225         .ne {
1226             manerror "ignoring $line"
1227         }
1228         default {
1229             manerror "unrecognized format directive: $line"
1230         }
1231     }
1232 }
1233 ##
1234 ## merge copyright listings
1235 ##
1236 proc merge-copyrights {l1 l2} {
1237     foreach copyright [concat $l1 $l2] {
1238         if {[regexp {^Copyright +\(c\) +(\d+) +(by +)?(\w.*)$} $copyright all date by who]} {
1239             lappend dates($who) $date
1240             continue
1241         }
1242         if {[regexp {^Copyright +\(c\) +(\d+)-(\d+) +(by +)?(\w.*)$} $copyright all from to by who]} {
1243             for {set date $from} {$date <= $to} {incr date} {
1244                 lappend dates($who) $date
1245             }
1246             continue
1247         }
1248         if {[regexp {^Copyright +\(c\) +(\d+), *(\d+) +(by +)?(\w.*)$} $copyright all date1 date2 by who]} {
1249             lappend dates($who) $date1 $date2
1250             continue
1251         }
1252         puts "oops: $copyright"
1253     }
1254     foreach who [array names dates] {
1255         set list [lsort $dates($who)]
1256         if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} {
1257             lappend merge "Copyright (c) [lindex $list 0] $who"
1258         } else {
1259             lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who"
1260         }
1261     }
1262     return [lsort $merge]
1263 }
1264
1265 proc makedirhier {dir} {
1266     if {![file isdirectory $dir] && \
1267             [catch {file mkdir $dir} error]} {
1268         return -code error "cannot create directory $dir: $error"
1269     }
1270 }
1271
1272 ##
1273 ## foreach of the man directories specified by args
1274 ## convert manpages into hypertext in the directory
1275 ## specified by html.
1276 ##
1277 proc make-man-pages {html args} {
1278     global env manual overall_title
1279     makedirhier $html
1280     set manual(short-toc-n) 1
1281     set manual(short-toc-fp) [open $html/contents.htm w]
1282     puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>"
1283     puts $manual(short-toc-fp) "<BODY><HR><H3>$overall_title</H3><HR><DL>"
1284     set manual(merge-copyrights) {}
1285     foreach arg $args {
1286         set manual(wing-glob) [lindex $arg 0]
1287         set manual(wing-name) [lindex $arg 1]
1288         set manual(wing-file) [lindex $arg 2]
1289         set manual(wing-description) [lindex $arg 3]
1290         set manual(wing-copyrights) {}
1291         makedirhier $html/$manual(wing-file)
1292         set manual(wing-toc-fp) [open $html/$manual(wing-file)/contents.htm w]
1293         # whistle
1294         puts stderr "scanning section $manual(wing-name)"
1295         # put the entry for this section into the short table of contents
1296         puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/contents.htm\">$manual(wing-name)</A><DD>$manual(wing-description)"
1297         # initialize the wing table of contents
1298         puts $manual(wing-toc-fp) "<HTML><HEAD><TITLE>$manual(wing-name) Manual</TITLE></HEAD>"
1299         puts $manual(wing-toc-fp) "<BODY><HR><H3>$manual(wing-name)</H3><HR>"
1300         # initialize the short table of contents for this section
1301         set manual(wing-toc) {}
1302         # initialize the man directory for this section
1303         makedirhier $html/$manual(wing-file)
1304         # initialize the long table of contents for this section
1305         set manual(long-toc-n) 1
1306         # get the manual pages for this section
1307         set manual(pages) [lsort [glob $manual(wing-glob)]]
1308         if {[lsearch -glob $manual(pages) */options.n] >= 0} {
1309             set n [lsearch $manual(pages) */options.n]
1310             set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
1311         }
1312         # set manual(pages) [lrange $manual(pages) 0 5]
1313         foreach manual(page) $manual(pages) {
1314             # whistle
1315             puts stderr "scanning page $manual(page)"
1316             set manual(tail) [file tail $manual(page)]
1317             set manual(name) [file root $manual(tail)]
1318             set manual(section) {}
1319             if {[lsearch {case pack-old menubar} $manual(name)] >= 0} {
1320                 # obsolete
1321                 manerror "discarding $manual(name)"
1322                 continue
1323             }
1324             set manual(infp) [open $manual(page)]
1325             set manual(text) {}
1326             set manual(partial-text) {}
1327             foreach p {.RS .DS .CS .SO} {
1328                 set manual($p) 0
1329             }
1330             set manual(stack) {}
1331             set manual(section) {}
1332             set manual(section-toc) {}
1333             set manual(section-toc-n) 1
1334             set manual(copyrights) {}
1335             lappend manual(all-pages) $manual(wing-file)/$manual(tail)
1336             manreport 100 $manual(name)
1337             while {[gets $manual(infp) line] >= 0} {
1338                 manreport 100 $line
1339                 if {[regexp {^[`'][/\\]} $line]} {
1340                     if {[regexp {Copyright \(c\).*$} $line copyright]} {
1341                         lappend manual(copyrights) $copyright
1342                     }
1343                     # comment
1344                     continue
1345                 }
1346                 if {"$line" == {'}} {
1347                     # comment
1348                     continue
1349                 }
1350                 if {[parse-directive $line code rest]} {
1351                     switch -exact $code {
1352                         .ad - .na - .so - .ne - .AS - .VE - .VS -
1353                         . {
1354                             # ignore
1355                             continue
1356                         }
1357                     }
1358                     if {"$manual(partial-text)" != {}} {
1359                         lappend manual(text) [process-text $manual(partial-text)]
1360                         set manual(partial-text) {}
1361                     }
1362                     switch -exact $code {
1363                         .SH {
1364                             if {[llength $rest] == 0} {
1365                                 gets $manual(infp) rest
1366                             }
1367                             lappend manual(text) ".SH [unquote $rest]"
1368                         }
1369                         .TH {
1370                             lappend manual(text) "$code [unquote $rest]"
1371                         }
1372                         .HS - .UL -
1373                         .ta {
1374                             lappend manual(text) "$code [unquote $rest]"
1375                         }
1376                         .BS - .BE - .br - .fi - .sp -
1377                         .nf {
1378                             if {"$rest" != {}} {
1379                                 manerror "unexpected argument: $line"
1380                             }
1381                             lappend manual(text) $code
1382                         }
1383                         .AP {
1384                             lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
1385                         }
1386                         .IP {
1387                             regexp {^(.*) +\d+$} $rest all rest
1388                             lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
1389                         }
1390                         .TP {
1391                             set next [gets $manual(infp)]
1392                             if {"$next" != {'}} {
1393                                 lappend manual(text) ".IP [process-text $next]"
1394                             }
1395                         }
1396                         .OP {
1397                             lappend manual(text) [concat .OP [process-text \
1398                                     "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
1399                         }
1400                         .PP -
1401                         .LP {
1402                             lappend manual(text) {.PP}
1403                         }
1404                         .RS {
1405                             incr manual(.RS)
1406                             lappend manual(text) $code
1407                         }
1408                         .RE {
1409                             incr manual(.RS) -1
1410                             lappend manual(text) $code
1411                         }
1412                         .SO {
1413                             incr manual(.SO)
1414                             lappend manual(text) $code
1415                         }
1416                         .SE {
1417                             incr manual(.SO) -1
1418                             lappend manual(text) $code
1419                         }
1420                         .DS {
1421                             incr manual(.DS)
1422                             lappend manual(text) $code
1423                         }
1424                         .DE {
1425                             incr manual(.DS) -1
1426                             lappend manual(text) $code
1427                         }
1428                         .CS {
1429                             incr manual(.CS)
1430                             lappend manual(text) $code
1431                         }
1432                         .CE {
1433                             incr manual(.CS) -1
1434                             lappend manual(text) $code
1435                         }
1436                         .de {
1437                             while {[gets $manual(infp) line] >= 0} {
1438                                 if {[string match "..*" $line]} {
1439                                     break
1440                                 }
1441                             }
1442                         }
1443                         .. {
1444                             error "found .. outside of .de"
1445                         }
1446                         default {
1447                             manerror "unrecognized format directive: $line"
1448                         }
1449                     }
1450                 } else {
1451                     if {$manual(partial-text) == ""} {
1452                         set manual(partial-text) $line
1453                     } else {
1454                         append manual(partial-text) \n$line
1455                     }
1456                 }
1457             }
1458             if {$manual(partial-text) != ""} {
1459                 lappend manual(text) [process-text $manual(partial-text)]
1460             }
1461             close $manual(infp)
1462             # fixups
1463             if {$manual(.RS) != 0} {
1464                 if {$manual(name) != "selection"} {
1465                     puts "unbalanced .RS .RE"
1466                 }
1467             }
1468             if {$manual(.DS) != 0} {
1469                 puts "unbalanced .DS .DE"
1470             }
1471             if {$manual(.CS) != 0} {
1472                 puts "unbalanced .CS .CE"
1473             }
1474             if {$manual(.SO) != 0} {
1475                 puts "unbalanced .SO .SE"
1476             }
1477             # output conversion
1478             open-text
1479             if {[next-op-is .HS rest]} {
1480                 set manual($manual(name)-title) \
1481                         "[lrange $rest 1 end] [lindex $rest 0] manual page"
1482                 while {[more-text]} {
1483                     set line [next-text]
1484                     if {[is-a-directive $line]} {
1485                         output-directive $line
1486                     } else {
1487                         man-puts $line
1488                     }
1489                 }
1490                 man-puts <HR><PRE>
1491                 foreach copyright $manual(copyrights) {
1492                     man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
1493                 }
1494                 man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr.</PRE>"
1495                 set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
1496             } elseif {[next-op-is .TH rest]} {
1497                 set manual($manual(name)-title) "[lrange $rest 4 end] - [lindex $rest 0] manual page"
1498                 while {[more-text]} {
1499                     set line [next-text]
1500                     if {[is-a-directive $line]} {
1501                         output-directive $line
1502                     } else {
1503                         man-puts $line
1504                     }
1505                 }
1506                 man-puts <HR><PRE>
1507                 foreach copyright $manual(copyrights) {
1508                     man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
1509                 }
1510                 man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr.</PRE>"
1511                 set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
1512             } else {
1513                 manerror "no .HS or .TH record found"
1514             }
1515             #
1516             # make the long table of contents for this page
1517             #
1518             set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL><HR>]
1519         }
1520
1521         #
1522         # make the wing table of contents for the section
1523         #
1524         set width 0
1525         foreach name $manual(wing-toc) {
1526             if {[string length $name] > $width} {
1527                 set width [string length $name]
1528             }
1529         }
1530         set perline [expr {120 / $width}]
1531         set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
1532         set n 0
1533         catch {unset rows}
1534         foreach name [lsort $manual(wing-toc)] {
1535             set tail $manual(name-$name)
1536             if {[llength $tail] > 1} {
1537                 manerror "$name is defined in more than one file: $tail"
1538                 set tail [lindex $tail [expr {[llength $tail]-1}]]
1539             }
1540             set tail [file tail $tail]
1541             append rows([expr {$n%$nrows}]) \
1542                     "<td> <a href=\"$tail.htm\">$name</a>"
1543             incr n
1544         }
1545         puts $manual(wing-toc-fp) <table>
1546         foreach row [lsort -integer [array names rows]] {
1547             puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
1548         }
1549         puts $manual(wing-toc-fp) </table>
1550
1551         #
1552         # insert wing copyrights
1553         #
1554         puts $manual(wing-toc-fp) "<HR><PRE>"
1555         foreach copyright $manual(wing-copyrights) {
1556             puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
1557         }
1558         puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
1559         puts $manual(wing-toc-fp) "</PRE></BODY></HTML>"
1560         close $manual(wing-toc-fp)
1561         set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
1562     }
1563
1564     ##
1565     ## build the keyword index.
1566     ##
1567     proc strcasecmp {a b} { return [string compare -nocase $a $b] }
1568     set keys [lsort -command strcasecmp [array names manual keyword-*]]
1569     makedirhier $html/Keywords
1570     catch {eval file delete -- [glob $html/Keywords/*]}
1571     puts $manual(short-toc-fp) {<DT><A HREF="Keywords/contents.htm">Keywords</A><DD>The keywords from the Tcl/Tk man pages.}
1572     set keyfp [open $html/Keywords/contents.htm w]
1573     puts $keyfp "<HTML><HEAD><TITLE>Tcl/Tk Keywords</TITLE></HEAD>"
1574     puts $keyfp "<BODY><HR><H3>Tcl/Tk Keywords</H3><HR><H2>"
1575     foreach a {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
1576         puts $keyfp "<A HREF=\"$a.htm\">$a</A>"
1577         set afp [open $html/Keywords/$a.htm w]
1578         puts $afp "<HTML><HEAD><TITLE>Tcl/Tk Keywords - $a</TITLE></HEAD>"
1579         puts $afp "<BODY><HR><H3>Tcl/Tk Keywords - $a</H3><HR><H2>"
1580         foreach b {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
1581             puts $afp "<A HREF=\"$b.htm\">$b</A>"
1582         }
1583         puts $afp "</H2><HR><DL>"
1584         foreach k $keys {
1585             if {[regexp -nocase -- "^keyword-$a" $k]} {
1586                 set k [string range $k 8 end]
1587                 puts $afp "<DT><A NAME=\"$k\">$k</A><DD>"
1588                 set refs {}
1589                 foreach man $manual(keyword-$k) {
1590                     set name [lindex $man 0]
1591                     set file [lindex $man 1]
1592                     lappend refs "<A HREF=\"../$file\">$name</A>"
1593                 }
1594                 puts $afp [join $refs {, }]
1595             }
1596         }
1597         puts $afp "</DL><HR><PRE>"
1598         # insert merged copyrights
1599         foreach copyright $manual(merge-copyrights) {
1600             puts $afp "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
1601         }
1602         puts $afp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
1603         puts $afp "</PRE></BODY></HTML>"
1604         close $afp
1605     }
1606     puts $keyfp "</H2><HR><PRE>"
1607
1608     # insert merged copyrights
1609     foreach copyright $manual(merge-copyrights) {
1610         puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
1611     }
1612     puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
1613     puts $keyfp </PRE><HR></BODY></HTML>
1614     close $keyfp
1615
1616     ##
1617     ## finish off short table of contents
1618     ##
1619     puts $manual(short-toc-fp) {<DT><A HREF="http://www.elf.org">Source</A><DD>More information about these man pages.}
1620     puts $manual(short-toc-fp) "</DL><HR><PRE>"
1621     # insert merged copyrights
1622     foreach copyright $manual(merge-copyrights) {
1623         puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
1624     }
1625     puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
1626     puts $manual(short-toc-fp) "</PRE></BODY></HTML>"
1627     close $manual(short-toc-fp)
1628
1629     ##
1630     ## output man pages
1631     ##
1632     unset manual(section)
1633     foreach path $manual(all-pages) {
1634         set manual(wing-file) [file dirname $path]
1635         set manual(tail) [file tail $path]
1636         set manual(name) [file root $manual(tail)]
1637         set text $manual(output-$manual(wing-file)-$manual(name))
1638         set ntext 0
1639         foreach item $text {
1640             incr ntext [llength [split $item \n]]
1641             incr ntext
1642         }
1643         set toc $manual(toc-$manual(wing-file)-$manual(name))
1644         set ntoc 0
1645         foreach item $toc {
1646             incr ntoc [llength [split $item \n]]
1647             incr ntoc
1648         }
1649         puts stderr "rescanning page $manual(name) $ntoc/$ntext"
1650         set manual(outfp) [open $html/$manual(wing-file)/$manual(name).htm w]
1651         puts $manual(outfp) "<HTML><HEAD><TITLE>$manual($manual(name)-title)</TITLE></HEAD><BODY>"
1652         if {($ntext > 60) && ($ntoc > 32) || [lsearch {
1653             Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType
1654             CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash
1655             GetJustify GetPixels GetVisual ParseArgv QueueEvent
1656         } $manual(tail)] >= 0} {
1657             foreach item $toc {
1658                 puts $manual(outfp) $item
1659             }
1660         }
1661         foreach item $text {
1662             puts $manual(outfp) [insert-cross-references $item]
1663         }
1664         puts $manual(outfp) </BODY></HTML>
1665         close $manual(outfp)
1666     }
1667     return {}
1668 }
1669
1670 set usercmddesc {The interpreters which implement Tcl and Tk.}
1671 set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.}
1672 set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.}
1673 set tcllibdesc {The C functions which a Tcl extended C program may use.}
1674 set tklibdesc {The additional C functions which a Tk extended C program may use.}
1675
1676 parse_command_line
1677
1678 if {1} {
1679     if {[catch {
1680         make-man-pages $webdir \
1681             "$tcltkdir/{$tkdir,$tcldir}/doc/*.1 {Tcl/Tk Applications} UserCmd {$usercmddesc}" \
1682             "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" \
1683             "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" \
1684             "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" \
1685             "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}"
1686     } error]} {
1687         puts $error\n$errorInfo
1688     }
1689 }