texinfo Pod-Simple-Texinfo/lib/Pod/Simple/Texin...

[Patrice Dumas]

CVSROOT:        /sources/texinfo
Module name:    texinfo
Changes by:     Patrice Dumas <pertusus>        12/02/09 00:05:55

Modified files:
        Pod-Simple-Texinfo/lib/Pod/Simple: Texinfo.pm 
        Pod-Simple-Texinfo/t: Pod-Simple-Texinfo.t 
        tp/Texinfo     : Common.pm Parser.pm 
Added files:
        tp/t           : test_protect_hashchar_at_line_beginning.t 

Log message:
        New function to protect hash character in tree when first in line and 
matching
        a cpp directive line.
        
        Use that in Pod/Simple/Texinfo.pm.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm?cvsroot=texinfo&r1=1.10&r2=1.11
http://cvs.savannah.gnu.org/viewcvs/texinfo/Pod-Simple-Texinfo/t/Pod-Simple-Texinfo.t?cvsroot=texinfo&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Common.pm?cvsroot=texinfo&r1=1.128&r2=1.129
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Parser.pm?cvsroot=texinfo&r1=1.359&r2=1.360
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/test_protect_hashchar_at_line_beginning.t?cvsroot=texinfo&rev=1.1

Patches:
Index: Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
===================================================================
RCS file: 
/sources/texinfo/texinfo/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm        4 Feb 2012 23:26:12 
-0000       1.10
+++ Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm        9 Feb 2012 00:05:53 
-0000       1.11
@@ -32,7 +32,8 @@
 use Texinfo::Parser qw(parse_texi_line parse_texi_text);
 use Texinfo::Convert::Texinfo;
 use Texinfo::Convert::TextContent;
-use Texinfo::Common qw(protect_comma_in_tree protect_first_parenthesis);
+use Texinfo::Common qw(protect_comma_in_tree protect_first_parenthesis
+                       protect_hashchar_at_line_beginning);
 
 use vars qw(
   @ISA $VERSION
@@ -196,7 +197,7 @@
   }
 }
 
-
+# 'out' is out of the context, for now for index entries.
 sub _output($$$;$)
 {
   my $fh = shift;
@@ -257,6 +258,17 @@
   return Texinfo::Convert::Texinfo::convert($tree);
 }
 
+sub _protect_hashchar($) {
+  my $texinfo = shift;
+  # protect # first in line
+  if ($texinfo =~ /#/) {
+    my $tree = parse_texi_text(undef, $texinfo);
+    protect_hashchar_at_line_beginning(undef, $tree);
+    return Texinfo::Convert::Texinfo::convert($tree);
+  } else {
+    return $texinfo;
+  }
+}
 sub _section_manual_to_node_name($$$)
 {
   my $self = shift;
@@ -578,7 +590,8 @@
           _output($fh, address@hidden, 
                   "address@hidden $command_argument\n$out\n");
         } elsif ($tagname eq 'Para') {
-          _output($fh, address@hidden, "$out$result\n\n");
+          _output($fh, address@hidden, $out.
+                                   _protect_hashchar($result)."\n\n");
         } elsif ($tagname eq 'L') {
           my $format = pop @format_stack;
           my ($linktype, $content_implicit, $url_arg, 

Index: Pod-Simple-Texinfo/t/Pod-Simple-Texinfo.t
===================================================================
RCS file: /sources/texinfo/texinfo/Pod-Simple-Texinfo/t/Pod-Simple-Texinfo.t,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- Pod-Simple-Texinfo/t/Pod-Simple-Texinfo.t   4 Feb 2012 15:56:48 -0000       
1.6
+++ Pod-Simple-Texinfo/t/Pod-Simple-Texinfo.t   9 Feb 2012 00:05:54 -0000       
1.7
@@ -6,7 +6,7 @@
 # change 'tests => 1' to 'tests => last_test_to_print';
 
 use Test::More;
-BEGIN { plan tests => 12 };
+BEGIN { plan tests => 13 };
 use Pod::Simple::Texinfo;
 ok(1); # If we made it this far, we're ok.
 
@@ -189,5 +189,25 @@
 
 ', 'node beginning with a parenthesis');
 
+run_test('=head1 head
+
+# line 4 "ggggg"
+and
+ # line 5 "fff"
+
+# line 4 "bbb"
+# 7 "aaaa"
+', '@chapter head
address@hidden
+
address@hidden line 4 "ggggg"
+and
+ @hashchar{} line 5 "fff"
+
address@hidden line 4 "bbb"
address@hidden 7 "aaaa"
+
+', 'hash character');
+
 1;
 

Index: tp/Texinfo/Common.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Common.pm,v
retrieving revision 1.128
retrieving revision 1.129
diff -u -b -r1.128 -r1.129
--- tp/Texinfo/Common.pm        7 Feb 2012 19:41:39 -0000       1.128
+++ tp/Texinfo/Common.pm        9 Feb 2012 00:05:54 -0000       1.129
@@ -55,6 +55,7 @@
 normalize_top_node_name
 protect_comma_in_tree
 protect_first_parenthesis
+protect_hashchar_at_line_beginning
 valid_tree_transformation
 ) ] );
 
