X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pod%2Fpod2man.PL;h=7494c2659522a7cfbb288ba38af125f40cbb7a16;hb=04251ce85fbe7037c3a7ca309ab31a0207c941b3;hp=79e3edd1a19077831283044edb744fd6e00b92fe;hpb=5b4ebf24ca11cf22be52bfe38f5f55eb66d9405f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pod/pod2man.PL b/pod/pod2man.PL index 79e3edd..7494c26 100644 --- a/pod/pod2man.PL +++ b/pod/pod2man.PL @@ -2,6 +2,7 @@ use Config; use File::Basename qw(&basename &dirname); +use Cwd; # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -13,6 +14,7 @@ use File::Basename qw(&basename &dirname); # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; chdir dirname($0); $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; @@ -310,13 +312,18 @@ Tom Christiansen such that Larry probably doesn't recognize it anymore. $/ = ""; $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') { - ($version,$patch) = - `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/; +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; @@ -328,6 +335,7 @@ 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"; } @@ -414,8 +422,12 @@ $name =~ s-//+-/-g; if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i or $name =~ s-^.*?/[^/]*perl[^/]*/--i) { - # Lose ^arch/version/. - $name =~ s-^[^/]+/\d+\.\d+/--; + # 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. @@ -555,13 +567,14 @@ END print <<"END"; .TH $name $section "$RP" "$date" "$center" -.IX Title "$name $section" .UC END +push(@Indices, qq{.IX Title "$name $section"}); + while (($name, $desc) = each %namedesc) { for ($name, $desc) { s/^\s+//; s/\s+$//; } - print qq(.IX Name "$name - $desc"\n); + push(@Indices, qq(.IX Name "$name - $desc"\n)); } print <<'END'; @@ -665,6 +678,25 @@ $indent = 0; $begun = ""; +# Unrolling [^-=A-Z>]|[A-Z](?!<)|[-=](?![A-Z]<)[\x00-\xFF] gives: // MRE pp 165. +my $nonest = q{(?x) # Turn on /x mode. + (?: # Group + [^-=A-Z>]* # Anything that isn't a dash, equal sign or + # closing hook isn't special. Eat as much as + # we can. + (?: # Group. + (?: # Group. + [-=] # We want to recognize -> and =>. + (?![A-Z]<) # So, as long as it isn't followed by markup + [\x00-\xFF] # anything may follow - and = + | + [A-Z] # Capitals are fine too, + (?!<) # But not if they start markup. + ) # End of special sequences. + [^-=A-Z>]* # Followed by zero or more non-special chars. + )* # And we can repeat this as often as we can. + )}; # That's all folks. + while (<>) { if ($cutting) { next unless /^=/; @@ -734,7 +766,7 @@ while (<>) { # first hide the escapes in case we need to # intuit something and get it wrong due to fmting - s/([A-Z]<[^<>]*>)/noremap($1)/ge; + 1 while s/([A-Z]<$nonest>)/noremap($1)/ge; # func() is a reference to a perl function s{ @@ -791,13 +823,16 @@ while (<>) { while ($maxnest-- && /[A-Z]]*)>/font($1) . $2 . font('R')/eg; + s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg; # files and filelike refs in italics - s/F<([^<>]*)>/I<$1>/g; + s/F<($nonest)>/I<$1>/g; # no break -- usually we want C<> for this - s/S<([^<>]*)>/nobreak($1)/eg; + s/S<($nonest)>/nobreak($1)/eg; + + # LREF: a la HREF L + s:L<([^|>]+)\|[^>]+>:$1:g; # LREF: a manpage(3f) s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g; @@ -848,7 +883,7 @@ while (<>) { s/Z<>/\\&/g; # comes last because not subject to reprocessing - s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg; + s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg; } if (s/^=//) { @@ -883,11 +918,11 @@ while (<>) { s/\s+$//; delete $wanna_see{$_} if exists $wanna_see{$_}; print qq{.SH "$_"\n}; - print qq{.IX Header "$_"\n}; + push(@Indices, qq{.IX Header "$_"\n}); } elsif ($Cmd eq 'head2') { print qq{.Sh "$_"\n}; - print qq{.IX Subsection "$_"\n}; + push(@Indices, qq{.IX Subsection "$_"\n}); } elsif ($Cmd eq 'over') { push(@indent,$indent); @@ -906,7 +941,7 @@ while (<>) { s/[^"]""([^"]+?)""[^"]/'$1'/g; # here do something about the $" in perlvar? print STDOUT qq{.Ip "$_" $indent\n}; - print qq{.IX Item "$_"\n}; + push(@Indices, qq{.IX Item "$_"\n}); } elsif ($Cmd eq 'pod') { # this is just a comment @@ -939,6 +974,8 @@ if (%wanna_see && !$lax) { $oops++; } +foreach (@Indices) { print "$_\n"; } + exit; #exit ($oops != 0); @@ -1042,11 +1079,7 @@ sub makespace { sub mkindex { my ($entry) = @_; my @entries = split m:\s*/\s*:, $entry; - print ".IX Xref "; - for $entry (@entries) { - print qq("$entry" ); - } - print "\n"; + push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries; return ''; } @@ -1114,7 +1147,10 @@ sub internal_lrefs { } $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) - . " elsewhere in this document "; # terminal space to avoid words running together (pattern used strips terminal spaces) + . " 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; @@ -1198,3 +1234,4 @@ BEGIN { close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir;