home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / lib / site_perl / POD / ParserText.pm < prev   
Text File  |  1998-05-02  |  22KB  |  684 lines
  1. #############################################################################
  2. # Text.pm -- convert POD data to formatted ASCII text
  3. #
  4. # Derived from Tom Christiansen's Pod::Text module
  5. # (with extensive modifications).
  6. #
  7. # Copyright (C) 1994-1996 Tom Christiansen. All rights reserved.
  8. # This file is part of "PodParser". PodParser is free software;
  9. # you can redistribute it and/or modify it under the same terms
  10. # as Perl itself.
  11. #############################################################################
  12.  
  13. package Pod::ParserText;
  14.  
  15. $VERSION = 2.00;   ## Current version of this package
  16. require  5.002;    ## requires Perl version 5.002 or later
  17.  
  18. =head1 NAME
  19.  
  20. pod2text - function to convert POD data to formatted ASCII text
  21.  
  22. Pod::ParserText - a class for converting POD data to formatted ASCII text
  23.  
  24. =head1 SYNOPSIS
  25.  
  26.     use Pod::ParserText;
  27.     pod2text("perlfunc.pod");
  28.  
  29. or
  30.  
  31.     use Pod::ParserText;
  32.     package MyParser;
  33.     @ISA = qw(Pod::ParserText);
  34.  
  35.     sub new {
  36.        ## constructor code ...
  37.     }
  38.  
  39.     ## implementation of appropriate subclass methods ...
  40.  
  41.     package main;
  42.     $parser = new MyParser;
  43.     @ARGV = ('-')  unless (@ARGV > 0);
  44.     for (@ARGV) {
  45.        $parser->parse_from_file($_);
  46.     }
  47.  
  48. =head1 DESCRIPTION
  49.  
  50. Pod::ParserText is a module that can convert documentation in the POD
  51. format (such as can be found throughout the Perl distribution) into
  52. formatted ASCII.  Termcap is optionally supported for
  53. boldface/underline, and can be enabled via C<$Pod::ParserText::termcap=1>.
  54. If termcap has not been enabled, then backspaces will be used to
  55. simulate bold and underlined text.
  56.  
  57. A separate F<pod2text> program is included that is primarily a wrapper for
  58. C<Pod::ParserText::pod2text()>.
  59.  
  60. The single function C<pod2text()> can take one or two arguments. The first
  61. should be the name of a file to read the pod from, or "<&STDIN" to read from
  62. STDIN. A second argument, if provided, should be a filehandle glob where
  63. output should be sent.
  64.  
  65. =head1 SEE ALSO
  66.  
  67. L<Pod::Parser>.
  68.  
  69. =head1 AUTHOR
  70.  
  71. Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
  72.  
  73. Modified to derive from B<Pod::Parser> by
  74. Brad Appleton E<lt>Brad_Appleton-GBDA001@email.mot.comE<gt>
  75.  
  76. =cut
  77.  
  78. #############################################################################
  79.  
  80. use Exporter ();
  81. use Term::Cap;
  82. use Pod::Parser;
  83. @ISA = qw(Exporter Pod::Parser);
  84. @EXPORT = qw(&pod2text);
  85.  
  86. %HTML_Escapes = (
  87.     'amp'       =>        '&',        #   ampersand
  88.     'lt'        =>        '<',        #   left chevron, less-than
  89.     'gt'        =>        '>',        #   right chevron, greater-than
  90.     'quot'      =>        '"',        #   double quote
  91.  
  92.     "Aacute"    =>        "\xC1",     #   capital A, acute accent
  93.     "aacute"    =>        "\xE1",     #   small a, acute accent
  94.     "Acirc"     =>        "\xC2",     #   capital A, circumflex accent
  95.     "acirc"     =>        "\xE2",     #   small a, circumflex accent
  96.     "AElig"     =>        "\xC6",     #   capital AE diphthong (ligature)
  97.     "aelig"     =>        "\xE6",     #   small ae diphthong (ligature)
  98.     "Agrave"    =>        "\xC0",     #   capital A, grave accent
  99.     "agrave"    =>        "\xE0",     #   small a, grave accent
  100.     "Aring"     =>        "\xC5",     #   capital A, ring
  101.     "aring"     =>        "\xE5",     #   small a, ring
  102.     "Atilde"    =>        "\xC3",     #   capital A, tilde
  103.     "atilde"    =>        "\xE3",     #   small a, tilde
  104.     "Auml"      =>        "\xC4",     #   capital A, dieresis or umlaut mark
  105.     "auml"      =>        "\xE4",     #   small a, dieresis or umlaut mark
  106.     "Ccedil"    =>        "\xC7",     #   capital C, cedilla
  107.     "ccedil"    =>        "\xE7",     #   small c, cedilla
  108.     "Eacute"    =>        "\xC9",     #   capital E, acute accent
  109.     "eacute"    =>        "\xE9",     #   small e, acute accent
  110.     "Ecirc"     =>        "\xCA",     #   capital E, circumflex accent
  111.     "ecirc"     =>        "\xEA",     #   small e, circumflex accent
  112.     "Egrave"    =>        "\xC8",     #   capital E, grave accent
  113.     "egrave"    =>        "\xE8",     #   small e, grave accent
  114.     "ETH"       =>        "\xD0",     #   capital Eth, Icelandic
  115.     "eth"       =>        "\xF0",     #   small eth, Icelandic
  116.     "Euml"      =>        "\xCB",     #   capital E, dieresis or umlaut mark
  117.     "euml"      =>        "\xEB",     #   small e, dieresis or umlaut mark
  118.     "Iacute"    =>        "\xCD",     #   capital I, acute accent
  119.     "iacute"    =>        "\xED",     #   small i, acute accent
  120.     "Icirc"     =>        "\xCE",     #   capital I, circumflex accent
  121.     "icirc"     =>        "\xEE",     #   small i, circumflex accent
  122.     "Igrave"    =>        "\xCD",     #   capital I, grave accent
  123.     "igrave"    =>        "\xED",     #   small i, grave accent
  124.     "Iuml"      =>        "\xCF",     #   capital I, dieresis or umlaut mark
  125.     "iuml"      =>        "\xEF",     #   small i, dieresis or umlaut mark
  126.     "Ntilde"    =>        "\xD1",     #   capital N, tilde
  127.     "ntilde"    =>        "\xF1",     #   small n, tilde
  128.     "Oacute"    =>        "\xD3",     #   capital O, acute accent
  129.     "oacute"    =>        "\xF3",     #   small o, acute accent
  130.     "Ocirc"     =>        "\xD4",     #   capital O, circumflex accent
  131.     "ocirc"     =>        "\xF4",     #   small o, circumflex accent
  132.     "Ograve"    =>        "\xD2",     #   capital O, grave accent
  133.     "ograve"    =>        "\xF2",     #   small o, grave accent
  134.     "Oslash"    =>        "\xD8",     #   capital O, slash
  135.     "oslash"    =>        "\xF8",     #   small o, slash
  136.     "Otilde"    =>        "\xD5",     #   capital O, tilde
  137.     "otilde"    =>        "\xF5",     #   small o, tilde
  138.     "Ouml"      =>        "\xD6",     #   capital O, dieresis or umlaut mark
  139.     "ouml"      =>        "\xF6",     #   small o, dieresis or umlaut mark
  140.     "szlig"     =>        "\xDF",     #   small sharp s, German (sz ligature)
  141.     "THORN"     =>        "\xDE",     #   capital THORN, Icelandic
  142.     "thorn"     =>        "\xFE",     #   small thorn, Icelandic
  143.     "Uacute"    =>        "\xDA",     #   capital U, acute accent
  144.     "uacute"    =>        "\xFA",     #   small u, acute accent
  145.     "Ucirc"     =>        "\xDB",     #   capital U, circumflex accent
  146.     "ucirc"     =>        "\xFB",     #   small u, circumflex accent
  147.     "Ugrave"    =>        "\xD9",     #   capital U, grave accent
  148.     "ugrave"    =>        "\xF9",     #   small u, grave accent
  149.     "Uuml"      =>        "\xDC",     #   capital U, dieresis or umlaut mark
  150.     "uuml"      =>        "\xFC",     #   small u, dieresis or umlaut mark
  151.     "Yacute"    =>        "\xDD",     #   capital Y, acute accent
  152.     "yacute"    =>        "\xFD",     #   small y, acute accent
  153.     "yuml"      =>        "\xFF",     #   small y, dieresis or umlaut mark
  154.  
  155.     "lchevron"  =>        "\xAB",     #   left chevron (double less than)
  156.     "rchevron"  =>        "\xBB",     #   right chevron (double greater than)
  157. );
  158.  
  159. use strict;
  160. use diagnostics;
  161. use Carp;
  162.  
  163. ##---------------------------------
  164. ## Function definitions begin here
  165. ##---------------------------------
  166.  
  167. sub version {
  168.     no strict;
  169.     return  $VERSION;
  170. }
  171.  
  172. sub pod2text {
  173.     my ($infile, $outfile) = @_;
  174.     local $_;
  175.     my $text_parser = new Pod::ParserText;
  176.     $text_parser->parse_from_file($infile, $outfile);
  177. }
  178.  
  179. ##-------------------------------
  180. ## Method definitions begin here
  181. ##-------------------------------
  182.  
  183. sub new {
  184.     my $this = shift;
  185.     my $class = ref($this) || $this;
  186.     my %params = @_;
  187.     my $self = {%params};
  188.     bless $self, $class;
  189.     $self->initialize();
  190.     return  $self;
  191. }
  192.  
  193. sub initialize {
  194.     my $self = shift;
  195.     $self->SUPER::initialize();
  196.     return;
  197. }
  198.  
  199. sub makespace {
  200.     my $self = shift;
  201.     my $out_fh = $self->{OUTPUT};
  202.     if ($self->{NEEDSPACE}) {
  203.         print $out_fh "\n";
  204.         $self->{NEEDSPACE} = 0;
  205.     }
  206. }
  207.  
  208. sub bold {
  209.     my $self = shift;
  210.     my $line = shift;
  211.     my $map  = $self->{FONTMAP};
  212.     return $line if $self->{USE_FORMAT};
  213.     if ($self->{TERMCAP}) {
  214.         $line = "$map->{BOLD}$line$map->{NORM}";
  215.     }
  216.     else {
  217.         $line =~ s/(.)/$1\b$1/g;
  218.     }
  219. #   $line = "$map->{BOLD}$line$map->{NORM}" if $self->{ANSIFY};
  220.     return $line;
  221. }
  222.  
  223. sub italic {
  224.     my $self = shift;
  225.     my $line = shift;
  226.     my $map  = $self->{FONTMAP};
  227.     return $line if $self->{USE_FORMAT};
  228.     if ($self->{TERMCAP}) {
  229.         $line = "$map->{UNDL}$line$map->{NORM}";
  230.     }
  231.     else {
  232.         $line =~ s/(.)/$1\b_/g;
  233.     }
  234. #   $line = "$map->{UNDL}$line$map->{NORM}" if $self->{ANSIFY};
  235.     return $line;
  236. }
  237.  
  238. # Fill a paragraph including underlined and overstricken chars.
  239. # It's not perfect for words longer than the margin, and it's probably
  240. # slow, but it works.
  241. sub fill {
  242.     my $self = shift;
  243.     local $_ = shift;
  244.     my $par = "";
  245.     my $indent_space = " " x $self->{INDENT};
  246.     my $marg = $self->{SCREEN} - $self->{INDENT};
  247.     my $line = $indent_space;
  248.     my $line_length;
  249.     foreach (split) {
  250.         my $word_length = length;
  251.         $word_length -= 2 while /\010/g;  # Subtract backspaces
  252.  
  253.         if ($line_length + $word_length > $marg) {
  254.             $par .= $line . "\n";
  255.             $line= $indent_space . $_;
  256.             $line_length = $word_length;
  257.         }
  258.         else {
  259.             if ($line_length) {
  260.                 $line_length++;
  261.                 $line .= " ";
  262.             }
  263.             $line_length += $word_length;
  264.             $line .= $_;
  265.         }
  266.     }
  267.     $par .= "$line\n" if $line;
  268.     $par .= "\n";
  269.     return $par;
  270. }
  271.  
  272. ## Handle a pending "item" paragraph.  The lone argument (if given) is the
  273. ## corresponding item text.  (the item tag should be in $self->{ITEM}).
  274. sub item {
  275.     my $self  = shift;
  276.     local($_) = @_;
  277.     return  unless (defined  $self->{ITEM});
  278.     my $out_fh  = $self->{OUTPUT};
  279.     my $paratag = $self->{ITEM};
  280.     my $prev_indent = $self->{INDENTS}->[$#{$self->{INDEX}} - 1]
  281.                       || $self->{DEF_INDENT};
  282.     undef $self->{ITEM};
  283.     if ((defined $_) && ($_ ne '')
  284.                      && (length($paratag) + 3) < $self->{INDENT}) {
  285.         if (/^=/) {  # tricked!
  286.            $self->output($paratag, INDENT => $prev_indent);
  287.         }
  288.         else {
  289.            $self->IP_output($paratag, $_);
  290.         }
  291.     }
  292.     else {
  293.         $self->output($paratag, INDENT => $prev_indent);
  294.         $self->output($_, REFORMAT => 1);
  295.     }
  296. }
  297.  
  298. sub remap_whitespace {
  299.     my $self  = shift;
  300.     local($_) = shift;
  301.     tr/\000-\177/\200-\377/;
  302.     return $_;
  303. }
  304.  
  305. sub unmap_whitespace {
  306.     my $self  = shift;
  307.     local($_) = shift;
  308.     tr/\200-\377/\000-\177/;
  309.     return $_;
  310. }
  311.  
  312. sub IP_output {
  313.     my $self  = shift;
  314.     my $tag   = shift;
  315.     local($_) = @_;
  316.     my $out_fh  = $self->{OUTPUT};
  317.     my $tag_indent  = $self->{INDENTS}->[$#{$self->{INDEX}} - 1]
  318.                       || $self->{DEF_INDENT};
  319.     my $tag_cols = $self->{SCREEN} - $tag_indent;
  320.     my $cols = $self->{SCREEN} - $self->{INDENT};
  321.     $tag =~ s/\s*$//;
  322.     s/\s+/ /g;
  323.     s/^ //;
  324.     my $fmt_name = '_Pod_Text_IP_output_format_';
  325.     my $str = "format $fmt_name = \n"
  326.         . (" " x ($tag_indent))
  327.         . '@' . ('<' x ($self->{INDENT} - $tag_indent - 1))
  328.         . "^" .  ("<" x ($cols - 1)) . "\n"
  329.         . '$tag, $_'
  330.         . "\n~~"
  331.         . (" " x ($self->{INDENT} - 2))
  332.         . "^" .  ("<" x ($cols - 5)) . "\n"
  333.         . '$_' . "\n\n.\n1";
  334.     #warn $str; warn "tag is $tag, _ is $_";
  335.     {
  336.         ## reset format (turn off warning about redefining a format)
  337.         local($^W) = 0;
  338.         eval $str;
  339.         croak if ($@);
  340.     }
  341.     select((select($out_fh), $~ = $fmt_name)[0]);
  342.     local($:) = ($self->{HEADINGS}->[0] eq "SYNOPSIS") ? "\n " : $: ;
  343.     write $out_fh;
  344. }
  345.  
  346. sub output {
  347.     my $self = shift;
  348.     local $_ = shift;
  349.     my $out_fh = $self->{OUTPUT};
  350.     my %options;
  351.     if (@_ > 1) {
  352.         ## usage was $self->output($text, NAME=>VALUE, ...);
  353.         %options = @_;
  354.     }
  355.     elsif (@_ == 1) {
  356.         if (ref $_[0]) {
  357.            ## usage was $self->output($text, { NAME=>VALUE, ... } );
  358.            %options = %{$_[0]};
  359.         }
  360.         else {
  361.            ## usage was $self->output($text, $number);
  362.            $options{"REFORMAT"} = shift;
  363.         }
  364.     }
  365.     $options{"INDENT"} = $self->{INDENT}  unless (defined $options{"INDENT"});
  366.     if ((defined $options{"REFORMAT"}) && $options{"REFORMAT"}) {
  367.         my $cols = $self->{SCREEN} - $options{"INDENT"};
  368.         s/\s+/ /g;
  369.         s/^ //;
  370.         my $fmt_name = '_Pod_Text_output_format_';
  371.         my $str = "format $fmt_name = \n~~"
  372.             . (" " x ($options{"INDENT"} - 2))
  373.             . "^" .  ("<" x ($cols - 5)) . "\n"
  374.             . '$_' . "\n\n.\n1";
  375.         {
  376.             ## reset format (turn off warning about redefining a format)
  377.             local($^W) = 0;
  378.             eval $str;
  379.             croak if ($@);
  380.         }
  381.         select((select($out_fh), $~ = $fmt_name)[0]);
  382.         local($:) = ($self->{HEADINGS}->[0] eq "SYNOPSIS") ? "\n " : $: ;
  383.         write $out_fh;
  384.     }
  385.     else {
  386.         s/^/' ' x $options{"INDENT"}/gem;
  387.         s/^\s+\n$/\n/gm;
  388.         print $out_fh $_;
  389.     }
  390. }
  391.  
  392. sub internal_lrefs {
  393.     my $self = shift;
  394.     local $_ = shift;
  395.     s{L</([^>]+)>}{$1}g;
  396.     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
  397.     my $retstr = "the ";
  398.     my $i;
  399.     for ($i = 0; $i <= $#items; $i++) {
  400.         $retstr .= "C<$items[$i]>";
  401.         $retstr .= ", " if @items > 2 && $i != $#items;
  402.         $retstr .= " and " if $i+2 == @items;
  403.     }
  404.  
  405.    $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
  406.                       .  " elsewhere in this document ";
  407.  
  408.    return $retstr;
  409. }
  410.  
  411. sub begin_input {
  412.     my $self = shift;
  413.  
  414.     #----------------------------------------------------
  415.     # This class may wish to make use of some of the
  416.     # commented-out code below for initializing pragmas
  417.     #----------------------------------------------------
  418.     # $self->{PRAGMAS} = {
  419.     #     FILL     => 'on',
  420.     #     STYLE    => 'plain',
  421.     #     INDENT   => 0,
  422.     # };
  423.     # ## Initialize all PREVIOUS_XXX pragma values
  424.     # my ($name, $value);
  425.     # for (($name, $value) = each %{$self->{PRAGMAS}}) {
  426.     #     $self->{PRAGMAS}->{"PREVIOUS_${name}"} = $value;
  427.     # }
  428.     #----------------------------------------------------
  429.  
  430.     $self->{TERMCAP} = 0;
  431.     #$self->{USE_FORMAT} = 1;
  432.  
  433.     $self->{FONTMAP} = {
  434.         UNDL => "\x1b[4m",
  435.         INV  => "\x1b[7m",
  436.         BOLD => "\x1b[1m",
  437.         NORM => "\x1b[0m",
  438.     };
  439.     if ($self->{TERMCAP} and (! defined $self->{SETUPTERMCAP})) {
  440.         $self->{SETUPTERMCAP} = 1;
  441.         my ($term) = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 };
  442.         $self->{FONTMAP}->{UNDL} = $term->{'_us'};
  443.         $self->{FONTMAP}->{INV}  = $term->{'_mr'};
  444.         $self->{FONTMAP}->{BOLD} = $term->{'_md'};
  445.         $self->{FONTMAP}->{NORM} = $term->{'_me'};
  446.     }
  447.    
  448.     $self->{SCREEN} =
  449.                 ((defined $ENV{TERMCAP}) && ($ENV{TERMCAP} =~ /co#(\d+)/)[0])
  450.                 || ((defined $ENV{COLUMNS}) && $ENV{COLUMNS})
  451.                 || (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0]
  452.                 || 72;
  453.    
  454.     $self->{FANCY}      = 0;
  455.     $self->{DEF_INDENT} = 4;
  456.     $self->{INDENTS}    = [];
  457.     $self->{INDENT}     = $self->{DEF_INDENT};
  458.     $self->{INDEX}      = [];
  459.     $self->{NEEDSPACE}  = 0;
  460. }
  461.  
  462. sub end_input {
  463.     my $self = shift;
  464.     $self->item()  if (defined $self->{ITEM});
  465. }
  466.  
  467. sub pragma {
  468.     my $self  = shift;
  469.     ## convert remaining args to lowercase
  470.     my $name  = lc shift;
  471.     my $value = lc shift;
  472.     my $rc = 1;
  473.     local($_);
  474.     #----------------------------------------------------
  475.     # This class may wish to make use of some of the
  476.     # commented-out code below for processing pragmas
  477.     #----------------------------------------------------
  478.     # my ($abbrev, %abbrev_table);
  479.     # if ($name eq 'fill') {
  480.     #     %abbrev_table = ('on' => 'on',
  481.     #                      'of' => 'off',
  482.     #                      'p'  => 'previous');
  483.     #     $value = 'on' unless ((defined $value) && ($value ne ''));
  484.     #     return  $rc  unless ($value =~ /^(on|of|p)/io);
  485.     #     $abbrev = $1;
  486.     #     $value = $abbrev_table{$abbrev};
  487.     #     if ($value eq 'previous') {
  488.     #         $self->{PRAGMAS}->{FILL} = $self->{PRAGMAS}->{PREVIOUS_FILL};
  489.     #     }
  490.     #     else {
  491.     #         $self->{PRAGMAS}->{PREVIOUS_FILL} = $self->{PRAGMAS}->{FILL};
  492.     #         $self->{PRAGMAS}->{FILL} = $value;
  493.     #     }
  494.     # }
  495.     # elsif ($name eq 'style') {
  496.     #     %abbrev_table = ('b'  => 'bold',
  497.     #                      'i'  => 'italic',
  498.     #                      'c'  => 'code',
  499.     #                      'pl' => 'plain',
  500.     #                      'pr' => 'previous');
  501.     #     $value = 'plain' unless ((defined $value) && ($value ne ''));
  502.     #     return  $rc  unless ($value =~ /^(b|i|c|pl|pr)/io);
  503.     #     $abbrev = $1;
  504.     #     $value = $abbrev_table{$abbrev};
  505.     #     if ($value eq 'previous') {
  506.     #         $self->{PRAGMAS}->{STYLE} = $self->{PRAGMAS}->{PREVIOUS_STYLE};
  507.     #     }
  508.     #     else {
  509.     #         $self->{PRAGMAS}->{PREVIOUS_STYLE} = $self->{PRAGMAS}->{STYLE};
  510.     #         $self->{PRAGMAS}->{STYLE} = $value;
  511.     #     }
  512.     # }
  513.     # elsif ($name eq 'indent') {
  514.     #     return $rc unless ((defined $value) && ($value =~ /^([-+]?)(\d*)$/o));
  515.     #     my ($sign, $number) = ($1, $2);
  516.     #     $value .= 3  unless ((defined $number) && ($number ne ''));
  517.     #     $self->{PRAGMAS}->{PREVIOUS_INDENT} = $self->{PRAGMAS}->{INDENT};
  518.     #     if ($sign) {
  519.     #         $self->{PRAGMAS}->{INDENT} += $value;
  520.     #     }
  521.     #     else {
  522.     #         $self->{PRAGMAS}->{INDENT} = $value;
  523.     #     } 
  524.     # }
  525.     # else {
  526.     #     $rc = 0;
  527.     # }
  528.     #----------------------------------------------------
  529.     return $rc;
  530. }
  531.  
  532. sub command {
  533.     my $self = shift;
  534.     my $cmd  = shift;
  535.     local $_ = shift;
  536.     $cmd  = ''  unless (defined $cmd);
  537.     $_    = ''  unless (defined $_);
  538.     my $out_fh  = $self->{OUTPUT};
  539.  
  540.     $_ = $self->interpolate($_);
  541.     s/\s*$/\n/;
  542.     $self->item()  if (defined $self->{ITEM});
  543.  
  544.     if ($cmd eq 'head1') {
  545.         $self->makespace();
  546.         print $out_fh $_;
  547.         # print $out_fh uc($_);
  548.     }
  549.     elsif ($cmd eq 'head2' or $cmd eq 'head2') {
  550.         $self->makespace();
  551.         # s/(\w+)/\u\L$1/g;
  552.         #print ' ' x $self->{DEF_INDENT}, $_;
  553.         # print "\xA7";
  554.         s/(\w)/\xA7 $1/ if $self->{FANCY};
  555.         print $out_fh ' ' x ($self->{DEF_INDENT}/2), $_, "\n";
  556.     }
  557.     elsif ($cmd eq 'over') {
  558.         push(@{$self->{INDENTS}}, $self->{INDENT});
  559.         $self->{INDENT} += ($_ + 0) || $self->{DEF_INDENT};
  560.     }
  561.     elsif ($cmd eq 'back') {
  562.         $self->{INDENT} = pop(@{$self->{INDENTS}});
  563.         unless (defined $self->{INDENT}) {
  564.             carp "Unmatched =back\n";
  565.             $self->{INDENT} = $self->{DEF_INDENT};
  566.         }
  567.         $self->{NEEDSPACE} = 1;
  568.     }
  569.     elsif ($cmd eq 'item') {
  570.         $self->makespace();
  571.         # s/\A(\s*)\*/$1\xb7/ if $self->{FANCY};
  572.         # s/^(\s*\*\s+)/$1 /;
  573.         $self->{ITEM} = $_;
  574.     }
  575.     else {
  576.         carp "Unrecognized directive: $cmd\n";
  577.     }
  578. }
  579.  
  580. sub verbatim {
  581.     my $self = shift;
  582.     local $_ = shift;
  583.     $self->item()  if (defined $self->{ITEM});
  584.     $self->{NEEDSPACE} = 1;
  585.     $self->output($_);
  586. }
  587.  
  588. sub textblock {
  589.     my $self  = shift;
  590.     my $text  = shift;
  591.     local($_) = $self->interpolate($text);
  592.     if (defined $self->{ITEM}) {
  593.         $self->item($_);
  594.     }
  595.     else {
  596.         s/\s*$/\n/;
  597.         $self->makespace();
  598.         $self->output($_, REFORMAT => 1);
  599.     }
  600. }
  601.  
  602. sub interior_sequence {
  603.     my $self = shift;
  604.     my $cmd  = shift;
  605.     my $arg  = shift;
  606.     local($_) = $arg;
  607.     if ($cmd eq 'C') {
  608.         no strict;  ## dont complain about $HTML_Escapes without package prefix
  609.         my ($pre, $post) = ("`", "'");
  610.         ($pre, $post) = ($HTML_Escapes{"lchevron"}, $HTML_Escapes{"rchevron"})
  611.                 if ((defined $self->{FANCY}) && $self->{FANCY});
  612.         $_ = $pre . $_ . $post;
  613.     }
  614.     elsif ($cmd eq 'E') {
  615.         no strict;  ## dont complain about $HTML_Escapes without package prefix
  616.         if (defined $HTML_Escapes{$_}) {
  617.             $_ = $HTML_Escapes{$_};
  618.         }
  619.         else {
  620.             carp "Unknown escape: E<$_>";
  621.             $_ = "E<$_>";
  622.         }
  623.     # }
  624.     # elsif ($cmd eq 'B') {
  625.     #     $_ = $self->bold($_);
  626.     }
  627.     elsif ($cmd eq 'I') {
  628.         # $_ = $self->italic($_);
  629.         $_ = "*" . $_ . "*";
  630.     }
  631.     elsif (($cmd eq 'X') || ($cmd eq 'Z')) {
  632.         $_ = '';
  633.     }
  634.     elsif ($cmd eq 'S') {
  635.         # Escape whitespace until we are ready to print
  636.         #$_ = $self->remap_whitespace($_);
  637.     }
  638.     elsif ($cmd eq 'L') {
  639.         s/\s+/ /g;
  640.         my ($manpage, $sec, $ref) = ($_, '', '');
  641.         if (/^\s*"\s*(.*)\s*"\s*$/o) {
  642.             ($manpage, $sec) = ('', "\"$1\"");
  643.         }
  644.         elsif (m|\s*/\s*|o) {
  645.             ($manpage, $sec) = ($`, $');
  646.         }
  647.         if ($sec eq '') {
  648.             $ref .= "the $manpage manpage"  if ($manpage ne '');
  649.         }
  650.         elsif ($sec =~ /^\s*"\s*(.*)\s*"\s*$/o) {
  651.             $ref .= "the section on \"$1\"";
  652.             $ref .= " in the $manpage manpage"  if ($manpage ne '');
  653.         }
  654.         else {
  655.              $ref .= "the \"$sec\" entry";
  656.              $ref .= ($manpage eq '') ? " in this manpage"
  657.                                       : " in the $manpage manpage";
  658.         }
  659.         $_ = $ref;
  660.         #if ( m{^ ([a-zA-Z][^\s\/]+) (\([^\)]+\))? $}x ) {
  661.         #    ## LREF: a manpage(3f)
  662.         #    $_ = "the $1$2 manpage";
  663.         #}
  664.         #elsif ( m{^ ([^/]+) / ([:\w]+(\(\))?) $}x ) {
  665.         #    ## LREF: an =item on another manpage
  666.         #    $_ = "the \"$2\" entry in the $1 manpage";
  667.         #}
  668.         #elsif ( m{^ / ([:\w]+(\(\))?) $}x ) {
  669.         #    ## LREF: an =item on this manpage
  670.         #    $_ = $self->internal_lrefs($1);
  671.         #}
  672.         #elsif ( m{^ (?: ([a-zA-Z]\S+?) / )? "?(.*?)"? $}x ) {
  673.         #    ## LREF: a =head2 (head1?), maybe on a manpage, maybe right here
  674.         #    ## the "func" can disambiguate
  675.         #    $_ = ((defined $1) && $1)
  676.         #            ? "the section on \"$2\" in the $1 manpage"
  677.         #            : "the section on \"$2\"";
  678.         #}
  679.     }
  680.     return  $_;
  681. }
  682.  
  683. 1;
  684.