code:
# Transformations.pm: some transformations of the document tree
#
# Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016 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 (also from Patrice Dumas) come from texi2html.pl.

package Texinfo::Transformations;

use 5.00405;

use strict;

use Texinfo::Common;
use Texinfo::Structuring;

# Add raise/lowersections to be back at the normal level
sub _correct_level($$;$)
{
  my $section = shift;
  my $parent = shift;
  my $modifier = shift;
  $modifier = 1 if (!defined($modifier));

  my @result;
  if ($section->{'extra'} and $section->{'extra'}->{'sections_level'}) {
    my $level_to_remove = $modifier * $section->{'extra'}->{'sections_level'};
    my $command;
    if ($level_to_remove < 0) {
      $command = 'raisesection';
    } else {
      $command = 'lowersection';
    }
    my $remaining_level = abs($level_to_remove);
    while ($remaining_level) {
      push @result, {'cmdname' => $command,
                     'parent' => $parent};
      push @result, {'type' => 'empty_line', 'text' => "\n",
                     'parent' => $parent};
      $remaining_level--;
    }
  }
  return @result;
}

sub fill_gaps_in_sectioning($)
{
  my $root = shift;
  if (!$root->{'type'} or $root->{'type'} ne 'document_root'
      or !$root->{'contents'}) {
    return undef;
  }
  my @sections_list;
  foreach my $content (@{$root->{'contents'}}) {
    if ($content->{'cmdname'} and $content->{'cmdname'} ne 'node'
        and $content->{'cmdname'} ne 'bye') {
      push @sections_list, $content;
    }
  }

  return (undef, undef) if (!scalar(@sections_list));

  my @added_sections;
  my @contents;
  my $previous_section;
  foreach my $content(@{$root->{'contents'}}) {
    push @contents, $content;
    if (!@sections_list or $sections_list[0] ne $content) {
      next;
    }
    my $current_section = shift @sections_list;
    my $current_section_level = $current_section->{'level'};
    my $next_section = $sections_list[0];

    if (defined($next_section)) {
      my $next_section_level = $next_section->{'level'};
      if ($next_section_level - $current_section_level > 1) {
        my @correct_level_offset_commands = _correct_level($next_section,
                                                          $contents[-1]);
        if (@correct_level_offset_commands) {
          push @{$contents[-1]->{'contents'}}, @correct_level_offset_commands;
        }
        #print STDERR "* $current_section_level "._print_root_command_texi($current_section)."\n";
        #print STDERR "  $next_section_level "._print_root_command_texi($next_section)."\n";
        while ($next_section_level - $current_section_level > 1) {
          $current_section_level++;
          my $new_section = {'cmdname' =>
            $Texinfo::Common::level_to_structuring_command{'unnumbered'}->[$current_section_level],
            'parent' => $root,
          };
          $new_section->{'contents'} = [{'type' => 'empty_line',
                                         'text' => "\n",
                                         'parent' => $new_section}];
          $new_section->{'args'} = [{'type' => 'misc_line_arg',
                                     'parent' => $new_section}];
          $new_section->{'args'}->[0]->{'contents'} = [
             {'type' => 'empty_spaces_after_command',
              'text' => " ",
              'extra' => {'command' => $new_section},
              'parent' => $new_section->{'args'}->[0]
             },
             {'cmdname' => 'asis',
              'parent' => $new_section->{'args'}->[0]
             },
             {'type' => 'spaces_at_end',
              'text' => "\n",
              'parent' => $new_section->{'args'}->[0]
             }];
          $new_section->{'args'}->[0]->{'contents'}->[1]->{'args'}
             = [{'type' => 'brace_command_arg',
                 'contents' => [],
                 'parent' => $new_section->{'args'}->[0]->{'contents'}->[1]}];
          my @misc_contents = @{$new_section->{'args'}->[0]->{'contents'}};
          Texinfo::Common::trim_spaces_comment_from_content(\@misc_contents);
          $new_section->{'extra'}->{'misc_content'} = \@misc_contents;
          push @contents, $new_section;
          push @added_sections, $new_section;
          #print STDERR "  -> "._print_root_command_texi($new_section)."\n";
        }
        my @set_level_offset_commands = _correct_level($next_section,
                                                       $contents[-1], -1);
        if (@set_level_offset_commands) {
          push @{$contents[-1]->{'contents'}}, @set_level_offset_commands;
        }
      }
    }
  }
  return (\@contents, \@added_sections);
}

sub _reference_to_arg($$$)
{
  my $self = shift;
  my $type = shift;
  my $current = shift;

  if ($current->{'cmdname'} and
      $Texinfo::Common::ref_commands{$current->{'cmdname'}}
      and $current->{'extra'}
      and $current->{'extra'}->{'brace_command_contents'}) {
    my @args_try_order;
    if ($current->{'cmdname'} eq 'inforef') {
      @args_try_order = (0, 1, 2);
    } else {
      @args_try_order = (0, 1, 2, 4, 3);
    }
    foreach my $index (@args_try_order) {
      if (defined($current->{'args'}->[$index])
          and defined($current->{'extra'}->{'brace_command_contents'}->[$index])) {
        # This a double checking that there is some content.
        # Not sure that it is useful.
        my $text = Texinfo::Convert::Text::convert($current->{'args'}->[$index]);
        if (defined($text) and $text =~ /\S/) {
          my $result = {'contents' =>
                $current->{'extra'}->{'brace_command_contents'}->[$index],
                        'parent' => $current->{'parent'}};
          return ($result);
        }
      }
    }
    return {'text' => '', 'parent' => $current->{'parent'}};
  } else {
    return ($current);
  }
}

sub reference_to_arg_in_tree($$)
{
  my $self = shift;
  my $tree = shift;
  return Texinfo::Common::modify_tree($self, $tree, \&_reference_to_arg);
}

# prepare a new node and register it
sub _new_node($$)
{
  my $self = shift;
  my $node_tree = shift;

  $node_tree = Texinfo::Common::protect_comma_in_tree($node_tree);
  $node_tree->{'contents'}
     = Texinfo::Common::protect_first_parenthesis($node_tree->{'contents'});
  $node_tree = reference_to_arg_in_tree($self, $node_tree);

  my $empty_node = 0;
  if (!$node_tree->{'contents'}
      or !scalar(@{$node_tree->{'contents'}})) {
    $node_tree->{'contents'} = [{'text' => ''}];
    $empty_node = 1;
  }

  unless (($node_tree->{'contents'}->[-1]->{'cmdname'}
       and ($node_tree->{'contents'}->[-1]->{'cmdname'} eq 'c'
            or $node_tree->{'contents'}->[-1]->{'cmdname'} eq 'comment'))
      or (defined($node_tree->{'contents'}->[-1]->{'text'})
          and $node_tree->{'contents'}->[-1]->{'text'} =~ /\n/)) {
    push @{$node_tree->{'contents'}},
           {'type' => 'spaces_at_end', 'text' => "\n"};
  }

  my $appended_number = 0 +$empty_node;
  my ($node, $parsed_node);

  while (!defined($node)
         or ($self->{'labels'}
            and $self->{'labels'}->{$parsed_node->{'normalized'}})) {
    $node = {'cmdname' => 'node', 'args' => [{}]};
    my $node_arg = $node->{'args'}->[0];
    $node_arg->{'parent'} = $node;
    @{$node_arg->{'contents'}} = (
       {'extra' => {'command' => $node},
        'text' => ' ',
        'type' => 'empty_spaces_after_command'},
        @{$node_tree->{'contents'}});
    if ($appended_number) {
      splice (@{$node_arg->{'contents'}}, -1, 0,
                  {'text' => " $appended_number"});
    }
    foreach my $content (@{$node_arg->{'contents'}}) {
      $content->{'parent'} = $node_arg;
    }
    $parsed_node = Texinfo::Parser::_parse_node_manual($node_arg);
    if ($parsed_node and $parsed_node->{'node_content'}) {
      $parsed_node->{'normalized'} =
      Texinfo::Convert::NodeNameNormalization::normalize_node (
        { 'contents' => $parsed_node->{'node_content'} });
    }
    if (!defined($parsed_node) or !$parsed_node->{'node_content'}
        or $parsed_node->{'normalized'} !~ /[^-]/) {
      if ($appended_number) {
        return undef;
      } else {
        $node = undef;
      }
    }
    $appended_number++;
  }

  push @{$node->{'extra'}->{'nodes_manuals'}}, $parsed_node;
  if ($parsed_node->{'normalized'} ne '') {
    $self->{'labels'}->{$parsed_node->{'normalized'}} = $node;
    $node->{'extra'}->{'normalized'} = $parsed_node->{'normalized'};
  }
  if (!Texinfo::Parser::_register_label($self, $node, $parsed_node, undef)) {
    print STDERR "BUG: node unique, register failed:  $parsed_node->{'normalized'}\n";
  }
  push @{$self->{'nodes'}}, $node;
  return $node;
}

# reassociate a tree element to the new node, from previous node
sub _reassociate_to_node($$$$)
{
  my $self = shift;
  my $type = shift;
  my $current = shift;
  my $nodes = shift;
  my ($new_node, $previous_node) = @{$nodes};

  if ($current->{'cmdname'} and $current->{'cmdname'} eq 'menu') {
    if ($previous_node) {
      if (!$previous_node->{'menus'} or !@{$previous_node->{'menus'}}
           or !grep {$current eq $_} @{$previous_node->{'menus'}}) {
        print STDERR "Bug: menu $current not in previous node $previous_node\n";
      } else {
        @{$previous_node->{'menus'}} = grep {$_ ne $current} @{$previous_node->{'menus'}};
        delete $previous_node->{'menus'} if !(@{$previous_node->{'menus'}});
      }
    } else {
      my $info = $self->global_informations();
      if (!$info or !$info->{'unassociated_menus'}
          or !@{$info->{'unassociated_menus'}}
          or !grep {$current eq $_} @{$info->{'unassociated_menus'}}) {
        print STDERR "Bug: menu $current not in unassociated menus\n";
      } else {
        @{$info->{'unassociated_menus'}}
          = grep {$_ ne $current} @{$info->{'unassociated_menus'}};
        delete $info->{'unassociated_menus'} if !(@{$info->{'unassociated_menus'}});
      }
    }
    push @{$new_node->{'menus'}}, $current;
  } elsif ($current->{'extra'} and $current->{'extra'}->{'index_entry'}) {
    if ($previous_node
        and (!$current->{'extra'}->{'index_entry'}->{'node'}
             or $current->{'extra'}->{'index_entry'}->{'node'} ne $previous_node)) {
      print STDERR "Bug: index entry $current (".
        Texinfo::Convert::Texinfo::convert ({'contents' => $current->{'extra'}->{'index_entry'}->{'content'}})
         .") not in previous node $previous_node\n";
      print STDERR "  previous node: "._print_root_command_texi($previous_node)."\n";
      if ($current->{'extra'}->{'index_entry'}->{'node'}) {
        print STDERR "  current node: ".
         _print_root_command_texi($current->{'extra'}->{'index_entry'}->{'node'})."\n";
      } else {
        print STDERR "  current node not set\n";
      }
    }
    $current->{'extra'}->{'index_entry'}->{'node'} = $new_node;
  }
  return ($current);
}

sub insert_nodes_for_sectioning_commands($$)
{
  my $self = shift;
  my $root = shift;
  if (!$root->{'type'} or $root->{'type'} ne 'document_root'
      or !$root->{'contents'}) {
    return (undef, undef);
  }
  my @added_nodes;
  my @contents;
  my $previous_node;
  foreach my $content (@{$root->{'contents'}}) {
    if ($content->{'cmdname'} and $content->{'cmdname'} ne 'node'
        and $content->{'cmdname'} ne 'bye'
        and $content->{'cmdname'} ne 'part'
        and not ($content->{'extra'}
                 and $content->{'extra'}->{'associated_node'})) {
      my $new_node_tree;
      if ($content->{'cmdname'} eq 'top') {
        $new_node_tree = {'contents' => [{'text' => 'Top'}]};
      } else {
        $new_node_tree = Texinfo::Common::copy_tree({'contents'
          => $content->{'extra'}->{'misc_content'}});
      }
      my $new_node = _new_node($self, $new_node_tree);
      if (defined($new_node)) {
        push @contents, $new_node;
        push @added_nodes, $new_node;
        $new_node->{'extra'}->{'associated_section'} = $content;
        $content->{'extra'}->{'associated_node'} = $new_node;
        $new_node->{'parent'} = $content->{'parent'};
        # reassociate index entries and menus
        Texinfo::Common::modify_tree($self, $content, \&_reassociate_to_node,
                                     [$new_node, $previous_node]);
      }
    }
    # check normalized to avoid erroneous nodes, such as duplicates
    $previous_node = $content
      if ($content->{'cmdname'}
          and $content->{'cmdname'} eq 'node'
          and $content->{'extra'}->{'normalized'});
    push @contents, $content;
  }
  return (\@contents, \@added_nodes);
}

