[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
texinfo/tp Texinfo/Commands.pm Texinfo/Parser.p...
|
From: |
Patrice Dumas |
|
Subject: |
texinfo/tp Texinfo/Commands.pm Texinfo/Parser.p... |
|
Date: |
Sat, 06 Nov 2010 00:41:28 +0000 |
CVSROOT: /sources/texinfo
Module name: texinfo
Changes by: Patrice Dumas <pertusus> 10/11/06 00:41:28
Modified files:
tp/Texinfo : Commands.pm Parser.pm Structuring.pm
tp/Texinfo/Convert: Text.pm Unicode.pm
tp/t : 01use.t 02coverage.t test_utils.pl
Added files:
tp/Texinfo/Convert: Texinfo.pm
tp/t/results/coverage: arg_in_brace_no_arg_command.pl
Log message:
Put conversion to Texinfo from the tree in its own Convert module.
Prepare for convertion to enabled encodings.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Commands.pm?cvsroot=texinfo&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Parser.pm?cvsroot=texinfo&r1=1.142&r2=1.143
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Structuring.pm?cvsroot=texinfo&r1=1.18&r2=1.19
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Convert/Text.pm?cvsroot=texinfo&r1=1.12&r2=1.13
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Convert/Unicode.pm?cvsroot=texinfo&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Convert/Texinfo.pm?cvsroot=texinfo&rev=1.1
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/01use.t?cvsroot=texinfo&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/02coverage.t?cvsroot=texinfo&r1=1.22&r2=1.23
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/test_utils.pl?cvsroot=texinfo&r1=1.45&r2=1.46
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/results/coverage/arg_in_brace_no_arg_command.pl?cvsroot=texinfo&rev=1.1
Patches:
Index: Texinfo/Commands.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Commands.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- Texinfo/Commands.pm 2 Nov 2010 23:02:33 -0000 1.2
+++ Texinfo/Commands.pm 6 Nov 2010 00:41:27 -0000 1.3
@@ -378,4 +378,39 @@
$root_commands{'node'} = 1;
+
+
+# charset related definitions.
+
+our %perl_charset_to_html = (
+ 'utf8' => 'utf-8',
+ 'utf-8-strict' => 'utf-8',
+ 'ascii' => 'us-ascii',
+ 'shiftjis' => 'shift_jis',
+);
+
+# encoding name normalization to html-compatible encoding names
+our %encoding_aliases = (
+ 'latin1' => 'iso-8859-1',
+);
+
+foreach my $perl_charset (keys(%perl_charset_to_html)) {
+ $encoding_aliases{$perl_charset} = $perl_charset_to_html{$perl_charset};
+ $encoding_aliases{$perl_charset_to_html{$perl_charset}}
+ = $perl_charset_to_html{$perl_charset};
+}
+our %eight_bit_encoding_aliases = (
+ "iso-8859-1", 'iso8859_1',
+ "iso-8859-2", 'iso8859_2',
+ "iso-8859-15", 'iso8859_15',
+ "koi8-r", 'koi8',
+ "koi8-u", 'koi8',
+);
+
+foreach my $encoding (keys(%eight_bit_encoding_aliases)) {
+ $encoding_aliases{$encoding} = $encoding;
+ $encoding_aliases{$eight_bit_encoding_aliases{$encoding}} = $encoding;
+}
+
+
1;
Index: Texinfo/Parser.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Parser.pm,v
retrieving revision 1.142
retrieving revision 1.143
diff -u -b -r1.142 -r1.143
--- Texinfo/Parser.pm 2 Nov 2010 23:02:33 -0000 1.142
+++ Texinfo/Parser.pm 6 Nov 2010 00:41:28 -0000 1.143
@@ -24,7 +24,6 @@
# initializations, determination of command types.
# user visible subroutines.
# internal subroutines, doing the parsing.
-# code used to transform a texinfo tree into texinfo text.
package Texinfo::Parser;
@@ -42,6 +41,8 @@
use Texinfo::Convert::Text;
# to normalize node name, anchor, float arg, listoffloats and first *ref
argument.
use Texinfo::Convert::NodeNameNormalization;
+# in error messages
+use Texinfo::Convert::Texinfo;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -56,7 +57,6 @@
# will save memory.
%EXPORT_TAGS = ( 'all' => [ qw(
parser
- tree_to_texi
parse_texi_text
parse_texi_file
errors
@@ -399,37 +399,6 @@
}
-my %perl_charset_to_html = (
- 'utf8' => 'utf-8',
- 'utf-8-strict' => 'utf-8',
- 'ascii' => 'us-ascii',
- 'shiftjis' => 'shift_jis',
-);
-
-# encoding name normalization to html-compatible encoding names
-my %encoding_aliases = (
- 'latin1' => 'iso-8859-1',
-);
-
-foreach my $perl_charset (keys(%perl_charset_to_html)) {
- $encoding_aliases{$perl_charset} = $perl_charset_to_html{$perl_charset};
- $encoding_aliases{$perl_charset_to_html{$perl_charset}}
- = $perl_charset_to_html{$perl_charset};
-}
-my %makeinfo_encoding_to_map = (
- "iso-8859-1", 'iso8859_1',
- "iso-8859-2", 'iso8859_2',
- "iso-8859-15", 'iso8859_15',
- "koi8-r", 'koi8',
- "koi8-u", 'koi8',
-);
-
-foreach my $encoding (keys(%makeinfo_encoding_to_map)) {
- $encoding_aliases{$encoding} = $encoding;
- $encoding_aliases{$makeinfo_encoding_to_map{$encoding}} = $encoding;
-}
-
-
# simple deep copy of a structure
sub _deep_copy ($)
@@ -633,8 +602,6 @@
return $self->_parse_texi(address@hidden);
}
-sub tree_to_texi ($);
-
# return the errors and warnings
sub errors ($)
{
@@ -1357,7 +1324,7 @@
$spaces->{'type'} = 'spaces' if (defined($spaces));
return undef if (!scalar(@{$contents}));
- #print STDERR "BEFORE PROCESSING ".tree_to_texi({'contents' => $contents});
+ #print STDERR "BEFORE PROCESSING
".Texinfo::Convert::Texinfo::convert({'contents' => $contents});
if ($contents->[0]->{'type'} and $contents->[0]->{'type'} eq 'bracketed') {
#print STDERR "Return bracketed\n";
return ($spaces, shift @{$contents});
@@ -1400,10 +1367,10 @@
foreach my $arg (@args) {
#print STDERR "$command $arg"._print_current($contents[0]);
#foreach my $content (@contents) {print STDERR "
"._print_current($content)};
- #print STDERR " contents ->".tree_to_texi ({'contents' => address@hidden);
+ #print STDERR " contents ->".Texinfo::Convert::Texinfo::convert
({'contents' => address@hidden);
my ($spaces, $next) = _next_bracketed_or_word(address@hidden);
last if (!defined($next));
- #print STDERR "NEXT ".tree_to_texi($next)."\n";
+ #print STDERR "NEXT ".Texinfo::Convert::Texinfo::convert($next)."\n";
push @result, ['spaces', $spaces] if (defined($spaces));
push @result, [$arg, $next];
}
@@ -1461,7 +1428,8 @@
if ($self->{'labels'}->{$normalized}) {
_line_error($self, sprintf($self->__("address@hidden `%s' previously
defined"),
$current->{'cmdname'},
- tree_to_texi({'contents' => $label->{'node_content'}})),
+ Texinfo::Convert::Texinfo::convert({'contents' =>
+ $label->{'node_content'}})),
$line_nr);
_line_error($self, sprintf($self->__("here is the previous definition as
address@hidden"),
$self->{'labels'}->{$normalized}->{'cmdname'}),
@@ -1657,7 +1625,8 @@
_line_warn ($self, sprintf($self->
__("Unexpected argument on address@hidden line: %s"),
$current->{'cmdname'},
- tree_to_texi( { $content->{'contents'} })), $line_nr);
+ Texinfo::Convert::Texinfo::convert({ $content->{'contents'} })),
+ $line_nr);
} elsif ($content->{'cmdname'} eq 'c'
and $content->{'cmdname'} eq 'comment') {
} else {
@@ -1782,8 +1751,8 @@
_line_warn($self, sprintf($self->__("unrecognized encoding name
`%s'"),
$text), $line_nr);
} else {
- $encoding = $encoding_aliases{$encoding}
- if ($encoding_aliases{$encoding});
+ $encoding = $Texinfo::Commands::encoding_aliases{$encoding}
+ if ($Texinfo::Commands::encoding_aliases{$encoding});
$self->{'encoding'} = $encoding;
print STDERR "Using encoding $encoding\n" if ($self->{'debug'});
foreach my $input (@{$self->{'input'}}) {
@@ -1950,7 +1919,8 @@
return 0;
} elsif ($parsed_node->{'normalized'} !~ /[^-]/) {
_line_error ($self, sprintf($self->__("Empty node name after expansion
`%s'"),
- tree_to_texi({'contents' => $parsed_node->{'node_content'}})),
+ Texinfo::Convert::Texinfo::convert({'contents'
+ => $parsed_node->{'node_content'}})),
$line_nr);
return 0;
} else {
@@ -1966,7 +1936,7 @@
my $line_nr = shift;
if ($parsed_node and $parsed_node->{'manual_content'}) {
_line_error ($self, sprintf($self->__("Syntax for an external node used
for `%s'"),
- tree_to_texi($node)), $line_nr)
+ Texinfo::Convert::Texinfo::convert($node)), $line_nr)
}
}
@@ -2124,7 +2094,8 @@
or ($current->{'parent'}->{'cmdname'} ne 'macro'
and $current->{'parent'}->{'cmdname'} ne 'rmacro'))) {
$current->{'extra'}->{'macrobody'} =
- tree_to_texi({ 'contents' => $current->{'contents'} });
+ Texinfo::Convert::Texinfo::convert({ 'contents'
+ => $current->{'contents'} });
if ($current->{'args'} and $current->{'args'}->[0]) {
my $name = $current->{'args'}->[0]->{'text'};
if (exists($self->{'macros'}->{$name})) {
@@ -2313,6 +2284,7 @@
} elsif ($line =~ s/^(.)//o) {
print STDERR "ACCENT address@hidden>{'cmdname'}\n"
if ($self->{'debug'});
+ # FIXME this is different than usual tree, no content here
$current->{'args'} = [ { 'text' => $1, 'parent' => $current } ];
if ($current->{'cmdname'} =~ /^[a-zA-Z]/) {
$current->{'args'}->[-1]->{'type'} = 'space_command_arg';
@@ -3451,115 +3423,6 @@
return $args;
}
-
-
-# Following subroutines deal with transforming a texinfo tree into texinfo
-# text. Should give the text that was used parsed, except for a few cases.
-
-# expand a tree to the corresponding texinfo.
-sub tree_to_texi ($)
-{
- my $root = shift;
- die "tree_to_texi: root undef\n" if (!defined($root));
- die "tree_to_texi: bad root type (".ref($root).") $root\n"
- if (ref($root) ne 'HASH');
- my $result = '';
- #print STDERR "$root ";
- #print STDERR "$root->{'type'}" if (defined($root->{'type'}));
- #print STDERR "\n";
- if (defined($root->{'text'})) {
- $result .= $root->{'text'};
- } else {
- if ($root->{'cmdname'}
- or ($root->{'type'} and ($root->{'type'} eq 'def_line'
- or $root->{'type'} eq 'menu_entry'
- or $root->{'type'} eq 'menu_comment'))) {
- #print STDERR "cmd: $root->{'cmdname'}\n";
- $result .= _expand_cmd_args_to_texi($root);
- }
- $result .= '{' if ($root->{'type'} and $root->{'type'} eq 'bracketed');
- #print STDERR "$root->{'contents'} @{$root->{'contents'}}\n" if
(defined($root->{'contents'}));
- if (defined($root->{'contents'})) {
- die "bad contents type(" . ref($root->{'contents'})
- . ") $root->{'contents'}\n" if (ref($root->{'contents'}) ne 'ARRAY');
- foreach my $child (@{$root->{'contents'}}) {
- $result .= tree_to_texi($child);
- }
- }
- $result .= '}' if ($root->{'type'} and $root->{'type'} eq 'bracketed');
- if ($root->{'cmdname'} and (defined($block_commands{$root->{'cmdname'}})))
{
- $result .= '@end '.$root->{'cmdname'};
- }
- }
- #print STDERR "tree_to_texi result: $result\n";
- return $result;
-}
-
-
-# expand a command argument as texinfo.
-sub _expand_cmd_args_to_texi ($) {
- my $cmd = shift;
- my $cmdname = $cmd->{'cmdname'};
- $cmdname = '' if (!$cmd->{'cmdname'});
- my $result = '';
- $result = '@'.$cmdname if ($cmdname);
- #print STDERR "Expand $result\n";
- # must be before the next condition
- if ($block_commands{$cmdname}
- and ($def_commands{$cmdname}
- or $block_commands{$cmdname} eq 'multitable')
- and $cmd->{'args'}) {
- foreach my $arg (@{$cmd->{'args'}}) {
- $result .= tree_to_texi ($arg);
- }
- } elsif (($cmd->{'extra'} or $cmdname eq 'macro' or $cmdname eq 'rmacro')
- and defined($cmd->{'extra'}->{'arg_line'})) {
- $result .= $cmd->{'extra'}->{'arg_line'};
- } elsif (($block_commands{$cmdname} or $cmdname eq 'node')
- and defined($cmd->{'args'})) {
- die "bad args type (".ref($cmd->{'args'}).") $cmd->{'args'}\n"
- if (ref($cmd->{'args'}) ne 'ARRAY');
- foreach my $arg (@{$cmd->{'args'}}) {
- $result .= tree_to_texi ($arg) . ',';
- }
- $result =~ s/,$//;
- } elsif (defined($cmd->{'args'})) {
- my $braces;
- $braces = 1 if ($cmd->{'args'}->[0]->{'type'}
- and ($cmd->{'args'}->[0]->{'type'} eq 'brace_command_arg'
- or $cmd->{'args'}->[0]->{'type'} eq
'brace_command_context'));
- $result .= '{' if ($braces);
- if ($cmdname eq 'verb') {
- $result .= $cmd->{'type'};
- }
- if ($cmd->{'extra'} and exists ($cmd->{'extra'}->{'spaces'})) {
- $result .= $cmd->{'extra'}->{'spaces'};
- }
- #print STDERR "".Data::Dumper->Dump([$cmd]);
- my $arg_nr = 0;
- foreach my $arg (@{$cmd->{'args'}}) {
- if (exists($brace_commands{$cmdname}) or ($cmd->{'type'}
- and $cmd->{'type'} eq 'definfoenclose_command')) {
- $result .= ',' if ($arg_nr);
- $arg_nr++;
- }
- $result .= tree_to_texi ($arg);
- }
- if ($cmdname eq 'verb') {
- $result .= $cmd->{'type'};
- }
- #die "Shouldn't have args: $cmdname\n";
- $result .= '}' if ($braces);
- }
- if ($misc_commands{$cmdname}
- and $misc_commands{$cmdname} eq 'skipline') {
- $result .="\n";
- }
- $result .= '{'.$cmd->{'type'}.'}' if ($cmdname eq 'value');
- #print STDERR "Result: $result\n";
- return $result;
-}
-
1;
__END__
# Below is stub documentation.
Index: Texinfo/Structuring.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Structuring.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- Texinfo/Structuring.pm 1 Nov 2010 19:18:04 -0000 1.18
+++ Texinfo/Structuring.pm 6 Nov 2010 00:41:28 -0000 1.19
@@ -26,7 +26,8 @@
# for debugging only
use Texinfo::Convert::Text;
-use Texinfo::Parser qw(tree_to_texi);
+# for error messages
+use Texinfo::Convert::Texinfo;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -300,15 +301,18 @@
return $sec_root;
}
+# used to put a node name in error messages.
sub _node_extra_to_texi($)
{
my $node = shift;
my $result = '';
if ($node->{'manual_content'}) {
- $result = '('.tree_to_texi({'contents' => $node->{'manual_content'}}) .')';
+ $result = '('.Texinfo::Convert::Texinfo::convert({'contents'
+ => $node->{'manual_content'}}) .')';
}
if ($node->{'node_content'}) {
- $result .= tree_to_texi ({'contents' => $node->{'node_content'}});
+ $result .= Texinfo::Convert::Texinfo::convert ({'contents'
+ => $node->{'node_content'}});
}
return $result;
}
Index: Texinfo/Convert/Text.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Convert/Text.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- Texinfo/Convert/Text.pm 2 Nov 2010 23:02:33 -0000 1.12
+++ Texinfo/Convert/Text.pm 6 Nov 2010 00:41:28 -0000 1.13
@@ -24,6 +24,7 @@
# accent commands list.
use Texinfo::Commands;
+use Data::Dumper;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -146,6 +147,377 @@
my %accent_commands = %Texinfo::Commands::accent_commands;
+my %unicode_to_eight_bit = (
+ 'iso8859_1' => {
+ '00A0' => 'A0',
+ '00A1' => 'A1',
+ '00A2' => 'A2',
+ '00A3' => 'A3',
+ '00A4' => 'A4',
+ '00A5' => 'A5',
+ '00A6' => 'A6',
+ '00A7' => 'A7',
+ '00A8' => 'A8',
+ '00A9' => 'A9',
+ '00AA' => 'AA',
+ '00AB' => 'AB',
+ '00AC' => 'AC',
+ '00AD' => 'AD',
+ '00AE' => 'AE',
+ '00AF' => 'AF',
+ '00B0' => 'B0',
+ '00B1' => 'B1',
+ '00B2' => 'B2',
+ '00B3' => 'B3',
+ '00B4' => 'B4',
+ '00B5' => 'B5',
+ '00B6' => 'B6',
+ '00B7' => 'B7',
+ '00B8' => 'B8',
+ '00B9' => 'B9',
+ '00BA' => 'BA',
+ '00BB' => 'BB',
+ '00BC' => 'BC',
+ '00BD' => 'BD',
+ '00BE' => 'BE',
+ '00BF' => 'BF',
+ '00C0' => 'C0',
+ '00C1' => 'C1',
+ '00C2' => 'C2',
+ '00C3' => 'C3',
+ '00C4' => 'C4',
+ '00C5' => 'C5',
+ '00C6' => 'C6',
+ '00C7' => 'C7',
+ '00C7' => 'C7',
+ '00C8' => 'C8',
+ '00C9' => 'C9',
+ '00CA' => 'CA',
+ '00CB' => 'CB',
+ '00CC' => 'CC',
+ '00CD' => 'CD',
+ '00CE' => 'CE',
+ '00CF' => 'CF',
+ '00D0' => 'D0',
+ '00D1' => 'D1',
+ '00D2' => 'D2',
+ '00D3' => 'D3',
+ '00D4' => 'D4',
+ '00D5' => 'D5',
+ '00D6' => 'D6',
+ '00D7' => 'D7',
+ '00D8' => 'D8',
+ '00D9' => 'D9',
+ '00DA' => 'DA',
+ '00DB' => 'DB',
+ '00DC' => 'DC',
+ '00DD' => 'DD',
+ '00DE' => 'DE',
+ '00DF' => 'DF',
+ '00E0' => 'E0',
+ '00E1' => 'E1',
+ '00E2' => 'E2',
+ '00E3' => 'E3',
+ '00E4' => 'E4',
+ '00E5' => 'E5',
+ '00E6' => 'E6',
+ '00E7' => 'E7',
+ '00E8' => 'E8',
+ '00E9' => 'E9',
+ '00EA' => 'EA',
+ '00EB' => 'EB',
+ '00EC' => 'EC',
+ '00ED' => 'ED',
+ '00EE' => 'EE',
+ '00EF' => 'EF',
+ '00F0' => 'F0',
+ '00F1' => 'F1',
+ '00F2' => 'F2',
+ '00F3' => 'F3',
+ '00F4' => 'F4',
+ '00F5' => 'F5',
+ '00F6' => 'F6',
+ '00F7' => 'F7',
+ '00F8' => 'F8',
+ '00F9' => 'F9',
+ '00FA' => 'FA',
+ '00FB' => 'FB',
+ '00FC' => 'FC',
+ '00FD' => 'FD',
+ '00FE' => 'FE',
+ '00FF' => 'FF',
+ },
+ 'iso8859_15' => {
+ '00A0' => 'A0',
+ '00A1' => 'A1',
+ '00A2' => 'A2',
+ '00A3' => 'A3',
+ '20AC' => 'A4',
+ '00A5' => 'A5',
+ '0160' => 'A6',
+ '00A7' => 'A7',
+ '0161' => 'A8',
+ '00A9' => 'A9',
+ '00AA' => 'AA',
+ '00AB' => 'AB',
+ '00AC' => 'AC',
+ '00AD' => 'AD',
+ '00AE' => 'AE',
+ '00AF' => 'AF',
+ '00B0' => 'B0',
+ '00B1' => 'B1',
+ '00B2' => 'B2',
+ '00B3' => 'B3',
+ '017D' => 'B4',
+ '00B5' => 'B5',
+ '00B6' => 'B6',
+ '00B7' => 'B7',
+ '017E' => 'B8',
+ '00B9' => 'B9',
+ '00BA' => 'BA',
+ '00BB' => 'BB',
+ '0152' => 'BC',
+ '0153' => 'BD',
+ '0178' => 'BE',
+ '00BF' => 'BF',
+ '00C0' => 'C0',
+ '00C1' => 'C1',
+ '00C2' => 'C2',
+ '00C3' => 'C3',
+ '00C4' => 'C4',
+ '00C5' => 'C5',
+ '00C6' => 'C6',
+ '00C7' => 'C7',
+ '00C8' => 'C8',
+ '00C9' => 'C9',
+ '00CA' => 'CA',
+ '00CB' => 'CB',
+ '00CC' => 'CC',
+ '00CD' => 'CD',
+ '00CE' => 'CE',
+ '00CF' => 'CF',
+ '00D0' => 'D0',
+ '00D1' => 'D1',
+ '00D2' => 'D2',
+ '00D3' => 'D3',
+ '00D4' => 'D4',
+ '00D5' => 'D5',
+ '00D6' => 'D6',
+ '00D7' => 'D7',
+ '00D8' => 'D8',
+ '00D9' => 'D9',
+ '00DA' => 'DA',
+ '00DB' => 'DB',
+ '00DC' => 'DC',
+ '00DD' => 'DD',
+ '00DE' => 'DE',
+ '00DF' => 'DF',
+ '00E0' => 'E0',
+ '00E1' => 'E1',
+ '00E2' => 'E2',
+ '00E3' => 'E3',
+ '00E4' => 'E4',
+ '00E5' => 'E5',
+ '00E6' => 'E6',
+ '00E7' => 'E7',
+ '00E8' => 'E8',
+ '00E9' => 'E9',
+ '00EA' => 'EA',
+ '00EB' => 'EB',
+ '00EC' => 'EC',
+ '00ED' => 'ED',
+ '00EE' => 'EE',
+ '00EF' => 'EF',
+ '00F0' => 'F0',
+ '00F1' => 'F1',
+ '00F2' => 'F2',
+ '00F3' => 'F3',
+ '00F4' => 'F4',
+ '00F5' => 'F5',
+ '00F6' => 'F6',
+ '00F7' => 'F7',
+ '00F8' => 'F8',
+ '00F9' => 'F9',
+ '00FA' => 'FA',
+ '00FB' => 'FB',
+ '00FC' => 'FC',
+ '00FD' => 'FD',
+ '00FE' => 'FE',
+ '00FF' => 'FF',
+ },
+ 'iso8859_2' => {
+ '00A0' => 'A0',
+ '0104' => 'A1',
+ '02D8' => 'A2',
+ '0141' => 'A3',
+ '00A4' => 'A4',
+ '013D' => 'A5',
+ '015A' => 'A6',
+ '00A7' => 'A7',
+ '00A8' => 'A8',
+ '015E' => 'AA',
+ '0164' => 'AB',
+ '0179' => 'AC',
+ '00AD' => 'AD',
+ '017D' => 'AE',
+ '017B' => 'AF',
+ '00B0' => 'B0',
+ '0105' => 'B1',
+ '02DB' => 'B2',
+ '0142' => 'B3',
+ '00B4' => 'B4',
+ '013E' => 'B5',
+ '015B' => 'B6',
+ '02C7' => 'B7',
+ '00B8' => 'B8',
+ '0161' => 'B9',
+ '015F' => 'BA',
+ '0165' => 'BB',
+ '017A' => 'BC',
+ '02DD' => 'BD',
+ '017E' => 'BE',
+ '017C' => 'BF',
+ '0154' => 'C0',
+ '00C1' => 'C1',
+ '00C2' => 'C2',
+ '0102' => 'C3',
+ '00C4' => 'C4',
+ '0139' => 'C5',
+ '0106' => 'C6',
+ '00C7' => 'C7',
+ '010C' => 'C8',
+ '00C9' => 'C9',
+ '0118' => 'CA',
+ '00CB' => 'CB',
+ '011A' => 'CC',
+ '00CD' => 'CD',
+ '00CE' => 'CE',
+ '010E' => 'CF',
+ '0110' => 'D0',
+ '0143' => 'D1',
+ '0147' => 'D2',
+ '00D3' => 'D3',
+ '00D4' => 'D4',
+ '0150' => 'D5',
+ '00D6' => 'D6',
+ '00D7' => 'D7',
+ '0158' => 'D8',
+ '016E' => 'D9',
+ '00DA' => 'DA',
+ '0170' => 'DB',
+ '00DC' => 'DC',
+ '00DD' => 'DD',
+ '0162' => 'DE',
+ '00DF' => 'DF',
+ '0155' => 'E0',
+ '00E1' => 'E1',
+ '00E2' => 'E2',
+ '0103' => 'E3',
+ '00E4' => 'E4',
+ '013A' => 'E5',
+ '0107' => 'E6',
+ '00E7' => 'E7',
+ '010D' => 'E8',
+ '00E9' => 'E9',
+ '0119' => 'EA',
+ '00EB' => 'EB',
+ '011B' => 'EC',
+ '00ED' => 'ED',
+ '00EE' => 'EE',
+ '010F' => 'EF',
+ '0111' => 'F0',
+ '0144' => 'F1',
+ '0148' => 'F2',
+ '00F3' => 'F3',
+ '00F4' => 'F4',
+ '0151' => 'F5',
+ '00F6' => 'F6',
+ '00F7' => 'F7',
+ '0159' => 'F8',
+ '016F' => 'F9',
+ '00FA' => 'FA',
+ '0171' => 'FB',
+ '00FC' => 'FC',
+ '00FD' => 'FD',
+ '0163' => 'FE',
+ '02D9' => 'FF',
+ },
+ 'koi8' => {
+ '0415' => 'A3',
+ '0454' => 'A4',
+ '0456' => 'A6',
+ '0457' => 'A7',
+ '04D7' => 'B3',
+ '0404' => 'B4',
+ '0406' => 'B6',
+ '0407' => 'B7',
+ '042E' => 'C0',
+ '0430' => 'C1',
+ '0431' => 'C2',
+ '0446' => 'C3',
+ '0434' => 'C4',
+ '0435' => 'C5',
+ '0444' => 'C6',
+ '0433' => 'C7',
+ '0445' => 'C8',
+ '0438' => 'C9',
+ '0439' => 'CA',
+ '043A' => 'CB',
+ '043B' => 'CC',
+ '043C' => 'CD',
+ '043D' => 'CE',
+ '043E' => 'CF',
+ '043F' => 'D0',
+ '044F' => 'D1',
+ '0440' => 'D2',
+ '0441' => 'D3',
+ '0442' => 'D4',
+ '0443' => 'D5',
+ '0436' => 'D6',
+ '0432' => 'D7',
+ '044C' => 'D8',
+ '044B' => 'D9',
+ '0437' => 'DA',
+ '0448' => 'DB',
+ '044D' => 'DC',
+ '0449' => 'DD',
+ '0447' => 'DE',
+ '044A' => 'DF',
+ '042D' => 'E0',
+ '0410' => 'E1',
+ '0411' => 'E2',
+ '0426' => 'E3',
+ '0414' => 'E4',
+ '0415' => 'E5',
+ '0424' => 'E6',
+ '0413' => 'E7',
+ '0425' => 'E8',
+ '0418' => 'E9',
+ '0419' => 'EA',
+ '041A' => 'EB',
+ '041B' => 'EC',
+ '041C' => 'ED',
+ '041D' => 'EE',
+ '041E' => 'EF',
+ '041F' => 'F0',
+ '042F' => 'F1',
+ '0420' => 'F2',
+ '0421' => 'F3',
+ '0422' => 'F4',
+ '0423' => 'F5',
+ '0416' => 'F6',
+ '0412' => 'F7',
+ '042C' => 'F8',
+ '042B' => 'F9',
+ '0417' => 'FA',
+ '0428' => 'FB',
+ '042D' => 'FC',
+ '0429' => 'FD',
+ '0427' => 'FE',
+ '042A' => 'FF',
+ },
+);
+
# node?
my %kept_misc_commands;
foreach my $command ('sp', 'center', 'exdent',
@@ -183,10 +555,182 @@
$ignored_types{$type} = 1;
}
+sub _accent_stack($)
+{
+#unicode_to_eight_bit
+ my $current = shift;
+ my @accent_commands = ();
+ my $text = '';
+ my $done = 0;
+ my $debug = 0;
+ ACCENT:
+ while (1) {
+ if (!$current->{'args'} or !$current->{'cmdname'}
+ or !$accent_commands{$current->{'cmdname'}}) {
+ print STDERR "BUG: Not an accent command in accent\n";
+ print STDERR Data::Dumper->Dump([$current]);
+ print STDERR Texinfo::Convert::Texinfo::convert($current)."\n";
+ last;
+ }
+ push @accent_commands, $current->{'cmdname'};
+ my $arg = $current->{'args'}->[0];
+ if (defined($arg->{'text'})) {
+ return ($arg->{'text'}, address@hidden, $current);
+ }
+ if (!$arg->{'contents'}) {
+ print STDERR "BUG: No content in accent command\n";
+ print STDERR Data::Dumper->Dump([$current]);
+ print STDERR Texinfo::Convert::Texinfo::convert($current)."\n";
+ last;
+ }
+ foreach my $content (@{$arg->{'contents'}}) {
+ if (!($content->{'extra'} and $content->{'extra'}->{'invalid_nesting'})
+ and !($content->{'cmdname'} and ($content->{'cmdname'} eq 'c'
+ or $content->{'cmdname'} eq 'comment'))) {
+ if (defined($content->{'text'})) {
+ $text .= $content->{'text'};
+ print STDERR "TEXT: $text\n" if ($debug);
+ } elsif ($content->{'cmdname'} and
+ defined($text_no_brace_commands{$content->{'cmdname'}})) {
+ $text .= $text_no_brace_commands{$content->{'cmdname'}};
+ print STDERR "NO BRACE COMMAND: $text\n" if ($debug);
+ } elsif ($content->{'cmdname'} and
$text_brace_no_arg_commands{$content->{'cmdname'}}) {
+ $text .= $text_brace_no_arg_commands{$content->{'cmdname'}};
+ print STDERR "BRACE NO ARG COMMAND: $text\n" if ($debug);
+ } else {
+ $current = $content;
+ next ACCENT;
+ }
+ }
+ }
+ last;
+ }
+ return ($text, address@hidden, $current);
+}
+
+sub eight_bit_accents($$$)
+{
+ my $current = shift;
+ my $encoding = shift;
+ my $convert_accent = shift;
+
+ my $debug = 0;
+
+ my ($text, $stack, $innermost_accent) = _accent_stack($current);
+
+ # accents are formatted and the intermediate results are kept, such
+ # that we can return the maximum of multiaccented letters that can be
+ # rendered with a given eight bit formatting.
+ my $accent = $innermost_accent;
+ if ($debug) {
+ print STDERR "INNERMOST: $innermost_accent->{'cmdname'}($text)\n";
+ }
+ my $current_result = Texinfo::Convert::Unicode::unicode_accent($text,
$accent);
+ print STDERR 'PARTIAL_RESULTS: '.Encode::encode('utf8', $current_result) if
($debug);
+
+ my @results_stack = ([$current_result, $accent]);
+ if ($accent ne $current) {
+ while ($accent->{'parent'}->{'parent'}) {
+ $accent = $accent->{'parent'}->{'parent'};
+ $current_result =
+ Texinfo::Convert::Unicode::unicode_accent($current_result, $accent);
+ print STDERR '|'.Encode::encode('utf8', $current_result) if ($debug);
+ push @results_stack, [$current_result, $accent];
+ last if ($accent eq $current);
+ }
+ }
+ print STDERR "\n" if ($debug);
+
+ if ($debug) {
+ print STDERR "stack: ".join('|',@$stack)."\nPARTIAL_RESULATS_STACK:\n";
+ foreach my $partial_result (@results_stack) {
+ print STDERR " -> ".Encode::encode('utf8',
$partial_result->[0])."|$partial_result->[1]->{'cmdname'}\n";
+ }
+ }
+
+ my $encoding_map_name
+ = $Texinfo::Commands::eight_bit_encoding_aliases{$encoding};
+ my $eight_bit;
+ my $result;
+ my $accent_done;
+ # At this point we have the utf8 encoded results for the accent
+ # commands stack, with all the intermediate results.
+ # For each one we'll check if it is possible to encode it in the
+ # current eight bit output encoding table
+ foreach my $partial_result (@results_stack) {
+ my $char = $partial_result->[0];
+ my $new_eight_bit = '';
+ my $new_codepoint;
+
+ if (ord($char) <= 128) {
+ # 7bit ascii characters, the same in every 8bit encodings
+ $new_eight_bit = uc(sprintf("%02x",ord($char)));
+ $new_codepoint = uc(sprintf("%04x",ord($char)));
+ } elsif (ord($char) <= hex(0xFFFF)) {
+ $new_codepoint = uc(sprintf("%04x",ord($char)));
+ if (exists($unicode_to_eight_bit{$encoding_map_name}->{$new_codepoint}))
{
+ $new_eight_bit
+ = $unicode_to_eight_bit{$encoding_map_name}->{$new_codepoint};
+ }
+ }
+
+ if ($debug) {
+ my $eight_bit_txt = 'undef';
+ $eight_bit_txt = $eight_bit if (defined($eight_bit));
+ print STDERR "" . Encode::encode('utf8', $char) . "
($partial_result->[1]->{'cmdname'}), new_codepoint: $new_codepoint 8bit:
$new_eight_bit old:$eight_bit_txt\n";
+ }
+
+ # no corresponding eight bit character found
+ last if ($new_eight_bit eq '');
+
+ # in that case, the new eight bit character is the same than the one
+ # found with one less character (and it isnt a @dotless{i}). It may
+ # mean 2 things
+ # -> there are 2 characters in accent. This could happen, for example
+ # if an accent that cannot be rendered is found and it leads to
+ # appending or prepending a character. For example this happens for
+ # @={@,address@hidden, where @,address@hidden is expanded to a 2
character:
+ # n with a tilde, followed by a ,
+ # In nthat case, the additional utf8 accent is prepended, which
+ # means that it is composed with the , and leaves n with a tilde
+ # untouched.
+ # -> ord(char) leads to the same for the more inner character.
+ # this, for example, happens for @ubaraccent{a}, where ord(a) is
+ # the same than ord(a with underbar).
+ last if (defined($eight_bit) and (($new_eight_bit eq $eight_bit)
+ and !($partial_result->[1]->{'cmdname'} eq 'dotless' and $char eq
'i')));
+ $result = $partial_result->[0];
+ $accent_done = $partial_result->[1];
+ $eight_bit = $new_eight_bit;
+ }
+ my $accent_remaining = '';
+ if (defined($accent_done)) {
+ if ($accent_done ne $current) {
+ $accent_remaining = $accent_done->{'parent'}->{'parent'};
+ }
+ } else {
+ $accent_remaining = $innermost_accent;
+ $result = $text;
+ }
+ print STDERR "initial: $current, remaining: $accent_remaining, result: "
+ .Encode::encode('utf8', $result)."\n" if ($debug);
+ if ($accent_remaining) {
+ while (1) {
+ $result = &$convert_accent($result, $accent_remaining);
+ if ($accent_remaining eq $current) {
+ return $result;
+ }
+ $accent_remaining = $accent_remaining->{'parent'}->{'parent'};
+ }
+ }
+ return $result;
+}
+
sub ascii_accents($$)
{
my $text = shift;
- my $accent = shift;
+ my $command = shift;
+ my $accent = $command->{'cmdname'};
return $text if ($accent eq 'dotless');
return $text . "''" if ($accent eq 'H');
return $text . '.' if ($accent eq 'dotaccent');
@@ -210,11 +754,12 @@
return $text;
}
-sub convert($);
+sub convert($;$);
-sub convert($)
+sub convert($;$)
{
my $root = shift;
+ my $options = shift;
if (0) {
print STDERR "root\n";
@@ -253,13 +798,22 @@
# commands with braces
} elsif ($accent_commands{$root->{'cmdname'}}) {
return '' if (!$root->{'args'});
- return ascii_accents(convert($root->{'args'}->[0]), $root->{'cmdname'});
+ if ($options->{'enable_encoding'} and $options->{'enable_encoding'} eq
'utf-8') {
+ return
Texinfo::Convert::Unicode::unicode_accent(convert($root->{'args'}->[0],
$options),
+ $root->{'cmdname'});
+ } elsif ($options->{'enable_encoding'}
+ and
$Texinfo::Commands::eight_bit_encoding_aliases{$options->{'enable_encoding'}}) {
+ return eight_bit_accents($root, $options->{'enable_encoding'},
+ \&ascii_accents);
+ } else {
+ return ascii_accents(convert($root->{'args'}->[0], $options), $root);
+ }
} elsif ($root->{'cmdname'} eq 'image') {
- return convert($root->{'args'}->[0]);
+ return convert($root->{'args'}->[0], $options);
} elsif ($root->{'cmdname'} eq 'email') {
- my $mail = _normalise_space(convert($root->{'args'}->[0]));
+ my $mail = _normalise_space(convert($root->{'args'}->[0], $options));
my $text;
- $text = _normalise_space(convert($root->{'args'}->[1]))
+ $text = _normalise_space(convert($root->{'args'}->[1], $options))
if (defined($root->{'args'}->[1]));
return $text if (defined($text) and ($text ne ''));
return $mail;
@@ -267,12 +821,12 @@
and (($root->{'args'}->[0]->{'type'}
and $root->{'args'}->[0]->{'type'} eq 'brace_command_arg')
or $root->{'cmdname'} eq 'math')) {
- return convert($root->{'args'}->[0]);
+ return convert($root->{'args'}->[0], $options);
# block commands
} elsif (($root->{'cmdname'} eq 'quotation'
or $root->{'cmdname'} eq 'smallquotation')) {
if ($root->{'args'}) {
- $result = convert($root->{'args'}->[0]) ."\n";
+ $result = convert($root->{'args'}->[0], $options) ."\n";
}
} elsif ($kept_misc_commands{$root->{'cmdname'}} and $root->{'args'}) {
if ($root->{'cmdname'} eq 'sp') {
@@ -283,7 +837,7 @@
$result = "\n" x $sp_nr;
}
} elsif ($root->{'cmdname'} ne 'node') {
- $result = convert($root->{'args'}->[0]);
+ $result = convert($root->{'args'}->[0], $options);
# we always want an end of line even if is was eaten by a
chomp ($result);
$result .= "\n";
@@ -292,15 +846,15 @@
}
if ($root->{'type'} and $root->{'type'} eq 'def_line') {
#print STDERR "$root->{'extra'}->{'def_command'}\n";
- $result = convert($root->{'args'}->[0]) if ($root->{'args'});
+ $result = convert($root->{'args'}->[0], $options) if ($root->{'args'});
} elsif ($root->{'type'} and $root->{'type'} eq 'menu_entry') {
foreach my $arg (@{$root->{'args'}}) {
- $result .= convert($arg);
+ $result .= convert($arg, $options);
}
}
if ($root->{'contents'}) {
foreach my $content (@{$root->{'contents'}}) {
- $result .= convert($content);
+ $result .= convert($content, $options);
}
}
$result = '{'.$result.'}'
Index: Texinfo/Convert/Unicode.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Convert/Unicode.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- Texinfo/Convert/Unicode.pm 27 Oct 2010 22:03:13 -0000 1.1
+++ Texinfo/Convert/Unicode.pm 6 Nov 2010 00:41:28 -0000 1.2
@@ -553,7 +553,7 @@
return Unicode::Normalize::NFC($text .
chr(hex($unicode_diacritics{$accent})))
if (defined($unicode_diacritics{$accent}));
- return Texinfo::Convert::Text::ascii_accents($text, $accent);
+ return Texinfo::Convert::Text::ascii_accents($text, $command);
}
1;
Index: t/01use.t
===================================================================
RCS file: /sources/texinfo/texinfo/tp/t/01use.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- t/01use.t 20 Sep 2010 17:19:05 -0000 1.1
+++ t/01use.t 6 Nov 2010 00:41:28 -0000 1.2
@@ -10,9 +10,7 @@
#use Test;
use Test::More;
BEGIN { plan tests => 2 };
-use Texinfo::Parser qw(:all);
-use Data::Dumper;
-use Data::Compare;
+use Texinfo::Convert::Texinfo;
ok(1, "modules loading"); # If we made it this far, we're ok.
#########################
@@ -24,9 +22,6 @@
require 't/manual_tree.pl';
-is (tree_to_texi($manual_tree), $manual_tree_result, "tree_to_texi on a
manually written tree");
+is (Texinfo::Convert::Texinfo::convert($manual_tree),
+ $manual_tree_result, "tree_to_texi on a manually written tree");
-#print STDERR tree_to_texi($manual_tree);
-#print STDERR "".Data::Dumper->Dump([$manual_tree], ['$manual_tree']);
-# returns 1 if they are the same
-# Data::Compare::Compare($manual_tree, $manual_tree)."\n";
Index: t/02coverage.t
===================================================================
RCS file: /sources/texinfo/texinfo/tp/t/02coverage.t,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -b -r1.22 -r1.23
--- t/02coverage.t 24 Oct 2010 10:14:49 -0000 1.22
+++ t/02coverage.t 6 Nov 2010 00:41:28 -0000 1.23
@@ -12,6 +12,9 @@
@majorheading majorheading @b{in b}
'],
+['arg_in_brace_no_arg_command',
+'@TeX{in tex}
+'],
['accents',
'@ringaccent a
Index: t/test_utils.pl
===================================================================
RCS file: /sources/texinfo/texinfo/tp/t/test_utils.pl,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -b -r1.45 -r1.46
--- t/test_utils.pl 2 Nov 2010 23:02:33 -0000 1.45
+++ t/test_utils.pl 6 Nov 2010 00:41:28 -0000 1.46
@@ -1,8 +1,9 @@
use strict;
use Test::More;
-use Texinfo::Parser qw(tree_to_texi);
+use Texinfo::Parser;
use Texinfo::Convert::Text;
+use Texinfo::Convert::Texinfo;
use Texinfo::Structuring;
use File::Basename;
use Data::Dumper;
@@ -225,7 +226,7 @@
local $Data::Dumper::Sortkeys = \&filter_tree_keys;
$out_result = Data::Dumper->Dump([$result],
['$result_trees{\''.$test_name.'\'}']);
}
- my $texi_string_result = tree_to_texi($result);
+ my $texi_string_result = Texinfo::Convert::Texinfo::convert($result);
my $perl_string_result = $texi_string_result;
$perl_string_result =~ s/\\/\\\\/g;
$perl_string_result =~ s/'/\\'/g;
@@ -270,7 +271,8 @@
close (OUT);
}
- print STDERR "--> $test_name\n".tree_to_texi($result)."\n" if
($self->{'generate'});
+ print STDERR "-->
$test_name\n".Texinfo::Convert::Texinfo::convert($result)."\n"
+ if ($self->{'generate'});
}
if (!$self->{'generate'}) {
require $file;
@@ -321,10 +323,10 @@
$test_name.' errors');
ok (Data::Compare::Compare($indices, $result_indices{$test_name}),
$test_name.' indices');
- ok (tree_to_texi($result) eq $result_texis{$test_name},
+ ok (Texinfo::Convert::Texinfo::convert($result) eq
$result_texis{$test_name},
$test_name.' texi');
ok ($converted_text eq $result_texts{$test_name}, $test_name.' text');
- #is (tree_to_texi($result), $result_texis{$test_name}, $test_name.' text');
+ #is (Texinfo::Convert::Texinfo::convert($result),
$result_texis{$test_name}, $test_name.' text');
}
#exit;
}
Index: Texinfo/Convert/Texinfo.pm
===================================================================
RCS file: Texinfo/Convert/Texinfo.pm
diff -N Texinfo/Convert/Texinfo.pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ Texinfo/Convert/Texinfo.pm 6 Nov 2010 00:41:28 -0000 1.1
@@ -0,0 +1,202 @@
+# Texinfo.pm: output a Texinfo tree as Texinfo.
+#
+# Copyright 2010 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License,
+# or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+#
+# Original author: Patrice Dumas <address@hidden>
+# Parts (also from Patrice Dumas) come from texi2html.pl or texi2html.init.
+
+package Texinfo::Convert::Texinfo;
+
+use 5.00405;
+use strict;
+
+# commands definitions
+use Texinfo::Commands;
+
+require Exporter;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
address@hidden = qw(Exporter);
+
address@hidden = ('convert');
+
+$VERSION = '0.01';
+
+my %misc_commands = %Texinfo::Commands::misc_commands;
+my %brace_commands = %Texinfo::Commands::brace_commands;
+my %block_commands = %Texinfo::Commands::block_commands;
+my %def_commands = %Texinfo::Commands::def_commands;
+
+sub convert ($);
+# Following subroutines deal with transforming a texinfo tree into texinfo
+# text. Should give the text that was used parsed, except for a few cases.
+
+# expand a tree to the corresponding texinfo.
+sub convert ($)
+{
+ my $root = shift;
+ die "convert: root undef\n" if (!defined($root));
+ die "convert: bad root type (".ref($root).") $root\n"
+ if (ref($root) ne 'HASH');
+ my $result = '';
+ #print STDERR "$root ";
+ #print STDERR "$root->{'type'}" if (defined($root->{'type'}));
+ #print STDERR "\n";
+ if (defined($root->{'text'})) {
+ $result .= $root->{'text'};
+ } else {
+ if ($root->{'cmdname'}
+ or ($root->{'type'} and ($root->{'type'} eq 'def_line'
+ or $root->{'type'} eq 'menu_entry'
+ or $root->{'type'} eq 'menu_comment'))) {
+ #print STDERR "cmd: $root->{'cmdname'}\n";
+ $result .= _expand_cmd_args_to_texi($root);
+ }
+ $result .= '{' if ($root->{'type'} and $root->{'type'} eq 'bracketed');
+ #print STDERR "$root->{'contents'} @{$root->{'contents'}}\n" if
(defined($root->{'contents'}));
+ if (defined($root->{'contents'})) {
+ die "bad contents type(" . ref($root->{'contents'})
+ . ") $root->{'contents'}\n" if (ref($root->{'contents'}) ne 'ARRAY');
+ foreach my $child (@{$root->{'contents'}}) {
+ $result .= convert($child);
+ }
+ }
+ $result .= '}' if ($root->{'type'} and $root->{'type'} eq 'bracketed');
+ if ($root->{'cmdname'} and (defined($block_commands{$root->{'cmdname'}})))
{
+ $result .= '@end '.$root->{'cmdname'};
+ }
+ }
+ #print STDERR "convert result: $result\n";
+ return $result;
+}
+
+
+# expand a command argument as texinfo.
+sub _expand_cmd_args_to_texi ($) {
+ my $cmd = shift;
+ my $cmdname = $cmd->{'cmdname'};
+ $cmdname = '' if (!$cmd->{'cmdname'});
+ my $result = '';
+ $result = '@'.$cmdname if ($cmdname);
+ #print STDERR "Expand $result\n";
+ # must be before the next condition
+ if ($block_commands{$cmdname}
+ and ($def_commands{$cmdname}
+ or $block_commands{$cmdname} eq 'multitable')
+ and $cmd->{'args'}) {
+ foreach my $arg (@{$cmd->{'args'}}) {
+ $result .= convert ($arg);
+ }
+ } elsif (($cmd->{'extra'} or $cmdname eq 'macro' or $cmdname eq 'rmacro')
+ and defined($cmd->{'extra'}->{'arg_line'})) {
+ $result .= $cmd->{'extra'}->{'arg_line'};
+ } elsif (($block_commands{$cmdname} or $cmdname eq 'node')
+ and defined($cmd->{'args'})) {
+ die "bad args type (".ref($cmd->{'args'}).") $cmd->{'args'}\n"
+ if (ref($cmd->{'args'}) ne 'ARRAY');
+ foreach my $arg (@{$cmd->{'args'}}) {
+ $result .= convert ($arg) . ',';
+ }
+ $result =~ s/,$//;
+ } elsif (defined($cmd->{'args'})) {
+ my $braces;
+ $braces = 1 if ($cmd->{'args'}->[0]->{'type'}
+ and ($cmd->{'args'}->[0]->{'type'} eq 'brace_command_arg'
+ or $cmd->{'args'}->[0]->{'type'} eq
'brace_command_context'));
+ $result .= '{' if ($braces);
+ if ($cmdname eq 'verb') {
+ $result .= $cmd->{'type'};
+ }
+ if ($cmd->{'extra'} and exists ($cmd->{'extra'}->{'spaces'})) {
+ $result .= $cmd->{'extra'}->{'spaces'};
+ }
+ #print STDERR "".Data::Dumper->Dump([$cmd]);
+ my $arg_nr = 0;
+ foreach my $arg (@{$cmd->{'args'}}) {
+ if (exists($brace_commands{$cmdname}) or ($cmd->{'type'}
+ and $cmd->{'type'} eq 'definfoenclose_command')) {
+ $result .= ',' if ($arg_nr);
+ $arg_nr++;
+ }
+ $result .= convert ($arg);
+ }
+ if ($cmdname eq 'verb') {
+ $result .= $cmd->{'type'};
+ }
+ #die "Shouldn't have args: $cmdname\n";
+ $result .= '}' if ($braces);
+ }
+ if ($misc_commands{$cmdname}
+ and $misc_commands{$cmdname} eq 'skipline') {
+ $result .="\n";
+ }
+ $result .= '{'.$cmd->{'type'}.'}' if ($cmdname eq 'value');
+ #print STDERR "Result: $result\n";
+ return $result;
+}
+
+1;
+__END__
+# Below is stub documentation.
+
+=head1 NAME
+
+Texinfo::Parser - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+ use Texinfo::Parser;
+ blah blah blah
+
+=head1 DESCRIPTION
+
+Stub documentation for Texinfo::Parser, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+=head2 EXPORT
+
+None by default.
+
+
+
+=head1 SEE ALSO
+
+Mention other useful documentation such as the documentation of
+related modules or operating system documentation (such as man pages
+in UNIX), or any relevant external documentation such as RFCs or
+standards.
+
+If you have a mailing list set up for your module, mention it here.
+
+If you have a web site set up for your module, mention it here.
+
+=head1 AUTHOR
+
+Patrice Dumas, E<lt>address@hidden<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 Free Software Foundation, Inc.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License,
+# or (at your option) any later version.
+
+
+=cut
Index: t/results/coverage/arg_in_brace_no_arg_command.pl
===================================================================
RCS file: t/results/coverage/arg_in_brace_no_arg_command.pl
diff -N t/results/coverage/arg_in_brace_no_arg_command.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ t/results/coverage/arg_in_brace_no_arg_command.pl 6 Nov 2010 00:41:28
-0000 1.1
@@ -0,0 +1,54 @@
+use vars qw(%result_texis %result_texts %result_trees %result_errors
+ %result_indices %result_sectioning %result_nodes %result_menus
+ %result_floats);
+
+$result_trees{'arg_in_brace_no_arg_command'} = {
+ 'contents' => [
+ {
+ 'contents' => [
+ {
+ 'args' => [
+ {
+ 'contents' => [
+ {
+ 'parent' => {},
+ 'text' => 'in tex'
+ }
+ ],
+ 'parent' => {},
+ 'type' => 'brace_command_arg'
+ }
+ ],
+ 'cmdname' => 'TeX',
+ 'contents' => [],
+ 'parent' => {}
+ },
+ {
+ 'parent' => {},
+ 'text' => '
+'
+ }
+ ],
+ 'parent' => {},
+ 'type' => 'paragraph'
+ }
+ ],
+ 'type' => 'text_root'
+};
+$result_trees{'arg_in_brace_no_arg_command'}{'contents'}[0]{'contents'}[0]{'args'}[0]{'contents'}[0]{'parent'}
=
$result_trees{'arg_in_brace_no_arg_command'}{'contents'}[0]{'contents'}[0]{'args'}[0];
+$result_trees{'arg_in_brace_no_arg_command'}{'contents'}[0]{'contents'}[0]{'args'}[0]{'parent'}
= $result_trees{'arg_in_brace_no_arg_command'}{'contents'}[0]{'contents'}[0];
+$result_trees{'arg_in_brace_no_arg_command'}{'contents'}[0]{'contents'}[0]{'parent'}
= $result_trees{'arg_in_brace_no_arg_command'}{'contents'}[0];
+$result_trees{'arg_in_brace_no_arg_command'}{'contents'}[0]{'contents'}[1]{'parent'}
= $result_trees{'arg_in_brace_no_arg_command'}{'contents'}[0];
+$result_trees{'arg_in_brace_no_arg_command'}{'contents'}[0]{'parent'} =
$result_trees{'arg_in_brace_no_arg_command'};
+
+$result_texis{'arg_in_brace_no_arg_command'} = '@TeX{in tex}
+';
+
+
+$result_texts{'arg_in_brace_no_arg_command'} = 'TeX
+';
+
+$result_errors{'arg_in_brace_no_arg_command'} = [];
+
+
+1;