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