view release on metacpan or  search on metacpan

Pod/Dsr.pm  view on Meta::CPAN

        )
    } { '^&' . $1 . '\&' }egx;

    # func(n) is a reference to a manual page.  Make it ^&func\&(n).
    s{
        \b
        (\w[-:.\w]+ (?:\\s-1)?)
        (
            \( [^\)] \)
        )
    } { '^&' . $1 . '\&' . $2 }egx;

    # Convert simple Perl variable references to a fixed-width font.
#    s{
#        ( \s+ )
#        ( [\$\@%] [\w:]+ )
#        (?! \( )
#    } { $1 . '\f(FS' . $2 . '\f(FE'}egx;

    # Translate -- into a real em dash if it's used like one and fix up
    # dashes, but keep hyphens hyphens.
#    s{ (\G|^|.) (-+) (\b|.) } {
#        my ($pre, $dash, $post) = ($1, $2, $3);
#        if (length ($dash) == 1) {
#            ($pre =~ /[a-zA-Z]/) ? "$pre-$post" : "$pre\\-$post";
#        } elsif (length ($dash) == 2
#                 && ((!$pre && !$post)
#                     || ($pre =~ /\w/ && !$post)
#                     || ($pre eq ' ' && $post eq ' ')
#                     || ($pre eq '=' && $post ne '=')
#                     || ($pre ne '=' && $post eq '='))) {
#            "$pre\\*(--$post";
#        } else {
#            $pre . ('\-' x length $dash) . $post;
#        }
#    }egxs;

    # All done.
    $_;
}


############################################################################
# Output formatting
############################################################################

# Make vertical whitespace.
sub makespace {
    my $self = shift;
    $self->output (".BREAK\n") if ($$self{ITEMS} > 1);
    $$self{ITEMS} = 0;
    $self->output ($$self{INDENT} > 0 ? ".PARAGRAPH\n" : ".PARAGRAPH\n")
        if $$self{NEEDSPACE};
}

# Output any pending index entries, and optionally an index entry given as
# an argument.  Support multiple index entries in X<> separated by slashes,
# and strip special escapes from index entries.
sub outindex {
    my ($self, $section, $index) = @_;
    my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} };
    return unless ($section || @entries);
    $$self{INDEX} = [];
    my $output;
    if (@entries) {
        my $output = '.INDEX '
            . join (' ', @entries)
            . "\n";
    }
    if ($section) {
        if (defined($index) && $index ne '') {
            $index =~ s/\\-/-/g;
            $index =~ s/\\(?:s-?\d|.\(..|.)//g;
            $output .= ".INDEX $section>$index\n";
        }
        else {
            $output .= ".INDEX $section\n";
        }
    }
    $self->output ($output);
}

# 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";
    }