@@ -223,7 +224,8 @@
 }
 
 my %valid_tree_transformations;
-foreach my $valid_transformation ('simple_menus', 'fill_gaps_in_sectioning') {
+foreach my $valid_transformation ('simple_menus', 
+    'fill_gaps_in_sectioning', ) {
   $valid_tree_transformations{$valid_transformation} = 1;
 }
 
@@ -1463,7 +1465,7 @@
       }
     }
     if ($current->{'extra'}->{'end_command'}) {
-      # FIXME this should be a ref to th eend command instead...
+      # FIXME this should be a ref to the end command instead...
       $new->{'extra'}->{'end_command'} = 1;
     }
   }
@@ -1479,26 +1481,34 @@
 
   if ($tree->{'args'}) {
     my @args = @{$tree->{'args'}};
-    $tree->{'args'} = [];
-    foreach my $arg (@args) {
-      my @new_args = &$operation($self, 'arg', $arg);
-      push @{$tree->{'args'}}, @new_args;
-    }
-    foreach my $arg (@{$tree->{'args'}}) {
+    for (my $i = 0; $i <= $#args; $i++) {
+      my @new_args = &$operation($self, 'arg', $args[$i]);
+      # 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);
+      foreach my $arg (@new_args) {
       modify_tree($self, $arg, $operation);
     }
   }
+    #foreach my $arg (@{$tree->{'args'}}) {
+    #  modify_tree($self, $arg, $operation);
+    #}
+  }
   if ($tree->{'contents'}) {
     my @contents = @{$tree->{'contents'}};
-    $tree->{'contents'} = [];
-    foreach my $content (@contents) {
-      my @new_contents = &$operation($self, 'content', $content);
-      push @{$tree->{'contents'}}, @new_contents;
-    }
-    foreach my $content (@{$tree->{'contents'}}) {
+    for (my $i = 0; $i <= $#contents; $i++) {
+      my @new_contents = &$operation($self, 'content', $contents[$i]);
+      # 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);
+      foreach my $content (@new_contents) {
       modify_tree($self, $content, $operation);
     }
   }
+    #foreach my $content (@{$tree->{'contents'}}) {
+    #  modify_tree($self, $content, $operation);
+    #}
+  }
   return $tree;
 }
 
@@ -1535,6 +1545,91 @@
   return modify_tree(undef, $tree, \&_protect_comma);
 }
 
+sub _is_cpp_line($)
+{
+  my $text = shift;
+  return 1 if ($text =~ /^\s*#\s*(line)? (\d+)( "([^"]+)")?(\s+\d+)*\s*$/);
+  return 0;
+}
+
+sub _protect_hashchar_at_line_beginning($$$)
+{
+  my $self = shift;
+  my $type = shift;
+  my $current = shift;
+
+  #print STDERR "$type $current "._print_current($current)."\n";
+  # if the next is a hash character at line beginning, mark it
+  if (defined($current->{'text'}) and $current->{'text'} =~ /\n$/
+      and $current->{'parent'} and $current->{'parent'}->{'contents'}) {
+    my $parent = $current->{'parent'};
+    #print STDERR "End of line in $current, parent $parent: 
(@{$parent->{'contents'}})\n";
+    my $current_found = 0;
+    foreach my $content (@{$parent->{'contents'}}) {
+      if ($current_found) {
+        #print STDERR "after $current: $content $content->{'text'}\n";
+        if ($content->{'text'} and _is_cpp_line($content->{'text'})) {
+          $content->{'extra'}->{'_protect_hashchar'} = 1;
+        }
+        last;
+      } elsif ($content eq $current) {
+        $current_found = 1;
+      }
+    }
+  }
+
+  my $protect_hash = 0;
+  # if marked, or first and a cpp_line protect a leading hash character
+  if ($current->{'extra'} and $current->{'extra'}->{'_protect_hashchar'}) {
+    delete $current->{'extra'}->{'_protect_hashchar'};
+    if (!scalar(keys(%{$current->{'extra'}}))) {
+      delete $current->{'extra'};
+    }
+    $protect_hash = 1;
+  } elsif ($current->{'parent'} and $current->{'parent'}->{'contents'}
+           and $current->{'parent'}->{'contents'}->[0]
+           and $current->{'parent'}->{'contents'}->[0] eq $current
+           and $current->{'text'}
+           and _is_cpp_line($current->{'text'})) {
+    $protect_hash = 1;
+  }
+  if ($protect_hash) {
+    my @result = ();
+    if ($current->{'type'} and $current->{'type'} eq 'raw') {
+      if ($self) {
+        my $parent = $current->{'parent'};
+        while ($parent) {
+          if ($parent->{'cmdname'} and $parent->{'line_nr'}) {
+            $self->line_warn(sprintf($self->__(
+                  "protect_hashchar_at_line_beginning cannot protect in 
address@hidden"), 
+                                     $parent->{'cmdname'}), 
$parent->{'line_nr'});
+            last;
+          }
+          $parent = $parent->{'parent'};
+        }
+      }
+    } else {
+      $current->{'text'} =~ s/^(\s*)#//;
+      if ($1 ne '') {
+        push @result, {'text' => $1, 'parent' => $current->{'parent'}};
+      }
+      push @result, {'cmdname' => 'hashchar', 'parent' => $current->{'parent'},
+                     'args' => [{'type' => 'brace_command_arg'}]};
+    }
+    push @result, $current;
+    return @result;
+  } else {
+    return ($current);
+  }
+}
+
+sub protect_hashchar_at_line_beginning($$)
+{
+  my $self = shift;
+  my $tree = shift;
+  return modify_tree($self, $tree, \&_protect_hashchar_at_line_beginning);
+}
+
 sub protect_first_parenthesis($)
 {
   my $contents = shift;
@@ -1593,6 +1688,41 @@
   return undef;
 }
 
+# for debugging
+sub _print_current($)
+{
+  my $current = shift;
+  if (ref($current) ne 'HASH') {
+    return  "_print_current: $current not a hash\n";
+  }
+  my $type = '';
+  my $cmd = '';
+  my $parent_string = '';
+  my $text = '';
+  $type = "($current->{'type'})" if (defined($current->{'type'}));
+  $cmd = "address@hidden>{'cmdname'}" if (defined($current->{'cmdname'}));
+  $cmd .= "($current->{'level'})" if (defined($current->{'level'}));
+  $text = "[text: $current->{'text'}]" if (defined($current->{'text'}));
+  if ($current->{'parent'}) {
+    my $parent = $current->{'parent'};
+    my $parent_cmd = '';
+    my $parent_type = '';
+    $parent_cmd = "address@hidden>{'cmdname'}" if 
(defined($parent->{'cmdname'}));
+    $parent_type = "($parent->{'type'})" if (defined($parent->{'type'}));
+    $parent_string = " <- $parent_cmd$parent_type\n";
+  }
+  my $args = '';
+  my $contents = '';
+  $args = "args(".scalar(@{$current->{'args'}}).')' if $current->{'args'};
+  $contents = "contents(".scalar(@{$current->{'contents'}}).')'
+    if $current->{'contents'};
+  if ("$cmd$type" ne '') {
+    return "$cmd$type : $text $args $contents\n$parent_string";
+  } else {
+    return "$text $args $contents\n$parent_string";
+  }
+}
+
 1;
 
 __END__
@@ -1834,6 +1964,13 @@
 Return a contents array reference with first parenthesis in the 
 contents array reference protected.
 
+=item protect_hashchar_at_line_beginning($parser, $tree)
+
+Protect hash character at beginning of line if the line is a cpp
+line directive.  The I<$parser> argument maybe undef, if it is 
+defined it is used for error reporting in case an hash character
+could not be protected because it appeared in a raw environment.
+
 =item $command = find_parent_root_command($parser, $tree_element)
 
 Find the parent root command of a tree element (sectioning command or node).

Index: tp/Texinfo/Parser.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Parser.pm,v
retrieving revision 1.359
retrieving revision 1.360
diff -u -b -r1.359 -r1.360
--- tp/Texinfo/Parser.pm        5 Feb 2012 22:22:08 -0000       1.359
+++ tp/Texinfo/Parser.pm        9 Feb 2012 00:05:54 -0000       1.360
@@ -887,35 +887,7 @@
 sub _print_current($)
 {
   my $current = shift;
-  if (ref($current) ne 'HASH') {
-    return  "_print_current: $current not a hash\n";
-  }
-  my $type = '';
-  my $cmd = '';
-  my $parent_string = '';
-  my $text = '';
-  $type = "($current->{'type'})" if (defined($current->{'type'}));
-  $cmd = "address@hidden>{'cmdname'}" if (defined($current->{'cmdname'}));
-  $cmd .= "($current->{'level'})" if (defined($current->{'level'}));
-  $text = "[text: $current->{'text'}]" if (defined($current->{'text'}));
-  if ($current->{'parent'}) {
-    my $parent = $current->{'parent'};
-    my $parent_cmd = '';
-    my $parent_type = '';
-    $parent_cmd = "address@hidden>{'cmdname'}" if 
(defined($parent->{'cmdname'}));
-    $parent_type = "($parent->{'type'})" if (defined($parent->{'type'}));
-    $parent_string = " <- $parent_cmd$parent_type\n";
-  }
-  my $args = '';
-  my $contents = '';
-  $args = "args(".scalar(@{$current->{'args'}}).')' if $current->{'args'};
-  $contents = "contents(".scalar(@{$current->{'contents'}}).')'
-    if $current->{'contents'};
-  if ("$cmd$type" ne '') {
-    return "$cmd$type : $text $args $contents\n$parent_string";
-  } else {
-    return "$text $args $contents\n$parent_string";
-  }
+  return Texinfo::Common::_print_current($current);
 }
 
 # for debugging

Index: tp/t/test_protect_hashchar_at_line_beginning.t
===================================================================
RCS file: tp/t/test_protect_hashchar_at_line_beginning.t
diff -N tp/t/test_protect_hashchar_at_line_beginning.t
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ tp/t/test_protect_hashchar_at_line_beginning.t      9 Feb 2012 00:05:54 
-0000       1.1
@@ -0,0 +1,102 @@
+use strict;
+
+use Test::More;
+BEGIN { plan tests => 4 };
+
+use Texinfo::Common;
+use Texinfo::Parser qw(parse_texi_text);
+use Texinfo::Common qw(protect_hashchar_at_line_beginning);
+use Texinfo::Convert::Texinfo;
+
+use Data::Dumper;
+
+ok(1);
+
+sub run_test($$$)
+{
+  my $in = shift;
+  my $out = shift;
+  my $name = shift;
+
+  my $tree = parse_texi_text(undef, $in);
+
+  my $corrected_tree = protect_hashchar_at_line_beginning(undef, $tree);
+  my $texi_result = Texinfo::Convert::Texinfo::convert($corrected_tree);
+
+  if (!defined($out)) {
+    print STDERR " --> $name:\n$texi_result";
+  } else {
+    is ($texi_result, $out, $name);
+  }
+
+}
+
+run_test ('# line 4 "ggggg"
+and
+ # line 5 "fff"
+
+# line 4 "bbb"
+# 7 "aaaa"
+', '@hashchar{} line 4 "ggggg"
+and
+ @hashchar{} line 5 "fff"
+
address@hidden line 4 "bbb"
address@hidden 7 "aaaa"
+', 'two paragraphs');
+
+run_test ('
address@hidden
+# line 5 "fff"
+aaa
+
+b
+
+# line 4 "bbb"
+# 7 "aaaa"
address@hidden example
+', '
address@hidden
address@hidden line 5 "fff"
+aaa
+
+b
+
address@hidden line 4 "bbb"
address@hidden 7 "aaaa"
address@hidden example
+', 'in example');
+
+run_test ('
address@hidden @asis
address@hidden truc
+
+# line 4 "bbb"
address@hidden table
+
address@hidden
+# 7 "aaaa"
address@hidden # line 5 "fff"
+# 6 "ff"
address@hidden itemize
+', '
address@hidden @asis
address@hidden truc
+
address@hidden line 4 "bbb"
address@hidden table
+
address@hidden
address@hidden 7 "aaaa"
address@hidden @hashchar{} line 5 "fff"
address@hidden 6 "ff"
address@hidden itemize
+', 'in block commands');
+
+
+#{
+#  local $Data::Dumper::Purity = 1;
+#  local $Data::Dumper::Indent = 1;
+# 
+#  print STDERR Data::Dumper->Dump([$tree]);
+#}