texinfo/tp TODO Texinfo/Common.pm t/protect_cha...

[Patrice Dumas]

CVSROOT:        /sources/texinfo
Module name:    texinfo
Changes by:     Patrice Dumas <pertusus>        12/02/19 23:20:39

Modified files:
        tp             : TODO 
        tp/Texinfo     : Common.pm 
Added files:
        tp/t           : protect_character_in_texinfo.t 

Log message:
        Texinfo/Common.pm: in modify_tree recurse first before modifying the
        tree to avoid visiting an element twice.
        Protect better comma in tree and new functions protect colon and 
        special characters ending a node appearing after a label in menu.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/TODO?cvsroot=texinfo&r1=1.266&r2=1.267
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Common.pm?cvsroot=texinfo&r1=1.131&r2=1.132
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/protect_character_in_texinfo.t?cvsroot=texinfo&rev=1.1

Patches:
Index: TODO
===================================================================
RCS file: /sources/texinfo/texinfo/tp/TODO,v
retrieving revision 1.266
retrieving revision 1.267
diff -u -b -r1.266 -r1.267
--- TODO        18 Feb 2012 23:27:36 -0000      1.266
+++ TODO        19 Feb 2012 23:20:33 -0000      1.267
@@ -7,12 +7,6 @@
 
 Document TEXTCONTENT_COMMENT.
 
-pod2texi: remove punctuation in node to avoid confusing @ref in info.
-in @ref. First : is searched.  if followed by a : the node name is found
-and there is no label. When parsing a node a filename with ( is searched for.
-Nested parentheses are taken into account.
-Then more parentheses?
-
 
 Bugs
 ====
@@ -105,6 +99,36 @@
 sectioning_command_target_name
 node_target_name
 
+Protection of punctuation in nodes.
+in @ref. First : is searched.  if followed by a : the node name is found
+and there is no label. When parsing a node a filename with ( is searched for.
+Nested parentheses are taken into account.
+Then more parentheses?
+
+Automatic generation of node names from section names.  To be protected:
+* in every case
+  ( at the beginning
+* In @node line
+  commas
+* In menu entry
+  * if there is a label
+    tab comma dot
+  * if there is no label
+    :
+* In @ref
+  commas
+
+In generated info:
+* in every case 
+  ( at the beginning
+* in Node line 
+  commas
+* In menu entry and *Note
+  * if there is a label
+    tab comma dot
+  * if there is no label
+    :
+
 
 DocBook
 =======

Index: Texinfo/Common.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Common.pm,v
retrieving revision 1.131
retrieving revision 1.132
diff -u -b -r1.131 -r1.132
--- Texinfo/Common.pm   16 Feb 2012 00:33:49 -0000      1.131
+++ Texinfo/Common.pm   19 Feb 2012 23:20:34 -0000      1.132
@@ -56,6 +56,8 @@
 protect_comma_in_tree
 protect_first_parenthesis
 protect_hashchar_at_line_beginning
+protect_colon_in_tree
+protect_node_after_label_in_tree
 valid_tree_transformation
 move_index_entries_after_items_in_tree
 ) ] );
@@ -1479,38 +1481,34 @@
   my $self = shift;
   my $tree = shift;
   my $operation = shift;
-  #print STDERR "tree: $tree\n";
+  #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]);
       # 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'}}) {
+      #foreach my $arg (@new_args) {
     #  modify_tree($self, $arg, $operation);
     #}
   }
+  }
   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]);
       # 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'}}) {
+      #foreach my $content (@new_contents) {
     #  modify_tree($self, $content, $operation);
     #}
   }
+  }
   return $tree;
 }
 
@@ -1520,31 +1518,102 @@
   my $type = shift;
   my $current = shift;
 
