summaryrefslogtreecommitdiff
path: root/src/lib/libcrypto/util/pod2man.pl
diff options
context:
space:
mode:
authorbeck <>2000-03-19 11:13:58 +0000
committerbeck <>2000-03-19 11:13:58 +0000
commit796d609550df3a33fc11468741c5d2f6d3df4c11 (patch)
tree6c6d539061caa20372dad0ac4ddb1dfae2fbe7fe /src/lib/libcrypto/util/pod2man.pl
parent5be3114c1fd7e0dfea1e38d3abb4cbba75244419 (diff)
downloadopenbsd-796d609550df3a33fc11468741c5d2f6d3df4c11.tar.gz
openbsd-796d609550df3a33fc11468741c5d2f6d3df4c11.tar.bz2
openbsd-796d609550df3a33fc11468741c5d2f6d3df4c11.zip
OpenSSL 0.9.5 merge
*warning* this bumps shared lib minors for libssl and libcrypto from 2.1 to 2.2 if you are using the ssl26 packages for ssh and other things to work you will need to get new ones (see ~beck/libsslsnap/<arch>) on cvs or ~beck/src-patent.tar.gz on cvs
Diffstat (limited to 'src/lib/libcrypto/util/pod2man.pl')
-rw-r--r--src/lib/libcrypto/util/pod2man.pl1181
1 files changed, 1181 insertions, 0 deletions
diff --git a/src/lib/libcrypto/util/pod2man.pl b/src/lib/libcrypto/util/pod2man.pl
new file mode 100644
index 0000000000..f5ec0767ed
--- /dev/null
+++ b/src/lib/libcrypto/util/pod2man.pl
@@ -0,0 +1,1181 @@
1: #!/usr/bin/perl-5.005
2 eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
3 if $running_under_some_shell;
4
5$DEF_PM_SECTION = '3pm' || '3';
6
7=head1 NAME
8
9pod2man - translate embedded Perl pod directives into man pages
10
11=head1 SYNOPSIS
12
13B<pod2man>
14[ B<--section=>I<manext> ]
15[ B<--release=>I<relpatch> ]
16[ B<--center=>I<string> ]
17[ B<--date=>I<string> ]
18[ B<--fixed=>I<font> ]
19[ B<--official> ]
20[ B<--lax> ]
21I<inputfile>
22
23=head1 DESCRIPTION
24
25B<pod2man> converts its input file containing embedded pod directives (see
26L<perlpod>) into nroff source suitable for viewing with nroff(1) or
27troff(1) using the man(7) macro set.
28
29Besides the obvious pod conversions, B<pod2man> also takes care of
30func(), func(n), and simple variable references like $foo or @bar so
31you don't have to use code escapes for them; complex expressions like
32C<$fred{'stuff'}> will still need to be escaped, though. Other nagging
33little roffish things that it catches include translating the minus in
34something like foo-bar, making a long dash--like this--into a real em
35dash, fixing up "paired quotes", putting a little space after the
36parens in something like func(), making C++ and PI look right, making
37double underbars have a little tiny space between them, making ALLCAPS
38a teeny bit smaller in troff(1), and escaping backslashes so you don't
39have to.
40
41=head1 OPTIONS
42
43=over 8
44
45=item center
46
47Set the centered header to a specific string. The default is
48"User Contributed Perl Documentation", unless the C<--official> flag is
49given, in which case the default is "Perl Programmers Reference Guide".
50
51=item date
52
53Set the left-hand footer string to this value. By default,
54the modification date of the input file will be used.
55
56=item fixed
57
58The fixed font to use for code refs. Defaults to CW.
59
60=item official
61
62Set the default header to indicate that this page is of
63the standard release in case C<--center> is not given.
64
65=item release
66
67Set the centered footer. By default, this is the current
68perl release.
69
70=item section
71
72Set the section for the C<.TH> macro. The standard conventions on
73sections are to use 1 for user commands, 2 for system calls, 3 for
74functions, 4 for devices, 5 for file formats, 6 for games, 7 for
75miscellaneous information, and 8 for administrator commands. This works
76best if you put your Perl man pages in a separate tree, like
77F</usr/local/perl/man/>. By default, section 1 will be used
78unless the file ends in F<.pm> in which case section 3 will be selected.
79
80=item lax
81
82Don't complain when required sections aren't present.
83
84=back
85
86=head1 Anatomy of a Proper Man Page
87
88For those not sure of the proper layout of a man page, here's
89an example of the skeleton of a proper man page. Head of the
90major headers should be setout as a C<=head1> directive, and
91are historically written in the rather startling ALL UPPER CASE
92format, although this is not mandatory.
93Minor headers may be included using C<=head2>, and are
94typically in mixed case.
95
96=over 10
97
98=item NAME
99
100Mandatory section; should be a comma-separated list of programs or
101functions documented by this podpage, such as:
102
103 foo, bar - programs to do something
104
105=item SYNOPSIS
106
107A short usage summary for programs and functions, which
108may someday be deemed mandatory.
109
110=item DESCRIPTION
111
112Long drawn out discussion of the program. It's a good idea to break this
113up into subsections using the C<=head2> directives, like
114
115 =head2 A Sample Subection
116
117 =head2 Yet Another Sample Subection
118
119=item OPTIONS
120
121Some people make this separate from the description.
122
123=item RETURN VALUE
124
125What the program or function returns if successful.
126
127=item ERRORS
128
129Exceptions, return codes, exit stati, and errno settings.
130
131=item EXAMPLES
132
133Give some example uses of the program.
134
135=item ENVIRONMENT
136
137Envariables this program might care about.
138
139=item FILES
140
141All files used by the program. You should probably use the FE<lt>E<gt>
142for these.
143
144=item SEE ALSO
145
146Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8).
147
148=item NOTES
149
150Miscellaneous commentary.
151
152=item CAVEATS
153
154Things to take special care with; sometimes called WARNINGS.
155
156=item DIAGNOSTICS
157
158All possible messages the program can print out--and
159what they mean.
160
161=item BUGS
162
163Things that are broken or just don't work quite right.
164
165=item RESTRICTIONS
166
167Bugs you don't plan to fix :-)
168
169=item AUTHOR
170
171Who wrote it (or AUTHORS if multiple).
172
173=item HISTORY
174
175Programs derived from other sources sometimes have this, or
176you might keep a modification log here.
177
178=back
179
180=head1 EXAMPLES
181
182 pod2man program > program.1
183 pod2man some_module.pm > /usr/perl/man/man3/some_module.3
184 pod2man --section=7 note.pod > note.7
185
186=head1 DIAGNOSTICS
187
188The following diagnostics are generated by B<pod2man>. Items
189marked "(W)" are non-fatal, whereas the "(F)" errors will cause
190B<pod2man> to immediately exit with a non-zero status.
191
192=over 4
193
194=item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s>
195
196(W) If you start include an option, you should set it off
197as bold, italic, or code.
198
199=item can't open %s: %s
200
201(F) The input file wasn't available for the given reason.
202
203=item Improper man page - no dash in NAME header in paragraph %d of %s
204
205(W) The NAME header did not have an isolated dash in it. This is
206considered important.
207
208=item Invalid man page - no NAME line in %s
209
210(F) You did not include a NAME header, which is essential.
211
212=item roff font should be 1 or 2 chars, not `%s' (F)
213
214(F) The font specified with the C<--fixed> option was not
215a one- or two-digit roff font.
216
217=item %s is missing required section: %s
218
219(W) Required sections include NAME, DESCRIPTION, and if you're
220using a section starting with a 3, also a SYNOPSIS. Actually,
221not having a NAME is a fatal.
222
223=item Unknown escape: %s in %s
224
225(W) An unknown HTML entity (probably for an 8-bit character) was given via
226a C<EE<lt>E<gt>> directive. Besides amp, lt, gt, and quot, recognized
227entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
228Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
229Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
230icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc,
231ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig,
232THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml,
233Yacute, yacute, and yuml.
234
235=item Unmatched =back
236
237(W) You have a C<=back> without a corresponding C<=over>.
238
239=item Unrecognized pod directive: %s
240
241(W) You specified a pod directive that isn't in the known list of
242C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
243
244
245=back
246
247=head1 NOTES
248
249If you would like to print out a lot of man page continuously, you
250probably want to set the C and D registers to set contiguous page
251numbering and even/odd paging, at least on some versions of man(7).
252Settting the F register will get you some additional experimental
253indexing:
254
255 troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ...
256
257The indexing merely outputs messages via C<.tm> for each
258major page, section, subsection, item, and any C<XE<lt>E<gt>>
259directives.
260
261
262=head1 RESTRICTIONS
263
264None at this time.
265
266=head1 BUGS
267
268The =over and =back directives don't really work right. They
269take absolute positions instead of offsets, don't nest well, and
270making people count is suboptimal in any event.
271
272=head1 AUTHORS
273
274Original prototype by Larry Wall, but so massively hacked over by
275Tom Christiansen such that Larry probably doesn't recognize it anymore.
276
277=cut
278
279$/ = "";
280$cutting = 1;
281@Indices = ();
282
283# We try first to get the version number from a local binary, in case we're
284# running an installed version of Perl to produce documentation from an
285# uninstalled newer version's pod files.
286if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
287 my $perl = (-x './perl' && -f './perl' ) ?
288 './perl' :
289 ((-x '../perl' && -f '../perl') ?
290 '../perl' :
291 '');
292 ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl;
293}
294# No luck; we'll just go with the running Perl's version
295($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
296$DEF_RELEASE = "perl $version";
297$DEF_RELEASE .= ", patch $patch" if $patch;
298
299
300sub makedate {
301 my $secs = shift;
302 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
303 my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
304 $year += 1900;
305 return "$mday/$mname/$year";
306}
307
308use Getopt::Long;
309
310$DEF_SECTION = 1;
311$DEF_CENTER = "User Contributed Perl Documentation";
312$STD_CENTER = "Perl Programmers Reference Guide";
313$DEF_FIXED = 'CW';
314$DEF_LAX = 0;
315
316sub usage {
317 warn "$0: @_\n" if @_;
318 die <<EOF;
319usage: $0 [options] podpage
320Options are:
321 --section=manext (default "$DEF_SECTION")
322 --release=relpatch (default "$DEF_RELEASE")
323 --center=string (default "$DEF_CENTER")
324 --date=string (default "$DEF_DATE")
325 --fixed=font (default "$DEF_FIXED")
326 --official (default NOT)
327 --lax (default NOT)
328EOF
329}
330
331$uok = GetOptions( qw(
332 section=s
333 release=s
334 center=s
335 date=s
336 fixed=s
337 official
338 lax
339 help));
340
341$DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
342
343usage("Usage error!") unless $uok;
344usage() if $opt_help;
345usage("Need one and only one podpage argument") unless @ARGV == 1;
346
347$section = $opt_section || ($ARGV[0] =~ /\.pm$/
348 ? $DEF_PM_SECTION : $DEF_SECTION);
349$RP = $opt_release || $DEF_RELEASE;
350$center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
351$lax = $opt_lax || $DEF_LAX;
352
353$CFont = $opt_fixed || $DEF_FIXED;
354
355if (length($CFont) == 2) {
356 $CFont_embed = "\\f($CFont";
357}
358elsif (length($CFont) == 1) {
359 $CFont_embed = "\\f$CFont";
360}
361else {
362 die "roff font should be 1 or 2 chars, not `$CFont_embed'";
363}
364
365$date = $opt_date || $DEF_DATE;
366
367for (qw{NAME DESCRIPTION}) {
368# for (qw{NAME DESCRIPTION AUTHOR}) {
369 $wanna_see{$_}++;
370}
371$wanna_see{SYNOPSIS}++ if $section =~ /^3/;
372
373
374$name = @ARGV ? $ARGV[0] : "<STDIN>";
375$Filename = $name;
376if ($section =~ /^1/) {
377 require File::Basename;
378 $name = uc File::Basename::basename($name);
379}
380$name =~ s/\.(pod|p[lm])$//i;
381
382# Lose everything up to the first of
383# */lib/*perl* standard or site_perl module
384# */*perl*/lib from -D prefix=/opt/perl
385# */*perl*/ random module hierarchy
386# which works.
387$name =~ s-//+-/-g;
388if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
389 or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
390 or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
391 # Lose ^site(_perl)?/.
392 $name =~ s-^site(_perl)?/--;
393 # Lose ^arch/. (XXX should we use Config? Just for archname?)
394 $name =~ s~^(.*-$^O|$^O-.*)/~~o;
395 # Lose ^version/.
396 $name =~ s-^\d+\.\d+/--;
397}
398
399# Translate Getopt/Long to Getopt::Long, etc.
400$name =~ s(/)(::)g;
401
402if ($name ne 'something') {
403 FCHECK: {
404 open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
405 while (<F>) {
406 next unless /^=\b/;
407 if (/^=head1\s+NAME\s*$/) { # an /m would forgive mistakes
408 $_ = <F>;
409 unless (/\s*-+\s+/) {
410 $oops++;
411 warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
412 } else {
413 my @n = split /\s+-+\s+/;
414 if (@n != 2) {
415 $oops++;
416 warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n"
417 }
418 else {
419 %namedesc = @n;
420 }
421 }
422 last FCHECK;
423 }
424 next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME
425 next if /^=pod\b/; # It is OK to have =pod before NAME
426 die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax;
427 }
428 die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax;
429 }
430 close F;
431}
432
433print <<"END";
434.rn '' }`
435''' \$RCSfile\$\$Revision\$\$Date\$
436'''
437''' \$Log\$
438'''
439.de Sh
440.br
441.if t .Sp
442.ne 5
443.PP
444\\fB\\\\\$1\\fR
445.PP
446..
447.de Sp
448.if t .sp .5v
449.if n .sp
450..
451.de Ip
452.br
453.ie \\\\n(.\$>=3 .ne \\\\\$3
454.el .ne 3
455.IP "\\\\\$1" \\\\\$2
456..
457.de Vb
458.ft $CFont
459.nf
460.ne \\\\\$1
461..
462.de Ve
463.ft R
464
465.fi
466..
467'''
468'''
469''' Set up \\*(-- to give an unbreakable dash;
470''' string Tr holds user defined translation string.
471''' Bell System Logo is used as a dummy character.
472'''
473.tr \\(*W-|\\(bv\\*(Tr
474.ie n \\{\\
475.ds -- \\(*W-
476.ds PI pi
477.if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
478.if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
479.ds L" ""
480.ds R" ""
481''' \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of
482''' \\*(L" and \\*(R", except that they are used on ".xx" lines,
483''' such as .IP and .SH, which do another additional levels of
484''' double-quote interpretation
485.ds M" """
486.ds S" """
487.ds N" """""
488.ds T" """""
489.ds L' '
490.ds R' '
491.ds M' '
492.ds S' '
493.ds N' '
494.ds T' '
495'br\\}
496.el\\{\\
497.ds -- \\(em\\|
498.tr \\*(Tr
499.ds L" ``
500.ds R" ''
501.ds M" ``
502.ds S" ''
503.ds N" ``
504.ds T" ''
505.ds L' `
506.ds R' '
507.ds M' `
508.ds S' '
509.ds N' `
510.ds T' '
511.ds PI \\(*p
512'br\\}
513END
514
515print <<'END';
516.\" If the F register is turned on, we'll generate
517.\" index entries out stderr for the following things:
518.\" TH Title
519.\" SH Header
520.\" Sh Subsection
521.\" Ip Item
522.\" X<> Xref (embedded
523.\" Of course, you have to process the output yourself
524.\" in some meaninful fashion.
525.if \nF \{
526.de IX
527.tm Index:\\$1\t\\n%\t"\\$2"
528..
529.nr % 0
530.rr F
531.\}
532END
533
534print <<"END";
535.TH $name $section "$RP" "$date" "$center"
536.UC
537END
538
539push(@Indices, qq{.IX Title "$name $section"});
540
541while (($name, $desc) = each %namedesc) {
542 for ($name, $desc) { s/^\s+//; s/\s+$//; }
543 push(@Indices, qq(.IX Name "$name - $desc"\n));
544}
545
546print <<'END';
547.if n .hy 0
548.if n .na
549.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
550.de CQ \" put $1 in typewriter font
551END
552print ".ft $CFont\n";
553print <<'END';
554'if n "\c
555'if t \\&\\$1\c
556'if n \\&\\$1\c
557'if n \&"
558\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
559'.ft R
560..
561.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
562. \" AM - accent mark definitions
563.bd B 3
564. \" fudge factors for nroff and troff
565.if n \{\
566. ds #H 0
567. ds #V .8m
568. ds #F .3m
569. ds #[ \f1
570. ds #] \fP
571.\}
572.if t \{\
573. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
574. ds #V .6m
575. ds #F 0
576. ds #[ \&
577. ds #] \&
578.\}
579. \" simple accents for nroff and troff
580.if n \{\
581. ds ' \&
582. ds ` \&
583. ds ^ \&
584. ds , \&
585. ds ~ ~
586. ds ? ?
587. ds ! !
588. ds /
589. ds q
590.\}
591.if t \{\
592. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
593. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
594. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
595. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
596. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
597. ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
598. ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
599. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
600. ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10'
601.\}
602. \" troff and (daisy-wheel) nroff accents
603.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
604.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
605.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
606.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
607.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
608.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
609.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
610.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
611.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
612.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
613.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
614.ds ae a\h'-(\w'a'u*4/10)'e
615.ds Ae A\h'-(\w'A'u*4/10)'E
616.ds oe o\h'-(\w'o'u*4/10)'e
617.ds Oe O\h'-(\w'O'u*4/10)'E
618. \" corrections for vroff
619.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
620.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
621. \" for low resolution devices (crt and lpr)
622.if \n(.H>23 .if \n(.V>19 \
623\{\
624. ds : e
625. ds 8 ss
626. ds v \h'-1'\o'\(aa\(ga'
627. ds _ \h'-1'^
628. ds . \h'-1'.
629. ds 3 3
630. ds o a
631. ds d- d\h'-1'\(ga
632. ds D- D\h'-1'\(hy
633. ds th \o'bp'
634. ds Th \o'LP'
635. ds ae ae
636. ds Ae AE
637. ds oe oe
638. ds Oe OE
639.\}
640.rm #[ #] #H #V #F C
641END
642
643$indent = 0;
644
645$begun = "";
646
647# Unrolling [^A-Z>]|[A-Z](?!<) gives: // MRE pp 165.
648my $nonest = '(?:[^A-Z>]*(?:[A-Z](?!<)[^A-Z>]*)*)';
649
650while (<>) {
651 if ($cutting) {
652 next unless /^=/;
653 $cutting = 0;
654 }
655 if ($begun) {
656 if (/^=end\s+$begun/) {
657 $begun = "";
658 }
659 elsif ($begun =~ /^(roff|man)$/) {
660 print STDOUT $_;
661 }
662 next;
663 }
664 chomp;
665
666 # Translate verbatim paragraph
667
668 if (/^\s/) {
669 @lines = split(/\n/);
670 for (@lines) {
671 1 while s
672 {^( [^\t]* ) \t ( \t* ) }
673 { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
674 s/\\/\\e/g;
675 s/\A/\\&/s;
676 }
677 $lines = @lines;
678 makespace() unless $verbatim++;
679 print ".Vb $lines\n";
680 print join("\n", @lines), "\n";
681 print ".Ve\n";
682 $needspace = 0;
683 next;
684 }
685
686 $verbatim = 0;
687
688 if (/^=for\s+(\S+)\s*/s) {
689 if ($1 eq "man" or $1 eq "roff") {
690 print STDOUT $',"\n\n";
691 } else {
692 # ignore unknown for
693 }
694 next;
695 }
696 elsif (/^=begin\s+(\S+)\s*/s) {
697 $begun = $1;
698 if ($1 eq "man" or $1 eq "roff") {
699 print STDOUT $'."\n\n";
700 }
701 next;
702 }
703
704 # check for things that'll hosed our noremap scheme; affects $_
705 init_noremap();
706
707 if (!/^=item/) {
708
709 # trofficate backslashes; must do it before what happens below
710 s/\\/noremap('\\e')/ge;
711
712 # protect leading periods and quotes against *roff
713 # mistaking them for directives
714 s/^(?:[A-Z]<)?[.']/\\&$&/gm;
715
716 # first hide the escapes in case we need to
717 # intuit something and get it wrong due to fmting
718
719 1 while s/([A-Z]<$nonest>)/noremap($1)/ge;
720
721 # func() is a reference to a perl function
722 s{
723 \b
724 (
725 [:\w]+ \(\)
726 )
727 } {I<$1>}gx;
728
729 # func(n) is a reference to a perl function or a man page
730 s{
731 ([:\w]+)
732 (
733 \( [^\051]+ \)
734 )
735 } {I<$1>\\|$2}gx;
736
737 # convert simple variable references
738 s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g;
739
740 if (m{ (
741 [\-\w]+
742 \(
743 [^\051]*?
744 [\@\$,]
745 [^\051]*?
746 \)
747 )
748 }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
749 {
750 warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
751 $oops++;
752 }
753
754 while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
755 warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
756 $oops++;
757 }
758
759 # put it back so we get the <> processed again;
760 clear_noremap(0); # 0 means leave the E's
761
762 } else {
763 # trofficate backslashes
764 s/\\/noremap('\\e')/ge;
765
766 }
767
768 # need to hide E<> first; they're processed in clear_noremap
769 s/(E<[^<>]+>)/noremap($1)/ge;
770
771
772 $maxnest = 10;
773 while ($maxnest-- && /[A-Z]</) {
774
775 # can't do C font here
776 s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg;
777
778 # files and filelike refs in italics
779 s/F<($nonest)>/I<$1>/g;
780
781 # no break -- usually we want C<> for this
782 s/S<($nonest)>/nobreak($1)/eg;
783
784 # LREF: a la HREF L<show this text|man/section>
785 s:L<([^|>]+)\|[^>]+>:$1:g;
786
787 # LREF: a manpage(3f)
788 s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
789
790 # LREF: an =item on another manpage
791 s{
792 L<
793 ([^/]+)
794 /
795 (
796 [:\w]+
797 (\(\))?
798 )
799 >
800 } {the C<$2> entry in the I<$1> manpage}gx;
801
802 # LREF: an =item on this manpage
803 s{
804 ((?:
805 L<
806 /
807 (
808 [:\w]+
809 (\(\))?
810 )
811 >
812 (,?\s+(and\s+)?)?
813 )+)
814 } { internal_lrefs($1) }gex;
815
816 # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
817 # the "func" can disambiguate
818 s{
819 L<
820 (?:
821 ([a-zA-Z]\S+?) /
822 )?
823 "?(.*?)"?
824 >
825 }{
826 do {
827 $1 # if no $1, assume it means on this page.
828 ? "the section on I<$2> in the I<$1> manpage"
829 : "the section on I<$2>"
830 }
831 }gesx; # s in case it goes over multiple lines, so . matches \n
832
833 s/Z<>/\\&/g;
834
835 # comes last because not subject to reprocessing
836 s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg;
837 }
838
839 if (s/^=//) {
840 $needspace = 0; # Assume this.
841
842 s/\n/ /g;
843
844 ($Cmd, $_) = split(' ', $_, 2);
845
846 $dotlevel = 1;
847 if ($Cmd eq 'head1') {
848 $dotlevel = 1;
849 }
850 elsif ($Cmd eq 'head2') {
851 $dotlevel = 1;
852 }
853 elsif ($Cmd eq 'item') {
854 $dotlevel = 2;
855 }
856
857 if (defined $_) {
858 &escapes($dotlevel);
859 s/"/""/g;
860 }
861
862 clear_noremap(1);
863
864 if ($Cmd eq 'cut') {
865 $cutting = 1;
866 }
867 elsif ($Cmd eq 'head1') {
868 s/\s+$//;
869 delete $wanna_see{$_} if exists $wanna_see{$_};
870 print qq{.SH "$_"\n};
871 push(@Indices, qq{.IX Header "$_"\n});
872 }
873 elsif ($Cmd eq 'head2') {
874 print qq{.Sh "$_"\n};
875 push(@Indices, qq{.IX Subsection "$_"\n});
876 }
877 elsif ($Cmd eq 'over') {
878 push(@indent,$indent);
879 $indent += ($_ + 0) || 5;
880 }
881 elsif ($Cmd eq 'back') {
882 $indent = pop(@indent);
883 warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
884 $needspace = 1;
885 }
886 elsif ($Cmd eq 'item') {
887 s/^\*( |$)/\\(bu$1/g;
888 # if you know how to get ":s please do
889 s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g;
890 s/\\\*\(L"([^"]+?)""/'$1'/g;
891 s/[^"]""([^"]+?)""[^"]/'$1'/g;
892 # here do something about the $" in perlvar?
893 print STDOUT qq{.Ip "$_" $indent\n};
894 push(@Indices, qq{.IX Item "$_"\n});
895 }
896 elsif ($Cmd eq 'pod') {
897 # this is just a comment
898 }
899 else {
900 warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
901 }
902 }
903 else {
904 if ($needspace) {
905 &makespace;
906 }
907 &escapes(0);
908 clear_noremap(1);
909 print $_, "\n";
910 $needspace = 1;
911 }
912}
913
914print <<"END";
915
916.rn }` ''
917END
918
919if (%wanna_see && !$lax) {
920 @missing = keys %wanna_see;
921 warn "$0: $Filename is missing required section"
922 . (@missing > 1 && "s")
923 . ": @missing\n";
924 $oops++;
925}
926
927foreach (@Indices) { print "$_\n"; }
928
929exit;
930#exit ($oops != 0);
931
932#########################################################################
933
934sub nobreak {
935 my $string = shift;
936 $string =~ s/ /\\ /g;
937 $string;
938}
939
940sub escapes {
941 my $indot = shift;
942
943 s/X<(.*?)>/mkindex($1)/ge;
944
945 # translate the minus in foo-bar into foo\-bar for roff
946 s/([^0-9a-z-])-([^-])/$1\\-$2/g;
947
948 # make -- into the string version \*(-- (defined above)
949 s/\b--\b/\\*(--/g;
950 s/"--([^"])/"\\*(--$1/g; # should be a better way
951 s/([^"])--"/$1\\*(--"/g;
952
953 # fix up quotes; this is somewhat tricky
954 my $dotmacroL = 'L';
955 my $dotmacroR = 'R';
956 if ( $indot == 1 ) {
957 $dotmacroL = 'M';
958 $dotmacroR = 'S';
959 }
960 elsif ( $indot >= 2 ) {
961 $dotmacroL = 'N';
962 $dotmacroR = 'T';
963 }
964 if (!/""/) {
965 s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge;
966 s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge;
967 }
968
969 #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
970 #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
971
972
973 # make sure that func() keeps a bit a space tween the parens
974 ### s/\b\(\)/\\|()/g;
975 ### s/\b\(\)/(\\|)/g;
976
977 # make C++ into \*C+, which is a squinched version (defined above)
978 s/\bC\+\+/\\*(C+/g;
979
980 # make double underbars have a little tiny space between them
981 s/__/_\\|_/g;
982
983 # PI goes to \*(PI (defined above)
984 s/\bPI\b/noremap('\\*(PI')/ge;
985
986 # make all caps a teeny bit smaller, but don't muck with embedded code literals
987 my $hidCFont = font('C');
988 if ($Cmd !~ /^head1/) { # SH already makes smaller
989 # /g isn't enough; 1 while or we'll be off
990
991# 1 while s{
992# (?!$hidCFont)(..|^.|^)
993# \b
994# (
995# [A-Z][\/A-Z+:\-\d_$.]+
996# )
997# (s?)
998# \b
999# } {$1\\s-1$2\\s0}gmox;
1000
1001 1 while s{
1002 (?!$hidCFont)(..|^.|^)
1003 (
1004 \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
1005 )
1006 } {
1007 $1 . noremap( '\\s-1' . $2 . '\\s0' )
1008 }egmox;
1009
1010 }
1011}
1012
1013# make troff just be normal, but make small nroff get quoted
1014# decided to just put the quotes in the text; sigh;
1015sub ccvt {
1016 local($_,$prev) = @_;
1017 noremap(qq{.CQ "$_" \n\\&});
1018}
1019
1020sub makespace {
1021 if ($indent) {
1022 print ".Sp\n";
1023 }
1024 else {
1025 print ".PP\n";
1026 }
1027}
1028
1029sub mkindex {
1030 my ($entry) = @_;
1031 my @entries = split m:\s*/\s*:, $entry;
1032 push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries;
1033 return '';
1034}
1035
1036sub font {
1037 local($font) = shift;
1038 return '\\f' . noremap($font);
1039}
1040
1041sub noremap {
1042 local($thing_to_hide) = shift;
1043 $thing_to_hide =~ tr/\000-\177/\200-\377/;
1044 return $thing_to_hide;
1045}
1046
1047sub init_noremap {
1048 # escape high bit characters in input stream
1049 s/([\200-\377])/"E<".ord($1).">"/ge;
1050}
1051
1052sub clear_noremap {
1053 my $ready_to_print = $_[0];
1054
1055 tr/\200-\377/\000-\177/;
1056
1057 # trofficate backslashes
1058 # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
1059
1060 # now for the E<>s, which have been hidden until now
1061 # otherwise the interative \w<> processing would have
1062 # been hosed by the E<gt>
1063 s {
1064 E<
1065 (
1066 ( \d + )
1067 | ( [A-Za-z]+ )
1068 )
1069 >
1070 } {
1071 do {
1072 defined $2
1073 ? chr($2)
1074 :
1075 exists $HTML_Escapes{$3}
1076 ? do { $HTML_Escapes{$3} }
1077 : do {
1078 warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
1079 "E<$1>";
1080 }
1081 }
1082 }egx if $ready_to_print;
1083}
1084
1085sub internal_lrefs {
1086 local($_) = shift;
1087 local $trailing_and = s/and\s+$// ? "and " : "";
1088
1089 s{L</([^>]+)>}{$1}g;
1090 my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
1091 my $retstr = "the ";
1092 my $i;
1093 for ($i = 0; $i <= $#items; $i++) {
1094 $retstr .= "C<$items[$i]>";
1095 $retstr .= ", " if @items > 2 && $i != $#items;
1096 $retstr .= " and " if $i+2 == @items;
1097 }
1098
1099 $retstr .= " entr" . ( @items > 1 ? "ies" : "y" )
1100 . " elsewhere in this document";
1101 # terminal space to avoid words running together (pattern used
1102 # strips terminal spaces)
1103 $retstr .= " " if length $trailing_and;
1104 $retstr .= $trailing_and;
1105
1106 return $retstr;
1107
1108}
1109
1110BEGIN {
1111%HTML_Escapes = (
1112 'amp' => '&', # ampersand
1113 'lt' => '<', # left chevron, less-than
1114 'gt' => '>', # right chevron, greater-than
1115 'quot' => '"', # double quote
1116
1117 "Aacute" => "A\\*'", # capital A, acute accent
1118 "aacute" => "a\\*'", # small a, acute accent
1119 "Acirc" => "A\\*^", # capital A, circumflex accent
1120 "acirc" => "a\\*^", # small a, circumflex accent
1121 "AElig" => '\*(AE', # capital AE diphthong (ligature)
1122 "aelig" => '\*(ae', # small ae diphthong (ligature)
1123 "Agrave" => "A\\*`", # capital A, grave accent
1124 "agrave" => "A\\*`", # small a, grave accent
1125 "Aring" => 'A\\*o', # capital A, ring
1126 "aring" => 'a\\*o', # small a, ring
1127 "Atilde" => 'A\\*~', # capital A, tilde
1128 "atilde" => 'a\\*~', # small a, tilde
1129 "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark
1130 "auml" => 'a\\*:', # small a, dieresis or umlaut mark
1131 "Ccedil" => 'C\\*,', # capital C, cedilla
1132 "ccedil" => 'c\\*,', # small c, cedilla
1133 "Eacute" => "E\\*'", # capital E, acute accent
1134 "eacute" => "e\\*'", # small e, acute accent
1135 "Ecirc" => "E\\*^", # capital E, circumflex accent
1136 "ecirc" => "e\\*^", # small e, circumflex accent
1137 "Egrave" => "E\\*`", # capital E, grave accent
1138 "egrave" => "e\\*`", # small e, grave accent
1139 "ETH" => '\\*(D-', # capital Eth, Icelandic
1140 "eth" => '\\*(d-', # small eth, Icelandic
1141 "Euml" => "E\\*:", # capital E, dieresis or umlaut mark
1142 "euml" => "e\\*:", # small e, dieresis or umlaut mark
1143 "Iacute" => "I\\*'", # capital I, acute accent
1144 "iacute" => "i\\*'", # small i, acute accent
1145 "Icirc" => "I\\*^", # capital I, circumflex accent
1146 "icirc" => "i\\*^", # small i, circumflex accent
1147 "Igrave" => "I\\*`", # capital I, grave accent
1148 "igrave" => "i\\*`", # small i, grave accent
1149 "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark
1150 "iuml" => "i\\*:", # small i, dieresis or umlaut mark
1151 "Ntilde" => 'N\*~', # capital N, tilde
1152 "ntilde" => 'n\*~', # small n, tilde
1153 "Oacute" => "O\\*'", # capital O, acute accent
1154 "oacute" => "o\\*'", # small o, acute accent
1155 "Ocirc" => "O\\*^", # capital O, circumflex accent
1156 "ocirc" => "o\\*^", # small o, circumflex accent
1157 "Ograve" => "O\\*`", # capital O, grave accent
1158 "ograve" => "o\\*`", # small o, grave accent
1159 "Oslash" => "O\\*/", # capital O, slash
1160 "oslash" => "o\\*/", # small o, slash
1161 "Otilde" => "O\\*~", # capital O, tilde
1162 "otilde" => "o\\*~", # small o, tilde
1163 "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark
1164 "ouml" => "o\\*:", # small o, dieresis or umlaut mark
1165 "szlig" => '\*8', # small sharp s, German (sz ligature)
1166 "THORN" => '\\*(Th', # capital THORN, Icelandic
1167 "thorn" => '\\*(th',, # small thorn, Icelandic
1168 "Uacute" => "U\\*'", # capital U, acute accent
1169 "uacute" => "u\\*'", # small u, acute accent
1170 "Ucirc" => "U\\*^", # capital U, circumflex accent
1171 "ucirc" => "u\\*^", # small u, circumflex accent
1172 "Ugrave" => "U\\*`", # capital U, grave accent
1173 "ugrave" => "u\\*`", # small u, grave accent
1174 "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark
1175 "uuml" => "u\\*:", # small u, dieresis or umlaut mark
1176 "Yacute" => "Y\\*'", # capital Y, acute accent
1177 "yacute" => "y\\*'", # small y, acute accent
1178 "yuml" => "y\\*:", # small y, dieresis or umlaut mark
1179);
1180}
1181