texinfo/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm

# Texinfo.pm: format Pod as Texinfo.
#
# Copyright 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License,
# or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
# 
# Original author: Patrice Dumas <pertusus@free.fr>
# Parts from L<Pod::Simple::HTML>.


package Pod::Simple::Texinfo;

require 5;
use strict;

use Carp qw(cluck);
#use Pod::Simple::Debug (3);
use Pod::Simple::PullParser ();

use Texinfo::Convert::NodeNameNormalization qw(normalize_node);
use Texinfo::Parser qw(parse_texi_line parse_texi_text);
use Texinfo::Convert::Texinfo;
use Texinfo::Convert::TextContent;
use Texinfo::Common qw(protect_comma_in_tree protect_first_parenthesis
                       protect_hashchar_at_line_beginning);
use Texinfo::Transformations;

use vars qw(
  @ISA $VERSION
);

@ISA = ('Pod::Simple::PullParser');
$VERSION = '0.01';

#use UNIVERSAL ();

# Allows being called from the comand line as
# perl -w -MPod::Simple::Texinfo -e Pod::Simple::Texinfo::go thingy.pod
sub go { Pod::Simple::Texinfo->parse_from_file(@ARGV); exit 0 }

my %head_commands_level;
foreach my $level (1 .. 4) {
  $head_commands_level{'head'.$level} = $level;
}

my @numbered_sectioning_commands = ('part', 'chapter', 'section', 'subsection',
  'subsubsection');
my @appendix_sectioning_commands = ('part', 'appendix', 'appendixsec',
  'appendixsubsec', 'appendixsubsubsec');
my @unnumbered_sectioning_commands = ('part', 'unnumbered', 'unnumberedsec', 
  'unnumberedsubsec', 'unnumberedsubsubsec');

my @raw_formats = ('html', 'HTML', 'docbook', 'DocBook', 'texinfo',
                       'Texinfo');

# from other Pod::Simple modules.  Creates accessor subroutine.
__PACKAGE__->_accessorize(
  'texinfo_sectioning_base_level',
  'texinfo_short_title',
  'texinfo_man_url_prefix',
  'texinfo_sectioning_style',
  'texinfo_add_upper_sectioning_command',
  'texinfo_section_nodes',
  'texinfo_internal_pod_manuals',
);

my $sectioning_style = 'numbered';
#my $sectioning_base_level = 2;
my $sectioning_base_level = 0;
my $man_url_prefix = 'http://man.he.net/man';

sub new
{
  my $class = shift;
  my $new = $class->SUPER::new(@_);
  $new->accept_targets(@raw_formats);
  $new->preserve_whitespace(1);
  $new->texinfo_section_nodes(0);
  $new->texinfo_sectioning_base_level ($sectioning_base_level);
  $new->texinfo_man_url_prefix ($man_url_prefix);
  $new->texinfo_sectioning_style ($sectioning_style);
  $new->texinfo_add_upper_sectioning_command(1);
  return $new;
}

sub run
{
  my $self = shift;

  # In case the caller changed the formats
  my @formats = $self->accept_targets();
  foreach my $format (@formats) {
    if (lc($format) eq 'texinfo') {
      $self->{'texinfo_raw_format_commands'}->{$format} = '';
      $self->{'texinfo_if_format_commands'}->{':'.$format} = '';
    } else {
      $self->{'texinfo_raw_format_commands'}->{$format} = lc($format);
      $self->{'texinfo_if_format_commands'}->{':'.$format} = lc($format);
    }
  }
  my $base_level = $self->texinfo_sectioning_base_level;
  $base_level = 1 if ($base_level <= 1);
  if ($self->texinfo_sectioning_style eq 'numbered') {
    $self->{'texinfo_sectioning_commands'} = \@numbered_sectioning_commands;
  } elsif ($self->texinfo_sectioning_style eq 'unnumbered') {
    $self->{'texinfo_sectioning_commands'} = \@unnumbered_sectioning_commands;
  } else {
    $self->{'texinfo_sectioning_commands'} = \@appendix_sectioning_commands;
  }
  foreach my $heading_command (keys(%head_commands_level)) {
    my $level = $head_commands_level{$heading_command} + $base_level -1;
    if (!defined($self->{'texinfo_sectioning_commands'}->[$level])) {
      $self->{'texinfo_head_commands'}->{$heading_command}
        = $self->{'texinfo_sectioning_commands'}->[-1];
    } else {
      $self->{'texinfo_head_commands'}->{$heading_command}
        = $self->{'texinfo_sectioning_commands'}->[$level];
    }
  }
  $self->{'texinfo_internal_pod_manuals_hash'} = {};
  my $manuals = $self->texinfo_internal_pod_manuals();
  if ($manuals) {
    foreach my $manual (@$manuals) {
       $self->{'texinfo_internal_pod_manuals_hash'}->{$manual} = 1;
    }
  }

  if ($self->bare_output()) {
    $self->_convert_pod();
  } else {
    $self->_preamble();
    $self->_convert_pod();
    $self->_postamble(); 
  }
}

