texinfo/tp/Texinfo Common.pm

[Patrice Dumas]

CVSROOT:        /sources/texinfo
Module name:    texinfo
Changes by:     Patrice Dumas <pertusus>        11/12/21 00:05:56

Modified files:
        tp/Texinfo     : Common.pm 

Log message:
        Add a function to protect comma in tree, and a function to go through
        a tree.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Common.pm?cvsroot=texinfo&r1=1.104&r2=1.105

Patches:
Index: Common.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Common.pm,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -b -r1.104 -r1.105
--- Common.pm   12 Dec 2011 22:44:59 -0000      1.104
+++ Common.pm   21 Dec 2011 00:05:56 -0000      1.105
@@ -53,6 +53,7 @@
 trim_spaces_comment_from_content
 float_name_caption
 normalize_top_node_name
+protect_comma_in_tree
 ) ] );
 
 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@@ -1356,6 +1357,72 @@
   }
 }
 
+sub modify_tree($$$);
+sub modify_tree($$$)
+{
+  my $self = shift;
+  my $tree = shift;
+  my $operation = shift;
+
+  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'}}) {
+      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'}}) {
+      modify_tree($self, $content, $operation);
+    }
+  }
+  return $tree;
+}
+
+sub _protect_comma($$$)
+{
+  my $self = shift;
+  my $type = shift;
+  my $current = shift;
+
+  if (defined($current->{'text'}) and $current->{'text'} =~ /,/
+      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;
+      }
+      push @result, {'cmdname' => 'comma', 'parent' => $current->{'parent'},
+                     'args' => [{'type' => 'brace_command_arg'}]};
+    }
+    pop @result unless ($current->{'text'} =~ /,$/);
+    return @result;
+  } else {
+    return ($current);
+  }
+}
+
+sub protect_comma_in_tree($$)
+{
+  my $self = shift;
+  my $tree = shift;
+  return modify_tree($self, $tree, \&_protect_comma);
+}
+
 
 1;
 
@@ -1584,6 +1651,10 @@
 Normalize the node name string given in argument, by normalizing
 Top node case.
 
+=item protect_comma_in_tree
+
+Protect comma characters, replacing C<,> with @comma{} in tree.
+
 =back
 
 =head1 SEE ALSO