1 | #!/usr/local/bin/perl |
---|
2 | # $Id: tcsh.man2html,v 1.1.1.1 1998-10-03 21:10:19 danw 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 | |
---|
25 | eval '(exit $?0)' && eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}' |
---|
26 | & eval 'exec /usr/local/bin/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 | |
---|
77 | while ($#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 | |
---|
101 | if (@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 | |
---|
115 | if ($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 | |
---|
130 | unless ($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 | |
---|
138 | if (-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 | |
---|
147 | if ($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 | |
---|
157 | open(MAN, ">$dir/$outfile") || die "$whatami: Can't open $dir/$outfile!\n"; |
---|
158 | print MAN @man; |
---|
159 | close 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 | |
---|
167 | system("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; |
---|
183 | foreach (@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/&/&\;/g; |
---|
201 | s/>/>\;/g; |
---|
202 | s/</<\;/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 | |
---|
243 | open(TOP, ">$dir/$topfile"); |
---|
244 | select TOP; |
---|
245 | |
---|
246 | # Top page header |
---|
247 | |
---|
248 | print <<EOP; |
---|
249 | <HEAD> |
---|
250 | <TITLE>$title</TITLE> |
---|
251 | </HEAD> |
---|
252 | <BODY> |
---|
253 | <A NAME="top"></A> |
---|
254 | <H1>$title</H1> |
---|
255 | <HR> |
---|
256 | EOP |
---|
257 | |
---|
258 | # FORM block, if we're making an index |
---|
259 | |
---|
260 | $action = $cgibin ? "http://$host/$cgibindir/$cgifile" : $cgifile; |
---|
261 | |
---|
262 | print <<EOP if $index; |
---|
263 | <FORM METHOD="GET" ACTION="$action"> |
---|
264 | Go directly to a section, command or variable: <INPUT NAME="input"> |
---|
265 | </FORM> |
---|
266 | EOP |
---|
267 | |
---|
268 | # Table of contents |
---|
269 | |
---|
270 | print <<EOP; |
---|
271 | <H2> |
---|
272 | EOP |
---|
273 | |
---|
274 | foreach $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 | |
---|
297 | print <<EOP; |
---|
298 | </H2> |
---|
299 | EOP |
---|
300 | |
---|
301 | print "<HR>\n" if $single; |
---|
302 | |
---|
303 | ### Make sections |
---|
304 | |
---|
305 | foreach $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> |
---|
318 | EOP |
---|
319 | &printsectionbody(*man, *sectionlines, *section, *name); |
---|
320 | print <<EOP if $section; # Skip header section |
---|
321 | <A HREF="#top">Table of Contents</A> |
---|
322 | </menu> |
---|
323 | EOP |
---|
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> |
---|
348 | EOP |
---|
349 | &printsectionbody(*man, *sectionlines, *section, *name); |
---|
350 | |
---|
351 | # Trailer |
---|
352 | |
---|
353 | print <<EOP; |
---|
354 | $pointers |
---|
355 | </BODY> |
---|
356 | EOP |
---|
357 | |
---|
358 | } |
---|
359 | } |
---|
360 | |
---|
361 | select TOP unless $single; |
---|
362 | |
---|
363 | # Top page trailer |
---|
364 | |
---|
365 | print <<EOP; |
---|
366 | </H2> |
---|
367 | <HR> |
---|
368 | Here are the <A HREF="$outfile">nroff manpage</A> (175K) |
---|
369 | from which this HTML version was generated, |
---|
370 | the <A HREF="$script">Perl script</A> which did the conversion |
---|
371 | and the <A HREF="file://ftp.astron.com/pub/tcsh/"> |
---|
372 | complete source code</A> for <I>tcsh</I>. |
---|
373 | <HR> |
---|
374 | <I>tcsh</I> is maintained by |
---|
375 | Christos Zoulas <A HREF="mailto:christos\@gw.com"><christos\@gw.com></A> |
---|
376 | and the <A HREF="$listsfile"><I>tcsh</I> maintainers' mailing list</A>. |
---|
377 | Dave Schweisguth <A HREF="mailto:dcs\@proton.chem.yale.edu"><dcs\@proton.chem.yale.edu></A> |
---|
378 | wrote the manpage and the HTML conversion script. |
---|
379 | </BODY> |
---|
380 | EOP |
---|
381 | |
---|
382 | close TOP; |
---|
383 | |
---|
384 | ### Make lists page |
---|
385 | |
---|
386 | open(LISTS, ">$dir/$listsfile"); |
---|
387 | select LISTS; |
---|
388 | while(($_ = <DATA>) ne "END\n") { # Text stored after __END__ |
---|
389 | s/TOPFILEHERE/$topfile/; |
---|
390 | print; |
---|
391 | } |
---|
392 | close LISTS; |
---|
393 | |
---|
394 | ### Make search script |
---|
395 | |
---|
396 | if ($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 | |
---|
425 | exit; |
---|
426 | |
---|
427 | ### Subroutines |
---|
428 | |
---|
429 | # Process and print the body of a section |
---|
430 | |
---|
431 | sub 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 | |
---|
542 | s/^\.br.*/<BR>/; |
---|
543 | |
---|
544 | # More nroff special characters |
---|
545 | |
---|
546 | s/^\\&\;//; # leading dot escape; save until |
---|
547 | # now so leading dots aren't |
---|
548 | # confused with ends of .igs |
---|
549 | |
---|
550 | &make_hrefs(*name, *_); |
---|
551 | } |
---|
552 | push(@para, $_); |
---|
553 | } |
---|
554 | } |
---|
555 | |
---|
556 | push(@para, "-->\n") if $comment; # Close open comment |
---|
557 | |
---|
558 | # Print paragraph |
---|
559 | |
---|
560 | if ($paratypes[$pline] eq 'P') { |
---|
561 | &font(*para); |
---|
562 | print @para; |
---|
563 | } elsif ($paratypes[$pline] eq 'I') { |
---|
564 | &font(*para); |
---|
565 | print "<menu>\n", |
---|
566 | @para, |
---|
567 | "</menu>\n"; |
---|
568 | } else { # T |
---|
569 | @tag = shift(@para); |
---|
570 | &font(*tag); |
---|
571 | &font(*para); |
---|
572 | print "<DL compact>\n" unless $dl; |
---|
573 | print "<DT>\n", |
---|
574 | @tag, |
---|
575 | "<DD>\n", |
---|
576 | @para; |
---|
577 | if ($pline == $#paratypes || $paratypes[$pline + 1] ne 'T') { |
---|
578 | # Perl 5 lossage alert |
---|
579 | # Next para is not a definition list |
---|
580 | $dl = 0; # Close open definition list |
---|
581 | print "</DL>\n"; |
---|
582 | } else { |
---|
583 | $dl = 1; # Leave definition list open |
---|
584 | } |
---|
585 | } |
---|
586 | print "<P>\n"; |
---|
587 | |
---|
588 | # Indent/outdent the *next* para |
---|
589 | |
---|
590 | while ($changeindent > 0) { |
---|
591 | print "<menu>\n"; |
---|
592 | $changeindent--; |
---|
593 | } |
---|
594 | while ($changeindent < 0) { |
---|
595 | print "</menu>\n"; |
---|
596 | $changeindent++; |
---|
597 | } |
---|
598 | } |
---|
599 | 1; |
---|
600 | } |
---|
601 | |
---|
602 | # Make one name anchor in a line; cue on fonts (.B or .I) but leave them alone |
---|
603 | |
---|
604 | sub make_name { |
---|
605 | |
---|
606 | local(*name, *font, *file, *index, *line) = @_; |
---|
607 | local($text); |
---|
608 | |
---|
609 | if (($text) = ($line =~ /^\.[BI]\s+([^\s\\]+)/)) { # Found pattern |
---|
610 | |
---|
611 | if ( |
---|
612 | $text !~ /^-/ # Avoid lists of options |
---|
613 | && (length($text) > 1 # and history escapes |
---|
614 | || $text =~ /^[%:@]$/) # Special pleading for %, :, @ |
---|
615 | && ! $name{"$text $font"} # Skip if there's one already |
---|
616 | ) { |
---|
617 | # Record link |
---|
618 | |
---|
619 | $name{"$text $font"} = ($single ? '' : $file) . "#$text"; |
---|
620 | push(@name, "$text\t" . $name{"$text $font"}) if $index; |
---|
621 | |
---|
622 | # Put in the name anchor |
---|
623 | |
---|
624 | $line =~ s/^(\.[BI]\s+)([^\s\\]+)/$1<A NAME=\"$text\">$2<\/A>/; |
---|
625 | } |
---|
626 | } |
---|
627 | $line; |
---|
628 | } |
---|
629 | |
---|
630 | # Make all the href anchors in a line; cue on fonts (\fB ... \fR or |
---|
631 | # \fI ... \fR) but leave them alone |
---|
632 | |
---|
633 | sub make_hrefs { |
---|
634 | |
---|
635 | local(*name, *line) = @_; |
---|
636 | local(@pieces, $piece); |
---|
637 | |
---|
638 | @pieces = split(/(\\f[BI][^\\]*\\fR)/, $line); |
---|
639 | |
---|
640 | $piece = 0; |
---|
641 | foreach (@pieces) { |
---|
642 | if (/\\f([BI])([^\\]*)\\fR/ # Found a possibility |
---|
643 | |
---|
644 | # It's not followed by (, i.e. it's not a manpage reference |
---|
645 | |
---|
646 | && substr($pieces[$piece + 1], 0, 1) ne '(') { |
---|
647 | $key = "$2 $1"; |
---|
648 | if ($name{$key}) { # If there's a matching name |
---|
649 | s/(\\f[BI])([^\\]*)(\\fR)/$1<A HREF=\"$name{$key}\">$2<\/A>$3/; |
---|
650 | } |
---|
651 | } |
---|
652 | $piece++; |
---|
653 | } |
---|
654 | $line = join('', @pieces); |
---|
655 | } |
---|
656 | |
---|
657 | # Convert nroff font escapes to HTML |
---|
658 | # Expects comments and breaks to be in HTML form already |
---|
659 | |
---|
660 | sub font { |
---|
661 | |
---|
662 | local(*para) = @_; |
---|
663 | local($i, $j, @begin, @end, $part, @pieces, $bold, $italic); |
---|
664 | |
---|
665 | return 0 if $#para == -1; # Ignore empty paragraphs |
---|
666 | # Perl 5 lossage alert |
---|
667 | |
---|
668 | # Find beginning and end of each part between HTML comments |
---|
669 | |
---|
670 | $i = 0; |
---|
671 | @begin = (); |
---|
672 | @end = (); |
---|
673 | foreach (@para) { |
---|
674 | push(@begin, $i + 1) if /^-->/ || /^<BR>/; |
---|
675 | push(@end, $i - 1) if /^<!--/ || /^<BR>/; |
---|
676 | $i++; |
---|
677 | } |
---|
678 | if ($para[0] =~ /^<!--/ || $para[0] =~ /^<BR>/) { |
---|
679 | shift(@end); |
---|
680 | } else { |
---|
681 | unshift(@begin, 0); # Begin at the beginning |
---|
682 | } |
---|
683 | if ($para[$#para] =~ /^-->/ || $para[$#para] =~ /^<BR>/) { |
---|
684 | pop(@begin); |
---|
685 | } else { |
---|
686 | push(@end, $#para); # End at the end |
---|
687 | } |
---|
688 | |
---|
689 | # Fontify each part |
---|
690 | |
---|
691 | $bold = $italic = 0; |
---|
692 | foreach $i (0 .. $#begin) { |
---|
693 | $* = 1; |
---|
694 | $part = join('', @para[$begin[$i] .. $end[$i]]); |
---|
695 | $part =~ s/^\.([BI])\s+(.*)$/\\f$1$2\\fR/g; # .B, .I |
---|
696 | @pieces = split(/(\\f[BIR])/, $part); |
---|
697 | $part = ''; |
---|
698 | foreach $j (@pieces) { |
---|
699 | if ($j eq '\fB') { |
---|
700 | if ($italic) { |
---|
701 | $italic = 0; |
---|
702 | $part .= '</I>'; |
---|
703 | } |
---|
704 | unless ($bold) { |
---|
705 | $bold = 1; |
---|
706 | $part .= '<B>'; |
---|
707 | } |
---|
708 | } elsif ($j eq '\fI') { |
---|
709 | if ($bold) { |
---|
710 | $bold = 0; |
---|
711 | $part .= '</B>'; |
---|
712 | } |
---|
713 | unless ($italic) { |
---|
714 | $italic = 1; |
---|
715 | $part .= '<I>'; |
---|
716 | } |
---|
717 | } elsif ($j eq '\fR') { |
---|
718 | if ($bold) { |
---|
719 | $bold = 0; |
---|
720 | $part .= '</B>'; |
---|
721 | } elsif ($italic) { |
---|
722 | $italic = 0; |
---|
723 | $part .= '</I>'; |
---|
724 | } |
---|
725 | } else { |
---|
726 | $part .= $j; |
---|
727 | } |
---|
728 | } |
---|
729 | $* = 0; |
---|
730 | |
---|
731 | # Close bold/italic before break |
---|
732 | |
---|
733 | if ($end[$i] == $#para || $para[$end[$i] + 1] =~ /^<BR>/) { |
---|
734 | # Perl 5 lossage alert |
---|
735 | if ($bold) { |
---|
736 | $bold = 0; |
---|
737 | $part =~ s/(\n)?$/<\/B>$1\n/; |
---|
738 | } elsif ($italic) { |
---|
739 | $italic = 0; |
---|
740 | $part =~ s/(\n)?$/<\/I>$1\n/; |
---|
741 | } |
---|
742 | } |
---|
743 | |
---|
744 | # Rebuild this section of @para |
---|
745 | |
---|
746 | foreach $j ($begin[$i] .. $end[$i]) { |
---|
747 | $part =~ s/^([^\n]*(\n|$))//; |
---|
748 | $para[$j] = $1; |
---|
749 | } |
---|
750 | } |
---|
751 | |
---|
752 | # Close bold/italic on last non-comment line |
---|
753 | # Do this only here because fonts pass through comments |
---|
754 | |
---|
755 | $para[$end[$#end]] =~ s/(\n)?$/<\/B>$1/ if $bold; |
---|
756 | $para[$end[$#end]] =~ s/(\n)?$/<\/I>$1/ if $italic; |
---|
757 | } |
---|
758 | |
---|
759 | sub usage { |
---|
760 | local ($message) = $_[0]; |
---|
761 | |
---|
762 | warn $message if $message; |
---|
763 | warn <<EOP; |
---|
764 | Usage: $whatami [-1icsu] [-C dir] [-d dir] [-h host] [file] |
---|
765 | Without [file], reads from tcsh.man or stdin. |
---|
766 | -1 Makes a single page instead of a table of contents and sections |
---|
767 | -i Makes a CGI searchable index script, tcsh.html/tcsh.cgi, intended |
---|
768 | for a server which respects the .cgi extension in any directory. |
---|
769 | -c Like -i, but the CGI script is intended for a server which wants |
---|
770 | scripts in /cgi-bin (or some other privileged directory separate |
---|
771 | from the rest of the HTML) and must be moved there by hand. |
---|
772 | -C dir Uses /dir instead of /cgi-bin as the CGI bin dir. |
---|
773 | Meaningless without -c. |
---|
774 | -d dir Uses /dir/tcsh.html instead of /tcsh.html as the HTML dir. |
---|
775 | Meaningless without -c. |
---|
776 | -D dir Uses /dir.html instead of /tcsh.html as the HTML dir. |
---|
777 | Meaningless without -c. |
---|
778 | -G name Uses name instead of tcsh.cgi as the name of the CGI script. |
---|
779 | Meaningless without -c or -i. |
---|
780 | -h host Uses host as the host:port part of the URL to the entry point. |
---|
781 | Meaningless without -c. |
---|
782 | -s Filenames are shorter (max 8 + 3) but less descriptive. |
---|
783 | -u This message |
---|
784 | EOP |
---|
785 | exit !! $message; |
---|
786 | } |
---|
787 | |
---|
788 | ### Inlined documents. Watch for *HERE tokens. |
---|
789 | |
---|
790 | __END__ |
---|
791 | <HEAD> |
---|
792 | <TITLE>The tcsh mailing lists</TITLE> |
---|
793 | </HEAD> |
---|
794 | <BODY> |
---|
795 | <A HREF="TOPFILEHERE">Up</A> |
---|
796 | <H2>The <I>tcsh</I> mailing lists</H2> |
---|
797 | There are three <I>tcsh</I> mailing lists: |
---|
798 | <DL> |
---|
799 | <DT> |
---|
800 | <I>tcsh@mx.gw.com</I> |
---|
801 | <DD> |
---|
802 | The <I>tcsh</I> maintainers and testers' mailing list. |
---|
803 | <DT> |
---|
804 | <I>tcsh-diffs@mx.gw.com</I> |
---|
805 | <DD> |
---|
806 | The same as <I>tcsh@mx.gw.com</I>, plus diffs for each new |
---|
807 | patchlevel of <I>tcsh</I>. |
---|
808 | <DT> |
---|
809 | <I>tcsh-bugs@mx.gw.com</I> |
---|
810 | <DD> |
---|
811 | Bug reports. |
---|
812 | </DL> |
---|
813 | You can subscribe to any of these lists by sending mail to |
---|
814 | <I><A HREF="mailto:listserv@mx.gw.com">listserv@mx.gw.com</A></I> with the |
---|
815 | text "subscribe <list name> <your name>" on a line by |
---|
816 | itself in the body. <list name> is the name of the mailing list, |
---|
817 | without "@mx.gw.com", and <your name> is your real name, not your |
---|
818 | email address. You can also ask the list server for help by sending |
---|
819 | only the word "help". |
---|
820 | <P> |
---|
821 | <A HREF="TOPFILEHERE">Up</A> |
---|
822 | </BODY> |
---|
823 | END |
---|
824 | #!/usr/local/bin/perl |
---|
825 | |
---|
826 | # Emulate #!/usr/local/bin/perl on systems without #! |
---|
827 | |
---|
828 | eval '(exit $?0)' && eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}' |
---|
829 | & eval 'exec /usr/local/bin/perl -S $0 $argv:q' if 0; |
---|
830 | |
---|
831 | # Setup |
---|
832 | |
---|
833 | # Location: doesn't work with relative URLs, so we need to know where to find |
---|
834 | # the top and section files. |
---|
835 | # If the search engine is in /cgi-bin, we need a hard-coded URL. |
---|
836 | # If the search engine is in the same directory, we can figure it out from CGI |
---|
837 | # environment variables. |
---|
838 | |
---|
839 | $root = ROOTHERE; |
---|
840 | $topfile = 'TOPFILEHERE'; |
---|
841 | @name = ( |
---|
842 | 'NAMEHERE' |
---|
843 | ); |
---|
844 | |
---|
845 | # Do the search |
---|
846 | |
---|
847 | $input = $ENV{'QUERY_STRING'}; |
---|
848 | $input =~ s/^input=//; |
---|
849 | $input =~ s/\+/ /g; |
---|
850 | print "Status: 302 Found\n"; |
---|
851 | if ($input ne '' && ($key = (grep(/^$input/, @name))[0] || |
---|
852 | (grep(/^$input/i, @name))[0] || |
---|
853 | (grep( /$input/i, @name))[0] )) { |
---|
854 | $key =~ /\t([^\t]*)$/; |
---|
855 | print "Location: $root$1\n\n"; |
---|
856 | } else { |
---|
857 | print "Location: $root$topfile\n\n"; |
---|
858 | } |
---|
859 | END |
---|