-  if (defined($current->{'text'}) and $current->{'text'} =~ /,/
+  return _protect_text($current, quotemeta(','));
+}
+
+sub protect_comma_in_tree($)
+{
+  my $tree = shift;
+  return modify_tree(undef, $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 "$to_protect: $current "._print_current($current)."\n";
+  if (defined($current->{'text'}) and $current->{'text'} =~ /$to_protect/
       and !(defined($current->{'type'}) and $current->{'type'} eq 'raw')) {
     my @result = ();
-    my @text_fragments = split /,/, $current->{'text'};
-    foreach my $text_fragment (@text_fragments) {
-      if ($text_fragment ne '') {
-        my $new_text = {'text' => $text_fragment, 
-                        'parent' => $current->{'parent'}};
-        $new_text->{'type'} = $current->{'type'} if 
defined($current->{'type'});
-        push @result, $new_text;
+    my $remaining_text = $current->{'text'};
+    while ($remaining_text) {
+      if ($remaining_text =~ s/^(.*?)(($to_protect)+)//) {
+        if ($1 ne '') {
+          push @result, {'text' => $1, 'parent' => $current->{'parent'}};
+          $result[-1]->{'type'} = $current->{'type'} 
+            if defined($current->{'type'});
       }
+        if ($to_protect eq quotemeta(',')) {
+          for (my $i = 0; $i < length($2); $i++) {
       push @result, {'cmdname' => 'comma', 'parent' => $current->{'parent'},
                      'args' => [{'type' => 'brace_command_arg'}]};
     }
-    pop @result unless ($current->{'text'} =~ /,$/);
+        } else {
+          push @result, _new_asis_command_with_text($2, $current->{'parent'},
+                                                    $current->{'type'});
+        }
+      } else {
+        push @result, {'text' => $remaining_text, 'parent' => 
$current->{'parent'}};
+        $result[-1]->{'type'} = $current->{'type'} 
+          if defined($current->{'type'});
+        last;
+      }
+    }
+    #print STDERR "Result: @result\n";
     return @result;
   } else {
+    #print STDERR "No change: $current\n";
     return ($current);
   }
 }
 
-sub protect_comma_in_tree($)
+sub _protect_colon($$$)
+{
+  my $self = shift;
+  my $type = shift;
+  my $current = shift;
+
+  return _protect_text ($current, quotemeta(':'));
+}
+
+sub protect_colon_in_tree($)
 {
   my $tree = shift;
-  return modify_tree(undef, $tree, \&_protect_comma);
+  return modify_tree(undef, $tree, \&_protect_colon);
+}
+
+sub _protect_node_after_label($$$)
+{
+  my $self = shift;
+  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(undef, $tree, \&_protect_node_after_label);
 }
 
 sub _is_cpp_line($)
@@ -1647,12 +1716,8 @@
     } else {
       $brace = shift @contents;
     }
-    unshift @contents, {'cmdname' => 'asis', 'parent' => $brace->{'parent'}};
-    push @{$contents[0]->{'args'}}, {'type' => 'brace_command_arg', 
-                                    'parent' => $contents[0]};
-    push @{$contents[0]->{'args'}->[0]->{'contents'}}, {
-      'type' => $brace->{'type'}, 'text' => '(',
-      'parent' => $contents[0]->{'args'}->[0]};
+    unshift @contents, _new_asis_command_with_text('(', $brace->{'parent'},
+                                                    $brace->{'type'});
   }
   return address@hidden;
 }
@@ -2058,6 +2123,16 @@
 
 Protect comma characters, replacing C<,> with @comma{} in tree.
 
+=item protect_colon_in_tree($tree)
+
+=item protect_node_after_label_in_tree($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 $contents_result = protect_first_parenthesis ($contents)
 
 Return a contents array reference with first parenthesis in the 

Index: t/protect_character_in_texinfo.t
===================================================================
RCS file: t/protect_character_in_texinfo.t
diff -N t/protect_character_in_texinfo.t
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ t/protect_character_in_texinfo.t    19 Feb 2012 23:20:35 -0000      1.1
@@ -0,0 +1,56 @@
+use strict;
+
+use Test::More;
+BEGIN { plan tests => 3 };
+
+use lib 'maintain/lib/Unicode-EastAsianWidth/lib/';
+use lib 'maintain/lib/libintl-perl/lib/';
+use lib 'maintain/lib/Text-Unidecode/lib/';
+use Texinfo::Parser qw(parse_texi_text);
+use Texinfo::Common qw(protect_comma_in_tree protect_colon_in_tree
+      protect_node_after_label_in_tree);
+use Texinfo::Convert::Texinfo;
+
+ok(1);
+
+sub run_test($$$$)
+{
+  my $do = shift;
+  my $in = shift;
+  my $out = shift;
+  my $name = shift;
+
+  my $tree = parse_texi_text(undef, $in);
+  if ($do->{'protect_comma'}) {
+    $tree = protect_comma_in_tree($tree);
+  }
+  if ($do->{'protect_colon'}) {
+    $tree = protect_colon_in_tree($tree);
+  }
+  if ($do->{'protect_node_after_label'}) {
+    $tree = protect_node_after_label_in_tree($tree);
+  }
+  
+  my $texi_result = Texinfo::Convert::Texinfo::convert($tree);
+
+  if (!defined($out)) {
+    print STDERR " --> $name:\n$texi_result";
+  } else {
+    is ($texi_result, $out, $name);
+  }
+}
+
+run_test({'protect_comma' => 1},
+'Some, text,,,@code{,} @asis{, text} @verb{:v,:} @,c', 
+'address@hidden address@hidden@address@hidden@address@hidden @address@hidden 
text} @verb{:v,:} @,c', 
+'protect comma');
+
+run_test({'protect_colon' => 1},
+'Some :: colons: @code{:} @verb{: in verb::} @:.:',
+'Some @asis{::} address@hidden:} @address@hidden:}} @verb{: in verb::} 
@:address@hidden:}',
+'protect colon');
+
+run_test({'protect_node_after_label' => 1},
+"\t\t".'., text @code{,.t.} @verb{:, .:} .'."\t t",
+'@asis{                address@hidden,} text @address@hidden,address@hidden 
@verb{:, .:} @asis{.       } t',
+'protect node after label characters');