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