PageRenderTime 27ms CodeModel.GetById 10ms app.highlight 8ms RepoModel.GetById 1ms app.codeStats 0ms

/contrib/tcsh/tcsh.man2html

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