util/src/TclTk/tcl8.6.12/pkgs/tdbc1.1.3/tools/tdbc-man2html.tcl

   1 #!/bin/sh
   2 # The next line is executed by /bin/sh, but not tcl \
   3 exec tclsh "$0" ${1+"$@"}
   4
   5 package require Tcl 8.5-
   6
   7 # Convert Ousterhout format man pages into highly crosslinked hypertext.
   8 #
   9 # Along the way detect many unmatched font changes and other odd things.
  10 #
  11 # Note well, this program is a hack rather than a piece of software
  12 # engineering.  In that sense it's probably a good example of things
  13 # that a scripting language, like Tcl, can do well.  It is offered as
  14 # an example of how someone might convert a specific set of man pages
  15 # into hypertext, not as a general solution to the problem.  If you
  16 # try to use this, you'll be very much on your own.
  17 #
  18 # Copyright (c) 1995-1997 Roger E. Critchlow Jr
  19
  20 set Version "0.40"
  21
  22 set ::CSSFILE "docs.css"
  23
  24 set ::logo {
  25     <a href="http://sourceforge.net/projects/tcl">
  26     <img src="http://sflogo.sourceforge.net/sflogo.php?group_id=10894&amp;type=14"
  27          width="150" height="40"
  28          alt="Get Tcl at SourceForge.net. Fast, secure and Free Open Source software downloads" />
  29     </a>
  30 }
  31
  32 proc parse_command_line {} {
  33     global argv Version
  34
  35     # These variables determine where the man pages come from and where
  36     # the converted pages go to.
  37     global tcltkdir tkdir tcldir webdir build_tcl build_tk
  38     global build_tdbc build_tdbcodbc build_tdbcsqlite3 build_tdbcmysql
  39     global build_tdbcpostgres
  40     global tdbcdir tdbcodbcdir tdbcsqlite3dir tdbcmysqldir tdbcpostgresdir
  41
  42     # Set defaults based on original code.
  43     set tcltkdir ../..
  44     set tkdir {}
  45     set tcldir {}
  46     set tdbcdir {}
  47     set tdbcodbcdir {}
  48     set tdbcsqlite3dir {}
  49     set tdbcmysqldir {}
  50     set tdbcpostgresdir {}
  51     set webdir ../html
  52     set build_tcl 0
  53     set build_tk 0
  54     set build_tdbc 0
  55     set build_tdbcodbc 0
  56     set build_tdbcsqlite3 0
  57     set build_tdbcmysql 0
  58     set build_tdbcpostgres 0
  59
  60     # Default search version is a glob pattern
  61     set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}
  62
  63     # Handle arguments a la GNU:
  64     #   --version
  65     #   --useversion=<version>
  66     #   --help
  67     #   --srcdir=/path
  68     #   --htmldir=/path
  69
  70     foreach option $argv {
  71         switch -glob -- $option {
  72             --version {
  73                 puts "tcltk-man-html $Version"
  74                 exit 0
  75             }
  76
  77             --help {
  78                 puts "usage: tcltk-man-html \[OPTION\] ...\n"
  79                 puts "  --help              print this help, then exit"
  80                 puts "  --version           print version number, then exit"
  81                 puts "  --srcdir=DIR        find tcl and tk source below DIR"
  82                 puts "  --htmldir=DIR       put generated HTML in DIR"
  83                 puts "  --tcl               build tcl help"
  84                 puts "  --tk                build tk help"
  85                 puts "  --useversion        version of tcl/tk to search for"
  86                 exit 0
  87             }
  88
  89             --srcdir=* {
  90                 # length of "--srcdir=" is 9.
  91                 set tcltkdir [string range $option 9 end]
  92             }
  93
  94             --htmldir=* {
  95                 # length of "--htmldir=" is 10
  96                 set webdir [string range $option 10 end]
  97             }
  98
  99             --useversion=* {
 100                 # length of "--useversion=" is 13
 101                 set useversion [string range $option 13 end]
 102             }
 103
 104             --tcl {
 105                 set build_tcl 1
 106             }
 107
 108             --tk {
 109                 set build_tk 1
 110             }
 111
 112             --tdbc {
 113                 set build_tdbc 1
 114             }
 115
 116             --tdbcodbc {
 117                 set build_tdbcodbc 1
 118             }
 119
 120             --tdbcsqlite3 {
 121                 set build_tdbcsqlite3 1
 122             }
 123
 124             --tdbcmysql {
 125                 set build_tdbcmysql 1
 126             }
 127
 128             --tdbcpostgres {
 129                 set build_tdbcpostgres 1
 130             }
 131
 132             default {
 133                 puts stderr "tcltk-man-html: unrecognized option -- `$option'"
 134                 exit 1
 135             }
 136         }
 137     }
 138
 139     if {$build_tcl} {
 140         # Find Tcl.
 141         set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
 142                 -directory $tcltkdir tcl$useversion]] end]
 143         if {$tcldir eq ""} {
 144             puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
 145             exit 1
 146         }
 147         puts "using Tcl source directory $tcldir"
 148     }
 149
 150     if {$build_tk} {
 151         # Find Tk.
 152         set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
 153                                       -directory $tcltkdir tk$useversion]] end]
 154         if {$tkdir eq ""} {
 155             puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
 156             exit 1
 157         }
 158         puts "using Tk source directory $tkdir"
 159     }
 160
 161     if {$build_tdbc} {
 162         # Find Tdbc.
 163         set tdbcdir [lindex [lsort [glob -nocomplain -tails -type d \
 164                                         -directory $tcltkdir \
 165                                         tdbc$useversion]] end]
 166         if {$tdbcdir eq ""} {
 167             puts stderr "tcltk-man-html: couldn't find Tdbc below $tcltkdir"
 168             exit 1
 169         }
 170         puts "using Tdbc source directory $tcldir"
 171     }
 172
 173     if {$build_tdbcodbc} {
 174         # Find Tdbcodbc.
 175         set tdbcodbcdir [lindex [lsort [glob -nocomplain -tails -type d \
 176                                         -directory $tcltkdir \
 177                                         tdbcodbc$useversion]] end]
 178         if {$tdbcodbcdir eq ""} {
 179             puts stderr "tcltk-man-html: couldn't find Tdbcodbc below $tcltkdir"
 180             exit 1
 181         }
 182         puts "using Tdbcodbc source directory $tcldir"
 183     }
 184
 185     if {$build_tdbcsqlite3} {
 186         # Find Tdbcsqlite3.
 187         set tdbcsqlite3dir [lindex [lsort [glob -nocomplain -tails -type d \
 188                                         -directory $tcltkdir \
 189                                         tdbcsqlite3$useversion]] end]
 190         if {$tdbcsqlite3dir eq ""} {
 191             puts stderr "tcltk-man-html: couldn't find Tdbcsqlite3 below $tcltkdir"
 192             exit 1
 193         }
 194         puts "using Tdbcsqlite3 source directory $tcldir"
 195     }
 196
 197     if {$build_tdbcmysql} {
 198         # Find Tdbcmysql.
 199         set tdbcmysqldir [lindex [lsort [glob -nocomplain -tails -type d \
 200                                         -directory $tcltkdir \
 201                                         tdbcmysql$useversion]] end]
 202         if {$tdbcmysqldir eq ""} {
 203             puts stderr "tcltk-man-html: couldn't find Tdbcmysql below $tcltkdir"
 204             exit 1
 205         }
 206         puts "using Tdbcmysql source directory $tcldir"
 207     }
 208
 209
 210     if {$build_tdbcpostgres} {
 211         # Find Tdbcpostgres.
 212         set tdbcpostgresdir [lindex [lsort [glob -nocomplain -tails -type d \
 213                                                 -directory $tcltkdir \
 214                                                 tdbcpostgres$useversion]] end]
 215         if {$tdbcpostgresdir eq ""} {
 216             puts stderr "tcltk-man-html: couldn't find Tdbcpostgres below \
 217                          $tcltkdir"
 218             exit 1
 219         }
 220         puts "using Tdbcpostgres source directory $tcldir"
 221     }
 222
 223     # the title for the man pages overall
 224     global overall_title
 225     set overall_title ""
 226     if {$build_tcl} {
 227         append overall_title "[capitalize $tcldir]"
 228     }
 229     if {$build_tcl && $build_tk} {
 230         append overall_title "/"
 231     }
 232     if {$build_tk} {
 233         append overall_title "[capitalize $tkdir]"
 234     }
 235     if {!$build_tcl && !$build_tk &&
 236         ($build_tdbc || $build_tdbcodbc || $build_tdbcsqlite3
 237          || $build_tdbcmysql || $build_tdbcpostgres)} {
 238         append overall_title "[capitalize $tdbcdir]"
 239     }
 240     append overall_title " Documentation"
 241 }
 242
 243 proc capitalize {string} {
 244     return [string toupper $string 0]
 245 }
 246
 247 ##
 248 ##
 249 ##
 250 set manual(report-level) 1
 251
 252 proc manerror {msg} {
 253     global manual
 254     set name {}
 255     set subj {}
 256     set procname [lindex [info level -1] 0]
 257     if {[info exists manual(name)]} {
 258         set name $manual(name)
 259     }
 260     if {[info exists manual(section)] && [string length $manual(section)]} {
 261         puts stderr "$name: $manual(section): $procname: $msg"
 262     } else {
 263         puts stderr "$name: $procname: $msg"
 264     }
 265 }
 266
 267 proc manreport {level msg} {
 268     global manual
 269     if {$level < $manual(report-level)} {
 270         uplevel 1 [list manerror $msg]
 271     }
 272 }
 273
 274 proc fatal {msg} {
 275     global manual
 276     uplevel 1 [list manerror $msg]
 277     exit 1
 278 }
 279
 280 ##
 281 ## templating
 282 ##
 283 proc indexfile {} {
 284     if {[info exists ::TARGET] && $::TARGET eq "devsite"} {
 285         return "index.tml"
 286     } else {
 287         return "contents.htm"
 288     }
 289 }
 290 proc copyright {copyright {level {}}} {
 291     # We don't actually generate a separate copyright page anymore
 292     #set page "${level}copyright.htm"
 293     #return "<A HREF=\"$page\">Copyright</A> &#169; [htmlize-text [lrange $copyright 2 end]]"
 294     # obfuscate any email addresses that may appear in name
 295     set who [string map {@ (at)} [lrange $copyright 2 end]]
 296     return "Copyright &copy; [htmlize-text $who]"
 297 }
 298 proc copyout {copyrights {level {}}} {
 299     set out "<div class=\"copy\">"
 300     foreach c $copyrights {
 301         append out "[copyright $c $level]\n"
 302     }
 303     append out "</div>"
 304     return $out
 305 }
 306 proc CSS {{level ""}} {
 307     return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n"
 308 }
 309 proc DOCTYPE {} {
 310     return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
 311 }
 312 proc htmlhead {title header args} {
 313     set level ""
 314     if {[lindex $args end] eq "../[indexfile]"} {
 315         # XXX hack - assume same level for CSS file
 316         set level "../"
 317     }
 318     set out "[DOCTYPE]\n<HTML>\n<HEAD><TITLE>$title</TITLE>\n[CSS $level]</HEAD>\n"
 319     foreach {uptitle url} $args {
 320         set header "<a href=\"$url\">$uptitle</a> <small>&gt;</small> $header"
 321     }
 322     append out "<BODY><H2>$header</H2>"
 323     global manual
 324     if {[info exists manual(subheader)]} {
 325         set subs {}
 326         foreach {name subdir} $manual(subheader) {
 327             if {$name eq $title} {
 328                 lappend subs $name
 329             } else {
 330                 lappend subs "<A HREF=\"${level}$subdir/[indexfile]\">$name</A>"
 331             }
 332         }
 333         append out "\n<H3>[join $subs { | }]</H3>"
 334     }
 335     return $out
 336 }
 337 proc gencss {} {
 338     set hBd "1px dotted #11577b"
 339     return "
 340 body, div, p, th, td, li, dd, ul, ol, dl, dt, blockquote {
 341     font-family: Verdana, sans-serif;
 342 }
 343
 344 pre, code { font-family: 'Courier New', Courier, monospace; }
 345
 346 pre {
 347     background-color:  #f6fcec;
 348     border-top:        1px solid #6A6A6A;
 349     border-bottom:     1px solid #6A6A6A;
 350     padding:           1em;
 351     overflow:          auto;
 352 }
 353
 354 body {
 355     background-color:  #FFFFFF;
 356     font-size:         12px;
 357     line-height:       1.25;
 358     letter-spacing:    .2px;
 359     padding-left:      .5em;
 360 }
 361
 362 h1, h2, h3, h4 {
 363     font-family:       Georgia, serif;
 364     padding-left:      1em;
 365     margin-top:        1em;
 366 }
 367
 368 h1 {
 369     font-size:         18px;
 370     color:             #11577b;
 371     border-bottom:     $hBd;
 372     margin-top:        0px;
 373 }
 374
 375 h2 {
 376     font-size:         14px;
 377     color:             #11577b;
 378     background-color:  #c5dce8;
 379     padding-left:      1em;
 380     border:            1px solid #6A6A6A;
 381 }
 382
 383 h3, h4 {
 384     color:             #1674A4;
 385     background-color:  #e8f2f6;
 386     border-bottom:     $hBd;
 387     border-top:        $hBd;
 388 }
 389
 390 h3 { font-size: 12px; }
 391 h4 { font-size: 11px; }
 392
 393 .keylist dt, .arguments dt {
 394   width: 20em;
 395   float: left;
 396   padding: 2px;
 397   border-top: 1px solid #999;
 398 }
 399
 400 .keylist dt { font-weight: bold; }
 401
 402 .keylist dd, .arguments dd {
 403   margin-left: 20em;
 404   padding: 2px;
 405   border-top: 1px solid #999;
 406 }
 407
 408 .copy {
 409     background-color:  #f6fcfc;
 410     white-space:       pre;
 411     font-size:         80%;
 412     border-top:        1px solid #6A6A6A;
 413     margin-top:        2em;
 414 }
 415 "
 416 }
 417
 418 ##
 419 ## parsing
 420 ##
 421 proc unquote arg {
 422     return [string map [list \" {}] $arg]
 423 }
 424
 425 proc parse-directive {line codename restname} {
 426     upvar 1 $codename code $restname rest
 427     return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]
 428 }
 429
 430 proc htmlize-text {text {charmap {}}} {
 431     # contains some extras for use in nroff->html processing
 432     # build on the list passed in, if any
 433     lappend charmap \
 434         {&}     {&amp;} \
 435         {\\}    "&#92;" \
 436         {\e}    "&#92;" \
 437         {\ }    {&nbsp;} \
 438         {\|}    {&nbsp;} \
 439         {\0}    { } \
 440         \"      {&quot;} \
 441         {<}     {&lt;} \
 442         {>}     {&gt;} \
 443         \u201c "&#8220;" \
 444         \u201d "&#8221;"
 445
 446     return [string map $charmap $text]
 447 }
 448
 449 proc process-text {text} {
 450     global manual
 451     # preprocess text; note that this is an incomplete map, and will probably
 452     # need to have things added to it as the manuals expand to use them.
 453     set charmap [list \
 454             {\&}        "\t" \
 455             {\%}        {} \
 456             "\\\n"      "\n" \
 457             {\(+-}      "&#177;" \
 458             {\(co}      "&copy;" \
 459             {\(em}      "&#8212;" \
 460             {\(fm}      "&#8242;" \
 461             {\(mu}      "&#215;" \
 462             {\(mi}      "&#8722;" \
 463             {\(->}      "<font size=\"+1\">&#8594;</font>" \
 464             {\fP}       {\fR} \
 465             {\.}        . \
 466             {\(bu}      "&#8226;" \
 467             ]
 468     lappend charmap {\o'o^'} {&ocirc;} ; # o-circumflex in re_syntax.n
 469     lappend charmap {\-\|\-} --        ; # two hyphens
 470     lappend charmap {\-} -             ; # a hyphen
 471
 472     set text [htmlize-text $text $charmap]
 473     # General quoted entity
 474     regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text
 475     while {[string first "\\" $text] >= 0} {
 476         # C R
 477         if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \
 478                 {\1<TT>\2</TT>\3} text]} continue
 479         # B R
 480         if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
 481                 {\1<B>\2</B>\3} text]} continue
 482         # B I
 483         if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
 484                 {\1<B>\2</B>\\fI\3} text]} continue
 485         # I R
 486         if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
 487                 {\1<I>\2</I>\3} text]} continue
 488         # I B
 489         if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
 490                 {\1<I>\2</I>\\fB\3} text]} continue
 491         # B B, I I, R R
 492         if {
 493             [regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
 494                 {\1\\fB\2\3} ntext]
 495             || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \
 496                     {\1\\fI\2\3} ntext]
 497             || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \
 498                     {\1\\fR\2\3} ntext]
 499         } then {
 500             manerror "impotent font change: $text"
 501             set text $ntext
 502             continue
 503         }
 504         # unrecognized
 505         manerror "uncaught backslash: $text"
 506         set text [string map [list "\\" "&#92;"] $text]
 507     }
 508     return $text
 509 }
 510 ##
 511 ## pass 2 text input and matching
 512 ##
 513 proc open-text {} {
 514     global manual
 515     set manual(text-length) [llength $manual(text)]
 516     set manual(text-pointer) 0
 517 }
 518 proc more-text {} {
 519     global manual
 520     return [expr {$manual(text-pointer) < $manual(text-length)}]
 521 }
 522 proc next-text {} {
 523     global manual
 524     if {[more-text]} {
 525         set text [lindex $manual(text) $manual(text-pointer)]
 526         incr manual(text-pointer)
 527         return $text
 528     }
 529     manerror "read past end of text"
 530     error "fatal"
 531 }
 532 proc is-a-directive {line} {
 533     return [string match .* $line]
 534 }
 535 proc split-directive {line opname restname} {
 536     upvar 1 $opname op $restname rest
 537     set op [string range $line 0 2]
 538     set rest [string trim [string range $line 3 end]]
 539 }
 540 proc next-op-is {op restname} {
 541     global manual
 542     upvar 1 $restname rest
 543     if {[more-text]} {
 544         set text [lindex $manual(text) $manual(text-pointer)]
 545         if {[string equal -length 3 $text $op]} {
 546             set rest [string range $text 4 end]
 547             incr manual(text-pointer)
 548             return 1
 549         }
 550     }
 551     return 0
 552 }
 553 proc backup-text {n} {
 554     global manual
 555     if {$manual(text-pointer)-$n >= 0} {
 556         incr manual(text-pointer) -$n
 557     }
 558 }
 559 proc match-text args {
 560     global manual
 561     set nargs [llength $args]
 562     if {$manual(text-pointer) + $nargs > $manual(text-length)} {
 563         return 0
 564     }
 565     set nback 0
 566     foreach arg $args {
 567         if {![more-text]} {
 568             backup-text $nback
 569             return 0
 570         }
 571         set arg [string trim $arg]
 572         set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
 573         if {$arg eq $targ} {
 574             incr nback
 575             incr manual(text-pointer)
 576             continue
 577         }
 578         if {[regexp {^@(\w+)$} $arg all name]} {
 579             upvar 1 $name var
 580             set var $targ
 581             incr nback
 582             incr manual(text-pointer)
 583             continue
 584         }
 585         if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\
 586                 && [string equal $op [lindex $targ 0]]} {
 587             upvar 1 $name var
 588             set var [lrange $targ 1 end]
 589             incr nback
 590             incr manual(text-pointer)
 591             continue
 592         }
 593         backup-text $nback
 594         return 0
 595     }
 596     return 1
 597 }
 598 proc expand-next-text {n} {
 599     global manual
 600     return [join [lrange $manual(text) $manual(text-pointer) \
 601             [expr {$manual(text-pointer)+$n-1}]] \n\n]
 602 }
 603 ##
 604 ## pass 2 output
 605 ##
 606 proc man-puts {text} {
 607     global manual
 608     lappend manual(output-$manual(wing-file)-$manual(name)) $text
 609 }
 610
 611 ##
 612 ## build hypertext links to tables of contents
 613 ##
 614 proc long-toc {text} {
 615     global manual
 616     set here M[incr manual(section-toc-n)]
 617     set there L[incr manual(long-toc-n)]
 618     lappend manual(section-toc) \
 619             "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
 620     return "<A NAME=\"$here\">$text</A>"
 621 }
 622 proc option-toc {name class switch} {
 623     global manual
 624     if {[string match "*OPTIONS" $manual(section)]} {
 625         if {$manual(name) ne "ttk_widget" && ($manual(name) ne "ttk_entry" ||
 626                 ![string match validate* $name])} {
 627             # link the defined option into the long table of contents
 628             set link [long-toc "$switch, $name, $class"]
 629             regsub -- "$switch, $name, $class" $link "$switch" link
 630             return $link
 631         }
 632     } elseif {"$manual(name):$manual(section)" ne "options:DESCRIPTION"} {
 633         error "option-toc in $manual(name) section $manual(section)"
 634     }
 635
 636     # link the defined standard option to the long table of contents and make
 637     # a target for the standard option references from other man pages.
 638
 639     set first [lindex $switch 0]
 640     set here M$first
 641     set there L[incr manual(long-toc-n)]
 642     set manual(standard-option-$manual(name)-$first) \
 643         "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>"
 644     lappend manual(section-toc) \
 645         "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
 646     return "<A NAME=\"$here\">$switch</A>"
 647 }
 648 proc std-option-toc {name page} {
 649     global manual
 650     if {[info exists manual(standard-option-$page-$name)]} {
 651         lappend manual(section-toc) <DD>$manual(standard-option-$page-$name)
 652         return $manual(standard-option-$page-$name)
 653     }
 654     manerror "missing reference to \"$name\" in $page.n"
 655     set here M[incr manual(section-toc-n)]
 656     set there L[incr manual(long-toc-n)]
 657     set other M$name
 658     lappend manual(section-toc) "<DD><A HREF=\"$page.htm#$other\">$name</A>"
 659     return "<A HREF=\"$page.htm#$other\">$name</A>"
 660 }
 661 ##
 662 ## process the widget option section
 663 ## in widget and options man pages
 664 ##
 665 proc output-widget-options {rest} {
 666     global manual
 667     man-puts <DL>
 668     lappend manual(section-toc) <DL>
 669     backup-text 1
 670     set para {}
 671     while {[next-op-is .OP rest]} {
 672         switch -exact -- [llength $rest] {
 673             3 {
 674                 lassign $rest switch name class
 675             }
 676             5 {
 677                 set switch [lrange $rest 0 2]
 678                 set name [lindex $rest 3]
 679                 set class [lindex $rest 4]
 680             }
 681             default {
 682                 fatal "bad .OP $rest"
 683             }
 684         }
 685         if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch \
 686                 all oswitch switch cswitch]} {
 687             if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch \
 688                     all oswitch switch1 switch2 cswitch]} {
 689                 error "not Switch: $switch"
 690             }
 691             set switch "$switch1$cswitch or $oswitch$switch2"
 692         }
 693         if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} {
 694             error "not Name: $name"
 695         }
 696         if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} {
 697             error "not Class: $class"
 698         }
 699         man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
 700         man-puts "<DT>Database Name: $oname$name$cname"
 701         man-puts "<DT>Database Class: $oclass$class$cclass"
 702         man-puts <DD>[next-text]
 703         set para <P>
 704
 705         if {[next-op-is .RS rest]} {
 706             while {[more-text]} {
 707                 set line [next-text]
 708                 if {[is-a-directive $line]} {
 709                     split-directive $line code rest
 710                     switch -exact -- $code {
 711                         .RE {
 712                             break
 713                         }
 714                         .SH - .SS {
 715                             manerror "unbalanced .RS at section end"
 716                             backup-text 1
 717                             break
 718                         }
 719                         default {
 720                             output-directive $line
 721                         }
 722                     }
 723                 } else {
 724                     man-puts $line
 725                 }
 726             }
 727         }
 728     }
 729     man-puts </DL>
 730     lappend manual(section-toc) </DL>
 731 }
 732
 733 ##
 734 ## process .RS lists
 735 ##
 736 proc output-RS-list {} {
 737     global manual
 738     if {[next-op-is .IP rest]} {
 739         output-IP-list .RS .IP $rest
 740         if {[match-text .RE .sp .RS @rest .IP @rest2]} {
 741             man-puts <P>$rest
 742             output-IP-list .RS .IP $rest2
 743         }
 744         if {[match-text .RE .sp .RS @rest .RE]} {
 745             man-puts <P>$rest
 746             return
 747         }
 748         if {[next-op-is .RE rest]} {
 749             return
 750         }
 751     }
 752     man-puts <DL><DD>
 753     while {[more-text]} {
 754         set line [next-text]
 755         if {[is-a-directive $line]} {
 756             split-directive $line code rest
 757             switch -exact -- $code {
 758                 .RE {
 759                     break
 760                 }
 761                 .SH - .SS {
 762                     manerror "unbalanced .RS at section end"
 763                     backup-text 1
 764                     break
 765                 }
 766                 default {
 767                     output-directive $line
 768                 }
 769             }
 770         } else {
 771             man-puts $line
 772         }
 773     }
 774     man-puts </DL>
 775 }
 776
 777 ##
 778 ## process .IP lists which may be plain indents,
 779 ## numeric lists, or definition lists
 780 ##
 781 proc output-IP-list {context code rest} {
 782     global manual
 783     if {![string length $rest]} {
 784         # blank label, plain indent, no contents entry
 785         man-puts <DL><DD>
 786         while {[more-text]} {
 787             set line [next-text]
 788             if {[is-a-directive $line]} {
 789                 split-directive $line code rest
 790                 if {$code eq ".IP" && $rest eq {}} {
 791                     man-puts "<P>"
 792                     continue
 793                 }
 794                 if {$code in {.br .DS .RS}} {
 795                     output-directive $line
 796                 } else {
 797                     backup-text 1
 798                     break
 799                 }
 800             } else {
 801                 man-puts $line
 802             }
 803         }
 804         man-puts </DL>
 805     } else {
 806         # labelled list, make contents
 807         if {$context ne ".SH" && $context ne ".SS"} {
 808             man-puts <P>
 809         }
 810         set dl "<DL class=\"[string tolower $manual(section)]\">"
 811         man-puts $dl
 812         lappend manual(section-toc) $dl
 813         backup-text 1
 814         set accept_RE 0
 815         set para {}
 816         while {[more-text]} {
 817             set line [next-text]
 818             if {[is-a-directive $line]} {
 819                 split-directive $line code rest
 820                 switch -exact -- $code {
 821                     .IP {
 822                         if {$accept_RE} {
 823                             output-IP-list .IP $code $rest
 824                             continue
 825                         }
 826                         if {$manual(section) eq "ARGUMENTS" || \
 827                                 [regexp {^\[\d+\]$} $rest]} {
 828                             man-puts "$para<DT>$rest<DD>"
 829                         } elseif {"&#8226;" eq $rest} {
 830                             man-puts "$para<DT><DD>$rest&nbsp;"
 831                         } else {
 832                             man-puts "$para<DT>[long-toc $rest]<DD>"
 833                         }
 834                         if {"$manual(name):$manual(section)" eq \
 835                                 "selection:DESCRIPTION"} {
 836                             if {[match-text .RE @rest .RS .RS]} {
 837                                 man-puts <DT>[long-toc $rest]<DD>
 838                             }
 839                         }
 840                     }
 841                     .sp - .br - .DS - .CS {
 842                         output-directive $line
 843                     }
 844                     .RS {
 845                         if {[match-text .RS]} {
 846                             output-directive $line
 847                             incr accept_RE 1
 848                         } elseif {[match-text .CS]} {
 849                             output-directive .CS
 850                             incr accept_RE 1
 851                         } elseif {[match-text .PP]} {
 852                             output-directive .PP
 853                             incr accept_RE 1
 854                         } elseif {[match-text .DS]} {
 855                             output-directive .DS
 856                             incr accept_RE 1
 857                         } else {
 858                             output-directive $line
 859                         }
 860                     }
 861                     .PP {
 862                         if {[match-text @rest1 .br @rest2 .RS]} {
 863                             # yet another nroff kludge as above
 864                             man-puts "$para<DT>[long-toc $rest1]"
 865                             man-puts "<DT>[long-toc $rest2]<DD>"
 866                             incr accept_RE 1
 867                         } elseif {[match-text @rest .RE]} {
 868                             # gad, this is getting ridiculous
 869                             if {!$accept_RE} {
 870                                 man-puts "</DL><P>$rest<DL>"
 871                                 backup-text 1
 872                                 set para {}
 873                                 break
 874                             } else {
 875                                 man-puts "<P>$rest"
 876                                 incr accept_RE -1
 877                             }
 878                         } elseif {$accept_RE} {
 879                             output-directive $line
 880                         } else {
 881                             backup-text 1
 882                             break
 883                         }
 884                     }
 885                     .RE {
 886                         if {!$accept_RE} {
 887                             backup-text 1
 888                             break
 889                         }
 890                         incr accept_RE -1
 891                     }
 892                     default {
 893                         backup-text 1
 894                         break
 895                     }
 896                 }
 897             } else {
 898                 man-puts $line
 899             }
 900             set para <P>
 901         }
 902         man-puts "$para</DL>"
 903         lappend manual(section-toc) </DL>
 904         if {$accept_RE} {
 905             manerror "missing .RE in output-IP-list"
 906         }
 907     }
 908 }
 909 ##
 910 ## handle the NAME section lines
 911 ## there's only one line in the NAME section,
 912 ## consisting of a comma separated list of names,
 913 ## followed by a hyphen and a short description.
 914 ##
 915 proc output-name {line} {
 916     global manual
 917     # split name line into pieces
 918     regexp {^([^-]+) - (.*)$} $line all head tail
 919     # output line to manual page untouched
 920     man-puts $line
 921     # output line to long table of contents
 922     lappend manual(section-toc) <DL><DD>$line</DD></DL>
 923     # separate out the names for future reference
 924     foreach name [split $head ,] {
 925         set name [string trim $name]
 926         if {[llength $name] > 1} {
 927             manerror "name has a space: {$name}\nfrom: $line"
 928         }
 929         lappend manual(wing-toc) $name
 930         lappend manual(name-$name) $manual(wing-file)/$manual(name)
 931     }
 932 }
 933 ##
 934 ## build a cross-reference link if appropriate
 935 ##
 936 proc cross-reference {ref} {
 937     global manual
 938     if {[string match "Tcl_*" $ref]} {
 939         set lref $ref
 940     } elseif {[string match "Tk_*" $ref]} {
 941         set lref $ref
 942     } elseif {$ref eq "Tcl"} {
 943         set lref $ref
 944     } else {
 945         set lref [string tolower $ref]
 946     }
 947     ##
 948     ## nothing to reference
 949     ##
 950     if {![info exists manual(name-$lref)]} {
 951         foreach name {
 952             array file history info interp string trace after clipboard grab
 953             image option pack place selection tk tkwait update winfo wm
 954         } {
 955             if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
 956                     [info exists manual(name-$name)] && \
 957                     $manual(tail) ne "$name.n"} {
 958                 return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
 959             }
 960         }
 961         if {$lref in {stdin stdout stderr end}} {
 962             # no good place to send these
 963             # tcl tokens?
 964             # also end
 965         }
 966         return $ref
 967     }
 968     ##
 969     ## would be a self reference
 970     ##
 971     foreach name $manual(name-$lref) {
 972         if {"$manual(wing-file)/$manual(name)" in $name} {
 973             return $ref
 974         }
 975     }
 976     ##
 977     ## multiple choices for reference
 978     ##
 979     if {[llength $manual(name-$lref)] > 1} {
 980         set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]
 981         set tcl_ref [lindex $manual(name-$lref) $tcl_i]
 982         set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
 983         set tk_ref [lindex $manual(name-$lref) $tk_i]
 984         if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd"
 985                 || $manual(wing-file) eq "TclLib"} {
 986             return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
 987         }
 988         if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd"
 989                 || $manual(wing-file) eq "TkLib"} {
 990             return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
 991         }
 992         if {$lref eq "exit" && $manual(tail) eq "tclsh.1" && $tcl_i >= 0} {
 993             return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
 994         }
 995         puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"
 996         return $ref
 997     }
 998     ##
 999     ## exceptions, sigh, to the rule
