texinfo/tp Texinfo/Structuring.pm t/test_utils.pl

[Patrice Dumas]

CVSROOT:        /sources/texinfo
Module name:    texinfo
Changes by:     Patrice Dumas <pertusus>        10/10/26 22:28:43

Modified files:
        tp/Texinfo     : Structuring.pm 
        tp/t           : test_utils.pl 

Log message:
        Determine the section command tree based on a texinfo tree.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Structuring.pm?cvsroot=texinfo&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/test_utils.pl?cvsroot=texinfo&r1=1.26&r2=1.27

Patches:
Index: Texinfo/Structuring.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Structuring.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- Texinfo/Structuring.pm      25 Oct 2010 22:09:06 -0000      1.5
+++ Texinfo/Structuring.pm      26 Oct 2010 22:28:43 -0000      1.6
@@ -24,6 +24,8 @@
 use 5.00405;
 use strict;
 
+use Texinfo::Convert::Text;
+
 require Exporter;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 @ISA = qw(Exporter);
@@ -36,7 +38,7 @@
 # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
 # will save memory.
 %EXPORT_TAGS = ( 'all' => [ qw(
-  
+  sectioning_structure  
 ) ] );
 
 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@@ -135,23 +137,155 @@
   }
 }
 
-sub sectioning_structure($)
+my %sec2level = (
+              'top', 0,
+              'chapter', 1,
+              'unnumbered', 1,
+              'chapheading', 1,
+              'appendix', 1,
+              'section', 2,
+              'unnumberedsec', 2,
+              'heading', 2,
+              'appendixsec', 2,
+              'subsection', 3,
+              'unnumberedsubsec', 3,
+              'subheading', 3,
+              'appendixsubsec', 3,
+              'subsubsection', 4,
+              'unnumberedsubsubsec', 4,
+              'subsubheading', 4,
+              'appendixsubsubsec', 4,
+         );
+
+# out of the main hierarchy
+$sec2level{'part'} = 0;
+# this are synonyms
+$sec2level{'appendixsection'} = 2;
+# sec2level{'majorheading'} is also 1 and not 0
+$sec2level{'majorheading'} = 1;
+$sec2level{'chapheading'} = 1;
+$sec2level{'centerchap'} = 1;
+
+my %appendix_commands;
+my %unnumbered_commands;
+foreach my $command (keys(%sec2level)) {
+  if ($command =~ /appendix/) {
+    $appendix_commands{$command} = 1;
+  } elsif ($command =~ /unnumbered/) {
+    $unnumbered_commands{$command} = 1;
+  }
+}
+$unnumbered_commands{'top'} = 1;
+$unnumbered_commands{'centerchap'} = 1;
+$unnumbered_commands{'part'} = 1;
+
+my $min_level = $sec2level{'top'};
+my $max_level = $sec2level{'subsubsection'};
+
+sub sectioning_structure($$)
 {
+  my $self = shift;
   my $root = shift;
   if (!$root->{'type'} or $root->{'type'} ne 'document_root'
       or !$root->{'contents'}) {
     return undef;
   }
+
+  my $sec_root = {'text' => '_ROOT'};
+  my $previous_command;
+
+  my $in_appendix = 0;
+  # lowest level with a number.  This is the lowest level above 0.
+  my $number_top_level;
+  
+  # holds the current number for all the levels.  It is not possible to use
+  # something like the last child index, because of @unnumber.
+  my @command_numbers;
   foreach my $content (@{$root->{'contents'}}) {
     if ($content->{'cmdname'} and $content->{'cmdname'} ne 'node'
         and $content->{'cmdname'} ne 'bye') {
-      my $level = 0;
-      $level = $content->{'extra'}->{'sections_level'}
-        if ($content->{'extra'} and $content->{'extra'}->{'sections_level'});
+      my $level = $sec2level{$content->{'cmdname'}};
+      # correct level according to raise/lowersections
+      if ($content->{'extra'} and $content->{'extra'}->{'sections_level'}) {
+        $level -= $content->{'extra'}->{'sections_level'};
+        if ($level < $min_level) {
+          $level = $min_level;
+        } elsif ($level > $max_level) {
+          $level = $max_level;
+        }
+      }
+      my $command = { 'section' => $content, 'level' => $level,
+         #             'name' => $content->{'cmdname'}, 
+         #             'text' => 
+         # Texinfo::Convert::Text::convert($content->{'args'}->[0])
+                                                        };
+      if ($previous_command) {
+        # new command is below
+        if ($previous_command->{'level'} < $level) {
+          if ($level - $previous_command->{'level'} > 1) {
+            $self->_line_error(sprintf($self->__("Upping the section level of 
address@hidden which is too low"), 
+                                       $content->{'cmdname'}), 
$content->{'line_nr'});
+            $command->{'level'} = $previous_command->{'level'} + 1;
+          }
+          $previous_command->{'childs'} = [$command];
+          $command->{'up'} = $previous_command;
+          $command_numbers[$command->{'level'}] = undef;
+        } else {
+          my $up = $previous_command->{'up'};
+          if ($previous_command->{'level'} != $level) {
+            # means it is above the previous command, the up is to be found
+            while ($up->{'up'} and $up->{'level'} >= $level) {
+              $up = $up->{'up'};
+            }
+            if ($level <= $up->{'level'}) {
+              $self->_line_error(sprintf($self->__("Lowering the section level 
of address@hidden appearing after a lower element"), 
+                                       $content->{'cmdname'}), 
$content->{'line_nr'});
+              $command->{'level'} = $up->{'level'} + 1;
+            }
+          }
+          push @{$up->{'childs'}}, $command;
+          $command->{'up'} = $up;
+          $command->{'prev'} = $up->{'childs'}->[-2];
+          $command->{'prev'}->{'next'} = $command;
+          if (!$unnumbered_commands{$content->{'cmdname'}}) {
+            $command_numbers[$command->{'level'}]++;
+          }
+          
+        }
+      } else { # first section determines the level of the root.  It is 
+               # typically -1 when there is a @top.
+        $command->{'up'} = $sec_root;
+        $sec_root->{'level'} = $level - 1;
+        $sec_root->{'childs'} = [$command];
+        $number_top_level = $level;
+        $number_top_level++ if (!$number_top_level);
+      }
+      if (!defined($command_numbers[$command->{'level'}])) {
+        if ($unnumbered_commands{$content->{'cmdname'}}) {
+          $command_numbers[$command->{'level'}] = 0;
+        } else {
+          $command_numbers[$command->{'level'}] = 1;
+        }
+      }
+      if ($appendix_commands{$content->{'cmdname'}} and !$in_appendix) {
+        $in_appendix = 1;
+        $command_numbers[$command->{'level'}] = 'A';
+      }
+      if (!$unnumbered_commands{$content->{'cmdname'}}) {
+        # construct the number
+        $command->{'number'} = $command_numbers[$number_top_level];
+        for (my $i = $number_top_level+1; $i <= $command->{'level'}; $i++) {
+          $command->{'number'} .= ".$command_numbers[$i]";
+        }
+      }
+      $previous_command = $command;
 
-      print STDERR "$level $content->{'cmdname'}\n";
+      #my $number = '';
+      #$number = $command->{'number'} if defined($command->{'number'});
+      #print STDERR 
"($command->{'level'}|$level|$sec2level{$content->{'cmdname'}})[$command_numbers[$command->{'level'}]]($in_appendix)
 $number address@hidden>{'cmdname'} 
".Texinfo::Convert::Text::convert($content->{'args'}->[0])."\n";
     }
   }
+  return $sec_root;
 }
 
 1;

Index: t/test_utils.pl
===================================================================
RCS file: /sources/texinfo/texinfo/tp/t/test_utils.pl,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -b -r1.26 -r1.27
--- t/test_utils.pl     26 Oct 2010 19:36:52 -0000      1.26
+++ t/test_utils.pl     26 Oct 2010 22:28:43 -0000      1.27
@@ -12,7 +12,8 @@
 #use Struct::Compare;
 use Getopt::Long qw(GetOptions);
 
-use vars qw(%result_texis %result_texts %result_trees %result_errors 
%result_indices);
+use vars qw(%result_texis %result_texts %result_trees %result_errors 
+   %result_indices %result_sectioning);
 
 ok(1);
 
@@ -46,6 +47,7 @@
 
 sub filter_keys { [grep {$_ ne 'next'} ( sort keys %{$_[0]} )] }
 #sub filter_keys { [grep {$_ ne 'parent' and $_ ne 'next'} ( sort keys 
%{$_[0]} )] }
+sub filter_main_tree { [grep {$_ ne 'section'} ( sort keys %{$_[0]} )] }
 
 sub test($$) 
 {
@@ -80,8 +82,15 @@
   } else {
     $result = $parser->parse_texi_file($test_case);
   }
