contrib/tcsh/tcsh.man2html

   1 : # -*- perl -*-
   2
   3 # tcsh.man2html, Dave Schweisguth <dcs@proton.chem.yale.edu>
   4 #
   5 # Notes:
   6 #
   7 # Always puts all files in the directory tcsh.html, creating it if necessary.
   8 # tcsh.html/top.html is the entry point, and tcsh.html/index.html is a symlink
   9 # to tcsh.html/top.html so one needn't specify a file at all if working through
  10 # a typically configured server.
  11 #
  12 # Designed for tcsh manpage. Guaranteed not to work on manpages not written
  13 # in the exact same style of nroff -man, i.e. any other manpage.
  14 #
  15 # Makes links FROM items which are both a) in particular sections (see
  16 # Configuration) and b) marked with .B or .I. Makes links TO items which
  17 # are marked with \fB ... \fR or \fI ... \fR.
  18 #
  19 # Designed with X Mosaic in mind and tested lightly with lynx. I've punted on
  20 # HTML's lack of a .PD equivalent and lynx's different <menu> handling.
  21
  22 # Emulate #!/usr/local/bin/perl on systems without #!
  23
  24 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
  25 & eval 'exec perl -S $0 $argv:q' if 0;
  26
  27 ### Constants
  28
  29 # Setup
  30
  31 ($whatami = $0) =~ s|.*/||;     # `basename $0`
  32 $isatty         = -t STDIN;
  33
  34 # Configuration
  35
  36 $index          = 0;            # Don't make a searchable index CGI script
  37 $cgibin         = 0;            # Look for $cgifile in $dir, not $cgibindir
  38 $shortfiles     = 0;            # Use long filenames
  39 $single         = 0;            # Make single page instead of top and sections
  40
  41 $host           = '';           # host:port part of server URL ***
  42 $updir          = '';           # Directories between $host and $dir ***
  43 $dir            = 'tcsh';       # Directory in which to put the pieces *
  44 $cgifile        = 'tcsh.cgi';   # CGI script name **
  45 $cgibindir      = 'cgi-bin';    # CGI directory ***
  46 $headerfile     = 'header';     # HTML file for initial comments *
  47 $indexfile      = 'index';      # Symlink to $topfile *
  48 $listsfile      = 'lists';      # Mailing list description HTML file *
  49 $outfile        = 'tcsh.man';   # Default input file and copy of input file
  50 $script         = $whatami;     # Copy of script; filename length must be OK
  51 $topfile        = 'top';        # Top-level HTML file *
  52
  53 # *   .htm or .html suffix added later
  54 # **  Only used with -i or -c
  55 # *** Only used with -c
  56
  57 # Sections to inline in the top page
  58
  59 %inline_me      = ('NAME',      1,
  60                    'SYNOPSIS',  1);
  61
  62 # Sections in which to put name anchors and the font in which to look for
  63 # links to those anchors
  64
  65 %link_me        = ('Editor commands',           'I',
  66                    'Builtin commands',          'I',
  67                    'Special aliases',           'I',
  68                    'Special shell variables',   'B',
  69                    'ENVIRONMENT',               'B',
  70                    'FILES',                     'I');
  71
  72 ### Arguments and error-checking
  73
  74 # Parse args
  75
  76 while ($#ARGV > -1 && (($first, $rest) = ($ARGV[0] =~ /^-(.)(.*)/))) {
  77     # Perl 5 lossage alert
  78     if ($first =~ /[CdDGh]/) {  # Switches with arguments
  79         shift;
  80         $arg = $rest ne '' ? $rest : $ARGV[0] ne '' ? shift :
  81             &usage("$whatami: -$first requires an argument.\n");
  82     } elsif ($rest ne '') {
  83         $ARGV[0] = "-$rest";
  84     } else {
  85         shift;
  86     }
  87     if    ($first eq '1')   { $single = 1; }
  88     elsif ($first eq 'c')   { $cgibin = 1; }
  89     elsif ($first eq 'C')   { $cgibindir = $arg; }
  90     elsif ($first eq 'd')   { $updir = $arg; }
  91     elsif ($first eq 'D')   { $dir = $arg; }
  92     elsif ($first eq 'G')   { $cgifile = $arg; }
  93     elsif ($first eq 'h')   { $host = $arg; }
  94     elsif ($first eq 'i')   { $index = 1; }
  95     elsif ($first eq 's')   { $shortfiles = 1; }
  96     elsif ($first eq 'u')   { &usage(0); }
  97     else                    { &usage("$whatami: -$first is not an option.\n"); }
  98 }
  99
 100 if (@ARGV == 0) {
 101     if ($isatty) {
 102         $infile = $outfile;             # Default input file if interactive
 103     } else {
 104         $infile = 'STDIN';              # Read STDIN if no args and not a tty
 105     }
 106 } elsif (@ARGV == 1) {
 107     $infile = $ARGV[0];
 108 } else {
 109     &usage("$whatami: Please specify one and only one file.\n");
 110 }
 111
 112 $index = $index || $cgibin;             # $index is true if $cgibin is true
 113
 114 if ($cgibin && ! $host) {
 115     die "$whatami: Must specify host with -h if using -c.\n";
 116 }
 117
 118 # Decide on HTML suffix and append it to filenames
 119
 120 $html = $shortfiles ? 'htm' : 'html';   # Max 3-character extension
 121 $dir            .= ".$html";            # Directory in which to put the pieces
 122 $headerfile     .= ".$html";            # HTML file for initial comments
 123 $topfile        .= ".$html";            # Top-level HTML file (or moved notice)
 124 $indexfile      .= ".$html";            # Symlink to $topfile
 125 $listsfile      .= ".$html";            # Mailing list description HTML file
 126
 127 # Check for input file
 128
 129 unless ($infile eq 'STDIN') {
 130     die "$whatami: $infile doesn't exist!\n"    unless -e $infile;
 131     die "$whatami: $infile is unreadable!\n"    unless -r _;
 132     die "$whatami: $infile is empty!\n"         unless -s _;
 133 }
 134
 135 # Check for output directory and create if necessary
 136
 137 if (-e $dir) {
 138     -d _ || die "$whatami: $dir is not a directory!\n";
 139     -r _ && -w _ && -x _ || die "$whatami: $dir is inaccessible!\n"
 140 } else {
 141     mkdir($dir, 0755) || die "$whatami: Can't create $dir!\n";
 142 }
 143
 144 # Slurp manpage
 145
 146 if ($infile eq 'STDIN') {
 147     @man = <STDIN>;
 148 } else {
 149     open(MAN, $infile) || die "$whatami: Error opening $infile!\n";
 150     @man = <MAN>;
 151     close MAN;
 152 }
 153
 154 # Print manpage to HTML directory (can't use cp if we're reading from STDIN)
 155
 156 open(MAN, ">$dir/$outfile") || die "$whatami: Can't open $dir/$outfile!\n";
 157 print MAN @man;
 158 close MAN;
 159
 160 # Copy script to HTML directory
 161
 162 (system("cp $0 $dir") >> 8) && die "$whatami: Can't copy $0 to $dir!\n";
 163
 164 # Link top.html to index.html in case someone looks at tcsh.html/
 165
 166 system("rm -f $dir/$indexfile");    # Some systems can't ln -sf
 167 (system("ln -s $topfile $dir/$indexfile") >> 8)
 168     && die "$whatami: Can't link $topfile to $dir/$indexfile!\n";
 169
 170 ### Get title and section headings
 171
 172 $comment = 0;                       # 0 for text, 1 for ignored text
 173 @sectionlines = (0);                # First line of section
 174 @sectiontypes = (0);                # H or S
 175 @sectiontexts = ('Header');         # Text of section heading
 176 @sectionfiles = ($headerfile);      # Filename in which to store section
 177 %name = ();                         # Array of name anchors
 178 @name = () if $index;               # Ordered array of name anchors
 179 $font = '';                         # '' to not make names, 'B' or 'I' to do so
 180
 181 $line = 0;
 182 foreach (@man) {
 183     if (/^\.ig/) {                  # Start ignoring
 184         $comment = 1;
 185     } elsif (/^\.\./) {             # Stop ignoring
 186         $comment = 0;
 187     } elsif (! $comment) {          # Not in .ig'ed section; do stuff
 188
 189         # nroff special characters
 190
 191         s/\\-/-/g;                  # \-
 192         s/\\^//g;                   # \^
 193         s/^\\'/'/;                  # leading ' escape
 194         s/^\\(\s)/$1/;              # leading space escape
 195         s/\\(e|\\)/\\/g;            # \e, \\; must do this after other escapes
 196
 197         # HTML special characters; deal with these before adding more
 198
 199         s/&/&amp\;/g;
 200         s/>/&gt\;/g;
 201         s/</&lt\;/g;
 202
 203         # Get title
 204
 205         if (/^\.TH\s+(\w+)\s+(\w+)\s+\"([^\"]*)\"\s+\"([^\"]*)\"/) {
 206             $title = "$1($2) $4 ($3) $1($2)";
 207         }
 208
 209         # Build per-section info arrays
 210
 211         if (($type, $text) = /^\.S([HS])\s+\"?([^\"]*)\"?/) {
 212
 213             push(@sectionlines, $line);     # Index of first line of section
 214             push(@sectiontypes, $type eq 'H' ? 0 : 1);  # Type of section
 215             $text =~ s/\s*$//;              # Remove trailing whitespace
 216             push(@sectiontexts, $text);     # Title of section (key for href)
 217             $text =~ s/\s*\(\+\)$//;        # Remove (+)
 218             if ($shortfiles) {
 219                 $file = $#sectionlines;     # Short filenames; use number
 220             } else {
 221                 $file = $text;              # Long filenames; use title
 222                 $file =~ s/[\s\/]+/_/g;     # Replace whitespace and / with _
 223             }
 224             $file .= ".$html" unless $single;
 225             push(@sectionfiles, $file);     # File in which to store section
 226             $name{"$text B"} = ($single ? '#' : '') . $file;
 227                                             # Index entry for &make_hrefs
 228             push(@name, "$text\t" . $name{"$text B"}) if $index;
 229                                             # Index entry for CGI script
 230             # Look for anchors in the rest of this section if $link_me{$text}
 231             # is non-null, and mark them with the font which is its value
 232
 233             $font = $link_me{$text};
 234         }
 235         &make_name(*name, *font, *file, *index, *_) if $font;
 236     }
 237     $line++;
 238 }
 239
 240 ### Make top page
 241
 242 open(TOP, ">$dir/$topfile");
 243 select TOP;
 244
 245 # Top page header
 246
 247 print <<EOP;
 248 <HEAD>
 249 <TITLE>$title</TITLE>
 250 </HEAD>
 251 <BODY>
 252 <A NAME="top"></A>
 253 <H1>$title</H1>
 254 <HR>
 255 EOP
 256
 257 # FORM block, if we're making an index
 258
 259 $action = $cgibin ? "http://$host/$cgibindir/$cgifile" : $cgifile;
 260
 261 print <<EOP if $index;
 262 <FORM METHOD="GET" ACTION="$action">
 263 Go directly to a section, command or variable: <INPUT NAME="input">
 264 </FORM>
 265 EOP
 266
 267 # Table of contents
 268
 269 print <<EOP;
 270 <H2>
 271 EOP
 272
 273 foreach $section (1 .. $#sectionlines) {
 274     if ($sectiontypes[$section - 1] < $sectiontypes[$section]) {
 275         print "</H2> <menu>\n";     # Indent, smaller font
 276     } elsif ($sectiontypes[$section - 1] > $sectiontypes[$section]) {
 277         print "</menu> <H2>\n";     # Outdent, larger font
 278     }
 279     if ($inline_me{$sectiontexts[$section]}) {    # Section is in %inline_me
 280
 281         # Print section inline
 282
 283         print "$sectiontexts[$section]\n";
 284         print "</H2> <menu>\n";     # Indent, smaller font
 285         &printsectionbody(*man, *sectionlines, *section, *name);
 286         print "</menu> <H2>\n";     # Outdent, larger font
 287     } else {
 288
 289         # Print link to section
 290
 291         print "<A HREF=\"", $single ? '#' : '',
 292             "$sectionfiles[$section]\">$sectiontexts[$section]</A><BR>\n";
 293     }
 294 }
 295
 296 print <<EOP;
 297 </H2>
 298 EOP
 299
 300 print "<HR>\n" if $single;
 301
 302 ### Make sections
 303
 304 foreach $section (0 .. $#sectionlines) {
 305
 306     # Skip inlined sections
 307
 308     next if $inline_me{$sectiontexts[$section]};
 309
 310     if ($single) {
 311
 312         # Header
 313
 314         print <<EOP if $section;        # Skip header section
 315 <H2><A NAME="$sectionfiles[$section]">$sectiontexts[$section]</A></H2>
 316 <menu>
 317 EOP
 318         &printsectionbody(*man, *sectionlines, *section, *name);
 319         print <<EOP if $section;        # Skip header section
 320 <A HREF="#top">Table of Contents</A>
 321 </menu>
 322 EOP
 323
 324     } else {
 325
 326         # Make pointer line for header and trailer
 327
 328         $pointers  = "<A HREF=\"$topfile\">Up</A>";
 329         $pointers .= "\n<A HREF=\"$sectionfiles[$section + 1]\">Next</A>"
 330             if ($section < $#sectionlines) &&
 331             ! $inline_me{$sectiontexts[$section + 1]};
 332         $pointers .= "\n<A HREF=\"$sectionfiles[$section - 1]\">Previous</A>"
 333             if ($section > 1) &&                # section 0 is initial comments
 334             ! $inline_me{$sectiontexts[$section - 1]};
 335
 336         # Header
 337
 338         open(OUT, ">$dir/$sectionfiles[$section]");
 339         select OUT;
 340         print <<EOP;
 341 <HEAD>
 342 <TITLE>$sectiontexts[$section]</TITLE>
 343 </HEAD>
 344 <BODY>
 345 $pointers
 346 <H2>$sectiontexts[$section]</H2>
 347 EOP
 348         &printsectionbody(*man, *sectionlines, *section, *name);
 349
 350         # Trailer
 351
 352         print <<EOP;
 353 $pointers
 354 </BODY>
 355 EOP
 356
 357     }
 358 }
 359
 360 select TOP unless $single;
 361
 362 # Top page trailer
 363
 364 print <<EOP;
 365 </H2>
 366 <HR>
 367 Here are the <A HREF="$outfile">nroff manpage</A> (175K)
 368 from which this HTML version was generated,
 369 the <A HREF="$script">Perl script</A> which did the conversion
 370 and the <A HREF="ftp://ftp.astron.com/pub/tcsh/">
 371 complete source code</A> for <I>tcsh</I>.
 372 <HR>
 373 <I>tcsh</I> is maintained by
 374 Christos Zoulas <A HREF="mailto:christos\@astron.com">&lt;christos\@astron.com&gt;</A>
 375 and the <A HREF="$listsfile"><I>tcsh</I> maintainers' mailing list</A>.
 376 Dave Schweisguth <A HREF="mailto:dcs\@proton.chem.yale.edu">&lt;dcs\@proton.chem.yale.edu&gt;</A>
 377 wrote the manpage and the HTML conversion script.
 378 </BODY>
 379 EOP
 380
 381 close TOP;
 382
 383 ### Make lists page
 384
 385 open(LISTS, ">$dir/$listsfile");
 386 select LISTS;
 387 while(($_ = <DATA>) ne "END\n") {   # Text stored after __END__
 388     s/TOPFILEHERE/$topfile/;
 389     print;
 390 }
 391 close LISTS;
 392
 393 ### Make search script
 394
 395 if ($index) {
 396
 397     # URL of $dir; see comments in search script
 398
 399     $root = $cgibin
 400         ? "'http://$host/" . ($updir ? "$updir/" : '') . "$dir/'"
 401         : '"http://$ENV{\'SERVER_NAME\'}:$ENV{\'SERVER_PORT\'}" . (($_ = $ENV{\'SCRIPT_NAME\'}) =~ s|[^/]*$||, $_)';
 402
 403     # String for passing @name to search script
 404
 405     $name = join("',\n'", @name);
 406
 407     open(TOP, ">$dir/$cgifile");
 408     select TOP;
 409     while(($_ = <DATA>) ne "END\n") {   # Text stored after __END__
 410         s/ROOTHERE/$root/;
 411         s/NAMEHERE/$name/;
 412         s/TOPFILEHERE/$topfile/;
 413         print;
 414     }
 415     close TOP;
 416     chmod(0755, "$dir/$cgifile") ||
 417         die "$whatami: Can't chmod 0755 $dir/$cgifile!\n";
 418     warn "$whatami: Don't forget to move $dir/$cgifile to /$cgibindir.\n"
 419         if $cgibin;
 420 }
 421
 422 ### That's all, folks
 423
 424 exit;
 425
 426 ### Subroutines
 427
 428 # Process and print the body of a section
 429
 430 sub printsectionbody {
 431
 432     local(*man, *sectionlines, *sline, *name) = @_;     # Number of section
 433     local($sfirst, $slast, @paralines, @paratypes, $comment, $dl, $pline,
 434           $comment, $pfirst, $plast, @para, @tag, $changeindent);
 435
 436     # Define section boundaries
 437
 438     $sfirst = $sectionlines[$sline] + 1;
 439     if ($sline == $#sectionlines) {
 440         $slast = $#man;
 441     } else {
 442         $slast = $sectionlines[$sline + 1] - 1;
 443     }
 444
 445     # Find paragraph markers, ignoring those between '.ig' and '..'
 446
 447     if ($man[$sfirst] =~ /^\.[PIT]P/) {
 448         @paralines = ();
 449         @paratypes = ();
 450     } else {
 451         @paralines = ($sfirst - 1);             # .P follows .S[HS] by default
 452         @paratypes = ('P');
 453     }
 454     $comment = 0;
 455     foreach ($sfirst .. $slast) {
 456         if ($man[$_] =~ /^\.ig/) {              # Start ignoring
 457             $comment = 1;
 458         } elsif ($man[$_] =~ /^\.\./) {         # Stop ignoring
 459             $comment = 0;
 460         } elsif (! $comment && $man[$_] =~ /^\.([PIT])P/) {
 461             push(@paralines, $_);
 462             push(@paratypes, $1);
 463         }
 464     }
 465
 466     # Process paragraphs
 467
 468     $changeindent = 0;
 469     $dl = 0;
 470     foreach $pline (0 .. $#paralines) {
 471
 472         @para = ();
 473         $comment = 0;
 474
 475         # Define para boundaries
 476
 477         $pfirst = $paralines[$pline] + 1;
 478         if ($pline == $#paralines) {
 479             $plast = $slast;
 480         } else {
 481             $plast = $paralines[$pline + 1] - 1;
 482         }
 483
 484         foreach (@man[$pfirst .. $plast]) {
 485             if (/^\.ig/) {                  # nroff begin ignore
 486                 if ($comment == 0) {
 487                     $comment = 2;
 488                     push(@para, "<!--\n");
 489                 } elsif ($comment == 1) {
 490                     $comment = 2;
 491                 } elsif ($comment == 2) {
 492                     s/--/-/g;               # Remove double-dashes in comments
 493                     push(@para, $_);
 494                 }
 495             } elsif (/^\.\./) {             # nroff end ignore
 496                 if ($comment == 0) {
 497                     ;
 498                 } elsif ($comment == 1) {
 499                     ;
 500                 } elsif ($comment == 2) {
 501                     $comment = 1;
 502                 }
 503             } elsif (/^\.\\\"/) {           # nroff comment
 504                 if ($comment == 0) {
 505                     $comment = 1;
 506                     push(@para, "<!--\n");
 507                     s/^\.\\\"//;
 508                 } elsif ($comment == 1) {
 509                     s/^\.\\\"//;
 510                 } elsif ($comment == 2) {
 511                     ;
 512                 }
 513                 s/--/-/g;                   # Remove double-dashes in comments
 514                 push(@para, $_);
 515             } else {                        # Nothing to do with comments
 516                 if ($comment == 0) {
 517                     ;
 518                 } elsif ($comment == 1) {
 519                     $comment = 0;
 520                     push(@para, "-->\n");
 521                 } elsif ($comment == 2) {
 522                     s/--/-/g;               # Remove double-dashes in comments
 523                 }
 524
 525                 unless ($comment) {
 526
 527                     if (/^\.TH/) {          # Title; got this already
 528                         next;
 529                     } elsif (/^\.PD/) {     # Para spacing; unimplemented
 530                         next;
 531                     } elsif (/^\.RS/) {     # Indent (one width only)
 532                         $changeindent++;
 533                         next;
 534                     } elsif (/^\.RE/) {     # Outdent
 535                         $changeindent--;
 536                         next;
 537                     }
 538
 539                     # Line break
 540                     s/^\.br.*/<BR>/;
 541
 542                     # More nroff special characters
 543
 544                     s/^\\&amp\;//;          # leading dot escape; save until
 545                                             #   now so leading dots aren't
 546                                             #   confused with ends of .igs
 547
 548                     &make_hrefs(*name, *_);
 549                 }
 550                 push(@para, $_);
 551             }
 552         }
 553
 554         push(@para, "-->\n") if $comment;   # Close open comment
 555
 556         # Print paragraph
 557
 558         if ($paratypes[$pline] eq 'P') {
 559             &font(*para);
 560             print   @para;
 561         } elsif ($paratypes[$pline] eq 'I') {
 562             &font(*para);
 563             print   "<menu>\n",
 564                     @para,
 565                     "</menu>\n";
 566         } else {                        # T
 567             @tag = shift(@para);
 568             &font(*tag);
 569             &font(*para);
 570             print   "<DL compact>\n" unless $dl;
 571             print   "<DT>\n",
 572                     @tag,
 573                     "<DD>\n",
 574                     @para;
 575             if ($pline == $#paratypes || $paratypes[$pline + 1] ne 'T') {
 576                 # Perl 5 lossage alert
 577                 # Next para is not a definition list
 578                 $dl = 0;                    # Close open definition list
 579                 print "</DL>\n";
 580             } else {
 581                 $dl = 1;                    # Leave definition list open
 582             }
 583         }
 584         print "<P>\n";
 585
 586         # Indent/outdent the *next* para
 587
 588         while ($changeindent > 0) {
 589             print "<menu>\n";
 590             $changeindent--;
 591         }
 592         while ($changeindent < 0) {
 593             print "</menu>\n";
 594             $changeindent++;
 595         }
 596     }
 597     1;
 598 }
 599
 600 # Make one name anchor in a line; cue on fonts (.B or .I) but leave them alone
 601
 602 sub make_name {
 603
 604     local(*name, *font, *file, *index, *line) = @_;
 605     local($text);
 606
 607     if (($text) = ($line =~ /^\.[BI]\s+([^\s\\]+)/)) {  # Found pattern
 608
 609         if (
 610             $text !~ /^-/                   # Avoid lists of options
 611             && (length($text) > 1           # and history escapes
 612                 ||  $text =~ /^[%:@]$/)     # Special pleading for %, :, @
 613             && ! $name{"$text $font"}       # Skip if there's one already
 614         ) {
 615             # Record link
 616
 617             $name{"$text $font"} = ($single ? '' : $file) . "#$text";
 618             push(@name, "$text\t" . $name{"$text $font"}) if $index;
 619
 620             # Put in the name anchor
 621
 622             $line =~ s/^(\.[BI]\s+)([^\s\\]+)/$1<A NAME=\"$text\">$2<\/A>/;
 623         }
 624     }
 625     $line;
 626 }
 627
 628 # Make all the href anchors in a line; cue on fonts (\fB ... \fR or
 629 # \fI ... \fR) but leave them alone
 630
 631 sub make_hrefs {
 632
 633     local(*name, *line) = @_;
 634     local(@pieces, $piece);
 635
 636     @pieces = split(/(\\f[BI][^\\]*\\fR)/, $line);
 637
 638     $piece = 0;
 639     foreach (@pieces) {
 640         if (/\\f([BI])([^\\]*)\\fR/     # Found a possibility
 641
 642         # It's not followed by (, i.e. it's not a manpage reference
 643
 644         && substr($pieces[$piece + 1], 0, 1) ne '(') {
 645             $key = "$2 $1";
 646             if ($name{$key}) {                  # If there's a matching name
 647                 s/(\\f[BI])([^\\]*)(\\fR)/$1<A HREF=\"$name{$key}\">$2<\/A>$3/;
 648             }
 649         }
 650         $piece++;
 651     }
 652     $line = join('', @pieces);
 653 }
 654
 655 # Convert nroff font escapes to HTML
 656 # Expects comments and breaks to be in HTML form already
 657
 658 sub font {
 659
 660     local(*para) = @_;
 661     local($i, $j, @begin, @end, $part, @pieces, $bold, $italic);
 662
 663     return 0 if $#para == -1;   # Ignore empty paragraphs
 664                                 # Perl 5 lossage alert
 665
 666     # Find beginning and end of each part between HTML comments
 667
 668     $i = 0;
 669     @begin = ();
 670     @end = ();
 671     foreach (@para) {
 672         push(@begin, $i + 1) if /^-->/ || /^<BR>/;
 673         push(@end, $i - 1) if /^<!--/ || /^<BR>/;
 674         $i++;
 675     }
 676     if ($para[0] =~ /^<!--/ || $para[0] =~ /^<BR>/) {
 677         shift(@end);
 678     } else {
 679         unshift(@begin, 0);     # Begin at the beginning
 680     }
 681     if ($para[$#para] =~ /^-->/ || $para[$#para] =~ /^<BR>/) {
 682         pop(@begin);
 683     } else {
 684         push(@end, $#para);     # End at the end
 685     }
 686
 687     # Fontify each part
 688
 689     $bold = $italic = 0;
 690     foreach $i (0 .. $#begin) {
 691         $part = join('', @para[$begin[$i] .. $end[$i]]);
 692         $part =~ s/^\.([BI])\s+(.*)$/\\f$1$2\\fR/gm;        # .B, .I
 693         @pieces = split(/(\\f[BIR])/m, $part);
 694         $part = '';
 695         foreach $j (@pieces) {
 696             if ($j eq '\fB') {
 697                 if ($italic) {
 698                     $italic = 0;
 699                     $part .= '</I>';
 700                 }
 701                 unless ($bold) {
 702                     $bold = 1;
 703                     $part .= '<B>';
 704                 }
 705             } elsif ($j eq '\fI') {
 706                 if ($bold) {
 707                     $bold = 0;
 708                     $part .= '</B>';
 709                 }
 710                 unless ($italic) {
 711                     $italic = 1;
 712                     $part .= '<I>';
 713                 }
 714             } elsif ($j eq '\fR') {
 715                 if ($bold) {
 716                     $bold = 0;
 717                     $part .= '</B>';
 718                 } elsif ($italic) {
 719                     $italic = 0;
 720                     $part .= '</I>';
 721                 }
 722             } else {
 723                 $part .= $j;
 724             }
 725         }
 726
 727         # Close bold/italic before break
 728
 729         if ($end[$i] == $#para || $para[$end[$i] + 1] =~ /^<BR>/) {
 730             # Perl 5 lossage alert
 731             if ($bold) {
 732                 $bold = 0;
 733                 $part =~ s/(\n)?$/<\/B>$1\n/;
 734             } elsif ($italic) {
 735                 $italic = 0;
 736                 $part =~ s/(\n)?$/<\/I>$1\n/;
 737             }
 738         }
 739
 740         # Rebuild this section of @para
 741
 742         foreach $j ($begin[$i] .. $end[$i]) {
 743             $part =~ s/^([^\n]*(\n|$))//;
 744             $para[$j] = $1;
 745         }
 746     }
 747
 748     # Close bold/italic on last non-comment line
 749     # Do this only here because fonts pass through comments
 750
 751     $para[$end[$#end]] =~ s/(\n)?$/<\/B>$1/ if $bold;
 752     $para[$end[$#end]] =~ s/(\n)?$/<\/I>$1/ if $italic;
 753 }
 754
 755 sub usage {
 756     local ($message) = $_[0];
 757
 758     warn $message if $message;
 759     warn <<EOP;
 760 Usage: $whatami [-1icsu] [-C dir] [-d dir] [-h host] [file]
 761 Without [file], reads from tcsh.man or stdin.
 762 -1          Makes a single page instead of a table of contents and sections
 763 -i          Makes a CGI searchable index script, tcsh.html/tcsh.cgi, intended
 764             for a server which respects the .cgi extension in any directory.
 765 -c          Like -i,  but the CGI script is intended for a server which wants
 766             scripts in /cgi-bin (or some other privileged directory separate
 767             from the rest of the HTML) and must be moved there by hand.
 768 -C dir      Uses /dir instead of /cgi-bin as the CGI bin dir.
 769             Meaningless without -c.
 770 -d dir      Uses /dir/tcsh.html instead of /tcsh.html as the HTML dir.
 771             Meaningless without -c.
 772 -D dir      Uses /dir.html instead of /tcsh.html as the HTML dir.
 773             Meaningless without -c.
 774 -G name     Uses name instead of tcsh.cgi as the name of the CGI script.
 775             Meaningless without -c or -i.
 776 -h host     Uses host as the host:port part of the URL to the entry point.
 777             Meaningless without -c.
 778 -s          Filenames are shorter (max 8 + 3) but less descriptive.
 779 -u          This message
 780 EOP
 781     exit !! $message;
 782 }
 783
 784 ### Inlined documents. Watch for *HERE tokens.
 785
 786 __END__
 787 <HEAD>
 788 <TITLE>The tcsh mailing lists</TITLE>
 789 </HEAD>
 790 <BODY>
 791 <A HREF="TOPFILEHERE">Up</A>
 792 <H2>The <I>tcsh</I> mailing lists</H2>
 793 There are three <I>tcsh</I> mailing lists:
 794 <DL>
 795 <DT>
 796 <I>tcsh@mailman.astron.com</I>
 797 <DD>
 798 The <I>tcsh</I> maintainers and testers' mailing list.
 799 <DT>
 800 <I>tcsh-bugs@astron.com</I>
 801 <DD>
 802 Open bug and user comment discussion.
 803 </DL>
 804 You can subscribe to either of these lists by visiting
 805 <I><A HREF="https://mailman.astron.com/">https://mailman.astron.com/</A></I>
 806 <P>
 807 To file a bug report or a feature suggestion (preferably
 808 with code), please visit
 809 <I><A HREF="https://bugs.astron.com/">https://bugs.astron.com/</A></I>
 810 <P>
 811 <A HREF="TOPFILEHERE">Up</A>
 812 </BODY>
 813 END
 814 : # -*- perl -*-
 815
 816 # Emulate #!/usr/local/bin/perl on systems without #!
 817
 818 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
 819 & eval 'exec perl -S $0 $argv:q' if 0;
 820
 821 # Setup
 822
 823 # Location: doesn't work with relative URLs, so we need to know where to find
 824 #   the top and section files.
 825 # If the search engine is in /cgi-bin, we need a hard-coded URL.
 826 # If the search engine is in the same directory, we can figure it out from CGI
 827 #   environment variables.
 828
 829 $root = ROOTHERE;
 830 $topfile = 'TOPFILEHERE';
 831 @name = (
 832 'NAMEHERE'
 833 );
 834
 835 # Do the search
 836
 837 $input = $ENV{'QUERY_STRING'};
 838 $input =~ s/^input=//;
 839 $input =~ s/\+/ /g;
 840 print "Status: 302 Found\n";
 841 if ($input ne '' && ($key = (grep(/^$input/,  @name))[0] ||
 842                             (grep(/^$input/i, @name))[0] ||
 843                             (grep( /$input/i, @name))[0]   )) {
 844     $key =~ /\t([^\t]*)$/;
 845     print "Location: $root$1\n\n";
 846 } else {
 847     print "Location: $root$topfile\n\n";
 848 }
 849 END