texinfo/tp/DebugTexinfo/DebugTree.pm

# DebugTexinfo::DebugTree.pm: debug a Texinfo::Parser tree.
#
# Copyright 2011, 2012, 2013 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>

# Example of calls
# with creation of elements corresponding to sections:
# ./texi2any.pl --set TEXINFO_OUTPUT_FORMAT=debugtree --set USE_NODES=0 file.texi
# with creation of elements corresponding to nodes:
# ./texi2any.pl --set TEXINFO_OUTPUT_FORMAT=debugtree --set USE_NODES=1 file.texi
# no elements
# ./texi2any.pl --set TEXINFO_OUTPUT_FORMAT=debugtree file.texi
# 
# Some unofficial info about the --debug command line option ... with
# --debug=1, the tree is not printed,
# --debug=10 (or more), the tree is printed at the end of the run,
# --debug=100 (or more), the tree is printed at each newline.


use Texinfo::Convert::Converter;

package DebugTexinfo::DebugTree;

@ISA = qw(Texinfo::Convert::Converter);

my %defaults = (
  'EXTENSION' => 'debugtree',
  'OUTFILE' => '-',
);

sub converter_defaults($$)
{
  return %defaults;
}

sub output($$)
{
  my $self = shift;
  my $root = shift;


  $self->_set_outfile();
  return undef unless $self->_create_destination_directory();

  my $fh;
  if (! $self->{'output_file'} eq '') {
    $fh = $self->Texinfo::Common::open_out ($self->{'output_file'});
    if (!$fh) {
      $self->document_error(sprintf($self->__("could not open %s for writing: %s"),
                                    $self->{'output_file'}, $!));
      return undef;
    }
  }

  my $elements;
  if ($self) {
    if ($self->get_conf('USE_NODES')) {
      $elements = Texinfo::Structuring::split_by_node($root);
    } elsif (defined($self->get_conf('USE_NODES'))) {
      #print STDERR "U sections\n";
      $elements = Texinfo::Structuring::split_by_section($root);
    }
    # Currently the information added is not used further.
    if ($elements and ($self->get_conf('SPLIT') 
                       or !$self->get_conf('MONOLITHIC'))) {
      #print STDERR "S ".$self->get_conf('SPLIT')."\n";
      Texinfo::Structuring::split_pages($elements,
                                        $self->get_conf('SPLIT'));
    }
  }
  if ($elements) {
    $root = {'type' => 'elements_root',
             'contents' => $elements };
  }
  return $self->_output_text (_print_tree($self, $root), $fh);
}

sub convert($$)
{
  my $self = shift;
  my $root = shift;

  return _print_tree($self, $root);
}

sub convert_tree($$)
{
  my $self = shift;
  my $root = shift;

  return _print_tree($self, $root);
}

sub _print_tree($$;$$);

sub _print_tree($$;$$)
{
  my $self = shift;
  my $root = shift;
  my $level = shift;
  my $argument = shift;
  $level = 0 if (!defined($level));

  my $result = ' ' x $level;
  if ($argument) {
    $result .= '%';
    $level++;
  }
  if ($root->{'cmdname'}) {
    $result .= "\@$root->{'cmdname'} ";
  }
  if (defined($root->{'type'})) {
    $result .= "$root->{'type'} ";
  }
  if (defined($root->{'text'})) {
    my $text = $root->{'text'};
    $text =~ s/\n/\\n/g;
    $text =~ s/\f/\\f/g;
    $text =~ s/\r/\\r/g;
    $result .= "|$text|";
  }
  $result .= "\n";
  if ($root->{'args'}) {
    foreach my $arg (@{$root->{'args'}}) {
      $result .= _print_tree ($self, $arg, $level +1, 1);
    }
  }
  if ($root->{'contents'}) {
    foreach my $content (@{$root->{'contents'}}) {
      $result .= _print_tree ($self, $content, $level+1);
    }
  }
  return $result;
}