# Pod::Man -- Convert POD data to formatted *roff input.
-# $Id: Man.pm,v 1.7 2000/09/03 09:22:57 eagle Exp $
+# $Id: Man.pm,v 1.15 2001/02/10 06:50:22 eagle Exp $
#
-# Copyright 1999, 2000 by Russ Allbery <rra@stanford.edu>
+# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
# Perl core and too many things could munge CVS magic revision strings.
# This number should ideally be the same as the CVS revision in podlators,
# however.
-$VERSION = 1.07;
+$VERSION = 1.15;
############################################################################
.\}
.rm #[ #] #H #V #F C
----END OF PREAMBLE----
-
+#`# for cperl-mode
+
# This table is taken nearly verbatim from Tom Christiansen's pod2man. It
# assumes that the standard preamble has already been printed, since that's
# what defines all of the accent marks. Note that some of these are quoted
s/^([.\'\\])/\\&$1/mg;
$_;
}
-
-# Given a command and a single argument that may or may not contain double
-# quotes, handle double-quote formatting for it. If there are no double
-# quotes, just return the command followed by the argument in double quotes.
-# If there are double quotes, use an if statement to test for nroff, and for
-# nroff output the command followed by the argument in double quotes with
-# embedded double quotes doubled. For other formatters, remap paired double
-# quotes to `` and ''.
-sub switchquotes {
- my $command = shift;
- local $_ = shift;
- my $extra = shift;
- s/\\\*\([LR]\"/\"/g;
- if (/\"/) {
- s/\"/\"\"/g;
- my $troff = $_;
- $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g;
- s/\"/\"\"/g if $extra;
- $troff =~ s/\"/\"\"/g if $extra;
- $_ = qq("$_") . ($extra ? " $extra" : '');
- $troff = qq("$troff") . ($extra ? " $extra" : '');
- return ".if n $command $_\n.el $command $troff\n";
- } else {
- $_ = qq("$_") . ($extra ? " $extra" : '');
- return "$command $_\n";
- }
-}
# Translate a font string into an escape.
sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] }
-
+
############################################################################
# Initialization
############################################################################
}
# Figure out what quotes we'll be using for C<> text.
- $$self{quotes} ||= "'";
+ $$self{quotes} ||= '"';
if ($$self{quotes} eq 'none') {
$$self{LQUOTE} = $$self{RQUOTE} = '';
} elsif (length ($$self{quotes}) == 1) {
$$self{INDENT} = 0; # Current indentation level.
$$self{INDENTS} = []; # Stack of indentations.
$$self{INDEX} = []; # Index keys waiting to be printed.
+ $$self{ITEMS} = 0; # The number of consecutive =items.
$self->SUPER::initialize;
}
}
}
+ # If $name contains spaces, quote it; this mostly comes up in the case
+ # of input from stdin.
+ $name = '"' . $name . '"' if ($name =~ /\s/);
+
# Modification date header. Try to use the modification time of our
# input.
if (!defined $$self{date}) {
$self->$command (@_);
} else {
my ($text, $line, $paragraph) = @_;
- my ($file, $line) = $paragraph->file_line;
+ my $file;
+ ($file, $line) = $paragraph->file_line;
$text =~ s/\n+\z//;
$text = " $text" if ($text =~ /^\S/);
warn qq($file:$line: Unknown command paragraph "=$command$text"\n);
1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
s/\\/\\e/g;
s/^(\s*\S)/'\&' . $1/gme;
- $self->makespace if $$self{NEEDSPACE};
+ $self->makespace;
$self->output (".Vb $lines\n$_.Ve\n");
$$self{NEEDSPACE} = 0;
}
>
(
,?\s+(and\s+)? # Allow lots of them, conjuncted.
- L<
+ L<
/
( [:\w]+ ( \(\) )? )
>
# scalars as well as scalars and does the right thing with them.
$text = $self->parse ($text, @_);
$text =~ s/\n\s*$/\n/;
- $self->makespace if $$self{NEEDSPACE};
- $self->output (protect $self->mapfonts ($text));
+ $self->makespace;
+ $self->output (protect $self->textmapfonts ($text));
$self->outindex;
$$self{NEEDSPACE} = 1;
}
my $tmp = $self->buildlink ($_);
return bless \ "$tmp", 'Pod::Man::String';
}
-
+
# Whitespace protection replaces whitespace with "\ ".
if ($command eq 'S') {
s/\s+/\\ /g;
local $_ = $self->parse (@_);
s/\s+$//;
s/\\s-?\d//g;
- $self->output (switchquotes ('.SH', $self->mapfonts ($_)));
+ s/\s*\n\s*/ /g;
+ if ($$self{ITEMS} > 1) {
+ $$self{ITEMS} = 0;
+ $self->output (".PD\n");
+ }
+ $self->output ($self->switchquotes ('.SH', $self->mapfonts ($_)));
$self->outindex (($_ eq 'NAME') ? () : ('Header', $_));
$$self{NEEDSPACE} = 0;
}
my $self = shift;
local $_ = $self->parse (@_);
s/\s+$//;
- $self->output (switchquotes ('.Sh', $self->mapfonts ($_)));
+ s/\s*\n\s*/ /g;
+ if ($$self{ITEMS} > 1) {
+ $$self{ITEMS} = 0;
+ $self->output (".PD\n");
+ }
+ $self->output ($self->switchquotes ('.Sh', $self->mapfonts ($_)));
$self->outindex ('Subsection', $_);
$$self{NEEDSPACE} = 0;
}
+# Third level heading.
+sub cmd_head3 {
+ my $self = shift;
+ local $_ = $self->parse (@_);
+ s/\s+$//;
+ s/\s*\n\s*/ /g;
+ if ($$self{ITEMS} > 1) {
+ $$self{ITEMS} = 0;
+ $self->output (".PD\n");
+ }
+ $self->makespace;
+ $self->output ($self->switchquotes ('.I', $self->mapfonts ($_)));
+ $self->outindex ('Subsection', $_);
+ $$self{NEEDSPACE} = 1;
+}
+
+# Fourth level heading.
+sub cmd_head4 {
+ my $self = shift;
+ local $_ = $self->parse (@_);
+ s/\s+$//;
+ s/\s*\n\s*/ /g;
+ if ($$self{ITEMS} > 1) {
+ $$self{ITEMS} = 0;
+ $self->output (".PD\n");
+ }
+ $self->makespace;
+ $self->output ($self->textmapfonts ($_) . "\n");
+ $self->outindex ('Subsection', $_);
+ $$self{NEEDSPACE} = 1;
+}
+
# Start a list. For indents after the first, wrap the outside indent in .RS
# so that hanging paragraph tags will be correct.
sub cmd_over {
$self->output (".RE\n");
$$self{WEIRDINDENT} = 0;
}
- $_ = $self->mapfonts ($_);
- $self->output (switchquotes ('.Ip', $_, $$self{INDENT}));
+ $_ = $self->textmapfonts ($_);
+ $self->output (".PD 0\n") if ($$self{ITEMS} == 1);
+ $self->output ($self->switchquotes ('.Ip', $_, $$self{INDENT}));
$self->outindex ($index ? ('Item', $index) : ());
$$self{NEEDSPACE} = 0;
+ $$self{ITEMS}++;
}
# Begin a block for a particular translator. Setting VERBATIM triggers
s/^\s+//;
s/\s+$//;
+ # If the argument looks like a URL, return it verbatim. This only
+ # handles URLs that use the server syntax.
+ if (m%^[a-z]+://\S+$%) { return $_ }
+
# Default to using the whole content of the link entry as a section
# name. Note that L<manpage/> forces a manpage interpretation, as does
# something looking like L<manpage(section)>. Do the same thing to
# At this point, we'll have embedded font codes of the form \f(<font>[SE]
# where <font> is one of B, I, or F. Turn those into the right font start
-# or end codes. B<someI<thing> else> should map to \fBsome\f(BIthing\fB
-# else\fR. The old pod2man didn't get this right; the second \fB was \fR,
-# so nested sequences didn't work right. We take care of this by using
-# variables as a combined pointer to our current font sequence, and set each
-# to the number of current nestings of start tags for that font. Use them
-# as a vector to look up what font sequence to use.
+# or end codes. The old pod2man didn't get B<someI<thing> else> right;
+# after I<> it switched back to normal text rather than bold. We take care
+# of this by using variables as a combined pointer to our current font
+# sequence, and set each to the number of current nestings of start tags for
+# that font. Use them as a vector to look up what font sequence to use.
+#
+# \fP changes to the previous font, but only one previous font is kept. We
+# don't know what the outside level font is; normally it's R, but if we're
+# inside a heading it could be something else. So arrange things so that
+# the outside font is always the "previous" font and end with \fP instead of
+# \fR. Idea from Zack Weinberg.
sub mapfonts {
my $self = shift;
local $_ = shift;
my ($fixed, $bold, $italic) = (0, 0, 0);
my %magic = (F => \$fixed, B => \$bold, I => \$italic);
+ my $last = '\fR';
+ s { \\f\((.)(.) } {
+ my $sequence = '';
+ my $f;
+ if ($last ne '\fR') { $sequence = '\fP' }
+ ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1;
+ $f = $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)};
+ if ($f eq $last) {
+ '';
+ } else {
+ if ($f ne '\fR') { $sequence .= $f }
+ $last = $f;
+ $sequence;
+ }
+ }gxe;
+ $_;
+}
+
+# Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU
+# groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather
+# than R, presumably because \f(CW doesn't actually do a font change. To
+# work around this, use a separate textmapfonts for text blocks where the
+# default font is always R and only use the smart mapfonts for headings.
+sub textmapfonts {
+ my $self = shift;
+ local $_ = shift;
+
+ my ($fixed, $bold, $italic) = (0, 0, 0);
+ my %magic = (F => \$fixed, B => \$bold, I => \$italic);
s { \\f\((.)(.) } {
${ $magic{$1} } += ($2 eq 'S') ? 1 : -1;
$$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)};
$self->parse_text ({ -expand_seq => 'sequence',
-expand_ptree => 'collapse' }, @_);
}
-
+
# Takes a parse tree and a flag saying whether or not to treat it as literal
# text (not call guesswork on it), and returns the concatenation of all of
# the text strings in that parse tree. If the literal flag isn't true,
# Make vertical whitespace.
sub makespace {
my $self = shift;
- $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n");
+ $self->output (".PD\n") if ($$self{ITEMS} > 1);
+ $$self{ITEMS} = 0;
+ $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n")
+ if $$self{NEEDSPACE};
}
# Output any pending index entries, and optionally an index entry given as
# Output text to the output device.
sub output { print { $_[0]->output_handle } $_[1] }
+# Given a command and a single argument that may or may not contain double
+# quotes, handle double-quote formatting for it. If there are no double
+# quotes, just return the command followed by the argument in double quotes.
+# If there are double quotes, use an if statement to test for nroff, and for
+# nroff output the command followed by the argument in double quotes with
+# embedded double quotes doubled. For other formatters, remap paired double
+# quotes to LQUOTE and RQUOTE.
+sub switchquotes {
+ my $self = shift;
+ my $command = shift;
+ local $_ = shift;
+ my $extra = shift;
+ s/\\\*\([LR]\"/\"/g;
+
+ # We also have to deal with \*C` and \*C', which are used to add the
+ # quotes around C<> text, since they may expand to " and if they do this
+ # confuses the .SH macros and the like no end. Expand them ourselves.
+ # If $extra is set, we're dealing with =item, which in most nroff macro
+ # sets requires an extra level of quoting of double quotes.
+ my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/);
+ if (/\"/ || ($c_is_quote && /\\\*\(C[\'\`]/)) {
+ s/\"/\"\"/g;
+ my $troff = $_;
+ $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g;
+ s/\\\*\(C\`/$$self{LQUOTE}/g;
+ s/\\\*\(C\'/$$self{RQUOTE}/g;
+ $troff =~ s/\\\*\(C[\'\`]//g;
+ s/\"/\"\"/g if $extra;
+ $troff =~ s/\"/\"\"/g if $extra;
+ $_ = qq("$_") . ($extra ? " $extra" : '');
+ $troff = qq("$troff") . ($extra ? " $extra" : '');
+ return ".if n $command $_\n.el $command $troff\n";
+ } else {
+ $_ = qq("$_") . ($extra ? " $extra" : '');
+ return "$command $_\n";
+ }
+}
+
__END__
.\" These are some extra bits of roff that I don't want to lose track of