| : #!/usr/bin/perl-5.005 |
| eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' |
| if $running_under_some_shell; |
| |
| $DEF_PM_SECTION = '3pm' || '3'; |
| |
| =head1 NAME |
| |
| pod2man - translate embedded Perl pod directives into man pages |
| |
| =head1 SYNOPSIS |
| |
| B<pod2man> |
| [ B<--section=>I<manext> ] |
| [ B<--release=>I<relpatch> ] |
| [ B<--center=>I<string> ] |
| [ B<--date=>I<string> ] |
| [ B<--fixed=>I<font> ] |
| [ B<--official> ] |
| [ B<--lax> ] |
| I<inputfile> |
| |
| =head1 DESCRIPTION |
| |
| B<pod2man> converts its input file containing embedded pod directives (see |
| L<perlpod>) into nroff source suitable for viewing with nroff(1) or |
| troff(1) using the man(7) macro set. |
| |
| Besides the obvious pod conversions, B<pod2man> also takes care of |
| func(), func(n), and simple variable references like $foo or @bar so |
| you don't have to use code escapes for them; complex expressions like |
| C<$fred{'stuff'}> will still need to be escaped, though. Other nagging |
| little roffish things that it catches include translating the minus in |
| something like foo-bar, making a long dash--like this--into a real em |
| dash, fixing up "paired quotes", putting a little space after the |
| parens in something like func(), making C++ and PI look right, making |
| double underbars have a little tiny space between them, making ALLCAPS |
| a teeny bit smaller in troff(1), and escaping backslashes so you don't |
| have to. |
| |
| =head1 OPTIONS |
| |
| =over 8 |
| |
| =item center |
| |
| Set the centered header to a specific string. The default is |
| "User Contributed Perl Documentation", unless the C<--official> flag is |
| given, in which case the default is "Perl Programmers Reference Guide". |
| |
| =item date |
| |
| Set the left-hand footer string to this value. By default, |
| the modification date of the input file will be used. |
| |
| =item fixed |
| |
| The fixed font to use for code refs. Defaults to CW. |
| |
| =item official |
| |
| Set the default header to indicate that this page is of |
| the standard release in case C<--center> is not given. |
| |
| =item release |
| |
| Set the centered footer. By default, this is the current |
| perl release. |
| |
| =item section |
| |
| Set the section for the C<.TH> macro. The standard conventions on |
| sections are to use 1 for user commands, 2 for system calls, 3 for |
| functions, 4 for devices, 5 for file formats, 6 for games, 7 for |
| miscellaneous information, and 8 for administrator commands. This works |
| best if you put your Perl man pages in a separate tree, like |
| F</usr/local/perl/man/>. By default, section 1 will be used |
| unless the file ends in F<.pm> in which case section 3 will be selected. |
| |
| =item lax |
| |
| Don't complain when required sections aren't present. |
| |
| =back |
| |
| =head1 Anatomy of a Proper Man Page |
| |
| For those not sure of the proper layout of a man page, here's |
| an example of the skeleton of a proper man page. Head of the |
| major headers should be setout as a C<=head1> directive, and |
| are historically written in the rather startling ALL UPPER CASE |
| format, although this is not mandatory. |
| Minor headers may be included using C<=head2>, and are |
| typically in mixed case. |
| |
| =over 10 |
| |
| =item NAME |
| |
| Mandatory section; should be a comma-separated list of programs or |
| functions documented by this podpage, such as: |
| |
| foo, bar - programs to do something |
| |
| =item SYNOPSIS |
| |
| A short usage summary for programs and functions, which |
| may someday be deemed mandatory. |
| |
| =item DESCRIPTION |
| |
| Long drawn out discussion of the program. It's a good idea to break this |
| up into subsections using the C<=head2> directives, like |
| |
| =head2 A Sample Subection |
| |
| =head2 Yet Another Sample Subection |
| |
| =item OPTIONS |
| |
| Some people make this separate from the description. |
| |
| =item RETURN VALUE |
| |
| What the program or function returns if successful. |
| |
| =item ERRORS |
| |
| Exceptions, return codes, exit stati, and errno settings. |
| |
| =item EXAMPLES |
| |
| Give some example uses of the program. |
| |
| =item ENVIRONMENT |
| |
| Envariables this program might care about. |
| |
| =item FILES |
| |
| All files used by the program. You should probably use the FE<lt>E<gt> |
| for these. |
| |
| =item SEE ALSO |
| |
| Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8). |
| |
| =item NOTES |
| |
| Miscellaneous commentary. |
| |
| =item CAVEATS |
| |
| Things to take special care with; sometimes called WARNINGS. |
| |
| =item DIAGNOSTICS |
| |
| All possible messages the program can print out--and |
| what they mean. |
| |
| =item BUGS |
| |
| Things that are broken or just don't work quite right. |
| |
| =item RESTRICTIONS |
| |
| Bugs you don't plan to fix :-) |
| |
| =item AUTHOR |
| |
| Who wrote it (or AUTHORS if multiple). |
| |
| =item HISTORY |
| |
| Programs derived from other sources sometimes have this, or |
| you might keep a modification log here. |
| |
| =back |
| |
| =head1 EXAMPLES |
| |
| pod2man program > program.1 |
| pod2man some_module.pm > /usr/perl/man/man3/some_module.3 |
| pod2man --section=7 note.pod > note.7 |
| |
| =head1 DIAGNOSTICS |
| |
| The following diagnostics are generated by B<pod2man>. Items |
| marked "(W)" are non-fatal, whereas the "(F)" errors will cause |
| B<pod2man> to immediately exit with a non-zero status. |
| |
| =over 4 |
| |
| =item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s> |
| |
| (W) If you start include an option, you should set it off |
| as bold, italic, or code. |
| |
| =item can't open %s: %s |
| |
| (F) The input file wasn't available for the given reason. |
| |
| =item Improper man page - no dash in NAME header in paragraph %d of %s |
| |
| (W) The NAME header did not have an isolated dash in it. This is |
| considered important. |
| |
| =item Invalid man page - no NAME line in %s |
| |
| (F) You did not include a NAME header, which is essential. |
| |
| =item roff font should be 1 or 2 chars, not `%s' (F) |
| |
| (F) The font specified with the C<--fixed> option was not |
| a one- or two-digit roff font. |
| |
| =item %s is missing required section: %s |
| |
| (W) Required sections include NAME, DESCRIPTION, and if you're |
| using a section starting with a 3, also a SYNOPSIS. Actually, |
| not having a NAME is a fatal. |
| |
| =item Unknown escape: %s in %s |
| |
| (W) An unknown HTML entity (probably for an 8-bit character) was given via |
| a C<EE<lt>E<gt>> directive. Besides amp, lt, gt, and quot, recognized |
| entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave, |
| Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute, |
| Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc, |
| icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc, |
| ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig, |
| THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml, |
| Yacute, yacute, and yuml. |
| |
| =item Unmatched =back |
| |
| (W) You have a C<=back> without a corresponding C<=over>. |
| |
| =item Unrecognized pod directive: %s |
| |
| (W) You specified a pod directive that isn't in the known list of |
| C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>. |
| |
| |
| =back |
| |
| =head1 NOTES |
| |
| If you would like to print out a lot of man page continuously, you |
| probably want to set the C and D registers to set contiguous page |
| numbering and even/odd paging, at least on some versions of man(7). |
| Settting the F register will get you some additional experimental |
| indexing: |
| |
| troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ... |
| |
| The indexing merely outputs messages via C<.tm> for each |
| major page, section, subsection, item, and any C<XE<lt>E<gt>> |
| directives. |
| |
| |
| =head1 RESTRICTIONS |
| |
| None at this time. |
| |
| =head1 BUGS |
| |
| The =over and =back directives don't really work right. They |
| take absolute positions instead of offsets, don't nest well, and |
| making people count is suboptimal in any event. |
| |
| =head1 AUTHORS |
| |
| Original prototype by Larry Wall, but so massively hacked over by |
| Tom Christiansen such that Larry probably doesn't recognize it anymore. |
| |
| =cut |
| |
| $/ = ""; |
| $cutting = 1; |
| @Indices = (); |
| |
| # We try first to get the version number from a local binary, in case we're |
| # running an installed version of Perl to produce documentation from an |
| # uninstalled newer version's pod files. |
| if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') { |
| my $perl = (-x './perl' && -f './perl' ) ? |
| './perl' : |
| ((-x '../perl' && -f '../perl') ? |
| '../perl' : |
| ''); |
| ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl; |
| } |
| # No luck; we'll just go with the running Perl's version |
| ($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version; |
| $DEF_RELEASE = "perl $version"; |
| $DEF_RELEASE .= ", patch $patch" if $patch; |
| |
| |
| sub makedate { |
| my $secs = shift; |
| my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs); |
| my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon]; |
| $year += 1900; |
| return "$mday/$mname/$year"; |
| } |
| |
| use Getopt::Long; |
| |
| $DEF_SECTION = 1; |
| $DEF_CENTER = "User Contributed Perl Documentation"; |
| $STD_CENTER = "Perl Programmers Reference Guide"; |
| $DEF_FIXED = 'CW'; |
| $DEF_LAX = 0; |
| |
| sub usage { |
| warn "$0: @_\n" if @_; |
| die <<EOF; |
| usage: $0 [options] podpage |
| Options are: |
| --section=manext (default "$DEF_SECTION") |
| --release=relpatch (default "$DEF_RELEASE") |
| --center=string (default "$DEF_CENTER") |
| --date=string (default "$DEF_DATE") |
| --fixed=font (default "$DEF_FIXED") |
| --official (default NOT) |
| --lax (default NOT) |
| EOF |
| } |
| |
| $uok = GetOptions( qw( |
| section=s |
| release=s |
| center=s |
| date=s |
| fixed=s |
| official |
| lax |
| help)); |
| |
| $DEF_DATE = makedate((stat($ARGV[0]))[9] || time()); |
| |
| usage("Usage error!") unless $uok; |
| usage() if $opt_help; |
| usage("Need one and only one podpage argument") unless @ARGV == 1; |
| |
| $section = $opt_section || ($ARGV[0] =~ /\.pm$/ |
| ? $DEF_PM_SECTION : $DEF_SECTION); |
| $RP = $opt_release || $DEF_RELEASE; |
| $center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER); |
| $lax = $opt_lax || $DEF_LAX; |
| |
| $CFont = $opt_fixed || $DEF_FIXED; |
| |
| if (length($CFont) == 2) { |
| $CFont_embed = "\\f($CFont"; |
| } |
| elsif (length($CFont) == 1) { |
| $CFont_embed = "\\f$CFont"; |
| } |
| else { |
| die "roff font should be 1 or 2 chars, not `$CFont_embed'"; |
| } |
| |
| $date = $opt_date || $DEF_DATE; |
| |
| for (qw{NAME DESCRIPTION}) { |
| # for (qw{NAME DESCRIPTION AUTHOR}) { |
| $wanna_see{$_}++; |
| } |
| $wanna_see{SYNOPSIS}++ if $section =~ /^3/; |
| |
| |
| $name = @ARGV ? $ARGV[0] : "<STDIN>"; |
| $Filename = $name; |
| if ($section =~ /^1/) { |
| require File::Basename; |
| $name = uc File::Basename::basename($name); |
| } |
| $name =~ s/\.(pod|p[lm])$//i; |
| |
| # Lose everything up to the first of |
| # */lib/*perl* standard or site_perl module |
| # */*perl*/lib from -D prefix=/opt/perl |
| # */*perl*/ random module hierarchy |
| # which works. |
| $name =~ s-//+-/-g; |
| if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i |
| or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i |
| or $name =~ s-^.*?/[^/]*perl[^/]*/--i) { |
| # Lose ^site(_perl)?/. |
| $name =~ s-^site(_perl)?/--; |
| # Lose ^arch/. (XXX should we use Config? Just for archname?) |
| $name =~ s~^(.*-$^O|$^O-.*)/~~o; |
| # Lose ^version/. |
| $name =~ s-^\d+\.\d+/--; |
| } |
| |
| # Translate Getopt/Long to Getopt::Long, etc. |
| $name =~ s(/)(::)g; |
| |
| if ($name ne 'something') { |
| FCHECK: { |
| open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!"; |
| while (<F>) { |
| next unless /^=\b/; |
| if (/^=head1\s+NAME\s*$/) { # an /m would forgive mistakes |
| $_ = <F>; |
| unless (/\s*-+\s+/) { |
| $oops++; |
| warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n" |
| } else { |
| my @n = split /\s+-+\s+/; |
| if (@n != 2) { |
| $oops++; |
| warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n" |
| } |
| else { |
| $n[0] =~ s/\n/ /g; |
| $n[1] =~ s/\n/ /g; |
| %namedesc = @n; |
| } |
| } |
| last FCHECK; |
| } |
| next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME |
| next if /^=pod\b/; # It is OK to have =pod before NAME |
| next if /^=(for|begin|end)\s+comment\b/; # It is OK to have =for =begin or =end comment before NAME |
| die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax; |
| } |
| die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax; |
| } |
| close F; |
| } |
| |
| print <<"END"; |
| .rn '' }` |
| ''' \$RCSfile\$\$Revision\$\$Date\$ |
| ''' |
| ''' \$Log\$ |
| ''' |
| .de Sh |
| .br |
| .if t .Sp |
| .ne 5 |
| .PP |
| \\fB\\\\\$1\\fR |
| .PP |
| .. |
| .de Sp |
| .if t .sp .5v |
| .if n .sp |
| .. |
| .de Ip |
| .br |
| .ie \\\\n(.\$>=3 .ne \\\\\$3 |
| .el .ne 3 |
| .IP "\\\\\$1" \\\\\$2 |
| .. |
| .de Vb |
| .ft $CFont |
| .nf |
| .ne \\\\\$1 |
| .. |
| .de Ve |
| .ft R |
| |
| .fi |
| .. |
| ''' |
| ''' |
| ''' Set up \\*(-- to give an unbreakable dash; |
| ''' string Tr holds user defined translation string. |
| ''' Bell System Logo is used as a dummy character. |
| ''' |
| .tr \\(*W-|\\(bv\\*(Tr |
| .ie n \\{\\ |
| .ds -- \\(*W- |
| .ds PI pi |
| .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch |
| .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch |
| .ds L" "" |
| .ds R" "" |
| ''' \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of |
| ''' \\*(L" and \\*(R", except that they are used on ".xx" lines, |
| ''' such as .IP and .SH, which do another additional levels of |
| ''' double-quote interpretation |
| .ds M" """ |
| .ds S" """ |
| .ds N" """"" |
| .ds T" """"" |
| .ds L' ' |
| .ds R' ' |
| .ds M' ' |
| .ds S' ' |
| .ds N' ' |
| .ds T' ' |
| 'br\\} |
| .el\\{\\ |
| .ds -- \\(em\\| |
| .tr \\*(Tr |
| .ds L" `` |
| .ds R" '' |
| .ds M" `` |
| .ds S" '' |
| .ds N" `` |
| .ds T" '' |
| .ds L' ` |
| .ds R' ' |
| .ds M' ` |
| .ds S' ' |
| .ds N' ` |
| .ds T' ' |
| .ds PI \\(*p |
| 'br\\} |
| END |
| |
| print <<'END'; |
| .\" If the F register is turned on, we'll generate |
| .\" index entries out stderr for the following things: |
| .\" TH Title |
| .\" SH Header |
| .\" Sh Subsection |
| .\" Ip Item |
| .\" X<> Xref (embedded |
| .\" Of course, you have to process the output yourself |
| .\" in some meaninful fashion. |
| .if \nF \{ |
| .de IX |
| .tm Index:\\$1\t\\n%\t"\\$2" |
| .. |
| .nr % 0 |
| .rr F |
| .\} |
| END |
| |
| print <<"END"; |
| .TH $name $section "$RP" "$date" "$center" |
| .UC |
| END |
| |
| push(@Indices, qq{.IX Title "$name $section"}); |
| |
| while (($name, $desc) = each %namedesc) { |
| for ($name, $desc) { s/^\s+//; s/\s+$//; } |
| push(@Indices, qq(.IX Name "$name - $desc"\n)); |
| } |
| |
| print <<'END'; |
| .if n .hy 0 |
| .if n .na |
| .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' |
| .de CQ \" put $1 in typewriter font |
| END |
| print ".ft $CFont\n"; |
| print <<'END'; |
| 'if n "\c |
| 'if t \\&\\$1\c |
| 'if n \\&\\$1\c |
| 'if n \&" |
| \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7 |
| '.ft R |
| .. |
| .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2 |
| . \" AM - accent mark definitions |
| .bd B 3 |
| . \" fudge factors for nroff and troff |
| .if n \{\ |
| . ds #H 0 |
| . ds #V .8m |
| . ds #F .3m |
| . ds #[ \f1 |
| . ds #] \fP |
| .\} |
| .if t \{\ |
| . ds #H ((1u-(\\\\n(.fu%2u))*.13m) |
| . ds #V .6m |
| . ds #F 0 |
| . ds #[ \& |
| . ds #] \& |
| .\} |
| . \" simple accents for nroff and troff |
| .if n \{\ |
| . ds ' \& |
| . ds ` \& |
| . ds ^ \& |
| . ds , \& |
| . ds ~ ~ |
| . ds ? ? |
| . ds ! ! |
| . ds / |
| . ds q |
| .\} |
| .if t \{\ |
| . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" |
| . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' |
| . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' |
| . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' |
| . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' |
| . ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10' |
| . ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m' |
| . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' |
| . 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' |
| .\} |
| . \" troff and (daisy-wheel) nroff accents |
| .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' |
| .ds 8 \h'\*(#H'\(*b\h'-\*(#H' |
| .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#] |
| .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u' |
| .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u' |
| .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#] |
| .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] |
| .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' |
| .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' |
| .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] |
| .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] |
| .ds ae a\h'-(\w'a'u*4/10)'e |
| .ds Ae A\h'-(\w'A'u*4/10)'E |
| .ds oe o\h'-(\w'o'u*4/10)'e |
| .ds Oe O\h'-(\w'O'u*4/10)'E |
| . \" corrections for vroff |
| .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' |
| .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' |
| . \" for low resolution devices (crt and lpr) |
| .if \n(.H>23 .if \n(.V>19 \ |
| \{\ |
| . ds : e |
| . ds 8 ss |
| . ds v \h'-1'\o'\(aa\(ga' |
| . ds _ \h'-1'^ |
| . ds . \h'-1'. |
| . ds 3 3 |
| . ds o a |
| . ds d- d\h'-1'\(ga |
| . ds D- D\h'-1'\(hy |
| . ds th \o'bp' |
| . ds Th \o'LP' |
| . ds ae ae |
| . ds Ae AE |
| . ds oe oe |
| . ds Oe OE |
| .\} |
| .rm #[ #] #H #V #F C |
| END |
| |
| $indent = 0; |
| |
| $begun = ""; |
| |
| # Unrolling [^A-Z>]|[A-Z](?!<) gives: // MRE pp 165. |
| my $nonest = '(?:[^A-Z>]*(?:[A-Z](?!<)[^A-Z>]*)*)'; |
| |
| while (<>) { |
| if ($cutting) { |
| next unless /^=/; |
| $cutting = 0; |
| } |
| if ($begun) { |
| if (/^=end\s+$begun/) { |
| $begun = ""; |
| } |
| elsif ($begun =~ /^(roff|man)$/) { |
| print STDOUT $_; |
| } |
| next; |
| } |
| chomp; |
| |
| # Translate verbatim paragraph |
| |
| if (/^\s/) { |
| @lines = split(/\n/); |
| for (@lines) { |
| 1 while s |
| {^( [^\t]* ) \t ( \t* ) } |
| { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex; |
| s/\\/\\e/g; |
| s/\A/\\&/s; |
| } |
| $lines = @lines; |
| makespace() unless $verbatim++; |
| print ".Vb $lines\n"; |
| print join("\n", @lines), "\n"; |
| print ".Ve\n"; |
| $needspace = 0; |
| next; |
| } |
| |
| $verbatim = 0; |
| |
| if (/^=for\s+(\S+)\s*/s) { |
| if ($1 eq "man" or $1 eq "roff") { |
| print STDOUT $',"\n\n"; |
| } else { |
| # ignore unknown for |
| } |
| next; |
| } |
| elsif (/^=begin\s+(\S+)\s*/s) { |
| $begun = $1; |
| if ($1 eq "man" or $1 eq "roff") { |
| print STDOUT $'."\n\n"; |
| } |
| next; |
| } |
| |
| # check for things that'll hosed our noremap scheme; affects $_ |
| init_noremap(); |
| |
| if (!/^=item/) { |
| |
| # trofficate backslashes; must do it before what happens below |
| s/\\/noremap('\\e')/ge; |
| |
| # protect leading periods and quotes against *roff |
| # mistaking them for directives |
| s/^(?:[A-Z]<)?[.']/\\&$&/gm; |
| |
| # first hide the escapes in case we need to |
| # intuit something and get it wrong due to fmting |
| |
| 1 while s/([A-Z]<$nonest>)/noremap($1)/ge; |
| |
| # func() is a reference to a perl function |
| s{ |
| \b |
| ( |
| [:\w]+ \(\) |
| ) |
| } {I<$1>}gx; |
| |
| # func(n) is a reference to a perl function or a man page |
| s{ |
| ([:\w]+) |
| ( |
| \( [^\051]+ \) |
| ) |
| } {I<$1>\\|$2}gx; |
| |
| # convert simple variable references |
| s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g; |
| |
| if (m{ ( |
| [\-\w]+ |
| \( |
| [^\051]*? |
| [\@\$,] |
| [^\051]*? |
| \) |
| ) |
| }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/) |
| { |
| warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n"; |
| $oops++; |
| } |
| |
| while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) { |
| warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n"; |
| $oops++; |
| } |
| |
| # put it back so we get the <> processed again; |
| clear_noremap(0); # 0 means leave the E's |
| |
| } else { |
| # trofficate backslashes |
| s/\\/noremap('\\e')/ge; |
| |
| } |
| |
| # need to hide E<> first; they're processed in clear_noremap |
| s/(E<[^<>]+>)/noremap($1)/ge; |
| |
| |
| $maxnest = 10; |
| while ($maxnest-- && /[A-Z]</) { |
| |
| # can't do C font here |
| s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg; |
| |
| # files and filelike refs in italics |
| s/F<($nonest)>/I<$1>/g; |
| |
| # no break -- usually we want C<> for this |
| s/S<($nonest)>/nobreak($1)/eg; |
| |
| # LREF: a la HREF L<show this text|man/section> |
| s:L<([^|>]+)\|[^>]+>:$1:g; |
| |
| # LREF: a manpage(3f) |
| s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g; |
| |
| # LREF: an =item on another manpage |
| s{ |
| L< |
| ([^/]+) |
| / |
| ( |
| [:\w]+ |
| (\(\))? |
| ) |
| > |
| } {the C<$2> entry in the I<$1> manpage}gx; |
| |
| # LREF: an =item on this manpage |
| s{ |
| ((?: |
| L< |
| / |
| ( |
| [:\w]+ |
| (\(\))? |
| ) |
| > |
| (,?\s+(and\s+)?)? |
| )+) |
| } { internal_lrefs($1) }gex; |
| |
| # LREF: a =head2 (head1?), maybe on a manpage, maybe right here |
| # the "func" can disambiguate |
| s{ |
| L< |
| (?: |
| ([a-zA-Z]\S+?) / |
| )? |
| "?(.*?)"? |
| > |
| }{ |
| do { |
| $1 # if no $1, assume it means on this page. |
| ? "the section on I<$2> in the I<$1> manpage" |
| : "the section on I<$2>" |
| } |
| }gesx; # s in case it goes over multiple lines, so . matches \n |
| |
| s/Z<>/\\&/g; |
| |
| # comes last because not subject to reprocessing |
| s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg; |
| } |
| |
| if (s/^=//) { |
| $needspace = 0; # Assume this. |
| |
| s/\n/ /g; |
| |
| ($Cmd, $_) = split(' ', $_, 2); |
| |
| $dotlevel = 1; |
| if ($Cmd eq 'head1') { |
| $dotlevel = 1; |
| } |
| elsif ($Cmd eq 'head2') { |
| $dotlevel = 1; |
| } |
| elsif ($Cmd eq 'item') { |
| $dotlevel = 2; |
| } |
| |
| if (defined $_) { |
| &escapes($dotlevel); |
| s/"/""/g; |
| } |
| |
| clear_noremap(1); |
| |
| if ($Cmd eq 'cut') { |
| $cutting = 1; |
| } |
| elsif ($Cmd eq 'head1') { |
| s/\s+$//; |
| delete $wanna_see{$_} if exists $wanna_see{$_}; |
| print qq{.SH "$_"\n}; |
| push(@Indices, qq{.IX Header "$_"\n}); |
| } |
| elsif ($Cmd eq 'head2') { |
| print qq{.Sh "$_"\n}; |
| push(@Indices, qq{.IX Subsection "$_"\n}); |
| } |
| elsif ($Cmd eq 'over') { |
| push(@indent,$indent); |
| $indent += ($_ + 0) || 5; |
| } |
| elsif ($Cmd eq 'back') { |
| $indent = pop(@indent); |
| warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent; |
| $needspace = 1; |
| } |
| elsif ($Cmd eq 'item') { |
| s/^\*( |$)/\\(bu$1/g; |
| # if you know how to get ":s please do |
| s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g; |
| s/\\\*\(L"([^"]+?)""/'$1'/g; |
| s/[^"]""([^"]+?)""[^"]/'$1'/g; |
| # here do something about the $" in perlvar? |
| print STDOUT qq{.Ip "$_" $indent\n}; |
| push(@Indices, qq{.IX Item "$_"\n}); |
| } |
| elsif ($Cmd eq 'pod') { |
| # this is just a comment |
| } |
| else { |
| warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n"; |
| } |
| } |
| else { |
| if ($needspace) { |
| &makespace; |
| } |
| &escapes(0); |
| clear_noremap(1); |
| print $_, "\n"; |
| $needspace = 1; |
| } |
| } |
| |
| print <<"END"; |
| |
| .rn }` '' |
| END |
| |
| if (%wanna_see && !$lax) { |
| @missing = keys %wanna_see; |
| warn "$0: $Filename is missing required section" |
| . (@missing > 1 && "s") |
| . ": @missing\n"; |
| $oops++; |
| } |
| |
| foreach (@Indices) { print "$_\n"; } |
| |
| exit; |
| #exit ($oops != 0); |
| |
| ######################################################################### |
| |
| sub nobreak { |
| my $string = shift; |
| $string =~ s/ /\\ /g; |
| $string; |
| } |
| |
| sub escapes { |
| my $indot = shift; |
| |
| s/X<(.*?)>/mkindex($1)/ge; |
| |
| # translate the minus in foo-bar into foo\-bar for roff |
| s/([^0-9a-z-])-([^-])/$1\\-$2/g; |
| |
| # make -- into the string version \*(-- (defined above) |
| s/\b--\b/\\*(--/g; |
| s/"--([^"])/"\\*(--$1/g; # should be a better way |
| s/([^"])--"/$1\\*(--"/g; |
| |
| # fix up quotes; this is somewhat tricky |
| my $dotmacroL = 'L'; |
| my $dotmacroR = 'R'; |
| if ( $indot == 1 ) { |
| $dotmacroL = 'M'; |
| $dotmacroR = 'S'; |
| } |
| elsif ( $indot >= 2 ) { |
| $dotmacroL = 'N'; |
| $dotmacroR = 'T'; |
| } |
| if (!/""/) { |
| s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge; |
| s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge; |
| } |
| |
| #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g; |
| #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g; |
| |
| |
| # make sure that func() keeps a bit a space tween the parens |
| ### s/\b\(\)/\\|()/g; |
| ### s/\b\(\)/(\\|)/g; |
| |
| # make C++ into \*C+, which is a squinched version (defined above) |
| s/\bC\+\+/\\*(C+/g; |
| |
| # make double underbars have a little tiny space between them |
| s/__/_\\|_/g; |
| |
| # PI goes to \*(PI (defined above) |
| s/\bPI\b/noremap('\\*(PI')/ge; |
| |
| # make all caps a teeny bit smaller, but don't muck with embedded code literals |
| my $hidCFont = font('C'); |
| if ($Cmd !~ /^head1/) { # SH already makes smaller |
| # /g isn't enough; 1 while or we'll be off |
| |
| # 1 while s{ |
| # (?!$hidCFont)(..|^.|^) |
| # \b |
| # ( |
| # [A-Z][\/A-Z+:\-\d_$.]+ |
| # ) |
| # (s?) |
| # \b |
| # } {$1\\s-1$2\\s0}gmox; |
| |
| 1 while s{ |
| (?!$hidCFont)(..|^.|^) |
| ( |
| \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b |
| ) |
| } { |
| $1 . noremap( '\\s-1' . $2 . '\\s0' ) |
| }egmox; |
| |
| } |
| } |
| |
| # make troff just be normal, but make small nroff get quoted |
| # decided to just put the quotes in the text; sigh; |
| sub ccvt { |
| local($_,$prev) = @_; |
| noremap(qq{.CQ "$_" \n\\&}); |
| } |
| |
| sub makespace { |
| if ($indent) { |
| print ".Sp\n"; |
| } |
| else { |
| print ".PP\n"; |
| } |
| } |
| |
| sub mkindex { |
| my ($entry) = @_; |
| my @entries = split m:\s*/\s*:, $entry; |
| push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries; |
| return ''; |
| } |
| |
| sub font { |
| local($font) = shift; |
| return '\\f' . noremap($font); |
| } |
| |
| sub noremap { |
| local($thing_to_hide) = shift; |
| $thing_to_hide =~ tr/\000-\177/\200-\377/; |
| return $thing_to_hide; |
| } |
| |
| sub init_noremap { |
| # escape high bit characters in input stream |
| s/([\200-\377])/"E<".ord($1).">"/ge; |
| } |
| |
| sub clear_noremap { |
| my $ready_to_print = $_[0]; |
| |
| tr/\200-\377/\000-\177/; |
| |
| # trofficate backslashes |
| # s/(?!\\e)(?:..|^.|^)\\/\\e/g; |
| |
| # now for the E<>s, which have been hidden until now |
| # otherwise the interative \w<> processing would have |
| # been hosed by the E<gt> |
| s { |
| E< |
| ( |
| ( \d + ) |
| | ( [A-Za-z]+ ) |
| ) |
| > |
| } { |
| do { |
| defined $2 |
| ? chr($2) |
| : |
| exists $HTML_Escapes{$3} |
| ? do { $HTML_Escapes{$3} } |
| : do { |
| warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n"; |
| "E<$1>"; |
| } |
| } |
| }egx if $ready_to_print; |
| } |
| |
| sub internal_lrefs { |
| local($_) = shift; |
| local $trailing_and = s/and\s+$// ? "and " : ""; |
| |
| s{L</([^>]+)>}{$1}g; |
| my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); |
| my $retstr = "the "; |
| my $i; |
| for ($i = 0; $i <= $#items; $i++) { |
| $retstr .= "C<$items[$i]>"; |
| $retstr .= ", " if @items > 2 && $i != $#items; |
| $retstr .= " and " if $i+2 == @items; |
| } |
| |
| $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) |
| . " elsewhere in this document"; |
| # terminal space to avoid words running together (pattern used |
| # strips terminal spaces) |
| $retstr .= " " if length $trailing_and; |
| $retstr .= $trailing_and; |
| |
| return $retstr; |
| |
| } |
| |
| BEGIN { |
| %HTML_Escapes = ( |
| 'amp' => '&', # ampersand |
| 'lt' => '<', # left chevron, less-than |
| 'gt' => '>', # right chevron, greater-than |
| 'quot' => '"', # double quote |
| |
| "Aacute" => "A\\*'", # capital A, acute accent |
| "aacute" => "a\\*'", # small a, acute accent |
| "Acirc" => "A\\*^", # capital A, circumflex accent |
| "acirc" => "a\\*^", # small a, circumflex accent |
| "AElig" => '\*(AE', # capital AE diphthong (ligature) |
| "aelig" => '\*(ae', # small ae diphthong (ligature) |
| "Agrave" => "A\\*`", # capital A, grave accent |
| "agrave" => "A\\*`", # small a, grave accent |
| "Aring" => 'A\\*o', # capital A, ring |
| "aring" => 'a\\*o', # small a, ring |
| "Atilde" => 'A\\*~', # capital A, tilde |
| "atilde" => 'a\\*~', # small a, tilde |
| "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark |
| "auml" => 'a\\*:', # small a, dieresis or umlaut mark |
| "Ccedil" => 'C\\*,', # capital C, cedilla |
| "ccedil" => 'c\\*,', # small c, cedilla |
| "Eacute" => "E\\*'", # capital E, acute accent |
| "eacute" => "e\\*'", # small e, acute accent |
| "Ecirc" => "E\\*^", # capital E, circumflex accent |
| "ecirc" => "e\\*^", # small e, circumflex accent |
| "Egrave" => "E\\*`", # capital E, grave accent |
| "egrave" => "e\\*`", # small e, grave accent |
| "ETH" => '\\*(D-', # capital Eth, Icelandic |
| "eth" => '\\*(d-', # small eth, Icelandic |
| "Euml" => "E\\*:", # capital E, dieresis or umlaut mark |
| "euml" => "e\\*:", # small e, dieresis or umlaut mark |
| "Iacute" => "I\\*'", # capital I, acute accent |
| "iacute" => "i\\*'", # small i, acute accent |
| "Icirc" => "I\\*^", # capital I, circumflex accent |
| "icirc" => "i\\*^", # small i, circumflex accent |
| "Igrave" => "I\\*`", # capital I, grave accent |
| "igrave" => "i\\*`", # small i, grave accent |
| "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark |
| "iuml" => "i\\*:", # small i, dieresis or umlaut mark |
| "Ntilde" => 'N\*~', # capital N, tilde |
| "ntilde" => 'n\*~', # small n, tilde |
| "Oacute" => "O\\*'", # capital O, acute accent |
| "oacute" => "o\\*'", # small o, acute accent |
| "Ocirc" => "O\\*^", # capital O, circumflex accent |
| "ocirc" => "o\\*^", # small o, circumflex accent |
| "Ograve" => "O\\*`", # capital O, grave accent |
| "ograve" => "o\\*`", # small o, grave accent |
| "Oslash" => "O\\*/", # capital O, slash |
| "oslash" => "o\\*/", # small o, slash |
| "Otilde" => "O\\*~", # capital O, tilde |
| "otilde" => "o\\*~", # small o, tilde |
| "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark |
| "ouml" => "o\\*:", # small o, dieresis or umlaut mark |
| "szlig" => '\*8', # small sharp s, German (sz ligature) |
| "THORN" => '\\*(Th', # capital THORN, Icelandic |
| "thorn" => '\\*(th',, # small thorn, Icelandic |
| "Uacute" => "U\\*'", # capital U, acute accent |
| "uacute" => "u\\*'", # small u, acute accent |
| "Ucirc" => "U\\*^", # capital U, circumflex accent |
| "ucirc" => "u\\*^", # small u, circumflex accent |
| "Ugrave" => "U\\*`", # capital U, grave accent |
| "ugrave" => "u\\*`", # small u, grave accent |
| "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark |
| "uuml" => "u\\*:", # small u, dieresis or umlaut mark |
| "Yacute" => "Y\\*'", # capital Y, acute accent |
| "yacute" => "y\\*'", # small y, acute accent |
| "yuml" => "y\\*:", # small y, dieresis or umlaut mark |
| ); |
| } |
| |