[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch master updated: * tp/Texinfo/ManipulateTree.pm, tp/Texinfo/Common
|
From: |
Patrice Dumas |
|
Subject: |
branch master updated: * tp/Texinfo/ManipulateTree.pm, tp/Texinfo/Common.pm, tp/Makefile.am (dist_modules_DATA), doc/tp_api/Makefile.am (texi2any_internals_dependencies), : move tree transformation functions depending on modify_tree from Texinfo/Common.pm to the new Texinfo/ManipulateTree.pm module. Update callers. |
|
Date: |
Sat, 13 Apr 2024 15:53:56 -0400 |
This is an automated email from the git hooks/post-receive script.
pertusus pushed a commit to branch master
in repository texinfo.
The following commit(s) were added to refs/heads/master by this push:
new 7f4f9a2dc2 * tp/Texinfo/ManipulateTree.pm, tp/Texinfo/Common.pm,
tp/Makefile.am (dist_modules_DATA), doc/tp_api/Makefile.am
(texi2any_internals_dependencies), : move tree transformation functions
depending on modify_tree from Texinfo/Common.pm to the new
Texinfo/ManipulateTree.pm module. Update callers.
7f4f9a2dc2 is described below
commit 7f4f9a2dc2717d191e99e3015e1f42a0acc87a79
Author: Patrice Dumas <pertusus@free.fr>
AuthorDate: Sat Apr 13 21:53:47 2024 +0200
* tp/Texinfo/ManipulateTree.pm, tp/Texinfo/Common.pm,
tp/Makefile.am (dist_modules_DATA), doc/tp_api/Makefile.am
(texi2any_internals_dependencies), : move tree transformation
functions depending on modify_tree from Texinfo/Common.pm to the new
Texinfo/ManipulateTree.pm module. Update callers.
---
ChangeLog | 8 +
Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm | 11 +-
doc/tp_api/Makefile.am | 1 +
tp/Makefile.am | 1 +
tp/Texinfo/Common.pm | 808 +-----------------------
tp/Texinfo/Convert/HTML.pm | 3 +-
tp/Texinfo/ManipulateTree.pm | 900 +++++++++++++++++++++++++++
tp/Texinfo/Structuring.pm | 27 +-
tp/Texinfo/Transformations.pm | 35 +-
tp/Texinfo/Translations.pm | 13 +-
tp/t/index_before_item.t | 6 +-
tp/t/protect_character_in_texinfo.t | 9 +-
tp/t/test_protect_contents.t | 1 -
tp/t/test_tree_copy.t | 9 +-
tp/t/test_utils.pl | 12 +-
tp/texi2any.pl | 5 +-
16 files changed, 988 insertions(+), 861 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 5820cd6193..64fd654361 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2024-04-13 Patrice Dumas <pertusus@free.fr>
+
+ * tp/Texinfo/ManipulateTree.pm, tp/Texinfo/Common.pm,
+ tp/Makefile.am (dist_modules_DATA), doc/tp_api/Makefile.am
+ (texi2any_internals_dependencies), : move tree transformation
+ functions depending on modify_tree from Texinfo/Common.pm to the new
+ Texinfo/ManipulateTree.pm module. Update callers.
+
2024-04-13 Patrice Dumas <pertusus@free.fr>
* tp/Texinfo/XS/structuring_transfo/structuring.c: make some functions
diff --git a/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
b/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
index 2657b06e3a..1b3345cddd 100644
--- a/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
+++ b/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
@@ -52,9 +52,8 @@ use Texinfo::Convert::NodeNameNormalization
qw(convert_to_identifier);
use Texinfo::Parser qw(parse_texi_line parse_texi_piece);
use Texinfo::Convert::Texinfo;
use Texinfo::Convert::TextContent;
-use Texinfo::Common qw(protect_colon_in_tree protect_comma_in_tree
- protect_first_parenthesis);
use Texinfo::Document;
+use Texinfo::ManipulateTree;
use Texinfo::Transformations qw(protect_hashchar_at_line_beginning
reference_to_arg_in_tree);
@@ -354,7 +353,7 @@ sub _protect_comma($)
{
my $texinfo = shift;
my $tree = parse_texi_line(undef, $texinfo);
- protect_comma_in_tree($tree);
+ Texinfo::ManipulateTree::protect_comma_in_tree($tree);
$tree = Texinfo::Document::rebuild_tree($tree);
return Texinfo::Convert::Texinfo::convert_to_texinfo($tree);
}
@@ -363,7 +362,7 @@ sub _protect_colon($)
{
my $texinfo = shift;
my $tree = parse_texi_line(undef, $texinfo);
- protect_colon_in_tree($tree);
+ Texinfo::ManipulateTree::protect_colon_in_tree($tree);
$tree = Texinfo::Document::rebuild_tree($tree);
return Texinfo::Convert::Texinfo::convert_to_texinfo($tree);
}
@@ -500,8 +499,8 @@ sub _prepare_anchor($$)
$texinfo_node_name = "$node $number_appended";
$node_tree = parse_texi_line(undef, $texinfo_node_name);
}
- protect_comma_in_tree($node_tree);
- protect_colon_in_tree($node_tree);
+ Texinfo::ManipulateTree::protect_comma_in_tree($node_tree);
+ Texinfo::ManipulateTree::protect_colon_in_tree($node_tree);
$node_tree = Texinfo::Document::rebuild_tree($node_tree);
$self->{'texinfo_nodes'}->{$normalized} = $node_tree;
my $final_node_name =
Texinfo::Convert::Texinfo::convert_to_texinfo($node_tree);
diff --git a/doc/tp_api/Makefile.am b/doc/tp_api/Makefile.am
index 946fd389b0..b8c9c27bc7 100644
--- a/doc/tp_api/Makefile.am
+++ b/doc/tp_api/Makefile.am
@@ -53,6 +53,7 @@ texi2any_internals_dependencies = \
$(top_srcdir)/tp/Texinfo/Common.pm \
$(top_srcdir)/tp/Texinfo/ParserNonXS.pm \
$(top_srcdir)/tp/Texinfo/Document.pm \
+ $(top_srcdir)/tp/Texinfo/ManipulateTree.pm \
$(top_srcdir)/tp/Texinfo/Structuring.pm \
$(top_srcdir)/tp/Texinfo/Report.pm \
$(top_srcdir)/tp/Texinfo/Translations.pm \
diff --git a/tp/Makefile.am b/tp/Makefile.am
index d8a8900ba3..4ffc1b3d64 100644
--- a/tp/Makefile.am
+++ b/tp/Makefile.am
@@ -74,6 +74,7 @@ dist_modules_DATA = \
Texinfo/Documentlanguages.pm \
Texinfo/Indices.pm \
Texinfo/IndicesXS.pm \
+ Texinfo/ManipulateTree.pm \
Texinfo/MiscXS.pm \
Texinfo/Options.pm \
Texinfo/Parser.pm \
diff --git a/tp/Texinfo/Common.pm b/tp/Texinfo/Common.pm
index 975a23aaf4..528dcdd733 100644
--- a/tp/Texinfo/Common.pm
+++ b/tp/Texinfo/Common.pm
@@ -20,15 +20,15 @@
package Texinfo::Common;
+# for unicode/layer support in binmode
+# for binmode documented as pushing :utf8 on top of :encoding
+use 5.008001;
+
use strict;
# To check if there is no erroneous autovivification
#no autovivification qw(fetch delete exists store strict);
-# for unicode/layer support in binmode
-# for binmode documented as pushing :utf8 on top of :encoding
-use 5.008001;
-
# to determine the null file
use Config;
use File::Spec;
@@ -43,13 +43,6 @@ use Carp qw(cluck confess);
use Locale::Messages;
-# FIXME do we really want XS in Common.pm? Move overriden functions
-# to other modules?
-use Texinfo::DocumentXS;
-use Texinfo::StructTransfXS;
-
-use Texinfo::XSLoader;
-
use Texinfo::Documentlanguages;
use Texinfo::Commands;
use Texinfo::Options;
@@ -61,12 +54,6 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
%EXPORT_TAGS = ( 'all' => [ qw(
collect_commands_in_tree
collect_commands_list_in_tree
-move_index_entries_after_items_in_tree
-relate_index_entries_to_table_items_in_tree
-protect_colon_in_tree
-protect_comma_in_tree
-protect_first_parenthesis
-protect_node_after_label_in_tree
valid_customization_option
valid_tree_transformation
) ] );
@@ -81,37 +68,6 @@ __ __p
$VERSION = '7.1dev';
-my $XS_structuring = Texinfo::XSLoader::XS_structuring_enabled();
-
-our %XS_overrides = (
- "Texinfo::Common::copy_tree"
- => "Texinfo::StructTransfXS::copy_tree",
- "Texinfo::Common::relate_index_entries_to_table_items_in_tree"
- => "Texinfo::StructTransfXS::relate_index_entries_to_table_items_in_tree",
- "Texinfo::Common::move_index_entries_after_items_in_tree"
- => "Texinfo::StructTransfXS::move_index_entries_after_items_in_tree",
- "Texinfo::Common::protect_colon_in_tree"
- => "Texinfo::StructTransfXS::protect_colon_in_tree",
- "Texinfo::Common::protect_comma_in_tree"
- => "Texinfo::StructTransfXS::protect_comma_in_tree",
- "Texinfo::Common::protect_node_after_label_in_tree"
- => "Texinfo::StructTransfXS::protect_node_after_label_in_tree",
-);
-
-our $module_loaded = 0;
-sub import {
- if (!$module_loaded) {
- if ($XS_structuring) {
- for my $sub (keys %XS_overrides) {
- Texinfo::XSLoader::override ($sub, $XS_overrides{$sub});
- }
- }
- $module_loaded = 1;
- }
- # The usual import method
- goto &Exporter::import;
-}
-
# i18n
# For the messages translations.
my $messages_textdomain = 'texinfo';
@@ -1860,724 +1816,6 @@ sub _collect_commands_list_in_tree($$$)
}
-# functions useful for Texinfo tree transformations
-# and some tree transformations functions, mostly those
-# used in conversion to main output formats. In general,
-# tree transformations functions are documented in the POD section.
-
-# Some helper functions defined here are used in other
-# modules but are not generally useful in converters
-# and therefore not public.
-
-
-# This implementation of tree copy is designed such as to be
-# implemntable easily in XS with reference to copy local to
-# the element and not in a hash
-
-# It is important to go through the tree in the same order
-# in _copy_tree and _copy_extra_info, to be sure that elements already
-# seen are the same in both cases, such that _counter is at 0 in
-# _copy_extra_info when all the dependent elements have been seen
-# and going through the target element.
-
-# the *_directions extra items are not elements, they contain
-# up, next and prev that point to elements.
-# it could also have been possible to determine that it is
-# an extra_directions if the keys are only up, next and prev
-my %extra_directions;
-foreach my $type ('menu', 'node', 'section', 'toplevel') {
- $extra_directions{$type.'_directions'} = 1;
-}
-
-sub _copy_tree($$);
-sub _copy_tree($$)
-{
- my $current = shift;
- my $parent = shift;
-
- # either a duplicate in a tree (should be rare/avoided) or an
- # element referred to in extra/info, either directly or
- # (probably rare) in the extra element tree that has already
- # been seen in the tree
- if ($current->{'_copy'}) {
- #print STDERR "RCT $current ".debug_print_element($current)
- # .": $current->{'_counter'}\n";
- $current->{'_copy'}->{'parent'} = $parent
- if (not $current->{'_copy'}->{'parent'} and $parent);
- return $current->{'_copy'};
- }
-
- my $new = {};
- $new->{'parent'} = $parent if ($parent);
- foreach my $key ('type', 'cmdname', 'text') {
- $new->{$key} = $current->{$key} if (exists($current->{$key}));
- }
-
- $current->{'_copy'} = $new;
- $current->{'_counter'} = 0 if !exists($current->{'_counter'});
- $current->{'_counter'}++;
-
- #print STDERR "CTNEW $current ".debug_print_element($current)." $new\n";
-
- foreach my $key ('args', 'contents') {
- if ($current->{$key}) {
- if (ref($current->{$key}) ne 'ARRAY') {
- my $command_or_type = '';
- if ($new->{'cmdname'}) {
- $command_or_type = '@'.$new->{'cmdname'};
- } elsif ($new->{'type'}) {
- $command_or_type = $new->{'type'};
- }
- print STDERR "BUG: Not an array [$command_or_type] $key ".
- ref($current->{$key})."\n";
- }
- $new->{$key} = [];
- foreach my $child (@{$current->{$key}}) {
- push @{$new->{$key}}, _copy_tree($child, $new);
- }
- }
- }
- foreach my $info_type ('info', 'extra') {
- next if (!$current->{$info_type});
- $new->{$info_type} = {};
- foreach my $key (sort(keys(%{$current->{$info_type}}))) {
- my $value = $current->{$info_type}->{$key};
- if (ref($value) eq 'ARRAY' and ref($value->[0]) eq 'HASH') {
- #print STDERR "II ARRAY $key $value\n";
- $new->{$info_type}->{$key} = [];
- foreach my $target (@{$value}) {
- if ($target->{'_copy'}) {
- push @{$new->{$info_type}->{$key}}, $target->{'_copy'};
- } else {
- push @{$new->{$info_type}->{$key}}, undef;
- $target->{'_counter'}++;
- #print STDERR "AC $target ".debug_print_element($target)
- # .": $target->{'_counter'}\n";
- }
- _copy_tree($target, undef);
- }
- } elsif (ref($value) eq 'HASH') {
- #print STDERR "II HASH $key $value\n";
- if ($extra_directions{$key}) {
- $new->{$info_type}->{$key} = {};
- foreach my $direction (sort (keys(%$value))) {
- my $target = $value->{$direction};
- if ($target->{'_copy'}) {
- $new->{$info_type}->{$key}->{$direction} = $target->{'_copy'};
- } else {
- $target->{'_counter'}++;
- }
- _copy_tree($target, undef);
- }
- } else {
- if ($value->{'_copy'}) {
- $new->{$info_type}->{$key} = $value->{'_copy'};
- } else {
- $value->{'_counter'}++;
- #print STDERR "AC $value ".debug_print_element($value)
- # .": $value->{'_counter'}\n";
- }
- _copy_tree($value, undef);
- }
- }
- }
- }
- return $new;
-}
-
-sub _get_copy_ref($$)
-{
- my $target = shift;
- my $context = shift;
-
- if (ref($target) ne 'HASH' or !$target->{'_counter'}) {
- print STDERR "BUG: $context: unexpected target $target\n";
- print STDERR " ".debug_print_element($target)."\n";
- die;
- }
- $target->{'_counter'}--;
- if ($target->{'_counter'} == 0) {
- delete $target->{'_counter'};
- my $copy = $target->{'_copy'};
- delete $target->{'_copy'};
- return $copy;
- }
- return $target->{'_copy'};
-}
-
-sub _copy_extra_info($$;$);
-sub _copy_extra_info($$;$)
-{
- my $current = shift;
- my $new = shift;
- my $level = shift;
-
- my $command_or_type = '';
- if ($new->{'cmdname'}) {
- $command_or_type = '@'.$new->{'cmdname'};
- } elsif ($new->{'type'}) {
- $command_or_type = $new->{'type'};
- }
-
- $level = 0 if (!defined($level));
-
- if (!$current->{'_copy'}) {
- #print STDERR "DONE $current ".debug_print_element($current)."\n";
- return;
- }
-
- $level++;
- #print STDERR (' ' x $level)
- # .Texinfo::Common::debug_print_element($current).": $current ".
- # (defined($current->{'_counter'}) ? $current->{'_counter'} : 'N')."\n";
-
- _get_copy_ref($current, "myself[$command_or_type]");
-
- foreach my $key ('args', 'contents') {
- if ($current->{$key}) {
- my $index = 0;
- foreach my $child (@{$current->{$key}}) {
- _copy_extra_info($child, $new->{$key}->[$index], $level);
- $index++;
- }
- }
- }
-
- foreach my $info_type ('info', 'extra') {
- next if (!$current->{$info_type});
- foreach my $key (sort(keys(%{$current->{$info_type}}))) {
- my $value = $current->{$info_type}->{$key};
- #print STDERR (' ' x $level) . "K $info_type $key |$value\n";
- if (ref($value) eq '') {
- $new->{$info_type}->{$key} = $value;
- } elsif (ref($value) eq 'ARRAY') {
- #print STDERR (' ' x $level) .
- # "Array $command_or_type $info_type -> $key\n";
- # misc_args index_entry
- if (ref($value->[0]) eq '') {
- $new->{$info_type}->{$key} = [@$value];
- } else {
- # authors manual_content menus node_content
- my $new_array = $new->{$info_type}->{$key};
- for (my $index = 0; $index < scalar(@{$value}); $index++) {
- if (!defined($new_array->[$index])) {
- my $context = "$info_type [$command_or_type]{$key} [$index]";
- $new_array->[$index] = _get_copy_ref($value->[$index], $context);
- }
- _copy_extra_info($value->[$index],
- $value->[$index]->{'_copy'}, $level)
- if ($value->[$index]->{'_copy'});
- }
- }
- } elsif (ref($value) eq 'HASH') {
- #print STDERR (' ' x $level)
- # . "Hash $command_or_type $info_type -> $key\n";
- if ($extra_directions{$key}) {
- my $new_directions = $new->{$info_type}->{$key};
- foreach my $direction (sort(keys(%$value))) {
- if (!exists($new_directions->{$direction})) {
- my $context = "$info_type [$command_or_type]{$key} {$direction}";
- $new_directions->{$direction}
- = _get_copy_ref($value->{$direction}, $context);
- }
- _copy_extra_info($value->{$direction},
- $value->{$direction}->{'_copy'}, $level)
- if ($value->{$direction}->{'_copy'});
- }
- } else {
- if (not defined($value->{'cmdname'}) and not
defined($value->{'type'})
- and not defined($value->{'text'}) and not
defined($value->{'extra'})
- and not defined($value->{'contents'})
- and not defined($value->{'args'})
- and scalar(keys(%$value))) {
- print STDERR "HASH NOT ELEMENT $info_type
[$command_or_type]{$key}\n";
- }
- if (!exists($new->{$info_type}->{$key})) {
- my $context = "${info_type}[$command_or_type]{$key}";
- $new->{$info_type}->{$key} = _get_copy_ref($value, $context);
- }
- if ($value->{'_copy'}) {
- _copy_extra_info($value, $value->{'_copy'}, $level);
- }
- }
- } else {
- print STDERR "Unexpected $info_type [$command_or_type]{$key}: "
- .ref($value)."\n";
- }
- }
- }
-}
-
-sub copy_tree($)
-{
- my $current = shift;
- my $copy = _copy_tree($current, undef);
- _copy_extra_info($current, $copy);
- return $copy;
-}
-
-# Never overriden by XS version
-sub copy_treeNonXS($)
-{
- my $current = shift;
- my $copy = _copy_tree($current, undef);
- _copy_extra_info($current, $copy);
- return $copy;
-}
-
-sub copy_contents($;$)
-{
- my $element = shift;
- my $type = shift;
- my $tmp = {'contents' => $element->{'contents'}};
- my $copy = copy_tree($tmp);
- if (defined($type)) {
- $copy->{'type'} = $type;
- }
- return $copy;
-}
-
-sub copy_contentsNonXS($;$)
-{
- my $element = shift;
- my $type = shift;
- my $tmp = {'contents' => $element->{'contents'}};
- my $copy = copy_treeNonXS($tmp);
- if (defined($type)) {
- $copy->{'type'} = $type;
- }
- return $copy;
-}
-
-sub modify_tree($$;$);
-sub modify_tree($$;$)
-{
- my $tree = shift;
- my $operation = shift;
- my $argument = shift;
- #print STDERR "modify_tree tree: $tree\n";
-
- if (!defined($tree) or ref($tree) ne 'HASH') {
- cluck "tree ".(!defined($tree) ? 'UNDEF' : "not a hash: $tree");
- return undef;
- }
-
- if ($tree->{'args'}) {
- my $args_nr = scalar(@{$tree->{'args'}});
- for (my $i = 0; $i < $args_nr; $i++) {
- my $new_args = &$operation('arg', $tree->{'args'}->[$i], $argument);
- if ($new_args) {
- # replace by new content
- splice(@{$tree->{'args'}}, $i, 1, @$new_args);
- $i += scalar(@$new_args) -1;
- $args_nr += scalar(@$new_args) -1;
- } else {
- modify_tree($tree->{'args'}->[$i], $operation, $argument);
- }
- }
- }
- if ($tree->{'contents'}) {
- my $contents_nr = scalar(@{$tree->{'contents'}});
- for (my $i = 0; $i < $contents_nr; $i++) {
- my $new_contents = &$operation('content',
- $tree->{'contents'}->[$i], $argument);
- if ($new_contents) {
- # replace by new content
- splice(@{$tree->{'contents'}}, $i, 1, @$new_contents);
- $i += scalar(@$new_contents) -1;
- $contents_nr += scalar(@$new_contents) -1;
- } else {
- modify_tree($tree->{'contents'}->[$i], $operation, $argument);
- }
- }
- }
- if ($tree->{'source_marks'}) {
- my @source_marks = @{$tree->{'source_marks'}};
- for (my $i = 0; $i <= $#source_marks; $i++) {
- if ($source_marks[$i]->{'element'}) {
- my $new_element
- = &$operation('source_mark', $source_marks[$i]->{'element'},
- $argument);
- if ($new_element) {
- $source_marks[$i]->{'element'} = $new_element->[0];
- }
- }
- }
- }
- return $tree;
-}
-
-sub _protect_comma($$)
-{
- my $type = shift;
- my $current = shift;
-
- return _protect_text($current, quotemeta(','));
-}
-
-sub protect_comma_in_tree($)
-{
- my $tree = shift;
-
- return modify_tree($tree, \&_protect_comma);
-}
-
-sub _new_asis_command_with_text($$;$)
-{
- my $text = shift;
- my $parent = shift;
- my $text_type = shift;
- my $new_command = {'cmdname' => 'asis', 'parent' => $parent };
- push @{$new_command->{'args'}}, {'type' => 'brace_command_arg',
- 'parent' => $new_command};
- push @{$new_command->{'args'}->[0]->{'contents'}}, {
- 'text' => $text,
- 'parent' => $new_command->{'args'}->[0]};
- if (defined($text_type)) {
- $new_command->{'args'}->[0]->{'contents'}->[0]->{'type'} = $text_type;
- }
- return $new_command;
-}
-
-sub _protect_text($$)
-{
- my $current = shift;
- my $to_protect = shift;
-
- #print STDERR "_protect_text: $to_protect: $current "
- # .debug_print_element($current, 1)."\n";
- if (defined($current->{'text'}) and $current->{'text'} =~ /$to_protect/
- and !(defined($current->{'type'})
- and ($current->{'type'} eq 'raw'
- or $current->{'type'} eq 'rawline_arg'))) {
- my @result = ();
- my $remaining_text = $current->{'text'};
-
- my $remaining_source_marks;
- my $current_position = 0;
- if ($current->{'source_marks'}) {
- $remaining_source_marks = [@{$current->{'source_marks'}}];
- delete $current->{'source_marks'};
- }
- while ($remaining_text) {
- if ($remaining_text =~ s/^(.*?)(($to_protect)+)//) {
- # Note that it includes for completeness the case of $1 eq ''
- # although it is unclear that source marks may happen in that case
- # as they are rather associated to the previous element.
- my $e = {'text' => $1, 'parent' => $current->{'parent'}};
- $e->{'type'} = $current->{'type'} if defined($current->{'type'});
- $current_position = Texinfo::Common::relocate_source_marks(
- $remaining_source_marks, $e,
- $current_position, length($1));
- if ($e->{'text'} ne '' or $e->{'source_marks'}) {
- push @result, $e;
- }
- if ($to_protect eq quotemeta(',')) {
- for (my $i = 0; $i < length($2); $i++) {
- my $e = {'cmdname' => 'comma', 'parent' => $current->{'parent'},
- 'args' => [{'type' => 'brace_command_arg'}]};
- $current_position = Texinfo::Common::relocate_source_marks(
- $remaining_source_marks, $e,
- $current_position, 1);
- push @result, $e;
- }
- } else {
- my $new_asis = _new_asis_command_with_text($2, $current->{'parent'},
- $current->{'type'});
- my $e = $new_asis->{'args'}->[0]->{'contents'}->[0];
- $current_position = Texinfo::Common::relocate_source_marks(
- $remaining_source_marks, $e,
- $current_position, length($2));
- push @result, $new_asis;
- }
- } else {
- my $e = {'text' => $remaining_text, 'parent' => $current->{'parent'}};
- $e->{'type'} = $current->{'type'} if defined($current->{'type'});
- $current_position = Texinfo::Common::relocate_source_marks(
- $remaining_source_marks, $e,
- $current_position,
length($remaining_text));
- push @result, $e;
- last;
- }
- }
- #print STDERR "_protect_text: Result: @result\n";
- return \@result;
- } else {
- #print STDERR "_protect_text: No change\n";
- return undef;
- }
-}
-
-sub _protect_colon($$)
-{
- my $type = shift;
- my $current = shift;
-
- return _protect_text($current, quotemeta(':'));
-}
-
-sub protect_colon_in_tree($)
-{
- my $tree = shift;
-
- return modify_tree($tree, \&_protect_colon);
-}
-
-sub _protect_node_after_label($$)
-{
- my $type = shift;
- my $current = shift;
-
- return _protect_text($current, '['. quotemeta(".\t,") .']');
-}
-
-sub protect_node_after_label_in_tree($)
-{
- my $tree = shift;
-
- return modify_tree($tree, \&_protect_node_after_label);
-}
-
-sub protect_first_parenthesis($)
-{
- my $element = shift;
- confess("BUG: protect_first_parenthesis element undef")
- if (!defined($element));
- confess("BUG: protect_first_parenthesis not a hash")
- if (ref($element) ne 'HASH');
- #print STDERR "protect_first_parenthesis: $element->{'contents'}\n";
- return if (!$element->{'contents'} or !scalar(@{$element->{'contents'}}));
-
- my $current_position = 0;
- my $nr_contents = scalar(@{$element->{'contents'}});
- for (my $i = 0; $i < $nr_contents; $i++) {
- my $content = $element->{'contents'}->[$i];
- return if (!defined($content->{'text'}));
- if ($content->{'text'} eq '') {
- next;
- }
- if ($content->{'text'} =~ /^\(/) {
- my $remaining_source_marks;
- my $current_position = 0;
- if ($content->{'source_marks'}) {
- $remaining_source_marks = [@{$content->{'source_marks'}}];
- delete $content->{'source_marks'};
- }
- my $new_asis = _new_asis_command_with_text('(', $content->{'parent'},
- $content->{'type'});
- my $e = $new_asis->{'args'}->[0]->{'contents'}->[0];
- $current_position = Texinfo::Common::relocate_source_marks(
- $remaining_source_marks, $e,
- $current_position, length('('));
- if ($content->{'text'} !~ /^\($/) {
- $content->{'text'} =~ s/^\(//;
- $current_position = Texinfo::Common::relocate_source_marks(
- $remaining_source_marks, $content,
- $current_position, length($content->{'text'}));
- } else {
- splice (@{$element->{'contents'}}, $i, 1);
- }
- splice (@{$element->{'contents'}}, $i, 0, $new_asis);
- }
- return;
- }
-}
-
-sub move_index_entries_after_items($)
-{
- # enumerate or itemize
- my $current = shift;
-
- return unless ($current->{'contents'});
-
- my $previous;
- foreach my $item (@{$current->{'contents'}}) {
- #print STDERR "Before proceeding: $previous $item->{'cmdname'}
(@{$previous->{'contents'}})\n" if ($previous and $previous->{'contents'});
- if (defined($previous) and $item->{'cmdname'}
- and $item->{'cmdname'} eq 'item'
- and $previous->{'contents'} and scalar(@{$previous->{'contents'}})) {
-
- my $previous_ending_container;
- if ($previous->{'contents'}->[-1]->{'type'}
- and ($previous->{'contents'}->[-1]->{'type'} eq 'paragraph'
- or $previous->{'contents'}->[-1]->{'type'} eq 'preformatted')) {
- $previous_ending_container = $previous->{'contents'}->[-1];
- } else {
- $previous_ending_container = $previous;
- }
-
- my $contents_nr = scalar(@{$previous_ending_container->{'contents'}});
-
- # find the last index entry, with possibly comments after
- my $last_entry_idx = -1;
- for (my $i = $contents_nr -1; $i >= 0; $i--) {
- my $content = $previous_ending_container->{'contents'}->[$i];
- if ($content->{'type'} and $content->{'type'} eq
'index_entry_command') {
- $last_entry_idx = $i;
- } elsif (not $content->{'cmdname'}
- or ($content->{'cmdname'} ne 'c'
- and $content->{'cmdname'} ne 'comment')) {
- last;
- }
- }
-
- if ($last_entry_idx >= 0) {
- my $item_container;
- if ($item->{'contents'} and $item->{'contents'}->[0]
- and $item->{'contents'}->[0]->{'type'}
- and $item->{'contents'}->[0]->{'type'} eq 'preformatted') {
- $item_container = $item->{'contents'}->[0];
- } else {
- $item_container = $item;
- }
-
- for (my $i = $last_entry_idx; $i < $contents_nr; $i++) {
- $previous_ending_container->{'contents'}->[$i]->{'parent'}
- = $item_container;
- }
-
- my $insertion_idx = 0;
- if ($item_container->{'contents'}
- and $item_container->{'contents'}->[0]
- and $item_container->{'contents'}->[0]->{'type'}
- and $item_container->{'contents'}->[0]->{'type'} eq
'ignorable_spaces_after_command') {
- # insert after leading spaces, and add an end of line if there
- # is none
- $insertion_idx = 1;
- $item_container->{'contents'}->[0]->{'text'} .= "\n"
- if ($item_container->{'contents'}->[0]->{'text'} !~ /\n$/);
- }
- # first part of the splice is the insertion in $item_container
- splice (@{$item_container->{'contents'}},
- $insertion_idx, 0,
- # this splice removes from the previous container starting
- # at $last_entry_idx and returns the contents to be
inserted
- splice (@{$previous_ending_container->{'contents'}},
- $last_entry_idx, $contents_nr - $last_entry_idx));
- delete $previous_ending_container->{'contents'}
- if (!scalar(@{$previous_ending_container->{'contents'}}))
- }
- }
- $previous = $item;
- }
-}
-
-sub _move_index_entries_after_items($$)
-{
- my $type = shift;
- my $current = shift;
-
- if ($current->{'cmdname'} and ($current->{'cmdname'} eq 'enumerate'
- or $current->{'cmdname'} eq 'itemize')) {
- move_index_entries_after_items($current);
- }
- return undef;
-}
-
-# For @itemize/@enumerate
-sub move_index_entries_after_items_in_tree($)
-{
- my $tree = shift;
-
- modify_tree($tree, \&_move_index_entries_after_items);
-}
-
-sub _relate_index_entries_to_table_items_in($$)
-{
- my $table = shift;
- my $indices_information = shift;
-
- return unless $table->{'contents'};
-
- foreach my $table_entry (@{$table->{'contents'}}) {
- next unless $table_entry->{'contents'}
- and $table_entry->{'type'} eq 'table_entry';
-
- my $term = $table_entry->{'contents'}->[0];
- my $definition;
- my $item;
-
- # Move any index entries from the start of a 'table_definition' to
- # the 'table_term'.
- if (defined($table_entry->{'contents'}->[1])
- and defined($table_entry->{'contents'}->[1]->{'type'})
- and $table_entry->{'contents'}->[1]->{'type'} eq 'table_definition') {
- $definition = $table_entry->{'contents'}->[1];
- my $nr_index_entry_command = 0;
- foreach my $child (@{$definition->{'contents'}}) {
- if ($child->{'type'} and $child->{'type'} eq 'index_entry_command') {
- $child->{'parent'} = $term;
- $nr_index_entry_command++;
- } else {
- last;
- }
- }
- if ($nr_index_entry_command > 0) {
- unshift @{$term->{'contents'}},
- splice (@{$definition->{'contents'}}, 0, $nr_index_entry_command);
- }
- }
-
- if (defined($term->{'type'}) and $term->{'type'} eq 'table_term') {
- # Relate the first index_entry_command in the 'table_term' to
- # the term itself.
-
- my $index_entry;
- my $index_element;
- foreach my $content (@{$term->{'contents'}}) {
- if ($content->{'type'}
- and $content->{'type'} eq 'index_entry_command') {
- if (!$index_entry) {
- my $index_info;
- $index_element = $content;
- ($index_entry, $index_info)
- = Texinfo::Common::lookup_index_entry(
- $content->{'extra'}->{'index_entry'},
- $indices_information);
- }
- } elsif ($content->{'cmdname'} and $content->{'cmdname'} eq 'item') {
- $item = $content unless $item;
- }
- if ($item and $index_entry) {
- # This is better than overwriting 'entry_element', which
- # holds important information.
- $index_entry->{'entry_associated_element'} = $item;
- # also add a reference from element to index entry in index
- $item->{'extra'} = {} if (!$item->{'extra'});
- $item->{'extra'}->{'associated_index_entry'}
- = [@{$index_element->{'extra'}->{'index_entry'}}];
- last;
- }
- }
- }
- }
-}
-
-# Locate all @tables in the tree, and relate index entries to
-# the @item that immediately follows or precedes them.
-sub _relate_index_entries_to_table_items($$$)
-{
- my $type = shift;
- my $current = shift;
- my $indices_information = shift;
-
- if ($current->{'cmdname'} and $current->{'cmdname'} eq 'table') {
- _relate_index_entries_to_table_items_in($current, $indices_information);
- }
- return undef;
-}
-
-sub relate_index_entries_to_table_items_in_tree($)
-{
- my $document = shift;
-
- my $tree = $document->tree();
- my $indices_information = $document->indices_information();
-
- modify_tree($tree, \&_relate_index_entries_to_table_items,
- $indices_information);
-}
-
# Common to different module, but not meant to be used in user-defined
# codes.
@@ -3076,50 +2314,12 @@ is an L<C<extra>
I<index_entry>|Texinfo::Parser/index_entry> associated to an el
The I<$index_entry> hash is described in L<Texinfo::Document/index_entries>.
The
I<$index_info> hash is described in L<<
C<Texinfo::Document::indices_information>|Texinfo::Document/$indices_information
= $document->indices_information() >>.
-
-=item move_index_entries_after_items_in_tree($tree)
-X<C<move_index_entries_after_items_in_tree>>
-
-In C<@enumerate> and C<@itemize> from the tree, move index entries
-appearing just before C<@item> after the C<@item>. Comment lines
-between index entries are moved too.
-
-=item relate_index_entries_to_table_items_in_tree($document)
-X<C<relate_index_entries_to_table_items_in_tree>>
-
-In tables, relate index entries preceding and following an
-entry with said item. Reference one of them in the entry's
-C<entry_associated_element>.
-
=item $normalized_name = normalize_top_node_name($node_string)
X<C<normalize_top_node_name>>
Normalize the node name string given in argument, by normalizing
Top node case.
-=item protect_colon_in_tree($tree)
-
-=item protect_node_after_label_in_tree($tree)
-X<C<protect_colon_in_tree>>
-X<C<protect_node_after_label_in_tree>>
-
-Protect colon with C<protect_colon_in_tree> and characters that
-are special in node names after a label in menu entries (tab
-dot and comma) with C<protect_node_after_label_in_tree>.
-The protection is achieved by putting protected characters
-in C<@asis{}>.
-
-=item protect_comma_in_tree($tree)
-X<C<protect_comma_in_tree>>
-
-Protect comma characters, replacing C<,> with @comma{} in tree.
-
-=item protect_first_parenthesis($element)
-X<C<protect_first_parenthesis>>
-
-Modify I<$element> contents by protecting the first parenthesis.
-If I<$element> is undef a fatal error with a backtrace will be emitted.
-
=item $level = section_level($section)
X<C<section_level>>
diff --git a/tp/Texinfo/Convert/HTML.pm b/tp/Texinfo/Convert/HTML.pm
index 538f00bd64..6937da333b 100644
--- a/tp/Texinfo/Convert/HTML.pm
+++ b/tp/Texinfo/Convert/HTML.pm
@@ -71,6 +71,7 @@ use Texinfo::Convert::Texinfo;
use Texinfo::Convert::Utils;
use Texinfo::Convert::Text;
use Texinfo::Convert::NodeNameNormalization;
+use Texinfo::ManipulateTree;
use Texinfo::Structuring;
use Texinfo::Indices;
use Texinfo::Convert::Converter;
@@ -1259,7 +1260,7 @@ sub _internal_command_tree($$$)
my $substituted_strings
= {'number' => {'text' => $section_number},
'section_title'
- => Texinfo::Common::copy_treeNonXS($command->{'args'}->[0])};
+ => Texinfo::ManipulateTree::copy_treeNonXS($command->{'args'}->[0])};
if ($command->{'cmdname'} eq 'appendix'
and $command->{'extra'}->{'section_level'} == 1) {
diff --git a/tp/Texinfo/ManipulateTree.pm b/tp/Texinfo/ManipulateTree.pm
new file mode 100644
index 0000000000..12f5c406e7
--- /dev/null
+++ b/tp/Texinfo/ManipulateTree.pm
@@ -0,0 +1,900 @@
+# ManipulateTree.pm: common Texinfo tree manipulation
+#
+# Copyright 2010-2024 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>
+
+package Texinfo::ManipulateTree;
+
+use 5.00405;
+
+# stop \s from matching non-ASCII spaces, etc. \p{...} can still be
+# used to match Unicode character classes.
+use if $] >= 5.014, re => '/a';
+
+use strict;
+
+# To check if there is no erroneous autovivification
+#no autovivification qw(fetch delete exists store strict);
+
+# debugging
+use Carp qw(cluck confess);
+
+use Texinfo::StructTransfXS;
+
+use Texinfo::XSLoader;
+
+use Texinfo::Common;
+
+require Exporter;
+use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
+@ISA = qw(Exporter);
+
+%EXPORT_TAGS = ( 'all' => [ qw(
+move_index_entries_after_items_in_tree
+relate_index_entries_to_table_items_in_tree
+protect_colon_in_tree
+protect_comma_in_tree
+protect_first_parenthesis
+protect_node_after_label_in_tree
+) ] );
+
+@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+$VERSION = '7.1dev';
+
+my $XS_structuring = Texinfo::XSLoader::XS_structuring_enabled();
+
+our %XS_overrides = (
+ "Texinfo::ManipulateTree::copy_tree"
+ => "Texinfo::StructTransfXS::copy_tree",
+ "Texinfo::ManipulateTree::relate_index_entries_to_table_items_in_tree"
+ => "Texinfo::StructTransfXS::relate_index_entries_to_table_items_in_tree",
+ "Texinfo::ManipulateTree::move_index_entries_after_items_in_tree"
+ => "Texinfo::StructTransfXS::move_index_entries_after_items_in_tree",
+ "Texinfo::ManipulateTree::protect_colon_in_tree"
+ => "Texinfo::StructTransfXS::protect_colon_in_tree",
+ "Texinfo::ManipulateTree::protect_comma_in_tree"
+ => "Texinfo::StructTransfXS::protect_comma_in_tree",
+ "Texinfo::ManipulateTree::protect_node_after_label_in_tree"
+ => "Texinfo::StructTransfXS::protect_node_after_label_in_tree",
+);
+
+our $module_loaded = 0;
+sub import {
+ if (!$module_loaded) {
+ if ($XS_structuring) {
+ for my $sub (keys %XS_overrides) {
+ Texinfo::XSLoader::override ($sub, $XS_overrides{$sub});
+ }
+ }
+ $module_loaded = 1;
+ }
+ # The usual import method
+ goto &Exporter::import;
+}
+
+# functions useful for Texinfo tree transformations
+# and some tree transformations functions, mostly those
+# used in conversion to main output formats. In general,
+# tree transformations functions are documented in the POD section.
+
+# Some helper functions defined here are used in other
+# modules but are not generally useful in converters
+# and therefore not public.
+
+
+# This implementation of tree copy is designed such as to be
+# implementable easily in XS with reference to copy local to
+# the element and not in a hash
+
+# It is important to go through the tree in the same order
+# in _copy_tree and _copy_extra_info, to be sure that elements already
+# seen are the same in both cases, such that _counter is at 0 in
+# _copy_extra_info when all the dependent elements have been seen
+# and going through the target element.
+
+# the *_directions extra items are not elements, they contain
+# up, next and prev that point to elements.
+# it could also have been possible to determine that it is
+# an extra_directions if the keys are only up, next and prev
+my %extra_directions;
+foreach my $type ('menu', 'node', 'section', 'toplevel') {
+ $extra_directions{$type.'_directions'} = 1;
+}
+
+sub _copy_tree($$);
+sub _copy_tree($$)
+{
+ my $current = shift;
+ my $parent = shift;
+
+ # either a duplicate in a tree (should be rare/avoided) or an
+ # element referred to in extra/info, either directly or
+ # (probably rare) in the extra element tree that has already
+ # been seen in the tree
+ if ($current->{'_copy'}) {
+ #print STDERR "RCT $current ".debug_print_element($current)
+ # .": $current->{'_counter'}\n";
+ $current->{'_copy'}->{'parent'} = $parent
+ if (not $current->{'_copy'}->{'parent'} and $parent);
+ return $current->{'_copy'};
+ }
+
+ my $new = {};
+ $new->{'parent'} = $parent if ($parent);
+ foreach my $key ('type', 'cmdname', 'text') {
+ $new->{$key} = $current->{$key} if (exists($current->{$key}));
+ }
+
+ $current->{'_copy'} = $new;
+ $current->{'_counter'} = 0 if !exists($current->{'_counter'});
+ $current->{'_counter'}++;
+
+ #print STDERR "CTNEW $current ".debug_print_element($current)." $new\n";
+
+ foreach my $key ('args', 'contents') {
+ if ($current->{$key}) {
+ if (ref($current->{$key}) ne 'ARRAY') {
+ my $command_or_type = '';
+ if ($new->{'cmdname'}) {
+ $command_or_type = '@'.$new->{'cmdname'};
+ } elsif ($new->{'type'}) {
+ $command_or_type = $new->{'type'};
+ }
+ print STDERR "BUG: Not an array [$command_or_type] $key ".
+ ref($current->{$key})."\n";
+ }
+ $new->{$key} = [];
+ foreach my $child (@{$current->{$key}}) {
+ push @{$new->{$key}}, _copy_tree($child, $new);
+ }
+ }
+ }
+ foreach my $info_type ('info', 'extra') {
+ next if (!$current->{$info_type});
+ $new->{$info_type} = {};
+ foreach my $key (sort(keys(%{$current->{$info_type}}))) {
+ my $value = $current->{$info_type}->{$key};
+ if (ref($value) eq 'ARRAY' and ref($value->[0]) eq 'HASH') {
+ #print STDERR "II ARRAY $key $value\n";
+ $new->{$info_type}->{$key} = [];
+ foreach my $target (@{$value}) {
+ if ($target->{'_copy'}) {
+ push @{$new->{$info_type}->{$key}}, $target->{'_copy'};
+ } else {
+ push @{$new->{$info_type}->{$key}}, undef;
+ $target->{'_counter'}++;
+ #print STDERR "AC $target ".debug_print_element($target)
+ # .": $target->{'_counter'}\n";
+ }
+ _copy_tree($target, undef);
+ }
+ } elsif (ref($value) eq 'HASH') {
+ #print STDERR "II HASH $key $value\n";
+ if ($extra_directions{$key}) {
+ $new->{$info_type}->{$key} = {};
+ foreach my $direction (sort (keys(%$value))) {
+ my $target = $value->{$direction};
+ if ($target->{'_copy'}) {
+ $new->{$info_type}->{$key}->{$direction} = $target->{'_copy'};
+ } else {
+ $target->{'_counter'}++;
+ }
+ _copy_tree($target, undef);
+ }
+ } else {
+ if ($value->{'_copy'}) {
+ $new->{$info_type}->{$key} = $value->{'_copy'};
+ } else {
+ $value->{'_counter'}++;
+ #print STDERR "AC $value ".debug_print_element($value)
+ # .": $value->{'_counter'}\n";
+ }
+ _copy_tree($value, undef);
+ }
+ }
+ }
+ }
+ return $new;
+}
+
+sub _get_copy_ref($$)
+{
+ my $target = shift;
+ my $context = shift;
+
+ if (ref($target) ne 'HASH' or !$target->{'_counter'}) {
+ print STDERR "BUG: $context: unexpected target $target\n";
+ print STDERR " ".debug_print_element($target)."\n";
+ die;
+ }
+ $target->{'_counter'}--;
+ if ($target->{'_counter'} == 0) {
+ delete $target->{'_counter'};
+ my $copy = $target->{'_copy'};
+ delete $target->{'_copy'};
+ return $copy;
+ }
+ return $target->{'_copy'};
+}
+
+sub _copy_extra_info($$;$);
+sub _copy_extra_info($$;$)
+{
+ my $current = shift;
+ my $new = shift;
+ my $level = shift;
+
+ my $command_or_type = '';
+ if ($new->{'cmdname'}) {
+ $command_or_type = '@'.$new->{'cmdname'};
+ } elsif ($new->{'type'}) {
+ $command_or_type = $new->{'type'};
+ }
+
+ $level = 0 if (!defined($level));
+
+ if (!$current->{'_copy'}) {
+ #print STDERR "DONE $current ".debug_print_element($current)."\n";
+ return;
+ }
+
+ $level++;
+ #print STDERR (' ' x $level)
+ # .Texinfo::Common::debug_print_element($current).": $current ".
+ # (defined($current->{'_counter'}) ? $current->{'_counter'} : 'N')."\n";
+
+ _get_copy_ref($current, "myself[$command_or_type]");
+
+ foreach my $key ('args', 'contents') {
+ if ($current->{$key}) {
+ my $index = 0;
+ foreach my $child (@{$current->{$key}}) {
+ _copy_extra_info($child, $new->{$key}->[$index], $level);
+ $index++;
+ }
+ }
+ }
+
+ foreach my $info_type ('info', 'extra') {
+ next if (!$current->{$info_type});
+ foreach my $key (sort(keys(%{$current->{$info_type}}))) {
+ my $value = $current->{$info_type}->{$key};
+ #print STDERR (' ' x $level) . "K $info_type $key |$value\n";
+ if (ref($value) eq '') {
+ $new->{$info_type}->{$key} = $value;
+ } elsif (ref($value) eq 'ARRAY') {
+ #print STDERR (' ' x $level) .
+ # "Array $command_or_type $info_type -> $key\n";
+ # misc_args index_entry
+ if (ref($value->[0]) eq '') {
+ $new->{$info_type}->{$key} = [@$value];
+ } else {
+ # authors manual_content menus node_content
+ my $new_array = $new->{$info_type}->{$key};
+ for (my $index = 0; $index < scalar(@{$value}); $index++) {
+ if (!defined($new_array->[$index])) {
+ my $context = "$info_type [$command_or_type]{$key} [$index]";
+ $new_array->[$index] = _get_copy_ref($value->[$index], $context);
+ }
+ _copy_extra_info($value->[$index],
+ $value->[$index]->{'_copy'}, $level)
+ if ($value->[$index]->{'_copy'});
+ }
+ }
+ } elsif (ref($value) eq 'HASH') {
+ #print STDERR (' ' x $level)
+ # . "Hash $command_or_type $info_type -> $key\n";
+ if ($extra_directions{$key}) {
+ my $new_directions = $new->{$info_type}->{$key};
+ foreach my $direction (sort(keys(%$value))) {
+ if (!exists($new_directions->{$direction})) {
+ my $context = "$info_type [$command_or_type]{$key} {$direction}";
+ $new_directions->{$direction}
+ = _get_copy_ref($value->{$direction}, $context);
+ }
+ _copy_extra_info($value->{$direction},
+ $value->{$direction}->{'_copy'}, $level)
+ if ($value->{$direction}->{'_copy'});
+ }
+ } else {
+ if (not defined($value->{'cmdname'}) and not
defined($value->{'type'})
+ and not defined($value->{'text'}) and not
defined($value->{'extra'})
+ and not defined($value->{'contents'})
+ and not defined($value->{'args'})
+ and scalar(keys(%$value))) {
+ print STDERR "HASH NOT ELEMENT $info_type
[$command_or_type]{$key}\n";
+ }
+ if (!exists($new->{$info_type}->{$key})) {
+ my $context = "${info_type}[$command_or_type]{$key}";
+ $new->{$info_type}->{$key} = _get_copy_ref($value, $context);
+ }
+ if ($value->{'_copy'}) {
+ _copy_extra_info($value, $value->{'_copy'}, $level);
+ }
+ }
+ } else {
+ print STDERR "Unexpected $info_type [$command_or_type]{$key}: "
+ .ref($value)."\n";
+ }
+ }
+ }
+}
+
+sub copy_tree($)
+{
+ my $current = shift;
+ my $copy = _copy_tree($current, undef);
+ _copy_extra_info($current, $copy);
+ return $copy;
+}
+
+# Never overriden by XS version
+sub copy_treeNonXS($)
+{
+ my $current = shift;
+ my $copy = _copy_tree($current, undef);
+ _copy_extra_info($current, $copy);
+ return $copy;
+}
+
+sub copy_contents($;$)
+{
+ my $element = shift;
+ my $type = shift;
+ my $tmp = {'contents' => $element->{'contents'}};
+ my $copy = copy_tree($tmp);
+ if (defined($type)) {
+ $copy->{'type'} = $type;
+ }
+ return $copy;
+}
+
+sub copy_contentsNonXS($;$)
+{
+ my $element = shift;
+ my $type = shift;
+ my $tmp = {'contents' => $element->{'contents'}};
+ my $copy = copy_treeNonXS($tmp);
+ if (defined($type)) {
+ $copy->{'type'} = $type;
+ }
+ return $copy;
+}
+
+sub modify_tree($$;$);
+sub modify_tree($$;$)
+{
+ my $tree = shift;
+ my $operation = shift;
+ my $argument = shift;
+ #print STDERR "modify_tree tree: $tree\n";
+
+ if (!defined($tree) or ref($tree) ne 'HASH') {
+ cluck "tree ".(!defined($tree) ? 'UNDEF' : "not a hash: $tree");
+ return undef;
+ }
+
+ if ($tree->{'args'}) {
+ my $args_nr = scalar(@{$tree->{'args'}});
+ for (my $i = 0; $i < $args_nr; $i++) {
+ my $new_args = &$operation('arg', $tree->{'args'}->[$i], $argument);
+ if ($new_args) {
+ # replace by new content
+ splice(@{$tree->{'args'}}, $i, 1, @$new_args);
+ $i += scalar(@$new_args) -1;
+ $args_nr += scalar(@$new_args) -1;
+ } else {
+ modify_tree($tree->{'args'}->[$i], $operation, $argument);
+ }
+ }
+ }
+ if ($tree->{'contents'}) {
+ my $contents_nr = scalar(@{$tree->{'contents'}});
+ for (my $i = 0; $i < $contents_nr; $i++) {
+ my $new_contents = &$operation('content',
+ $tree->{'contents'}->[$i], $argument);
+ if ($new_contents) {
+ # replace by new content
+ splice(@{$tree->{'contents'}}, $i, 1, @$new_contents);
+ $i += scalar(@$new_contents) -1;
+ $contents_nr += scalar(@$new_contents) -1;
+ } else {
+ modify_tree($tree->{'contents'}->[$i], $operation, $argument);
+ }
+ }
+ }
+ if ($tree->{'source_marks'}) {
+ my @source_marks = @{$tree->{'source_marks'}};
+ for (my $i = 0; $i <= $#source_marks; $i++) {
+ if ($source_marks[$i]->{'element'}) {
+ my $new_element
+ = &$operation('source_mark', $source_marks[$i]->{'element'},
+ $argument);
+ if ($new_element) {
+ $source_marks[$i]->{'element'} = $new_element->[0];
+ }
+ }
+ }
+ }
+ return $tree;
+}
+
+sub _protect_comma($$)
+{
+ my $type = shift;
+ my $current = shift;
+
+ return _protect_text($current, quotemeta(','));
+}
+
+sub protect_comma_in_tree($)
+{
+ my $tree = shift;
+
+ return modify_tree($tree, \&_protect_comma);
+}
+
+sub _new_asis_command_with_text($$;$)
+{
+ my $text = shift;
+ my $parent = shift;
+ my $text_type = shift;
+ my $new_command = {'cmdname' => 'asis', 'parent' => $parent };
+ push @{$new_command->{'args'}}, {'type' => 'brace_command_arg',
+ 'parent' => $new_command};
+ push @{$new_command->{'args'}->[0]->{'contents'}}, {
+ 'text' => $text,
+ 'parent' => $new_command->{'args'}->[0]};
+ if (defined($text_type)) {
+ $new_command->{'args'}->[0]->{'contents'}->[0]->{'type'} = $text_type;
+ }
+ return $new_command;
+}
+
+sub _protect_text($$)
+{
+ my $current = shift;
+ my $to_protect = shift;
+
+ #print STDERR "_protect_text: $to_protect: $current "
+ # .debug_print_element($current, 1)."\n";
+ if (defined($current->{'text'}) and $current->{'text'} =~ /$to_protect/
+ and !(defined($current->{'type'})
+ and ($current->{'type'} eq 'raw'
+ or $current->{'type'} eq 'rawline_arg'))) {
+ my @result = ();
+ my $remaining_text = $current->{'text'};
+
+ my $remaining_source_marks;
+ my $current_position = 0;
+ if ($current->{'source_marks'}) {
+ $remaining_source_marks = [@{$current->{'source_marks'}}];
+ delete $current->{'source_marks'};
+ }
+ while ($remaining_text) {
+ if ($remaining_text =~ s/^(.*?)(($to_protect)+)//) {
+ # Note that it includes for completeness the case of $1 eq ''
+ # although it is unclear that source marks may happen in that case
+ # as they are rather associated to the previous element.
+ my $e = {'text' => $1, 'parent' => $current->{'parent'}};
+ $e->{'type'} = $current->{'type'} if defined($current->{'type'});
+ $current_position = Texinfo::Common::relocate_source_marks(
+ $remaining_source_marks, $e,
+ $current_position, length($1));
+ if ($e->{'text'} ne '' or $e->{'source_marks'}) {
+ push @result, $e;
+ }
+ if ($to_protect eq quotemeta(',')) {
+ for (my $i = 0; $i < length($2); $i++) {
+ my $e = {'cmdname' => 'comma', 'parent' => $current->{'parent'},
+ 'args' => [{'type' => 'brace_command_arg'}]};
+ $current_position = Texinfo::Common::relocate_source_marks(
+ $remaining_source_marks, $e,
+ $current_position, 1);
+ push @result, $e;
+ }
+ } else {
+ my $new_asis = _new_asis_command_with_text($2, $current->{'parent'},
+ $current->{'type'});
+ my $e = $new_asis->{'args'}->[0]->{'contents'}->[0];
+ $current_position = Texinfo::Common::relocate_source_marks(
+ $remaining_source_marks, $e,
+ $current_position, length($2));
+ push @result, $new_asis;
+ }
+ } else {
+ my $e = {'text' => $remaining_text, 'parent' => $current->{'parent'}};
+ $e->{'type'} = $current->{'type'} if defined($current->{'type'});
+ $current_position = Texinfo::Common::relocate_source_marks(
+ $remaining_source_marks, $e,
+ $current_position,
length($remaining_text));
+ push @result, $e;
+ last;
+ }
+ }
+ #print STDERR "_protect_text: Result: @result\n";
+ return \@result;
+ } else {
+ #print STDERR "_protect_text: No change\n";
+ return undef;
+ }
+}
+
+sub _protect_colon($$)
+{
+ my $type = shift;
+ my $current = shift;
+
+ return _protect_text($current, quotemeta(':'));
+}
+
+sub protect_colon_in_tree($)
+{
+ my $tree = shift;
+
+ return modify_tree($tree, \&_protect_colon);
+}
+
+sub _protect_node_after_label($$)
+{
+ my $type = shift;
+ my $current = shift;
+
+ return _protect_text($current, '['. quotemeta(".\t,") .']');
+}
+
+sub protect_node_after_label_in_tree($)
+{
+ my $tree = shift;
+
+ return modify_tree($tree, \&_protect_node_after_label);
+}
+
+sub protect_first_parenthesis($)
+{
+ my $element = shift;
+ confess("BUG: protect_first_parenthesis element undef")
+ if (!defined($element));
+ confess("BUG: protect_first_parenthesis not a hash")
+ if (ref($element) ne 'HASH');
+ #print STDERR "protect_first_parenthesis: $element->{'contents'}\n";
+ return if (!$element->{'contents'} or !scalar(@{$element->{'contents'}}));
+
+ my $current_position = 0;
+ my $nr_contents = scalar(@{$element->{'contents'}});
+ for (my $i = 0; $i < $nr_contents; $i++) {
+ my $content = $element->{'contents'}->[$i];
+ return if (!defined($content->{'text'}));
+ if ($content->{'text'} eq '') {
+ next;
+ }
+ if ($content->{'text'} =~ /^\(/) {
+ my $remaining_source_marks;
+ my $current_position = 0;
+ if ($content->{'source_marks'}) {
+ $remaining_source_marks = [@{$content->{'source_marks'}}];
+ delete $content->{'source_marks'};
+ }
+ my $new_asis = _new_asis_command_with_text('(', $content->{'parent'},
+ $content->{'type'});
+ my $e = $new_asis->{'args'}->[0]->{'contents'}->[0];
+ $current_position = Texinfo::Common::relocate_source_marks(
+ $remaining_source_marks, $e,
+ $current_position, length('('));
+ if ($content->{'text'} !~ /^\($/) {
+ $content->{'text'} =~ s/^\(//;
+ $current_position = Texinfo::Common::relocate_source_marks(
+ $remaining_source_marks, $content,
+ $current_position, length($content->{'text'}));
+ } else {
+ splice (@{$element->{'contents'}}, $i, 1);
+ }
+ splice (@{$element->{'contents'}}, $i, 0, $new_asis);
+ }
+ return;
+ }
+}
+
+sub move_index_entries_after_items($)
+{
+ # enumerate or itemize
+ my $current = shift;
+
+ return unless ($current->{'contents'});
+
+ my $previous;
+ foreach my $item (@{$current->{'contents'}}) {
+ #print STDERR "Before proceeding: $previous $item->{'cmdname'}
(@{$previous->{'contents'}})\n" if ($previous and $previous->{'contents'});
+ if (defined($previous) and $item->{'cmdname'}
+ and $item->{'cmdname'} eq 'item'
+ and $previous->{'contents'} and scalar(@{$previous->{'contents'}})) {
+
+ my $previous_ending_container;
+ if ($previous->{'contents'}->[-1]->{'type'}
+ and ($previous->{'contents'}->[-1]->{'type'} eq 'paragraph'
+ or $previous->{'contents'}->[-1]->{'type'} eq 'preformatted')) {
+ $previous_ending_container = $previous->{'contents'}->[-1];
+ } else {
+ $previous_ending_container = $previous;
+ }
+
+ my $contents_nr = scalar(@{$previous_ending_container->{'contents'}});
+
+ # find the last index entry, with possibly comments after
+ my $last_entry_idx = -1;
+ for (my $i = $contents_nr -1; $i >= 0; $i--) {
+ my $content = $previous_ending_container->{'contents'}->[$i];
+ if ($content->{'type'} and $content->{'type'} eq
'index_entry_command') {
+ $last_entry_idx = $i;
+ } elsif (not $content->{'cmdname'}
+ or ($content->{'cmdname'} ne 'c'
+ and $content->{'cmdname'} ne 'comment')) {
+ last;
+ }
+ }
+
+ if ($last_entry_idx >= 0) {
+ my $item_container;
+ if ($item->{'contents'} and $item->{'contents'}->[0]
+ and $item->{'contents'}->[0]->{'type'}
+ and $item->{'contents'}->[0]->{'type'} eq 'preformatted') {
+ $item_container = $item->{'contents'}->[0];
+ } else {
+ $item_container = $item;
+ }
+
+ for (my $i = $last_entry_idx; $i < $contents_nr; $i++) {
+ $previous_ending_container->{'contents'}->[$i]->{'parent'}
+ = $item_container;
+ }
+
+ my $insertion_idx = 0;
+ if ($item_container->{'contents'}
+ and $item_container->{'contents'}->[0]
+ and $item_container->{'contents'}->[0]->{'type'}
+ and $item_container->{'contents'}->[0]->{'type'} eq
'ignorable_spaces_after_command') {
+ # insert after leading spaces, and add an end of line if there
+ # is none
+ $insertion_idx = 1;
+ $item_container->{'contents'}->[0]->{'text'} .= "\n"
+ if ($item_container->{'contents'}->[0]->{'text'} !~ /\n$/);
+ }
+ # first part of the splice is the insertion in $item_container
+ splice (@{$item_container->{'contents'}},
+ $insertion_idx, 0,
+ # this splice removes from the previous container starting
+ # at $last_entry_idx and returns the contents to be
inserted
+ splice (@{$previous_ending_container->{'contents'}},
+ $last_entry_idx, $contents_nr - $last_entry_idx));
+ delete $previous_ending_container->{'contents'}
+ if (!scalar(@{$previous_ending_container->{'contents'}}))
+ }
+ }
+ $previous = $item;
+ }
+}
+
+sub _move_index_entries_after_items($$)
+{
+ my $type = shift;
+ my $current = shift;
+
+ if ($current->{'cmdname'} and ($current->{'cmdname'} eq 'enumerate'
+ or $current->{'cmdname'} eq 'itemize')) {
+ move_index_entries_after_items($current);
+ }
+ return undef;
+}
+
+# For @itemize/@enumerate
+sub move_index_entries_after_items_in_tree($)
+{
+ my $tree = shift;
+
+ modify_tree($tree, \&_move_index_entries_after_items);
+}
+
+sub _relate_index_entries_to_table_items_in($$)
+{
+ my $table = shift;
+ my $indices_information = shift;
+
+ return unless $table->{'contents'};
+
+ foreach my $table_entry (@{$table->{'contents'}}) {
+ next unless $table_entry->{'contents'}
+ and $table_entry->{'type'} eq 'table_entry';
+
+ my $term = $table_entry->{'contents'}->[0];
+ my $definition;
+ my $item;
+
+ # Move any index entries from the start of a 'table_definition' to
+ # the 'table_term'.
+ if (defined($table_entry->{'contents'}->[1])
+ and defined($table_entry->{'contents'}->[1]->{'type'})
+ and $table_entry->{'contents'}->[1]->{'type'} eq 'table_definition') {
+ $definition = $table_entry->{'contents'}->[1];
+ my $nr_index_entry_command = 0;
+ foreach my $child (@{$definition->{'contents'}}) {
+ if ($child->{'type'} and $child->{'type'} eq 'index_entry_command') {
+ $child->{'parent'} = $term;
+ $nr_index_entry_command++;
+ } else {
+ last;
+ }
+ }
+ if ($nr_index_entry_command > 0) {
+ unshift @{$term->{'contents'}},
+ splice (@{$definition->{'contents'}}, 0, $nr_index_entry_command);
+ }
+ }
+
+ if (defined($term->{'type'}) and $term->{'type'} eq 'table_term') {
+ # Relate the first index_entry_command in the 'table_term' to
+ # the term itself.
+
+ my $index_entry;
+ my $index_element;
+ foreach my $content (@{$term->{'contents'}}) {
+ if ($content->{'type'}
+ and $content->{'type'} eq 'index_entry_command') {
+ if (!$index_entry) {
+ my $index_info;
+ $index_element = $content;
+ ($index_entry, $index_info)
+ = Texinfo::Common::lookup_index_entry(
+ $content->{'extra'}->{'index_entry'},
+ $indices_information);
+ }
+ } elsif ($content->{'cmdname'} and $content->{'cmdname'} eq 'item') {
+ $item = $content unless $item;
+ }
+ if ($item and $index_entry) {
+ # This is better than overwriting 'entry_element', which
+ # holds important information.
+ $index_entry->{'entry_associated_element'} = $item;
+ # also add a reference from element to index entry in index
+ $item->{'extra'} = {} if (!$item->{'extra'});
+ $item->{'extra'}->{'associated_index_entry'}
+ = [@{$index_element->{'extra'}->{'index_entry'}}];
+ last;
+ }
+ }
+ }
+ }
+}
+
+# Locate all @tables in the tree, and relate index entries to
+# the @item that immediately follows or precedes them.
+sub _relate_index_entries_to_table_items($$$)
+{
+ my $type = shift;
+ my $current = shift;
+ my $indices_information = shift;
+
+ if ($current->{'cmdname'} and $current->{'cmdname'} eq 'table') {
+ _relate_index_entries_to_table_items_in($current, $indices_information);
+ }
+ return undef;
+}
+
+sub relate_index_entries_to_table_items_in_tree($)
+{
+ my $document = shift;
+
+ my $tree = $document->tree();
+ my $indices_information = $document->indices_information();
+
+ modify_tree($tree, \&_relate_index_entries_to_table_items,
+ $indices_information);
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Texinfo::ManipulateTree - Texinfo modules common tree manipulation functions
+
+=head1 SYNOPSIS
+
+ use Texinfo::ManipulateTree;
+
+=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.
+
+=head1 DESCRIPTION
+
+Texinfo::ManipulateTree contains methods for copying and modifying the
+Texinfo tree used for default conversion to output formats.
+
+For optional tree transformation, see L<Texinfo::Transformations>.
+
+=head1 METHODS
+
+The Texinfo tree and Texinfo tree elements used in argument of some functions
+are documented in L<Texinfo::Parser/TEXINFO TREE>. When customization
+information is needed, an object that defines C<get_conf> is
+expected, normally a L<Texinfo::Document/Getting customization
+options values registered in document> object.
+
+=over
+
+=item move_index_entries_after_items_in_tree($tree)
+X<C<move_index_entries_after_items_in_tree>>
+
+In C<@enumerate> and C<@itemize> from the tree, move index entries
+appearing just before C<@item> after the C<@item>. Comment lines
+between index entries are moved too.
+
+=item protect_colon_in_tree($tree)
+
+=item protect_node_after_label_in_tree($tree)
+X<C<protect_colon_in_tree>>
+X<C<protect_node_after_label_in_tree>>
+
+Protect colon with C<protect_colon_in_tree> and characters that
+are special in node names after a label in menu entries (tab
+dot and comma) with C<protect_node_after_label_in_tree>.
+The protection is achieved by putting protected characters
+in C<@asis{}>.
+
+=item protect_comma_in_tree($tree)
+X<C<protect_comma_in_tree>>
+
+Protect comma characters, replacing C<,> with @comma{} in tree.
+
+=item protect_first_parenthesis($element)
+X<C<protect_first_parenthesis>>
+
+Modify I<$element> contents by protecting the first parenthesis.
+If I<$element> is undef a fatal error with a backtrace will be emitted.
+
+=item relate_index_entries_to_table_items_in_tree($document)
+X<C<relate_index_entries_to_table_items_in_tree>>
+
+In tables, relate index entries preceding and following an
+entry with said item. Reference one of them in the entry's
+C<entry_associated_element>.
+
+=back
+
+=head1 SEE ALSO
+
+L<Texinfo::Document>, L<Texinfo::Structuring>, L<Texinfo::Transformations>.
+
+=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
diff --git a/tp/Texinfo/Structuring.pm b/tp/Texinfo/Structuring.pm
index d8a280b5a7..daffcf776c 100644
--- a/tp/Texinfo/Structuring.pm
+++ b/tp/Texinfo/Structuring.pm
@@ -26,14 +26,15 @@ use 5.00405;
# See comment at start of HTML.pm
use if $] >= 5.012, feature => 'unicode_strings';
-use strict;
-# Can be used to check that there is no incorrect autovivfication
-# no autovivification qw(fetch delete exists store strict);
-
# stop \s from matching non-ASCII spaces, etc. \p{...} can still be
# used to match Unicode character classes.
use if $] >= 5.014, re => '/a';
+use strict;
+
+# Can be used to check that there is no incorrect autovivfication
+# no autovivification qw(fetch delete exists store strict);
+
use Carp qw(cluck confess);
use Texinfo::StructTransfXS;
@@ -42,6 +43,7 @@ use Texinfo::XSLoader;
use Texinfo::Commands;
use Texinfo::Common;
+use Texinfo::ManipulateTree;
# for error messages
use Texinfo::Convert::Texinfo qw(target_element_to_texi_label
@@ -1307,26 +1309,28 @@ sub new_node_menu_entry
}
$menu_entry_name
- = Texinfo::Common::copy_contentsNonXS($name_element, 'menu_entry_name');
+ = Texinfo::ManipulateTree::copy_contentsNonXS($name_element,
+ 'menu_entry_name');
foreach my $content (@{$menu_entry_name->{'contents'}}) {
$content->{'parent'} = $menu_entry_name;
}
# colons could be doubly protected, but it is probably better
# than not protected at all.
- Texinfo::Common::protect_colon_in_tree($menu_entry_name);
+ Texinfo::ManipulateTree::protect_colon_in_tree($menu_entry_name);
}
my $entry = {'type' => 'menu_entry'};
my $menu_entry_node
- = Texinfo::Common::copy_contentsNonXS($node_name_element,
'menu_entry_node');
+ = Texinfo::ManipulateTree::copy_contentsNonXS($node_name_element,
+ 'menu_entry_node');
foreach my $content (@{$menu_entry_node->{'contents'}}) {
$content->{'parent'} = $menu_entry_node;
}
# do not protect here, as it could already be protected, and
# the menu entry should be the same as the node
- #Texinfo::Common::protect_colon_in_tree($menu_entry_node);
+ #Texinfo::ManipulateTree::protect_colon_in_tree($menu_entry_node);
my $description = {'type' => 'menu_entry_description',
'contents' => []};
@@ -1476,7 +1480,7 @@ sub new_complete_node_menu
if ($associated_part and $associated_part->{'args'}
and scalar(@{$associated_part->{'args'}}) > 0) {
my $part_title_copy
- = Texinfo::Common::copy_contentsNonXS(
+ = Texinfo::ManipulateTree::copy_contentsNonXS(
$associated_part->{'args'}->[0]);
my $part_title
= Texinfo::Translations::gdt('Part: {part_title}',
@@ -1628,7 +1632,8 @@ sub _print_down_menus($$$$$;$)
foreach my $menu (@menus) {
foreach my $entry (@{$menu->{'contents'}}) {
if ($entry->{'type'} and $entry->{'type'} eq 'menu_entry') {
- push @master_menu_contents, Texinfo::Common::copy_treeNonXS($entry);
+ push @master_menu_contents,
+ Texinfo::ManipulateTree::copy_treeNonXS($entry);
# gather node children to recursively print their menus
my $node
= _normalized_entry_associated_internal_node($entry,
@@ -1650,7 +1655,7 @@ sub _print_down_menus($$$$$;$)
}
my $node_title_copy
- = Texinfo::Common::copy_contentsNonXS($node_name_element);
+ = Texinfo::ManipulateTree::copy_contentsNonXS($node_name_element);
_insert_menu_comment_content(\@master_menu_contents, 0,
$node_title_copy, 0);
diff --git a/tp/Texinfo/Transformations.pm b/tp/Texinfo/Transformations.pm
index e2ffa6b9dc..769d8524c2 100644
--- a/tp/Texinfo/Transformations.pm
+++ b/tp/Texinfo/Transformations.pm
@@ -37,8 +37,9 @@ use Texinfo::XSLoader;
use Texinfo::Commands;
use Texinfo::Common;
use Texinfo::Translations;
-use Texinfo::Structuring;
use Texinfo::Document;
+use Texinfo::ManipulateTree;
+use Texinfo::Structuring;
require Exporter;
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
@@ -181,7 +182,8 @@ sub fill_gaps_in_sectioning($;$)
my $line_content;
if ($commands_heading_content) {
$line_content
- = Texinfo::Common::copy_contentsNonXS($commands_heading_content);
+ = Texinfo::ManipulateTree::copy_contentsNonXS(
+ $commands_heading_content);
$line_content->{'parent'} = $line_arg;
} else {
my $asis_command = {'cmdname' => 'asis',
@@ -270,7 +272,7 @@ sub reference_to_arg_in_tree($)
{
my $tree = shift;
- return Texinfo::Common::modify_tree($tree, \&_reference_to_arg);
+ return Texinfo::ManipulateTree::modify_tree($tree, \&_reference_to_arg);
}
# prepare and add a new node as a possible cross reference targets
@@ -315,13 +317,14 @@ sub _new_node($$;$)
# 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 = Texinfo::ManipulateTree::protect_comma_in_tree($node_tree);
# always
- Texinfo::Common::protect_first_parenthesis($node_tree);
+ Texinfo::ManipulateTree::protect_first_parenthesis($node_tree);
# in menu entry without label
- $node_tree = Texinfo::Common::protect_colon_in_tree($node_tree);
+ $node_tree = Texinfo::ManipulateTree::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
+ = Texinfo::ManipulateTree::protect_node_after_label_in_tree($node_tree);
$node_tree = reference_to_arg_in_tree($node_tree);
my $empty_node = 0;
@@ -452,7 +455,7 @@ sub insert_nodes_for_sectioning_commands($)
$new_node_tree = {'contents' => [{'text' => 'Top'}]};
} else {
$new_node_tree
- = Texinfo::Common::copy_contentsNonXS($content->{'args'}->[0]);
+ =
Texinfo::ManipulateTree::copy_contentsNonXS($content->{'args'}->[0]);
}
my $new_node = _new_node($new_node_tree, $document,
$customization_information);
@@ -467,8 +470,8 @@ 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($content, \&_reassociate_to_node,
- [$new_node, $previous_node]);
+ Texinfo::ManipulateTree::modify_tree($content, \&_reassociate_to_node,
+ [$new_node, $previous_node]);
}
}
# check is_target to avoid erroneous nodes, such as duplicates
@@ -909,7 +912,7 @@ sub protect_hashchar_at_line_beginning($;$$)
my $registrar = shift;
my $customization_information = shift;
- return Texinfo::Common::modify_tree($tree,
+ return Texinfo::ManipulateTree::modify_tree($tree,
\&_protect_hashchar_at_line_beginning,
[$registrar, $customization_information]);
}
@@ -922,7 +925,7 @@ sub _protect_first_parenthesis_in_targets($$$)
my $element_label = Texinfo::Common::get_label_element($current);
if ($element_label) {
- Texinfo::Common::protect_first_parenthesis($element_label);
+ Texinfo::ManipulateTree::protect_first_parenthesis($element_label);
}
return undef;
}
@@ -931,7 +934,8 @@ sub protect_first_parenthesis_in_targets($)
{
my $tree = shift;
- Texinfo::Common::modify_tree($tree, \&_protect_first_parenthesis_in_targets);
+ Texinfo::ManipulateTree::modify_tree($tree,
+ \&_protect_first_parenthesis_in_targets);
}
1;
@@ -955,6 +959,9 @@ without nodes and C<complete_tree_nodes_menus> and
C<complete_tree_nodes_missing_menu> that completes the node menus based on the
sectioning tree.
+Methods for copying and modifying the Texinfo tree used for default
+conversion to output formats are in L<Texinfo::ManipulateTree>.
+
=head1 METHODS
No method is exported in the default case.
@@ -1057,7 +1064,7 @@ nodes are used as labels in the generated master menu.
=head1 SEE ALSO
L<Texinfo manual|http://www.gnu.org/s/texinfo/manual/texinfo/>,
-L<Texinfo::Parser>.
+L<Texinfo::Parser>, L<Texinfo::ManipulateTree>.
=head1 AUTHOR
diff --git a/tp/Texinfo/Translations.pm b/tp/Texinfo/Translations.pm
index fb9ed212ab..dbe9da62c7 100644
--- a/tp/Texinfo/Translations.pm
+++ b/tp/Texinfo/Translations.pm
@@ -47,6 +47,8 @@ use Texinfo::Convert::Unicode;
# to load a parser
use Texinfo::Parser;
+use Texinfo::ManipulateTree;
+
# we want a reliable way to switch locale for the document
# strings translations so we don't use the system gettext.
Locale::Messages->select_package ('gettext_pp');
@@ -410,7 +412,8 @@ sub complete_indices($;$)
$name = $arg;
} elsif ($role eq 'class') {
$class = $arg;
- } elsif ($role eq 'arg' or $role eq 'typearg' or $role eq
'delimiter') {
+ } elsif ($role eq 'arg' or $role eq 'typearg'
+ or $role eq 'delimiter') {
last;
}
}
@@ -422,10 +425,10 @@ sub complete_indices($;$)
my $def_command = $main_entry_element->{'extra'}->{'def_command'};
- my $class_copy = Texinfo::Common::copy_treeNonXS($class);
- my $name_copy = Texinfo::Common::copy_treeNonXS($name);
- my $ref_class_copy = Texinfo::Common::copy_treeNonXS($class);
- my $ref_name_copy = Texinfo::Common::copy_treeNonXS($name);
+ my $class_copy = Texinfo::ManipulateTree::copy_treeNonXS($class);
+ my $name_copy = Texinfo::ManipulateTree::copy_treeNonXS($name);
+ my $ref_class_copy = Texinfo::ManipulateTree::copy_treeNonXS($class);
+ my $ref_name_copy = Texinfo::ManipulateTree::copy_treeNonXS($name);
# Use the document language that was current when the command was
# used for getting the translation.
diff --git a/tp/t/index_before_item.t b/tp/t/index_before_item.t
index 936698e3b7..26aef75be3 100644
--- a/tp/t/index_before_item.t
+++ b/tp/t/index_before_item.t
@@ -8,9 +8,9 @@ use Test::More;
BEGIN { plan tests => 6; }
use Texinfo::Parser qw(parse_texi_piece);
-use Texinfo::Common qw(move_index_entries_after_items_in_tree);
-use Texinfo::Document;
use Texinfo::Convert::Texinfo;
+use Texinfo::Document;
+use Texinfo::ManipulateTree;
use Texinfo::DebugTree;
ok(1);
@@ -26,7 +26,7 @@ sub run_test($$$)
#print STDERR Texinfo::DebugTree::convert_tree(undef, $tree)."\n";
- move_index_entries_after_items_in_tree($tree);
+ Texinfo::ManipulateTree::move_index_entries_after_items_in_tree($tree);
# rebuild tree
$tree = $document->tree();
diff --git a/tp/t/protect_character_in_texinfo.t
b/tp/t/protect_character_in_texinfo.t
index 75128975c6..caef11dca9 100644
--- a/tp/t/protect_character_in_texinfo.t
+++ b/tp/t/protect_character_in_texinfo.t
@@ -8,10 +8,9 @@ use Test::More;
BEGIN { plan tests => 7; }
use Texinfo::Parser qw(parse_texi_line parse_texi_piece);
-use Texinfo::Common qw(protect_comma_in_tree protect_colon_in_tree
- protect_node_after_label_in_tree);
use Texinfo::Convert::Texinfo;
use Texinfo::Document;
+use Texinfo::ManipulateTree;
use Texinfo::XSLoader;
my $XS_structuring = Texinfo::XSLoader::XS_structuring_enabled();
@@ -45,13 +44,13 @@ sub run_test($$$$)
foreach my $tree ($tree_as_text, $tree_as_line) {
if ($do->{'protect_comma'}) {
- protect_comma_in_tree($tree);
+ Texinfo::ManipulateTree::protect_comma_in_tree($tree);
}
if ($do->{'protect_colon'}) {
- protect_colon_in_tree($tree);
+ Texinfo::ManipulateTree::protect_colon_in_tree($tree);
}
if ($do->{'protect_node_after_label'}) {
- protect_node_after_label_in_tree($tree);
+ Texinfo::ManipulateTree::protect_node_after_label_in_tree($tree);
}
}
diff --git a/tp/t/test_protect_contents.t b/tp/t/test_protect_contents.t
index f055b8306a..b10572a8f7 100644
--- a/tp/t/test_protect_contents.t
+++ b/tp/t/test_protect_contents.t
@@ -8,7 +8,6 @@ use Test::More;
BEGIN { plan tests => 2; }
use Texinfo::Parser qw(parse_texi_line parse_texi_piece);
-use Texinfo::Common qw(protect_first_parenthesis);
use Texinfo::Convert::Texinfo;
use Texinfo::Document;
use Texinfo::Transformations;
diff --git a/tp/t/test_tree_copy.t b/tp/t/test_tree_copy.t
index d880a5f179..cc15c6fc38 100644
--- a/tp/t/test_tree_copy.t
+++ b/tp/t/test_tree_copy.t
@@ -16,6 +16,7 @@ use Texinfo::Common;
use Texinfo::Parser;
use Texinfo::Convert::Texinfo;
use Texinfo::Document;
+use Texinfo::ManipulateTree;
use Texinfo::Structuring;
my $srcdir = $ENV{'srcdir'};
@@ -57,7 +58,7 @@
$tref->{'contents'}->[1]->{'extra'}->{'thing'}->{'contents'}->[0]->{'extra'}->{'
my $tref_texi = Texinfo::Convert::Texinfo::convert_to_texinfo($tref);
-my $tref_copy = Texinfo::Common::copy_treeNonXS($tref);
+my $tref_copy = Texinfo::ManipulateTree::copy_treeNonXS($tref);
my $tref_copy_texi = Texinfo::Convert::Texinfo::convert_to_texinfo($tref_copy);
@@ -137,7 +138,7 @@ T
my $test_parser = Texinfo::Parser::parser();
my $document = Texinfo::Parser::parse_texi_piece($test_parser, $text);
my $tree = $document->tree();
-my $copy = Texinfo::Common::copy_tree($tree);
+my $copy = Texinfo::ManipulateTree::copy_tree($tree);
my $texi_tree = Texinfo::Convert::Texinfo::convert_to_texinfo($tree);
@@ -151,7 +152,7 @@ Texinfo::Structuring::sectioning_structure($document);
# rebuild the tree
$tree = $document->tree();
-my $copy_with_sec = Texinfo::Common::copy_tree($tree);
+my $copy_with_sec = Texinfo::ManipulateTree::copy_tree($tree);
my $texi_tree_with_sec = Texinfo::Convert::Texinfo::convert_to_texinfo($tree);
my $texi_copy_with_sec
@@ -182,7 +183,7 @@ foreach my $file_include (['Texinfo', $manual_file,
$manual_include_dir],
warn "$label: ".$error_message->{'error_line'}
if ($debug);
}
- my $test_tree_copy = Texinfo::Common::copy_tree($texinfo_test_tree);
+ my $test_tree_copy = Texinfo::ManipulateTree::copy_tree($texinfo_test_tree);
my $test_texi
= Texinfo::Convert::Texinfo::convert_to_texinfo($texinfo_test_tree);
diff --git a/tp/t/test_utils.pl b/tp/t/test_utils.pl
index 32700a76d2..9774668ef5 100644
--- a/tp/t/test_utils.pl
+++ b/tp/t/test_utils.pl
@@ -70,6 +70,7 @@ use Texinfo::Parser;
use Texinfo::Convert::Text;
use Texinfo::Document;
use Texinfo::Convert::PlainTexinfo;
+use Texinfo::ManipulateTree;
use Texinfo::Structuring;
use Texinfo::Indices;
use Texinfo::Translations;
@@ -891,10 +892,10 @@ sub test($$)
# There are other specific tests for comparison to texinfo, but here
# we also get the tree.
%tested_transformations = (
- 'protect_comma' => \&Texinfo::Common::protect_comma_in_tree,
- 'protect_colon' => \&Texinfo::Common::protect_colon_in_tree,
+ 'protect_comma' => \&Texinfo::ManipulateTree::protect_comma_in_tree,
+ 'protect_colon' => \&Texinfo::ManipulateTree::protect_colon_in_tree,
'protect_node_after_label'
- => \&Texinfo::Common::protect_node_after_label_in_tree,
+ => \&Texinfo::ManipulateTree::protect_node_after_label_in_tree,
'protect_first_parenthesis'
=> \&Texinfo::Transformations::protect_first_parenthesis_in_targets,
'protect_hashchar_at_line_beginning'
@@ -1095,11 +1096,12 @@ sub test($$)
}
if ($tree_transformations{'relate_index_entries_to_items'}) {
- Texinfo::Common::relate_index_entries_to_table_items_in_tree($document);
+ Texinfo::ManipulateTree::relate_index_entries_to_table_items_in_tree(
+ $document);
}
if ($tree_transformations{'move_index_entries_after_items'}) {
- Texinfo::Common::move_index_entries_after_items_in_tree($tree);
+ Texinfo::ManipulateTree::move_index_entries_after_items_in_tree($tree);
}
if ($tree_transformations{'insert_nodes_for_sectioning_commands'}) {
diff --git a/tp/texi2any.pl b/tp/texi2any.pl
index ac04b714ff..c55916c608 100755
--- a/tp/texi2any.pl
+++ b/tp/texi2any.pl
@@ -1643,12 +1643,13 @@ while(@input_files) {
if
($formats_table{$converted_format}->{'relate_index_entries_to_table_items'}
or $tree_transformations{'relate_index_entries_to_table_items'}) {
- Texinfo::Common::relate_index_entries_to_table_items_in_tree($document);
+ Texinfo::ManipulateTree::relate_index_entries_to_table_items_in_tree(
+ $document);
}
if ($formats_table{$converted_format}->{'move_index_entries_after_items'}
or $tree_transformations{'move_index_entries_after_items'}) {
- Texinfo::Common::move_index_entries_after_items_in_tree($tree);
+ Texinfo::ManipulateTree::move_index_entries_after_items_in_tree($tree);
}
if ($tree_transformations{'insert_nodes_for_sectioning_commands'}) {
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- branch master updated: * tp/Texinfo/ManipulateTree.pm, tp/Texinfo/Common.pm, tp/Makefile.am (dist_modules_DATA), doc/tp_api/Makefile.am (texi2any_internals_dependencies), : move tree transformation functions depending on modify_tree from Texinfo/Common.pm to the new Texinfo/ManipulateTree.pm module. Update callers.,
Patrice Dumas <=