my $STDIN_DOCU_NAME = 'stdin';
sub _preamble($)
{
  my $self = shift;

  my $fh = $self->{'output_fh'};

  if (!defined($self->texinfo_short_title)) {
    my $short_title = $self->get_short_title();
    if (defined($short_title) and $short_title =~ m/\S/) {
      $self->texinfo_short_title($short_title);
    }
  }

  if ($self->texinfo_sectioning_base_level == 0) {
    #print STDERR "$fh\n";
    print $fh '\input texinfo'."\n";
    my $setfilename;
    if (defined($self->texinfo_short_title)) {
      $setfilename = _pod_title_to_file_name($self->texinfo_short_title);
    } else {
      # FIXME maybe output filename would be better than source_filename?
      my $source_filename = $self->source_filename();
      if (defined($source_filename) and $source_filename ne '') {
        if ($source_filename eq '-') {
          $setfilename = $STDIN_DOCU_NAME;
        } else {
          $setfilename = $source_filename;
          $setfilename =~ s/\.(pod|pm)$//i;
        }
      }
    }
    if (defined($setfilename) and $setfilename =~ m/\S/) {
      $setfilename = _protect_text($setfilename, 1);
      $setfilename .= '.info';
      print $fh "\@setfilename $setfilename\n\n"
    }
    # FIXME depend on =encoding
    print $fh '@documentencoding utf-8'."\n\n";

    my $title = $self->get_title();
    if (defined($title) and $title =~ m/\S/) {
      print $fh "\@settitle "._protect_text($title, 1)."\n\n";
    }
    print $fh "\@node Top\n";
    if (defined($self->texinfo_short_title)) {
       print $fh "\@top "._protect_text($self->texinfo_short_title, 1)."\n\n";
    }
  } elsif (defined($self->texinfo_short_title)
           and $self->texinfo_add_upper_sectioning_command) {
      my $level = $self->texinfo_sectioning_base_level() - 1;
      my $name = _protect_text($self->texinfo_short_title, 1);
      my $node_name = _prepare_anchor($self, $name);

      my $anchor = '';
      my $node = '';
      if ($node_name =~ /\S/) {
        if (!$self->texinfo_section_nodes 
            or $self->{'texinfo_sectioning_commands'}->[$level] eq 'part') {
          $anchor = "\@anchor{$node_name}\n";
        } else {
          $node = "\@node $node_name\n";
        }
      }
      print $fh "$node\@$self->{'texinfo_sectioning_commands'}->[$level] "
         ._protect_text($self->texinfo_short_title, 1)."\n$anchor\n";
  }
}

# 'out' is out of the context, for now for index entries.
sub _output($$$;$)
{
  my $fh = shift;
  my $accumulated_stack = shift;
  my $text = shift;
  my $out = shift;

  if (scalar(@$accumulated_stack)) {
    if ($out) {
      $accumulated_stack->[-1]->{'out'} .= $text;
    } else {
      $accumulated_stack->[-1]->{'text'} .= $text;
    }
  } else {
    print $fh $text;
  }
}

sub _begin_context($$)
{
  my $accumulated_stack = shift;
  my $tag = shift;
  push @$accumulated_stack, {'text' => '', 'tag' => $tag, 
                             'out' => ''};
}

