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