This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pod/pod2man.PL
[perl5.git] / pod / pod2man.PL
CommitLineData
4633a7c4
LW
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
8a5546a1 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
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.
8a5546a1 17$origdir = cwd;
44a8e56a
PP
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') {
3dd51965
PP
321 ($version,$patch) =
322 `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
323}
324# No luck; we'll just go with the running Perl's version
325($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
cb1a09d0
AD
326$DEF_RELEASE = "perl $version";
327$DEF_RELEASE .= ", patch $patch" if $patch;
328
329
330sub makedate {
331 my $secs = shift;
332 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
333 my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
334 return "$mday/$mname/$year";
a0d0e21e
LW
335}
336
cb1a09d0
AD
337use Getopt::Long;
338
339$DEF_SECTION = 1;
340$DEF_CENTER = "User Contributed Perl Documentation";
341$STD_CENTER = "Perl Programmers Reference Guide";
342$DEF_FIXED = 'CW';
1e422769 343$DEF_LAX = 0;
cb1a09d0
AD
344
345sub usage {
346 warn "$0: @_\n" if @_;
347 die <<EOF;
348usage: $0 [options] podpage
349Options are:
350 --section=manext (default "$DEF_SECTION")
351 --release=relpatch (default "$DEF_RELEASE")
352 --center=string (default "$DEF_CENTER")
353 --date=string (default "$DEF_DATE")
354 --fixed=font (default "$DEF_FIXED")
355 --official (default NOT)
1e422769 356 --lax (default NOT)
cb1a09d0
AD
357EOF
358}
359
360$uok = GetOptions( qw(
361 section=s
362 release=s
363 center=s
364 date=s
365 fixed=s
366 official
1e422769 367 lax
cb1a09d0
AD
368 help));
369
370$DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
371
372usage("Usage error!") unless $uok;
373usage() if $opt_help;
374usage("Need one and only one podpage argument") unless @ARGV == 1;
375
2e4a4f55
RS
376$section = $opt_section || ($ARGV[0] =~ /\.pm$/
377 ? $DEF_PM_SECTION : $DEF_SECTION);
cb1a09d0
AD
378$RP = $opt_release || $DEF_RELEASE;
379$center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
1e422769 380$lax = $opt_lax || $DEF_LAX;
cb1a09d0
AD
381
382$CFont = $opt_fixed || $DEF_FIXED;
383
a0d0e21e
LW
384if (length($CFont) == 2) {
385 $CFont_embed = "\\f($CFont";
cb1a09d0 386}
a0d0e21e
LW
387elsif (length($CFont) == 1) {
388 $CFont_embed = "\\f$CFont";
cb1a09d0 389}
a0d0e21e 390else {
cb1a09d0
AD
391 die "roff font should be 1 or 2 chars, not `$CFont_embed'";
392}
393
cb1a09d0
AD
394$date = $opt_date || $DEF_DATE;
395
396for (qw{NAME DESCRIPTION}) {
397# for (qw{NAME DESCRIPTION AUTHOR}) {
398 $wanna_see{$_}++;
399}
400$wanna_see{SYNOPSIS}++ if $section =~ /^3/;
401
a0d0e21e 402
cb1a09d0
AD
403$name = @ARGV ? $ARGV[0] : "<STDIN>";
404$Filename = $name;
55497cff
PP
405if ($section =~ /^1/) {
406 require File::Basename;
407 $name = uc File::Basename::basename($name);
408}
409$name =~ s/\.(pod|p[lm])$//i;
bbc6b0c7
RS
410
411# Lose everything up to the first of
412# */lib/*perl* standard or site_perl module
413# */*perl*/lib from -D prefix=/opt/perl
414# */*perl*/ random module hierarchy
415# which works.
416$name =~ s-//+-/-g;
417if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
418 or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
419 or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
2dde2d61
GS
420 # Lose ^site(_perl)?/.
421 $name =~ s-^site(_perl)?/--;
422 # Lose ^arch/. (XXX should we use Config? Just for archname?)
423 $name =~ s~^(.*-$^O|$^O-.*)/~~o;
424 # Lose ^version/.
425 $name =~ s-^\d+\.\d+/--;
bbc6b0c7
RS
426}
427
428# Translate Getopt/Long to Getopt::Long, etc.
429$name =~ s(/)(::)g;
a0d0e21e 430
cb1a09d0
AD
431if ($name ne 'something') {
432 FCHECK: {
433 open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
434 while (<F>) {
f360dba1 435 next unless /^=\b/;
cb1a09d0
AD
436 if (/^=head1\s+NAME\s*$/) { # an /m would forgive mistakes
437 $_ = <F>;
438 unless (/\s*-+\s+/) {
439 $oops++;
f360dba1 440 warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
d714cd28
CS
441 } else {
442 my @n = split /\s+-+\s+/;
443 if (@n != 2) {
444 $oops++;
445 warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n"
446 }
447 else {
448 %namedesc = @n;
449 }
450 }
cb1a09d0
AD
451 last FCHECK;
452 }
f360dba1 453 next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME
a8aaa22c 454 next if /^=pod\b/; # It is OK to have =pod before NAME
1e422769 455 die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax;
cb1a09d0 456 }
1e422769 457 die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax;
cb1a09d0
AD
458 }
459 close F;
460}
461
a0d0e21e
LW
462print <<"END";
463.rn '' }`
464''' \$RCSfile\$\$Revision\$\$Date\$
cb1a09d0 465'''
a0d0e21e 466''' \$Log\$
cb1a09d0 467'''
a0d0e21e
LW
468.de Sh
469.br
470.if t .Sp
471.ne 5
472.PP
473\\fB\\\\\$1\\fR
474.PP
475..
476.de Sp
477.if t .sp .5v
478.if n .sp
479..
480.de Ip
481.br
482.ie \\\\n(.\$>=3 .ne \\\\\$3
483.el .ne 3
484.IP "\\\\\$1" \\\\\$2
485..
486.de Vb
487.ft $CFont
488.nf
489.ne \\\\\$1
490..
491.de Ve
492.ft R
493
494.fi
495..
496'''
497'''
498''' Set up \\*(-- to give an unbreakable dash;
499''' string Tr holds user defined translation string.
500''' Bell System Logo is used as a dummy character.
501'''
502.tr \\(*W-|\\(bv\\*(Tr
503.ie n \\{\\
504.ds -- \\(*W-
cb1a09d0 505.ds PI pi
a0d0e21e
LW
506.if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
507.if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
508.ds L" ""
509.ds R" ""
3e3baf6d
TB
510''' \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of
511''' \\*(L" and \\*(R", except that they are used on ".xx" lines,
512''' such as .IP and .SH, which do another additional levels of
513''' double-quote interpretation
514.ds M" """
515.ds S" """
516.ds N" """""
517.ds T" """""
a0d0e21e
LW
518.ds L' '
519.ds R' '
3e3baf6d
TB
520.ds M' '
521.ds S' '
522.ds N' '
523.ds T' '
a0d0e21e
LW
524'br\\}
525.el\\{\\
526.ds -- \\(em\\|
527.tr \\*(Tr
528.ds L" ``
529.ds R" ''
3e3baf6d
TB
530.ds M" ``
531.ds S" ''
532.ds N" ``
533.ds T" ''
a0d0e21e
LW
534.ds L' `
535.ds R' '
3e3baf6d
TB
536.ds M' `
537.ds S' '
538.ds N' `
539.ds T' '
cb1a09d0 540.ds PI \\(*p
a0d0e21e 541'br\\}
cb1a09d0
AD
542END
543
544print <<'END';
545.\" If the F register is turned on, we'll generate
546.\" index entries out stderr for the following things:
547.\" TH Title
548.\" SH Header
549.\" Sh Subsection
550.\" Ip Item
551.\" X<> Xref (embedded
552.\" Of course, you have to process the output yourself
553.\" in some meaninful fashion.
554.if \nF \{
555.de IX
556.tm Index:\\$1\t\\n%\t"\\$2"
557..
558.nr % 0
559.rr F
560.\}
561END
562
563print <<"END";
564.TH $name $section "$RP" "$date" "$center"
a0d0e21e
LW
565.UC
566END
567
1c98b8f6
G
568push(@Indices, qq{.IX Title "$name $section"});
569
cb1a09d0
AD
570while (($name, $desc) = each %namedesc) {
571 for ($name, $desc) { s/^\s+//; s/\s+$//; }
1c98b8f6 572 push(@Indices, qq(.IX Name "$name - $desc"\n));
cb1a09d0
AD
573}
574
a0d0e21e 575print <<'END';
cb1a09d0 576.if n .hy 0
a0d0e21e
LW
577.if n .na
578.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
579.de CQ \" put $1 in typewriter font
580END
581print ".ft $CFont\n";
582print <<'END';
583'if n "\c
748a9306
LW
584'if t \\&\\$1\c
585'if n \\&\\$1\c
a0d0e21e 586'if n \&"
748a9306 587\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
a0d0e21e
LW
588'.ft R
589..
590.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
591. \" AM - accent mark definitions
9430eed9 592.bd B 3
a0d0e21e
LW
593. \" fudge factors for nroff and troff
594.if n \{\
595. ds #H 0
596. ds #V .8m
597. ds #F .3m
598. ds #[ \f1
599. ds #] \fP
600.\}
601.if t \{\
748a9306 602. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
a0d0e21e
LW
603. ds #V .6m
604. ds #F 0
605. ds #[ \&
606. ds #] \&
607.\}
608. \" simple accents for nroff and troff
609.if n \{\
610. ds ' \&
611. ds ` \&
612. ds ^ \&
613. ds , \&
614. ds ~ ~
615. ds ? ?
616. ds ! !
cb1a09d0
AD
617. ds /
618. ds q
a0d0e21e
LW
619.\}
620.if t \{\
748a9306
LW
621. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
622. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
623. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
624. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
625. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
a0d0e21e
LW
626. ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
627. ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
748a9306 628. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
a0d0e21e
LW
629. 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'
630.\}
631. \" troff and (daisy-wheel) nroff accents
748a9306 632.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
a0d0e21e 633.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
748a9306
LW
634.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
635.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
636.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
a0d0e21e 637.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
748a9306 638.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
a0d0e21e 639.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
748a9306 640.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
a0d0e21e
LW
641.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
642.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
643.ds ae a\h'-(\w'a'u*4/10)'e
644.ds Ae A\h'-(\w'A'u*4/10)'E
645.ds oe o\h'-(\w'o'u*4/10)'e
646.ds Oe O\h'-(\w'O'u*4/10)'E
647. \" corrections for vroff
748a9306
LW
648.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
649.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
a0d0e21e
LW
650. \" for low resolution devices (crt and lpr)
651.if \n(.H>23 .if \n(.V>19 \
652\{\
653. ds : e
654. ds 8 ss
655. ds v \h'-1'\o'\(aa\(ga'
656. ds _ \h'-1'^
657. ds . \h'-1'.
658. ds 3 3
659. ds o a
660. ds d- d\h'-1'\(ga
661. ds D- D\h'-1'\(hy
662. ds th \o'bp'
663. ds Th \o'LP'
664. ds ae ae
665. ds Ae AE
666. ds oe oe
667. ds Oe OE
668.\}
669.rm #[ #] #H #V #F C
670END
671
672$indent = 0;
673
8c634b6e
KA
674$begun = "";
675
a0d0e21e
LW
676while (<>) {
677 if ($cutting) {
678 next unless /^=/;
679 $cutting = 0;
680 }
8c634b6e
KA
681 if ($begun) {
682 if (/^=end\s+$begun/) {
683 $begun = "";
684 }
685 elsif ($begun =~ /^(roff|man)$/) {
686 print STDOUT $_;
687 }
688 next;
689 }
a0d0e21e
LW
690 chomp;
691
692 # Translate verbatim paragraph
693
694 if (/^\s/) {
695 @lines = split(/\n/);
696 for (@lines) {
697 1 while s
698 {^( [^\t]* ) \t ( \t* ) }
699 { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
700 s/\\/\\e/g;
701 s/\A/\\&/s;
702 }
703 $lines = @lines;
704 makespace() unless $verbatim++;
705 print ".Vb $lines\n";
706 print join("\n", @lines), "\n";
707 print ".Ve\n";
708 $needspace = 0;
709 next;
710 }
711
712 $verbatim = 0;
713
8c634b6e
KA
714 if (/^=for\s+(\S+)\s*/s) {
715 if ($1 eq "man" or $1 eq "roff") {
716 print STDOUT $',"\n\n";
717 } else {
718 # ignore unknown for
719 }
720 next;
721 }
722 elsif (/^=begin\s+(\S+)\s*/s) {
723 $begun = $1;
724 if ($1 eq "man" or $1 eq "roff") {
725 print STDOUT $'."\n\n";
726 }
727 next;
728 }
729
a0d0e21e
LW
730 # check for things that'll hosed our noremap scheme; affects $_
731 init_noremap();
732
733 if (!/^=item/) {
734
735 # trofficate backslashes; must do it before what happens below
736 s/\\/noremap('\\e')/ge;
737
5b4ebf24
TB
738 # protect leading periods and quotes against *roff
739 # mistaking them for directives
740 s/^(?:[A-Z]<)?[.']/\\&$&/gm;
a0d0e21e 741
cb1a09d0 742 # first hide the escapes in case we need to
a0d0e21e
LW
743 # intuit something and get it wrong due to fmting
744
7b8d334a 745 1 while s/([A-Z]<[^<>]*>)/noremap($1)/ge;
a0d0e21e
LW
746
747 # func() is a reference to a perl function
748 s{
749 \b
750 (
751 [:\w]+ \(\)
752 )
753 } {I<$1>}gx;
754
1e2391a5 755 # func(n) is a reference to a perl function or a man page
a0d0e21e 756 s{
1e2391a5 757 ([:\w]+)
a0d0e21e 758 (
1e2391a5 759 \( [^\051]+ \)
a0d0e21e
LW
760 )
761 } {I<$1>\\|$2}gx;
762
763 # convert simple variable references
1e2391a5 764 s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g;
a0d0e21e
LW
765
766 if (m{ (
767 [\-\w]+
768 \(
769 [^\051]*?
770 [\@\$,]
771 [^\051]*?
772 \)
773 )
cb1a09d0 774 }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
a0d0e21e 775 {
cb1a09d0
AD
776 warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
777 $oops++;
778 }
a0d0e21e
LW
779
780 while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
cb1a09d0
AD
781 warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
782 $oops++;
783 }
a0d0e21e
LW
784
785 # put it back so we get the <> processed again;
786 clear_noremap(0); # 0 means leave the E's
787
788 } else {
789 # trofficate backslashes
790 s/\\/noremap('\\e')/ge;
791
cb1a09d0 792 }
a0d0e21e
LW
793
794 # need to hide E<> first; they're processed in clear_noremap
795 s/(E<[^<>]+>)/noremap($1)/ge;
796
797
798 $maxnest = 10;
799 while ($maxnest-- && /[A-Z]</) {
800
801 # can't do C font here
802 s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
803
804 # files and filelike refs in italics
805 s/F<([^<>]*)>/I<$1>/g;
806
807 # no break -- usually we want C<> for this
808 s/S<([^<>]*)>/nobreak($1)/eg;
809
b74bceb9
AB
810 # LREF: a la HREF L<show this text|man/section>
811 s:L<([^|>]+)\|[^>]+>:$1:g;
812
cb1a09d0 813 # LREF: a manpage(3f)
a0d0e21e
LW
814 s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
815
816 # LREF: an =item on another manpage
817 s{
818 L<
819 ([^/]+)
820 /
821 (
822 [:\w]+
823 (\(\))?
824 )
825 >
826 } {the C<$2> entry in the I<$1> manpage}gx;
827
828 # LREF: an =item on this manpage
829 s{
830 ((?:
831 L<
832 /
833 (
834 [:\w]+
835 (\(\))?
836 )
837 >
838 (,?\s+(and\s+)?)?
839 )+)
840 } { internal_lrefs($1) }gex;
841
842 # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
843 # the "func" can disambiguate
844 s{
845 L<
846 (?:
cb1a09d0 847 ([a-zA-Z]\S+?) /
a0d0e21e
LW
848 )?
849 "?(.*?)"?
850 >
851 }{
852 do {
853 $1 # if no $1, assume it means on this page.
854 ? "the section on I<$2> in the I<$1> manpage"
855 : "the section on I<$2>"
cb1a09d0 856 }
e52f39a2 857 }gesx; # s in case it goes over multiple lines, so . matches \n
a0d0e21e
LW
858
859 s/Z<>/\\&/g;
860
861 # comes last because not subject to reprocessing
862 s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
863 }
864
865 if (s/^=//) {
866 $needspace = 0; # Assume this.
867
868 s/\n/ /g;
869
870 ($Cmd, $_) = split(' ', $_, 2);
871
3e3baf6d
TB
872 $dotlevel = 1;
873 if ($Cmd eq 'head1') {
874 $dotlevel = 1;
875 }
876 elsif ($Cmd eq 'head2') {
877 $dotlevel = 1;
878 }
879 elsif ($Cmd eq 'item') {
880 $dotlevel = 2;
881 }
882
a0d0e21e 883 if (defined $_) {
3e3baf6d 884 &escapes($dotlevel);
a0d0e21e
LW
885 s/"/""/g;
886 }
887
888 clear_noremap(1);
889
890 if ($Cmd eq 'cut') {
891 $cutting = 1;
892 }
893 elsif ($Cmd eq 'head1') {
cb1a09d0
AD
894 s/\s+$//;
895 delete $wanna_see{$_} if exists $wanna_see{$_};
896 print qq{.SH "$_"\n};
1c98b8f6 897 push(@Indices, qq{.IX Header "$_"\n});
a0d0e21e
LW
898 }
899 elsif ($Cmd eq 'head2') {
cb1a09d0 900 print qq{.Sh "$_"\n};
1c98b8f6 901 push(@Indices, qq{.IX Subsection "$_"\n});
a0d0e21e
LW
902 }
903 elsif ($Cmd eq 'over') {
904 push(@indent,$indent);
cb1a09d0 905 $indent += ($_ + 0) || 5;
a0d0e21e
LW
906 }
907 elsif ($Cmd eq 'back') {
908 $indent = pop(@indent);
f360dba1 909 warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
a0d0e21e
LW
910 $needspace = 1;
911 }
912 elsif ($Cmd eq 'item') {
913 s/^\*( |$)/\\(bu$1/g;
6ea29bdc
JH
914 # if you know how to get ":s please do
915 s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g;
916 s/\\\*\(L"([^"]+?)""/'$1'/g;
917 s/[^"]""([^"]+?)""[^"]/'$1'/g;
918 # here do something about the $" in perlvar?
a0d0e21e 919 print STDOUT qq{.Ip "$_" $indent\n};
1c98b8f6 920 push(@Indices, qq{.IX Item "$_"\n});
a0d0e21e 921 }
cb1a09d0
AD
922 elsif ($Cmd eq 'pod') {
923 # this is just a comment
924 }
a0d0e21e 925 else {
f360dba1 926 warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
a0d0e21e
LW
927 }
928 }
929 else {
930 if ($needspace) {
931 &makespace;
932 }
3e3baf6d 933 &escapes(0);
a0d0e21e
LW
934 clear_noremap(1);
935 print $_, "\n";
936 $needspace = 1;
937 }
938}
939
940print <<"END";
941
942.rn }` ''
943END
944
1e422769 945if (%wanna_see && !$lax) {
cb1a09d0
AD
946 @missing = keys %wanna_see;
947 warn "$0: $Filename is missing required section"
948 . (@missing > 1 && "s")
949 . ": @missing\n";
950 $oops++;
951}
952
1c98b8f6
G
953foreach (@Indices) { print "$_\n"; }
954
cb1a09d0
AD
955exit;
956#exit ($oops != 0);
957
a0d0e21e
LW
958#########################################################################
959
960sub nobreak {
961 my $string = shift;
962 $string =~ s/ /\\ /g;
963 $string;
964}
965
966sub escapes {
3e3baf6d 967 my $indot = shift;
a0d0e21e 968
cb1a09d0
AD
969 s/X<(.*?)>/mkindex($1)/ge;
970
a0d0e21e
LW
971 # translate the minus in foo-bar into foo\-bar for roff
972 s/([^0-9a-z-])-([^-])/$1\\-$2/g;
973
974 # make -- into the string version \*(-- (defined above)
975 s/\b--\b/\\*(--/g;
976 s/"--([^"])/"\\*(--$1/g; # should be a better way
977 s/([^"])--"/$1\\*(--"/g;
978
979 # fix up quotes; this is somewhat tricky
3e3baf6d
TB
980 my $dotmacroL = 'L';
981 my $dotmacroR = 'R';
982 if ( $indot == 1 ) {
983 $dotmacroL = 'M';
984 $dotmacroR = 'S';
985 }
986 elsif ( $indot >= 2 ) {
987 $dotmacroL = 'N';
988 $dotmacroR = 'T';
989 }
a0d0e21e 990 if (!/""/) {
3e3baf6d
TB
991 s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge;
992 s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge;
a0d0e21e
LW
993 }
994
995 #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
996 #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
cb1a09d0 997
a0d0e21e
LW
998
999 # make sure that func() keeps a bit a space tween the parens
1000 ### s/\b\(\)/\\|()/g;
1001 ### s/\b\(\)/(\\|)/g;
1002
1003 # make C++ into \*C+, which is a squinched version (defined above)
1004 s/\bC\+\+/\\*(C+/g;
1005
1006 # make double underbars have a little tiny space between them
1007 s/__/_\\|_/g;
1008
cb1a09d0 1009 # PI goes to \*(PI (defined above)
a0d0e21e
LW
1010 s/\bPI\b/noremap('\\*(PI')/ge;
1011
1012 # make all caps a teeny bit smaller, but don't muck with embedded code literals
1013 my $hidCFont = font('C');
1014 if ($Cmd !~ /^head1/) { # SH already makes smaller
1015 # /g isn't enough; 1 while or we'll be off
1016
1017# 1 while s{
1018# (?!$hidCFont)(..|^.|^)
1019# \b
1020# (
1021# [A-Z][\/A-Z+:\-\d_$.]+
1022# )
1023# (s?)
1024# \b
1025# } {$1\\s-1$2\\s0}gmox;
1026
1027 1 while s{
1028 (?!$hidCFont)(..|^.|^)
1029 (
1030 \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
1031 )
cb1a09d0 1032 } {
a0d0e21e
LW
1033 $1 . noremap( '\\s-1' . $2 . '\\s0' )
1034 }egmox;
1035
1036 }
1037}
1038
1039# make troff just be normal, but make small nroff get quoted
1040# decided to just put the quotes in the text; sigh;
1041sub ccvt {
1e422769 1042 local($_,$prev) = @_;
a0d0e21e 1043 noremap(qq{.CQ "$_" \n\\&});
cb1a09d0 1044}
a0d0e21e
LW
1045
1046sub makespace {
1047 if ($indent) {
1048 print ".Sp\n";
1049 }
1050 else {
1051 print ".PP\n";
1052 }
1053}
1054
cb1a09d0
AD
1055sub mkindex {
1056 my ($entry) = @_;
1057 my @entries = split m:\s*/\s*:, $entry;
1c98b8f6 1058 push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries;
cb1a09d0
AD
1059 return '';
1060}
1061
a0d0e21e
LW
1062sub font {
1063 local($font) = shift;
1064 return '\\f' . noremap($font);
cb1a09d0 1065}
a0d0e21e
LW
1066
1067sub noremap {
1068 local($thing_to_hide) = shift;
1069 $thing_to_hide =~ tr/\000-\177/\200-\377/;
1070 return $thing_to_hide;
cb1a09d0 1071}
a0d0e21e
LW
1072
1073sub init_noremap {
3dd51965
PP
1074 # escape high bit characters in input stream
1075 s/([\200-\377])/"E<".ord($1).">"/ge;
cb1a09d0 1076}
a0d0e21e
LW
1077
1078sub clear_noremap {
1079 my $ready_to_print = $_[0];
1080
1081 tr/\200-\377/\000-\177/;
1082
1083 # trofficate backslashes
1084 # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
1085
1086 # now for the E<>s, which have been hidden until now
1087 # otherwise the interative \w<> processing would have
1088 # been hosed by the E<gt>
1089 s {
3dd51965
PP
1090 E<
1091 (
1092 ( \d + )
1093 | ( [A-Za-z]+ )
1094 )
a0d0e21e 1095 >
cb1a09d0 1096 } {
3dd51965
PP
1097 do {
1098 defined $2
1099 ? chr($2)
1100 :
1101 exists $HTML_Escapes{$3}
1102 ? do { $HTML_Escapes{$3} }
a0d0e21e 1103 : do {
f360dba1 1104 warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
a0d0e21e 1105 "E<$1>";
cb1a09d0
AD
1106 }
1107 }
a0d0e21e 1108 }egx if $ready_to_print;
cb1a09d0 1109}
a0d0e21e
LW
1110
1111sub internal_lrefs {
1112 local($_) = shift;
5b4ebf24 1113 local $trailing_and = s/and\s+$// ? "and " : "";
a0d0e21e
LW
1114
1115 s{L</([^>]+)>}{$1}g;
1116 my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
1117 my $retstr = "the ";
1118 my $i;
1119 for ($i = 0; $i <= $#items; $i++) {
1120 $retstr .= "C<$items[$i]>";
1121 $retstr .= ", " if @items > 2 && $i != $#items;
1122 $retstr .= " and " if $i+2 == @items;
cb1a09d0 1123 }
a0d0e21e
LW
1124
1125 $retstr .= " entr" . ( @items > 1 ? "ies" : "y" )
7427f721
A
1126 . " elsewhere in this document";
1127 # terminal space to avoid words running together (pattern used
1128 # strips terminal spaces)
1129 $retstr .= " " if length $trailing_and;
5b4ebf24 1130 $retstr .= $trailing_and;
a0d0e21e
LW
1131
1132 return $retstr;
1133
cb1a09d0 1134}
a0d0e21e
LW
1135
1136BEGIN {
1137%HTML_Escapes = (
1138 'amp' => '&', # ampersand
1139 'lt' => '<', # left chevron, less-than
1140 'gt' => '>', # right chevron, greater-than
1141 'quot' => '"', # double quote
1142
1143 "Aacute" => "A\\*'", # capital A, acute accent
1144 "aacute" => "a\\*'", # small a, acute accent
1145 "Acirc" => "A\\*^", # capital A, circumflex accent
1146 "acirc" => "a\\*^", # small a, circumflex accent
1147 "AElig" => '\*(AE', # capital AE diphthong (ligature)
1148 "aelig" => '\*(ae', # small ae diphthong (ligature)
1149 "Agrave" => "A\\*`", # capital A, grave accent
1150 "agrave" => "A\\*`", # small a, grave accent
1151 "Aring" => 'A\\*o', # capital A, ring
1152 "aring" => 'a\\*o', # small a, ring
1153 "Atilde" => 'A\\*~', # capital A, tilde
1154 "atilde" => 'a\\*~', # small a, tilde
1155 "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark
1156 "auml" => 'a\\*:', # small a, dieresis or umlaut mark
1157 "Ccedil" => 'C\\*,', # capital C, cedilla
1158 "ccedil" => 'c\\*,', # small c, cedilla
1159 "Eacute" => "E\\*'", # capital E, acute accent
1160 "eacute" => "e\\*'", # small e, acute accent
1161 "Ecirc" => "E\\*^", # capital E, circumflex accent
1162 "ecirc" => "e\\*^", # small e, circumflex accent
1163 "Egrave" => "E\\*`", # capital E, grave accent
1164 "egrave" => "e\\*`", # small e, grave accent
1165 "ETH" => '\\*(D-', # capital Eth, Icelandic
1166 "eth" => '\\*(d-', # small eth, Icelandic
1167 "Euml" => "E\\*:", # capital E, dieresis or umlaut mark
1168 "euml" => "e\\*:", # small e, dieresis or umlaut mark
1169 "Iacute" => "I\\*'", # capital I, acute accent
1170 "iacute" => "i\\*'", # small i, acute accent
1171 "Icirc" => "I\\*^", # capital I, circumflex accent
1172 "icirc" => "i\\*^", # small i, circumflex accent
1173 "Igrave" => "I\\*`", # capital I, grave accent
1174 "igrave" => "i\\*`", # small i, grave accent
1175 "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark
1176 "iuml" => "i\\*:", # small i, dieresis or umlaut mark
1177 "Ntilde" => 'N\*~', # capital N, tilde
1178 "ntilde" => 'n\*~', # small n, tilde
1179 "Oacute" => "O\\*'", # capital O, acute accent
1180 "oacute" => "o\\*'", # small o, acute accent
1181 "Ocirc" => "O\\*^", # capital O, circumflex accent
1182 "ocirc" => "o\\*^", # small o, circumflex accent
1183 "Ograve" => "O\\*`", # capital O, grave accent
1184 "ograve" => "o\\*`", # small o, grave accent
1185 "Oslash" => "O\\*/", # capital O, slash
1186 "oslash" => "o\\*/", # small o, slash
1187 "Otilde" => "O\\*~", # capital O, tilde
1188 "otilde" => "o\\*~", # small o, tilde
1189 "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark
1190 "ouml" => "o\\*:", # small o, dieresis or umlaut mark
1191 "szlig" => '\*8', # small sharp s, German (sz ligature)
1192 "THORN" => '\\*(Th', # capital THORN, Icelandic
1193 "thorn" => '\\*(th',, # small thorn, Icelandic
1194 "Uacute" => "U\\*'", # capital U, acute accent
1195 "uacute" => "u\\*'", # small u, acute accent
1196 "Ucirc" => "U\\*^", # capital U, circumflex accent
1197 "ucirc" => "u\\*^", # small u, circumflex accent
1198 "Ugrave" => "U\\*`", # capital U, grave accent
1199 "ugrave" => "u\\*`", # small u, grave accent
1200 "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark
1201 "uuml" => "u\\*:", # small u, dieresis or umlaut mark
1202 "Yacute" => "Y\\*'", # capital Y, acute accent
1203 "yacute" => "y\\*'", # small y, acute accent
1204 "yuml" => "y\\*:", # small y, dieresis or umlaut mark
1205);
1206}
cb1a09d0 1207
5d94fbed 1208!NO!SUBS!
4633a7c4
LW
1209
1210close OUT or die "Can't close $file: $!";
1211chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1212exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1 1213chdir $origdir;