sub complete_node_menu($$)
{
  my $self = shift;
  my $node = shift;

  my @node_childs;
  if ($node->{'extra'}->{'associated_section'}->{'section_childs'}) {
    foreach my $child (@{$node->{'extra'}->{'associated_section'}->{'section_childs'}}) {
      if ($child->{'extra'} and $child->{'extra'}->{'associated_node'}) {
        push @node_childs, $child->{'extra'}->{'associated_node'};
      }
    }
  }
  # Special case for @top.  Gather all the children of the @part following
  # @top.
  if ($node->{'extra'}->{'associated_section'}->{'cmdname'} eq 'top') {
    my $current = $node->{'extra'}->{'associated_section'};
    while ($current->{'section_next'}) {
      $current = $current->{'section_next'};
      if ($current->{'cmdname'} and $current->{'cmdname'} eq 'part'
          and $current->{'section_childs'}) {
        foreach my $child (@{$current->{'section_childs'}}) {
          if ($child->{'extra'} and $child->{'extra'}->{'associated_node'}) {
            push @node_childs, $child->{'extra'}->{'associated_node'};
          }
        }
      } elsif ($current->{'extra'}->{'associated_node'}) {
        # for @appendix, and what follows, as it stops a @part, but is
        # not below @top
        push @node_childs, $current->{'extra'}->{'associated_node'};
      }
    }
  }
  if (scalar(@node_childs)) {
    my %existing_entries;
    if ($node->{'menus'} and @{$node->{'menus'}}) {
      foreach my $menu (@{$node->{'menus'}}) {
        foreach my $entry (@{$menu->{'contents'}}) {
          if ($entry->{'type'} and $entry->{'type'} eq 'menu_entry') {
            my $entry_node = $entry->{'extra'}->{'menu_entry_node'};
            if (! $entry_node->{'manual_content'}
                and defined($entry_node->{'normalized'})) {
              $existing_entries{$entry_node->{'normalized'}}
                = [$menu, $entry];
            }
          }
        }
      }
    }
    #print STDERR join('|', keys(%existing_entries))."\n";
    my @pending;
    my $current_menu;
    foreach my $node_entry (@node_childs) {
      if ($existing_entries{$node_entry->{'extra'}->{'normalized'}}) {
        my $entry;
        ($current_menu, $entry)
         = @{$existing_entries{$node_entry->{'extra'}->{'normalized'}}};
        if (@pending) {
          my $index;
          for ($index = 0; $index < scalar(@{$current_menu->{'contents'}}); $index++) {
            #print STDERR "$index, ".scalar(@{$current_menu->{'contents'}})."\n";
            last if ($current_menu->{'contents'}->[$index] eq $entry);
          }
          splice (@{$current_menu->{'contents'}}, $index, 0, @pending);
          foreach my $entry (@pending) {
            $entry->{'parent'} = $current_menu;
          }
          @pending = ();
        }
      } else {
        my $entry = Texinfo::Structuring::new_node_menu_entry($self,
                              $node_entry->{'extra'}->{'node_content'});
        push @pending, $entry;
      }
    }
    if (scalar(@pending)) {
      if (!$current_menu) {
        my $section = $node->{'extra'}->{'associated_section'};
        $current_menu =
       Texinfo::Structuring::new_block_command (\@pending, $section, 'menu');
        push @{$section->{'contents'}}, $current_menu;
        push @{$section->{'contents'}}, {'type' => 'empty_line',
                                         'text' => "\n",
                                         'parent' => $section};
        push @{$node->{'menus'}}, $current_menu;
      } else {
        foreach my $entry (@pending) {
          $entry->{'parent'} = $current_menu;
        }
        my $end;
        if ($current_menu->{'contents'}->[-1]->{'cmdname'}
            and $current_menu->{'contents'}->[-1]->{'cmdname'} eq 'end') {
          $end = pop @{$current_menu->{'contents'}};
        }
        push @{$current_menu->{'contents'}}, @pending;
        push @{$current_menu->{'contents'}}, $end if ($end);
      }
    }
  }
}

# This should be called after Texinfo::Structuring::sectioning_structure.
sub complete_tree_nodes_menus($$)
{
  my $self = shift;
  my $root = shift;
  if (!$root->{'type'} or $root->{'type'} ne 'document_root'
      or !$root->{'contents'}) {
    return undef;
  }
  foreach my $content (@{$root->{'contents'}}) {
    if ($content->{'cmdname'} and $content->{'cmdname'} eq 'node'
        and (scalar(@{$content->{'extra'}->{'nodes_manuals'}}) == 1)
        and $content->{'extra'}
        and $content->{'extra'}->{'associated_section'}) {
      complete_node_menu($self, $content);
    }
  }
}

sub _copy_contents($)
{
  my $contents = shift;
  my $copy = Texinfo::Common::copy_tree({'contents' => $contents});
  return $copy->{'contents'};
}

sub _print_down_menus($$;$);
sub _print_down_menus($$;$)
{
  my $self = shift;
  my $node = shift;
  my $labels = shift;
  $labels = $self->labels_information() if (!defined($labels));

  my @master_menu_contents;

  if ($node->{'menus'} and scalar(@{$node->{'menus'}})) {
    my @node_children;
    foreach my $menu (@{$node->{'menus'}}) {
      foreach my $entry (@{$menu->{'contents'}}) {
        if ($entry->{'type'} and $entry->{'type'} eq 'menu_entry') {
          push @master_menu_contents, Texinfo::Common::copy_tree($entry);
          # gather node children to recusrsively print their menus
          my $entry_node = $entry->{'extra'}->{'menu_entry_node'};
          if (! $entry_node->{'manual_content'}
              and defined($entry_node->{'normalized'})) {
            my $node = $labels->{$entry_node->{'normalized'}};
            if (defined($node) and $node->{'extra'}) {
              push @node_children, $node;
            }
          }
        }
      }
    }
    if (scalar(@master_menu_contents)) {
      # Prepend node title
      my $node_title_contents;
      if ($node->{'extra'}->{'associated_section'}
          and $node->{'extra'}->{'associated_section'}->{'extra'}
          and $node->{'extra'}->{'associated_section'}->{'extra'}->{'misc_content'}) {
        $node_title_contents
          = _copy_contents($node->{'extra'}->{'associated_section'}->{'extra'}->{'misc_content'});
      } else {
        $node_title_contents = _copy_contents($node->{'extra'}->{'node_content'});
      }
      my $menu_comment = {'type' => 'menu_comment'};
      $menu_comment->{'contents'}->[0] = {'type' => 'preformatted',
                                          'parent' => $menu_comment};

      $menu_comment->{'contents'}->[0]->{'contents'}
        = [{'text' => "\n", 'type' => 'empty_line'}, @$node_title_contents,
           {'text' => "\n", 'type' => 'empty_line'},
           {'text' => "\n", 'type' => 'empty_line'}];
      foreach my $content (@{$menu_comment->{'contents'}->[0]->{'contents'}}) {
        $content->{'parent'} = $menu_comment->{'contents'}->[0];
      }
      unshift @master_menu_contents, $menu_comment;

      # now recurse in the children
      foreach my $child (@node_children) {
        push @master_menu_contents, _print_down_menus($self, $child, $labels);
      }
    }
  }
  return @master_menu_contents;
}

sub new_master_menu($;$)
{
  my $self = shift;
  my $labels = shift;
  $labels = $self->labels_information() if (!defined($labels));
  my $node = $labels->{'Top'};
  return undef if (!defined($node));

  my @master_menu_contents;
  if ($node->{'menus'} and scalar(@{$node->{'menus'}})) {
    foreach my $menu (@{$node->{'menus'}}) {
      foreach my $entry (@{$menu->{'contents'}}) {
        if ($entry->{'type'} and $entry->{'type'} eq 'menu_entry') {
          my $entry_node = $entry->{'extra'}->{'menu_entry_node'};
          if (! $entry_node->{'manual_content'}
              and defined($entry_node->{'normalized'})) {
            my $node = $labels->{$entry_node->{'normalized'}};
            if (defined($node) and $node->{'extra'}) {
              push @master_menu_contents, _print_down_menus($self,
                                                            $node, $labels);
            }
          }
        }
      }
    }
  }
  if (scalar(@master_menu_contents)) {
    my $first_preformatted = $master_menu_contents[0]->{'contents'}->[0];
    my $master_menu_title = $self->gdt(' --- The Detailed Node Listing ---');
    my @master_menu_title_contents;
    foreach my $content (@{$master_menu_title->{'contents'}}, {'text' => "\n"}) {
      $content->{'parent'} = $first_preformatted;
      push @master_menu_title_contents, $content;
    }
    unshift @{$first_preformatted->{'contents'}}, @master_menu_title_contents;
    return Texinfo::Structuring::new_block_command(\@master_menu_contents, undef, 'detailmenu');
  } else {
    return undef;
  }
}

sub regenerate_master_menu($;$)
{
  my $self = shift;
  my $labels = shift;
  $labels = $self->labels_information() if (!defined($labels));
  my $top_node = $labels->{'Top'};
  return undef if (!defined($top_node));

  my $new_master_menu = new_master_menu($self, $labels);
  return undef if (!defined($new_master_menu) or !$top_node->{'menus'}
                   or !scalar(@{$top_node->{'menus'}}));

  foreach my $menu (@{$top_node->{'menus'}}) {
    my $detailmenu_index = 0;
    foreach my $entry (@{$menu->{'contents'}}) {
      if ($entry->{'cmdname'} and $entry->{'cmdname'} eq 'detailmenu') {
        # replace existing detailmenu by the master menu
        $new_master_menu->{'parent'} = $menu;
        splice (@{$menu->{'contents'}}, $detailmenu_index, 1,
                $new_master_menu);
        return 1;
      }
      $detailmenu_index++;
    }
  }

  my $last_menu = $top_node->{'menus'}->[-1];
  my $index = scalar(@{$last_menu->{'contents'}});
  if ($index
      and $last_menu->{'contents'}->[$index-1]->{'cmdname'}
      and $last_menu->{'contents'}->[$index-1]->{'cmdname'} eq 'end') {
    $index --;
  }
  $new_master_menu->{'parent'} = $last_menu;
  if ($index
      and $last_menu->{'contents'}->[$index-1]->{'type'}
      and $last_menu->{'contents'}->[$index-1]->{'type'} eq 'menu_comment'
      and $last_menu->{'contents'}->[$index-1]->{'contents'}->[-1]->{'type'}
      and $last_menu->{'contents'}->[$index-1]->{'contents'}->[-1]->{'type'}
             eq 'preformatted') {
    my $empty_line = {'type' => 'empty_line', 'text' => "\n", 'parent' =>
               $last_menu->{'contents'}->[$index-1]->{'contents'}->[-1]};
    push @{$last_menu->{'contents'}->[$index-1]->{'contents'}}, $empty_line;
  } elsif ($index
           and $last_menu->{'contents'}->[$index-1]->{'type'}
           and $last_menu->{'contents'}->[$index-1]->{'type'} eq 'menu_entry') {
    my $menu_comment = {'type' => 'menu_comment', 'parent' => $last_menu};
    splice (@{$last_menu->{'contents'}}, $index, 0, $menu_comment);
    $index++;
    my $preformatted = {'type' => 'preformatted', 'parent' => $menu_comment};
    push @{$menu_comment->{'contents'}}, $preformatted;
    my $empty_line = {'type' => 'after_description_line', 'text' => "\n",
                      'parent' => $preformatted};
    push @{$preformatted->{'contents'}}, $empty_line;
  }
  splice (@{$last_menu->{'contents'}}, $index, 0, $new_master_menu);

  return 1;
}

# modify the menu tree to put description and menu comment content
# together directly in the menu.  Put the menu_entry in a preformatted.
# last merge preformatted.
sub menu_to_simple_menu($);

sub menu_to_simple_menu($)
{
  my $menu = shift;

  my @contents;
  foreach my $content (@{$menu->{'contents'}}) {
    if ($content->{'type'} and $content->{'type'} eq 'menu_comment') {
      push @contents, @{$content->{'contents'}};
    } elsif ($content->{'type'} and $content->{'type'} eq 'menu_entry') {
      my $preformatted = {'type' => 'preformatted', 'contents' => [$content]};
      push @contents, $preformatted;
      $content->{'parent'} = $preformatted;

      my $in_description;
      my @args = @{$content->{'args'}};
      @{$content->{'args'}} = ();
      while (@args) {
        if ($args[0]->{'type'} and $args[0]->{'type'} eq 'menu_entry_description') {
          my $description = shift @args;
          push @contents, @{$description->{'contents'}};
          push @contents, @args;
          last;
        } else {
          my $arg = shift @args;
          push @{$content->{'args'}}, $arg;
        }
      }
    } elsif ($content->{'cmdname'}
             and $Texinfo::Common::menu_commands{$content->{'cmdname'}}) {
      menu_to_simple_menu($content);
      push @contents, $content;
    } else {
      push @contents, $content;
    }
  }

  # reset parent, put in menu and merge preformatted.
  @{$menu->{'contents'}} = ();
  my $current_preformatted;
  foreach my $content (@contents) {
    $content->{'parent'} = $menu;
    if ($content->{'type'} and $content->{'type'} eq 'preformatted') {
      if (!defined($current_preformatted)) {
        $current_preformatted = $content;
        push @{$menu->{'contents'}}, $content;
      } else {
        foreach my $preformatted_content (@{$content->{'contents'}}) {
          push @{$current_preformatted->{'contents'}}, $preformatted_content;
          $preformatted_content->{'parent'} = $current_preformatted;
        }
      }
    } else {
      $current_preformatted = undef;
      push @{$menu->{'contents'}}, $content;
    }
  }
}

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

  if ($self->{'info'} and $self->{'info'}->{'unassociated_menus'}) {
    foreach my $menu (@{$self->{'info'}->{'unassociated_menus'}}) {
      menu_to_simple_menu($menu);
    }
  }
  if ($self->{'nodes'} and @{$self->{'nodes'}}) {
    foreach my $node (@{$self->{'nodes'}}) {
      if ($node->{'menus'}) {
        foreach my $menu (@{$node->{'menus'}}) {
          menu_to_simple_menu($menu);
        }
      }
    }
  }
}

1;

__END__

=head1 NAME

Texinfo::Transformations - transformations of Texinfo::Parser.pm tree

=head1 SYNOPSIS

  use Texinfo:Transformations;

=head1 DESCRIPTION

Includes miscellaneous methods C<set_menus_to_simple_menu> and
C<menu_to_simple_menu> to change the menu texinfo tree, as well
as C<insert_nodes_for_sectioning_commands> that adds nodes for
sectioning commands without nodes and C<complete_tree_nodes_menus>
that completes the node menus based on the sectioning tree.

=head1 METHODS

No method is exported in the default case.

Most of those function references takes a Texinfo::Parser object
as argument, see L<Texinfo::Parser>.

=over

=item ($root_content, $added_sections) = fill_gaps_in_sectioning ($root)

This function adds empty C<@unnumbered> and similar commands in a tree
to fill gaps in sectioning.  This may be used, for example, when converting
from a format that can handle gaps in sectioning.  I<$root> is the tree
root.  An array reference is returned, containing the root contents
with added sectioning commands, as well as an array reference containing
the added sectioning commands.

If the sectioning commands are lowered or raised (with C<@raisesections>,
C<@lowersection>) the tree may be modified with C<@raisesections> or
C<@lowersection> added to some tree elements.

=item menu_to_simple_menu ($menu)

=item set_menus_to_simple_menu ($parser)

C<menu_to_simple_menu> transforms the tree of a menu tree element.
C<set_menus_to_simple_menu> calls C<menu_to_simple_menu> for all the
menus of the document.

A simple menu has no I<menu_comment>, I<menu_entry> or I<menu_entry_description>
container anymore, their content are merged directly in the menu in
I<preformatted> container.

=item ($root_content, $added_nodes) = insert_nodes_for_sectioning_commands ($parser, $tree)

Insert nodes for sectioning commands without node in C<$tree>.
An array reference is returned, containing the root contents
with added nodes, as well as an array reference containing the
added nodes.

=item complete_tree_nodes_menus ($parser, $tree)

Add menu entries or whole menus for nodes associated with sections,
based on the sectioning tree.  This function should therefore be
called after L<sectioning_structure>.

=item $detailmenu = new_master_menu ($parser)

Returns a detailmenu tree element formatted as a master node.

=item regenerate_master_menu ($parser)

Regenerate the Top node master menu, replacing the first detailmenu
in Top node menus or appending at the end of the Top node menu.

=back

=head1 SEE ALSO

L<Texinfo manual|http://www.gnu.org/s/texinfo/manual/texinfo/>,
L<Texinfo::Parser>.

=head1 AUTHOR

Patrice Dumas, E<lt>pertusus@free.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2010, 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.

=cut


code:
# Copyright 2014, 2015, 2016 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/>.

package Texinfo::XSLoader;

use DynaLoader;

use 5.00405;
use strict;
use warnings;

our $TEXINFO_XS;

our $VERSION = '6.3.90';

our $disable_XS;

# For verbose information about what's being done
sub _debug($) {
  if ($TEXINFO_XS eq 'debug') {
    my $msg = shift;
    warn $msg . "\n";
  }
}

# For messages to say that XS module couldn't be loaded
sub _fatal($) {
  if ($TEXINFO_XS eq 'debug'
      or $TEXINFO_XS eq 'required'
      or $TEXINFO_XS eq 'warn') {
    my $msg = shift;
    warn $msg . "\n";
  }
}

# We look for the .la and .so files in @INC because this allows us to override
# which modules are used using -I flags to "perl".
sub _find_file($) {
  my $file = shift;
  for my $dir (@INC) {
    _debug "checking $dir/$file";
    if (-f "$dir/$file") {
      _debug "found $dir/$file";
      return ($dir, "$dir/$file");
    }
  }
  return undef;
}

# Make symbols accessible under
# namespace $FULL_MODULE_NAME (e.g. Texinfo::Convert::Paragraph),
# either from XS implementation in $MODULE, or non-XS implementation
# $FALLBACK_MODULE.  $MODULE_NAME is the name of a Libtool file used for
# loading the XS subroutines.
# $INTERFACE_VERSION is a module interface number, to be changed when the XS
# interface changes.
sub init {
 my ($full_module_name,
     $module,
     $fallback_module,
     $module_name,
     $interface_version,
     $warning_message,
     $fatal_message
   ) = @_;

 # Possible values for TEXINFO_XS environment variable:
 #
 # TEXINFO_XS=omit         # don't try loading xs at all
 # TEXINFO_XS=default      # try xs, libtool and then perl paths,
 #                         # silent fallback
 # TEXINFO_XS=libtool      # try xs, libtool only, silent fallback
 # TEXINFO_XS=standalone   # try xs, perl paths only, silent fallback
 # TEXINFO_XS=warn         # try xs, libtool and then perl paths, warn
 #                         # on failure
 # TEXINFO_XS=required     # abort if not loadable, no fallback
 # TEXINFO_XS=debug        # voluminuous debugging
 #
 # Other values are treated at the moment as 'default'.

 $TEXINFO_XS = $ENV{'TEXINFO_XS'};
 if (!defined($TEXINFO_XS)) {
   $TEXINFO_XS = '';
 }

 if ($TEXINFO_XS eq 'omit') {
   # Don't try to use the XS module
   goto FALLBACK;
 }

 if ($disable_XS) {
   _fatal "use of XS modules was disabled when Texinfo was built";
   goto FALLBACK;
 }

 if ($warning_message) {
   _debug $warning_message;
 }

 if ($fatal_message) {
   _fatal $fatal_message;
   goto FALLBACK;
 }

 if (!$module) {
   goto FALLBACK;
 }

 my ($libtool_dir, $libtool_archive);
 if ($TEXINFO_XS ne 'standalone') {
   ($libtool_dir, $libtool_archive) = _find_file("$module_name.la");
   if (!$libtool_archive) {
     if ($TEXINFO_XS eq 'libtool') {
       _fatal "$module_name: couldn't find Libtool archive file";
       goto FALLBACK;
     }
     _debug "$module_name: couldn't find Libtool archive file";
   }
 }

 my $dlname = undef;
 my $dlpath = undef;

 # Try perl paths
 if (!$libtool_archive) {
   my @modparts = split(/::/,$module);
   my $dlname = $modparts[-1];
   my $modpname = join('/',@modparts);
   # the directories with -L prepended setup directories to
   # be in the search path. Then $dlname is prepended as it is
   # the name really searched for.
   $dlpath = DynaLoader::dl_findfile(map("-L$_/auto/$modpname", @INC), $dlname);
   if (!$dlpath) {
     _fatal "$module_name:  couldn't find $module";
     goto FALLBACK;
   }
   goto LOAD;
 }

 my $fh;
 open $fh, $libtool_archive;
 if (!$fh) {
   _fatal "$module_name: couldn't open Libtool archive file";
   goto FALLBACK;
 }

 # Look for the line in XS*.la giving the name of the loadable object.
 while (my $line = <$fh>) {
   if ($line =~ /^\s*dlname\s*=\s*'([^']+)'\s$/) {
     $dlname = $1;
     last;
   }
 }
 if (!$dlname) {
   _fatal "$module_name: couldn't find name of shared object";
   goto FALLBACK;
 }

 # The *.so file is under .libs in the source directory.
 push @DynaLoader::dl_library_path, $libtool_dir;
 push @DynaLoader::dl_library_path, "$libtool_dir/.libs";

 $dlpath = DynaLoader::dl_findfile($dlname);
 if (!$dlpath) {
   _fatal "$module_name: couldn't find $dlname";
   goto FALLBACK;
 }

LOAD:

  #my $flags = dl_load_flags $module; # This is 0 in DynaLoader
  my $flags = 0;
  my $libref = DynaLoader::dl_load_file($dlpath, $flags);
  if (!$libref) {
    _fatal "$module_name: couldn't load file $dlpath";
    goto FALLBACK;
  }
  _debug "$dlpath loaded";
  my @undefined_symbols = DynaLoader::dl_undef_symbols();
  if ($#undefined_symbols+1 != 0) {
    _fatal "$module_name: still have undefined symbols after dl_load_file";
  }
  my $bootname = "boot_$module";
  $bootname =~ s/:/_/g;
  _debug "looking for $bootname";
  my $symref = DynaLoader::dl_find_symbol($libref, $bootname);
  if (!$symref) {
    _fatal "$module_name: couldn't find $bootname symbol";
    goto FALLBACK;
  }
  _debug "trying to call $bootname...";
  my $boot_fn = DynaLoader::dl_install_xsub("${module}::bootstrap",
                                                  $symref, $dlname);

  if (!$boot_fn) {
    _fatal "$module_name: couldn't bootstrap";
    goto FALLBACK;
  }
  _debug "  ...succeeded";

  push @DynaLoader::dl_shared_objects, $dlpath; # record files loaded

  # This is the module bootstrap function, which causes all the other
  # functions (XSUB's) provided by the module to become available to
  # be called from Perl code.
  &$boot_fn($module, $interface_version);

  # This makes it easier to refer to packages and symbols by name.
  no strict 'refs';

  if (defined &{"${module}::init"} and !&{"${module}::init"} ()) {
    _fatal "$module_name: error initializing";
    goto FALLBACK;
  }

  *{"${full_module_name}::"} = \%{"${module}::"};

  return $module;

FALLBACK:
  if ($TEXINFO_XS eq 'required') {
    die "unset the TEXINFO_XS environment variable to use the "
       ."pure Perl modules\n";
  } elsif ($TEXINFO_XS eq 'warn' or $TEXINFO_XS eq 'debug') {
    warn "falling back to pure Perl module\n";
  }
  if (!defined $fallback_module) {
    die "no fallback module for $full_module_name";
  }

  # Fall back to using the Perl code.
  # Use eval here to interpret :: properly in module name.
  eval "require $fallback_module";

  *{"${full_module_name}::"} = \%{"${fallback_module}::"};

  return  $fallback_module;
} # end init

