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