summaryrefslogtreecommitdiff
path: root/macros/texinfo/texinfo/tp/Texinfo/Transformations.pm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2022-11-09 03:02:50 +0000
committerNorbert Preining <norbert@preining.info>2022-11-09 03:02:50 +0000
commit5de83ec843cdc88e6adc42b1fe3f0ec48c52b7f3 (patch)
treeb49f7c180396c8ef389c8fd519370b6d03f4e100 /macros/texinfo/texinfo/tp/Texinfo/Transformations.pm
parent118cb5bbc5236bf86ca1088b9b3bae04c7b09beb (diff)
CTAN sync 202211090302
Diffstat (limited to 'macros/texinfo/texinfo/tp/Texinfo/Transformations.pm')
-rw-r--r--macros/texinfo/texinfo/tp/Texinfo/Transformations.pm636
1 files changed, 414 insertions, 222 deletions
diff --git a/macros/texinfo/texinfo/tp/Texinfo/Transformations.pm b/macros/texinfo/texinfo/tp/Texinfo/Transformations.pm
index 6e5cdee10d..482f340ecb 100644
--- a/macros/texinfo/texinfo/tp/Texinfo/Transformations.pm
+++ b/macros/texinfo/texinfo/tp/Texinfo/Transformations.pm
@@ -1,6 +1,6 @@
# Transformations.pm: some transformations of the document tree
#
-# Copyright 2010-2019 Free Software Foundation, Inc.
+# Copyright 2010-2022 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
@@ -24,10 +24,29 @@ use 5.00405;
use strict;
+# To check if there is no erroneous autovivification
+#no autovivification qw(fetch delete exists store strict);
+
+
+use Carp qw(cluck);
+
+use Texinfo::Commands;
use Texinfo::Common;
+use Texinfo::Translations;
use Texinfo::Structuring;
-use Carp qw(cluck);
+require Exporter;
+use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
+@ISA = qw(Exporter);
+
+%EXPORT_TAGS = ( 'all' => [ qw(
+protect_hashchar_at_line_beginning
+reference_to_arg_in_tree
+) ] );
+
+@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+$VERSION = '7.0';
# Add raise/lowersections to be back at the normal level
sub _correct_level($$;$)
@@ -61,14 +80,10 @@ sub _correct_level($$;$)
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') {
+ and $Texinfo::Commands::root_commands{$content->{'cmdname'}}) {
push @sections_list, $content;
}
}
@@ -85,12 +100,12 @@ sub fill_gaps_in_sectioning($)
}
my $current_section = shift @sections_list;
my $current_section_level
- = Texinfo::Structuring::section_level($current_section);
+ = Texinfo::Common::section_level($current_section);
my $next_section = $sections_list[0];
if (defined($next_section)) {
my $next_section_level
- = Texinfo::Structuring::section_level($next_section);
+ = Texinfo::Common::section_level($next_section);
if ($next_section_level - $current_section_level > 1) {
my @correct_level_offset_commands = _correct_level($next_section,
@@ -98,15 +113,13 @@ sub fill_gaps_in_sectioning($)
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',
+ $new_section->{'contents'} = [{'type' => 'empty_line',
'text' => "\n",
'parent' => $new_section}];
$new_section->{'args'} = [{'type' => 'line_arg',
@@ -127,7 +140,6 @@ sub fill_gaps_in_sectioning($)
'parent' => $new_section->{'args'}->[0]->{'contents'}->[1]}];
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);
@@ -140,19 +152,18 @@ sub fill_gaps_in_sectioning($)
return (\@contents, \@added_sections);
}
-# This converts a reference @-command to simple text using one of the
-# arguments. This is used to remove reference @-command from
+# This converts a reference @-command to simple text using one of the
+# arguments. This is used to remove reference @-command from
# constructed node names trees, as node names cannot contain
-# reference @-command while there could be some in the tree used in
+# reference @-command while there could be some in the tree used in
# input for the node name tree.
sub _reference_to_arg($$$)
{
- my $self = shift;
my $type = shift;
my $current = shift;
- if ($current->{'cmdname'} and
- $Texinfo::Common::ref_commands{$current->{'cmdname'}}
+ if ($current->{'cmdname'} and
+ $Texinfo::Commands::ref_commands{$current->{'cmdname'}}
and $current->{'args'}) {
my @args_try_order;
if ($current->{'cmdname'} eq 'inforef') {
@@ -164,7 +175,8 @@ sub _reference_to_arg($$$)
if (defined($current->{'args'}->[$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]);
+ my $text = Texinfo::Convert::Text::convert_to_text(
+ $current->{'args'}->[$index]);
if (defined($text) and $text =~ /\S/) {
my $result
= {'contents' => $current->{'args'}->[$index]->{'contents'},
@@ -179,67 +191,95 @@ sub _reference_to_arg($$$)
}
}
-sub reference_to_arg_in_tree($$)
+sub reference_to_arg_in_tree($)
{
- my $self = shift;
my $tree = shift;
- return Texinfo::Common::modify_tree($self, $tree, \&_reference_to_arg);
+ return Texinfo::Common::modify_tree($tree, \&_reference_to_arg);
}
# prepare a new node
-sub _new_node($$)
+# modifies $nodes_list, $targets_list, $labels
+sub _new_node($$$$)
{
- my $self = shift;
my $node_tree = shift;
+ my $nodes_list = shift;
+ my $targets_list = shift;
+ my $labels = shift;
+ # We protect for all the contexts, as the node name should be
+ # the same in the different contexts, even if some protections
+ # are not needed for the parsing. Also, this way the node tree
+ # can be directly reused in the menus for example, without
+ # additional protection, some parts could be double protected
+ # otherwise, those that are protected with @asis.
+ #
+ # needed in nodes lines, @*ref and in menus with a label
$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);
+ # always
+ $node_tree->{'contents'}
+ = Texinfo::Common::protect_first_parenthesis($node_tree->{'contents'})
+ if ($node_tree->{'contents'});
+ # in menu entry without label
+ $node_tree = Texinfo::Common::protect_colon_in_tree($node_tree);
+ # in menu entry with label
+ $node_tree = Texinfo::Common::protect_node_after_label_in_tree($node_tree);
+ $node_tree = reference_to_arg_in_tree($node_tree);
my $empty_node = 0;
- if (!$node_tree->{'contents'}
+ 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 $comment_at_end;
+ if ($node_tree->{'contents'}->[-1]->{'cmdname'}
+ and ($node_tree->{'contents'}->[-1]->{'cmdname'} eq 'c'
+ or $node_tree->{'contents'}->[-1]->{'cmdname'} eq 'comment')) {
+ $comment_at_end = pop @{$node_tree->{'contents'}};
}
+ my $spaces_after_argument = '';
+ if (scalar(@{$node_tree->{'contents'}}) > 0
+ and $node_tree->{'contents'}->[-1]->{'text'}
+ and $node_tree->{'contents'}->[-1]->{'text'} =~ s/(\s+)$//) {
+ $spaces_after_argument = $1;
+ }
+ $spaces_after_argument .= "\n" unless ($spaces_after_argument =~ /\n/
+ or $comment_at_end);
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'}});
+ while (!defined($node)
+ or ($labels
+ and $labels->{$parsed_node->{'normalized'}})) {
+ $node = {'cmdname' => 'node',
+ 'args' => [
+ {'type' => 'line_arg',
+ 'extra' =>
+ {'spaces_after_argument' => $spaces_after_argument}}
+ ],
+ 'extra' => {'spaces_before_argument' => ' '}};
+ my $node_line_arg = $node->{'args'}->[0];
+ $node_line_arg->{'parent'} = $node;
+ $node_line_arg->{'extra'}->{'comment_at_end'} = $comment_at_end
+ if (defined($comment_at_end));
+ @{$node_line_arg->{'contents'}} = (@{$node_tree->{'contents'}});
if ($appended_number) {
- splice (@{$node_arg->{'contents'}}, -1, 0,
- {'text' => " $appended_number"});
+ push @{$node_line_arg->{'contents'}}, {'text' => " $appended_number"};
}
- foreach my $content (@{$node_arg->{'contents'}}) {
- $content->{'parent'} = $node_arg;
+ foreach my $content (@{$node_line_arg->{'contents'}}) {
+ $content->{'parent'} = $node_line_arg;
}
- $parsed_node = Texinfo::Common::parse_node_manual($node_arg);
+ my $modified_node_content;
+ ($parsed_node, $modified_node_content)
+ = Texinfo::Common::parse_node_manual($node_line_arg);
if ($parsed_node and $parsed_node->{'node_content'}) {
$parsed_node->{'normalized'} =
- Texinfo::Convert::NodeNameNormalization::normalize_node (
+ Texinfo::Convert::NodeNameNormalization::normalize_node(
{ 'contents' => $parsed_node->{'node_content'} });
}
+ $node_line_arg->{'contents'} = $modified_node_content;
if (!defined($parsed_node) or !$parsed_node->{'node_content'}
or $parsed_node->{'normalized'} !~ /[^-]/) {
if ($appended_number) {
@@ -253,82 +293,84 @@ sub _new_node($$)
push @{$node->{'extra'}->{'nodes_manuals'}}, $parsed_node;
if ($parsed_node->{'normalized'} ne '') {
- $self->{'labels'}->{$parsed_node->{'normalized'}} = $node;
+ $labels->{$parsed_node->{'normalized'}} = $node;
$node->{'extra'}->{'normalized'} = $parsed_node->{'normalized'};
}
- push @{$self->{'targets'}}, $node;
- if ($parsed_node->{'node_content'}) {
- $node->{'extra'}->{'node_content'} = $parsed_node->{'node_content'};
- }
- push @{$self->{'nodes'}}, $node;
+ Texinfo::Common::register_label($targets_list, $node, $parsed_node);
+ push @{$nodes_list}, $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};
+ my $argument = shift;
+ my ($new_node, $previous_node) = @{$argument};
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'}}) {
+ if (not defined($previous_node->{'extra'}->{'menus'})
+ or not scalar(@{$previous_node->{'extra'}->{'menus'}})
+ or not (grep {$current eq $_} @{$previous_node->{'extra'}->{'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'}});
+ @{$previous_node->{'extra'}->{'menus'}}
+ = grep {$_ ne $current} @{$previous_node->{'extra'}->{'menus'}};
+ delete $previous_node->{'extra'}->{'menus'} if !(@{$previous_node->{'extra'}->{'menus'}});
}
}
- push @{$new_node->{'menus'}}, $current;
+ push @{$new_node->{'extra'}->{'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)) {
+ if ($previous_node
+ and (!$current->{'extra'}->{'index_entry'}->{'entry_node'}
+ or $current->{'extra'}->{'index_entry'}->{'entry_node'} ne $previous_node)) {
print STDERR "Bug: index entry $current (".
- Texinfo::Convert::Texinfo::convert ({'contents' => $current->{'extra'}->{'index_entry'}->{'content'}})
+ Texinfo::Convert::Texinfo::convert_to_texinfo(
+ {'contents' => $current->{'extra'}->{'index_entry'}->{'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 " previous node: "
+ .Texinfo::Convert::Texinfo::root_heading_command_to_texinfo($previous_node)."\n";
+ if ($current->{'extra'}->{'index_entry'}->{'entry_node'}) {
print STDERR " current node: ".
- _print_root_command_texi($current->{'extra'}->{'index_entry'}->{'node'})."\n";
+ Texinfo::Convert::Texinfo::root_heading_command_to_texinfo(
+ $current->{'extra'}->{'index_entry'}->{'entry_node'})."\n";
} else {
print STDERR " current node not set\n";
}
}
- $current->{'extra'}->{'index_entry'}->{'node'} = $new_node;
+ $current->{'extra'}->{'index_entry'}->{'entry_node'} = $new_node;
}
return ($current);
}
-sub insert_nodes_for_sectioning_commands($$)
+# modifies $nodes_list, $targets_list, $labels
+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 $nodes_list = shift;
+ my $targets_list = shift;
+ my $labels = shift;
+
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 $Texinfo::Commands::root_commands{$content->{'cmdname'}}
+ 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'
+ $new_node_tree = Texinfo::Common::copy_tree({'contents'
=> $content->{'args'}->[0]->{'contents'}});
}
- my $new_node = _new_node($self, $new_node_tree);
+ my $new_node = _new_node($new_node_tree, $nodes_list,
+ $targets_list, $labels);
if (defined($new_node)) {
push @contents, $new_node;
push @added_nodes, $new_node;
@@ -336,13 +378,13 @@ sub insert_nodes_for_sectioning_commands($$)
$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,
+ Texinfo::Common::modify_tree($content, \&_reassociate_to_node,
[$new_node, $previous_node]);
}
}
# check normalized to avoid erroneous nodes, such as duplicates
- $previous_node = $content
- if ($content->{'cmdname'}
+ $previous_node = $content
+ if ($content->{'cmdname'}
and $content->{'cmdname'} eq 'node'
and $content->{'extra'}->{'normalized'});
push @contents, $content;
@@ -363,40 +405,42 @@ sub _prepend_new_menu_in_node_section($$$)
push @{$section->{'contents'}}, {'type' => 'empty_line',
'text' => "\n",
'parent' => $section};
- push @{$node->{'menus'}}, $current_menu;
+ push @{$node->{'extra'}->{'menus'}}, $current_menu;
}
-sub complete_node_menu($$;$)
+sub complete_node_menu($;$)
{
- my $self = shift;
my $node = shift;
my $use_sections = shift;
- my @node_childs = Texinfo::Structuring::get_node_node_childs($node);
+ my @node_childs
+ = Texinfo::Structuring::get_node_node_childs_from_sectioning($node);
if (scalar(@node_childs)) {
my %existing_entries;
- if ($node->{'menus'} and @{$node->{'menus'}}) {
- foreach my $menu (@{$node->{'menus'}}) {
+ if ($node->{'extra'}->{'menus'} and @{$node->{'extra'}->{'menus'}}) {
+ foreach my $menu (@{$node->{'extra'}->{'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'}}
+ my ($normalized_entry_node, $node)
+ = _normalized_entry_associated_internal_node($entry);
+ if (defined($normalized_entry_node)) {
+ $existing_entries{$normalized_entry_node}
= [$menu, $entry];
}
}
}
}
}
- #print STDERR join('|', keys(%existing_entries))."\n";
+ #print STDERR "existing_entries: ".join('|', keys(%existing_entries))."\n";
my @pending;
my $current_menu;
foreach my $node_entry (@node_childs) {
- if ($existing_entries{$node_entry->{'extra'}->{'normalized'}}) {
+ if ($node_entry->{'extra'}
+ and defined($node_entry->{'extra'}->{'normalized'})
+ and $existing_entries{$node_entry->{'extra'}->{'normalized'}}) {
my $entry;
- ($current_menu, $entry)
+ ($current_menu, $entry)
= @{$existing_entries{$node_entry->{'extra'}->{'normalized'}}};
if (@pending) {
my $index;
@@ -411,16 +455,18 @@ sub complete_node_menu($$;$)
@pending = ();
}
} else {
- my $entry = Texinfo::Structuring::new_node_menu_entry($self,
- $node_entry, $use_sections);
- push @pending, $entry;
+ my $entry = Texinfo::Structuring::new_node_menu_entry($node_entry,
+ $use_sections);
+ # not defined $entry should mean an empty node. We do not warn as
+ # we try, in general, to be silent in the transformations.
+ push @pending, $entry if (defined($entry));
}
}
if (scalar(@pending)) {
if (!$current_menu) {
my $section = $node->{'extra'}->{'associated_section'};
$current_menu =
- Texinfo::Structuring::new_block_command (\@pending, $section, 'menu');
+ Texinfo::Structuring::new_block_command(\@pending, $section, 'menu');
_prepend_new_menu_in_node_section($node, $section, $current_menu);
} else {
foreach my $entry (@pending) {
@@ -442,15 +488,11 @@ sub _get_non_automatic_nodes_with_sections($)
{
my $root = shift;
- if (!$root->{'type'} or $root->{'type'} ne 'document_root'
- or !$root->{'contents'}) {
- return undef;
- }
my @non_automatic_nodes;
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'}
and $content->{'extra'}->{'associated_section'}) {
push @non_automatic_nodes, $content;
}
@@ -459,36 +501,30 @@ sub _get_non_automatic_nodes_with_sections($)
}
# This should be called after Texinfo::Structuring::sectioning_structure.
-sub complete_tree_nodes_menus($$;$)
+sub complete_tree_nodes_menus($;$)
{
- my $self = shift;
my $root = shift;
my $use_sections = shift;
my $non_automatic_nodes = _get_non_automatic_nodes_with_sections($root);
- if (not defined($non_automatic_nodes)) {
- return undef;
- }
foreach my $node (@{$non_automatic_nodes}) {
- complete_node_menu($self, $node, $use_sections);
+ complete_node_menu($node, $use_sections);
}
}
# this only complete menus if there was no menu
-sub complete_tree_nodes_missing_menu($$;$)
+sub complete_tree_nodes_missing_menu($;$)
{
- my $self = shift;
my $root = shift;
my $use_sections = shift;
my $non_automatic_nodes = _get_non_automatic_nodes_with_sections($root);
- if (not defined($non_automatic_nodes)) {
- return undef;
- }
foreach my $node (@{$non_automatic_nodes}) {
- if (not $node->{'menus'} or not scalar(@{$node->{'menus'}})) {
+ if (not $node->{'extra'}->{'menus'}
+ or not scalar(@{$node->{'extra'}->{'menus'}})) {
my $section = $node->{'extra'}->{'associated_section'};
- my $current_menu = Texinfo::Structuring::new_complete_node_menu($self, $node, $use_sections);
+ my $current_menu
+ = Texinfo::Structuring::new_complete_node_menu($node, $use_sections);
if (defined($current_menu)) {
_prepend_new_menu_in_node_section($node, $section, $current_menu);
}
@@ -496,37 +532,25 @@ sub complete_tree_nodes_missing_menu($$;$)
}
}
-sub _copy_contents($)
+sub _print_down_menus($$);
+sub _print_down_menus($$)
{
- 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'}})) {
+ if ($node->{'extra'}->{'menus'} and scalar(@{$node->{'extra'}->{'menus'}})) {
my @node_children;
- foreach my $menu (@{$node->{'menus'}}) {
+ foreach my $menu (@{$node->{'extra'}->{'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;
- }
+ # gather node children to recursively print their menus
+ my ($normalized_entry_node, $node)
+ = _normalized_entry_associated_internal_node($entry, $labels);
+ if (defined($node) and $node->{'extra'}) {
+ push @node_children, $node;
}
}
}
@@ -539,11 +563,12 @@ sub _print_down_menus($$;$)
and $node->{'extra'}->{'associated_section'}->{'args'}->[0]
and $node->{'extra'}->{'associated_section'}->{'args'}->[0]->{'contents'}) {
$node_title_contents
- = _copy_contents($node->{'extra'}->{'associated_section'}->{'args'}->[0]->{'contents'});
+ = Texinfo::Common::copy_contents(
+ $node->{'extra'}->{'associated_section'}->{'args'}->[0]->{'contents'});
} else {
- $node_title_contents = _copy_contents($node->{'extra'}->{'node_content'});
+ $node_title_contents = Texinfo::Common::copy_contents($node->{'extra'}->{'node_content'});
}
- my $menu_comment = {'type' => 'menu_comment'};
+ my $menu_comment = {'type' => 'menu_comment', 'contents' => []};
$menu_comment->{'contents'}->[0] = {'type' => 'preformatted',
'parent' => $menu_comment};
@@ -558,34 +583,60 @@ sub _print_down_menus($$;$)
# now recurse in the children
foreach my $child (@node_children) {
- push @master_menu_contents, _print_down_menus($self, $child, $labels);
+ push @master_menu_contents, _print_down_menus($child, $labels);
}
}
}
return @master_menu_contents;
}
-sub new_master_menu($;$)
+if (0) {
+ # it is needed to mark the translation as gdt is called like
+ # Texinfo::Translations::gdt($self, ' --- The Detailed Node Listing ---')
+ # and not like gdt(' --- The Detailed Node Listing ---')
+ gdt(' --- The Detailed Node Listing ---');
+}
+
+sub _normalized_entry_associated_internal_node($;$)
+{
+ my $entry = shift;
+ my $labels = shift;
+
+ my $entry_node = $entry->{'extra'}->{'menu_entry_node'};
+ # 'normalized' is added by Texinfo::Structuring::associate_internal_references
+ # so it could be possible not to have 'normalized' set. In that case, it could
+ # still be determined with NodeNameNormalization::normalize_node.
+ my $normalized_entry_node = $entry_node->{'normalized'};
+ #my $normalized_entry_node
+ # = Texinfo::Convert::NodeNameNormalization::normalize_node(
+ # {'contents' => $entry_node->{'node_content'}});
+ if (! $entry_node->{'manual_content'}
+ and defined($normalized_entry_node)) {
+ if ($labels) {
+ return ($normalized_entry_node, $labels->{$normalized_entry_node});
+ } else {
+ return ($normalized_entry_node, undef);
+ }
+ }
+ return (undef, undef);
+}
+
+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'}}) {
+ if ($node->{'extra'}->{'menus'} and scalar(@{$node->{'extra'}->{'menus'}})) {
+ foreach my $menu (@{$node->{'extra'}->{'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);
- }
+ my ($normalized_entry_node, $node)
+ = _normalized_entry_associated_internal_node($entry, $labels);
+ if (defined($node) and $node->{'extra'}) {
+ push @master_menu_contents, _print_down_menus($node, $labels);
}
}
}
@@ -593,38 +644,41 @@ sub new_master_menu($;$)
}
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 = Texinfo::Translations::gdt($self,
+ ' --- 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');
+ return Texinfo::Structuring::new_block_command(\@master_menu_contents, undef,
+ 'detailmenu');
} else {
return undef;
}
}
-sub regenerate_master_menu($;$)
+# self is used to pass down a translatable object with customization
+# information for the gdt() call.
+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'}}));
+ return undef if (!defined($new_master_menu) or !$top_node->{'extra'}->{'menus'}
+ or !scalar(@{$top_node->{'extra'}->{'menus'}}));
- foreach my $menu (@{$top_node->{'menus'}}) {
+ foreach my $menu (@{$top_node->{'extra'}->{'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,
+ splice (@{$menu->{'contents'}}, $detailmenu_index, 1,
$new_master_menu);
return 1;
}
@@ -632,13 +686,14 @@ sub regenerate_master_menu($;$)
}
}
- my $last_menu = $top_node->{'menus'}->[-1];
+ my $last_menu = $top_node->{'extra'}->{'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'}
@@ -646,21 +701,25 @@ sub regenerate_master_menu($;$)
and $last_menu->{'contents'}->[$index-1]->{'contents'}->[-1]->{'type'}
and $last_menu->{'contents'}->[$index-1]->{'contents'}->[-1]->{'type'}
eq 'preformatted') {
+ # there is already a menu comment at the end of the menu, add an empty line
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') {
+ # there is a last menu entry, add a menu comment containing an empty line
+ # after it
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",
+ my $empty_line = {'type' => 'after_menu_description_line', 'text' => "\n",
'parent' => $preformatted};
push @{$preformatted->{'contents'}}, $empty_line;
}
+ # insert master menu
splice (@{$last_menu->{'contents'}}, $index, 0, $new_master_menu);
return 1;
@@ -699,7 +758,8 @@ sub menu_to_simple_menu($)
}
}
} elsif ($content->{'cmdname'}
- and $Texinfo::Common::menu_commands{$content->{'cmdname'}}) {
+ and $Texinfo::Commands::block_commands{$content->{'cmdname'}}
+ and $Texinfo::Commands::block_commands{$content->{'cmdname'}} eq 'menu') {
menu_to_simple_menu($content);
push @contents, $content;
} else {
@@ -731,12 +791,12 @@ sub menu_to_simple_menu($)
sub set_menus_to_simple_menu($)
{
- my $self = shift;
+ my $nodes_list = shift;
- if ($self->{'nodes'} and @{$self->{'nodes'}}) {
- foreach my $node (@{$self->{'nodes'}}) {
- if ($node->{'menus'}) {
- foreach my $menu (@{$node->{'menus'}}) {
+ if ($nodes_list) {
+ foreach my $node (@{$nodes_list}) {
+ if ($node->{'extra'}->{'menus'}) {
+ foreach my $menu (@{$node->{'extra'}->{'menus'}}) {
menu_to_simple_menu($menu);
}
}
@@ -744,106 +804,238 @@ sub set_menus_to_simple_menu($)
}
}
+sub _is_cpp_line($)
+{
+ my $text = shift;
+ return 1 if ($text =~ /^\s*#\s*(line)? (\d+)(( "([^"]+)")(\s+\d+)*)?\s*$/);
+ return 0;
+}
+
+# An element can be marked to be protected, it will actually be protected
+# when it is processed later on by Texinfo::Common::modify_tree
+sub _protect_hashchar_at_line_beginning($$$)
+{
+ my $type = shift;
+ my $current = shift;
+ my $argument = shift;
+
+ my ($registrar, $customization_information, $elements_to_protect) = @$argument;
+
+ #print STDERR "$type $current ".debug_print_element($current)."\n";
+ # if the next is a hash character at line beginning, mark it
+ if (defined($current->{'text'}) and $current->{'text'} =~ /\n$/
+ and $current->{'parent'} and $current->{'parent'}->{'contents'}) {
+ my $parent = $current->{'parent'};
+ #print STDERR "End of line in $current, parent $parent: (@{$parent->{'contents'}})\n";
+ my $current_found = 0;
+ foreach my $content (@{$parent->{'contents'}}) {
+ if ($current_found) {
+ #print STDERR "after $current: $content $content->{'text'}\n";
+ if ($content->{'text'} and _is_cpp_line($content->{'text'})) {
+ $elements_to_protect->{$content} = 1;
+ }
+ last;
+ } elsif ($content eq $current) {
+ $current_found = 1;
+ }
+ }
+ }
+
+ my $protect_hash = 0;
+ # if marked, or first and a cpp_line protect a leading hash character
+ if ($elements_to_protect->{$current}) {
+ $protect_hash = 1;
+ delete $elements_to_protect->{$current};
+ } elsif ($current->{'parent'}
+ and $current->{'parent'}->{'contents'}
+ and $current->{'parent'}->{'contents'}->[0]
+ and $current->{'parent'}->{'contents'}->[0] eq $current
+ and $current->{'text'}
+ and _is_cpp_line($current->{'text'})) {
+ $protect_hash = 1;
+ }
+ if ($protect_hash) {
+ my @result = ();
+ if ($current->{'type'} and $current->{'type'} eq 'raw') {
+ my $parent = $current->{'parent'};
+ while ($parent) {
+ if ($parent->{'cmdname'} and $parent->{'source_info'}) {
+ if ($registrar) {
+ $registrar->line_warn($customization_information, sprintf(__(
+ "could not protect hash character in \@%s"),
+ $parent->{'cmdname'}), $parent->{'source_info'});
+ }
+ last;
+ }
+ $parent = $parent->{'parent'};
+ }
+ } else {
+ $current->{'text'} =~ s/^(\s*)#//;
+ if ($1 ne '') {
+ push @result, {'text' => $1, 'parent' => $current->{'parent'}};
+ }
+ push @result, {'cmdname' => 'hashchar', 'parent' => $current->{'parent'},
+ 'args' => [{'type' => 'brace_command_arg'}]};
+ }
+ push @result, $current;
+ return @result;
+ } else {
+ return ($current);
+ }
+}
+
+sub protect_hashchar_at_line_beginning($$$)
+{
+ my $registrar = shift;
+ my $customization_information = shift;
+ my $tree = shift;
+
+ my $elements_to_protect = {};
+ return Texinfo::Common::modify_tree($tree, \&_protect_hashchar_at_line_beginning,
+ [$registrar, $customization_information, $elements_to_protect]);
+}
+
1;
__END__
=head1 NAME
-Texinfo::Transformations - transformations of Texinfo::Parser.pm tree
+Texinfo::Transformations - transformations of Texinfo Perl tree
-=head1 SYNOPSIS
+=head1 NOTES
+
+The Texinfo Perl module main purpose is to be used in C<texi2any> to convert
+Texinfo to other formats. There is no promise of API stability.
- 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
+as C<insert_nodes_for_sectioning_commands> that adds nodes for
sectioning commands without nodes and C<complete_tree_nodes_menus>
-and C<complete_tree_nodes_missing_menu> that completes the
+and C<complete_tree_nodes_missing_menu> 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 complete_tree_nodes_menus($tree, $add_section_names_in_entries)
+X<C<complete_tree_nodes_menus>>
+
+Add menu entries or whole menus for nodes associated with sections,
+based on the sectioning tree. If the optional
+C<$add_section_names_in_entries> argument is set, a menu entry
+name is added using the section name. This function should be
+called after L<sectioning_structure|Texinfo::Structuring/$sections_root, $sections_list = sectioning_structure($registrar, $customization_information, $tree)>.
+
+=item complete_tree_nodes_missing_menu($tree, $use_section_names_in_entries)
+X<C<complete_tree_nodes_missing_menu>>
+
+Add whole menus for nodes associated with sections and without menu,
+based on the sectioning tree. If the optional
+C<$add_section_names_in_entries> argument is set, a menu entry
+name is added using the section name. This function should be
+called after L<sectioning_structure|Texinfo::Structuring/$sections_root, $sections_list = sectioning_structure($registrar, $customization_information, $tree)>.
-=item ($root_content, $added_sections) = fill_gaps_in_sectioning ($root)
+=item ($root_content, $added_sections) = fill_gaps_in_sectioning($tree)
+X<C<fill_gaps_in_sectioning>>
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
+to fill gaps in sectioning. This may be used, for example, when converting
+from a format that can handle gaps in sectioning. I<$tree> is the tree
root. An array reference is returned, containing the root contents
-with added sectioning commands, as well as an array reference containing
+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)
+=item ($root_content, $added_nodes) = insert_nodes_for_sectioning_commands($tree, $nodes_list, $targets_list, $labels)
+X<C<insert_nodes_for_sectioning_commands>>
Insert nodes for sectioning commands without node in C<$tree>.
+Add nodes to the labels used as targets for references C<$labels>
+and C<$targets_list> and to C<$nodes_list>.
+
An array reference is returned, containing the root contents
-with added nodes, as well as an array reference containing the
+with added nodes, as well as an array reference containing the
added nodes.
-=item complete_tree_nodes_menus ($parser, $tree, $add_section_names_in_entries)
+=item menu_to_simple_menu($menu)
-Add menu entries or whole menus for nodes associated with sections,
-based on the sectioning tree. If the optional
-C<$add_section_names_in_entries> argument is set, a menu entry
-name is added using the section name. This function should be
-called after L<sectioning_structure>.
+=item set_menus_to_simple_menu($nodes_list)
+X<C<menu_to_simple_menu>>
+X<C<set_menus_to_simple_menu>>
-=item complete_tree_nodes_missing_menu ($parser, $tree, $use_section_names_in_entries)
+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 nodes in C<$nodes_list>.
-Add whole menus for nodes associated with sections and without menu,
-based on the sectioning tree. If the optional
-C<$add_section_names_in_entries> argument is set, a menu entry
-name is added using the section name. This function should be
-called after L<sectioning_structure>.
+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 $detailmenu = new_master_menu ($parser)
+=item $detailmenu = new_master_menu($translations, $labels)
+X<C<new_master_menu>>
Returns a detailmenu tree element formatted as a master node.
-
-=item regenerate_master_menu ($parser)
+I<$translations>, if defined, should be a L<Texinfo::Translations> object and
+should also hold customization information.
+
+=item protect_hashchar_at_line_beginning($registrar, $customization_information, $tree)
+X<C<protect_hashchar_at_line_beginning>>
+
+Protect hash (#) character at the beginning of line such that they would not be
+considered as lines to be processed by the CPP processor. The I<$registrar>
+and I<$customization_information> arguments may be undef. If defined, the
+I<$registrar> argument should be a L<Texinfo::Report> object in which the
+errors and warnings encountered while parsing are registered. If defined,
+I<$customization_information> should give access to customization through
+C<get_conf>. If both I<$registrar> and I<$customization_information> are
+defined they are used for error reporting in case an hash character could not
+be protected because it appeared in a raw environment.
+
+=item $modified_tree = reference_to_arg_in_tree($tree)
+X<C<reference_to_arg_in_tree>>
+
+Modify I<$tree> by converting reference @-commands to simple text using one of
+the arguments. This transformation can be used, for example, to remove
+reference @-command from constructed node names trees, as node names cannot
+contain reference @-command while there could be some in the tree used in input
+for the node name tree.
+
+=item regenerate_master_menu($translations, $labels)
+X<C<regenerate_master_menu>>
Regenerate the Top node master menu, replacing the first detailmenu
in Top node menus or appending at the end of the Top node menu.
+I<$translations>, if defined, should be a L<Texinfo::Translations> object and
+should also hold customization information.
=back
=head1 SEE ALSO
-L<Texinfo manual|http://www.gnu.org/s/texinfo/manual/texinfo/>,
+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- Free Software Foundation, Inc. See the source file for
+all copyright years.
+
+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