# Override subroutine $TARGET with $SOURCE.
sub override {
  my ($target, $source) = @_;

  _debug "attempting to override $target with $source...";

  no strict 'refs'; # access modules and symbols by name.
  no warnings 'redefine'; # do not warn about redefining a function.

  if (defined &{"${source}"}) {
    *{"${target}"} = \&{"${source}"};
    _debug "  ...succeeded";
  } else {
    _debug "  ...failed";
  }
}

1;
__END__

repo_name: mthl/texinfo

license: mit


code:
PATH_SEPARATOR="@PATH_SEPARATOR@"
PERL="@PERL@"
DIFF_U_OPTION="@DIFF_U_OPTION@"
DIFF_A_OPTION="@DIFF_A_OPTION@"


code:
Index: Texinfo/Convert/Converter.pm
===================================================================
--- Texinfo/Convert/Converter.pm	(revision 7488)
+++ Texinfo/Convert/Converter.pm	(working copy)
@@ -1136,6 +1136,8 @@ sub _collect_leading_trailing_spaces_arg($$)
   return @result;
 }

+use Parsetexi;
+
 sub _table_item_content_tree($$$)
 {
   my $self = shift;
@@ -1160,7 +1162,8 @@ sub _table_item_content_tree($$$)
                'contents' => $contents,
                'parent' => $command,};
     $command->{'args'} = [$arg];
-    $self->Texinfo::Parser::_register_command_arg($arg, 'brace_command_contents');
+    #$self->Parsetexi::_register_command_arg($arg, 'brace_command_contents');
+    #$self->Texinfo::Parser::_register_command_arg($arg, 'brace_command_contents');
     $contents = [$command];
   }
   $converted_tree->{'contents'} = $contents;
Index: Texinfo/ModulePath.pm.in
===================================================================
--- Texinfo/ModulePath.pm.in	(revision 7490)
+++ Texinfo/ModulePath.pm.in	(working copy)
@@ -51,6 +51,7 @@ sub init (;$$) {
     if ('@USE_EXTERNAL_UNIDECODE@' ne 'yes') {
       unshift @INC, (File::Spec->catdir($lib_dir, 'lib', 'Text-Unidecode', 'lib'));
     }
+    unshift @INC, (File::Spec->catdir($lib_dir, '..', 'parsetexi'));
   }

   if (!$libexec_dir) {
Index: Texinfo/Parser.pm
===================================================================
--- Texinfo/Parser.pm	(revision 7506)
+++ Texinfo/Parser.pm	(working copy)
@@ -33,6 +33,9 @@ package Texinfo::Parser;
 use 5.006;
 use strict;

+# make sure we don't load this module for testing XS
+die;
+
 # debug
 use Carp qw(cluck);

Index: Texinfo/Report.pm
===================================================================
--- Texinfo/Report.pm	(revision 7496)
+++ Texinfo/Report.pm	(working copy)
@@ -48,7 +48,8 @@ use File::Basename;

 use Locale::Messages;
 # to be able to load a parser if none was given to gdt.
-use Texinfo::Parser;
+#use Texinfo::Parser;
+use Parsetexi;

 # return the errors and warnings
 sub errors($)
@@ -392,7 +393,8 @@ sub gdt($$;$$)
     }
   }
   #my $parser = Texinfo::Parser::parser($parser_conf);
-  my $parser = Texinfo::Parser::simple_parser($parser_conf);
+  #my $parser = Texinfo::Parser::simple_parser($parser_conf);
+  my $parser = Parsetexi::parser($parser_conf);
   if ($parser->{'DEBUG'}) {
     print STDERR "GDT $translation_result\n";
   }