1000     ##
1001     switch -exact -- $manual(tail) {
1002         canvas.n {
1003             if {$lref eq "focus"} {
1004                 upvar 1 tail tail
1005                 set clue [string first command $tail]
1006                 if {$clue < 0 ||  $clue > 5} {
1007                     return $ref
1008                 }
1009             }
1010             if {$lref in {bitmap image text}} {
1011                 return $ref
1012             }
1013         }
1014         checkbutton.n - radiobutton.n {
1015             if {$lref in {image}} {
1016                 return $ref
1017             }
1018         }
1019         menu.n {
1020             if {$lref in {checkbutton radiobutton}} {
1021                 return $ref
1022             }
1023         }
1024         options.n {
1025             if {$lref in {bitmap image set}} {
1026                 return $ref
1027             }
1028         }
1029         regexp.n {
1030             if {$lref in {string}} {
1031                 return $ref
1032             }
1033         }
1034         source.n {
1035             if {$lref in {text}} {
1036                 return $ref
1037             }
1038         }
1039         history.n {
1040             if {$lref in {exec}} {
1041                 return $ref
1042             }
1043         }
1044         return.n {
1045             if {$lref in {error continue break}} {
1046                 return $ref
1047             }
1048         }
1049         scrollbar.n {
1050             if {$lref in {set}} {
1051                 return $ref
1052             }
1053         }
1054     }
1055     ##
1056     ## return the cross reference
1057     ##
1058     return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"
1059 }
1060 ##
1061 ## reference generation errors
1062 ##
1063 proc reference-error {msg text} {
1064     global manual
1065     puts stderr "$manual(tail): $msg: {$text}"
1066     return $text
1067 }
1068 ##
1069 ## insert as many cross references into this text string as are appropriate
1070 ##
1071 proc insert-cross-references {text} {
1072     global manual
1073     ##
1074     ## we identify cross references by:
1075     ##     ``quotation''
1076     ##    <B>emboldening</B>
1077     ##    Tcl_ prefix
1078     ##    Tk_ prefix
1079     ##    [a-zA-Z0-9]+ manual entry
1080     ## and we avoid messing with already anchored text
1081     ##
1082     ##
1083     ## find where each item lives
1084     ##
1085     array set offset [list \
1086             anchor [string first {<A } $text] \
1087             end-anchor [string first {</A>} $text] \
1088             quote [string first {``} $text] \
1089             end-quote [string first {''} $text] \
1090             bold [string first {<B>} $text] \
1091             end-bold [string first {</B>} $text] \
1092             tcl [string first {Tcl_} $text] \
1093             tk [string first {Tk_} $text] \
1094             Tcl1 [string first {Tcl manual entry} $text] \
1095             Tcl2 [string first {Tcl overview manual entry} $text] \
1096             ]
1097     ##
1098     ## accumulate a list
1099     ##
1100     foreach name [array names offset] {
1101         if {$offset($name) >= 0} {
1102             set invert($offset($name)) $name
1103             lappend offsets $offset($name)
1104         }
1105     }
1106     ##
1107     ## if nothing, then we're done.
1108     ##
1109     if {![info exists offsets]} {
1110         return $text
1111     }
1112     ##
1113     ## sort the offsets
1114     ##
1115     set offsets [lsort -integer $offsets]
1116     ##
1117     ## see which we want to use
1118     ##
1119     switch -exact -- $invert([lindex $offsets 0]) {
1120         anchor {
1121             if {$offset(end-anchor) < 0} {
1122                 return [reference-error {Missing end anchor} $text]
1123             }
1124             set head [string range $text 0 $offset(end-anchor)]
1125             set tail [string range $text [expr {$offset(end-anchor)+1}] end]
1126             return $head[insert-cross-references $tail]
1127         }
1128         quote {
1129             if {$offset(end-quote) < 0} {
1130                 return [reference-error "Missing end quote" $text]
1131             }
1132             if {$invert([lindex $offsets 1]) eq "tk"} {
1133                 set offsets [lreplace $offsets 1 1]
1134             }
1135             if {$invert([lindex $offsets 1]) eq "tcl"} {
1136                 set offsets [lreplace $offsets 1 1]
1137             }
1138             switch -exact -- $invert([lindex $offsets 1]) {
1139                 end-quote {
1140                     set head [string range $text 0 [expr {$offset(quote)-1}]]
1141                     set body [string range $text [expr {$offset(quote)+2}] \
1142                             [expr {$offset(end-quote)-1}]]
1143                     set tail [string range $text \
1144                             [expr {$offset(end-quote)+2}] end]
1145                     return "$head``[cross-reference $body]''[insert-cross-references $tail]"
1146                 }
1147                 bold -
1148                 anchor {
1149                     set head [string range $text \
1150                             0 [expr {$offset(end-quote)+1}]]
1151                     set tail [string range $text \
1152                             [expr {$offset(end-quote)+2}] end]
1153                     return "$head[insert-cross-references $tail]"
1154                 }
1155             }
1156             return [reference-error "Uncaught quote case" $text]
1157         }
1158         bold {
1159             if {$offset(end-bold) < 0} {
1160                 return $text
1161             }
1162             if {$invert([lindex $offsets 1]) eq "tk"} {
1163                 set offsets [lreplace $offsets 1 1]
1164             }
1165             if {$invert([lindex $offsets 1]) eq "tcl"} {
1166                 set offsets [lreplace $offsets 1 1]
1167             }
1168             switch -exact -- $invert([lindex $offsets 1]) {
1169                 end-bold {
1170                     set head [string range $text 0 [expr {$offset(bold)-1}]]
1171                     set body [string range $text [expr {$offset(bold)+3}] \
1172                             [expr {$offset(end-bold)-1}]]
1173                     set tail [string range $text \
1174                             [expr {$offset(end-bold)+4}] end]
1175                     return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]"
1176                 }
1177                 anchor {
1178                     set head [string range $text \
1179                             0 [expr {$offset(end-bold)+3}]]
1180                     set tail [string range $text \
1181                             [expr {$offset(end-bold)+4}] end]
1182                     return "$head[insert-cross-references $tail]"
1183                 }
1184             }
1185             return [reference-error "Uncaught bold case" $text]
1186         }
1187         tk {
1188             set head [string range $text 0 [expr {$offset(tk)-1}]]
1189             set tail [string range $text $offset(tk) end]
1190             if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} {
1191                 return [reference-error "Tk regexp failed" $text]
1192             }
1193             return $head[cross-reference $body][insert-cross-references $tail]
1194         }
1195         tcl {
1196             set head [string range $text 0 [expr {$offset(tcl)-1}]]
1197             set tail [string range $text $offset(tcl) end]
1198             if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} {
1199                 return [reference-error {Tcl regexp failed} $text]
1200             }
1201             return $head[cross-reference $body][insert-cross-references $tail]
1202         }
1203         Tcl1 -
1204         Tcl2 {
1205             set off [lindex $offsets 0]
1206             set head [string range $text 0 [expr {$off-1}]]
1207             set body Tcl
1208             set tail [string range $text [expr {$off+3}] end]
1209             return $head[cross-reference $body][insert-cross-references $tail]
1210         }
1211         end-anchor -
1212         end-bold -
1213         end-quote {
1214             return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
1215         }
1216     }
1217 }
1218 ##
1219 ## process formatting directives
1220 ##
1221 proc output-directive {line} {
1222     global manual
1223     # process format directive
1224     split-directive $line code rest
1225     switch -exact -- $code {
1226         .BS - .BE {
1227             # man-puts <HR>
1228         }
1229         .SH - .SS {
1230             # drain any open lists
1231             # announce the subject
1232             set manual(section) $rest
1233             # start our own stack of stuff
1234             set manual($manual(name)-$manual(section)) {}
1235             lappend manual(has-$manual(section)) $manual(name)
1236             if {$code ne ".SS"} {
1237                 man-puts "<H3>[long-toc $manual(section)]</H3>"
1238             } else {
1239                 man-puts "<H4>[long-toc $manual(section)]</H4>"
1240             }
1241             # some sections can simply free wheel their way through the text
1242             # some sections can be processed in their own loops
1243             switch -exact -- $manual(section) {
1244                 NAME {
1245                     if {$manual(tail) in {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3}} {
1246                         # these manual pages have two NAME sections
1247                         if {[info exists manual($manual(tail)-NAME)]} {
1248                             return
1249                         }
1250                         set manual($manual(tail)-NAME) 1
1251                     }
1252                     set names {}
1253                     while {1} {
1254                         set line [next-text]
1255                         if {[is-a-directive $line]} {
1256                             backup-text 1
1257                             output-name [join $names { }]
1258                             return
1259                         } else {
1260                             lappend names [string trim $line]
1261                         }
1262                     }
1263                 }
1264                 SYNOPSIS {
1265                     lappend manual(section-toc) <DL>
1266                     while {1} {
1267                         if {
1268                             [next-op-is .nf rest]
1269                             || [next-op-is .br rest]
1270                             || [next-op-is .fi rest]
1271                         } then {
1272                             continue
1273                         }
1274                         if {
1275                             [next-op-is .SH rest]
1276                             || [next-op-is .SS rest]
1277                             || [next-op-is .BE rest]
1278                             || [next-op-is .SO rest]
1279                         } then {
1280                             backup-text 1
1281                             break
1282                         }
1283                         if {[next-op-is .sp rest]} {
1284                             #man-puts <P>
1285                             continue
1286                         }
1287                         set more [next-text]
1288                         if {[is-a-directive $more]} {
1289                             manerror "in SYNOPSIS found $more"
1290                             backup-text 1
1291                             break
1292                         }
1293                         foreach more [split $more \n] {
1294                             man-puts $more<BR>
1295                             if {$manual(wing-file) in {TclLib TkLib}} {
1296                                 lappend manual(section-toc) <DD>$more
1297                             }
1298                         }
1299                     }
1300                     lappend manual(section-toc) </DL>
1301                     return
1302                 }
1303                 {SEE ALSO} {
1304                     while {[more-text]} {
1305                         if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
1306                             backup-text 1
1307                             return
1308                         }
1309                         set more [next-text]
1310                         if {[is-a-directive $more]} {
1311                             manerror "$more"
1312                             backup-text 1
1313                             return
1314                         }
1315                         set nmore {}
1316                         foreach cr [split $more ,] {
1317                             set cr [string trim $cr]
1318                             if {![regexp {^<B>.*</B>$} $cr]} {
1319                                 set cr <B>$cr</B>
1320                             }
1321                             if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
1322                                 set cr <B>$name</B>
1323                             }
1324                             lappend nmore $cr
1325                         }
1326                         man-puts [join $nmore {, }]
1327                     }
1328                     return
1329                 }
1330                 KEYWORDS {
1331                     while {[more-text]} {
1332                         if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
1333                             backup-text 1
1334                             return
1335                         }
1336                         set more [next-text]
1337                         if {[is-a-directive $more]} {
1338                             manerror "$more"
1339                             backup-text 1
1340                             return
1341                         }
1342                         set keys {}
1343                         foreach key [split $more ,] {
1344                             set key [string trim $key]
1345                             lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm]
1346                             set initial [string toupper [string index $key 0]]
1347                             lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
1348                         }
1349                         man-puts [join $keys {, }]
1350                     }
1351                     return
1352                 }
1353             }
1354             if {[next-op-is .IP rest]} {
1355                 output-IP-list $code .IP $rest
1356                 return
1357             }
1358             if {[next-op-is .PP rest]} {
1359                 return
1360             }
1361             return
1362         }
1363         .SO {
1364             # When there's a sequence of multiple .SO chunks, process into one
1365             set optslist {}
1366             while 1 {
1367                 if {[match-text @stuff .SE]} {
1368                     foreach opt [split $stuff \n\t] {
1369                         lappend optslist [list $opt $rest]
1370                     }
1371                 } else {
1372                     manerror "unexpected .SO format:\n[expand-next-text 2]"
1373                 }
1374                 if {![next-op-is .SO rest]} {
1375                     break
1376                 }
1377             }
1378             output-directive {.SH STANDARD OPTIONS}
1379             man-puts <DL>
1380             lappend manual(section-toc) <DL>
1381             foreach optionpair [lsort -dictionary -index 0 $optslist] {
1382                 lassign $optionpair option targetPage
1383                 man-puts "<DT><B>[std-option-toc $option $targetPage]</B>"
1384             }
1385             man-puts </DL>
1386             lappend manual(section-toc) </DL>
1387         }
1388         .OP {
1389             output-widget-options $rest
1390             return
1391         }
1392         .IP {
1393             output-IP-list .IP .IP $rest
1394             return
1395         }
1396         .PP {
1397             man-puts <P>
1398         }
1399         .RS {
1400             output-RS-list
1401             return
1402         }
1403         .RE {
1404             manerror "unexpected .RE"
1405             return
1406         }
1407         .br {
1408             man-puts <BR>
1409             return
1410         }
1411         .DE {
1412             manerror "unexpected .DE"
1413             return
1414         }
1415         .DS {
1416             if {[next-op-is .ta rest]} {
1417                 # skip the leading .ta directive if it is there
1418             }
1419             if {[match-text @stuff .DE]} {
1420                 set td "<td><p style=\"font-size:12px;padding-left:.5em;padding-right:.5em;\">"
1421                 set bodyText [string map [list \n <tr>$td \t $td] \n$stuff]
1422                 man-puts "<dl><dd><table border=\"0\">$bodyText</table></dl>"
1423                 #man-puts <PRE>$stuff</PRE>
1424             } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} {
1425                 man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>"
1426             } else {
1427                 manerror "unexpected .DS format:\n[expand-next-text 2]"
1428             }
1429             return
1430         }
1431         .CS {
1432             if {[next-op-is .ta rest]} {
1433                 # ???
1434             }
1435             if {[match-text @stuff .CE]} {
1436                 man-puts <PRE>$stuff</PRE>
1437             } else {
1438                 manerror "unexpected .CS format:\n[expand-next-text 2]"
1439             }
1440             return
1441         }
1442         .CE {
1443             manerror "unexpected .CE"
1444             return
1445         }
1446         .sp {
1447             man-puts <P>
1448         }
1449         .ta {
1450             # these are tab stop settings for short tables
1451             switch -exact -- $manual(name):$manual(section) {
1452                 {bind:MODIFIERS} -
1453                 {bind:EVENT TYPES} -
1454                 {bind:BINDING SCRIPTS AND SUBSTITUTIONS} -
1455                 {expr:OPERANDS} -
1456                 {expr:MATH FUNCTIONS} -
1457                 {history:DESCRIPTION} -
1458                 {history:HISTORY REVISION} -
1459                 {switch:DESCRIPTION} -
1460                 {upvar:DESCRIPTION} {
1461                     return;                     # fix.me
1462                 }
1463                 default {
1464                     manerror "ignoring $line"
1465                 }
1466             }
1467         }
1468         .nf {
1469             if {[match-text @more .fi]} {
1470                 foreach more [split $more \n] {
1471                     man-puts $more<BR>
1472                 }
1473             } elseif {[match-text .RS @more .RE .fi]} {
1474                 man-puts <DL><DD>
1475                 foreach more [split $more \n] {
1476                     man-puts $more<BR>
1477                 }
1478                 man-puts </DL>
1479             } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} {
1480                 man-puts <DL><DD>
1481                 foreach more [split $more \n] {
1482                     man-puts $more<BR>
1483                 }
1484                 man-puts <DL><DD>
1485                 foreach more2 [split $more2 \n] {
1486                     man-puts $more2<BR>
1487                 }
1488                 man-puts </DL></DL>
1489             } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} {
1490                 man-puts <DL><DD>
1491                 foreach more [split $more \n] {
1492                     man-puts $more<BR>
1493                 }
1494                 man-puts <DL><DD>
1495                 foreach more2 [split $more2 \n] {
1496                     man-puts $more2<BR>
1497                 }
1498                 man-puts </DL><DD>
1499                 foreach more3 [split $more3 \n] {
1500                     man-puts $more3<BR>
1501                 }
1502                 man-puts </DL>
1503             } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} {
1504                 man-puts <P><DL><DD>
1505                 foreach more [split $more \n] {
1506                     man-puts $more<BR>
1507                 }
1508                 man-puts <DL><DD>
1509                 foreach more2 [split $more2 \n] {
1510                     man-puts $more2<BR>
1511                 }
1512                 man-puts </DL></DL><P>
1513             } elseif {[match-text .RS .sp @more .sp .RE .fi]} {
1514                 man-puts <P><DL><DD>
1515                 foreach more [split $more \n] {
1516                     man-puts $more<BR>
1517                 }
1518                 man-puts </DL><P>
1519             } else {
1520                 manerror "ignoring $line"
1521             }
1522         }
1523         .fi {
1524             manerror "ignoring $line"
1525         }
1526         .na -
1527         .ad -
1528         .nr -
1529         .if -
1530         .UL -
1531         .ne {
1532             manerror "ignoring $line"
1533         }
1534         .\\\" {
1535             manerror "ignoring comment $line"
1536         }
1537         default {
1538             manerror "unrecognized format directive: $line"
1539         }
1540     }
1541 }
1542 ##
1543 ## merge copyright listings
1544 ##
1545 proc merge-copyrights {l1 l2} {
1546     set merge {}
1547     set re1 {^Copyright +(?:\(c\)|\\\(co|&copy;) +(\w.*?)(?:all rights reserved)?(?:\. )*$}
1548     set re2 {^(\d+) +(?:by +)?(\w.*)$}         ;# date who
1549     set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$}   ;# from to who
1550     set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who
1551     foreach copyright [concat $l1 $l2] {
1552         if {[regexp -nocase -- $re1 $copyright -> info]} {
1553             set info [string trimright $info ". "] ; # remove extra period
1554             if {[regexp -- $re2 $info -> date who]} {
1555                 lappend dates($who) $date
1556                 continue
1557             } elseif {[regexp -- $re3 $info -> from to who]} {
1558                 for {set date $from} {$date <= $to} {incr date} {
1559                     lappend dates($who) $date
1560                 }
1561                 continue
1562             } elseif {[regexp -- $re3 $info -> date1 date2 who]} {
1563                 lappend dates($who) $date1 $date2
1564                 continue
1565             }
1566         }
1567         puts "oops: $copyright"
1568     }
1569     foreach who [array names dates] {
1570         set list [lsort -dictionary $dates($who)]
1571         if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} {
1572             lappend merge "Copyright &copy; [lindex $list 0] $who"
1573         } else {
1574             lappend merge "Copyright &copy; [lindex $list 0]-[lrange $list end end] $who"
1575         }
1576     }
1577     return [lsort -dictionary $merge]
1578 }
1579
1580 proc makedirhier {dir} {
1581     if {![file isdirectory $dir] && \
1582             [catch {file mkdir $dir} error]} {
1583         return -code error "cannot create directory $dir: $error"
1584     }
1585 }
1586
1587 proc addbuffer {args} {
1588     global manual
1589     if {$manual(partial-text) ne ""} {
1590         append manual(partial-text) \n
1591     }
1592     append manual(partial-text) [join $args ""]
1593 }
1594 proc flushbuffer {} {
1595     global manual
1596     if {$manual(partial-text) ne ""} {
1597         lappend manual(text) [process-text $manual(partial-text)]
1598         set manual(partial-text) ""
1599     }
1600 }
1601
1602 ##
1603 ## foreach of the man directories specified by args
1604 ## convert manpages into hypertext in the directory
1605 ## specified by html.
1606 ##
1607 proc make-man-pages {html args} {
1608     global manual overall_title tcltkdesc
1609     makedirhier $html
1610     set cssfd [open $html/$::CSSFILE w]
1611     puts $cssfd [gencss]
1612     close $cssfd
1613     set manual(short-toc-n) 1
1614     set manual(short-toc-fp) [open $html/[indexfile] w]
1615     puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title]
1616     puts $manual(short-toc-fp) "<DL class=\"keylist\">"
1617     set manual(merge-copyrights) {}
1618     foreach arg $args {
1619         # preprocess to set up subheader for the rest of the files
1620         if {![llength $arg]} {
1621             continue
1622         }
1623         set name [lindex $arg 1]
1624         set file [lindex $arg 2]
1625         lappend manual(subheader) $name $file
1626     }
1627     foreach arg $args {
1628         if {![llength $arg]} {
1629             continue
1630         }
1631         set manual(wing-glob) [lindex $arg 0]
1632         set manual(wing-name) [lindex $arg 1]
1633         set manual(wing-file) [lindex $arg 2]
1634         set manual(wing-description) [lindex $arg 3]
1635         set manual(wing-copyrights) {}
1636         makedirhier $html/$manual(wing-file)
1637         set manual(wing-toc-fp) [open $html/$manual(wing-file)/[indexfile] w]
1638         # whistle
1639         puts stderr "scanning section $manual(wing-name)"
1640         # put the entry for this section into the short table of contents
1641         puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>"
1642         # initialize the wing table of contents
1643         puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \
1644                 $manual(wing-name) $overall_title "../[indexfile]"]
1645         # initialize the short table of contents for this section
1646         set manual(wing-toc) {}
1647         # initialize the man directory for this section
1648         makedirhier $html/$manual(wing-file)
1649         # initialize the long table of contents for this section
1650         set manual(long-toc-n) 1
1651         # get the manual pages for this section
1652         set manual(pages) [lsort -dictionary [glob $manual(wing-glob)]]
1653         set n [lsearch -glob $manual(pages) */ttk_widget.n]
1654         if {$n >= 0} {
1655             set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
1656         }
1657         set n [lsearch -glob $manual(pages) */options.n]
1658         if {$n >= 0} {
1659             set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
1660         }
1661         # set manual(pages) [lrange $manual(pages) 0 5]
1662         set LQ \u201c
1663         set RQ \u201d
1664         foreach manual_page $manual(pages) {
1665             set manual(page) $manual_page
1666             # whistle
1667             puts stderr "scanning page $manual(page)"
1668             set manual(tail) [file tail $manual(page)]
1669             set manual(name) [file root $manual(tail)]
1670             set manual(section) {}
1671             if {$manual(name) in {case pack-old menubar}} {
1672                 # obsolete
1673                 manerror "discarding $manual(name)"
1674                 continue
1675             }
1676             set manual(infp) [open $manual(page)]
1677             set manual(text) {}
1678             set manual(partial-text) {}
1679             foreach p {.RS .DS .CS .SO} {
1680                 set manual($p) 0
1681             }
1682             set manual(stack) {}
1683             set manual(section) {}
1684             set manual(section-toc) {}
1685             set manual(section-toc-n) 1
1686             set manual(copyrights) {}
1687             lappend manual(all-pages) $manual(wing-file)/$manual(tail)
1688             manreport 100 $manual(name)
1689             set ignored 0
1690             while {[gets $manual(infp) line] >= 0} {
1691                 manreport 100 $line
1692                 if {"$line" eq "'\\\" IGNORE"} {
1693                     set ignored 1
1694                     continue
1695                 }
1696                 if {"$line" eq "'\\\" END IGNORE"} {
1697                     set ignored 0
1698                     continue
1699                 }
1700                 if {$ignored} {
1701                     continue
1702                 }
1703                 if {[regexp {^[`'][/\\]} $line]} {
1704                     if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} {
1705                         lappend manual(copyrights) $copyright
1706                     }
1707                     # comment
1708                     continue
1709                 }
1710                 if {"$line" eq {'}} {
1711                     # comment
1712                     continue
1713                 }
1714                 if {![parse-directive $line code rest]} {
1715                     addbuffer $line
1716                     continue
1717                 }
1718                 switch -exact -- $code {
1719                     .ad - .na - .so - .ne - .AS - .VE - .VS - . {
1720                         # ignore
1721                         continue
1722                     }
1723                 }
1724                 switch -exact -- $code {
1725                     .SH - .SS {
1726                         flushbuffer
1727                         if {[llength $rest] == 0} {
1728                             gets $manual(infp) rest
1729                         }
1730                         lappend manual(text) "$code [unquote $rest]"
1731                     }
1732                     .TH {
1733                         flushbuffer
1734                         lappend manual(text) "$code [unquote $rest]"
1735                     }
1736                     .QW {
1737                         set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
1738                         addbuffer $LQ [unquote [lindex $rest 0]] $RQ \
1739                             [unquote [lindex $rest 1]]
1740                     }
1741                     .PQ {
1742                         set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
1743                         addbuffer ( $LQ [unquote [lindex $rest 0]] $RQ \
1744                             [unquote [lindex $rest 1]] ) \
1745                             [unquote [lindex $rest 2]]
1746                     }
1747                     .QR {
1748                         set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
1749                         addbuffer $LQ [unquote [lindex $rest 0]] - \
1750                             [unquote [lindex $rest 1]] $RQ \
1751                             [unquote [lindex $rest 2]]
1752                     }
1753                     .MT {
1754                         addbuffer $LQ$RQ
1755                     }
1756                     .HS - .UL - .ta {
1757                         flushbuffer
1758                         lappend manual(text) "$code [unquote $rest]"
1759                     }
1760                     .BS - .BE - .br - .fi - .sp - .nf {
1761                         flushbuffer
1762                         if {"$rest" ne {}} {
1763                             manerror "unexpected argument: $line"
1764                         }
1765                         lappend manual(text) $code
1766                     }
1767                     .AP {
1768                         flushbuffer
1769                         lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
1770                     }
1771                     .IP {
1772                         flushbuffer
1773                         regexp {^(.*) +\d+$} $rest all rest
1774                         lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
1775                     }
1776                     .TP {
1777                         flushbuffer
1778                         while {[is-a-directive [set next [gets $manual(infp)]]]} {
1779                             manerror "ignoring $next after .TP"
1780                         }
1781                         if {"$next" ne {'}} {
1782                             lappend manual(text) ".IP [process-text $next]"
1783                         }
1784                     }
1785                     .OP {
1786                         flushbuffer
1787                         lappend manual(text) [concat .OP [process-text \
1788                                 "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
1789                     }
1790                     .PP - .LP {
1791                         flushbuffer
1792                         lappend manual(text) {.PP}
1793                     }
1794                     .RS {
1795                         flushbuffer
1796                         incr manual(.RS)
1797                         lappend manual(text) $code
1798                     }
1799                     .RE {
1800                         flushbuffer
1801                         incr manual(.RS) -1
1802                         lappend manual(text) $code
1803                     }
1804                     .SO {
1805                         flushbuffer
1806                         incr manual(.SO)
1807                         if {[llength $rest] == 0} {
1808                             lappend manual(text) "$code options"
1809                         } else {
1810                             lappend manual(text) "$code [unquote $rest]"
1811                         }
1812                     }
1813                     .SE {
1814                         flushbuffer
1815                         incr manual(.SO) -1
1816                         lappend manual(text) $code
1817                     }
1818                     .DS {
1819                         flushbuffer
1820                         incr manual(.DS)
1821                         lappend manual(text) $code
1822                     }
1823                     .DE {
1824                         flushbuffer
1825                         incr manual(.DS) -1
1826                         lappend manual(text) $code
1827                     }
1828                     .CS {
1829                         flushbuffer
1830                         incr manual(.CS)
1831                         lappend manual(text) $code
1832                     }
1833                     .CE {
1834                         flushbuffer
1835                         incr manual(.CS) -1
1836                         lappend manual(text) $code
1837                     }
1838                     .de {
1839                         while {[gets $manual(infp) line] >= 0} {
1840                             if {[string match "..*" $line]} {
1841                                 break
1842                             }
1843                         }
1844                     }
1845                     .. {
1846                         error "found .. outside of .de"
1847                     }
1848                     default {
1849                         flushbuffer
1850                         manerror "unrecognized format directive: $line"
1851                     }
1852                 }
1853             }
1854             flushbuffer
1855             close $manual(infp)
1856             # fixups
1857             if {$manual(.RS) != 0} {
1858                 puts "unbalanced .RS .RE"
1859             }
1860             if {$manual(.DS) != 0} {
1861                 puts "unbalanced .DS .DE"
1862             }
1863             if {$manual(.CS) != 0} {
1864                 puts "unbalanced .CS .CE"
1865             }
1866             if {$manual(.SO) != 0} {
1867                 puts "unbalanced .SO .SE"
1868             }
1869             # output conversion
1870             open-text
1871             set haserror 0
1872             if {[next-op-is .HS rest]} {
1873                 set manual($manual(name)-title) \
1874                         "[lrange $rest 1 end] [lindex $rest 0] manual page"
1875             } elseif {[next-op-is .TH rest]} {
1876                 set manual($manual(name)-title) "[lindex $rest 0] manual page - [lrange $rest 4 end]"
1877             } else {
1878                 set haserror 1
1879                 manerror "no .HS or .TH record found"
1880             }
1881             if {!$haserror} {
1882                 while {[more-text]} {
1883                     set line [next-text]
1884                     if {[is-a-directive $line]} {
1885                         output-directive $line
1886                     } else {
1887                         man-puts $line
1888                     }
1889                 }
1890                 man-puts [copyout $manual(copyrights) "../"]
1891                 set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
1892             }
1893             #
1894             # make the long table of contents for this page
1895             #
1896             set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL>]
1897         }
1898
1899         #
1900         # make the wing table of contents for the section
1901         #
1902         set width 0
1903         foreach name $manual(wing-toc) {
1904             if {[string length $name] > $width} {
1905                 set width [string length $name]
1906             }
1907         }
1908         set perline [expr {120 / $width}]
1909         set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
1910         set n 0
1911         catch {unset rows}
1912         foreach name [lsort -dictionary $manual(wing-toc)] {
1913             set tail $manual(name-$name)
1914             if {[llength $tail] > 1} {
1915                 manerror "$name is defined in more than one file: $tail"
1916                 set tail [lindex $tail [expr {[llength $tail]-1}]]
1917             }
1918             set tail [file tail $tail]
1919             append rows([expr {$n%$nrows}]) \
1920                     "<td> <a href=\"$tail.htm\">$name</a>"
1921             incr n
1922         }
1923         puts $manual(wing-toc-fp) <table>
1924         foreach row [lsort -integer [array names rows]] {
1925             puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
1926         }
1927         puts $manual(wing-toc-fp) </table>
1928
1929         #
1930         # insert wing copyrights
1931         #
1932         puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"]
1933         puts $manual(wing-toc-fp) $::logo
1934         puts $manual(wing-toc-fp) "</BODY></HTML>"
1935         close $manual(wing-toc-fp)
1936         set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
1937     }
1938
1939     ##
1940     ## build the keyword index.
1941     ##
1942     file delete -force -- $html/Keywords
1943     makedirhier $html/Keywords
1944     set keyfp [open $html/Keywords/[indexfile] w]
1945     puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \
1946                      $overall_title "../[indexfile]"]
1947     set letters {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}
1948     # Create header first
1949     set keyheader {}
1950     foreach a $letters {
1951         set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
1952         if {[llength $keys]} {
1953             lappend keyheader "<A HREF=\"$a.htm\">$a</A>"
1954         } else {
1955             # No keywords for this letter
1956             lappend keyheader $a
1957         }
1958     }
1959     set keyheader "<H3>[join $keyheader " |\n"]</H3>"
1960     puts $keyfp $keyheader
1961     foreach a $letters {
1962         set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
1963         if {![llength $keys]} {
1964             continue
1965         }
1966         # Per-keyword page
1967         set afp [open $html/Keywords/$a.htm w]
1968         puts $afp [htmlhead "$tcltkdesc Keywords - $a" \
1969                        "$tcltkdesc Keywords - $a" \
1970                        $overall_title "../[indexfile]"]
1971         puts $afp $keyheader
1972         puts $afp "<DL class=\"keylist\">"
1973         foreach k [lsort -dictionary $keys] {
1974             set k [string range $k 8 end]
1975             puts $afp "<DT><A NAME=\"$k\">$k</A></DT>"
1976             puts $afp "<DD>"
1977             set refs {}
1978             foreach man $manual(keyword-$k) {
1979                 set name [lindex $man 0]
1980                 set file [lindex $man 1]
1981                 lappend refs "<A HREF=\"../$file\">$name</A>"
1982             }
1983             puts $afp "[join $refs {, }]</DD>"
1984         }
1985         puts $afp "</DL>"
1986         # insert merged copyrights
1987         puts $afp [copyout $manual(merge-copyrights)]
1988         puts $afp $::logo
1989         puts $afp "</BODY></HTML>"
1990         close $afp
1991     }
1992     # insert merged copyrights
1993     puts $keyfp [copyout $manual(merge-copyrights)]
1994     puts $keyfp $::logo
1995     puts $keyfp "</BODY></HTML>"
1996     close $keyfp
1997
1998     ##
1999     ## finish off short table of contents
2000     ##
2001     puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/[indexfile]\">Keywords</A><DD>The keywords from the $tcltkdesc man pages."
2002     puts $manual(short-toc-fp) "</DL>"
2003     # insert merged copyrights
2004     puts $manual(short-toc-fp) [copyout $manual(merge-copyrights)]
2005     puts $manual(short-toc-fp) $::logo
2006     puts $manual(short-toc-fp) "</BODY></HTML>"
2007     close $manual(short-toc-fp)
2008
2009     ##
2010     ## output man pages
2011     ##
2012     unset manual(section)
2013     foreach path $manual(all-pages) {
2014         set manual(wing-file) [file dirname $path]
2015         set manual(tail) [file tail $path]
2016         set manual(name) [file root $manual(tail)]
2017         set text $manual(output-$manual(wing-file)-$manual(name))
2018         set ntext 0
2019         foreach item $text {
2020             incr ntext [llength [split $item \n]]
2021             incr ntext
2022         }
2023         set toc $manual(toc-$manual(wing-file)-$manual(name))
2024         set ntoc 0
2025         foreach item $toc {
2026             incr ntoc [llength [split $item \n]]
2027             incr ntoc
2028         }
2029         puts stderr "rescanning page $manual(name) $ntoc/$ntext"
2030         set outfd [open $html/$manual(wing-file)/$manual(name).htm w]
2031         puts $outfd [htmlhead "$manual($manual(name)-title)" \
2032                 $manual(name) $manual(wing-file) "[indexfile]" \
2033                 $overall_title "../[indexfile]"]
2034         if {
2035             (($ntext > 60) && ($ntoc > 32)) || $manual(tail) in {
2036                 Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType
2037                 CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash
2038                 GetJustify GetPixels GetVisual ParseArgv QueueEvent
2039             }
2040         } then {
2041             foreach item $toc {
2042                 puts $outfd $item
2043             }
2044         }
2045         foreach item $text {
2046             puts $outfd [insert-cross-references $item]
2047         }
2048         puts $outfd $::logo
2049         puts $outfd "</BODY></HTML>"
2050         close $outfd
2051     }
2052     return {}
2053 }
2054
2055 parse_command_line
2056
2057 set tcltkdesc ""; set cmdesc ""; set appdir ""
2058 if {$build_tcl} {
2059     append tcltkdesc "Tcl"
2060     append cmdesc "Tcl"
2061     append appdir "$tcldir"
2062 }
2063 if {$build_tcl && $build_tk} {
2064     append tcltkdesc "/"
2065     append cmdesc " and "
2066     append appdir ","
2067 }
2068 if {$build_tk} {
2069     append tcltkdesc "Tk"
2070     append cmdesc "Tk"
2071     append appdir "$tkdir"
2072 }
2073 if {!$build_tcl && !$build_tk} {
2074     set cmdesc "Tcl DataBase Connectivity"
2075     set tcltkdesc "TDBC"
2076     set sep {}
2077 } else {
2078     set sep ,
2079 }
2080 if {$build_tdbc} {
2081     append appdir $sep $tdbcdir
2082     set sep ,
2083 }
2084 if {$build_tdbcodbc} {
2085     append appdir $sep $tdbcodbcdir
2086     set sep ,
2087 }
2088 if {$build_tdbcsqlite3} {
2089     append appdir $sep $tdbcsqlite3dir
2090     set sep ,
2091 }
2092 if {$build_tdbcmysql} {
2093     append appdir $sep $tdbcmysqldir
2094     set sep ,
2095 }
2096 if {$build_tdbcpostgres} {
2097     append appdir $sep $tdbcpostgresdir
2098     set sep ,
2099 }
2100
2101 set usercmddesc "The interpreters which implement $cmdesc."
2102 set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.}
2103 set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.}
2104 set tcllibdesc {The C functions which a Tcl extended C program may use.}
2105 set tklibdesc {The additional C functions which a Tk extended C program may use.}
2106 set tdbcdesc {The commands that are implemented by Tcl DataBase Connectivity (TDBC)}
2107 set tdbclibdesc {The C functions that are implemented by Tcl DataBase Connectivity (TDBC)}
2108 set tdbcodbcdesc {The ODBC driver for Tcl DataBase Connectivity (TDBC)}
2109 set tdbcsqlite3desc {The Sqlite3 driver for Tcl DataBase Connectivity (TDBC)}
2110 set tdbcmysqldesc {The MySQL driver for Tcl DataBase Connectivity (TDBC)}
2111 set tdbcpostgresdesc {The Postgres driver for Tcl DataBase Connectivity (TDBC)}
2112
2113
2114 if {[catch {
2115     make-man-pages $webdir \
2116         [expr {($build_tcl || $build_tk) ? "$tcltkdir/{$appdir}/doc/*.1 \"$tcltkdesc Applications\" UserCmd {$usercmddesc}" : ""}] \
2117         [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" : ""}] \
2118         [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" : ""}] \
2119         [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" : ""}] \
2120         [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" : ""}] \
2121         [expr {$build_tdbc ? "$tcltkdir/$tdbcdir/doc/*.n {Tcl Database Connectivity} TDBC {$tdbcdesc}" : ""}] \
2122         [expr {$build_tdbcodbc ? "$tcltkdir/$tdbcodbcdir/doc/*.n {TDBC-ODBC Bridge} Tdbcodbc {$tdbcodbcdesc}" : ""}] \
2123         [expr {$build_tdbcsqlite3 ? "$tcltkdir/$tdbcsqlite3dir/doc/*.n {TDBC driver for Sqlite3} Tdbcsqlite3 {$tdbcsqlite3desc}" : ""}] \
2124         [expr {$build_tdbcmysql ? "$tcltkdir/$tdbcmysqldir/doc/*.n {TDBC driver for MySQL} Tdbcmysql {$tdbcmysqldesc}" : ""}] \
2125         [expr {$build_tdbcpostgres ? "$tcltkdir/$tdbcpostgresdir/doc/*.n {TDBC driver for Postgres} Tdbcpostgres {$tdbcpostgresdesc}" : ""}] \
2126         [expr {$build_tdbc ? "$tcltkdir/$tdbcdir/doc/*.3 {Tcl Database Connectivity C API} TdbcLib {$tdbclibdesc}" : ""}] \
2127 } error]} {
2128     puts $error\n$errorInfo
2129 }
2130
2131 # Local Variables:
2132 # mode: tcl
2133 # End: