summaryrefslogtreecommitdiff
path: root/macros/texinfo/texinfo/tp/Texinfo/XS/parsetexi/Parsetexi.pm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /macros/texinfo/texinfo/tp/Texinfo/XS/parsetexi/Parsetexi.pm
Initial commit
Diffstat (limited to 'macros/texinfo/texinfo/tp/Texinfo/XS/parsetexi/Parsetexi.pm')
-rw-r--r--macros/texinfo/texinfo/tp/Texinfo/XS/parsetexi/Parsetexi.pm445
1 files changed, 445 insertions, 0 deletions
diff --git a/macros/texinfo/texinfo/tp/Texinfo/XS/parsetexi/Parsetexi.pm b/macros/texinfo/texinfo/tp/Texinfo/XS/parsetexi/Parsetexi.pm
new file mode 100644
index 0000000000..87c9a0a0d6
--- /dev/null
+++ b/macros/texinfo/texinfo/tp/Texinfo/XS/parsetexi/Parsetexi.pm
@@ -0,0 +1,445 @@
+# Copyright 2014-2019 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/>.
+
+package Parsetexi;
+
+use Texinfo::XSLoader;
+
+# same as texi2any.pl, although I don't know what the real requirement
+# is for this module.
+use 5.00405;
+use strict;
+use warnings;
+
+require Exporter;
+
+use Texinfo::Common;
+use Texinfo::Encoding;
+use Texinfo::Convert::NodeNameNormalization;
+
+our @ISA = qw(Exporter DynaLoader Texinfo::Report);
+our %EXPORT_TAGS = ( 'all' => [ qw(
+ parser
+ parse_texi_text
+ parse_texi_line
+ parse_texi_file
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+
+);
+
+sub get_conf($$)
+{
+ my $self = shift;
+ my $var = shift;
+ return $self->{$var};
+}
+
+my %parser_default_configuration =
+ (%Texinfo::Common::default_parser_state_configuration,
+ %Texinfo::Common::default_customization_values);
+
+my %tree_informations;
+foreach my $tree_information ('values', 'macros', 'explained_commands', 'labels') {
+ $tree_informations{$tree_information} = 1;
+}
+
+use Storable qw(dclone); # standard in 5.007003
+
+sub duplicate_parser {
+ my $old_parser = shift;
+
+ my $parser = dclone(\%parser_default_configuration);
+
+ foreach my $key (keys(%parser_default_configuration)) {
+ if ($tree_informations{$key}) {
+ if (defined($old_parser->{$key})) {
+ foreach my $info_key (keys(%{$old_parser->{$key}})) {
+ $parser->{$key}->{$info_key}
+ = $old_parser->{$key}->{$info_key};
+ }
+ }
+ } elsif(ref($old_parser->{$key})) {
+ $parser->{$key} = dclone($old_parser->{$key});
+ } else {
+ $parser->{$key} = $old_parser->{$key};
+ }
+ }
+ bless $parser, ref($old_parser);
+
+ $parser->Texinfo::Report::new;
+ return $parser;
+}
+
+sub simple_parser {
+ goto &parser;
+}
+
+# Stub for Texinfo::Parser::parser (line 574)
+sub parser (;$$)
+{
+ my $conf = shift;
+
+ my $parser = dclone(\%parser_default_configuration);
+
+ reset_parser ();
+ # fixme: these are overwritten immediately after
+ if (defined($conf)) {
+ foreach my $key (keys (%$conf)) {
+ if ($key ne 'values' and ref($conf->{$key})) {
+ $parser->{$key} = dclone($conf->{$key});
+ } else {
+ $parser->{$key} = $conf->{$key};
+ }
+
+ if ($key eq 'include_directories') {
+ foreach my $d (@{$conf->{'include_directories'}}) {
+ add_include_directory ($d);
+ }
+ } elsif ($key eq 'values') {
+ # This is used by Texinfo::Report::gdt for substituted values
+ for my $v (keys %{$conf->{'values'}}) {
+ if (!ref($conf->{'values'}->{$v})) {
+ store_value ($v, $conf->{'values'}->{$v});
+ } elsif (ref($conf->{'values'}->{$v}) eq 'HASH') {
+ store_value ($v, "<<HASH VALUE>>");
+ } elsif (ref($conf->{'values'}->{$v}) eq 'ARRAY') {
+ store_value ($v, "<<ARRAY VALUE>>");
+ } else {
+ store_value ($v, "<<UNKNOWN VALUE>>");
+ }
+ }
+ } elsif ($key eq 'expanded_formats') {
+ clear_expanded_formats ();
+
+ for my $f (@{$parser->{$key}}) {
+ add_expanded_format ($f);
+ }
+ } elsif ($key eq 'documentlanguage') {
+ if (defined ($conf->{$key})) {
+ set_documentlanguage ($conf->{$key});
+ }
+ } elsif ($key eq 'SHOW_MENU') {
+ conf_set_show_menu ($conf->{$key});
+ } elsif ($key eq 'IGNORE_SPACE_AFTER_BRACED_COMMAND_NAME') {
+ conf_set_IGNORE_SPACE_AFTER_BRACED_COMMAND_NAME ($conf->{$key});
+ } elsif ($key eq 'CPP_LINE_DIRECTIVES') {
+ conf_set_CPP_LINE_DIRECTIVES($conf->{$key});
+ } else {
+ #warn "ignoring parser configuration value \"$key\"\n";
+ }
+ }
+ }
+
+ bless $parser;
+
+ $parser->Texinfo::Report::new;
+
+ return $parser;
+}
+
+# Record any @menu elements under $root in the 'menus' array of $node.
+sub _find_menus_of_node {
+ my $node = shift;
+ my $root = shift;
+
+ if ($root->{'contents'}) {
+ my $contents = $root->{'contents'};
+ foreach my $child (@{$contents}) {
+ if ($child->{'cmdname'} and $child->{'cmdname'} eq 'menu') {
+ push @{$node->{'menus'}}, $child;
+ }
+ }
+ }
+}
+
+# Set 'menus' array for each node. This accounts for malformed input where
+# the number of sectioning commands between @node and @menu is not exactly 1.
+sub _complete_node_menus {
+ my $self = shift;
+ my $root = shift;
+
+ if (!defined $self->{'nodes'}) {
+ $self->{'nodes'} = [];
+ }
+ my $node;
+ foreach my $child (@{$root->{'contents'}}) {
+ if ($child->{'cmdname'} and $child->{'cmdname'} eq 'node') {
+ $node = $child;
+ }
+ _find_menus_of_node ($node, $child) unless !defined $node;
+ }
+}
+
+sub get_parser_info {
+ my $self = shift;
+
+ my ($TARGETS, $INTL_XREFS, $FLOATS,
+ $INDEX_NAMES, $ERRORS, $GLOBAL_INFO, $GLOBAL_INFO2);
+
+ $TARGETS = build_label_list ();
+ $INTL_XREFS = build_internal_xref_list ();
+ $FLOATS = build_float_list ();
+
+ $INDEX_NAMES = build_index_data ();
+ $self->{'index_names'} = $INDEX_NAMES;
+
+ $GLOBAL_INFO = build_global_info ();
+ $GLOBAL_INFO2 = build_global_info2 ();
+
+ $self->{'targets'} = $TARGETS;
+ $self->{'labels'} = {};
+ $self->{'internal_references'} = $INTL_XREFS;
+ $self->{'floats'} = $FLOATS;
+ $self->{'info'} = $GLOBAL_INFO;
+ $self->{'extra'} = $GLOBAL_INFO2;
+
+ _get_errors ($self);
+ Texinfo::Common::complete_indices ($self);
+}
+
+use File::Basename; # for fileparse
+
+# Handle 'IGNORE_BEFORE_SETFILENAME' conf value.
+# Put everything before @setfilename in a special type. This allows
+# ignoring everything before @setfilename.
+sub _maybe_ignore_before_setfilename {
+ my ($self, $text_root) = @_;
+
+ if ($self->{'IGNORE_BEFORE_SETFILENAME'} and $text_root
+ and $self->{'extra'}->{'setfilename'}
+ and $self->{'extra'}->{'setfilename'}->{'parent'} eq $text_root) {
+ my $before_setfilename = {'type' => 'preamble_before_setfilename',
+ 'parent' => $text_root,
+ 'contents' => []};
+ while (@{$text_root->{'contents'}}
+ and (!$text_root->{'contents'}->[0]->{'cmdname'}
+ or $text_root->{'contents'}->[0]->{'cmdname'} ne 'setfilename')) {
+ my $content = shift @{$text_root->{'contents'}};
+ $content->{'parent'} = $before_setfilename;
+ push @{$before_setfilename->{'contents'}}, $content;
+ }
+ if (!@{$text_root->{'contents'}}) {
+ # not found
+ #splice @{$text_root->{'contents'}}, 0, 0, @$before_setfilename;
+ $text_root->{'contents'} = $before_setfilename->{'contents'};
+ } else {
+ unshift (@{$text_root->{'contents'}}, $before_setfilename)
+ if (@{$before_setfilename->{'contents'}});
+ }
+ }
+}
+
+# Replacement for Texinfo::Parser::parse_texi_file (line 835)
+sub parse_texi_file ($$)
+{
+ my $self = shift;
+ my $file_name = shift;
+ my $tree_stream;
+
+ my $status = parse_file ($file_name);
+ if ($status) {
+ # TODO: internationalise this message?
+ $self->document_error(sprintf("could not open %s: %s", $file_name, $!));
+ return undef;
+ }
+
+ my $TREE = build_texinfo_tree ();
+ get_parser_info ($self);
+ _complete_node_menus ($self, $TREE);
+
+ # line 899
+ my $text_root;
+ if ($TREE->{'type'} eq 'text_root') {
+ $text_root = $TREE;
+ } elsif ($TREE->{'contents'} and $TREE->{'contents'}->[0]
+ and $TREE->{'contents'}->[0]->{'type'} eq 'text_root') {
+ $text_root = $TREE->{'contents'}->[0];
+ }
+
+ _maybe_ignore_before_setfilename($self, $text_root);
+
+ ############################################################
+
+ if (defined($self->{'info'}->{'input_encoding_name'})) {
+ my ($texinfo_encoding, $perl_encoding, $input_encoding)
+ = Texinfo::Encoding::encoding_alias(
+ $self->{'info'}->{'input_encoding_name'});
+ $self->{'info'}->{'input_encoding_name'} = $input_encoding;
+ }
+
+ my ($basename, $directories, $suffix) = fileparse($file_name);
+ $self->{'info'}->{'input_file_name'} = $basename;
+ $self->{'info'}->{'input_directory'} = $directories;
+
+ return $TREE;
+}
+
+# Copy the errors into the error list in Texinfo::Report.
+# TODO: Could we just access the error list directly instead of going
+# through Texinfo::Report line_error?
+sub _get_errors($)
+{
+ my $self = shift;
+ my $ERRORS;
+ my $tree_stream = dump_errors();
+ eval $tree_stream;
+ for my $error (@{$ERRORS}) {
+ if ($error->{'type'} eq 'error') {
+ $self->line_error ($error->{'message'}, $error->{'line_nr'});
+ } else {
+ $self->line_warn ($error->{'message'}, $error->{'line_nr'});
+ }
+ }
+}
+
+# Replacement for Texinfo::Parser::parse_texi_text (line 757)
+#
+# Used in tests under tp/t.
+sub parse_texi_text($$;$$$$)
+{
+ my $self = shift;
+ my $text = shift;
+ my $lines_nr = shift;
+ my $file = shift;
+ my $macro = shift;
+ my $fixed_line_number = shift;
+
+ return undef if (!defined($text));
+
+ $self = parser() if (!defined($self));
+
+ # make sure that internal byte buffer is in UTF-8 before we pass
+ # it in to the XS code.
+ utf8::upgrade($text);
+
+ parse_text($text);
+ my $tree = build_texinfo_tree ();
+ my $INDEX_NAMES = build_index_data ();
+ $self->{'index_names'} = $INDEX_NAMES;
+
+ for my $index (keys %$INDEX_NAMES) {
+ if ($INDEX_NAMES->{$index}->{'merged_in'}) {
+ $self->{'merged_indices'}-> {$index}
+ = $INDEX_NAMES->{$index}->{'merged_in'};
+ }
+ }
+
+ get_parser_info($self);
+ _complete_node_menus ($self, $tree);
+ return $tree;
+}
+
+# Replacement for Texinfo::Parser::parse_texi_line (line 918)
+sub parse_texi_line($$;$$$$)
+{
+ my $self = shift;
+ my $text = shift;
+ my $lines_nr = shift;
+ my $file = shift;
+ my $macro = shift;
+ my $fixed_line_number = shift;
+
+ return undef if (!defined($text));
+
+ $self = parser() if (!defined($self));
+ utf8::upgrade($text);
+ parse_string($text);
+ my $tree = build_texinfo_tree ();
+ return $tree;
+}
+
+# Public interfaces of Texinfo::Parser (starting line 942)
+sub indices_information($)
+{
+ my $self = shift;
+
+ my $INDEX_NAMES;
+ if (!$self->{'index_names'}) {
+ $INDEX_NAMES = build_index_data ();
+ $self->{'index_names'} = $INDEX_NAMES;
+ }
+ return $self->{'index_names'};
+}
+
+sub floats_information($)
+{
+ my $self = shift;
+ return $self->{'floats'};
+}
+
+sub internal_references_information($)
+{
+ my $self = shift;
+ return $self->{'internal_references'};
+}
+
+sub global_commands_information($)
+{
+ my $self = shift;
+ return $self->{'extra'};
+}
+
+sub global_informations($)
+{
+ my $self = shift;
+ return $self->{'info'};
+}
+
+# Setup labels and nodes info and return labels
+sub labels_information($)
+{
+ goto &Texinfo::Common::labels_information;
+}
+
+BEGIN {
+ Texinfo::XSLoader::init (
+ "Texinfo::Parser",
+ "Parsetexi",
+ "Texinfo::ParserNonXS",
+ "Parsetexi",
+ 0);
+} # end BEGIN
+
+END {
+ #reset_parser (); # for debugging memory leaks
+}
+
+# This "use" statement is all the way down here because Texinfo::Report
+# and Texinfo::Parser both "use" each other. If we "use Texinfo::Report"
+# at the top of the file, this has the problem that the symbol table
+# for the Texinfo::Parser namespace, %Texinfo::Parser::, is a different
+# hash (i.e. it has a different address) from what it ends up with by the
+# end of this module. Once the Perl interpreter has read in a module and
+# interpreted variables in terms of a given symbol table, it does not
+# do so them again. Hence, use of subroutines in the Texinfo::Parser namespace
+# fails. This remains the case even if we arrange for the symbol table hash
+# to remain at the same address, because is empty while the file is being read.
+use Texinfo::Report;
+
+# NB Don't add more functions down here, because this can cause an error
+# with some versions of Perl, connected with the typeglob assignment just
+# above. ("Can't call mro_method_changed_in() on anonymous symbol table").
+#
+# See http://perl5.git.perl.org/perl.git/commitdiff/03d9f026ae253e9e69212a3cf6f1944437e9f070?hp=ac73ea1ec401df889d312b067f78b618f7ffecc3
+#
+# (change to Perl interpreter on 22 Oct 2011)
+
+
+1;
+__END__