texinfo/tp Texinfo/Common.pm Texinfo/Structurin...

[Patrice Dumas]

CVSROOT:        /sources/texinfo
Module name:    texinfo
Changes by:     Patrice Dumas <pertusus>        12/02/25 13:13:04

Modified files:
        tp/Texinfo     : Common.pm Structuring.pm 
        tp/t           : automatic_nodes.t 

Log message:
        Reassociate menus and index entries to automatically added nodes.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Common.pm?cvsroot=texinfo&r1=1.133&r2=1.134
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Structuring.pm?cvsroot=texinfo&r1=1.116&r2=1.117
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/automatic_nodes.t?cvsroot=texinfo&r1=1.3&r2=1.4

Patches:
Index: Texinfo/Common.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Common.pm,v
retrieving revision 1.133
retrieving revision 1.134
diff -u -b -r1.133 -r1.134
--- Texinfo/Common.pm   22 Feb 2012 00:03:44 -0000      1.133
+++ Texinfo/Common.pm   25 Feb 2012 13:13:04 -0000      1.134
@@ -1475,19 +1475,20 @@
   return $new;
 }
 
-sub modify_tree($$$);
-sub modify_tree($$$)
+sub modify_tree($$$;$);
+sub modify_tree($$$;$)
 {
   my $self = shift;
   my $tree = shift;
   my $operation = shift;
+  my $argument = shift;
   #print STDERR "modify_tree tree: $tree\n";
 
   if ($tree->{'args'}) {
     my @args = @{$tree->{'args'}};
     for (my $i = 0; $i <= $#args; $i++) {
-      modify_tree($self, $args[$i], $operation);
-      my @new_args = &$operation($self, 'arg', $args[$i]);
+      modify_tree($self, $args[$i], $operation, $argument);
+      my @new_args = &$operation($self, 'arg', $args[$i], $argument);
       # this puts the new args at the place of the old arg using the 
       # offset from the end of the array
       splice (@{$tree->{'args'}}, $i - $#args -1, 1, @new_args);
@@ -1499,8 +1500,8 @@
   if ($tree->{'contents'}) {
     my @contents = @{$tree->{'contents'}};
     for (my $i = 0; $i <= $#contents; $i++) {
-      modify_tree($self, $contents[$i], $operation);
-      my @new_contents = &$operation($self, 'content', $contents[$i]);
+      modify_tree($self, $contents[$i], $operation, $argument);
+      my @new_contents = &$operation($self, 'content', $contents[$i], 
$argument);
       # this puts the new contents at the place of the old content using the 
       # offset from the end of the array
       splice (@{$tree->{'contents'}}, $i - $#contents -1, 1, @new_contents);
@@ -1544,7 +1545,6 @@
   return $new_command;
 }
 
-
 sub _protect_text($$)
 {
   my $current = shift;

Index: Texinfo/Structuring.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Structuring.pm,v
retrieving revision 1.116
retrieving revision 1.117
diff -u -b -r1.116 -r1.117
--- Texinfo/Structuring.pm      24 Feb 2012 23:21:50 -0000      1.116
+++ Texinfo/Structuring.pm      25 Feb 2012 13:13:04 -0000      1.117
@@ -1297,6 +1297,49 @@
   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 = $nodes->[0];
+  my $previous_node = $nodes->[1];
+
+  if ($current->{'cmdname'} and $current->{'cmdname'} eq 'menu') {
+    if ($previous_node) {
+      if (!$previous_node->{'menus'} or address@hidden>{'menus'}}
+           or !grep {$current eq $_} @{$previous_node->{'menus'}}) {
+        print STDERR "Bug: menu $current not in previous node 
$previous_node\n";
+      } else {
+        @{$previous_node->{'menus'}} = grep {$_ ne $current} 
@{$previous_node->{'menus'}};
+        delete $previous_node->{'menus'} if !(@{$previous_node->{'menus'}});
+      }
+    } else {
+      my $info = $self->global_informations();
+      if (!$info or !$info->{'unassociated_menus'} 
+          or address@hidden>{'unassociated_menus'}}
+          or !grep {$current eq $_} @{$info->{'unassociated_menus'}}) {
+        print STDERR "Bug: menu $current not in unassociated menus\n";
+      } else {
+        @{$info->{'unassociated_menus'}} 
+          = grep {$_ ne $current} @{$info->{'unassociated_menus'}};
+        delete $info->{'unassociated_menus'} if 
!(@{$info->{'unassociated_menus'}});
+      }
+    }
+    push @{$new_node->{'menus'}}, $current;
+  } elsif ($current->{'extra'} and $current->{'extra'}->{'index_entry'}) {
+    if ($previous_node 
+        and (!$current->{'extra'}->{'index_entry'}->{'node'}
+             or $current->{'extra'}->{'index_entry'}->{'node'} ne 
$previous_node)) {
+      print STDERR "Bug: index entry $current not in previous node 
$previous_node\n";
+    }
+    $current->{'extra'}->{'index_entry'}->{'node'} = $new_node;
+  }
+  return ($current);
+}
+
 sub _insert_nodes_for_sectioning_commands($$)
 {
   my $self = shift;
@@ -1306,6 +1349,7 @@
     return undef;
   }
   my @contents;
+  my $previous_node;
   foreach my $content (@{$root->{'contents'}}) {
     if ($content->{'cmdname'} and $content->{'cmdname'} ne 'node'
         and $content->{'cmdname'} ne 'bye'
@@ -1325,9 +1369,13 @@
         $new_node->{'extra'}->{'associated_section'} = $content;
         $content->{'extra'}->{'associated_node'} = $new_node;
         $new_node->{'parent'} = $content->{'parent'};
-        # FIXME set $index_entry->{'node'}
+        # reassociate index entries and menus
+        Texinfo::Common::modify_tree($self, $content, \&_reassociate_to_node,
+                                     [$new_node, $previous_node]);
       }
     }
+    $previous_node = $content 
+      if ($content->{'cmdname'} and $content->{'cmdname'} eq 'node');
     push @contents, $content;
   }
   return address@hidden;

Index: t/automatic_nodes.t
===================================================================
RCS file: /sources/texinfo/texinfo/tp/t/automatic_nodes.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- t/automatic_nodes.t 24 Feb 2012 23:21:50 -0000      1.3
+++ t/automatic_nodes.t 25 Feb 2012 13:13:04 -0000      1.4
@@ -1,7 +1,7 @@
 use strict;
 
 use Test::More;
-BEGIN { plan tests => 12 };
+BEGIN { plan tests => 15 };
 
 use lib 'maintain/lib/Unicode-EastAsianWidth/lib/';
 use lib 'maintain/lib/libintl-perl/lib/';
@@ -114,8 +114,8 @@
 @bye
 ';
 
-  my $parser = Texinfo::Parser::parser();
-  my $tree = $parser->parse_texi_text ($sections_text);
+  $parser = Texinfo::Parser::parser();
+  $tree = $parser->parse_texi_text ($sections_text);
   my $new_content 
    = Texinfo::Structuring::_insert_nodes_for_sectioning_commands($parser, 
$tree);
   $tree->{'contents'} = $new_content;
@@ -123,3 +123,34 @@
   is ($reference, $result, 'add nodes');
   #print STDERR "$result";
   
+$parser = Texinfo::Parser::parser();
+$tree = $parser->parse_texi_text ('@node Top
address@hidden top
+
address@hidden chap
+
address@hidden index entry
+
address@hidden
+* (some_manual)::
address@hidden menu
+');
+$new_content
+   = Texinfo::Structuring::_insert_nodes_for_sectioning_commands($parser, 
$tree);
+$tree->{'contents'} = $new_content;
+my ($index_names, $merged_indices, $index_entries) = 
$parser->indices_information();
+my $labels = $parser->labels_information();
+ok (($labels->{'chap'}->{'menus'} and @{$labels->{'chap'}->{'menus'}}
+     and scalar(@{$labels->{'chap'}->{'menus'}}) == 1
+     and !exists($labels->{'Top'}->{'menus'})), 'new node has a menu');
+is (Texinfo::Convert::Texinfo::convert($labels->{'chap'}->{'menus'}->[0]),
+'@menu
+* (some_manual)::
address@hidden menu
+', 'reassociated menu is correct');
+#print STDERR join('|', keys(%$index_entries))."\n";
+is ($labels->{'chap'}, $index_entries->{'cp'}->[0]->{'node'}, 
+  'index entry reassociated');
+#print STDERR Texinfo::Convert::Texinfo::convert($tree);
+
+