-#Texinfo::Structuring::collect_structure($result);
-  #my $structure = Texinfo::Structuring::sectioning_structure($parser, 
$result);
+
+  my $structure = Texinfo::Structuring::sectioning_structure($parser, $result);
+  {
+    local $Data::Dumper::Purity = 1;
+    local $Data::Dumper::Sortkeys = \&filter_main_tree;
+    local $Data::Dumper::Indent = 1;
+
+    #print STDERR Data::Dumper->Dump([$structure], 
['$result_sectioning{\''.$test_name.'\'}']);
+  }
 
   my ($errors, $error_nrs) = $parser->errors();
   my ($index_names, $merged_indices) = $parser->indices_information();
@@ -97,7 +106,6 @@
 
   {
     local $Data::Dumper::Purity = 1;
-    local $Data::Dumper::Sortkeys = \&filter_keys;
     local $Data::Dumper::Indent = 1;
 
     my $out_file = $new_file;
@@ -107,7 +115,11 @@
     print OUT 'use vars qw(%result_texis %result_texts %result_trees 
%result_errors %results_indices);'."\n\n";
 
     #print STDERR "Generate: ".Data::Dumper->Dump([$result], ['$res']);
-    my $out_result = "".Data::Dumper->Dump([$result], 
['$result_trees{\''.$test_name.'\'}']);
+    my $out_result;
+    {
+      local $Data::Dumper::Sortkeys = \&filter_keys;
+      $out_result = Data::Dumper->Dump([$result], 
['$result_trees{\''.$test_name.'\'}']);
+    }
     my $texi_string_result = tree_to_texi($result);
     my $perl_string_result = $texi_string_result;
     $perl_string_result =~ s/\\/\\\\/g;