Index: Texinfo/Structuring.pm
===================================================================
--- Texinfo/Structuring.pm	(revision 7506)
+++ Texinfo/Structuring.pm	(working copy)
@@ -396,7 +396,8 @@ sub nodes_tree($)
   foreach my $node (@{$self->{'nodes'}}) {
     if ($node->{'extra'}->{'normalized'} eq 'Top') {
       $top_node = $node;
-      my $parser = Texinfo::Parser::simple_parser ($self->{'conf'});
+      #my $parser = Texinfo::Parser::simple_parser ($self->{'conf'});
+      my $parser = Parsetexi::parser ($self->{'conf'});
       my $top_node_up_content_tree
                          = $parser->parse_texi_line($self->{'TOP_NODE_UP'});
       $top_node_up
Index: t/test_utils.pl
===================================================================
--- t/test_utils.pl	(revision 7480)
+++ t/test_utils.pl	(working copy)
@@ -43,7 +43,8 @@ Texinfo::ModulePath::init();

 use Test::More;

-use Texinfo::Parser;
+#use Texinfo::Parser;
+use Parsetexi;
 use Texinfo::Convert::Text;
 use Texinfo::Convert::Texinfo;
 use Texinfo::Structuring;
@@ -730,7 +731,8 @@ sub test($$)
   #  push @tested_formats, @{$self->{'test_formats'}};
   }

-  my $parser = Texinfo::Parser->parser({'TEST' => 1,
+  #my $parser = Texinfo::Parser->parser({'TEST' => 1,
+  my $parser = Parsetexi::parser({'TEST' => 1,
                                         'include_directories' => [
                                           't/include_dir/',
                                           't/include/',
Index: texi2any.pl
===================================================================
--- texi2any.pl	(revision 7480)
+++ texi2any.pl	(working copy)
@@ -273,8 +273,8 @@ if ($configured_version eq '@' . 'PACKAGE_VERSION@
   } else {
     # used in the standalone perl module, as $hardcoded_version is undef
     # and it should never be configured in that setup
-    require Texinfo::Parser;
-    $configured_version = $Texinfo::Parser::VERSION;
+    ## require Texinfo::Parser;
+    ## $configured_version = $Texinfo::Parser::VERSION;
   }
 }
 my $configured_package = '@PACKAGE@';
@@ -1068,7 +1068,14 @@ if ($call_texi2dvi) {
   document_warn(__('--Xopt option without printed output'));
 }

-require Texinfo::Parser;
+#require Texinfo::Parser;
+BEGIN {
+require Parsetexi;
+*Texinfo::Parser:: = \%Parsetexi::;
+}
+
+print *Parsetexi::{PACKAGE};
+
 require Texinfo::Structuring;
 require Texinfo::Transformations;
 # Avoid loading these modules until down here to speed up the case


code:
# A style that tries to be analogous with a book, in HTML.
#
# This file is in the public domain. Thus it may easily be used as an
# example for further customizations.
#
# Originally written by Patrice Dumas in 2004.
# Modified in 2007, 2008.
#
# This style is based on the scriptbasic style.

use strict;

use vars qw($element_file_name);

set_from_init_file('contents', 1);
set_from_init_file('INLINE_CONTENTS', 1);
set_from_init_file('USE_TITLEPAGE_FOR_TITLE', 1);

my @book_buttons = ('Back', 'Forward', ' ', 'Contents', 'Index', 'About');

foreach my $buttons ('SECTION_BUTTONS', 'CHAPTER_BUTTONS', 'TOP_BUTTONS') {
  set_from_init_file($buttons, \@book_buttons);
}

my @book_footer_buttons = ('Contents', 'Index', 'About');
foreach my $buttons ('MISC_BUTTONS', 'SECTION_FOOTER_BUTTONS') {
  set_from_init_file($buttons, \@book_footer_buttons);
}

set_from_init_file('NODE_FOOTER_BUTTONS', ['Back', 'Forward']);
set_from_init_file('LINKS_BUTTONS',
    ['Top', 'Index', 'Contents', 'About', 'Up', 'NextFile', 'PrevFile']);

set_from_init_file('WORDS_IN_PAGE', undef);
set_from_init_file('SHOW_MENU', 0);
set_from_init_file('USE_NODES', undef);

set_from_init_file('BIG_RULE', '
');

my ($book_previous_default_filename, $book_previous_file_name,
    $book_unumbered_nr);

sub book_init($)
{
  my $converter = shift;

  $book_previous_default_filename = undef;
  $book_previous_file_name = undef;
  $book_unumbered_nr = 0;
  return 1;
}

texinfo_register_handler('init', \&book_init);

my $NO_BULLET_LIST_CLASS = 'no-bullet';

sub book_print_up_toc($$)
{
  my $converter = shift;
  my $command = shift;

  my $result = '';
  my $current_command = $command;
  my @up_commands;
  while (defined($current_command->{'section_up'})
           and ($current_command->{'section_up'} ne $current_command)
           and defined($current_command->{'section_up'}->{'cmdname'})) {
    unshift (@up_commands, $current_command->{'section_up'});
    $current_command = $current_command->{'section_up'};
  }
  # this happens for example for top element
  return '' if !(@up_commands);
  #print $fh "
" . &$anchor('', $Texi2HTML::HREF{Contents}, '[' . $Texi2HTML::NAME{Contents} . ']') . "
\n";
  my $up = shift @up_commands;
#print STDERR "$up $up->{'cmdname'} ".Texinfo::Structuring::_print_root_command_texi($up)."\n";
  $result .= $converter->_attribute_class('ul', $NO_BULLET_LIST_CLASS).">
"
  . "command_href($up)."\">".$converter->command_text($up)
   . "
\n";
  foreach my $up (@up_commands) {
    $result .= '
'
    .$converter->_attribute_class('ul', $NO_BULLET_LIST_CLASS).">
"
    . "command_href($up)."\">".$converter->command_text($up)
   . "
\n";
  }
  foreach my $up (@up_commands) {
    $result .= "

\n";
  }
  $result .= "
\n";
  return $result;
}

sub book_navigation_header($$$$)
{
  my $self = shift;
  my $buttons = shift;
  my $cmdname = shift;
  my $command = shift;

  my $element = $command->{'parent'};
  if ($element
      and $element->{'extra'}->{'section'}
      and ($element->{'contents'}->[0] eq $command
          or (!$element->{'contents'}->[0]->{'cmdname'}
              and $element->{'contents'}->[1] eq $command))
      and defined($element->{'filename'})
      and $self->{'counter_in_file'}->{$element->{'filename'}} == 1) {

    return book_print_up_toc($self, $element->{'extra'}->{'section'}) .
       &{$self->default_formatting_function('navigation_header')}($self,
                                 $buttons, $cmdname, $command);

  } else {
    return &{$self->default_formatting_function('navigation_header')}($self,
             $buttons, $cmdname, $command);
  }
}

texinfo_register_formatting_function('navigation_header',
                                     \&book_navigation_header);

sub book_print_sub_toc($$$);

sub book_print_sub_toc($$$)
{
  my $converter = shift;
  my $parent_command = shift;
  my $command = shift;

  my $result = '';
  my $content_href = $converter->command_href($command);
  my $heading = $converter->command_text($command);
  if ($content_href) {
    $result .= "
 "."$heading" . "
\n";
  }
#print STDERR "SUB_TOC $element->{'text'}\n"; #sleep 1;
  if ($command->{'section_childs'} and @{$command->{'section_childs'}}) {
#print STDERR "SUB_TOC child $element->{'child'}->{'text'}\n";
    $result .= '
'.$converter->_attribute_class('ul',$NO_BULLET_LIST_CLASS)
     .">\n". book_print_sub_toc($converter, $parent_command,
                                $command->{'section_childs'}->[0])
     ."

\n";
  }
  if (exists($command->{'section_next'})) {
#print STDERR "SUB_TOC next($element->{'text'}) $element->{'next'}->{'text'}\n";
    $result .= book_print_sub_toc($converter, $parent_command,
                                  $command->{'section_next'});
  }
  return $result;
}

sub book_convert_heading_command($$$$$)
{
  my $self = shift;
  my $cmdname = shift;
  my $command = shift;
  my $args = shift;
  my $content = shift;

  my $result = '';

  # not clear that it may really happen
  if ($self->in_string) {
    $result .= $self->command_string($command) ."\n" if ($cmdname ne 'node');
    $result .= $content if (defined($content));
    return $result;
  }
  my $element_id = $self->command_id($command);
  $result .= "\n"
    if (defined($element_id) and $element_id ne '');

  print STDERR "Process $command "
        .Texinfo::Structuring::_print_root_command_texi($command)."\n"
          if ($self->get_conf('DEBUG'));
  my $element;
  if ($Texinfo::Common::root_commands{$command->{'cmdname'}}
      and $command->{'parent'}
      and $command->{'parent'}->{'type'}
      and $command->{'parent'}->{'type'} eq 'element') {
    $element = $command->{'parent'};
  }
  if ($element) {
    $result .= &{$self->{'format_element_header'}}($self, $cmdname,
                                            $command, $element);
  }

  my $heading_level;
  # FIXME this is done as in texi2html: node is used as heading if there
  # is nothing else.  Is it right?
  if ($cmdname eq 'node') {
    if (!$element or (!$element->{'extra'}->{'section'}
                      and $element->{'extra'}->{'node'}
                      and $element->{'extra'}->{'node'} eq $command
                      # bogus node may not have been normalized
                      and defined($command->{'extra'}->{'normalized'}))) {
      if ($command->{'extra'}->{'normalized'} eq 'Top') {
        $heading_level = 0;
      } else {
        $heading_level = 3;
      }
    }
  } else {
    $heading_level = $command->{'level'};
  }

  my $heading = $self->command_text($command);
  # $heading not defined may happen if the command is a @node, for example
  # if there is an error in the node.
  if (defined($heading) and $heading ne '' and defined($heading_level)) {

    if ($self->get_conf('TOC_LINKS')
        and $Texinfo::Common::root_commands{$cmdname}
        and $Texinfo::Common::sectioning_commands{$cmdname}) {
      my $content_href = $self->command_contents_href($command, 'contents',
                                        $self->{'current_filename'});
      if ($content_href) {
        $heading = "$heading";
      }
    }

    if ($self->in_preformatted()) {
      $result .= ''.$heading.''."\n";
    } else {
      # if the level was changed, set the command name right
      if ($cmdname ne 'node'
          and $heading_level ne $Texinfo::Common::command_structuring_level{$cmdname}) {
        $cmdname
          = $Texinfo::Common::level_to_structuring_command{$cmdname}->[$heading_level];
      }
      $result .= &{$self->{'format_heading_text'}}($self, $cmdname, $heading,
                                            $heading_level, $command);
    }
  }
  if ($command->{'section_childs'} and @{$command->{'section_childs'}}
      and $cmdname ne 'top') {
    $result .= $self->_attribute_class('ul', $NO_BULLET_LIST_CLASS).">\n";
    $result .= book_print_sub_toc($self, $command,
                                  $command->{'section_childs'}->[0]);
    $result .= "
\n";
  }
  $result .= $content if (defined($content));
  return $result;
}

foreach my $command (keys(%Texinfo::Common::sectioning_commands), 'node') {
  texinfo_register_command_formatting($command,
                                \&book_convert_heading_command);
}

sub book_element_file_name($$$)
{
  my $converter = shift;
  my $element = shift;
  my $filename = shift;

  return undef if ($converter->get_conf('NODE_FILENAMES')
                   or !$converter->get_conf('SPLIT'));

  if (defined($book_previous_default_filename)
      and ($filename eq $book_previous_default_filename)) {
    return $book_previous_file_name;
  }

  my $prefix = $converter->{'document_name'};
  my $new_file_name;
  my $command = $element->{'extra'}->{'section'};
  return undef unless ($command);
  if ($converter->element_is_top($element)) {
    $new_file_name = "${prefix}_top.html";
  } elsif (defined($command->{'number'}) and ($command->{'number'} ne '')) {
    my $number = $command->{'number'};
    $number .= '.' unless ($number =~ /\.$/);
    $new_file_name = "${prefix}_$number" . 'html';
  } else {
    $book_unumbered_nr++;
    $new_file_name = "${prefix}_U." . $book_unumbered_nr . '.html';
  }
  $book_previous_default_filename = $filename;
  $book_previous_file_name = $new_file_name;
  return $new_file_name;
}

$element_file_name = \&book_element_file_name;

1;


code:
# -*-perl-*-

#+##############################################################################
#
# chm.pm: convert to chm intermediate formats hhp, hhc, hhk and html files
#
#    Copyright 2004, 2006, 2009, 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/>.
#
# Originally written by Patrice Dumas.
#
#-##############################################################################

use strict;

use File::Spec;

main::set_global_format('html');

set_from_init_file('TOP_NODE_FILE', undef);
set_from_init_file('TOP_FILE', undef);

#$SECTION_NAVIGATION = 0; # to avoid headers in normal elements
set_from_init_file('SHOW_MENU', 0);
set_from_init_file('SPLIT', 'node');
set_from_init_file('contents', 1);
#set_from_init_file('SPLIT_INDEX', undef);

set_from_init_file('DEFAULT_RULE', '');
set_from_init_file('BIG_RULE', '');
set_from_init_file('HEADERS', 0);

set_from_init_file('footnotestyle', 'end');

#FIXME remove that later?
set_from_init_file('USE_NODES', 0);

use vars qw(%commands_formatting);
texinfo_register_formatting_function('end_file', \&chm_end_file);
texinfo_register_formatting_function('navigation_header', \&chm_noop);
texinfo_register_formatting_function('navigation_header_panel', \&chm_noop);

my %chm_languages = (
    'en'         => '0x409 English (United States)',
    'sq'         => '0x041c Albanian',
#    'ar'         => '0x1401 Arabic (ALGERIA)',
#    'es'         => '0x2c0a Spanish (ARGENTINA)',
#    'en'         => '0x0c09 English (AUSTRALIA)',
#    'de'         => '0x0c07 German (AUSTRIA)',
#    'ar'         => '0x3c01 Arabic (BAHRAIN)',
    'be'         => '0x0423 Byelorussian',
#    'fr'         => '0x080c French (BELGIUM)',
#    'en'         => '0x2809 English (BELIZE)',
#    'es'         => '0x400a Spanish (BOLIVIA)',
#    'pt'         => '0x0416 Portuguese (BRAZIL)',
#    'ms'         => '0x083e Malay (BRUNEI DARUSSALAM)',
    'bg'         => '0x0402 Bulgarian',
#    'fr'         => '0x0c0c French (CANADA)',
#    'es'         => '0x340a Spanish (CHILE)',
    'zh'         => '0x0804 Chinese (CHINA)',
#    'es'         => '0x240a Spanish (COLOMBIA)',
#    'es'         => '0x140a Spanish (COSTA RICA)',
    'hr'         => '0x041a Croatian',
    'cs'         => '0x0405 Czech',
    'da'         => '0x0406 Danish',
#    'es'         => '0x1c0a Spanish (DOMINICAN REPUBLIC)',
#    'es'         => '0x300a Spanish (ECUADOR)',
#    'ar'         => '0x0c01 Arabic (EGYPT)',
#    'es'         => '0x440a Spanish (EL SALVADOR)',
    'et'         => '0x0425 Estonian',
    'fo'         => '0x0438 Faeroese',
    'fi'         => '0x040b Finnish',
    'fr'         => '0x040c French (FRANCE)',
    'de'         => '0x0407 German (GERMANY)',
    'el'         => '0x0408 Greek',
#    'es'         => '0x100a Spanish (GUATEMALA)',
#    'es'         => '0x480a Spanish (HONDURAS)',
#    'zh'         => '0x0c04 Chinese (HONG KONG)',
    'hu'         => '0x040e Hungarian',
    'is'         => '0x040f Icelandic',
    'hi'         => '0x0439 Hindi',
    'in'         => '0x04',
    'fa'         => '0x0429 Farsi',
#    'ar'         => '0x0801 Arabic (IRAQ)',
#    'en'         => '0x1809 English (IRELAND)',
    'iw'         => '0x04',
    'it'         => '0x0410 Italian',
#    'en'         => '0x2009 English (JAMAICA)',
    'ja'         => '0x0411 Japanese',
#    'ar'         => '0x2c01 Arabic (JORDAN)',
    'sw'         => '0x0441 Swahili',
    'ko'         => '0x0412 Korean',
#    'ar'         => '0x3401 Arabic (KUWAIT)',
    'al'         => '0x0426 Latvian (Lettish)',
#    'ar'         => '0x3001 Arabic (LEBANON)',
#    'ar'         => '0x1001 Arabic (LIBYAN ARAB JAMAHIRIYA)',
#    'de'         => '0x1407 German (LIECHTENSTEIN)',
    'lt'         => '0x0427 Lithuanian',
#    'de'         => '0x1007 German (LUXEMBOURG)',
#    'zh'         => '0x1404 Chinese (MACAU)',
    'mk'         => '0x042f Macedonian',
#    'ms'         => '0x043e Malay (MALAYSIA)',
#    'es'         => '0x080a Spanish (MEXICO)',
#    'fr'         => '0x180c French (MONACO)',
#    'ar'         => '0x1801 Arabic (MOROCCO)',
    'nl'         => '0x0413 Dutch',
#    'en'         => '0x1409 English (NEW ZEALAND)',
#    'es'         => '0x4c0a Spanish (NICARAGUA)',
    'no'         => '0x0414 Norwegian',
#    'ar'         => '0x2001 Arabic (OMAN)',
    'ur'         => '0x0420 Urdu',
#    'es'         => '0x180a Spanish (PANAMA)',
#    'es'         => '0x3c0a Spanish (PARAGUAY)',
#    'es'         => '0x280a Spanish (PERU)',
#    'en'         => '0x3409 English (PHILIPPINES)',
    'pl'         => '0x0415 Polish',
    'pt'         => '0x0816 Portuguese (PORTUGAL)',
#    'es'         => '0x500a Spanish (PUERTO RICO)',
#    'ar'         => '0x4001 Arabic (QATAR)',
    'ro'         => '0x0418 Romanian',
    'ru'         => '0x0419 Russian',
    'ar'         => '0x0401 Arabic (SAUDI ARABIA)',
#    'zh'         => '0x1004 Chinese (SINGAPORE)',
    'sk'         => '0x041b Slovak',
    'sl'         => '0x0424 Slovenian',
    'af'         => '0x0436 Afrikaans',
    'ca'         => '0x0403 Catalan',
    'sv'         => '0x041d Swedish',
#    'de'         => '0x0807 German (SWITZERLAND)',
#    'ar'         => '0x2801 Arabic (SYRIAN ARAB REPUBLIC)',
#    'zh'         => '0x0404 Chinese (TAIWAN, PROVINCE OF CHINA)',
    'th'         => '0x041e Thai',
#    'en'         => '0x2c09 English (TRINIDAD AND TOBAGO)',
#    'ar'         => '0x1c01 Arabic (TUNISIA)',
    'tr'         => '0x041f Turkish',
    'uk'         => '0x0422 Ukrainian',
#    'ar'         => '0x3801 Arabic (UNITED ARAB EMIRATES)',
#    'en'         => '0x0809 English (UNITED KINGDOM)',
#    'en'         => '0x0409 English (UNITED STATES)',
#    'es'         => '0x380a Spanish (URUGUAY)',
#    'es'         => '0x200a Spanish (VENEZUELA)',
    'vi'         => '0x242a Vietnamese',
#    'ar'         => '0x2401 Arabic (YEMEN)',
#    'en'         => '0x3009 English (ZIMBABWE)',
    #''         => '',
);

my %hhk_global_property = (
   'ImageType' => 'Folder',
);

my %hhc_global_property = (
   'ImageType' => 'Folder',
);

# at least kchmviewer has trouble with the corresponding textual entities
foreach my $thing ('OE', 'oe', 'euro') {
  $commands_formatting{'normal'}->{$thing}
    = $Texinfo::Convert::Unicode::unicode_entities{$thing};
}

sub chm_end_file($)
{
  my $self = shift;
  my $pre_body_close = $self->get_conf('PRE_BODY_CLOSE');
  $pre_body_close = '' if (!defined($pre_body_close));
  return "

$pre_body_close

";
}

sub chm_noop($$)
{
  return '';
}

sub convert_tree ($$;$)
{
  my $converter = shift;
  my $tree = shift;
  my $options = shift;

  $options = {} if (!defined($options));

  return $converter->protect_text(
    Texinfo::Convert::Text::convert($tree,
   {Texinfo::Common::_convert_text_options($converter),
     %$options}));
}

sub chm_init($)
{
  my $self = shift;
  return if (defined($self->get_conf('OUTFILE'))
        and $Texinfo::Common::null_device_file{$self->get_conf('OUTFILE')});
  my $document_name = $self->{'document_name'};
  my $outdir = $self->{'destination_directory'};
  $outdir = File::Spec->curdir() if ($outdir eq '');

  my $hhk_filename = $document_name . ".hhk";
  my $hhk_file = File::Spec->catfile($outdir, $hhk_filename);
  my $hhk_fh = Texinfo::Common::open_out($self, $hhk_file);
  if (!defined($hhk_fh)) {
    $self->document_error(sprintf($self->__("chm.pm: could not open %s for writing: %s\n"),
                  $hhk_file, $!));
    return 0;
  }
  print STDERR "# writing HTML Help index in $hhk_file...\n"
     if ($self->get_conf('VERBOSE'));
  print $hhk_fh "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">\n\n";
  print $hhk_fh "\n<meta name=\"GENERATOR\" content=\""
   .$self->get_conf('PROGRAM') ."\">\n";
  print $hhk_fh "\n\n\n";
  print $hhk_fh "<OBJECT type=\"text/site properties\">\n";
  foreach my $property (sort(keys(%hhk_global_property))) {
    print $hhk_fh "<param name=\"$property\" value=\"$hhk_global_property{$property}\">\n";
  }
  print $hhk_fh "</OBJECT>\n";

  my $index_entries = Texinfo::Structuring::sort_indices($self,
                                          $self->{'index_entries'},
                                          $self->{'index_names'});
  if ($index_entries) {
    foreach my $index_name (sort(keys(%$index_entries))) {
      foreach my $index_entry_ref (@{$index_entries->{$index_name}}) {
        my $file = $self->command_filename($index_entry_ref->{'command'});
        # happens for things in @titlepage when it is not output
        if (!defined($file)) {
          if ($self->{'elements'} and $self->{'elements'}->[0]
             and defined($self->{'elements'}->[0]->{'filename'})) {
            # In that case use the first page.
            $file = $self->{'elements'}->[0]->{'filename'};
          } else {
            $file = '';
          }
        }
        my $anchor = $self->command_target($index_entry_ref->{'command'});
        my $origin_href = "$file#$anchor";
        my $entry = convert_tree($self,
                               {'contents' => $index_entry_ref->{'content'}},
                               {'code' => $index_entry_ref->{'in_code'}});
        print $hhk_fh "
 <OBJECT type=\"text/sitemap\">\n<param name=\"Name\" value=\"$entry\">\n<param name=\"Local\" value=\"$origin_href\">\n</OBJECT>
\n"
         if ($entry =~ /\S/);
      }
    }
  }
  print $hhk_fh "\n\n";
  delete $self->{'unclosed_files'}->{$hhk_file};
  if (!close ($hhk_fh)) {
    $self->document_error(sprintf($self->__("chm.pm: error on closing %s: %s"),
                          $hhk_file, $!));
    return 0;
  }

  my $hhc_filename = $document_name . ".hhc";
  my $hhc_file = File::Spec->catfile($outdir, $hhc_filename);
  my $hhc_fh = Texinfo::Common::open_out($self, $hhc_file);
  # Not sure $! is still valid
  if (!defined($hhc_fh)) {
    $self->document_error(sprintf($self->__("chm.pm: could not open %s for writing: %s\n"),
                  $hhc_file, $!));
    return 0;
  }

  print STDERR "# writing HTML Help project in $hhc_file...\n"
     if ($self->get_conf('VERBOSE'));

  print $hhc_fh "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">\n\n";
  print $hhc_fh "\n<meta name=\"GENERATOR\" content=\""
   .$self->get_conf('PROGRAM') ."\">\n";
  print $hhc_fh "\n\n\n";
  print $hhc_fh "<OBJECT type=\"text/site properties\">\n";
  foreach my $property (sort(keys(%hhc_global_property))) {
    print $hhc_fh "<param name=\"$property\" value=\"$hhc_global_property{$property}\">\n";

  }
  print $hhc_fh "</OBJECT>\n";

  if ($self->{'structuring'} and $self->{'structuring'}->{'sectioning_root'}) {
    my $section_root = $self->{'structuring'}->{'sectioning_root'};
    my $upper_level = $section_root->{'section_childs'}->[0]->{'level'};
    foreach my $top_section(@{$section_root->{'section_childs'}}) {
      $upper_level = $top_section->{'level'}
      if ($top_section->{'level'} < $upper_level);
    }
    $upper_level = 1 if ($upper_level <= 0);
    my $root_level = $upper_level - 1;
    my $level = $root_level;
    foreach my $section (@{$self->{'structuring'}->{'sections_list'}}) {
      next if ($section->{'cmdname'} eq 'part');
      my $section_level = $section->{'level'};
      $section_level = 1 if ($section_level == 0);
      if ($level < $section_level) {
        while ($level < $section_level) {
          print $hhc_fh "
\n";
          $level++;
        }
      } elsif ($level > $section->{'level'}) {
        while ($level > $section_level) {
          print $hhc_fh "
\n";
          $level--;
        }
      }
      my $text = convert_tree($self,
              {'contents' => $section->{'extra'}->{'misc_content'}});
      $text = $self->Texinfo::Common::numbered_heading($section, $text,
                          $self->get_conf('NUMBER_SECTIONS'));
      my $file = $self->command_filename($section);
      my $anchor = $self->command_target($section);
      my $origin_href = "$file#$anchor";
      print $hhc_fh "
 <OBJECT type=\"text/sitemap\">\n<param name=\"Name\" value=\"$text\">\n<param name=\"Local\" value=\"$origin_href\">\n</OBJECT>
\n";
    }
    while ($level > $root_level) {
      print $hhc_fh "
\n";
      $level--;
    }
  }
  print $hhc_fh "\n\n";
  delete $self->{'unclosed_files'}->{$hhc_file};
  if (!close ($hhc_fh)) {
    $self->document_error(sprintf($self->__("chm.pm: error on closing %s: %s"),
                          $hhc_file, $!));
    return 0;
  }

  my $hhp_filename = $document_name . ".hhp";
  my $hhp_file = File::Spec->catfile($outdir, $hhp_filename);
  my $hhp_fh = Texinfo::Common::open_out($self, $hhp_file);
  # Not sure $! is still valid
  if (!defined($hhp_fh)) {
    $self->document_error(sprintf($self->__("chm.pm: could not open %s for writing: %s\n"),
                  $hhp_file, $!));
    return 0;
  }
  print STDERR "# writing HTML Help project in $hhp_file...\n"
     if ($self->get_conf('VERBOSE'));
  my $language = $chm_languages{'en'};
  my $documentlanguage = $self->get_conf('documentlanguage');
  $documentlanguage =~ s/_.*//;
  if (exists ($chm_languages{$documentlanguage})) {
    $language = $chm_languages{$documentlanguage};
  }
  my $title = convert_tree($self, $self->{'title_tree'});
  my $top_file = '';
  my $top_element = $self->global_element('Top');
  if ($top_element and $top_element->{'extra'}->{'element_command'}) {
    $top_file
     = $self->command_filename($top_element->{'extra'}->{'element_command'});
  }

  print $hhp_fh <<EOT;
[OPTIONS]
Compatibility=1.1 or later
Compiled file=$document_name.chm
Contents file=$hhc_filename
Default Window=Default
Default topic=$top_file
Display compile progress=No
Full-text search=Yes
Index file=$hhk_filename
Language=$language
Title=$title

[WINDOWS]
Default=,"$hhc_filename","$hhk_filename","$top_file","$top_file",,,,,0x22520,,0x384e,,,,,,,,0

[FILES]
EOT

  my %chm_files;
  if ($self->{'elements'}) {
    foreach my $element (@{$self->{'elements'}}) {
      if (!$chm_files{$element->{'filename'}}) {
        print $hhp_fh "$element->{'filename'}\n";
        $chm_files{$element->{'filename'}} = 1;
      }
    }
  }

  delete $self->{'unclosed_files'}->{$hhp_file};
  if (!close ($hhp_fh)) {
    $self->document_error(sprintf($self->__("chm.pm: error on closing %s: %s"),
                          $hhp_file, $!));
    return 0;
  }

  return 1;
}
texinfo_register_handler('init', \&chm_init);

1;


code:
# -*-perl-*-
#+##############################################################################
#
# html32.pm: output HTML 3.2
#
#    Copyright (C) 2003, 2004, 2007, 2009, 2011, 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/>.
#
# Originally written by Patrice Dumas.
#
#-##############################################################################

use strict;
use Texinfo::Convert::Converter qw(xml_protect_text);

use vars qw(%commands_formatting %style_commands_formatting);

set_from_init_file('COMPLEX_FORMAT_IN_TABLE', 1);

set_from_init_file('DOCTYPE', '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 3.2//EN" "http://www.w3.org/TR/html32/loose.dtd">');

set_from_init_file('FRAMESET_DOCTYPE', get_conf('DOCTYPE'));

set_from_init_file('BODYTEXT', 'bgcolor="#FFFFFF" text="#000000" link="#0000FF" vlink="#800080" alink="#FF0000"');

set_from_init_file('BEFORE_OVERVIEW', '');
set_from_init_file('AFTER_OVERVIEW', '');
set_from_init_file('BEFORE_TOC_LINES', '');
set_from_init_file('AFTER_TOC_LINES', '');

# html version for latex2html
set_from_init_file('L2H_HTML_VERSION', '3.2');

# no css, no class
set_from_init_file('NO_CSS', 1);

# no accesskey in html 3.2
set_from_init_file('USE_ACCESSKEY', 0);

set_from_init_file('MENU_SYMBOL', '*');

set_from_init_file('OPEN_QUOTE_SYMBOL', '`');
set_from_init_file('CLOSE_QUOTE_SYMBOL', "'");

foreach my $command ('euro', 'geq', 'leq',
   'bullet', 'equiv', 'expansion', 'point', 'result', 'arrow',
   'quotedblleft', 'quotedblright',
   'quoteleft', 'quoteright',
   'quotedblbase', 'quotesinglbase', 'guillemetleft', 'guillemetright',
   'guillemotleft', 'guillemotright', 'guilsinglleft', 'guilsinglright') {

  $commands_formatting{'normal'}->{$command}
    = xml_protect_text(undef,
             $Texinfo::Convert::Text::text_brace_no_arg_commands{$command});
}

$commands_formatting{'normal'}->{'oe'} = 'œ';
$commands_formatting{'normal'}->{'OE'} = 'Œ';

foreach my $dots ('dots', 'enddots') {
  $commands_formatting{'normal'}->{$dots} = '...';
  $commands_formatting{'preformatted'}->{$dots} = '...';
}

foreach my $context ('preformatted', 'normal') {
  foreach my $command('sansserif', 'r') {
    $style_commands_formatting{$context}->{$command} = {};
  }
}

# " is not in html 3.2
sub html32_protect_text($$)
{
  my $converter = shift;
  my $text = shift;
  $text =~ s/&/&/g;
  $text =~ s/</</g;
  $text =~ s/>/>/g;
  $text =~ s/\"/"/g;
  $text =~ s/\f/�/g;
  return $text;
}

texinfo_register_formatting_function('protect_text', \&html32_protect_text);

sub html32_convert_text($$$$)
{
  my $self = shift;
  my $type = shift;
  my $command = shift;
  my $text = shift;

  # do that first because in verb and verbatim, type is 'raw'
  if ($self->in_verbatim()) {
    return $self->protect_text($text);
  }
  return $text if ($self->in_raw());

  $text = uc($text) if ($self->in_upper_case());
  $text = $self->protect_text($text);

  if (!$self->in_code() and !$self->in_math()) {
    $text =~ s/``/"/g;
    $text =~ s/''/"/g;
    $text =~ s/---/\x{1F}/g;
    $text =~ s/--/-/g;
    $text =~ s/\x{1F}/--/g;
  }
  if (!$self->in_preformatted() and $self->in_space_protected()) {
    $text .= ' ' if (chomp($text));
    $text =~ s/ / /g;
  }
  return $text;
}
texinfo_register_type_formatting('text', \&html32_convert_text);

sub html32_convert_explained_command($$$$)
{
  my $self = shift;
  my $cmdname = shift;
  my $command = shift;
  my $args = shift;

  my $with_explanation;

  return '' if (!$args->[0] or !defined($args->[0]->{'normal'})
                or $args->[0]->{'normal'} !~ /\S/);

  if ($args->[1] and defined($args->[1]->{'string'})
                 and $args->[1]->{'string'} =~ /\S/) {
    $with_explanation = 1;
  }

  my $result;
  if ($with_explanation) {
    $result = $self->convert_tree ($self->gdt('{explained_string} ({explanation})',
          {'explained_string' => $args->[0]->{'tree'},
           'explanation' => $args->[1]->{'tree'} }));
  } else {
    $result = $args->[0]->{'normal'};
  }
  return $result;
}

foreach my $explained_command (keys(%Texinfo::Common::explained_commands)) {
  texinfo_register_command_formatting($explained_command,
                              \&html32_convert_explained_command);
}

# row in multitable. no thead in html 3.2
sub html32_convert_row_type($$$$) {
  my $self = shift;
  my $type = shift;
  my $command = shift;
  my $content = shift;

  return $content if ($self->in_string());
  if ($content =~ /\S/) {
    return '
' . $content . '
' . "\n";
  } else {
    return '';
  }
}
texinfo_register_type_formatting('row', \&html32_convert_row_type);

sub html32_convert_tab_command ($$$$)
{
  my $self = shift;
  my $cmdname = shift;
  my $command = shift;
  my $content = shift;

  my $row = $command->{'parent'};
  my $row_cmdname = $row->{'contents'}->[0]->{'cmdname'};

  # FIXME is it right?
  $content =~ s/^\s*//;
  $content =~ s/\s*$//;

  if ($self->in_string()) {
    return $content;
  }
  if ($row_cmdname eq 'headitem') {
    return "" . $content . '	';
  } else {
    return "" . $content . '	';
  }
}
texinfo_register_command_formatting('tab',
                            \&html32_convert_tab_command);

sub html32_convert_item_command($$$$)
{
  my $self = shift;
  my $cmdname = shift;
  my $command = shift;
  my $content = shift;

  if ($self->in_string()) {
    return $content;
  } elsif ($command->{'parent'}->{'type'}
           and $command->{'parent'}->{'type'} eq 'row') {
    return html32_convert_tab_command ($self, $cmdname, $command, $content);
  } else {
    return &{$self->default_commands_conversion($cmdname)}($self, $cmdname, $command, $content);
  }
}

texinfo_register_command_formatting('item',
                            \&html32_convert_item_command);
texinfo_register_command_formatting('headitem',
                            \&html32_convert_item_command);
1;


code:
#+##############################################################################
#
# latex2html.pm: interface to LaTeX2HTML
#
#    Copyright (C) 1999, 2000, 2003, 2005, 2006, 2009, 2011, 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/>.
#
# This code was taken from the main texi2html file in 2006.
# Certainly originally written by Olaf Bachmann.
# Adapted from texi2html T2h_l2h.pm in 2011.
#
#-##############################################################################

require 5.0;
use strict;

use Cwd;
use File::Copy;
use File::Spec;

my $global_cmds = get_conf('GLOBAL_COMMANDS');
if (!defined($global_cmds)) {
  set_from_init_file('GLOBAL_COMMANDS', []);
  $global_cmds = get_conf('GLOBAL_COMMANDS');
}
push @$global_cmds, ('math', 'tex');

texinfo_register_handler('structure', \&l2h_process);
texinfo_register_handler('finish', \&l2h_finish);

texinfo_register_command_formatting('math', \&l2h_do_tex);
texinfo_register_command_formatting('tex', \&l2h_do_tex);

# name/location of latex2html program
set_from_init_file('L2H_L2H', 'latex2html');

# If this is set the actual call to latex2html is skipped. The previously
# generated content is reused, instead.
# If set to 0, the cache is not used.
# If undef the cache is used for as many tex fragments as possible
# and for the remaining the command is run.
set_from_init_file('L2H_SKIP', undef);

# If this is set l2h uses the specified directory for temporary files. The path
# leading to this directory may not contain a dot (i.e., a ".");
# otherwise, l2h will fail.
set_from_init_file('L2H_TMP', '');

# If set, l2h uses the file as latex2html init file
set_from_init_file('L2H_FILE', undef);

# if this is set the intermediate files generated by texi2html in relation with
# latex2html are cleaned (they all have the prefix <document name>_l2h_).
set_from_init_file('L2H_CLEAN', 1);

# latex2html conversions consist of 2 stages:
# 1) l2h_process
#    to latex: Put "latex" code into a latex file
#                    (l2h_to_latex, l2h_finish_to_latex)
#    to html: Use latex2html to generate corresponding html code and images
#                    (l2h_to_html)
#    from html: Extract generated code and images from latex2html run
#                    (l2h_init_from_html)
# 2) l2h_do_tex called each time a @tex or @math command is encountered
#               in the output tree.

# init l2h defaults for files and names

my ($l2h_name, $l2h_latex_file, $l2h_cache_file, $l2h_html_file, $l2h_prefix);

# holds the status of latex2html operations. If 0 it means that there was
# an error
my $status = 0;

my $debug;
my $verbose;
my $docu_rdir;
my $docu_volume;
my $docu_directories;
my $docu_name;

my %commands_counters;

# init_from_html
my $extract_error_count;
my $invalid_counter_count;

# change_image_file_names
my %l2h_img;            # associate src file to destination file
                        # such that files are not copied twice
my $image_count;

# do_tex
my $html_output_count = 0;   # html text outputed in html result file

##########################
#
# First stage: Generation of Latex file
# Initialize with: init
# Add content with: l2h_to_latex ($text) --> HTML placeholder comment
# Finish with: finish_to_latex
#

my $l2h_latex_preamble = <<EOT;
% This document was automatically generated by the l2h extenstion of texi2html
% DO NOT EDIT !!!
\\documentclass{article}
\\usepackage{html}
\\begin{document}
EOT

my $l2h_latex_closing = <<EOT;
\\end{document}
EOT

my %l2h_to_latex = ();         # associate a latex text with the index in the
                               # html result array.
my @l2h_to_latex = ();         # array used to associate the index with
                               # the original latex text.
my $latex_count = 0;           # number of latex texts really stored
my $latex_converted_count = 0; # number of latex texts passed through latex2html
my $to_latex_count = 0;        # total number of latex texts processed
my $cached_count = 0;          # number of cached latex texts
my %l2h_cache = ();            # the cache hash. Associate latex text with
                               # html from the previous run
my @l2h_from_html;             # array of resulting html

my %global_count = ();         # associate a command name and the
                               # corresponding counter to the index in the
                               # html result array

# set $status to 1, if l2h could be initalized properly, to 0 otherwise
sub l2h_process($)
{
  my $self = shift;
  %l2h_to_latex = ();         # associate a latex text with the index in the
                              # html result array.
  @l2h_to_latex = ();         # array used to associate the index with
                              # the original latex text.
  $latex_count = 0;           # number of latex texts really stored
  $latex_converted_count = 0; # number of latex texts passed through latex2html
  $to_latex_count = 0;        # total number of latex texts processed
  $cached_count = 0;          # number of cached latex texts
  %l2h_cache = ();            # the cache hash. Associate latex text with
                              # html from the previous run
  @l2h_from_html = ();        # array of resulting html

  %global_count = ();         # associate a command name and the
                              # corresponding counter to the index in the
                              # html result array
  %commands_counters = ();
  $extract_error_count = 0;
  $invalid_counter_count = 0;
  %l2h_img = ();       # associate src file to destination file
                       # such that files are not copied twice
  $image_count = 1;

  $html_output_count = 0;   # html text outputed in html result file
  $status = 0;
  return if (defined($self->get_conf('OUTFILE'))
        and $Texinfo::Common::null_device_file{$self->get_conf('OUTFILE')});

  $docu_name = $self->{'document_name'};
  $docu_rdir = $self->{'destination_directory'};
  $docu_rdir = '' if (!defined($docu_rdir));
  my $no_file;
  ($docu_volume, $docu_directories, $no_file)
      = File::Spec->splitpath($docu_rdir, 1);
  $l2h_name =  "${docu_name}_l2h";
  $l2h_latex_file = File::Spec->catpath($docu_volume, $docu_directories,
                                        "${l2h_name}.tex");
  $l2h_cache_file = File::Spec->catpath($docu_volume, $docu_directories,
                                        "${docu_name}-l2h_cache.pm");
  # destination dir -- generated images are put there, should be the same
  # as dir of enclosing html document --
  $l2h_html_file = File::Spec->catpath($docu_volume, $docu_directories,
                                       "${l2h_name}.html");
  $l2h_prefix = "${l2h_name}_";
  $debug = $self->get_conf('DEBUG');
  $verbose = $self->get_conf('VERBOSE');

  unless ($self->get_conf('L2H_SKIP')) {
    unless (open(L2H_LATEX, ">$l2h_latex_file")) {
      $self->document_error(sprintf($self->__(
              "l2h: could not open latex file %s for writing: %s"),
                                    $l2h_latex_file, $!));
      $status = 0;
      return;
    }
    warn "# l2h: use ${l2h_latex_file} as latex file\n" if ($verbose);
    print L2H_LATEX $l2h_latex_preamble;
  }
  # open the database that holds cached text
  l2h_init_cache($self) if (!defined($self->get_conf('L2H_SKIP'))
                   or $self->get_conf('L2H_SKIP'));

  foreach my $command ('tex', 'math') {
    if ($self->{'extra'}->{$command}) {
      my $counter = 0;
      foreach my $root (@{$self->{'extra'}->{$command}}) {
        $counter++;
        my $tree;
        if ($command eq 'math') {
          $tree = $root->{'args'}->[0];
        } else {
          $tree = {'contents' => [@{$root->{'contents'}}]};
          if ($tree->{'contents'}->[0]
              and $tree->{'contents'}->[0]->{'type'}
              and $tree->{'contents'}->[0]->{'type'} eq 'empty_line_after_command') {
            shift @{$tree->{'contents'}};
          }
          if ($tree->{'contents'}->[-1]->{'cmdname'}
              and $tree->{'contents'}->[-1]->{'cmdname'} eq 'end') {
            pop @{$tree->{'contents'}};
          }
        }
        my $text = Texinfo::Convert::Texinfo::convert($tree);
        #$text .= "\n" if ($command eq 'tex');
        l2h_to_latex($self, $command, $text, $counter);
        $commands_counters{$root} = $counter;
      }
    }
  }
  $status = l2h_finish_to_latex($self);
  if ($status) {
    $status = l2h_to_html($self);
  }
  if ($status) {
    $status = l2h_init_from_html($self);
  }
  # FIXME use $status?  That is abort when something goes wrong on the
  # latex2html front?
  return 1;
}

# print text (2nd arg) into latex file (if not already there nor in cache)
# which can be later on replaced by the latex2html generated text.
#
sub l2h_to_latex($$$$)
{
  my $self = shift;
  my $command = shift;
  my $text = shift;
  my $counter = shift;

  if ($command eq 'tex') {
    $text .= ' ';
  } elsif ($command eq 'math') {
    $text = "\$".$text."\$";
  }
  $to_latex_count++;
  $text =~ s/(\s*)$//;
  # try whether we have text already on things to do
  my $count = $l2h_to_latex{$text};
  unless ($count) {
    $latex_count++;
    $count = $latex_count;
    # try whether we can get it from cache
    my $cached_text = l2h_from_cache($text);
    if (defined($cached_text)) {
      $cached_count++;
      # put the cached result in the html result array
      $l2h_from_html[$count] = $cached_text;
    } else {
      $latex_converted_count++;
      unless ($self->get_conf('L2H_SKIP')) {
        print L2H_LATEX "\\begin{rawhtml}\n\n";
        print L2H_LATEX "<!-- l2h_begin $l2h_name $count -->\n";
        print L2H_LATEX "\\end{rawhtml}\n";

        print L2H_LATEX "$text\n";

        print L2H_LATEX "\\begin{rawhtml}\n";
        print L2H_LATEX "<!-- l2h_end $l2h_name $count -->\n\n";
        print L2H_LATEX "\\end{rawhtml}\n";
      }
    }
    $l2h_to_latex[$count] = $text;
    $l2h_to_latex{$text} = $count;
  }
  $global_count{"${command}_$counter"} = $count;
  return 1;
}

# print closing into latex file and close it
sub l2h_finish_to_latex($)
{
  my $self = shift;
  my $reused = $to_latex_count - $latex_converted_count - $cached_count;
  unless ($self->get_conf('L2H_SKIP')) {
    print L2H_LATEX $l2h_latex_closing;
    close (L2H_LATEX);
  }
  warn "# l2h: finished to latex ($cached_count cached, $reused reused, $latex_converted_count to process)\n" if ($verbose);
  unless ($latex_count) {
    # no @tex nor @math
    l2h_finish($self);
    return 0;
  }
  return 1;
}

###################################
# Use latex2html to generate corresponding html code and images
#
# to_html([$l2h_latex_file, [$l2h_html_dir]]):
#   Call latex2html on $l2h_latex_file
#   Put images (prefixed with $l2h_name."_") and html file(s) in $l2h_html_dir
#   Return 1, on success
#          0, otherwise
#
sub l2h_to_html($)
{
  my $self = shift;
  my ($call, $dotbug);
  # when there are no tex constructs to convert (happens in case everything
  # comes from the cache), there is no latex2html run
  if ($self->get_conf('L2H_SKIP') or ($latex_converted_count == 0)) {
     warn "# l2h: skipping latex2html run\n" if ($verbose);
     return 1;
  }
  # Check for dot in directory where dvips will work
  if ($self->get_conf('L2H_TMP')) {
    if ($self->get_conf('L2H_TMP') =~ /\./) {
      $self->document_warn($self->__("l2h: L2H_TMP directory contains a dot"));
      $dotbug = 1;
    }
  } else {
    if (cwd() =~ /\./) {
      $self->document_warn($self->__("l2h: current directory contains a dot"));
      $dotbug = 1;
    }
  }
  return 0 if ($dotbug);

  $call = $self->get_conf('L2H_L2H');
  # use init file, if specified
  my $init_file = $self->get_conf('L2H_FILE');
  $call = $call . " -init_file " . $init_file
    if (defined($init_file) and $init_file ne ''
        and -f $init_file and -r $init_file);
  # set output dir
  $call .=  (($docu_rdir ne '') ? " -dir $docu_rdir" : " -no_subdir");
  # use l2h_tmp, if specified
  $call .= " -tmp ".$self->get_conf('L2H_TMP')
    if (defined($self->get_conf('L2H_TMP'))
        and $self->get_conf('L2H_TMP') ne '');
  # use a given html version if specified
  $call .= " -html_version ".$self->get_conf('L2H_HTML_VERSION')
    if (defined($self->get_conf('L2H_HTML_VERSION'))
        and $self->get_conf('L2H_HTML_VERSION') ne '');
  # options we want to be sure of
  $call .= " -address 0 -info 0 -split 0 -no_navigation -no_auto_link";
  $call .= " -prefix $l2h_prefix $l2h_latex_file";

  warn "# l2h: executing '$call'\n" if ($verbose);
  if (system($call)) {
    $self->document_error(sprintf($self->__("l2h: command did not succeed: %s"),
                                  $call));
    return 0;
  } else  {
     warn "# l2h: latex2html finished successfully\n" if ($verbose);
     return 1;
  }
}

##########################
# Third stage: Extract generated contents from latex2html run
# Initialize with: init_from_html
#   open $l2h_html_file for reading
#   reads in contents into array indexed by numbers
#   return 1,  on success -- 0, otherwise
# Finish with: finish
#   closes $l2h_html_dir/$l2h_name.".$docu_ext"

# the images generated by latex2html have names like ${docu_name}_l2h_img?.png
# they are copied to ${docu_name}_?.png, and html is changed accordingly.

# FIXME is it really necessary to bother doing that? Looks like an unneeded
# complication to me (pertusus, 2009), and it could go bad if there is some
# SRC="(.*?)" in the text (though the regexp could be made more specific).

# %l2h_img;            # associate src file to destination file
                        # such that files are not copied twice
sub l2h_change_image_file_names($$)
{
  my $self = shift;
  my $content = shift;
  my @images = ($content =~ /SRC="(.*?)"/g);
  my ($src, $dest);

  for $src (@images) {
    $dest = $l2h_img{$src};
    unless ($dest) {
      my $ext = '';
      if ($src =~ /.*\.(.*)$/ and (!defined($self->get_conf('EXTENSION'))
                                    or $1 ne $self->get_conf('EXTENSION'))) {
        $ext = ".$1";
      } else {
        # A warning when the image extension is the same than the
        # document extension. copying the file could result in
        # overwriting an output file (almost surely if the default
        # texi2html file names are used).
        $self->document_warn(sprintf($self->__(
                            "l2h: image has invalid extension: %s"), $src));
        next;
      }
      while (-e File::Spec->catpath($docu_volume, $docu_directories,
                                    "${docu_name}_${image_count}$ext")) {
        $image_count++;
      }
      my $file_src
        = File::Spec->catpath($docu_volume, $docu_directories, $src);
      $dest = "${docu_name}_${image_count}$ext";
      my $file_dest
        = File::Spec->catpath($docu_volume, $docu_directories, $dest);
      if ($debug) {
        copy($file_src, $file_dest);
      } else {
        if (!rename($file_src, $file_dest)) {
          $self->document_warn(sprintf($self->__("l2h: rename %s as %s failed: %s"),
                                       $file_src, $file_dest, $!));
        }
      }
      $l2h_img{$src} = $dest;
    }
  $content =~ s/SRC="$src"/SRC="$dest"/g;
  }
  return $content;
}

sub l2h_init_from_html($)
{
  my $self = shift;
  # when there are no tex constructs to convert (happens in case everything
  # comes from the cache), the html file that was generated by previous
  # latex2html runs isn't reused.
  if ($latex_converted_count == 0) {
    return 1;
  }

  if (! open(L2H_HTML, "<$l2h_html_file")) {
    $self->document_warn(sprintf($self->__("l2h: could not open %s: %s"),
                                 $l2h_html_file, $!));
    return 0;
  }
  warn "# l2h: use $l2h_html_file as html file\n" if ($verbose);

  my $html_converted_count = 0;   # number of html resulting texts
                                  # retrieved in the file

  my ($count, $h_line);
  while ($h_line = <L2H_HTML>) {
    if ($h_line =~ /!-- l2h_begin $l2h_name ([0-9]+) --/) {
      $count = $1;
      my $h_content = '';
      my $h_end_found = 0;
      while ($h_line = <L2H_HTML>) {
        if ($h_line =~ /!-- l2h_end $l2h_name $count --/) {
          $h_end_found = 1;
          chomp $h_content;
          chomp $h_content;
          $html_converted_count++;
          # transform image file names and copy image files
          $h_content = l2h_change_image_file_names($self, $h_content);
          # store result in the html result array
          $l2h_from_html[$count] = $h_content;
          # also add the result in cache hash
          $l2h_cache{$l2h_to_latex[$count]} = $h_content;
          last;
        }
        $h_content = $h_content.$h_line;
      }
      unless ($h_end_found) {
        # couldn't found the closing comment. Should be a bug.
        $self->document_warn(sprintf(__("latex2html.pm: end of \@%s item %d not found"),
                                      $l2h_name, $count));
        close(L2H_HTML);
        return 0;
      }
    }
  }

  # Not the same number of converted elements and retrieved elements
  if ($latex_converted_count != $html_converted_count) {
    $self->document_warn(sprintf($self->__(
      "latex2html.pm: processing produced %d items in HTML; expected %d, the number of items found in the document"),
                          $html_converted_count, $latex_converted_count));
  }

  warn "# l2h: Got $html_converted_count of $latex_count html contents\n"
    if ($verbose);

  close(L2H_HTML);
  return 1;
}

# $html_output_count = 0;   # html text outputed in html result file

# called each time a construct handled by latex2html is encountered, should
# output the corresponding html
sub l2h_do_tex($$)
{
  my $self = shift;
  my $cmdname = shift;;
  my $command = shift;
  my $content = shift;

  my $counter = $commands_counters{$command};
  return '' unless ($status);
  my $count = $global_count{"${cmdname}_$counter"};
  ################################## begin debug section (incorrect counts)
  if (!defined($count)) {
    # counter is undefined
    $invalid_counter_count++;
    $self->document_warn(
           sprintf($self->__("l2h: could not determine the fragment %d for \@%s",
                   $counter, $cmdname)));
    return ("<!-- l2h: ". __LINE__ . " undef count for ${cmdname}_$counter -->")
      if ($debug);
    return '';
  } elsif(($count <= 0) or ($count > $latex_count)) {
    # counter out of range
    $invalid_counter_count++;
    $self->_bug_message("l2h: request of $count out of range [0,$latex_count]");
    return ("<!-- l2h: ". __LINE__ . " out of range count $count -->")
      if ($debug);
    return '';
  }
  ################################## end debug section (incorrect counts)

  # this seems to be a valid counter
  my $result = '';
  $result = "<!-- l2h_begin $l2h_name $count -->" if ($debug);
  if (defined($l2h_from_html[$count])) {
    $html_output_count++;
    $result .= $l2h_from_html[$count];
    $result .= "\n" if ($cmdname eq 'tex');
  } else {
    # if the result is not in @l2h_from_html, there is an error somewhere.
    $extract_error_count++;
    $self->document_warn(sprintf($self->__(
       "l2h: could not extract the fragment %d for \@%s with output counter %d from HTML"),
                   $counter, $cmdname, $count));
    # try simple (ordinary) substitution (without l2h)
    $result .= "<!-- l2h: ". __LINE__ . " use default -->" if ($debug);
    $result .= &{$self->default_commands_conversion($cmdname)}($self,
                                                 $cmdname, $command, $content);
  }
  $result .= "<!-- l2h_end $l2h_name $count -->" if ($debug);
  return $result;
}

# store results in the cache and remove temporary files.
sub l2h_finish($)
{
  my $self = shift;
  return 1 unless($status);

  if ($verbose) {
    if ($extract_error_count + $invalid_counter_count) {
      warn "# l2h: finished from html ($extract_error_count extract and $invalid_counter_count invalid counter errors)\n";
    } else {
      warn "# l2h: finished from html (no error)\n";
    }
    if ($html_output_count != $latex_converted_count) {
      # this may happen if @-commands are collected at some places
      # but @-command at those places are not expanded later. For
      # example @math on @multitable lines.
      warn "# l2h: $html_output_count html outputed for $latex_converted_count converted\n";
    }
  }
  l2h_store_cache($self);
  if ($self->get_conf('L2H_CLEAN')) {
    warn "# l2h: removing temporary files generated by l2h extension\n"
     if ($verbose);
    my $quoted_l2h_name = quotemeta($l2h_name);
    my $dir = $docu_rdir;
    $dir = File::Spec->curdir() if ($dir eq '');
    if (opendir (DIR, $dir)) {
      foreach my $file (grep { /^$quoted_l2h_name/ } readdir(DIR)) {
      # FIXME error condition not checked
        unlink File::Spec->catpath($docu_volume, $docu_directories, $file);
      }
    }
  }
  warn "# l2h: Finished\n" if $verbose;
  return 1;
}

##############################
# stuff for l2h caching
#
# FIXME it is clear that l2h stuff takes very long compared with texi2any
# which is already quite long. However this also adds some complexity

# I tried doing this with a dbm data base, but it did not store all
# keys/values. Hence, I did as latex2html does it
sub l2h_init_cache($)
{
  my $self = shift;
  if (-r $l2h_cache_file) {
    my $rdo = do "$l2h_cache_file";
    $self->document_error(sprintf($self->__("l2h: could not load %s: %s"),
                                  $l2h_cache_file, $@))
      unless ($rdo);
  }
}

# store all the text obtained through latex2html
sub l2h_store_cache($)
{
  my $self = shift;
  return unless $latex_count;
  my ($key, $value);
  unless (open(FH, ">$l2h_cache_file")) {
    $self->document_error(sprintf($self->__("l2h: could not open %s for writing: %s"),
                                  $l2h_cache_file, $!));
    return;
  }
  foreach my $key(sort(keys(%l2h_cache))) {
  #while (($key, $value) = each %l2h_cache) {
    my $value = $l2h_cache{$key};
    # escape stuff
    $key =~ s|/|\\/|g;
    $key =~ s|\\\\/|\\/|g;
    # weird, a \ at the end of the key results in an error
    # maybe this also broke the dbm database stuff
    $key =~ s|\\$|\\\\|;
    $value =~ s/\|/\\\|/go;
    $value =~ s/\\\\\|/\\\|/go;
    $value =~ s|\\\\|\\\\\\\\|g;
    print FH "\n\$l2h_cache_key = q/$key/;\n";
    print FH "\$l2h_cache{\$l2h_cache_key} = q|$value|;\n";
  }
  print FH "1;";
  close (FH);
}

# return cached html, if it exists for text, and if all pictures
# are there, as well
sub l2h_from_cache($)
{
  my $text = shift;
  my $cached = $l2h_cache{$text};
  if (defined($cached)) {
    while ($cached =~ m/SRC="(.*?)"/g) {
      unless (-e File::Spec->catpath($docu_volume, $docu_directories, $1)) {
        return undef;
      }
    }
    return $cached;
  }
  return undef;
}

1;