sub _end_context($)
{
  my $accumulated_stack = shift;
  my $previous_context = pop @$accumulated_stack;
  return ($previous_context->{'text'}, $previous_context->{'out'});
}

sub _protect_text($;$)
{
  my $text = shift;
  my $remove_new_lines = shift;
  cluck if (!defined($text));
  $text =~ s/\n/ /g if ($remove_new_lines);
  $text =~ s/([\@\{\}])/\@$1/g;
  return $text;
}

sub _pod_title_to_file_name($)
{
  my $name = shift;
  $name =~ s/\s+/_/g;
  $name =~ s/::/-/g;
  $name =~ s/[^\w\.-]//g;
  $name = '_' if ($name eq '');
  return $name;
}

sub _protect_comma($)
{
  my $texinfo = shift;
  my $tree = parse_texi_line(undef, $texinfo);
  $tree = protect_comma_in_tree($tree);
  return Texinfo::Convert::Texinfo::convert($tree);
}

sub _protect_hashchar($)
{
  my $texinfo = shift;
  # protect # first in line
  if ($texinfo =~ /#/) {
    my $tree = parse_texi_text(undef, $texinfo);
    protect_hashchar_at_line_beginning(undef, $tree);
    return Texinfo::Convert::Texinfo::convert($tree);
  } else {
    return $texinfo;
  }
}

sub _reference_to_text_in_texi($)
{
  my $texinfo = shift;
  my $tree = parse_texi_text(undef, $texinfo);
  Texinfo::Transformations::reference_to_arg_in_tree(undef, $tree);
  return Texinfo::Convert::Texinfo::convert($tree);
}  

sub _section_manual_to_node_name($$$)
{
  my $self = shift;
  my $manual = shift;
  my $section = shift;
  my $base_level = shift;

  if (defined($manual) and $base_level > 0) {
    return _protect_text($manual, 1). " $section";
  } else {
    return $section;
  }
}

sub _normalize_texinfo_name($$)
{
  # Pod may be more forgiven than Texinfo, so we go through
  # a normalization, by parsing and converting back to Texinfo
  my $name = shift;
  my $command = shift;
  my $texinfo_text;
  if ($command eq 'anchor') {
    $texinfo_text = "\@anchor{$name}";
  } else {
    # item is not correct since it cannot happen outside of a table
    # context, so we use @center which accepts the same on the line
    if ($command eq 'item') {
      $command = 'center';
    }
    $texinfo_text = "\@$command $name\n";
  }
  my $tree = parse_texi_text(undef, $texinfo_text);
  if ($command eq 'anchor') {
    #print STDERR "GGG $tree->{'contents'}->[0]->{'cmdname'}\n";
    $tree->{'contents'}->[0]->{'args'}->[-0]->{'contents'}
      = protect_first_parenthesis($tree->{'contents'}->[0]->{'args'}->[-0]->{'contents'});
  }
  my $fixed_text = Texinfo::Convert::Texinfo::convert($tree, 1);
  my $result = $fixed_text;
  if ($command eq 'anchor') {
    $result =~ s/^\@anchor\{(.*)\}$/$1/s;
  } else {
    chomp($result);
    $result =~ s/^\@$command (.*)$/$1/s;
  }
  return $result;
}

sub _node_name($$)
{
  my $self = shift;
  my $texinfo_node_name = shift;

  chomp $texinfo_node_name;
  $texinfo_node_name 
     = $self->_section_manual_to_node_name($self->texinfo_short_title,
                                          $texinfo_node_name,
                                          $self->texinfo_sectioning_base_level);
  # also change refs to text
  return _reference_to_text_in_texi($texinfo_node_name);
}

