diff options
Diffstat (limited to 'macros/texinfo/texinfo/tp/Texinfo/Transformations.pm')
-rw-r--r-- | macros/texinfo/texinfo/tp/Texinfo/Transformations.pm | 636 |
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 |