This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix overloading via inherited autoloaded functions
[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 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 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 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 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
8c634b6e
KA
611$begun = "";
612
a0d0e21e
LW
613while (<>) {
614 if ($cutting) {
615 next unless /^=/;
616 $cutting = 0;
617 }
8c634b6e
KA
618 if ($begun) {
619 if (/^=end\s+$begun/) {
620 $begun = "";
621 }
622 elsif ($begun =~ /^(roff|man)$/) {
623 print STDOUT $_;
624 }
625 next;
626 }
a0d0e21e
LW
627 chomp;
628
629 # Translate verbatim paragraph
630
631 if (/^\s/) {
632 @lines = split(/\n/);
633 for (@lines) {
634 1 while s
635 {^( [^\t]* ) \t ( \t* ) }
636 { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
637 s/\\/\\e/g;
638 s/\A/\\&/s;
639 }
640 $lines = @lines;
641 makespace() unless $verbatim++;
642 print ".Vb $lines\n";
643 print join("\n", @lines), "\n";
644 print ".Ve\n";
645 $needspace = 0;
646 next;
647 }
648
649 $verbatim = 0;
650
8c634b6e
KA
651 if (/^=for\s+(\S+)\s*/s) {
652 if ($1 eq "man" or $1 eq "roff") {
653 print STDOUT $',"\n\n";
654 } else {
655 # ignore unknown for
656 }
657 next;
658 }
659 elsif (/^=begin\s+(\S+)\s*/s) {
660 $begun = $1;
661 if ($1 eq "man" or $1 eq "roff") {
662 print STDOUT $'."\n\n";
663 }
664 next;
665 }
666
a0d0e21e
LW
667 # check for things that'll hosed our noremap scheme; affects $_
668 init_noremap();
669
670 if (!/^=item/) {
671
672 # trofficate backslashes; must do it before what happens below
673 s/\\/noremap('\\e')/ge;
674
cb1a09d0 675 # first hide the escapes in case we need to
a0d0e21e
LW
676 # intuit something and get it wrong due to fmting
677
678 s/([A-Z]<[^<>]*>)/noremap($1)/ge;
679
680 # func() is a reference to a perl function
681 s{
682 \b
683 (
684 [:\w]+ \(\)
685 )
686 } {I<$1>}gx;
687
688 # func(n) is a reference to a man page
689 s{
690 (\w+)
691 (
692 \(
693 [^\s,\051]+
694 \)
695 )
696 } {I<$1>\\|$2}gx;
697
698 # convert simple variable references
748a9306 699 s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;
a0d0e21e
LW
700
701 if (m{ (
702 [\-\w]+
703 \(
704 [^\051]*?
705 [\@\$,]
706 [^\051]*?
707 \)
708 )
cb1a09d0 709 }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
a0d0e21e 710 {
cb1a09d0
AD
711 warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
712 $oops++;
713 }
a0d0e21e
LW
714
715 while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
cb1a09d0
AD
716 warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
717 $oops++;
718 }
a0d0e21e
LW
719
720 # put it back so we get the <> processed again;
721 clear_noremap(0); # 0 means leave the E's
722
723 } else {
724 # trofficate backslashes
725 s/\\/noremap('\\e')/ge;
726
cb1a09d0 727 }
a0d0e21e
LW
728
729 # need to hide E<> first; they're processed in clear_noremap
730 s/(E<[^<>]+>)/noremap($1)/ge;
731
732
733 $maxnest = 10;
734 while ($maxnest-- && /[A-Z]</) {
735
736 # can't do C font here
737 s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
738
739 # files and filelike refs in italics
740 s/F<([^<>]*)>/I<$1>/g;
741
742 # no break -- usually we want C<> for this
743 s/S<([^<>]*)>/nobreak($1)/eg;
744
cb1a09d0 745 # LREF: a manpage(3f)
a0d0e21e
LW
746 s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
747
748 # LREF: an =item on another manpage
749 s{
750 L<
751 ([^/]+)
752 /
753 (
754 [:\w]+
755 (\(\))?
756 )
757 >
758 } {the C<$2> entry in the I<$1> manpage}gx;
759
760 # LREF: an =item on this manpage
761 s{
762 ((?:
763 L<
764 /
765 (
766 [:\w]+
767 (\(\))?
768 )
769 >
770 (,?\s+(and\s+)?)?
771 )+)
772 } { internal_lrefs($1) }gex;
773
774 # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
775 # the "func" can disambiguate
776 s{
777 L<
778 (?:
cb1a09d0 779 ([a-zA-Z]\S+?) /
a0d0e21e
LW
780 )?
781 "?(.*?)"?
782 >
783 }{
784 do {
785 $1 # if no $1, assume it means on this page.
786 ? "the section on I<$2> in the I<$1> manpage"
787 : "the section on I<$2>"
cb1a09d0 788 }
e52f39a2 789 }gesx; # s in case it goes over multiple lines, so . matches \n
a0d0e21e
LW
790
791 s/Z<>/\\&/g;
792
793 # comes last because not subject to reprocessing
794 s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
795 }
796
797 if (s/^=//) {
798 $needspace = 0; # Assume this.
799
800 s/\n/ /g;
801
802 ($Cmd, $_) = split(' ', $_, 2);
803
804 if (defined $_) {
805 &escapes;
806 s/"/""/g;
807 }
808
809 clear_noremap(1);
810
811 if ($Cmd eq 'cut') {
812 $cutting = 1;
813 }
814 elsif ($Cmd eq 'head1') {
cb1a09d0
AD
815 s/\s+$//;
816 delete $wanna_see{$_} if exists $wanna_see{$_};
817 print qq{.SH "$_"\n};
818 print qq{.IX Header "$_"\n};
a0d0e21e
LW
819 }
820 elsif ($Cmd eq 'head2') {
cb1a09d0
AD
821 print qq{.Sh "$_"\n};
822 print qq{.IX Subsection "$_"\n};
a0d0e21e
LW
823 }
824 elsif ($Cmd eq 'over') {
825 push(@indent,$indent);
cb1a09d0 826 $indent += ($_ + 0) || 5;
a0d0e21e
LW
827 }
828 elsif ($Cmd eq 'back') {
829 $indent = pop(@indent);
f360dba1 830 warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
a0d0e21e
LW
831 $needspace = 1;
832 }
833 elsif ($Cmd eq 'item') {
834 s/^\*( |$)/\\(bu$1/g;
835 print STDOUT qq{.Ip "$_" $indent\n};
cb1a09d0 836 print qq{.IX Item "$_"\n};
a0d0e21e 837 }
cb1a09d0
AD
838 elsif ($Cmd eq 'pod') {
839 # this is just a comment
840 }
a0d0e21e 841 else {
f360dba1 842 warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
a0d0e21e
LW
843 }
844 }
845 else {
846 if ($needspace) {
847 &makespace;
848 }
849 &escapes;
850 clear_noremap(1);
851 print $_, "\n";
852 $needspace = 1;
853 }
854}
855
856print <<"END";
857
858.rn }` ''
859END
860
cb1a09d0
AD
861if (%wanna_see) {
862 @missing = keys %wanna_see;
863 warn "$0: $Filename is missing required section"
864 . (@missing > 1 && "s")
865 . ": @missing\n";
866 $oops++;
867}
868
869exit;
870#exit ($oops != 0);
871
a0d0e21e
LW
872#########################################################################
873
874sub nobreak {
875 my $string = shift;
876 $string =~ s/ /\\ /g;
877 $string;
878}
879
880sub escapes {
881
cb1a09d0
AD
882 s/X<(.*?)>/mkindex($1)/ge;
883
a0d0e21e
LW
884 # translate the minus in foo-bar into foo\-bar for roff
885 s/([^0-9a-z-])-([^-])/$1\\-$2/g;
886
887 # make -- into the string version \*(-- (defined above)
888 s/\b--\b/\\*(--/g;
889 s/"--([^"])/"\\*(--$1/g; # should be a better way
890 s/([^"])--"/$1\\*(--"/g;
891
892 # fix up quotes; this is somewhat tricky
893 if (!/""/) {
894 s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
895 s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
896 }
897
898 #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
899 #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
cb1a09d0 900
a0d0e21e
LW
901
902 # make sure that func() keeps a bit a space tween the parens
903 ### s/\b\(\)/\\|()/g;
904 ### s/\b\(\)/(\\|)/g;
905
906 # make C++ into \*C+, which is a squinched version (defined above)
907 s/\bC\+\+/\\*(C+/g;
908
909 # make double underbars have a little tiny space between them
910 s/__/_\\|_/g;
911
cb1a09d0 912 # PI goes to \*(PI (defined above)
a0d0e21e
LW
913 s/\bPI\b/noremap('\\*(PI')/ge;
914
915 # make all caps a teeny bit smaller, but don't muck with embedded code literals
916 my $hidCFont = font('C');
917 if ($Cmd !~ /^head1/) { # SH already makes smaller
918 # /g isn't enough; 1 while or we'll be off
919
920# 1 while s{
921# (?!$hidCFont)(..|^.|^)
922# \b
923# (
924# [A-Z][\/A-Z+:\-\d_$.]+
925# )
926# (s?)
927# \b
928# } {$1\\s-1$2\\s0}gmox;
929
930 1 while s{
931 (?!$hidCFont)(..|^.|^)
932 (
933 \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
934 )
cb1a09d0 935 } {
a0d0e21e
LW
936 $1 . noremap( '\\s-1' . $2 . '\\s0' )
937 }egmox;
938
939 }
940}
941
942# make troff just be normal, but make small nroff get quoted
943# decided to just put the quotes in the text; sigh;
944sub ccvt {
945 local($_,$prev) = @_;
946 if ( /^\W+$/ && !/^\$./ ) {
947 ($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
948 # what about $" ?
949 } else {
950 noremap(qq{${CFont_embed}$_\\fR});
cb1a09d0 951 }
a0d0e21e 952 noremap(qq{.CQ "$_" \n\\&});
cb1a09d0 953}
a0d0e21e
LW
954
955sub makespace {
956 if ($indent) {
957 print ".Sp\n";
958 }
959 else {
960 print ".PP\n";
961 }
962}
963
cb1a09d0
AD
964sub mkindex {
965 my ($entry) = @_;
966 my @entries = split m:\s*/\s*:, $entry;
967 print ".IX Xref ";
968 for $entry (@entries) {
969 print qq("$entry" );
970 }
971 print "\n";
972 return '';
973}
974
a0d0e21e
LW
975sub font {
976 local($font) = shift;
977 return '\\f' . noremap($font);
cb1a09d0 978}
a0d0e21e
LW
979
980sub noremap {
981 local($thing_to_hide) = shift;
982 $thing_to_hide =~ tr/\000-\177/\200-\377/;
983 return $thing_to_hide;
cb1a09d0 984}
a0d0e21e
LW
985
986sub init_noremap {
3dd51965 987 # escape high bit characters in input stream
988 s/([\200-\377])/"E<".ord($1).">"/ge;
cb1a09d0 989}
a0d0e21e
LW
990
991sub clear_noremap {
992 my $ready_to_print = $_[0];
993
994 tr/\200-\377/\000-\177/;
995
996 # trofficate backslashes
997 # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
998
999 # now for the E<>s, which have been hidden until now
1000 # otherwise the interative \w<> processing would have
1001 # been hosed by the E<gt>
1002 s {
3dd51965 1003 E<
1004 (
1005 ( \d + )
1006 | ( [A-Za-z]+ )
1007 )
a0d0e21e 1008 >
cb1a09d0 1009 } {
3dd51965 1010 do {
1011 defined $2
1012 ? chr($2)
1013 :
1014 exists $HTML_Escapes{$3}
1015 ? do { $HTML_Escapes{$3} }
a0d0e21e 1016 : do {
f360dba1 1017 warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
a0d0e21e 1018 "E<$1>";
cb1a09d0
AD
1019 }
1020 }
a0d0e21e 1021 }egx if $ready_to_print;
cb1a09d0 1022}
a0d0e21e
LW
1023
1024sub internal_lrefs {
1025 local($_) = shift;
1026
1027 s{L</([^>]+)>}{$1}g;
1028 my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
1029 my $retstr = "the ";
1030 my $i;
1031 for ($i = 0; $i <= $#items; $i++) {
1032 $retstr .= "C<$items[$i]>";
1033 $retstr .= ", " if @items > 2 && $i != $#items;
1034 $retstr .= " and " if $i+2 == @items;
cb1a09d0 1035 }
a0d0e21e
LW
1036
1037 $retstr .= " entr" . ( @items > 1 ? "ies" : "y" )
e52f39a2 1038 . " elsewhere in this document "; # terminal space to avoid words running together (pattern used strips terminal spaces)
a0d0e21e
LW
1039
1040 return $retstr;
1041
cb1a09d0 1042}
a0d0e21e
LW
1043
1044BEGIN {
1045%HTML_Escapes = (
1046 'amp' => '&', # ampersand
1047 'lt' => '<', # left chevron, less-than
1048 'gt' => '>', # right chevron, greater-than
1049 'quot' => '"', # double quote
1050
1051 "Aacute" => "A\\*'", # capital A, acute accent
1052 "aacute" => "a\\*'", # small a, acute accent
1053 "Acirc" => "A\\*^", # capital A, circumflex accent
1054 "acirc" => "a\\*^", # small a, circumflex accent
1055 "AElig" => '\*(AE', # capital AE diphthong (ligature)
1056 "aelig" => '\*(ae', # small ae diphthong (ligature)
1057 "Agrave" => "A\\*`", # capital A, grave accent
1058 "agrave" => "A\\*`", # small a, grave accent
1059 "Aring" => 'A\\*o', # capital A, ring
1060 "aring" => 'a\\*o', # small a, ring
1061 "Atilde" => 'A\\*~', # capital A, tilde
1062 "atilde" => 'a\\*~', # small a, tilde
1063 "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark
1064 "auml" => 'a\\*:', # small a, dieresis or umlaut mark
1065 "Ccedil" => 'C\\*,', # capital C, cedilla
1066 "ccedil" => 'c\\*,', # small c, cedilla
1067 "Eacute" => "E\\*'", # capital E, acute accent
1068 "eacute" => "e\\*'", # small e, acute accent
1069 "Ecirc" => "E\\*^", # capital E, circumflex accent
1070 "ecirc" => "e\\*^", # small e, circumflex accent
1071 "Egrave" => "E\\*`", # capital E, grave accent
1072 "egrave" => "e\\*`", # small e, grave accent
1073 "ETH" => '\\*(D-', # capital Eth, Icelandic
1074 "eth" => '\\*(d-', # small eth, Icelandic
1075 "Euml" => "E\\*:", # capital E, dieresis or umlaut mark
1076 "euml" => "e\\*:", # small e, dieresis or umlaut mark
1077 "Iacute" => "I\\*'", # capital I, acute accent
1078 "iacute" => "i\\*'", # small i, acute accent
1079 "Icirc" => "I\\*^", # capital I, circumflex accent
1080 "icirc" => "i\\*^", # small i, circumflex accent
1081 "Igrave" => "I\\*`", # capital I, grave accent
1082 "igrave" => "i\\*`", # small i, grave accent
1083 "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark
1084 "iuml" => "i\\*:", # small i, dieresis or umlaut mark
1085 "Ntilde" => 'N\*~', # capital N, tilde
1086 "ntilde" => 'n\*~', # small n, tilde
1087 "Oacute" => "O\\*'", # capital O, acute accent
1088 "oacute" => "o\\*'", # small o, acute accent
1089 "Ocirc" => "O\\*^", # capital O, circumflex accent
1090 "ocirc" => "o\\*^", # small o, circumflex accent
1091 "Ograve" => "O\\*`", # capital O, grave accent
1092 "ograve" => "o\\*`", # small o, grave accent
1093 "Oslash" => "O\\*/", # capital O, slash
1094 "oslash" => "o\\*/", # small o, slash
1095 "Otilde" => "O\\*~", # capital O, tilde
1096 "otilde" => "o\\*~", # small o, tilde
1097 "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark
1098 "ouml" => "o\\*:", # small o, dieresis or umlaut mark
1099 "szlig" => '\*8', # small sharp s, German (sz ligature)
1100 "THORN" => '\\*(Th', # capital THORN, Icelandic
1101 "thorn" => '\\*(th',, # small thorn, Icelandic
1102 "Uacute" => "U\\*'", # capital U, acute accent
1103 "uacute" => "u\\*'", # small u, acute accent
1104 "Ucirc" => "U\\*^", # capital U, circumflex accent
1105 "ucirc" => "u\\*^", # small u, circumflex accent
1106 "Ugrave" => "U\\*`", # capital U, grave accent
1107 "ugrave" => "u\\*`", # small u, grave accent
1108 "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark
1109 "uuml" => "u\\*:", # small u, dieresis or umlaut mark
1110 "Yacute" => "Y\\*'", # capital Y, acute accent
1111 "yacute" => "y\\*'", # small y, acute accent
1112 "yuml" => "y\\*:", # small y, dieresis or umlaut mark
1113);
1114}
cb1a09d0 1115
5d94fbed 1116!NO!SUBS!
4633a7c4
LW
1117
1118close OUT or die "Can't close $file: $!";
1119chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1120exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';