sub _prepare_anchor($$)
{
  my $self = shift;
  my $texinfo_node_name = shift;

  my $node = _normalize_texinfo_name($texinfo_node_name, 'anchor');

  if ($node !~ /\S/) {
    return '';
  }
  # Now we know that we have something.
  my $node_tree = parse_texi_line(undef, $node);
  my $normalized_base = normalize_node($node_tree);
  my $normalized = $normalized_base;
  my $number_appended = 0;
  while ($self->{'texinfo_nodes'}->{$normalized}) {
    $number_appended++;
    $normalized = "${normalized_base}-$number_appended";
  }
  my $node_name;
  if ($number_appended) {
    $texinfo_node_name = "$node $number_appended";
    $node_tree = parse_texi_line(undef, $texinfo_node_name);
  }
  $node_tree = protect_comma_in_tree($node_tree);
  $self->{'texinfo_nodes'}->{$normalized} = $node_tree;
  my $final_node_name = Texinfo::Convert::Texinfo::convert($node_tree, 1);
  return $final_node_name;
}

# from Pod::Simple::HTML general_url_escape
sub _url_escape($)
{
  my $string = shift;

  $string =~ s/([^\x00-\xFF])/join '', map sprintf('%%%02X',$_), unpack 'C*', $1/eg;
     # express Unicode things as urlencode(utf(orig)).

  # A pretty conservative escaping, behoovey even for query components
  #  of a URL (see RFC 2396)

  $string =~ s/([^-_\.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',ord($1))/eg;
   # Yes, stipulate the list without a range, so that this can work right on
   #  all charsets that this module happens to run under.
   # Altho, hmm, what about that ord?  Presumably that won't work right
   #  under non-ASCII charsets.  Something should be done
   #  about that, I guess?

  return $string;
}

my %tag_commands = (
  'F' => 'file',
  'S' => 'w',
  'I' => 'emph',
  'B' => 'strong', # or @b?
  'C' => 'code'
);

my %environment_commands = (
  'Verbatim' => 'verbatim',
  'over-text' => 'table @asis',
  'over-bullet' => 'itemize',
  'over-number' => 'enumerate',
  'over-block' => 'quotation',
);

my %line_commands = (
  'item-bullet' => 'item',
  'item-text' => 'item',
  'item-number' => 'item',
  'encoding' => 'documentencoding'
);

foreach my $tag (keys(%head_commands_level)) {
  $line_commands{$tag} = 1;
}

my %tags_index_before;
my %context_tags;
foreach my $context_tag (keys(%line_commands), 'L', 'X', 'Para') {
  $context_tags{$context_tag} = 1;
}

# do not appear as parsed token
# E entity/character
sub _convert_pod($)
{
  my $self = shift;

  my $fh = $self->{'output_fh'};

  my ($token, $type, $tagname, $top_seen);

  my @accumulated_output;
  my @format_stack;
  while($token = $self->get_token()) {
    my $type = $token->type();
    #print STDERR "* type $type\n";
    #print STDERR $token->dump()."\n";
    if ($type eq 'start') {
      my $tagname = $token->tagname();
      if ($context_tags{$tagname}) {
        if ($tagname eq 'L') {
          my $linktype = $token->attr('type');
          my $content_implicit = $token->attr('content-implicit');
          #print STDERR " L: $linktype\n";
          #my @attrs = keys %{$token->attr_hash};
          #print STDERR "  @attrs\n";
          #my $raw_L = $token->attr('raw').'';
          #print STDERR " $token->attr('raw'): $raw_L\n";
          my ($url_arg, $texinfo_node, $texinfo_manual, $texinfo_section);
          if ($linktype eq 'man') {
            # NOTE: the .'' is here to force the $token->attr to ba a real
            # string and not an object.
            # NOTE 2: It is not clear that setting the url should be done
            # here, maybe this should be in the Texinfo HTML converter.
            # However, there is a 'man' category here and not in Texinfo,
            # so the information is more precise in pod.
            my $replacement_arg = $token->attr('to').'';
            # regexp from Pod::Simple::HTML resolve_man_page_link
            # since it is very small, it is likely that copyright cannot be
            # claimed for that part.
            $replacement_arg =~ /^([^(]+)(?:[(](\d+)[)])?$/;
            my $page = $1;
            my $section = $2;
            if (defined($page) and $page ne '') {
              $section = 1 if (!defined($section));
              # it is unlikely that there is a comma because of _url_escape
              # but to be sure there is still a call to _protect_comma.
              $url_arg 
                = _protect_comma(_protect_text(
                    $self->texinfo_man_url_prefix
                    ."$section/"._url_escape($page)));
            } else {
              $url_arg = '';
            }
            $replacement_arg = _protect_text($replacement_arg);
            _output($fh, \@accumulated_output, "\@url{$url_arg,, $replacement_arg}");
          } elsif ($linktype eq 'url') {
            # NOTE: the .'' is here to force the $token->attr to be a real
            # string and not an object.
            $url_arg = _protect_comma(_protect_text($token->attr('to').''));
          } elsif ($linktype eq 'pod') {
            my $manual = $token->attr('to');
            my $section = $token->attr('section');
            $manual .= '' if (defined($manual));
            $section .= '' if (defined($section));
            if (0) {
              my $section_text = 'UNDEF'; 
              if (defined($section)) {
                $section_text = $section;
              }
              my $manual_text = 'UNDEF';
              if (defined($manual)) {
                $manual_text = $manual;
              } 
              print STDERR "L: $linktype $manual_text/$section_text\n";
            }
            if (defined($manual)) {
              if (! defined($section) or $section !~ m/\S/) {
                if ($self->{'texinfo_internal_pod_manuals_hash'}->{$manual}) {
                  $section = 'NAME';
                }
              }
              if ($self->{'texinfo_internal_pod_manuals_hash'}->{$manual}) {
                $texinfo_node =
                 $self->_section_manual_to_node_name($manual, $section, 
                                     $self->texinfo_sectioning_base_level);
              } else {
                $texinfo_manual = _protect_text(_pod_title_to_file_name($manual));
                if (defined($section)) {
                  $texinfo_node = $section;
                } else {
                  $texinfo_node = '';
                }
              }
            } elsif (defined($section) and $section =~ m/\S/) {
              $texinfo_node =
               $self->_section_manual_to_node_name(
                                     $self->texinfo_short_title, $section, 
                                     $self->texinfo_sectioning_base_level);
              $texinfo_section = _normalize_texinfo_name(
                 _protect_comma(_protect_text($section)), 'section');
              #print STDERR "L: internal: $texinfo_node/$texinfo_section\n";
            }
            $texinfo_node = _normalize_texinfo_name(
                    _protect_comma(_protect_text($texinfo_node)), 'anchor');
            #print STDERR "L: normalized node: $texinfo_node\n";

            # for pod, 'to' is the pod manual name.  Then 'section' is the 
            # section.
          }
          push @format_stack, [$linktype, $content_implicit, $url_arg, 
                               $texinfo_manual, $texinfo_node, $texinfo_section];
          #if (defined($to)) {
          #  print STDERR " | $to\n";
          #} else { 
          #  print STDERR "\n";
          #}
          #print STDERR $token->dump."\n";
        }
        _begin_context(\@accumulated_output, $tagname);
      } elsif ($tag_commands{$tagname}) {
        _output($fh, \@accumulated_output, "\@$tag_commands{$tagname}\{");
      } elsif ($environment_commands{$tagname}) {
        _output($fh, \@accumulated_output, "\@$environment_commands{$tagname}\n");
        if ($tagname eq 'Verbatim') {
          push @format_stack, 'verbatim';
        }
      } elsif ($tagname eq 'for') {
        my $target = $token->attr('target');
        push @format_stack, $target;
        if ($self->{'texinfo_raw_format_commands'}->{$target}) {
          _output($fh, \@accumulated_output, 
             "\@$self->{'texinfo_raw_format_commands'}->{$target}\n");
        } elsif ($self->{'texinfo_if_format_commands'}->{$target}) {
          _output($fh, \@accumulated_output, 
             "\@if$self->{'texinfo_if_format_commands'}->{$target}\n");
        }
      }
    } elsif ($type eq 'text') {
      my $text;
      if (@format_stack and !ref($format_stack[-1])
          and ((defined($self->{'texinfo_raw_format_commands'}->{$format_stack[-1]})
                and !$self->{'texinfo_raw_format_commands'}->{$format_stack[-1]})
               or ($format_stack[-1] eq 'verbatim'))) {
        $text = $token->text();
      } else {
        $text = _protect_text($token->text());
        if (@format_stack and !ref($format_stack[-1])
            and ($self->{'texinfo_raw_format_commands'}->{$format_stack[-1]})) {
          $text =~ s/^(\s*)#(\s*(line)? (\d+)(( "([^"]+)")(\s+\d+)*)?\s*)$/$1\@hashchar{}$2/mg;
        }
      }
      _output($fh, \@accumulated_output, $text);
    } elsif ($type eq 'end') {
      my $tagname = $token->tagname();
      if ($context_tags{$tagname}) {
        my ($result, $out) = _end_context(\@accumulated_output);
        #print STDERR "end: $tagname: $result, $out\n";
        my $texinfo_node = '';
        if ($line_commands{$tagname}) {

          my ($command, $command_argument);
          if ($head_commands_level{$tagname}) {
            $command = $self->{'texinfo_head_commands'}->{$tagname};
          } elsif ($line_commands{$tagname}) {
            $command = $line_commands{$tagname};
          }

          if ($head_commands_level{$tagname} or $tagname eq 'item-text') {
            chomp ($result);
            $result =~ s/\n/ /g;
            $result =~ s/^\s*//;
            $result =~ s/\s*$//;

            $command_argument = _normalize_texinfo_name($result, $command);
            if ($result =~ /\S/ and $command_argument !~ /\S/) {
              # use some raw text if the expansion lead to an empty section
              my $tree = parse_texi_line(undef, $result);
              my $converter = Texinfo::Convert::TextContent->converter();
              $command_argument = _protect_text($converter->convert_tree($tree));
            }

            my $anchor = '';
            my $node_name = _prepare_anchor($self, _node_name($self, $result));
            if ($node_name =~ /\S/) {
              if ($tagname eq 'item-text' or !$self->texinfo_section_nodes) {
                $anchor = "\n\@anchor{$node_name}";
              } else {
                $texinfo_node = "\@node $node_name\n";
              }
            }
            $command_argument .= $anchor;
          } else {
            $command_argument = $result;
          }
          _output($fh, \@accumulated_output, 
                  "$texinfo_node\@$command $command_argument\n$out\n");
        } elsif ($tagname eq 'Para') {
          _output($fh, \@accumulated_output, $out.
                                   _protect_hashchar($result)."\n\n");
        } elsif ($tagname eq 'L') {
          my $format = pop @format_stack;
          my ($linktype, $content_implicit, $url_arg, 
              $texinfo_manual, $texinfo_node, $texinfo_section) = @$format;
          if ($linktype ne 'man') {
            my $explanation;
            if (defined($result) and $result =~ m/\S/ and !$content_implicit) {
              $explanation = ' '. _protect_comma($result);
            }
            if ($linktype eq 'url') {
              if (defined($explanation)) {
                _output($fh, \@accumulated_output, 
                         "\@url{$url_arg,$explanation}");
              } else {
                _output($fh, \@accumulated_output, 
                         "\@url{$url_arg}");
              }
            } elsif ($linktype eq 'pod') {
              if (defined($texinfo_manual)) {
                $explanation = '' if (!defined($explanation));
                _output($fh, \@accumulated_output,
                         "\@ref{$texinfo_node,$explanation,, $texinfo_manual}");
              } elsif (defined($explanation)) {
                _output($fh, \@accumulated_output,
                       "\@ref{$texinfo_node,$explanation,$explanation}");
              } else {
                if (defined($texinfo_section) 
                    and $texinfo_section ne $texinfo_node) {
                  _output($fh, \@accumulated_output,
                           "\@ref{$texinfo_node,, $texinfo_section}");
                } else {
                  _output($fh, \@accumulated_output,
                           "\@ref{$texinfo_node}");
                }
              }
            }
          }
        } elsif ($tagname eq 'X') {
          my $next_token = $self->get_token();
          if ($next_token) {
            if ($next_token->type() eq 'text') {
              my $next_text = $next_token->text;
              $next_text =~ s/^\s*//;
              $next_token->text($next_text);
              #_output($fh, \@accumulated_output, "\n");
            }
            $self->unget_token($next_token);
          }
          chomp ($result);
          $result =~ s/\n/ /g;
          $result .= "\n";
          _output($fh, \@accumulated_output, "\@cindex $result", 1);
        }
      } elsif ($tag_commands{$tagname}) {
        _output($fh, \@accumulated_output, "}");
      } elsif ($environment_commands{$tagname}) {
        if ($tagname eq 'Verbatim') {
          pop @format_stack;
          _output($fh, \@accumulated_output, "\n");
        }
        my $tag = $environment_commands{$tagname};
        $tag =~ s/ .*//;
        _output($fh, \@accumulated_output, "\@end $tag\n\n");
      } elsif ($tagname eq 'for') {
        my $target = pop @format_stack;
        if ($self->{'texinfo_raw_format_commands'}->{$target}) {
          _output($fh, \@accumulated_output, 
                  "\n\@end $self->{'texinfo_raw_format_commands'}->{$target}\n");
        } elsif ($self->{'texinfo_if_format_commands'}->{$target}) {
          _output($fh, \@accumulated_output, 
                  "\@end if$self->{'texinfo_if_format_commands'}->{$target}\n");
        }
      }
    }
  }
}

sub _postamble($)
{
  my $self = shift;

  my $fh = $self->{'output_fh'};
  if ($self->texinfo_sectioning_base_level == 0) {
    #print STDERR "$fh\n";
    print $fh "\@bye\n";
  }
}

1;

__END__

=head1 NAME

Pod::Simple::Texinfo - format Pod as Texinfo

=head1 SYNOPSIS

  # From the command like
  perl -MPod::Simple::Texinfo -e Pod::Simple::Texinfo::go thingy.pod

  # From perl
  my $new = Pod::Simple::Texinfo->new;
  $new->texinfo_sectioning_style('unnumbered');
  my $from = shift @ARGV;
  my $to = $from;
  $to =~ s/\.(pod|pm)$/.texi/i;
  $new->parse_from_file($from, $to);

=head1 DESCRIPTION

This class is for making a Texinfo rendering of a Pod document.

This is a subclass of L<Pod::Simple::PullParser> and inherits all its
methods (and options).

It supports producing a standalone manual per Pod (the default) or 
render the Pod as a chapter, see L</texinfo_sectioning_base_level>.

=head1 METHODS

=over

=item texinfo_sectioning_base_level

Sets the level of the head1 commands.  1 is for the @chapter/@unnumbered 
level.  If set to 0, the head1 commands level is still 1, but the output 
manual is considered to be a standalone manual.  If not 0, the pod file is 
rendered as a fragment of a Texinfo manual.

=item texinfo_man_url_prefix

String used as a prefix for man page urls.  Default 
is C<http://man.he.net/man>.

=item texinfo_sectioning_style

Default is C<numbered>, using the numbered sectioning Texinfo @-commands
(@chapter, @section...).  Giving C<unnumbered> leads to using unnumbered
sectioning command variants (@unnumbered...), and any other value would
lead to using appendix sectioning command variants (@appendix...).

=item texinfo_add_upper_sectioning_command

If set (the default case), a sectioning command is added at the beginning 
of the output for the whole document, using the module name, at the level
above the level set by L<texinfo_sectioning_base_level>.  So there will be
a C<@part> if the level is equal to 1, a C<@chapter> if the level is equal
to 2 and so on and so forth.  If the base level is 0, a C<@top> command is 
output instead.

=item texinfo_section_nodes

If set, add C<@node> and not C<@anchor> for each sectioning command.

=back

=head1 SEE ALSO

L<Pod::Simple>. L<Pod::Simple::PullParser>. The Texinfo manual.

=head1 COPYRIGHT

Copyright (C) 2011, 2012 Free Software Foundation, Inc.

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License,
or (at your option) any later version.

C<_url_escape> is C<general_url_escape> from L<Pod::Simple::HTML>.

=head1 AUTHOR

Patrice Dumas E<lt>pertusus@free.frE<gt>.  Parts from L<Pod::Simple::HTML>.

=cut