# ParserNonXS.pm: parse texinfo code into a tree.
#
# Copyright 2010-2022 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 .
#
# Original author: Patrice Dumas
# Parts (also from Patrice Dumas) come from texi2html.pl or texi2html.init.
# Since there are different parser implementation, XS and NonXS, it is
# better to have the Texinfo::Parser packages define only the parser
# API functions. Constants, functions useful in both parsers, and other
# functions useful in other codes are better defined in other Texinfo
# modules.
# The organization of the file is the following:
# default parser state. With explanation of the internal structures.
# determination of command types.
# user visible subroutines and subroutines related to input.
# internal subroutines, doing the parsing.
# In general, the Parser works with character strings decoded from the
# command line, from input files or from the parsed document. There are
# exceptions for the following files and directory names that are binary
# strings:
# * the input file name passed through parse_texi_file is a binary string
# * @include file name and CPP line directive file names are encoded
# into binary strings.
# Those binary strings are in 'file_name' keys, they transit through
# $self->{'input'} and end up in 'source_info' in tree elements and
# in error messages.
#
# The following parser information is directly determined from the
# input file name as binary strings
# ->{'info'}->{'input_file_name'}
# ->{'info'}->{'input_directory'}
package Texinfo::Parser;
# We need the unicode stuff.
use 5.006;
use strict;
# stop \s from matching non-ASCII spaces, etc. \p{...} can still be
# used to match Unicode character classes.
use if $] >= 5.014, re => '/a';
# check that autovivification do not happen incorrectly. If set,
# need to uncomment many 'extra' key hash initialization
#no autovivification qw(fetch delete exists store strict);
# debug
use Carp qw(cluck);
use Data::Dumper;
# to detect if an encoding may be used to open the files
use Encode qw(find_encoding decode);
# for fileparse
use File::Basename;
# Clone could be faster for small structures, which should be the case
# here, but Clone is not in Perl core modules, so we use Storable::dclone.
use Storable qw(dclone); # standard in 5.007003
# commands definitions
use Texinfo::Common;
use Texinfo::Commands;
# Error reporting and counting
use Texinfo::Report;
# in error messages, and for macro body expansion
use Texinfo::Convert::Texinfo;
# to call set_nodes_list_labels
use Texinfo::Convert::NodeNameNormalization;
# to complete indices translations.
use Texinfo::Translations;
require Exporter;
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
our $module_loaded = 0;
sub import {
if (!$module_loaded) {
Texinfo::XSLoader::override ("Texinfo::Parser::_merge_text",
"Texinfo::MiscXS::merge_text");
Texinfo::XSLoader::override ("Texinfo::Parser::_abort_empty_line",
"Texinfo::MiscXS::abort_empty_line");
Texinfo::XSLoader::override ("Texinfo::Parser::_parse_texi_regex",
"Texinfo::MiscXS::parse_texi_regex");
$module_loaded = 1;
}
# The usual import method
goto &Exporter::import;
}
%EXPORT_TAGS = ( 'all' => [ qw(
parser
parse_texi_file
parse_texi_line
parse_texi_piece
parse_texi_text
) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
$VERSION = '7.0.2';
# these are the default values for the parser state
# some could become configurable if moved to the next hash, but they
# are not configurable/implemented in the XS parser, so they are best
# left internal. In general they are dynamically modified during parsing.
my %parser_state_initialization = (
# these are the user-added indices. May be an array reference on names
# or an hash reference in the same format than %index_names below
'indices' => [],
'aliases' => {}, # key is a command name value is the alias
'commands_info' => {}, # keys are @-commands names (without @) and
# values are arrays for global multiple @-commands
# and a value for non multiple global @-commands.
'conditionals_stack' => [], # a stack of conditional commands that are expanded.
# floats is not really needed, as it would be autogenerated,
# but this allows to have an output more similar to the XS parser output.
'floats' => {}, # key is the normalized float type, value is
# an array reference holding all the floats
# of that type.
'labels' => {}, # keys are normalized label names, as described
# in the `HTML Xref' node. Value should be
# a node/anchor or float in the tree.
'macros' => {}, # the key is the user-defined macro name. The
# value is the reference on a macro element
# as obtained by parsing the @macro
'macro_stack' => [], # stack of macros being expanded (more recent first)
'merged_indices' => {}, # the key is merged in the value
'regions_stack' => [], # a stack of regions commands elements (block
# region commands)
'sections_level' => 0, # modified by raise/lowersections
'targets' => [], # array of elements used to build 'labels'
# initialization of information returned by global_information()
'info' => {
'input_encoding_name' => 'utf-8',
'input_perl_encoding' => 'utf-8'
},
);
# configurable parser state
my %parser_state_configuration = (
'accept_internalvalue' => 0, # whether @txiinternalvalue should be added
# to the tree or considered invalid.
# currently set if called by gdt.
'clickstyle' => 'arrow', # duplicated in gdt but not set nor used by the XS parser
'kbdinputstyle' => 'distinct', # duplicated in gdt but not set nor used by the XS parser
'registrar' => undef, # Texinfo::Report object used for error reporting.
'values' => {'txicommandconditionals' => 1},
# the key is the name, the value the @set name
# argument.
# The txicommandconditionals is a special value
# that is set to mark that @ifcommandnotdefined
# is implemented
);
# customization options are in Texinfo::Common because all the
# customization options informations is gathered here, and also
# because it is used in other codes, in particular the XS parser.
my %parser_settable_configuration = (
%parser_state_configuration,
%Texinfo::Common::default_parser_customization_values,
);
my %parser_default_configuration = (
%parser_state_initialization,
%parser_settable_configuration
);
# the other possible keys for the parser state are:
#
# expanded_formats_hash each key comes from EXPANDED_FORMATS, value is 1
# index_names a structure holding the link between index
# names and merged indices;
# initial value is %index_names in Texinfo::Common.
# context_stack stack of the contexts, more recent on top.
# 'ct_line' is added when on a line or
# block @-command line,
# 'ct_def' is added instead if on a definition line.
# 'ct_preformatted' is added in block commands
# where there is no paragraphs and spaces are kept
# (format, example, display and menu commands...)
# 'ct_math' is added in math block commands
# (displaymath) and @math brace commands
# 'ct_rawpreformatted' is added in raw block commands
# (html, xml, docbook...)
# 'ct_inlineraw' is added when in inlineraw
# 'ct_brace_command' is added when in footnote,
# caption, or shortcaption (context brace_commands
# that does not already start another context, ie not
# math).
# context_command_stack the stack of @-commands. An @-command name can
# be added each time a context is pushed on
# 'context_stack'. Could be undef if there
# is no @-command associated with the context.
# definfoenclose an hash, key is the command name, value is an array
# reference with 2 values, beginning and ending.
# input a stack, with last at bottom. Holds the opened files
# or text. Pending macro expansion or text expansion
# is also in that structure.
# line_commands the same as %line_commands in Texinfo::Common,
# but with index entry commands dynamically added
# close_paragraph_commands same as %close_paragraph_commands
# close_preformatted_commands same as %close_preformatted_commands
# no_paragraph_commands the same as %default_no_paragraph_commands
# below, with index
# entry commands dynamically added
# simple_text_commands the same as %simple_text_commands below, but
# with index entry commands dynamically added
# current_node last seen node.
# current_section last seen section.
# nodes list of nodes.
# command_index associate a command name with an index name.
# internal_references an array holding all the internal references.
# set points to the value set when initializing, for
# configuration items that are not to be overriden
# by @-commands. For example documentlanguage.
# A source information is an hash reference with the keys:
# line_nr the line number.
# file_name the file name, a binary string.
# macro if in a macro expansion, the name of the macro.
#
# A text fragment with source information is a 2 element array reference,
# the first is the text, the second is the source information.
# The input structure is an array, the first is the most recently included
# file. The last element may corresponnd to a file if the parsing is done
# on a file, with parse_texi_file, or just hold pending text, if called on text.
# each element of the array is a hash reference. The key are:
# pending an array reference containing pending text fragments
# with source information, either the text given in
# input or macro expansion text.
# input_file_info source information corresponding to the current file.
# fh filehandle for the file.
# The commands in initialization_overrides are not set in the document if
# set at the parser initialization.
my %initialization_overrides = (
'documentlanguage' => 1,
);
my %nobrace_commands = %Texinfo::Commands::nobrace_commands;
my %line_commands = %Texinfo::Commands::line_commands;
my %brace_commands = %Texinfo::Commands::brace_commands;
my %commands_args_number = %Texinfo::Commands::commands_args_number;
my %accent_commands = %Texinfo::Commands::accent_commands;
my %contain_plain_text_commands = %Texinfo::Commands::contain_plain_text_commands;
my %contain_simple_text_commands = %Texinfo::Commands::contain_simple_text_commands;
my %block_commands = %Texinfo::Commands::block_commands;
my %blockitem_commands = %Texinfo::Commands::blockitem_commands;
my %close_paragraph_commands = %Texinfo::Commands::close_paragraph_commands;
my %def_commands = %Texinfo::Commands::def_commands;
my %def_alias_commands = %Texinfo::Commands::def_alias_commands;
my %preformatted_commands = %Texinfo::Commands::preformatted_commands;
my %math_commands = %Texinfo::Commands::math_commands;
my %deprecated_commands = %Texinfo::Commands::deprecated_commands;
my %root_commands = %Texinfo::Commands::root_commands;
my %sectioning_heading_commands = %Texinfo::Commands::sectioning_heading_commands;
my %ref_commands = %Texinfo::Commands::ref_commands;
my %heading_spec_commands = %Texinfo::Commands::heading_spec_commands;
my %in_heading_spec_commands = %Texinfo::Commands::in_heading_spec_commands;
my %variadic_commands = %Texinfo::Commands::variadic_commands;
my %default_index_commands = %Texinfo::Commands::default_index_commands;
my %global_multiple_commands = %Texinfo::Commands::global_commands;
my %global_unique_commands = %Texinfo::Commands::global_unique_commands;
my %def_map = %Texinfo::Common::def_map;
my %def_aliases = %Texinfo::Common::def_aliases;
my %in_index_commands = %Texinfo::Common::in_index_commands;
my %explained_commands = %Texinfo::Common::explained_commands;
my %inline_format_commands = %Texinfo::Common::inline_format_commands;
my %all_commands = %Texinfo::Common::all_commands;
# Keys are commmands, values are names of indices. User-defined
# index commands are added dynamically.
my %command_index;
$command_index{'vtable'} = 'vr';
$command_index{'ftable'} = 'fn';
foreach my $index_command (keys(%default_index_commands)) {
$command_index{$index_command} = $default_index_commands{$index_command};
}
# the type of index, fn: function, vr: variable, tp: type
my %index_type_def = (
'fn' => ['deffn', 'deftypefn', 'deftypeop', 'defop'],
'vr' => ['defvr', 'deftypevr', 'defcv', 'deftypecv' ],
'tp' => ['deftp']
);
foreach my $index_type (keys %index_type_def) {
foreach my $def (@{$index_type_def{$index_type}}) {
$command_index{$def} = $index_type;
}
}
foreach my $def_command(keys %def_map) {
if (ref($def_map{$def_command}) eq 'HASH') {
my ($real_command) = keys (%{$def_map{$def_command}});
$command_index{$def_command} = $command_index{$real_command};
}
$command_index{$def_command.'x'} = $command_index{$def_command};
}
# equivalence between a @set flag and an @@-command
my %set_flag_command_equivalent = (
'txicodequoteundirected' => 'codequoteundirected',
'txicodequotebacktick' => 'codequotebacktick',
# 'txideftypefnnl' => 'deftypefnnewline',
);
# could be moved to Texinfo::Common if needed more generally
my %set_flag_index_char_ignore = (
'txiindexatsignignore' => '@',
'txiindexbackslashignore' => '\\',
'txiindexlessthanignore' => '<',
'txiindexhyphenignore' => '-',
);
my %type_with_paragraph;
foreach my $type ('before_item', 'before_node_section', 'document_root',
'brace_command_context') {
$type_with_paragraph{$type} = 1;
}
my %command_ignore_space_after;
foreach my $command ('anchor', 'hyphenation', 'caption', 'shortcaption',
'sortas', 'seeentry', 'seealso') {
$command_ignore_space_after{$command} = 1;
}
# @-commands that do not start a paragraph
my %default_no_paragraph_commands;
# @-commands that should be at the beginning of a line
my %begin_line_commands;
foreach my $command ('node', 'end') {
$begin_line_commands{$command} = $command;
}
foreach my $no_paragraph_command ('titlefont', 'caption', 'shortcaption',
'image', '*', 'hyphenation', 'anchor', 'errormsg') {
$default_no_paragraph_commands{$no_paragraph_command} = 1;
}
foreach my $no_paragraph_command (keys(%line_commands),
grep {$nobrace_commands{$_} ne 'symbol'} keys(%nobrace_commands)) {
$default_no_paragraph_commands{$no_paragraph_command} = 1;
}
foreach my $no_paragraph_command (keys(%line_commands)) {
$begin_line_commands{$no_paragraph_command} = 1;
}
# verbatiminclude is not said to begin at the beginning of the line
# in the manual
foreach my $not_begin_line_command ('comment', 'c', 'sp', 'columnfractions',
'item', 'verbatiminclude',
'set', 'clear', 'vskip', 'subentry') {
delete $begin_line_commands{$not_begin_line_command};
}
my %close_preformatted_commands = %close_paragraph_commands;
foreach my $no_close_preformatted('sp') {
delete $close_preformatted_commands{$no_close_preformatted};
}
foreach my $block_command (keys(%block_commands)) {
$begin_line_commands{$block_command} = 1;
$default_no_paragraph_commands{$block_command} = 1;
# FIXME to close preformated or not to close?
#$close_preformatted_commands{$format_raw_command} = 1
# if ($brace_commands{$format_raw_command}) eq 'format_raw');
}
# commands that may appear in commands containing plain text only
my %in_plain_text_commands = %accent_commands;
foreach my $brace_command(keys(%brace_commands)) {
$in_plain_text_commands{$brace_command} = 1
if ($brace_commands{$brace_command} eq 'noarg');
}
my %symbol_nobrace_commands;
foreach my $no_brace_command (keys(%nobrace_commands)) {
if ($nobrace_commands{$no_brace_command} eq 'symbol') {
$symbol_nobrace_commands{$no_brace_command} = 1;
$in_plain_text_commands{$no_brace_command} = 1;
}
}
$in_plain_text_commands{'c'} = 1;
$in_plain_text_commands{'comment'} = 1;
# commands that may appear in any text argument, similar constraints
# as in paragraphs.
my %in_full_text_commands;
# start from all the brace commands
foreach my $command (keys(%brace_commands), keys(%symbol_nobrace_commands)) {
$in_full_text_commands{$command} = 1;
}
# selected line commands
foreach my $in_full_text_command ('c', 'comment', 'refill', 'subentry',
'columnfractions', 'set', 'clear', 'end') {
$in_full_text_commands{$in_full_text_command} = 1;
}
# selected block commands
foreach my $block_command (keys(%block_commands)) {
$in_full_text_commands{$block_command} = 1
if ($block_commands{$block_command} eq 'conditional'
or $block_commands{$block_command} eq 'format_raw');
}
# sort out brace commmands and setup command list appearing in more
# restricted context.
# those two commands are not allowed in any command except for @float */
delete $in_full_text_commands{'caption'};
delete $in_full_text_commands{'shortcaption'};
# commands that may appear inside sectioning commands
my %in_simple_text_with_refs_commands = %in_full_text_commands;
foreach my $not_in_simple_text_with_refs_commands ('titlefont',
'anchor', 'footnote', 'verb') {
delete $in_simple_text_with_refs_commands{$not_in_simple_text_with_refs_commands};
}
# commands that may happen in simple text arguments
my %in_simple_text_commands = %in_simple_text_with_refs_commands;
foreach my $not_in_simple_text_command('xref', 'ref', 'pxref', 'inforef') {
delete $in_simple_text_commands{$not_in_simple_text_command};
}
# commands that only accept plain text, ie only accent, symbol and glyph commands
my %plain_text_commands = %contain_plain_text_commands;
# commands that only accept simple text as argument in any context.
my %simple_text_commands = %contain_simple_text_commands;
my %simple_text_with_refs_commands = (%sectioning_heading_commands,
%def_commands);
# commands that accept full text, but no block or top-level commands
my %full_text_commands;
foreach my $brace_command (keys (%brace_commands)) {
if ($brace_commands{$brace_command} eq 'style_code'
or $brace_commands{$brace_command} eq 'style_other'
or $brace_commands{$brace_command} eq 'style_no_code') {
$full_text_commands{$brace_command} = 1;
}
}
# commands that accept almost the same as in full text, except
# what does not make sense on a line.
my %full_line_commands;
$full_line_commands{'center'} = 1;
$full_line_commands{'exdent'} = 1;
$full_line_commands{'item'} = 1;
$full_line_commands{'itemx'} = 1;
# Fill the valid nestings hash. The keys are the containing commands and
# the values arrays of commands that are allowed to occur inside those
# commands. All commands not in this hash are considered to accept anything.
# There are additional context tests, to make sure, for instance that we are
# testing @-commands on the block, line or node @-command line and not
# in the content.
# Index entry commands are dynamically set as %in_simple_text_commands
my %default_valid_nestings;
foreach my $command (keys(%plain_text_commands)) {
$default_valid_nestings{$command} = \%in_plain_text_commands;
}
foreach my $command (keys(%simple_text_commands)) {
$default_valid_nestings{$command} = \%in_simple_text_commands;
}
foreach my $command (keys(%full_text_commands), keys(%full_line_commands)) {
$default_valid_nestings{$command} = \%in_full_text_commands;
}
foreach my $command (keys(%simple_text_with_refs_commands)) {
$default_valid_nestings{$command} = \%in_simple_text_with_refs_commands;
}
# @this* commands should not appear in any line command except for
# page heading specification commands and can also appear in brace @-commands,
# on heading specification commands lines, such as indicatric @-commands.
foreach my $in_heading_spec (keys(%in_heading_spec_commands)) {
foreach my $command (keys(%heading_spec_commands)) {
$default_valid_nestings{$command}->{$in_heading_spec} = 1
}
foreach my $brace_command (keys (%brace_commands)) {
if ($brace_commands{$brace_command} eq 'style_code'
or $brace_commands{$brace_command} eq 'style_other'
or $brace_commands{$brace_command} eq 'style_no_code') {
$default_valid_nestings{$brace_command}->{$in_heading_spec} = 1;
}
}
}
# default indices
my %index_names = %Texinfo::Commands::index_names;
# index names that cannot be set by the user.
my %forbidden_index_name = ();
foreach my $name (keys(%index_names)) {
$forbidden_index_name{$name} = 1;
if ($name =~ /^(.).$/) {
$forbidden_index_name{$1} = 1;
}
}
foreach my $index (keys(%index_names)) {
my $one_letter_prefix = substr($index, 0, 1);
foreach my $prefix ($index, $one_letter_prefix) {
$default_no_paragraph_commands{$prefix.'index'} = 1;
$default_valid_nestings{$prefix.'index'} = \%in_simple_text_commands;
}
}
foreach my $other_forbidden_index_name ('info','ps','pdf','htm',
'html', 'log','aux','dvi','texi','txi','texinfo','tex','bib') {
$forbidden_index_name{$other_forbidden_index_name} = 1;
}
my %canonical_texinfo_encodings;
# Valid encodings as described in the Texinfo manual
foreach my $canonical_encoding ('us-ascii', 'utf-8', 'iso-8859-1',
'iso-8859-15', 'iso-8859-2', 'koi8-r', 'koi8-u') {
$canonical_texinfo_encodings{$canonical_encoding} = 1;
}
# context_stack stack contexts in which an empty line doesn't trigger
# a paragraph
my %no_paragraph_contexts;
foreach my $no_paragraph_context ('math', 'preformatted', 'rawpreformatted',
'def', 'inlineraw') {
$no_paragraph_contexts{'ct_'.$no_paragraph_context} = 1;
};
# Interface and internal functions for input management
# initialization entry point. Set up a parser.
# The last argument, optional, is a hash provided by the user to change
# the default values for what is present in %parser_default_configuration.
sub parser(;$$)
{
my $conf = shift;
my $parser = dclone(\%parser_default_configuration);
bless $parser;
_setup_conf($parser, $conf);
# Initialize command hash that are dynamically modified, notably
# those for index commands, and definoenclose, based on defaults
$parser->{'line_commands'} = dclone(\%line_commands);
$parser->{'brace_commands'} = dclone(\%brace_commands);
$parser->{'valid_nestings'} = dclone(\%default_valid_nestings);
$parser->{'no_paragraph_commands'} = { %default_no_paragraph_commands };
$parser->{'index_names'} = dclone(\%index_names);
$parser->{'command_index'} = {%command_index};
$parser->{'close_paragraph_commands'} = {%close_paragraph_commands};
$parser->{'close_preformatted_commands'} = {%close_preformatted_commands};
# other initializations
$parser->{'definfoenclose'} = {};
# handle user provided state.
# Currently not done, as none of the user provided configuration
# keys of interest are in %parser_state_configuration. If this
# changes, the if (0) could be removed. However, this setting of
# configuration is also not handled by the XS parser, which is
# again in favor of keeping the code ignored.
if (0) {
# REMARK the following code will not be used for user defined state
# if the corresponding key is ignored in _setup_conf()
#
# a hash is simply concatenated. It should be like %index_names.
if (ref($parser->{'indices'}) eq 'HASH') {
%{$parser->{'index_names'}} = (%{$parser->{'index_names'}},
%{$parser->{'indices'}});
} else { # an array holds index names defined with @defindex
foreach my $name (@{$parser->{'indices'}}) {
$parser->{'index_names'}->{$name} = {'in_code' => 0};
}
}
foreach my $index (keys (%{$parser->{'index_names'}})) {
if (!exists($parser->{'index_names'}->{$index}->{'name'})) {
$parser->{'index_names'}->{$index}->{'name'} = $index;
}
if (!exists($parser->{'index_names'}->{$index}->{'contained_indices'})) {
$parser->{'index_names'}->{$index}->{'contained_indices'}->{$index} = 1;
}
foreach my $prefix ($index, substr($index, 0, 1)) {
$parser->{'line_commands'}->{$prefix.'index'} = 'line';
$parser->{'no_paragraph_commands'}->{$prefix.'index'} = 1;
$parser->{'valid_nestings'}->{$prefix.'index'} = \%in_simple_text_commands;
$parser->{'command_index'}->{$prefix.'index'} = $index;
}
}
if ($parser->{'merged_indices'}) {
foreach my $index_from (keys (%{$parser->{'merged_indices'}})) {
my $index_to = $parser->{'merged_indices'}->{$index_from};
if (defined($parser->{'index_names'}->{$index_from})
and defined($parser->{'index_names'}->{$index_to})) {
$parser->{'index_names'}->{$index_from}->{'merged_in'} = $index_to;
$parser->{'index_names'}->{$index_to}->{'contained_indices'}->{$index_from} = 1;
}
}
}
}
# following is common with simple_parser
$parser->_init_context_stack();
# turn the array to a hash for speed. Not sure it really matters for such
# a small array.
$parser->{'expanded_formats_hash'} = {};
foreach my $expanded_format(@{$parser->{'EXPANDED_FORMATS'}}) {
$parser->{'expanded_formats_hash'}->{$expanded_format} = 1;
}
if (not defined($parser->{'registrar'})) {
$parser->{'registrar'} = Texinfo::Report::new();
}
return $parser;
}
# simple parser initialization. The only difference with a regular parser
# is that the dynamical @-commands groups and indices information references
# that are initialized in each regular parser are initialized once for all
# and shared among simple parsers. It is used in gdt() and this has a sizable
# effect on performance.
my $simple_parser_line_commands = dclone(\%line_commands);
my $simple_parser_brace_commands = dclone(\%brace_commands);
my $simple_parser_valid_nestings = dclone(\%default_valid_nestings);
my $simple_parser_no_paragraph_commands = { %default_no_paragraph_commands };
my $simple_parser_index_names = dclone(\%index_names);
my $simple_parser_command_index = {%command_index};
my $simple_parser_close_paragraph_commands = {%close_paragraph_commands};
my $simple_parser_close_preformatted_commands = {%close_preformatted_commands};
sub simple_parser(;$)
{
my $conf = shift;
my $parser = dclone(\%parser_default_configuration);
bless $parser;
_setup_conf($parser, $conf);
$parser->{'line_commands'} = $simple_parser_line_commands;
$parser->{'brace_commands'} = $simple_parser_brace_commands;
$parser->{'valid_nestings'} = $simple_parser_valid_nestings;
$parser->{'no_paragraph_commands'} = $simple_parser_no_paragraph_commands;
$parser->{'index_names'} = $simple_parser_index_names;
$parser->{'command_index'} = $simple_parser_command_index;
$parser->{'close_paragraph_commands'} = $simple_parser_close_paragraph_commands;
$parser->{'close_preformatted_commands'} = $simple_parser_close_preformatted_commands;
# other initializations
$parser->{'definfoenclose'} = {};
$parser->_init_context_stack();
# turn the array to a hash for speed. Not sure it really matters for such
# a small array.
foreach my $expanded_format(@{$parser->{'EXPANDED_FORMATS'}}) {
$parser->{'expanded_formats_hash'}->{$expanded_format} = 1;
}
if (not defined($parser->{'registrar'})) {
$parser->{'registrar'} = Texinfo::Report::new();
}
return $parser;
}
sub get_conf($$)
{
my ($self, $var) = @_;
return $self->{$var};
}
# split a scalar text in an array lines.
sub _text_to_lines($)
{
my $text = shift;
die if (!defined($text));
my $had_final_end_line = chomp($text);
my $lines = [ map {$_."\n"} split (/\n/, $text, -1) ];
chomp($lines->[-1]) unless (!@$lines or $had_final_end_line);
return $lines;
}
# construct a text fragments with source information array matching
# a lines array, based on information supplied.
#
# If $FIRST_LINE is undef, no line numbers are set.
# Otherwise, if $FIXED_LINE_NUMBER is set the line number is not
# increased, else it is increased, beginning at $FIRST_LINE.
sub _complete_line_nr($$;$$$)
{
my ($lines, $first_line, $file, $macro, $fixed_line_number) = @_;
$macro = '' if (!defined($macro));
$file = '' if (!defined($file));
my $new_lines = [];
if (defined($first_line)) {
my $line_index = $first_line;
foreach my $index(0..scalar(@$lines)-1) {
$line_index = $index+$first_line if (!$fixed_line_number);
$new_lines->[$index] = [ $lines->[$index],
{ 'line_nr' => $line_index,
'file_name' => $file, 'macro' => $macro } ];
}
} else {
foreach my $line (@$lines) {
push @$new_lines, [ $line ];
}
}
return $new_lines;
}
sub _prepare_input_from_text($$;$$$$)
{
my ($self, $text, $lines_nr, $file, $macro, $fixed_line_number) = @_;
return 0 if (!defined($text));
if (ref($text) eq '') {
$text = _text_to_lines($text);
}
if (not defined($lines_nr)) {
$lines_nr = 1;
}
my $lines_array = _complete_line_nr($text, $lines_nr, $file,
$macro, $fixed_line_number);
$self->{'input'} = [{'pending' => $lines_array}];
return 1;
}
# entry point for text fragments.
# Used in some tests.
# To be in line with the XS Parser,
# $lines_nr should only be an integer and text a string.
# $file, $macro, $fixed_line_number should never be used.
sub parse_texi_piece($$;$$$$)
{
my ($self, $text, $lines_nr, $file, $macro, $fixed_line_number) = @_;
$self = parser() if (!defined($self));
return undef unless (_prepare_input_from_text($self, $text, $lines_nr, $file,
$macro, $fixed_line_number));
my ($document_root, $before_node_section)
= _setup_document_root_and_before_node_section();
my $tree = $self->_parse_texi($document_root, $before_node_section);
return $tree;
}
# To be in line with the XS Parser,
# $lines_nr should only be an integer and text a string.
# $file, $macro, $fixed_line_number should never be used.
sub parse_texi_line($$;$$$$)
{
my ($self, $text, $lines_nr, $file, $macro, $fixed_line_number) = @_;
$self = parser() if (!defined($self));
return undef unless (_prepare_input_from_text($self, $text, $lines_nr, $file,
$macro, $fixed_line_number));
my $root = {'type' => 'root_line'};
my $tree = $self->_parse_texi($root, $root);
return $tree;
}
# To be in line with the XS Parser,
# $lines_nr should only be an integer and text a string.
# $file, $macro, $fixed_line_number should never be used.
sub parse_texi_text($$;$$$$)
{
my ($self, $text, $lines_nr, $file, $macro, $fixed_line_number) = @_;
$self = parser() if (!defined($self));
return undef unless (_prepare_input_from_text($self, $text, $lines_nr, $file,
$macro, $fixed_line_number));
return $self->_parse_texi_document();
}
# $FILE_NAME the name of the opened file should be a binary string.
sub _open_in {
my ($self, $filehandle, $file_name) = @_;
if (open($filehandle, $file_name)) {
if (defined($self->{'info'}->{'input_perl_encoding'})) {
if ($self->{'info'}->{'input_perl_encoding'} eq 'utf-8') {
binmode($filehandle, ":utf8");
# Use :utf8 instead of :encoding(utf-8), as the latter does
# error checking and has (unreliably) led to fatal errors
# when reading the first few lines of e.g. Latin-1 or Shift-JIS
# files, even though @documentencoding is given early on in the file.
# Evidently Perl is checking ahead in the file.
} else {
binmode($filehandle, ":encoding($self->{'info'}->{'input_perl_encoding'})");
}
}
return 1;
} else {
return 0;
}
}
# parse a texi file
# $INPUT_FILE_PATH is the name of the parsed file and should be a binary string.
sub parse_texi_file($$)
{
my ($self, $input_file_path) = @_;
my $filehandle = do { local *FH };
if (!_open_in($self, $filehandle, $input_file_path)) {
my $input_file_name = $input_file_path;
my $encoding = $self->get_conf('COMMAND_LINE_ENCODING');
if (defined($encoding)) {
$input_file_name = decode($encoding, $input_file_path);
}
$self->{'registrar'}->document_error($self,
sprintf(__("could not open %s: %s"),
$input_file_name, $!));
return undef;
}
my ($file_name, $directories, $suffix) = fileparse($input_file_path);
$self = parser() if (!defined($self));
$self->{'info'}->{'input_file_name'} = $file_name;
$self->{'info'}->{'input_directory'} = $directories;
$self->{'input'} = [{
'pending' => [],
'input_file_info' => {
'file_name' => $file_name,
'line_nr' => 0,
},
'fh' => $filehandle
}];
return $self->_parse_texi_document();
}
sub _parse_texi_document($)
{
my $self = shift;
my ($document_root, $before_node_section)
= _setup_document_root_and_before_node_section();
# it should be set by the first _next_text() call, so no need
# to preset it to a more precise source_info structure.
my $source_info = undef;
# put the empty lines and the \input line in a container at the beginning
my $preamble_before_beginning;
while (1) {
my $line;
($line, $source_info) = _next_text($self, $source_info);
last if (!defined($line));
# non ascii spaces do not start content
if ($line =~ /^ *\\input/ or $line =~ /^\s*$/) {
if (not defined($preamble_before_beginning)) {
$preamble_before_beginning = {'type' => 'preamble_before_beginning',
'contents' => [], 'parent' => $before_node_section };
push @{$before_node_section->{'contents'}}, $preamble_before_beginning;
}
push @{$preamble_before_beginning->{'contents'}},
{ 'text' => $line,
'type' => 'text_before_beginning',
'parent' => $preamble_before_beginning };
} else {
# This line is not part of the preamble_before_beginning.
# Shove back into input stream.
unshift @{$self->{'input'}->[0]->{'pending'}}, [$line, $source_info];
last;
}
}
my $tree = $self->_parse_texi($document_root, $before_node_section);
Texinfo::Common::rearrange_tree_beginning($self, $before_node_section);
return $tree;
}
# return indices information
sub indices_information($)
{
my $self = shift;
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->{'commands_info'};
}
# @ dircategory_direntry
# perl_encoding
# input_encoding_name
# input_file_name
# input_directory
sub global_information($)
{
my $self = shift;
return $self->{'info'};
}
sub labels_information($)
{
my $self = shift;
return $self->{'labels'}, $self->{'targets'}, $self->{'nodes'};
}
sub registered_errors($)
{
my $self = shift;
return $self->{'registrar'};
}
sub _setup_conf($$)
{
my ($parser, $conf) = @_;
$parser->{'set'} = {};
if (defined($conf)) {
foreach my $key (keys(%$conf)) {
if (exists($parser_settable_configuration{$key})) {
#if ($key eq 'info') {
# # merge hashes prefering values from $conf
# $parser->{'info'} = { %{$parser->{'info'}}, %{$conf->{'info'}} };
#}
# we keep registrar instead of copying on purpose, to reuse the object
if ($key ne 'values' and $key ne 'registrar' and ref($conf->{$key})) {
$parser->{$key} = dclone($conf->{$key});
} else {
$parser->{$key} = $conf->{$key};
}
if ($initialization_overrides{$key}) {
$parser->{'set'}->{$key} = $parser->{$key};
}
} else {
warn "ignoring parser configuration value \"$key\"\n";
}
}
}
}
# Following are the internal parsing subroutines. The most important are
#
# _parse_texi: main entry point, loop on input lines.
# _process_remaining_on_line: the main parser loop.
# _end_line: called at an end of line. Handling of
# @include lines is done here.
# _next_text: present the next text fragment, from
# pending text or line.
# Taking an encoding name $ENCODING as argument, the function returns
# $canonical_texinfo_encoding: the corresponding canonical Texinfo encoding,
# as described in the Texinfo manual (or undef);
# $perl_encoding: an encoding name suitable for perl;
# $canonical_output_encoding: an encoding name suitable for most
# output formats, especially HTML.
sub _encoding_alias($)
{
my $encoding = shift;
my $Encode_encoding_object = find_encoding($encoding);
my ($perl_encoding, $canonical_output_encoding);
if (defined($Encode_encoding_object)) {
$perl_encoding = $Encode_encoding_object->name();
# mime_name() is upper-case, our keys are lower case, set to lower case
$canonical_output_encoding = lc($Encode_encoding_object->mime_name());
}
my $canonical_texinfo_encoding;
foreach my $possible_encoding ($encoding, $canonical_output_encoding,
$perl_encoding) {
if (defined($possible_encoding)
and $canonical_texinfo_encodings{lc($possible_encoding)}) {
$canonical_texinfo_encoding = $possible_encoding;
}
}
return ($canonical_texinfo_encoding, $perl_encoding, $canonical_output_encoding);
}
# context stack functions
sub _init_context_stack($)
{
my $self = shift;
$self->{'context_stack'} = ['_root'];
$self->{'context_command_stack'} = [''];
}
sub _push_context($$$)
{
my ($self, $context, $command) = @_;
push @{$self->{'context_stack'}}, $context;
push @{$self->{'context_command_stack'}}, $command;
}
# if needed it could be possible to guard against removing '_root' context
# but it is unlikely to be useful since the expected context is checked.
sub _pop_context($$$$;$)
{
my ($self, $expected_contexts, $source_info, $current, $message) = @_;
my $popped_context = pop @{$self->{'context_stack'}};
if (not grep {$_ eq $popped_context} @$expected_contexts) {
my $error_message = "context $popped_context instead of "
.join(" or ", @$expected_contexts);
$error_message .= "; $message" if (defined($message));
$self->_bug_message($error_message, $source_info, $current);
die;
}
my $popped_command = pop @{$self->{'context_command_stack'}};
}
sub _get_context_stack($)
{
my $self = shift;
(undef, my @context_stack) = @{$self->{'context_stack'}};
return @context_stack;
}
sub _top_context($)
{
my $self = shift;
return $self->{'context_stack'}->[-1];
}
# find first non undef command
sub _top_context_command($)
{
my $self = shift;
for (my $i = scalar(@{$self->{'context_command_stack'}}) -1; $i > 0; $i--) {
if (defined($self->{'context_command_stack'}->[$i])) {
return $self->{'context_command_stack'}->[$i];
}
}
return undef;
}
# register warnings and errors
sub _line_warn
{
my $self = shift;
my $registrar = $self->{'registrar'};
$registrar->line_warn($self, @_);
}
sub _line_error
{
my $self = shift;
my $registrar = $self->{'registrar'};
$registrar->line_error($self, @_);
}
# Format a bug message
sub _bug_message($$;$$)
{
my ($self, $message, $source_info, $current) = @_;
my $line_message = '';
if ($source_info) {
my $file = $source_info->{'file_name'};
$line_message
= "last location: $source_info->{'file_name'}:$source_info->{'line_nr'}";
if ($source_info->{'macro'} ne '') {
$line_message .= " (possibly involving $source_info->{'macro'})";
}
$line_message .= "\n";
}
my @context_stack = $self->_get_context_stack;
my $message_context_stack = "context_stack: (@context_stack)\n";
my $current_element_message = '';
if ($current) {
$current_element_message = "current: ". _print_current($current);
}
warn "You found a bug: $message\n\n".
"Additional information:\n".
$line_message.$message_context_stack.$current_element_message;
}
# for debugging
sub _print_current($)
{
my $current = shift;
return Texinfo::Common::debug_print_element($current);
}
# for debugging
sub _print_command_args_texi($)
{
my $current = shift;
return '' if (!$current->{'cmdname'});
my $args = '';
my $with_brace;
if ($current->{'args'} and @{$current->{'args'}}) {
$with_brace
= ($current->{'args'}->[0]->{'type'} eq 'brace_command_arg'
or $current->{'args'}->[0]->{'type'} eq 'brace_command_context');
$args .= '{' if ($with_brace);
foreach my $arg (@{$current->{'args'}}) {
$args .= Texinfo::Convert::Texinfo::convert_to_texinfo($arg).', ';
}
$args =~ s/, $//;
}
chomp($args);
if ($with_brace) {
$args .= '}';
}
return '@'.$current->{'cmdname'} .$args."\n";
}
sub _register_global_command {
my ($self, $current, $source_info) = @_;
my $command = $current->{'cmdname'};
if ($command eq 'summarycontents') {
$command = 'shortcontents';
}
if ($global_multiple_commands{$command}) {
push @{$self->{'commands_info'}->{$command}}, $current;
$current->{'source_info'} = $source_info if (!$current->{'source_info'});
return 1;
} elsif ($global_unique_commands{$command}) {
# setfilename ignored in an included file
$current->{'source_info'} = $source_info if (!$current->{'source_info'});
if ($command eq 'setfilename'
and scalar(@{$self->{'input'}}) > 1) {
} elsif (exists ($self->{'commands_info'}->{$current->{'cmdname'}})) {
$self->_line_warn(sprintf(__('multiple @%s'),
$current->{'cmdname'}), $source_info);
} else {
$self->{'commands_info'}->{$current->{'cmdname'}} = $current;
}
return 1;
}
return 0;
}
# parse a @macro line
sub _parse_macro_command_line($$$$$;$)
{
my ($self, $command, $line, $parent, $source_info) = @_;
my $macro = { 'cmdname' => $command, 'parent' => $parent,
'extra' => {'arg_line' => $line}, 'source_info' => $source_info };
# REMACRO
if ($line =~ /^\s+([[:alnum:]][[:alnum:]_-]*)\s*(.*)/) {
my $macro_name = $1;
my $args_def = $2;
my @args;
if ($args_def =~ s/^\s*{\s*(.*?)\s*}\s*//) {
@args = split(/\s*,\s*/, $1);
}
print STDERR "MACRO \@$command $macro_name\n" if ($self->{'DEBUG'});
$macro->{'args'} = [
{ 'type' => 'macro_name', 'text' => $macro_name,
'parent' => $macro } ];
foreach my $formal_arg (@args) {
push @{$macro->{'args'}},
{ 'type' => 'macro_arg', 'text' => $formal_arg,
'parent' => $macro};
if ($formal_arg !~ /^[\w\-]+$/) {
$self->_line_error(sprintf(__("bad or empty \@%s formal argument: %s"),
$command, $formal_arg), $source_info);
$macro->{'extra'}->{'invalid_syntax'} = 1;
}
}
# accept an @-command after the arguments in case there is a @c or
# @comment
if ($args_def =~ /^\s*[^\@]/) {
$self->_line_error(sprintf(__("bad syntax for \@%s argument: %s"),
$command, $args_def),
$source_info);
$macro->{'extra'}->{'invalid_syntax'} = 1;
}
} elsif ($line !~ /\S/) {
$self->_line_error(sprintf(
__("%c%s requires a name"), ord('@'), $command), $source_info);
$macro->{'extra'}->{'invalid_syntax'} = 1;
} else {
$self->_line_error(sprintf(
__("bad name for \@%s"), $command), $source_info);
$macro->{'extra'}->{'invalid_syntax'} = 1;
}
return $macro;
}
# start a paragraph if in a context where paragraphs are to be started.
sub _begin_paragraph($$;$)
{
my ($self, $current, $source_info) = @_;
# !$current->{'type'} is true for @-commands and for text without
# type nor command.
if ((!$current->{'type'} or $type_with_paragraph{$current->{'type'}})
and !$no_paragraph_contexts{$self->_top_context()}) {
# find whether an @indent precedes the paragraph
my $indent;
if ($current->{'contents'}) {
my $index = scalar(@{$current->{'contents'}}) -1;
while ($index >= 0
and !($current->{'contents'}->[$index]->{'type'}
and ($current->{'contents'}->[$index]->{'type'} eq 'empty_line'
or $current->{'contents'}->[$index]->{'type'} eq 'paragraph'))
and !($current->{'contents'}->[$index]->{'cmdname'}
and $self->{'close_paragraph_commands'}->{$current->{'contents'}->[$index]->{'cmdname'}})) {
if ($current->{'contents'}->[$index]->{'cmdname'}
and ($current->{'contents'}->[$index]->{'cmdname'} eq 'indent'
or $current->{'contents'}->[$index]->{'cmdname'} eq 'noindent')) {
$indent = $current->{'contents'}->[$index]->{'cmdname'};
last;
}
$index--;
}
}
push @{$current->{'contents'}},
{ 'type' => 'paragraph', 'parent' => $current };
$current = $current->{'contents'}->[-1];
if ($indent) {
$current->{'extra'} = {$indent => 1};
}
print STDERR "PARAGRAPH\n" if ($self->{'DEBUG'});
return $current;
}
return 0;
}
sub _begin_preformatted($$)
{
my ($self, $current) = @_;
if ($self->_top_context() eq 'ct_preformatted') {
push @{$current->{'contents'}},
{ 'type' => 'preformatted',
'parent' => $current };
$current = $current->{'contents'}->[-1];
print STDERR "PREFORMATTED\n" if ($self->{'DEBUG'});
}
return $current;
}
# wrapper around line_warn. Set source_info to be the source_info of
# the command, corresponding to the opening of the command.
# Call line_warn with sprintf if needed.
sub _command_warn($$$$;@)
{
my $self = shift;
my $current = shift;
my $source_info = shift;
my $message = shift;
if ($current->{'source_info'}) {
$source_info = $current->{'source_info'};
}
if (@_) {
$self->_line_warn(sprintf($message, @_), $source_info);
} else {
$self->_line_warn($message, $source_info);
}
}
sub _command_error($$$$;@)
{
my $self = shift;
my $current = shift;
my $source_info = shift;
my $message = shift;
# use the beginning of the @-command for the error message
# line number if available.
if ($current->{'source_info'}) {
$source_info = $current->{'source_info'};
}
if (@_) {
$self->_line_error(sprintf($message, @_), $source_info);
} else {
$self->_line_error($message, $source_info);
}
}
# register error messages, but otherwise doesn't do much more than
# return $_[1]->{'parent'}
sub _close_brace_command($$$;$$)
{
my ($self, $current, $source_info, $closed_block_command,
$interrupting_command) = @_;
if ($current->{'cmdname'} ne 'verb'
or $current->{'extra'}->{'delimiter'} eq '') {
if (defined($closed_block_command)) {
$self->_command_error($current, $source_info,
__("\@end %s seen before \@%s closing brace"),
$closed_block_command, $current->{'cmdname'});
} elsif (defined($interrupting_command)) {
$self->_command_error($current, $source_info,
__("\@%s seen before \@%s closing brace"),
$interrupting_command, $current->{'cmdname'});
} else {
$self->_command_error($current, $source_info,
__("%c%s missing closing brace"), ord('@'), $current->{'cmdname'});
}
} else {
$self->_command_error($current, $source_info,
__("\@%s missing closing delimiter sequence: %s}"),
$current->{'cmdname'}, $current->{'extra'}->{'delimiter'});
}
$current = $current->{'parent'};
return $current;
}
sub _in_preformatted_context_not_menu($)
{
my $self = shift;
for (my $i = scalar(@{$self->{'context_command_stack'}}) -1; $i > 0; $i--) {
my $context = $self->{'context_stack'}->[$i];
# allow going through line context, for @*table to find the
# outside context, and also assuming that they are in the same context
# in term of preformatted. Maybe def could be traversed too.
if ($context ne 'ct_line' and $context ne 'ct_preformatted') {
return 0;
}
my $command_name = $self->{'context_command_stack'}->[$i];
if (defined($command_name)
and (not $block_commands{$command_name} eq 'menu')
and $context eq 'ct_preformatted') {
return 1;
}
}
return 0;
}
sub _kbd_formatted_as_code($$)
{
my ($self, $current) = @_;
if ($self->{'kbdinputstyle'} eq 'code') {
return 1;
} elsif ($self->{'kbdinputstyle'} eq 'example') {
if ($self->_in_preformatted_context_not_menu()) {
return 0;
} else {
return 1;
}
}
return 0;
}
# close brace commands, that don't set a new context (ie @caption, @footnote)
sub _close_all_style_commands($$$;$$)
{
my ($self, $current, $source_info, $closed_block_command,
$interrupting_command) = @_;
while ($current->{'parent'} and $current->{'parent'}->{'cmdname'}
and exists($self->{'brace_commands'}->{$current->{'parent'}->{'cmdname'}})
and $self->{'brace_commands'}->{$current->{'parent'}->{'cmdname'}} ne 'context') {
print STDERR "CLOSING(_close_all_style_commands) \@$current->{'parent'}->{'cmdname'}\n"
if ($self->{'DEBUG'});
$current = _close_brace_command($self, $current->{'parent'}, $source_info,
$closed_block_command, $interrupting_command);
}
return $current;
}
# close brace commands except for @caption, @footnote then the paragraph
sub _end_paragraph($$$;$$)
{
my ($self, $current, $source_info, $closed_block_command,
$interrupting_command) = @_;
$current = _close_all_style_commands($self, $current, $source_info,
$closed_block_command, $interrupting_command);
if ($current->{'type'} and $current->{'type'} eq 'paragraph') {
print STDERR "CLOSE PARA\n" if ($self->{'DEBUG'});
$current = $current->{'parent'};
}
return $current;
}
# close brace commands except for @caption, @footnote then the preformatted
sub _end_preformatted($$$;$$)
{
my ($self, $current, $source_info, $closed_block_command,
$interrupting_command) = @_;
$current = _close_all_style_commands($self, $current, $source_info,
$closed_block_command, $interrupting_command);
if ($current->{'type'} and $current->{'type'} eq 'preformatted') {
print STDERR "CLOSE PREFORMATTED\n" if ($self->{'DEBUG'});
# completly remove void preformatted contexts
if (!$current->{'contents'}) {
my $removed = pop @{$current->{'parent'}->{'contents'}};
print STDERR "popping $removed->{'type'}\n" if ($self->{'DEBUG'});
}
$current = $current->{'parent'};
}
return $current;
}
# check that there are no text holding environment (currently
# checking only paragraphs and preformatted) in contents
sub _check_no_text($)
{
my $current = shift;
my $after_paragraph = 0;
foreach my $content (@{$current->{'contents'}}) {
if ($content->{'type'} and $content->{'type'} eq 'paragraph') {
$after_paragraph = 1;
last;
} elsif ($content->{'type'} and $content->{'type'} eq 'preformatted') {
foreach my $preformatted_content (@{$content->{'contents'}}) {
if ((defined($preformatted_content->{'text'})
and $preformatted_content->{'text'} =~ /\S/)
or ($preformatted_content->{'cmdname'}
and ($preformatted_content->{'cmdname'} ne 'c'
and $preformatted_content->{'cmdname'} ne 'comment')
and !($preformatted_content->{'type'}
and $preformatted_content->{'type'} eq 'index_entry_command'))) {
$after_paragraph = 1;
last;
}
}
last if ($after_paragraph);
}
}
return $after_paragraph;
}
# put everything after the last @item/@itemx in a table_item type container
# and distinguish table_term and table_entry.
sub _gather_previous_item($$;$$)
{
my ($self, $current, $next_command, $source_info) = @_;
# nothing to do in that case.
if ($current->{'contents'}->[-1]->{'type'}
and $current->{'contents'}->[-1]->{'type'} eq 'before_item') {
if ($next_command and $next_command eq 'itemx') {
$self->_line_warn(sprintf(__("\@itemx should not begin \@%s"),
$current->{'cmdname'}), $source_info);
}
return;
}
my $type;
# if before an itemx, the type is different since there should not be
# real content, so it may be treated differently
if ($next_command and $next_command eq 'itemx') {
$type = 'inter_item';
} else {
$type = 'table_item';
}
my $table_after_terms = {'type' => $type,
'contents' => []};
# remove everything that is not an @item/@itemx or before_item to
# put it in the table_item/inter_item, starting from the end.
my $contents_count = scalar(@{$current->{'contents'}});
for (my $i = 0; $i < $contents_count; $i++) {
if ($current->{'contents'}->[-1]->{'cmdname'}
and ($current->{'contents'}->[-1]->{'cmdname'} eq 'item'
or ($current->{'contents'}->[-1]->{'cmdname'} eq 'itemx'))) {
last;
} else {
my $item_content = pop @{$current->{'contents'}};
$item_content->{'parent'} = $table_after_terms;
unshift @{$table_after_terms->{'contents'}}, $item_content;
}
}
if ($type eq 'table_item') {
# setup a table_entry
my $table_entry = {'type' => 'table_entry',
'parent' => $current,
'contents' => []};
my $table_term = {'type' => 'table_term',
'parent' => $table_entry, };
push @{$table_entry->{'contents'}}, $table_term;
# put everything starting from the end until reaching the previous
# table entry or beginning of the table in table term.
my $contents_count = scalar(@{$current->{'contents'}});
for (my $i = 0; $i < $contents_count; $i++) {
if ($current->{'contents'}->[-1]->{'type'}
# reached the beginning of the table
and ($current->{'contents'}->[-1]->{'type'} eq 'before_item'
# reached the previous table entry
or $current->{'contents'}->[-1]->{'type'} eq 'table_entry')) {
last;
} else {
my $item_content = pop @{$current->{'contents'}};
$item_content->{'parent'} = $table_term;
unshift @{$table_term->{'contents'}}, $item_content;
# debug
if (! (($item_content->{'cmdname'}
and ($item_content->{'cmdname'} eq 'itemx'
or $item_content->{'cmdname'} eq 'item'))
or ($item_content->{'type'}
and $item_content->{'type'} eq 'inter_item'))) {
$self->_bug_message("wrong element in table term", $source_info,
$item_content);
}
}
}
push @{$current->{'contents'}}, $table_entry;
if (scalar(@{$table_after_terms->{'contents'}})) {
push @{$table_entry->{'contents'}}, $table_after_terms;
$table_after_terms->{'parent'} = $table_entry;
}
} else {
my $after_paragraph = _check_no_text($table_after_terms);
if ($after_paragraph) {
$self->_line_error(__("\@itemx must follow \@item"), $source_info);
}
if (scalar(@{$table_after_terms->{'contents'}})) {
push @{$current->{'contents'}}, $table_after_terms;
$table_after_terms->{'parent'} = $current;
}
}
}
# Starting from the end, gather everything util the def_line to put in
# a def_item
sub _gather_def_item($;$)
{
my ($current, $next_command) = @_;
my $type;
# means that we are between a @def*x and a @def
if ($next_command) {
$type = 'inter_def_item';
} else {
$type = 'def_item';
}
# This may happen for a construct like
# @deffnx a b @section
# but otherwise the end of line will lead to the command closing
return if (!$current->{'cmdname'} or $current->{'cmdname'} =~ /x$/);
my $def_item = {'type' => $type,
'parent' => $current,
'contents' => []};
# remove everything that is not a def_line to put it in the def_item,
# starting from the end.
my $contents_count = scalar(@{$current->{'contents'}});
for (my $i = 0; $i < $contents_count; $i++) {
if ($current->{'contents'}->[-1]->{'type'}
and $current->{'contents'}->[-1]->{'type'} eq 'def_line') {
last;
} else {
my $item_content = pop @{$current->{'contents'}};
$item_content->{'parent'} = $def_item;
unshift @{$def_item->{'contents'}}, $item_content;
}
}
if (scalar(@{$def_item->{'contents'}})) {
push @{$current->{'contents'}}, $def_item;
}
}
# close formats
sub _close_command_cleanup($$) {
my ($self, $current) = @_;
return unless ($current->{'cmdname'});
# remove the dynamic counters in multitable, they are not of use in the final
# tree. Also determine the multitable_body and multitable_head with
# @item or @headitem rows.
if ($current->{'cmdname'} eq 'multitable') {
my $in_head_or_rows;
my @contents = @{$current->{'contents'}};
$current->{'contents'} = [];
foreach my $row (@contents) {
if ($row->{'type'} and $row->{'type'} eq 'row') {
delete $row->{'cells_count'};
if ($row->{'contents'}->[0]->{'cmdname'} eq 'headitem') {
if (!$in_head_or_rows) {
push @{$current->{'contents'}}, {'type' => 'multitable_head',
'parent' => $current};
$in_head_or_rows = 1;
}
} elsif ($row->{'contents'}->[0]->{'cmdname'} eq 'item') {
if (!defined($in_head_or_rows) or $in_head_or_rows) {
push @{$current->{'contents'}}, {'type' => 'multitable_body',
'parent' => $current};
$in_head_or_rows = 0;
}
}
push @{$current->{'contents'}->[-1]->{'contents'}}, $row;
$row->{'parent'} = $current->{'contents'}->[-1];
} else {
push @{$current->{'contents'}}, $row;
$in_head_or_rows = undef;
}
}
delete $current->{'rows_count'};
} elsif ($block_commands{$current->{'cmdname'}}
and $block_commands{$current->{'cmdname'}} eq 'item_container') {
delete $current->{'items_count'};
}
# put everything after the last @def*x command in a def_item type container.
if ($def_commands{$current->{'cmdname'}}) {
# At this point the end command hasn't been added to the command contents.
# so checks cannot be done at this point.
_gather_def_item($current);
}
if ($block_commands{$current->{'cmdname'}}
and $block_commands{$current->{'cmdname'}} eq 'item_line') {
# At this point the end command hasn't been added to the command contents.
# so checks cannot be done at this point.
if (@{$current->{'contents'}}) {
_gather_previous_item($self, $current);
}
}
# put end out of before_item, and replace it at the end of the parent.
# remove empty before_item.
# warn if not empty before_item, but format is empty
if ($blockitem_commands{$current->{'cmdname'}}) {
if (@{$current->{'contents'}}) {
my $leading_spaces = 0;
my $before_item;
if ($current->{'contents'}->[0]->{'type'}
and $current->{'contents'}->[0]->{'type'} eq 'ignorable_spaces_after_command'
and $current->{'contents'}->[1]
and $current->{'contents'}->[1]->{'type'}
and $current->{'contents'}->[1]->{'type'} eq 'before_item') {
$leading_spaces = 1;
$before_item = $current->{'contents'}->[1];
} elsif ($current->{'contents'}->[0]->{'type'}
and $current->{'contents'}->[0]->{'type'} eq 'before_item') {
$before_item = $current->{'contents'}->[0];
}
if ($before_item) {
if ($before_item->{'contents'}
and scalar(@{$before_item->{'contents'}}) > 0
and @{$before_item->{'contents'}}
and $before_item->{'contents'}->[-1]->{'cmdname'}
and $before_item->{'contents'}->[-1]->{'cmdname'} eq 'end') {
my $end = pop @{$before_item->{'contents'}};
$end->{'parent'} = $current;
push @{$current->{'contents'}}, $end;
}
# remove empty before_items. Both conditions can happen, the first
# if the before item remained empty, the second if after removing end
# and spaces it became empty.
if (!$before_item->{'contents'} or
scalar(@{$before_item->{'contents'}}) == 0) {
if ($leading_spaces) {
my $space = shift @{$current->{'contents'}};
shift @{$current->{'contents'}};
unshift @{$current->{'contents'}}, $space;
} else {
shift @{$current->{'contents'}};
}
} else {
# warn if not empty before_item, but format is empty
my $empty_before_item = 1;
foreach my $before_item_content (@{$before_item->{'contents'}}) {
if (!$before_item_content->{'cmdname'} or
($before_item_content->{'cmdname'} ne 'c'
and $before_item_content->{'cmdname'} ne 'comment')) {
$empty_before_item = 0;
last;
}
}
if (!$empty_before_item) {
my $empty_format = 1;
foreach my $format_content (@{$current->{'contents'}}) {
next if ($format_content eq $before_item);
if (($format_content->{'cmdname'}
and ($format_content->{'cmdname'} ne 'c'
and $format_content->{'cmdname'} ne 'comment'
and $format_content->{'cmdname'} ne 'end'))
or ($format_content->{'type'} and
($format_content->{'type'} ne 'ignorable_spaces_after_command'))) {
$empty_format = 0;
last;
}
}
if ($empty_format) {
$self->_line_warn(sprintf(__("\@%s has text but no \@item"),
$current->{'cmdname'}), $current->{'source_info'});
}
}
}
}
}
}
}
sub _pop_block_command_contexts($$$;$)
{
my $self = shift;
my $current = shift;
my $source_info = shift;
my $context_string = shift;
if ($preformatted_commands{$current->{'cmdname'}}
or $block_commands{$current->{'cmdname'}} eq 'menu') {
$self->_pop_context(['ct_preformatted'], $source_info, $current,
$context_string);
} elsif ($block_commands{$current->{'cmdname'}} eq 'format_raw') {
$self->_pop_context(['ct_rawpreformatted'], $source_info, $current,
$context_string);
} elsif ($math_commands{$current->{'cmdname'}}) {
$self->_pop_context(['ct_math'], $source_info, $current,
$context_string);
} elsif ($block_commands{$current->{'cmdname'}} eq 'region') {
pop @{$self->{'regions_stack'}};
}
}
# close the current command, with error messages and give the parent.
# If the last argument is given it is the command being closed if
# hadn't there be an error, currently only block command, used for a
# better error message.
sub _close_current($$$;$$)
{
my ($self, $current, $source_info, $closed_block_command,
$interrupting_command) = @_;
if ($current->{'cmdname'}) {
print STDERR "CLOSING(_close_current) \@$current->{'cmdname'}\n"
if ($self->{'DEBUG'});
if (exists($self->{'brace_commands'}->{$current->{'cmdname'}})) {
if ($self->{'brace_commands'}->{$current->{'cmdname'}} eq 'context') {
my $expected_context;
if ($math_commands{$current->{'cmdname'}}) {
$expected_context = 'ct_math';
} else {
$expected_context = 'ct_brace_command';
}
$self->_pop_context([$expected_context], $source_info, $current);
}
$current = _close_brace_command($self, $current, $source_info,
$closed_block_command, $interrupting_command);
} elsif (exists($block_commands{$current->{'cmdname'}})) {
if (defined($closed_block_command)) {
$self->_line_error(sprintf(__("`\@end' expected `%s', but saw `%s'"),
$current->{'cmdname'}, $closed_block_command),
$source_info);
} elsif ($interrupting_command) {
$self->_line_error(sprintf(__("\@%s seen before \@end %s"),
$interrupting_command, $current->{'cmdname'}),
$source_info);
} else {
$self->_line_error(sprintf(__("no matching `%cend %s'"),
ord('@'), $current->{'cmdname'}),
$source_info);
if ($block_commands{$current->{'cmdname'}} eq 'conditional') {
# in this case we are within an ignored conditional
_pop_element_from_contents($current->{'parent'});
}
}
_pop_block_command_contexts($self, $current, $source_info);
# empty non-closed block commands at the end of the document
delete $current->{'contents'}
if ($current->{'contents'} and scalar(@{$current->{'contents'}}) == 0);
$current = $current->{'parent'};
} else {
# There @item and @tab commands are closed, and also line commands
# with invalid content
$current = $current->{'parent'};
}
} elsif ($current->{'type'}) {
print STDERR "CLOSING type $current->{'type'}\n" if ($self->{'DEBUG'});
if ($current->{'type'} eq 'bracketed') {
$self->_command_error($current, $source_info,
__("misplaced %c"), ord('{'));
if ($current->{'contents'}
and @{$current->{'contents'}}
and $current->{'contents'}->[0]->{'type'}
and $current->{'contents'}->[0]->{'type'}
eq 'internal_spaces_before_argument') {
# remove spaces element from tree and update extra values
_abort_empty_line($self, $current);
}
} elsif ($current->{'type'} eq 'menu_comment'
or $current->{'type'} eq 'menu_entry_description') {
# close empty menu_comment
if ($current->{'type'} eq 'menu_comment'
and !@{$current->{'contents'}}) {
pop @{$current->{'parent'}->{'contents'}};
}
} elsif ($current->{'type'} eq 'line_arg'
or $current->{'type'} eq 'block_line_arg') {
$self->_pop_context(['ct_line', 'ct_def'], $source_info, $current);
}
# empty types, not closed or associated to a command that is not closed
delete $current->{'contents'}
if ($current->{'contents'} and !@{$current->{'contents'}});
$current = $current->{'parent'};
} else { # Should never go here.
$current = $current->{'parent'} if ($current->{'parent'});
$self->_bug_message("No type nor cmdname when closing",
$source_info, $current);
}
return $current;
}
# a closed_command arg means closing until that command is found.
# no command arg means closing until the root or a root_command
# is found.
sub _close_commands($$$;$$)
{
my ($self, $current, $source_info, $closed_block_command,
$interrupting_command) = @_;
$current = _end_paragraph($self, $current, $source_info,
$closed_block_command, $interrupting_command);
$current = _end_preformatted($self, $current, $source_info,
$closed_block_command, $interrupting_command);
# stop if the command is found
while (!($closed_block_command and $current->{'cmdname'}
and $current->{'cmdname'} eq $closed_block_command)
# Stop if at the root
and $current->{'parent'}
# Stop if at a type at the root
and not ($current->{'type'}
and $current->{'type'} eq 'before_node_section')
# Stop if in a root command
# or in a context brace_commands and searching for a specific
# end block command (with $closed_block_command set).
# This second condition means that a footnote is not closed when
# looking for the end of a block command, but is closed when
# completly closing the stack.
and !($current->{'cmdname'}
and ($root_commands{$current->{'cmdname'}}
or ($closed_block_command and $current->{'parent'}->{'cmdname'}
and (exists($brace_commands{$current->{'parent'}->{'cmdname'}})
and $brace_commands{$current->{'parent'}->{'cmdname'}} eq 'context'))))) {
_close_command_cleanup($self, $current);
$current = _close_current($self, $current, $source_info, $closed_block_command,
$interrupting_command);
}
my $closed_element;
if ($closed_block_command and $current->{'cmdname'}
and $current->{'cmdname'} eq $closed_block_command) {
_pop_block_command_contexts($self, $current, $source_info,
"for $closed_block_command");
$closed_element = $current;
$current = $current->{'parent'};
} elsif ($closed_block_command) {
$self->_line_error(sprintf(__("unmatched `%c%s'"),
ord('@'), "end $closed_block_command"), $source_info);
}
return ($closed_element, $current);
}
# begin paragraph if needed. If not try to merge with the previous
# content if it is also some text.
# NOTE - this sub has an XS override
sub _merge_text {
my ($self, $current, $text) = @_;
my $paragraph;
my $no_merge_with_following_text = 0;
if ($text =~ /\S/) {
my $leading_spaces;
if ($text =~ /^(\s+)/) {
$leading_spaces = $1;
}
if ($current->{'contents'} and @{$current->{'contents'}}
and $current->{'contents'}->[-1]->{'type'}
and ($current->{'contents'}->[-1]->{'type'} eq 'ignorable_spaces_after_command'
or $current->{'contents'}->[-1]->{'type'} eq 'internal_spaces_after_command'
or $current->{'contents'}->[-1]->{'type'} eq 'internal_spaces_before_argument'
or $current->{'contents'}->[-1]->{'type'} eq 'spaces_after_close_brace')) {
$no_merge_with_following_text = 1;
}
if (_abort_empty_line($self, $current, $leading_spaces)) {
$text =~ s/^(\s+)//;
}
$paragraph = _begin_paragraph($self, $current);
$current = $paragraph if ($paragraph);
}
if (!defined($current->{'contents'})) {
# this can happen for preformatted since they do not have an initialized
# contents to match better the XS parser
#$self->_bug_message("No contents in _merge_text",
# undef, $current);
#cluck;
#die;
$current->{'contents'} = [];
}
if (!$no_merge_with_following_text
and @{$current->{'contents'}}
and exists($current->{'contents'}->[-1]->{'text'})
and $current->{'contents'}->[-1]->{'text'} !~ /\n/) {
$current->{'contents'}->[-1]->{'text'} .= $text;
print STDERR "MERGED TEXT: $text|||\n" if ($self->{'DEBUG'});
} else {
push @{$current->{'contents'}}, { 'text' => $text, 'parent' => $current };
print STDERR "NEW TEXT: $text|||\n" if ($self->{'DEBUG'});
}
return $current;
}
# return the parent if in a item_container command, itemize or enumerate
sub _item_container_parent($)
{
my $current = shift;
if ((($current->{'cmdname'} and $current->{'cmdname'} eq 'item')
or ($current->{'type'} and $current->{'type'} eq 'before_item'))
and ($current->{'parent'} and $current->{'parent'}->{'cmdname'}
and $block_commands{$current->{'parent'}->{'cmdname'}}
and $block_commands{$current->{'parent'}->{'cmdname'}} eq 'item_container')) {
return ($current->{'parent'});
}
return undef;
}
# return the parent if in a item_line command, @*table
sub _item_line_parent($)
{
my $current = shift;
if ($current->{'type'} and $current->{'type'} eq 'before_item'
and $current->{'parent'}) {
$current = $current->{'parent'};
}
return $current if ($current->{'cmdname'}
and $block_commands{$current->{'cmdname'}}
and $block_commands{$current->{'cmdname'}} eq 'item_line');
return undef;
}
# return the parent if in a multitable
sub _item_multitable_parent($)
{
my $current = shift;
if (($current->{'cmdname'} and ($current->{'cmdname'} eq 'headitem'
or $current->{'cmdname'} eq 'item' or $current->{'cmdname'} eq 'tab'))
and $current->{'parent'} and $current->{'parent'}->{'parent'}) {
$current = $current->{'parent'}->{'parent'};
} elsif ($current->{'type'} and $current->{'type'} eq 'before_item'
and $current->{'parent'}) {
$current = $current->{'parent'};
}
return $current if ($current->{'cmdname'}
and $current->{'cmdname'} eq 'multitable');
return undef;
}
sub _encode_file_name($$)
{
my ($self, $file_name) = @_;
my $encoding;
my $input_file_name_encoding = $self->get_conf('INPUT_FILE_NAME_ENCODING');
if ($input_file_name_encoding) {
$encoding = $input_file_name_encoding;
} elsif ($self->get_conf('DOC_ENCODING_FOR_INPUT_FILE_NAME')) {
$encoding = $self->{'info'}->{'input_perl_encoding'};
} else {
$encoding = $self->get_conf('LOCALE_ENCODING');
}
return Texinfo::Common::encode_file_name($file_name, $encoding);
}
sub _save_line_directive
{
my ($self, $line_nr, $file_name) = @_;
my $input = $self->{'input'}->[0];
return if !$input;
$input->{'input_file_info'}->{'line_nr'} = $line_nr if $line_nr;
# need to convert to bytes for file name
if (defined($file_name)) {
my ($encoded_file_name, $file_name_encoding)
= _encode_file_name($self, $file_name);
$input->{'input_file_info'}->{'file_name'} = $encoded_file_name;
}
}
# returns next text fragment with source information, be it
# pending from a macro expansion or pending text, or read from file.
sub _next_text($$)
{
my ($self, $source_info) = @_;
while (@{$self->{'input'}}) {
my $input = $self->{'input'}->[0];
if (@{$input->{'pending'}}) {
my $new_text_and_info = shift @{$input->{'pending'}};
if ($new_text_and_info->[1] and $new_text_and_info->[1]->{'end_macro'}) {
delete $new_text_and_info->[1]->{'end_macro'};
my $top_macro = shift @{$self->{'macro_stack'}};
print STDERR "SHIFT MACRO_STACK(@{$self->{'macro_stack'}}): $top_macro->{'args'}->[0]->{'text'}\n"
if ($self->{'DEBUG'});
}
# corresponds to (line, new source_info)
return ($new_text_and_info->[0], $new_text_and_info->[1]);
} elsif ($input->{'fh'}) {
my $input_error = 0;
local $SIG{__WARN__} = sub {
my $message = shift;
print STDERR "$input->{'input_file_info'}->{'file_name'}" . ":"
. ($input->{'input_file_info'}->{'line_nr'} + 1)
. ": input error: $message";
$input_error = 1;
};
my $fh = $input->{'fh'};
my $line = <$fh>;
if (defined($line)) {
if ($input_error) {
# possible encoding error. attempt to recover by stripping out
# non-ASCII bytes. there may not be that many in the file.
Encode::_utf8_off($line);
$line =~ s/[\x80-\xFF]//g;
}
# add an end of line if there is none at the end of file
if (eof($fh) and $line !~ /\n/) {
$line .= "\n";
}
# DEL as comment character
$line =~ s/\x{7F}.*\s*//;
$input->{'input_file_info'}->{'line_nr'}++;
my $new_source_info = {
'line_nr' => $input->{'input_file_info'}->{'line_nr'},
'file_name' => $input->{'input_file_info'}->{'file_name'},
'macro' => ''};
return ($line, $new_source_info);
}
}
my $previous_input = shift(@{$self->{'input'}});
# Don't close STDIN
if ($previous_input->{'fh'}
and $previous_input->{'input_file_info'}->{'file_name'} ne '-') {
if (!close($previous_input->{'fh'})) {
# need to decode for error message
my $file_name_encoding;
if (defined($previous_input->{'file_name_encoding'})) {
$file_name_encoding = $previous_input->{'file_name_encoding'};
} else {
$file_name_encoding = $self->get_conf('COMMAND_LINE_ENCODING');
}
my $file_name = $previous_input->{'input_file_info'}->{'file_name'};
if (defined($file_name_encoding)) {
$file_name = decode($file_name_encoding, $file_name);
}
$self->{'registrar'}->document_warn($self,
sprintf(__("error on closing %s: %s"),
$file_name, $!));
}
}
}
return (undef, $source_info);
}
# collect text and line numbers until an end of line is found.
sub _new_line($$)
{
my ($self, $source_info) = @_;
my $new_line = '';
while (1) {
my $new_text;
($new_text, $source_info) = _next_text($self, $source_info);
if (!defined($new_text)) {
$new_line = undef if ($new_line eq '');
last;
}
$new_line .= $new_text;
my $chomped_text = $new_text;
last if chomp($chomped_text);
}
return ($new_line, $source_info);
}
# $MACRO is the element in the tree defining the macro.
sub _expand_macro_arguments($$$$)
{
my ($self, $macro, $line, $source_info) = @_;
my $braces_level = 1;
my $arguments = [ '' ];
my $arg_nr = 0;
my $args_total = scalar(@{$macro->{'args'}}) -1;
my $name = $macro->{'args'}->[0]->{'text'};
my $source_info_orig = $source_info;
while (1) {
if ($line =~ s/([^\\{},]*)([\\{},])//) {
my $separator = $2;
$arguments->[-1] .= $1;
if ($separator eq '\\') {
if ($line =~ s/^(.)//) {
my $protected_char = $1;
if ($protected_char !~ /[\\{},]/) {
$arguments->[-1] .= '\\';
}
$arguments->[-1] .= $protected_char;
print STDERR "MACRO ARG: $separator: $protected_char\n" if ($self->{'DEBUG'});
} else {
$arguments->[-1] .= '\\';
print STDERR "MACRO ARG: $separator\n" if ($self->{'DEBUG'});
}
} elsif ($separator eq ',') {
if ($braces_level == 1) {
if (scalar(@$arguments) < $args_total) {
push @$arguments, '';
$line =~ s/^\s*//;
print STDERR "MACRO NEW ARG\n" if ($self->{'DEBUG'});
} else {
# implicit quoting when there is one argument.
if ($args_total != 1) {
$self->_line_error(sprintf(__(
"macro `%s' called with too many args"),
$name), $source_info);
}
$arguments->[-1] .= ',';
}
} else {
$arguments->[-1] .= ',';
}
} elsif ($separator eq '}') {
$braces_level--;
last if ($braces_level == 0);
$arguments->[-1] .= $separator;
} elsif ($separator eq '{') {
$braces_level++;
$arguments->[-1] .= $separator;
}
} else {
print STDERR "MACRO ARG end of line\n" if ($self->{'DEBUG'});
$arguments->[-1] .= $line;
($line, $source_info) = _new_line($self, $source_info);
if (!defined($line)) {
$self->_line_error(sprintf(__("\@%s missing closing brace"),
$name), $source_info_orig);
return ($arguments, "\n", $source_info);
}
}
}
if ($args_total == 0 and $arguments->[0] ne '') {
$self->_line_error(sprintf(__(
"macro `%s' declared without argument called with an argument"),
$name), $source_info);
}
print STDERR "END MACRO ARGS EXPANSION(".scalar(@$arguments)."): ".
join("|\n", @$arguments) ."|\n" if ($self->{'DEBUG'});
return ($arguments, $line, $source_info);
}
sub _lookup_macro_parameter($$) {
my $macro = shift;
my $name = shift;
my $args_total = scalar(@{$macro->{'element'}->{'args'}}) -1;
if ($args_total > 0) {
my $arg_index;
# the first argument is the macro name
for ($arg_index=1; $arg_index<=$args_total; $arg_index++) {
if (defined($macro->{'element'}->{'args'}->[$arg_index])
and $macro->{'element'}->{'args'}->[$arg_index]->{'text'} eq $name) {
return $arg_index - 1;
}
}
}
return undef
}
# $MACRO is a member of $self->{'macros'}.
sub _expand_macro_body($$$$) {
my ($self, $macro, $args, $source_info) = @_;
my $macrobody = $macro->{'macrobody'};
my $result = '';
while ($macrobody ne '') {
if ($macrobody =~ s/^([^\\]*)\\//o) {
$result .= $1;
if ($macrobody =~ s/^\\//) {
$result .= '\\';
} elsif ($macrobody =~ s/^([^\\]*)\\//) {
my $arg = $1;
my $formal_arg_index = _lookup_macro_parameter($macro, $arg);
if (defined($formal_arg_index)) {
if ($formal_arg_index < scalar(@$args)) {
$result .= $args->[$formal_arg_index];
}
} else {
$self->_line_error(sprintf(__(
"\\ in \@%s expansion followed `%s' instead of parameter name or \\"),
$macro->{'element'}->{'args'}->[0]->{'text'}, $arg), $source_info);
$result .= '\\' . $arg;
}
}
next;
}
$result .= $macrobody;
last;
}
return $result;
}
# turn spaces that are ignored before @-commands like @sortas{} and
# @seeentry{} back to regular spaces if there is content after the @-command
sub _set_non_ignored_space_in_index_before_command($)
{
my $contents = shift;
my $pending_spaces_element = 0;
foreach my $content (@$contents) {
if ($content->{'type'}
and $content->{'type'} eq 'internal_spaces_before_brace_in_index') {
# set to "spaces_at_end" in case there are only spaces after
$content->{'type'} = 'spaces_at_end';
$pending_spaces_element = $content;
} elsif ($pending_spaces_element
and not (($content->{'cmdname'}
and $in_index_commands{$content->{'cmdname'}}
and defined($brace_commands{$content->{'cmdname'}}))
or ($content->{'type'}
and $content->{'type'} eq 'spaces_after_close_brace'))
and (! _check_empty_expansion([$content]))) {
delete $pending_spaces_element->{'type'};
$pending_spaces_element = 0;
}
}
}
sub _pop_element_from_contents($)
{
my $parent_element = shift;
my $popped_element = pop @{$parent_element->{'contents'}};
delete $parent_element->{'contents'}
if (scalar(@{$parent_element->{'contents'}}) == 0);
return $popped_element;
}
# each time a new line appeared, a container is opened to hold the text
# consisting only of spaces. This container is removed here, typically
# this is called when non-space happens on a line.
# NOTE - this sub has an XS override
sub _abort_empty_line {
my ($self, $current, $additional_spaces) = @_;
$additional_spaces = '' if (!defined($additional_spaces));
if ($current->{'contents'} and @{$current->{'contents'}}
and $current->{'contents'}->[-1]->{'type'}
and ($current->{'contents'}->[-1]->{'type'} eq 'empty_line'
or $current->{'contents'}->[-1]->{'type'} eq 'ignorable_spaces_after_command'
or $current->{'contents'}->[-1]->{'type'} eq 'internal_spaces_after_command'
or $current->{'contents'}->[-1]->{'type'} eq 'internal_spaces_before_argument'
or $current->{'contents'}->[-1]->{'type'} eq 'spaces_after_close_brace')) {
my $spaces_element = $current->{'contents'}->[-1];
print STDERR "ABORT EMPTY "
.$spaces_element->{'type'}
." additional text |$additional_spaces|,"
." current |$spaces_element->{'text'}|\n"
if ($self->{'DEBUG'});
$spaces_element->{'text'} .= $additional_spaces;
# remove empty 'empty*before'. Happens in many situations.
if ($spaces_element->{'text'} eq '') {
_pop_element_from_contents($current);
} elsif ($spaces_element->{'type'} eq 'empty_line') {
# exactly the same condition as to begin a paragraph
if ((!$current->{'type'} or $type_with_paragraph{$current->{'type'}})
and !$no_paragraph_contexts{$self->_top_context()}) {
$spaces_element->{'type'} = 'spaces_before_paragraph';
} else {
delete $spaces_element->{'type'};
}
} elsif ($spaces_element->{'type'} eq 'internal_spaces_after_command'
or $spaces_element->{'type'} eq 'internal_spaces_before_argument') {
# Remove element from main tree. It will still be referenced in
# the 'extra' hash as 'spaces_before_argument'.
_pop_element_from_contents($current);
my $owning_element
= $spaces_element->{'extra'}->{'spaces_associated_command'};
#$owning_element->{'extra'} = {} if (! $owning_element->{'extra'});
$owning_element->{'extra'}->{'spaces_before_argument'}
= $spaces_element->{'text'};
}
return 1;
}
return 0;
}
sub _isolate_trailing_space($$)
{
my $current = shift;
my $spaces_type = shift;
if ($current->{'contents'}->[-1]->{'text'} !~ /\S/) {
$current->{'contents'}->[-1]->{'type'} = $spaces_type;
} else {
if ($current->{'contents'}->[-1]->{'text'} =~ s/(\s+)$//) {
my $new_spaces = { 'text' => $1, 'parent' => $current,
'type' => $spaces_type };
push @{$current->{'contents'}}, $new_spaces;
}
}
}
# isolate last space in a command to help expansion disregard unuseful spaces.
sub _isolate_last_space
{
my ($self, $current) = @_;
return if (!$current->{'contents'});
# Store a final comment command in the 'extra' hash.
if (scalar(@{$current->{'contents'}}) >= 1
and $current->{'contents'}->[-1]->{'cmdname'}
and ($current->{'contents'}->[-1]->{'cmdname'} eq 'c'
or $current->{'contents'}->[-1]->{'cmdname'} eq 'comment')) {
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'comment_at_end'}
= _pop_element_from_contents($current);
# TODO: @c should probably not be allowed inside most brace commands
# as this would be difficult to implement properly in TeX.
}
return if !$current->{'contents'}
or !defined($current->{'contents'}->[-1]->{'text'})
or ($current->{'contents'}->[-1]->{'type'}
and (!$current->{'type'}
or ($current->{'type'} ne 'line_arg'
and $current->{'type'} ne 'block_line_arg')))
or $current->{'contents'}->[-1]->{'text'} !~ /\s+$/;
if ($current->{'type'} and $current->{'type'} eq 'menu_entry_node') {
_isolate_trailing_space($current, 'space_at_end_menu_node');
} else {
# Store final spaces in 'spaces_after_argument'.
#$current->{'extra'} = {} if (!$current->{'extra'});
if ($current->{'contents'}->[-1]->{'text'} !~ /\S/) {
$current->{'extra'}->{'spaces_after_argument'}
= $current->{'contents'}->[-1]->{'text'};
_pop_element_from_contents($current);
} else {
$current->{'contents'}->[-1]->{'text'} =~ s/(\s+)$//;
$current->{'extra'}->{'spaces_after_argument'} = $1;
}
}
}
# $LABEL_CONTENTS_CONTAINER->{'contents'} is the Texinfo for the
# specification of a node.
# Returned $parsed_node_manual object is a hash with two fields:
#
# manual_content - Texinfo tree for a manual name extracted from the
# node specification.
# node_content - Texinfo tree for the node name on its own
#
# retrieve a leading manual name in parentheses, if there is one
# and modify the $LABEL_CONTENTS_CONTAINER contents to be consistent
# with $parsed_node_manual.
sub _parse_node_manual($)
{
my $label_contents_container = shift;
my ($parsed_node_manual, $modified_node_content)
= Texinfo::Common::parse_node_manual($label_contents_container);
$label_contents_container->{'contents'} = $modified_node_content
if ($modified_node_content);
return $parsed_node_manual;
}
sub _parse_float_type($)
{
my $current = shift;
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'type'} = {};
if ($current->{'args'} and @{$current->{'args'}}
and $current->{'args'}->[0]->{'contents'}) {
my $normalized
= Texinfo::Convert::Texinfo::convert_to_texinfo(
{'contents' => $current->{'args'}->[0]->{'contents'}});
$current->{'extra'}->{'type'}->{'content'} =
$current->{'args'}->[0]->{'contents'};
$current->{'extra'}->{'type'}->{'normalized'} = $normalized;
return 1;
}
$current->{'extra'}->{'type'}->{'normalized'} = '';
return 0;
}
# split non-space text elements into strings without [ ] ( ) , and single
# character strings with one of them
sub _split_delimiters
{
my ($self, $root) = @_;
if (defined $root->{'type'} # 'spaces' for spaces
or !defined $root->{'text'}) {
return $root;
} else {
my @elements;
my $type;
my $chars = quotemeta '[](),';
my $text = $root->{'text'};
while (1) {
if ($text =~ s/^([^$chars]+)//) {
push @elements, {'text' => $1, 'parent' => $root->{'parent'}};
} elsif ($text =~ s/^([$chars])//) {
push @elements, {'text' => $1, 'type' => 'delimiter',
'parent' => $root->{'parent'}};
} else {
last;
}
}
return @elements;
}
}
# split text elements into whitespace and non-whitespace
sub _split_def_args
{
my ($self, $root) = @_;
if ($root->{'type'} and $root->{'type'} eq 'spaces_inserted') {
return $root;
} elsif (defined $root->{'text'}) {
my @elements;
my $type;
# FIXME how to handle non ascii space in def*? As space or argument?
my @split_text = split /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $root->{'text'};
if ($split_text[0] =~ /^\s*$/) {
$type = 'spaces';
}
for my $t (@split_text) {
my $e = {'text' => $t };
if ($type) {
$e->{'type'} = $type;
$type = undef;
} else {
$type = 'spaces';
}
$e->{'parent'} = $root->{'parent'};
push @elements, $e;
}
return @elements;
} elsif ($root->{'type'} and $root->{'type'} eq 'bracketed') {
_isolate_last_space($self, $root);
$root->{'type'} = 'bracketed_def_content';
}
return $root;
}
# definition line parsing
sub _parse_def($$$)
{
my ($self, $command, $current) = @_;
return [] if (!$current->{'contents'});
my $contents = $current->{'contents'};
my @new_contents;
my @contents = @$contents;
# could have used def_aliases, but use code more similar with the XS parser
if ($def_alias_commands{$command}) {
my $real_command = $def_aliases{$command};
my $prepended = $def_map{$command}->{$real_command};
my $bracketed = { 'type' => 'bracketed_inserted',
'parent' => $current };
my $content = { 'text' => $prepended, 'parent' => $bracketed };
# the prepended string is an english string (such as Function). If
# documentlanguage is set it needs to be translated during the conversion.
if (defined($self->{'documentlanguage'})) {
$content->{'type'} = 'untranslated';
$content->{'extra'} = {'documentlanguage' => $self->{'documentlanguage'}};
}
@{$bracketed->{'contents'}} = ($content);
unshift @contents, $bracketed,
{ 'text' => ' ', 'type' => 'spaces_inserted',
'parent' => $current,
};
$command = $def_aliases{$command};
}
@contents = map (_split_def_args($self, $_), @contents );
@new_contents = @contents;
$current->{'contents'} = \@new_contents;
my @result;
my @args = @{$def_map{$command}};
my $arg_type;
$arg_type = pop @args if ($args[-1] eq 'arg' or $args[-1] eq 'argtype');
# If $arg_type is not set (for @def* commands that are not documented
# to take args), everything happens as if arg_type was set to 'arg'.
# Fill in everything up to the args, collecting adjacent non-whitespace
# elements into a single element, e.g 'a@i{b}c'.
my $argument_content = [];
my $arg = shift (@args);
my $i = 0; # the offset in @new_contents of $token
while (@contents) {
my $token = $contents[0];
# finish previous item
if ( $token->{'type'}
and ($token->{'type'} eq 'spaces'
or $token->{'type'} eq 'spaces_inserted'
or $token->{'type'} eq 'bracketed_def_content'
or $token->{'type'} eq 'bracketed_inserted'
or $token->{'type'} eq 'delimiter')) {
# we create a {'contents' =>} only if there is more than one
# content gathered.
if (scalar(@$argument_content)) {
if (scalar(@$argument_content) > 1) {
my $e = {'contents' => $argument_content,
'type' => 'def_aggregate',
'parent' => $current };
push @result, [$arg, $e];
# Replace in the main tree.
splice @new_contents,
$i - scalar(@$argument_content),
scalar(@$argument_content),
$e;
for my $e2 (@$argument_content) {
$e2->{'parent'} = $e;
}
$i -= scalar(@$argument_content) - 1;
} elsif (scalar(@$argument_content) == 1) {
push @result, [$arg, $argument_content->[0]];
}
$argument_content = [];
if ($token->{'type'} eq 'spaces'
or $token->{'type'} eq 'spaces_inserted') {
$arg = shift (@args);
}
}
}
if ($token->{'type'} and ($token->{'type'} eq 'bracketed_def_content'
or $token->{'type'} eq 'bracketed_inserted')) {
push @result, [$arg, $token];
shift @contents;
$arg = shift (@args);
} elsif ($token->{'type'}
and ($token->{'type'} eq 'spaces'
or $token->{'type'} eq 'spaces_inserted')) {
if ($token->{'text'}) {
if ($token->{'text'} =~ /\n$/) {
$token->{'type'} = 'spaces_at_end';
}
push @result, ['spaces', $token];
shift @contents;
} else {
$i++;
last;
}
} elsif ($token->{'type'} and $token->{'type'} eq 'delimiter') {
push @result, ['delimiter', shift @contents];
} else {
my $text_or_cmd = shift @contents;
push @$argument_content, $text_or_cmd;
}
$i++;
last if (! defined($arg));
}
if (scalar(@$argument_content) > 1) {
my $e = {'contents' => $argument_content,
'type' => 'def_aggregate' };
push @result, [$arg, $e];
# Replace in the main tree.
splice @new_contents, $i - scalar(@$argument_content),
scalar(@$argument_content), $e;
} elsif (scalar(@$argument_content) == 1) {
push @result, [$arg, $argument_content->[0]];
}
if (scalar(@contents) > 0) {
splice @new_contents, -scalar(@contents);
}
@contents = map (_split_delimiters($self, $_), @contents );
@new_contents = (@new_contents, @contents);
# Create the part of the def_args array for any arguments.
my @args_results;
while (@contents) {
my $spaces;
my $next_token = shift @contents;
if ($next_token->{'type'} and $next_token->{'type'} eq 'spaces') {
$spaces = $next_token;
$next_token = shift @contents;
}
if (defined($spaces)) {
if ($spaces->{'text'} =~ /\n$/) {
$spaces->{'type'} = 'spaces_at_end';
}
push @args_results, ['spaces', $spaces]
}
last if (!defined($next_token));
if ($next_token->{'type'} and $next_token->{'type'} eq 'delimiter') {
push @args_results, ['delimiter', $next_token];
} else {
push @args_results, ['arg', $next_token];
}
}
# If a command like @deftypefn, mark the type arguments
if ($arg_type and $arg_type eq 'argtype') {
my $next_is_type = 1;
foreach my $arg(@args_results) {
if ($arg->[0] eq 'spaces') {
} elsif ($arg->[0] eq 'delimiter') {
$next_is_type = 1;
} elsif ($arg->[1]->{'cmdname'} and $arg->[1]->{'cmdname'} ne 'code') {
$next_is_type = 1;
} elsif ($next_is_type) {
$arg->[0] = 'typearg';
$next_is_type = 0;
} else {
$next_is_type = 1;
}
}
}
for my $pair (@result, @args_results) {
#$pair->[1]->{'extra'} = {} if (!$pair->[1]->{'extra'});
$pair->[1]->{'extra'}->{'def_role'} = $pair->[0];
}
return [@result, @args_results];
}
# register a label, that is something that may be the target of a reference
# and must be unique in the document. Corresponds to @node, @anchor and
# @float second arg.
sub _register_label($$$)
{
my ($targets_list, $current, $label) = @_;
Texinfo::Common::register_label($targets_list, $current, $label);
}
# store an index entry.
# $COMMAND_CONTAINER is the name of the @-command the index entry
# is associated with, for instance 'cindex', 'defivar' or 'vtable'.
# $CURRENT is the command element.
# $CONTENT holds the actual content. For index entries and v|ftable
# items, it is the index entry content, for def, it is the parsed
# arguments, based on the definition line arguments.
sub _enter_index_entry($$$$$$$)
{
my ($self, $command_container, $command, $current, $content,
$content_normalized, $source_info) = @_;
$content_normalized = $content if (!defined($content_normalized));
my $index_name = $self->{'command_index'}->{$command_container};
my $index = $self->{'index_names'}->{$index_name};
if (!defined($index->{'index_entries'})) {
$index->{'index_entries'} = [];
}
my $number = scalar(@{$index->{'index_entries'}}) + 1;
# FIXME index_type_command does not seems to be used anywhere.
# It appears in test results tree, so maybe it is worth keeping
# it to be able to understand changes.
my $index_entry = { 'index_name' => $index_name,
'index_at_command' => $command,
'index_type_command' => $command_container,
'entry_content' => $content,
'content_normalized' => $content_normalized,
'entry_element' => $current,
'entry_number' => $number,
'index_ignore_chars' => {},
};
# gather set txiindex*ignore information
foreach my $set_variable (keys(%set_flag_index_char_ignore)) {
if (exists($self->{'values'}->{$set_variable})) {
my $ignored_char = $set_flag_index_char_ignore{$set_variable};
$index_entry->{'index_ignore_chars'}->{$ignored_char} = 1;
}
}
if (defined $current->{'extra'}->{'sortas'}) {
$index_entry->{'sortas'} = $current->{'extra'}->{'sortas'};
}
if (@{$self->{'regions_stack'}}) {
$index_entry->{'entry_region'} = $self->{'regions_stack'}->[-1];
} elsif ($self->{'current_node'}) {
$index_entry->{'entry_node'} = $self->{'current_node'};
} elsif (!$self->{'current_section'}) {
$self->_line_warn(sprintf(__("entry for index `%s' outside of any node"),
$index_name), $source_info);
}
push @{$index->{'index_entries'}}, $index_entry;
$current->{'extra'}->{'index_entry'} = $index_entry;
}
# Used for file names and index sort strings to allow including the special
# Texinfo characters but not other command nor element type.
sub _convert_to_text {
my $e = shift;
my ($text, $superfluous_arg) = ('', 0);
return ($text, $superfluous_arg)
unless($e->{'contents'});
for my $c (@{$e->{'contents'}}) {
# Allow @@, @{ and @} to give a way for @, { and } to appear in
# filenames (although it's not a good idea to use these characters
# in filenames).
if (defined $c->{'text'}) {
$text .= $c->{'text'};
} elsif ($c->{'cmdname'}
and ($c->{'cmdname'} eq '@'
or $c->{'cmdname'} eq 'atchar')) {
$text .= '@';
} elsif ($c->{'cmdname'}
and ($c->{'cmdname'} eq '{'
or $c->{'cmdname'} eq 'lbracechar')) {
$text .= '{';
} elsif ($c->{'cmdname'}
and ($c->{'cmdname'} eq '}'
or $c->{'cmdname'} eq 'rbracechar')) {
$text .= '}';
} else {
$superfluous_arg = 1;
}
}
return ($text, $superfluous_arg);
}
# close constructs and do stuff at end of line (or end of the document)
sub _end_line($$$);
sub _end_line($$$)
{
my ($self, $current, $source_info) = @_;
my $current_old = $current;
# a line consisting only of spaces.
if ($current->{'contents'} and @{$current->{'contents'}}
and $current->{'contents'}->[-1]->{'type'}
and $current->{'contents'}->[-1]->{'type'} eq 'empty_line') {
print STDERR "END EMPTY LINE\n" if ($self->{'DEBUG'});
if ($current->{'type'} and $current->{'type'} eq 'paragraph') {
my $empty_line = pop @{$current->{'contents'}};
$current = _end_paragraph($self, $current, $source_info);
push @{$current->{'contents'}}, $empty_line;
$empty_line->{'parent'} = $current;
} elsif ($current->{'type'}
and $current->{'type'} eq 'preformatted'
and $current->{'parent'}->{'type'}
and $current->{'parent'}->{'type'} eq 'menu_entry_description') {
my $empty_line = pop @{$current->{'contents'}};
my $preformatted = $current;
$current = $current->{'parent'};
if (! scalar(@{$preformatted->{'contents'}})) {
_pop_element_from_contents($current);
}
# first parent is menu_entry
$current = $current->{'parent'}->{'parent'};
push @{$current->{'contents'}}, { 'type' => 'menu_comment',
'parent' => $current,
'contents' => [] };
$current = $current->{'contents'}->[-1];
push @{$current->{'contents'}}, { 'type' => 'preformatted',
'parent' => $current,
'contents' => [] };
$current = $current->{'contents'}->[-1];
push @{$current->{'contents'}}, { 'type' => 'after_menu_description_line',
'text' => $empty_line->{'text'},
'parent' => $current };
print STDERR "MENU: END DESCRIPTION, OPEN COMMENT\n" if ($self->{'DEBUG'});
} elsif (!$no_paragraph_contexts{$self->_top_context()}) {
$current = _end_paragraph($self, $current, $source_info);
}
# end of a menu line.
} elsif ($current->{'type'}
and ($current->{'type'} eq 'menu_entry_name'
or $current->{'type'} eq 'menu_entry_node')) {
my $empty_menu_entry_node = 0;
my $end_comment;
if ($current->{'type'} eq 'menu_entry_node') {
if (@{$current->{'contents'}}
and $current->{'contents'}->[-1]->{'cmdname'}
and ($current->{'contents'}->[-1]->{'cmdname'} eq 'c'
or $current->{'contents'}->[-1]->{'cmdname'} eq 'comment')) {
$end_comment = pop @{$current->{'contents'}};
}
if (!@{$current->{'contents'}}
# empty if only the end of line or spaces, including non ascii spaces
or (@{$current->{'contents'}} == 1
and defined($current->{'contents'}->[-1]->{'text'})
and $current->{'contents'}->[-1]->{'text'} !~ /\S/)) {
$empty_menu_entry_node = 1;
push @{$current->{'contents'}}, $end_comment if ($end_comment);
}
}
# we abort the menu entry if there is no node name
if ($empty_menu_entry_node or $current->{'type'} eq 'menu_entry_name') {
my $description_or_menu_comment;
my $menu_type_reopened = 'menu_description';
print STDERR "FINALLY NOT MENU ENTRY\n" if ($self->{'DEBUG'});
my $menu = $current->{'parent'}->{'parent'};
my $menu_entry = pop @{$menu->{'contents'}};
if (@{$menu->{'contents'}} and $menu->{'contents'}->[-1]->{'type'}
and $menu->{'contents'}->[-1]->{'type'} eq 'menu_entry') {
my $entry = $menu->{'contents'}->[-1];
my $description;
foreach my $entry_element (reverse(@{$entry->{'args'}})) {
if ($entry_element->{'type'} eq 'menu_entry_description') {
$description = $entry_element;
last;
}
}
if ($description) {
$description_or_menu_comment = $description;
} else {
# Normally this cannot happen
$self->_bug_message("No description in menu_entry",
$source_info, $current);
push @{$entry->{'args'}}, {'type' => 'menu_entry_description',
'parent' => $entry, };
$description_or_menu_comment = $entry->{'args'}->[-1];
}
} elsif (@{$menu->{'contents'}} and $menu->{'contents'}->[-1]->{'type'}
and $menu->{'contents'}->[-1]->{'type'} eq 'menu_comment') {
$description_or_menu_comment = $menu->{'contents'}->[-1];
$menu_type_reopened = 'menu_comment';
}
if ($description_or_menu_comment) {
$current = $description_or_menu_comment;
if ($current->{'contents'}->[-1]
and $current->{'contents'}->[-1]->{'type'}
and $current->{'contents'}->[-1]->{'type'} eq 'preformatted') {
$current = $current->{'contents'}->[-1];
} else {
# this should not happen
$self->_bug_message("description or menu comment not in preformatted",
$source_info, $current);
push @{$current->{'contents'}}, {'type' => 'preformatted',
'parent' => $current, };
$current = $current->{'contents'}->[-1];
}
} else {
push @{$menu->{'contents'}}, {'type' => 'menu_comment',
'parent' => $menu,
'contents' => [] };
$current = $menu->{'contents'}->[-1];
push @{$current->{'contents'}}, {'type' => 'preformatted',
'parent' => $current, };
$current = $current->{'contents'}->[-1];
print STDERR "THEN MENU_COMMENT OPEN\n" if ($self->{'DEBUG'});
}
while (@{$menu_entry->{'args'}}) {
my $arg = shift @{$menu_entry->{'args'}};
if (defined($arg->{'text'})) {
$current = _merge_text($self, $current, $arg->{'text'});
} elsif ($arg->{'contents'}) {
while (@{$arg->{'contents'}}) {
my $content = shift @{$arg->{'contents'}};
if (defined($content->{'text'})) {
$current = _merge_text($self, $current, $content->{'text'});
$content = undef;
} else {
$content->{'parent'} = $current;
push @{$current->{'contents'}}, $content;
}
}
}
$arg = undef;
}
# MENU_COMMENT open
$menu_entry = undef;
} else {
print STDERR "MENU ENTRY END LINE\n" if ($self->{'DEBUG'});
$current = $current->{'parent'};
$current = _enter_menu_entry_node($self, $current, $source_info);
if (defined($end_comment)) {
$end_comment->{'parent'} = $current;
push @{$current->{'contents'}}, $end_comment;
}
}
# def line
} elsif ($current->{'parent'}
and $current->{'parent'}->{'type'}
and $current->{'parent'}->{'type'} eq 'def_line') {
$self->_pop_context(['ct_def'], $source_info, $current);
# in case there are no arguments at all, it needs to be called here.
_abort_empty_line($self, $current);
my $def_command = $current->{'parent'}->{'extra'}->{'def_command'};
my $arguments = _parse_def($self, $def_command, $current);
if (scalar(@$arguments)) {
#$current->{'parent'}->{'extra'}->{'def_args'} = $arguments;
my $def_parsed_hash = {};
foreach my $arg (@$arguments) {
die if (!defined($arg->[0]));
last if ($arg->[0] eq 'arg' or $arg->[0] eq 'typearg'
or $arg->[0] eq 'delimiter');
next if ($arg->[0] eq 'spaces');
$def_parsed_hash->{$arg->[0]} = $arg->[1];
}
$current->{'parent'}->{'extra'}->{'def_parsed_hash'} = $def_parsed_hash;
# do a standard index entry tree
my $index_entry;
if (defined($def_parsed_hash->{'name'})) {
$index_entry = $def_parsed_hash->{'name'}
# empty bracketed
unless ($def_parsed_hash->{'name'}->{'type'}
and $def_parsed_hash->{'name'}->{'type'} eq 'bracketed_def_content'
and (!$def_parsed_hash->{'name'}->{'contents'}
or (!scalar(@{$def_parsed_hash->{'name'}->{'contents'}}))
or (scalar(@{$def_parsed_hash->{'name'}->{'contents'}}) == 1
and defined($def_parsed_hash->{'name'}->{'contents'}->[0]->{'text'})
and $def_parsed_hash->{'name'}->{'contents'}->[0]->{'text'} !~ /\S/)));
}
if (defined($index_entry)) {
my $index_contents_normalized;
if ($def_parsed_hash->{'class'}) {
# Delay getting the text until Texinfo::Structuring::sort_index_keys
# in order to avoid using gdt.
# We need to store the language as well in case there are multiple
# languages in the document.
if ($command_index{$def_command} eq 'fn'
or $command_index{$def_command} eq 'vr'
and $def_command ne 'defcv') {
undef $index_entry;
if (defined($self->{'documentlanguage'})) {
$current->{'parent'}->{'extra'}->{'documentlanguage'}
= $self->{'documentlanguage'};
}
}
}
my $index_contents;
if ($index_entry) {
$index_contents_normalized = [$index_entry];
$index_contents = [$index_entry];
}
_enter_index_entry($self,
$current->{'parent'}->{'extra'}->{'def_command'},
$current->{'parent'}->{'extra'}->{'original_def_cmdname'},
$current->{'parent'}, $index_contents,
$index_contents_normalized, $source_info);
} else {
$self->_command_warn($current->{'parent'}, $source_info,
__('missing name for @%s'),
$current->{'parent'}->{'extra'}->{'original_def_cmdname'});
}
} else {
$self->_command_warn($current->{'parent'}, $source_info,
__('missing category for @%s'),
$current->{'parent'}->{'extra'}->{'original_def_cmdname'});
}
$current = $current->{'parent'}->{'parent'};
$current = _begin_preformatted($self, $current);
# other block command lines
} elsif ($current->{'type'}
and $current->{'type'} eq 'block_line_arg') {
my $empty_text;
$self->_pop_context(['ct_line'], $source_info, $current,
'in block_line_arg');
# @multitable args
if ($current->{'parent'}->{'cmdname'}
and $current->{'parent'}->{'cmdname'} eq 'multitable') {
# parse the prototypes and put them in a special arg
my @prototype_row;
foreach my $content (@{$current->{'contents'}}) {
if ($content->{'type'} and $content->{'type'} eq 'bracketed') {
my $bracketed_prototype
= { 'type' => 'bracketed_multitable_prototype' };
$bracketed_prototype->{'contents'} = $content->{'contents'}
if ($content->{'contents'});
push @prototype_row, $bracketed_prototype;
} elsif ($content->{'text'}) {
# TODO: this should be a warning or an error - all prototypes
# on a @multitable line should be in braces, as documented in the
# Texinfo manual.
if ($content->{'text'} =~ /\S/) {
foreach my $prototype (split /\s+/, $content->{'text'}) {
push @prototype_row, { 'text' => $prototype,
'type' => 'row_prototype' }
unless ($prototype eq '');
}
}
} else {
if (!$content->{'cmdname'}
or ($content->{'cmdname'} ne 'c'
and $content->{'cmdname'} ne 'comment')) {
$self->_command_warn($current, $source_info,
__("unexpected argument on \@%s line: %s"),
$current->{'parent'}->{'cmdname'},
Texinfo::Convert::Texinfo::convert_to_texinfo($content));
}
}
}
my $multitable = $current->{'parent'};
#$multitable->{'extra'} = {} if (!$multitable->{'extra'});
$multitable->{'extra'}->{'max_columns'} = scalar(@prototype_row);
if (!scalar(@prototype_row)) {
$self->_command_warn($multitable, $source_info,
__("empty multitable"));
}
$multitable->{'extra'}->{'prototypes'} = \@prototype_row;
}
_isolate_last_space($self, $current);
$current = $current->{'parent'};
delete $current->{'remaining_args'};
# @float args
if ($current->{'cmdname'} and $current->{'cmdname'} eq 'float') {
$current->{'source_info'} = $source_info;
my $type = '';
my $float_label;
if ($current->{'args'} and $current->{'args'}->[1]) {
$float_label = _parse_node_manual($current->{'args'}->[1]);
_check_internal_node($self, $float_label, $source_info);
}
_register_label($self->{'targets'}, $current, $float_label);
_parse_float_type($current);
$type = $current->{'extra'}->{'type'}->{'normalized'};
push @{$self->{'floats'}->{$type}}, $current;
$current->{'extra'}->{'float_section'} = $self->{'current_section'}
if (defined($self->{'current_section'}));
}
# all the commands with @item
if ($current->{'cmdname'}
and $blockitem_commands{$current->{'cmdname'}}) {
if ($current->{'cmdname'} eq 'enumerate') {
my $spec = '1';
if ($current->{'args'} and $current->{'args'}->[0]
and $current->{'args'}->[0]->{'contents'}
and @{$current->{'args'}->[0]->{'contents'}}) {
if (scalar(@{$current->{'args'}->[0]->{'contents'}}) > 1) {
$self->_command_error($current, $source_info,
__("superfluous argument to \@%s"),
$current->{'cmdname'});
}
my $arg = $current->{'args'}->[0]->{'contents'}->[0];
if (!defined($arg->{'text'})
or $arg->{'text'} !~ /^(([[:digit:]]+)|([[:alpha:]]+))$/) {
$self->_command_error($current, $source_info,
__("bad argument to \@%s"),
$current->{'cmdname'});
} else {
$spec = $arg->{'text'};
}
}
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'enumerate_specification'} = $spec;
} elsif ($block_commands{$current->{'cmdname'}} eq 'item_line') {
if (!$current->{'extra'}
or !$current->{'extra'}->{'command_as_argument'}) {
$self->_command_error($current, $source_info,
__("%s requires an argument: the formatter for %citem"),
$current->{'cmdname'}, ord('@'));
} elsif ($self->{'brace_commands'}->{
$current->{'extra'}->{'command_as_argument'}->{'cmdname'}} eq 'noarg') {
$self->_command_error($current, $source_info,
__("command \@%s not accepting argument in brace should not be on \@%s line"),
$current->{'extra'}->{'command_as_argument'}->{'cmdname'},
$current->{'cmdname'});
delete $current->{'extra'}->{'command_as_argument'};
}
} elsif ($current->{'cmdname'} eq 'itemize'
and $current->{'extra'}
and $current->{'extra'}->{'command_as_argument'}) {
# This code checks that the command_as_argument of the @itemize
# is alone on the line, otherwise it is not a command_as_argument.
my @args = @{$current->{'args'}->[0]->{'contents'}};
while (@args) {
my $arg = shift @args;
last if ($arg eq $current->{'extra'}->{'command_as_argument'});
}
while (@args) {
my $arg = shift @args;
if (!(($arg->{'cmdname'}
and ($arg->{'cmdname'} eq 'c'
or $arg->{'cmdname'} eq 'comment'))
or (defined($arg->{'text'}) and $arg->{'text'} !~ /\S/))) {
delete $current->{'extra'}->{'command_as_argument'}->{'type'};
delete $current->{'extra'}->{'command_as_argument'};
last;
}
}
}
if ($current->{'extra'}
and $current->{'extra'}->{'command_as_argument'}
and $accent_commands{$current->{'extra'}->{'command_as_argument'}->{'cmdname'}}
and ($current->{'cmdname'} eq 'itemize'
or ($block_commands{$current->{'cmdname'}}
and $block_commands{$current->{'cmdname'}} eq 'item_line'))) {
# this can only happen to an accent command with brace, if without
# brace it is not set as command_as_argument to begin with.
$self->_command_warn($current, $source_info,
__("accent command `\@%s' not allowed as \@%s argument"),
$current->{'extra'}->{'command_as_argument'}->{'cmdname'},
$current->{'cmdname'});
delete $current->{'extra'}->{'command_as_argument'};
}
if ($current->{'cmdname'} eq 'itemize') {
if ((!$current->{'args'}
or !$current->{'args'}->[0]
or !$current->{'args'}->[0]->{'contents'}
or !@{$current->{'args'}->[0]->{'contents'}})) {
my $block_line_arg;
if ($current->{'args'} and $current->{'args'}->[-1]
and $current->{'args'}->[-1]->{'type'}
and $current->{'args'}->[-1]->{'type'} eq 'block_line_arg') {
$block_line_arg = $current->{'args'}->[-1];
} else {
$block_line_arg = { 'type' => 'block_line_arg',
'parent' => $current,
'contents' => [] };
unshift @{$current->{'args'}}, $block_line_arg;
}
my $inserted = { 'cmdname' => 'bullet',
'type' => 'command_as_argument_inserted',
'parent' => $block_line_arg };
unshift @{$block_line_arg->{'contents'}}, $inserted;
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'command_as_argument'} = $inserted;
}
} elsif ($block_commands{$current->{'cmdname'}}
and $block_commands{$current->{'cmdname'}} eq 'item_line') {
#$current->{'extra'} = {} if (!$current->{'extra'});
if (!$current->{'extra'}->{'command_as_argument'}) {
my $inserted = { 'cmdname' => 'asis',
'type' => 'command_as_argument_inserted',
'parent' => $current };
unshift @{$current->{'args'}}, $inserted;
$current->{'extra'}->{'command_as_argument'} = $inserted;
}
}
push @{$current->{'contents'}}, { 'type' => 'before_item',
'parent', $current };
$current = $current->{'contents'}->[-1];
}
if ($current->{'cmdname'}
and $block_commands{$current->{'cmdname'}} eq 'menu') {
push @{$current->{'contents'}}, {'type' => 'menu_comment',
'parent' => $current,
'contents' => [] };
$current = $current->{'contents'}->[-1];
print STDERR "MENU_COMMENT OPEN\n" if ($self->{'DEBUG'});
}
if ($current->{'cmdname'}
and $block_commands{$current->{'cmdname'}} eq 'format_raw'
and $self->{'expanded_formats_hash'}->{$current->{'cmdname'}}) {
push @{$current->{'contents'}},
{ 'type' => 'rawpreformatted',
'parent' => $current };
$current = $current->{'contents'}->[-1];
}
$current = _begin_preformatted($self, $current)
unless ($current->{'cmdname'}
and $block_commands{$current->{'cmdname'}} eq 'raw');
# misc command line arguments
# Never go here if skipline/noarg/...
} elsif ($current->{'type'} and $current->{'type'} eq 'line_arg') {
$self->_pop_context(['ct_line'], $source_info, $current, 'in line_arg');
_isolate_last_space($self, $current);
# first parent is the @command, second is the parent
$current = $current->{'parent'};
my $misc_cmd = $current;
my $command = $current->{'cmdname'};
my $end_command;
print STDERR "MISC END \@$command: $self->{'line_commands'}->{$command}\n"
if ($self->{'DEBUG'});
if ($self->{'line_commands'}->{$command} eq 'specific') {
my $args = _parse_line_command_args($self, $current, $source_info);
$current->{'extra'}->{'misc_args'} = $args if (defined($args));
} elsif ($self->{'line_commands'}->{$command} eq 'text') {
my ($text, $superfluous_arg)
= _convert_to_text($current->{'args'}->[0]);
#$current->{'extra'} = {} if (!$current->{'extra'});
if ($text eq '') {
if (not $superfluous_arg) {
$self->_command_warn($current, $source_info,
__("\@%s missing argument"), $command);
}
# if there is superfluous arg, a more suitable error is issued below.
$current->{'extra'}->{'missing_argument'} = 1;
} else {
$current->{'extra'}->{'text_arg'} = $text;
if ($command eq 'end') {
# REMACRO
my $remaining_on_line = $text;
if ($remaining_on_line =~ s/^([[:alnum:]][[:alnum:]-]*)//) {
$end_command = $1;
if (!exists $block_commands{$end_command}) {
$self->_command_warn($current, $source_info,
__("unknown \@end %s"), $end_command);
$end_command = undef;
} else {
print STDERR "END BLOCK $end_command\n" if ($self->{'DEBUG'});
if ($block_commands{$end_command} eq 'conditional') {
if (@{$self->{'conditionals_stack'}}
and $self->{'conditionals_stack'}->[-1] eq $end_command) {
pop @{$self->{'conditionals_stack'}};
} else {
$self->_command_error($current, $source_info,
__("unmatched `%c%s'"), ord('@'), 'end');
$end_command = undef;
}
}
}
# non-ASCII spaces are also superfluous arguments.
# If there is superfluous text after @end argument, set
# $superfluous_arg such that the error message triggered by an
# unexpected @-command on the @end line is issued below. Note
# that $superfluous_arg may also be true if it was set above.
if ($end_command and $remaining_on_line =~ /\S/) {
$superfluous_arg = 1;
}
# if $superfluous_arg is set there is a similar and somewhat
# better error message below
} elsif (!$superfluous_arg) {
$self->_command_error($current, $source_info,
__("bad argument to \@%s: %s"),
$command, $remaining_on_line);
}
} elsif ($superfluous_arg) {
# @-command effects are ignored, an error message is issued below.
} elsif ($command eq 'include') {
# We want Perl binary strings representing sequences of bytes,
# not character strings of codepoints in the internal perl encoding.
my ($file_name, $file_name_encoding) = _encode_file_name($self, $text);
my $file = Texinfo::Common::locate_include_file($self, $file_name);
if (defined($file)) {
my $filehandle = do { local *FH };
if (_open_in ($self, $filehandle, $file)) {
print STDERR "Included $file($filehandle)\n" if ($self->{'DEBUG'});
my ($directories, $suffix);
($file, $directories, $suffix) = fileparse($file);
unshift @{$self->{'input'}}, {
'input_file_info' => {'file_name' => $file,
'line_nr' => 0,
},
'file_name_encoding' => $file_name_encoding,
'pending' => [],
'fh' => $filehandle };
# TODO note that it is bytes. No reason to have it used much
# Make sure to document that it is bytes.
# TODO add $file_name_encoding information?
$current->{'extra'}->{'file'} = $file;
# we set the type to replaced to tell converters not to
# expand the @-command
$current->{'type'} = 'replaced';
} else {
# FIXME $text does not show the include directory. Using $file
# would require to decode it to perl internal codepoints with
# $file_name_encoding
$self->_command_error($current, $source_info,
__("\@%s: could not open %s: %s"),
$command, $text, $!);
}
} else {
$self->_command_error($current, $source_info,
__("\@%s: could not find %s"),
$command, $text);
}
} elsif ($command eq 'verbatiminclude') {
$current->{'extra'}->{'input_perl_encoding'}
= $self->{'info'}->{'input_perl_encoding'}
if defined $self->{'info'}->{'input_perl_encoding'};
} elsif ($command eq 'documentencoding') {
my ($texinfo_encoding, $perl_encoding, $input_encoding)
= _encoding_alias($text);
$self->_command_warn($current, $source_info,
__("encoding `%s' is not a canonical texinfo encoding"),
$text)
if (!$texinfo_encoding or $texinfo_encoding ne lc($text));
if ($input_encoding) {
$current->{'extra'}->{'input_encoding_name'} = $input_encoding;
}
if (!$perl_encoding) {
$self->_command_warn($current, $source_info,
__("unrecognized encoding name `%s'"), $text);
} else {
$current->{'extra'}->{'input_perl_encoding'} = $perl_encoding;
if ($input_encoding) {
$self->{'info'}->{'input_encoding_name'} = $input_encoding;
}
$self->{'info'}->{'input_perl_encoding'} = $perl_encoding;
foreach my $input (@{$self->{'input'}}) {
binmode($input->{'fh'}, ":encoding($perl_encoding)")
if ($input->{'fh'});
}
}
} elsif ($command eq 'documentlanguage') {
my @messages = Texinfo::Common::warn_unknown_language($text);
foreach my $message(@messages) {
$self->_command_warn($current, $source_info, $message);
}
if (!$self->{'set'}->{'documentlanguage'}) {
$self->{'documentlanguage'} = $text;
}
}
}
if ($superfluous_arg) {
# note that the argument to expand replaced @-commands is
# set, such that @include that are removed from the tree
# with type set to replaced are still shown in error messages.
my $texi_line
= Texinfo::Convert::Texinfo::convert_to_texinfo($current->{'args'}->[0], 1);
$texi_line =~ s/^\s*//;
$texi_line =~ s/\s*$//;
$self->_command_error($current, $source_info,
__("bad argument to \@%s: %s"),
$command, $texi_line);
}
} elsif ($command eq 'node') {
#$current->{'extra'} = {} if (!$current->{'extra'});
foreach my $arg (@{$current->{'args'}}) {
my $node = _parse_node_manual($arg);
push @{$current->{'extra'}->{'nodes_manuals'}}, $node;
}
_check_internal_node($self, $current->{'extra'}->{'nodes_manuals'}->[0],
$source_info);
_register_label($self->{'targets'}, $current,
$current->{'extra'}->{'nodes_manuals'}->[0]);
if ($self->{'current_part'}) {
my $part = $self->{'current_part'};
if (not $part->{'extra'}
or not $part->{'extra'}->{'part_associated_section'}) {
# we only associate a part to the following node if the
# part is not already associate to a sectioning command,
# but the part can be associated to the sectioning command later
# if a sectioning command follows the node.
$current->{'extra'}->{'node_preceding_part'} = $part;
$part->{'extra'}->{'part_following_node'} = $current;
}
}
$self->{'current_node'} = $current;
} elsif ($command eq 'listoffloats') {
_parse_float_type($current);
} else {
# Handle all the other 'line' commands. Here just check that they
# have an argument. Empty @top is allowed
if (!$current->{'args'}->[0]->{'contents'} and $command ne 'top') {
$self->_command_warn($current, $source_info,
__("\@%s missing argument"), $command);
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'missing_argument'} = 1;
} else {
if (($command eq 'item' or $command eq 'itemx')
and $current->{'parent'}->{'cmdname'}
and $self->{'command_index'}->{$current->{'parent'}->{'cmdname'}}) {
_enter_index_entry($self, $current->{'parent'}->{'cmdname'},
$command, $current,
$current->{'args'}->[0]->{'contents'},
undef, $source_info);
} elsif ($self->{'command_index'}->{$current->{'cmdname'}}) {
_enter_index_entry($self, $current->{'cmdname'},
$current->{'cmdname'}, $current,
$current->{'args'}->[0]->{'contents'},
undef, $source_info);
$current->{'type'} = 'index_entry_command';
}
# if there is a brace command interrupting an index or subentry
# command, replace the internal internal_spaces_before_brace_in_index
# text type with its final type depending on whether there is
# text after the brace command.
if (_is_index_element($self, $current)) {
if (defined($current->{'extra'}->{'sortas'})
or defined($current->{'extra'}->{'seealso'})
or defined($current->{'extra'}->{'seeentry'})) {
_set_non_ignored_space_in_index_before_command(
$current->{'args'}->[0]->{'contents'});
}
}
}
}
$current = $current->{'parent'};
if ($end_command) {
print STDERR "END COMMAND $end_command\n" if ($self->{'DEBUG'});
# reparent to block command
my $end = _pop_element_from_contents($current);
if ($block_commands{$end_command} ne 'conditional') {
# here close some empty types. Typically empty preformatted
# that would have been closed anyway in _close_commands, but
# also other types (rawpreformatted, before_item), some which
# may also have been closed anyway.
if (not defined($current->{'cmdname'}) and $current->{'type'}
and !$current->{'contents'}
and $current->{'parent'}) {
my $removed = pop @{$current->{'parent'}->{'contents'}};
print STDERR "popping at end command $end_command: $removed->{'type'}\n"
if ($self->{'DEBUG'});
$current = $current->{'parent'};
}
my $closed_command;
($closed_command, $current)
= _close_commands($self, $current, $source_info, $end_command);
if ($closed_command) {
_close_command_cleanup($self, $closed_command);
$end->{'parent'} = $closed_command;
push @{$closed_command->{'contents'}}, $end;
# closing a menu command, but still in a menu. Open a menu_comment
if ($block_commands{$closed_command->{'cmdname'}} eq 'menu'
and defined($self->_top_context_command())
and $block_commands{$self->_top_context_command()} eq 'menu') {
print STDERR "CLOSE MENU but still in menu context\n"
if ($self->{'DEBUG'});
push @{$current->{'contents'}}, {'type' => 'menu_comment',
'parent' => $current,
'contents' => [] };
$current = $current->{'contents'}->[-1];
}
} else {
# block command not found for @end
}
$current = _begin_preformatted($self, $current)
if ($close_preformatted_commands{$end_command});
}
} else {
$current = _begin_preformatted($self, $current)
if ($close_preformatted_commands{$command});
}
# Ignore @setfilename in included file, as said in the manual.
if (($command eq 'setfilename'
and scalar(@{$self->{'input'}}) > 1)
# TODO remove this condition if/when the XS parser has been updated
# to output @include with type replaced when the file was found
or ($current->{'contents'} and scalar(@{$current->{'contents'}})
and exists($current->{'contents'}->[-1]->{'type'})
and $current->{'contents'}->[-1]->{'type'} eq 'replaced')) {
# TODO keep the information
pop @{$current->{'contents'}};
} elsif ($command eq 'setfilename'
and ($self->{'current_node'} or $self->{'current_section'})) {
$self->_command_warn($misc_cmd, $source_info,
__("\@%s after the first element"), $command);
# columnfractions
} elsif ($command eq 'columnfractions') {
# in a multitable, we are in a block_line_arg
if (!$current->{'parent'} or !$current->{'parent'}->{'cmdname'}
or $current->{'parent'}->{'cmdname'} ne 'multitable') {
$self->_command_error($current, $source_info,
__("\@%s only meaningful on a \@multitable line"),
$command);
} else {
# This is the multitable block_line_arg line context
$self->_pop_context(['ct_line'], $source_info, $current, 'for multitable');
$current = $current->{'parent'};
$current->{'extra'}->{'max_columns'} = 0;
if (defined($misc_cmd->{'extra'}->{'misc_args'})) {
$current->{'extra'}->{'max_columns'}
= scalar(@{$misc_cmd->{'extra'}->{'misc_args'}});
$current->{'extra'}->{'columnfractions'} = $misc_cmd;
}
push @{$current->{'contents'}}, { 'type' => 'before_item',
'contents' => [], 'parent', $current };
$current = $current->{'contents'}->[-1];
}
} elsif ($root_commands{$command}) {
$current = $current->{'contents'}->[-1];
delete $current->{'remaining_args'};
# associate the section (not part) with the current node.
if ($command ne 'node' and $command ne 'part') {
if ($self->{'current_node'}
and !$self->{'current_node'}->{'extra'}->{'associated_section'}) {
$self->{'current_node'}->{'extra'}->{'associated_section'} = $current;
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'associated_node'} = $self->{'current_node'};
}
if ($self->{'current_part'}) {
$current->{'extra'}->{'associated_part'} = $self->{'current_part'};
$self->{'current_part'}->{'extra'}->{'part_associated_section'}
= $current;
if ($current->{'cmdname'} eq 'top') {
$self->_line_warn("\@part should not be associated with \@top",
$self->{'current_part'}->{'source_info'});
}
delete $self->{'current_part'};
}
$self->{'current_section'} = $current;
} elsif ($command eq 'part') {
$self->{'current_part'} = $current;
if ($self->{'current_node'}
and !$self->{'current_node'}->{'extra'}->{'associated_section'}) {
$self->_line_warn(sprintf(__(
"\@node precedes \@%s, but parts may not be associated with nodes"),
$command), $source_info);
}
}
}
}
# this happens if there is a nesting of line @-commands on a line.
# they are reprocessed here.
my $top_context = $self->_top_context();
if ($top_context eq 'ct_line' or $top_context eq 'ct_def') {
print STDERR "Still opened line command $top_context:"._print_current($current)
if ($self->{'DEBUG'});
if ($top_context eq 'ct_def') {
while ($current->{'parent'} and !($current->{'parent'}->{'type'}
and $current->{'parent'}->{'type'} eq 'def_line')) {
$current = _close_current($self, $current, $source_info);
}
} else {
while ($current->{'parent'} and !($current->{'type'}
and ($current->{'type'} eq 'block_line_arg'
or $current->{'type'} eq 'line_arg'))) {
$current = _close_current($self, $current, $source_info);
}
}
# check for infinite loop bugs...
if ($current eq $current_old) {
my $indent = '- ';
my $tree_msg = $indent . _print_current($current);
while ($current->{'parent'}) {
$indent = '-'.$indent;
$current = $current->{'parent'};
$tree_msg .= $indent . _print_current($current);
}
$self->_bug_message("Nothing closed while a line context remains\n$tree_msg",
$source_info);
die;
}
$current = $self->_end_line($current, $source_info);
}
return $current;
}
# $command may be undef if we are after a wrong other command such as
# a buggy @tab.
sub _start_empty_line_after_command($$$) {
my ($line, $current, $command) = @_;
$line =~ s/^([^\S\r\n]*)//;
push @{$current->{'contents'}}, { 'type' => 'ignorable_spaces_after_command',
'text' => $1,
'parent' => $current,
};
if (defined($command)) {
$current->{'contents'}->[-1]->{'extra'}
= {'spaces_associated_command' => $command};
$current->{'contents'}->[-1]->{'type'} = 'internal_spaces_after_command';
}
return $line;
}
sub _check_empty_node($$$$)
{
my ($self, $parsed_node, $command, $source_info) = @_;
if (!defined($parsed_node) or !$parsed_node->{'node_content'}) {
$self->_line_error(sprintf(__("empty argument in \@%s"),
$command), $source_info);
return 0;
} else {
return 1;
}
}
sub _check_internal_node($$$)
{
my ($self, $parsed_node, $source_info) = @_;
if ($parsed_node and $parsed_node->{'manual_content'}) {
$self->_line_error(sprintf(__("syntax for an external node used for `%s'"),
Texinfo::Structuring::node_extra_to_texi($parsed_node)), $source_info);
}
}
sub _check_node_label($$$$)
{
my ($self, $parsed_node, $command, $source_info) = @_;
_check_internal_node($self, $parsed_node, $source_info);
return _check_empty_node($self, $parsed_node, $command, $source_info);
}
# Return 1 if an element is all whitespace.
# Note that this function isn't completely reliable because it
# doesn't look deep into the element tree.
# Consistent with XS parser
sub _check_empty_expansion($)
{
my $current = shift;
foreach my $content (@$current) {
if (!(($content->{'cmdname'}
and ($content->{'cmdname'} eq ' ' or $content->{'cmdname'} eq "\t"
or $content->{'cmdname'} eq "\n"
or $content->{'cmdname'} eq 'c'
or $content->{'cmdname'} eq 'comment'
or $content->{'cmdname'} eq ':'))
or (defined($content->{'text'}) and $content->{'text'} !~ /\S/))) {
return 0;
}
}
return 1;
}
sub _register_extra_menu_entry_information($$;$)
{
my ($self, $current, $source_info) = @_;
foreach my $arg (@{$current->{'args'}}) {
if ($arg->{'type'} eq 'menu_entry_name') {
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'menu_entry_name'} = $arg;
if (not $arg->{'contents'} or scalar(@{$arg->{'contents'}}) == 0) {
$self->_line_warn(sprintf(__("empty menu entry name in `%s'"),
Texinfo::Convert::Texinfo::convert_to_texinfo($current)),
$source_info);
}
} elsif ($arg->{'type'} eq 'menu_entry_node') {
_isolate_last_space($self, $arg);
if (! $arg->{'contents'}) {
if ($self->{'FORMAT_MENU'} eq 'menu') {
$self->_line_error(__("empty node name in menu entry"), $source_info);
}
} else {
my $parsed_entry_node = _parse_node_manual($arg);
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'menu_entry_node'} = $parsed_entry_node;
}
} elsif ($arg->{'type'} eq 'menu_entry_description') {
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'menu_entry_description'} = $arg;
}
}
}
sub _enter_menu_entry_node($$$)
{
my ($self, $current, $source_info) = @_;
my $description = { 'type' => 'menu_entry_description',
'parent' => $current };
push @{$current->{'args'}}, $description;
_register_extra_menu_entry_information($self, $current, $source_info);
$current->{'source_info'} = $source_info;
push @{$self->{'internal_references'}}, $current;
$current = $description;
push @{$current->{'contents'}}, {'type' => 'preformatted',
'parent' => $current, };
$current = $current->{'contents'}->[-1];
return $current;
}
# If the container can hold a command as an argument, determined as
# parent element taking a command as an argument, like
# @itemize @bullet, and the command as argument being the only content.
sub _parent_of_command_as_argument($)
{
my $current = shift;
return ($current and $current->{'type'}
and $current->{'type'} eq 'block_line_arg'
and $current->{'parent'}
and $current->{'parent'}->{'cmdname'}
and ($current->{'parent'}->{'cmdname'} eq 'itemize'
or ($block_commands{$current->{'parent'}->{'cmdname'}}
and $block_commands{$current->{'parent'}->{'cmdname'}} eq 'item_line'))
and scalar(@{$current->{'contents'}}) == 1);
}
# register a command like @bullet with @itemize, or @asis with @table
sub _register_command_as_argument($$)
{
my $self = shift;
my $cmd_as_arg = shift;
print STDERR "FOR PARENT \@$cmd_as_arg->{'parent'}->{'parent'}->{'cmdname'} ".
"command_as_argument $cmd_as_arg->{'cmdname'}\n" if ($self->{'DEBUG'});
$cmd_as_arg->{'type'} = 'command_as_argument' if (!$cmd_as_arg->{'type'});
$cmd_as_arg->{'parent'}->{'parent'}->{'extra'}->{'command_as_argument'}
= $cmd_as_arg;
if ($cmd_as_arg->{'cmdname'} eq 'kbd'
and _kbd_formatted_as_code($self, $cmd_as_arg->{'parent'}->{'parent'})) {
$cmd_as_arg->{'parent'}->{'parent'}->{'extra'}->{'command_as_argument_kbd_code'} = 1;
}
}
sub _is_index_element {
my ($self, $element) = @_;
if (!$element->{'cmdname'}
or (!$self->{'command_index'}->{$element->{'cmdname'}}
and $element->{'cmdname'} ne 'subentry')) {
return 0;
}
return 1;
}
# This combines several regular expressions used in '_parse_texi' to
# look at what is next on the remaining part of the line.
# NOTE - this sub has an XS override
sub _parse_texi_regex {
my ($line) = @_;
# REMACRO
my ($at_command, $open_brace, $asterisk, $single_letter_command,
$separator_match, $misc_text)
= ($line =~ /^\@([[:alnum:]][[:alnum:]-]*)
|^(\{)
|^(\*)
|^\@(["'~\@&\}\{,\.!\? \t\n\*\-\^`=:\|\/\\])
|^([{}@,:\t.\f])
|^([^{}@,:\t.\n\f]+)
/x);
if ($open_brace) {
$separator_match = $open_brace;
} elsif ($asterisk) {
($misc_text) = ($line =~ /^([^{}@,:\t.\n\f]+)/);
}
return ($at_command, $open_brace, $asterisk, $single_letter_command,
$separator_match, $misc_text);
}
sub _check_line_directive {
my ($self, $line, $source_info) = @_;
if ($self->{'CPP_LINE_DIRECTIVES'}
and defined($source_info->{'file_name'})
and $source_info->{'file_name'} ne ''
and !$source_info->{'macro'}
and $line =~ /^\s*#\s*(line)? (\d+)(( "([^"]+)")(\s+\d+)*)?\s*$/) {
_save_line_directive($self, int($2), $5);
return 1;
}
return 0;
}
# Check whether $COMMAND can appear within $CURRENT->{'parent'}.
sub _check_valid_nesting {
my ($self, $current, $command, $source_info) = @_;
my $invalid_parent;
# error messages for forbidden constructs, like @node in @r,
# block command on line command, @xref in @anchor or node...
if ($current->{'parent'}) {
if ($current->{'parent'}->{'cmdname'}) {
if (defined($self->{'valid_nestings'}->{$current->{'parent'}->{'cmdname'}})
and !$self->{'valid_nestings'}->{$current->{'parent'}->{'cmdname'}}->{$command}
# we make sure that we are on a root @-command line and
# not in contents
and (!$root_commands{$current->{'parent'}->{'cmdname'}}
or ($current->{'type'}
and $current->{'type'} eq 'line_arg'))
# we make sure that we are on a block @-command line and
# not in contents
and (!defined($block_commands{$current->{'parent'}->{'cmdname'}})
or ($current->{'type'}
and $current->{'type'} eq 'block_line_arg'))
# we make sure that we are on an @item/@itemx line and
# not in an @enumerate, @multitable or @itemize @item.
and (($current->{'parent'}->{'cmdname'} ne 'itemx'
and $current->{'parent'}->{'cmdname'} ne 'item')
or ($current->{'type'}
and $current->{'type'} eq 'line_arg'))) {
$invalid_parent = $current->{'parent'}->{'cmdname'};
}
} elsif ($self->_top_context() eq 'ct_def'
# FIXME instead of hardcoding in_simple_text_with_refs_commands
# it would be better to use the parent command valid_nesting.
and !$in_simple_text_with_refs_commands{$command}) {
my $def_block = $current;
while ($def_block->{'parent'}
and (!$def_block->{'parent'}->{'type'}
or $def_block->{'parent'}->{'type'} ne 'def_line')) {
$def_block = $def_block->{'parent'};
}
$invalid_parent = $def_block->{'parent'}->{'parent'}->{'cmdname'};
}
}
if (defined($invalid_parent)) {
$self->_line_warn(sprintf(__("\@%s should not appear in \@%s"),
$command, $invalid_parent), $source_info);
}
}
sub _setup_document_root_and_before_node_section()
{
my $before_node_section = { 'type' => 'before_node_section' };
my $document_root = { 'contents' => [$before_node_section],
'type' => 'document_root' };
$before_node_section->{'parent'} = $document_root;
return ($document_root, $before_node_section);
}
my $STILL_MORE_TO_PROCESS = 0;
my $GET_A_NEW_LINE = 1;
my $FINISHED_TOTALLY = -1;
# return values:
# $STILL_MORE_TO_PROCESS: when there is more to process on the line
# $GET_A_NEW_LINE: when we need to read a new line
# $FINISHED_TOTALLY: found @bye, end of processing
sub _process_remaining_on_line($$$$)
{
my $self = shift;
my $current = shift;
my $line = shift;
my $source_info = shift;
my $retval = $STILL_MORE_TO_PROCESS;
# in a 'raw' (verbatim, ignore, (r)macro)
if ($current->{'cmdname'}
and $block_commands{$current->{'cmdname'}}
and ($block_commands{$current->{'cmdname'}} eq 'raw')) {
# r?macro may be nested
if (($current->{'cmdname'} eq 'macro'
or $current->{'cmdname'} eq 'rmacro')
and $line =~ /^\s*\@r?macro\s+/) {
$line =~ s/\s*\@(r?macro)//;
push @{$current->{'contents'}}, { 'cmdname' => $1,
'parent' => $current,
'contents' => [],
'extra' => {'arg_line' => $line }};
$current = $current->{'contents'}->[-1];
$retval = $GET_A_NEW_LINE;
goto funexit;
} elsif ($line =~ /^(\s*?)\@end\s+([a-zA-Z][\w-]*)/
and ($2 eq $current->{'cmdname'})) {
if ($line =~ s/^(\s+)//) {
push @{$current->{'contents'}},
{ 'text' => $1,
'type' => 'raw', 'parent' => $current };
$self->_line_warn(sprintf(
__("\@end %s should only appear at the beginning of a line"),
$current->{'cmdname'}), $source_info);
}
# store toplevel macro specification
if (($current->{'cmdname'} eq 'macro' or $current->{'cmdname'} eq 'rmacro')
and (! $current->{'parent'}
or !$current->{'parent'}->{'cmdname'}
or ($current->{'parent'}->{'cmdname'} ne 'macro'
and $current->{'parent'}->{'cmdname'} ne 'rmacro'))) {
my $macrobody =
Texinfo::Convert::Texinfo::convert_to_texinfo(
{ 'contents' => $current->{'contents'} });
if ($current->{'args'} and $current->{'args'}->[0]) {
my $name = $current->{'args'}->[0]->{'text'};
if (exists($self->{'macros'}->{$name})) {
$self->_line_warn(sprintf(__("macro `%s' previously defined"),
$name), $current->{'source_info'});
$self->_line_warn(sprintf(__(
"here is the previous definition of `%s'"),
$name), $self->{'macros'}->{$name}->{'element'}->{'source_info'});
}
if ($all_commands{$name}
or ($name eq 'txiinternalvalue'
and $self->{'accept_internalvalue'})) {
$self->_line_warn(sprintf(__(
"redefining Texinfo language command: \@%s"),
$name), $current->{'source_info'});
}
if (!$current->{'extra'}->{'invalid_syntax'}) {
$self->{'macros'}->{$name} = {
'element' => $current,
'macrobody' => $macrobody
};
}
}
}
print STDERR "CLOSED raw $current->{'cmdname'}\n" if ($self->{'DEBUG'});
# start a new line for the @end line (without the first spaces on
# the line that have already been put in a raw container).
# This is normally done at the beginning of a line, but not here,
# as we directly got the line. As the @end is processed just below,
# an empty line will not appear in the output, but it is needed to
# avoid a duplicate warning on @end not appearing at the beginning
# of the line
push @{$current->{'contents'}}, { 'type' => 'empty_line',
'text' => '',
'parent' => $current };
} else {
push @{$current->{'contents'}},
{ 'text' => $line, 'type' => 'raw', 'parent' => $current };
$retval = $GET_A_NEW_LINE;
goto funexit;
}
# in ignored conditional block command
} elsif ($current->{'cmdname'}
and $block_commands{$current->{'cmdname'}}
and ($block_commands{$current->{'cmdname'}} eq 'conditional')) {
# check for nested @ifset (so that @end ifset doesn't end the
# outermost @ifset). It is discarded when the outermost is.
if (($current->{'cmdname'} eq 'ifclear'
or $current->{'cmdname'} eq 'ifset'
or $current->{'cmdname'} eq 'ifcommanddefined'
or $current->{'cmdname'} eq 'ifcommandnotdefined')
and $line =~ /^\s*\@$current->{'cmdname'}/) {
push @{$current->{'contents'}}, { 'cmdname' => $current->{'cmdname'},
'parent' => $current,
'contents' => [],
};
$current = $current->{'contents'}->[-1];
} elsif ($line =~ /^(\s*?)\@end\s+([a-zA-Z][\w-]*)/
and ($2 eq $current->{'cmdname'})) {
my $end_command = $current->{'cmdname'};
$line =~ s/^(\s*?)\@end\s+$end_command//;
if ($1 ne '') {
$self->_line_warn(sprintf(
__("\@end %s should only appear at the beginning of a line"),
$end_command), $source_info);
}
$self->_line_warn(sprintf(
__("superfluous argument to \@%s %s: %s"), 'end', $end_command,
$line), $source_info)
if ($line =~ /\S/ and $line !~ /^\s*\@c(omment)?\b/);
$current = $current->{'parent'};
# don't store ignored @if*
my $conditional = _pop_element_from_contents($current);
if (!defined($conditional->{'cmdname'}
or $conditional->{'cmdname'} ne $end_command)) {
$self->_bug_message(
"Ignored command is not the conditional $end_command",
$source_info, $conditional);
die;
}
print STDERR "CLOSED conditional $end_command\n" if ($self->{'DEBUG'});
# Ignore until end of line
# FIXME this is not the same as for other commands. Change?
if ($line !~ /\n/) {
($line, $source_info) = _new_line($self, $source_info);
print STDERR "IGNORE CLOSE line: $line" if ($self->{'DEBUG'});
}
}
# anything remaining on the line and any other line is ignored here
$retval = $GET_A_NEW_LINE;
goto funexit;
# in @verb. type should be 'brace_command_arg'
} elsif ($current->{'parent'} and $current->{'parent'}->{'cmdname'}
and $current->{'parent'}->{'cmdname'} eq 'verb') {
#$current->{'parent'}->{'extra'} = {} if (!$current->{'parent'}->{'extra'});
# collect the first character if not already done
if (!defined($current->{'parent'}->{'extra'}->{'delimiter'})) {
if ($line =~ /^$/) {
$current->{'parent'}->{'extra'}->{'delimiter'} = '';
$self->_line_error(sprintf(
__("\@%s without associated character"), 'verb'), $source_info);
} else {
$line =~ s/^(.)//;
$current->{'parent'}->{'extra'}->{'delimiter'} = $1;
}
}
my $char = quotemeta($current->{'parent'}->{'extra'}->{'delimiter'});
if ($line =~ s/^(.*?)$char\}/\}/) {
push @{$current->{'contents'}},
{ 'text' => $1, 'type' => 'raw', 'parent' => $current }
if ($1 ne '');
print STDERR "END VERB\n" if ($self->{'DEBUG'});
} else {
push @{$current->{'contents'}},
{ 'text' => $line, 'type' => 'raw', 'parent' => $current };
print STDERR "LINE VERB: $line" if ($self->{'DEBUG'});
$retval = $GET_A_NEW_LINE;
goto funexit;
}
} elsif ($current->{'cmdname'}
and $block_commands{$current->{'cmdname'}}
and $block_commands{$current->{'cmdname'}} eq 'format_raw'
and not $self->{'expanded_formats_hash'}->{$current->{'cmdname'}}) {
push @{$current->{'contents'}}, { 'type' => 'elided_block',
'parent' => $current };
while (not $line =~ /^\s*\@end\s+$current->{'cmdname'}/) {
($line, $source_info) = _new_line($self, $source_info);
if (!$line) {
# unclosed block
$line = '';
last;
}
}
# start a new line for the @end line, this is normally done
# at the beginning of a line, but not here, as we directly
# got the lines.
$line =~ s/^([^\S\r\n]*)//;
push @{$current->{'contents'}}, { 'type' => 'empty_line',
'text' => $1,
'parent' => $current };
# It is important to let the processing continue from here, such that
# the @end is catched and handled below, as the condition has not changed
}
# this mostly happens in the following cases:
# after expansion of user defined macro that doesn't end with EOL
# after a protection of @\n in @def* line
# at the end of an expanded Texinfo fragment
while ($line eq '') {
print STDERR "EMPTY TEXT\n"
if ($self->{'DEBUG'});
($line, $source_info) = _next_text($self, $source_info);
if (!defined($line)) {
# end of the file or of a text fragment.
$current = _end_line($self, $current, $source_info);
# It may happen that there is an @include file on the line, it
# will be picked up at NEXT_LINE, beginning a new line
$retval = $GET_A_NEW_LINE;
goto funexit;
}
}
my $at_command_length;
my @line_parsing = _parse_texi_regex($line);
my ($at_command, $open_brace, $asterisk, $single_letter_command,
$separator_match, $misc_text) = @line_parsing;
print STDERR "PARSED: ".join(', ', map {!defined($_) ? 'UNDEF' : "'$_'"} @line_parsing)."\n"
if ($self->{'DEBUG'} and $self->{'DEBUG'} > 3);
my $command;
if ($single_letter_command) {
$command = $single_letter_command;
} elsif ($at_command) {
$at_command_length = length($at_command) + 1;
$command = $at_command;
my $alias_command;
if (exists($self->{'aliases'}->{$command})) {
$alias_command = $command;
$command = $self->{'aliases'}->{$command};
}
# handle user defined macros before anything else since
# their expansion may lead to changes in the line
if ($self->{'macros'}->{$command}) {
substr($line, 0, $at_command_length) = '';
my $expanded_macro = $self->{'macros'}->{$command}->{'element'};
my $args_number = scalar(@{$expanded_macro->{'args'}}) -1;
my $arguments = [];
if ($line =~ s/^\s*{\s*//) { # macro with args
($arguments, $line, $source_info)
= _expand_macro_arguments($self, $expanded_macro, $line, $source_info);
} elsif (($args_number >= 2) or ($args_number <1)) {
# as agreed on the bug-texinfo mailing list, no warn when zero
# arg and not called with {}.
$self->_line_warn(sprintf(__(
"\@%s defined with zero or more than one argument should be invoked with {}"),
$command), $source_info)
if ($args_number >= 2);
} else {
if ($line !~ /\n/) {
($line, $source_info) = _new_line($self, $source_info);
$line = '' if (!defined($line));
}
$line =~ s/^\s*// if ($line =~ /\S/);
my $has_end_of_line = chomp $line;
$arguments = [$line];
$line = "\n" if ($has_end_of_line);
}
my $expanded = _expand_macro_body($self,
$self->{'macros'}->{$command},
$arguments, $source_info);
print STDERR "MACROBODY: $expanded".'||||||'."\n"
if ($self->{'DEBUG'});
# empty result. It is ignored here.
if ($expanded eq '') {
goto funexit;
}
if ($self->{'MAX_MACRO_CALL_NESTING'}
and scalar(@{$self->{'macro_stack'}}) > $self->{'MAX_MACRO_CALL_NESTING'}) {
$self->_line_warn(sprintf(__(
"macro call nested too deeply (set MAX_NESTED_MACROS to override; current value %d)"),
$self->{'MAX_MACRO_CALL_NESTING'}), $source_info);
goto funexit;
}
if ($expanded_macro->{'cmdname'} eq 'macro') {
my $found = 0;
foreach my $macro (@{$self->{'macro_stack'}}) {
if ($macro->{'args'}->[0]->{'text'} eq $command) {
$self->_line_error(sprintf(__(
"recursive call of macro %s is not allowed; use \@rmacro if needed"),
$command), $source_info);
$found = 1;
last;
}
}
goto funexit if ($found);
}
my $expanded_lines = _text_to_lines($expanded);
goto funexit if (!@$expanded_lines);
chomp ($expanded_lines->[-1]);
pop @$expanded_lines if ($expanded_lines->[-1] eq '');
print STDERR "MACRO EXPANSION LINES: ".join('|', @$expanded_lines)
."|\nEND LINES MACRO EXPANSION\n" if ($self->{'DEBUG'});
goto funexit if (!@$expanded_lines);
unshift @{$self->{'macro_stack'}}, $expanded_macro;
print STDERR "UNSHIFT MACRO_STACK: $expanded_macro->{'args'}->[0]->{'text'}\n"
if ($self->{'DEBUG'});
my $new_lines = _complete_line_nr($expanded_lines,
$source_info->{'line_nr'}, $source_info->{'file_name'},
$expanded_macro->{'args'}->[0]->{'text'}, 1);
$source_info->{'end_macro'} = 1;
# first put the line that was interrupted by the macro call
# on the input pending text with information stack
if (! scalar(@{$self->{'input'}})) {
push @{$self->{'input'}}, {'pending' => []};
}
unshift @{$self->{'input'}->[0]->{'pending'}}, [$line, $source_info];
# current line is the first from macro expansion
my $new_text = shift @$new_lines;
($line, $source_info) = ($new_text->[0], $new_text->[1]);
# then put the following macro expansion lines with information on the
# pending text with information stack
unshift @{$self->{'input'}->[0]->{'pending'}}, @$new_lines;
goto funexit;
}
# expand value if it can change the line. It considered again
# together with other commands below for all the other cases
# which may need a well formed tree, which is not needed here, and
# early value expansion may be needed to provide with an argument.
if ($command eq 'value') {
my $expanded_line = $line;
substr($expanded_line, 0, $at_command_length) = '';
$expanded_line =~ s/^\s*//
if ($self->{'IGNORE_SPACE_AFTER_BRACED_COMMAND_NAME'});
# REVALUE
if ($expanded_line =~ s/^{([\w\-][^\s{\\}~`\^+"<>|@]*)}//) {
my $value = $1;
if (exists($self->{'values'}->{$value})) {
$line = $self->{'values'}->{$value} . $expanded_line;
goto funexit;
}
}
}
#substr($line, 0, $at_command_length) = '';
}
# special case for @-command as argument of @itemize or @*table.
# The normal case for those are to be identifier only, not a true command
# with argument, so can be followed by anything. If followed by
# braces, will be handled as a normal brace command.
#
# Need to be done as early as possible such that no other condition
# prevail and lead to a missed command
if ($current->{'cmdname'}
and defined($self->{'brace_commands'}->{$current->{'cmdname'}})
and !$open_brace
and _parent_of_command_as_argument($current->{'parent'})) {
_register_command_as_argument($self, $current);
$current = $current->{'parent'};
}
# command but before an opening brace, otherwise $current
# would be an argument type and not the command, and a new
# @-command was found. This means that the $current->{'cmdname'}
# argument (an opening brace, or a character after spaces for
# accent commands) was not found and there is already a new command.
#
# It would have been nice to allow for comments, but there is no
# container in the tree to put them when after command and before brace
# or argument for accent commands.
if ($command
and $current->{'cmdname'}
and defined($self->{'brace_commands'}->{$current->{'cmdname'}})) {
$self->_line_error(sprintf(__("\@%s expected braces"),
$current->{'cmdname'}), $source_info);
$current = $current->{'parent'};
}
# handle unknown @-command
if ($command and !$all_commands{$command}
and !$self->{'definfoenclose'}->{$command}
and !$self->{'command_index'}->{$command}
# @txiinternalvalue is invalid unless accept_internalvalue is set
and !($command eq 'txiinternalvalue'
and $self->{'accept_internalvalue'})) {
$self->_line_error(sprintf(__("unknown command `%s'"),
$command), $source_info);
substr($line, 0, $at_command_length) = '';
_abort_empty_line($self, $current);
my $paragraph = _begin_paragraph($self, $current, $source_info);
$current = $paragraph if ($paragraph);
goto funexit;
}
# this situation arises when after the $current->{'cmdname'}
# Brace commands not followed immediately by a brace
# opening. In particular cases that may lead to "command closing"
# or following character association with an @-command, for accent
# commands.
# This condition can only happen immediately after the command opening,
# otherwise the current element is in the 'args' and not right in the
# command container.
if ($current->{'cmdname'}
and defined($self->{'brace_commands'}->{$current->{'cmdname'}})
and !$open_brace) {
print STDERR "BRACE CMD: no brace after \@$current->{'cmdname'}: $line"
if $self->{'DEBUG'};
# Note that non ascii spaces do not count as spaces
if ($line =~ /^(\s+)/
and ($accent_commands{$current->{'cmdname'}}
or $self->{'IGNORE_SPACE_AFTER_BRACED_COMMAND_NAME'})) {
my $added_space = $1;
my $additional_newline;
if ($added_space =~ /\n/) {
$self->_line_warn(sprintf(
__("command `\@%s' must not be followed by new line"),
$current->{'cmdname'}), $source_info);
$additional_newline = 1;
}
#$current->{'extra'} = {} if (!$current->{'extra'});
if (!defined($current->{'extra'}->{'spaces'})) {
$line =~ s/^(\s+)//;
$current->{'extra'}->{'spaces'} = $added_space;
print STDERR "BRACE CMD before brace init spaces '$added_space'\n"
if $self->{'DEBUG'};
# only ignore spaces and one newline, two newlines lead to
# an empty line before the brace or argument which is incorrect.
} elsif ($additional_newline
and $current->{'extra'}->{'spaces'} =~ /\n/) {
print STDERR "BRACE CMD before brace second newline stops spaces\n"
if $self->{'DEBUG'};
$self->_line_error(sprintf(__("\@%s expected braces"),
$current->{'cmdname'}), $source_info);
$current = $current->{'parent'};
} else {
$line =~ s/^(\s+)//;
$current->{'extra'}->{'spaces'} .= $added_space;
print STDERR "BRACE CMD before brace add spaces '$added_space'\n"
if $self->{'DEBUG'};
}
# special case for accent commands, use following character except @
# as argument. Note that since we checked before that there isn't
# an @-command opening, there should not be an @ anyway. The line
# may possibly be empty in some specific case, without end of line.
} elsif ($accent_commands{$current->{'cmdname'}}
and $line =~ s/^([^@])//) {
print STDERR "ACCENT following_arg \@$current->{'cmdname'}\n"
if ($self->{'DEBUG'});
my $following_arg = {'type' => 'following_arg',
'parent' => $current};
$following_arg->{'contents'} = [{ 'text' => $1,
'parent' => $following_arg } ];
$current->{'args'} = [ $following_arg ];
if ($current->{'cmdname'} eq 'dotless' and $1 ne 'i' and $1 ne 'j') {
$self->_line_error(sprintf(
__("%c%s expects `i' or `j' as argument, not `%s'"),
ord('@'), $current->{'cmdname'}, $1),
$source_info);
}
$current = $current->{'parent'};
} else {
$self->_line_error(sprintf(__("\@%s expected braces"),
$current->{'cmdname'}), $source_info);
$current = $current->{'parent'};
}
# maybe a menu entry beginning: a * at the beginning of a menu line
} elsif ($current->{'type'}
and $current->{'type'} eq 'preformatted'
and $current->{'parent'}->{'type'}
and ($current->{'parent'}->{'type'} eq 'menu_comment'
or $current->{'parent'}->{'type'} eq 'menu_entry_description')
and $asterisk
and @{$current->{'contents'}}
and $current->{'contents'}->[-1]->{'type'}
and $current->{'contents'}->[-1]->{'type'} eq 'empty_line'
and $current->{'contents'}->[-1]->{'text'} eq '') {
print STDERR "MENU STAR\n" if ($self->{'DEBUG'});
_abort_empty_line($self, $current);
$line =~ s/^\*//;
push @{$current->{'contents'}}, { 'parent' => $current,
'type' => 'internal_menu_star',
'text' => '*' };
# a space after a * at the beginning of a menu line
} elsif ($current->{'contents'} and @{$current->{'contents'}}
and $current->{'contents'}->[-1]->{'type'}
and $current->{'contents'}->[-1]->{'type'} eq 'internal_menu_star') {
if ($line !~ /^\s+/) {
print STDERR "ABORT MENU STAR ($line)\n" if ($self->{'DEBUG'});
delete $current->{'contents'}->[-1]->{'type'};
} else {
print STDERR "MENU ENTRY (certainly)\n" if ($self->{'DEBUG'});
# this is the menu star collected previously
pop @{$current->{'contents'}};
$line =~ s/^(\s+)//;
my $leading_text = '*' . $1;
# FIXME remove empty description too? In that case there won't be
# a need to delete preformatted 'contents'
delete $current->{'contents'}
if (scalar(@{$current->{'contents'}}) == 0);
if ($current->{'type'} eq 'preformatted'
and $current->{'parent'}->{'type'}
and ($current->{'parent'}->{'type'} eq 'menu_comment'
# or $current->{'parent'}->{'type'} eq 'menu_entry_description'
)) {
my $menu = $current->{'parent'}->{'parent'};
if (!$current->{'contents'}) {
pop @{$current->{'parent'}->{'contents'}};
if (!scalar(@{$current->{'parent'}->{'contents'}})) {
pop @{$menu->{'contents'}};
}
}
$current = $menu;
} else {
# first parent preformatted, third is menu_entry
if ($current->{'type'} ne 'preformatted'
or $current->{'parent'}->{'type'} ne 'menu_entry_description'
or $current->{'parent'}->{'parent'}->{'type'} ne 'menu_entry'
or (not $block_commands{$current->{'parent'}->{'parent'}->{'parent'}
->{'cmdname'}} eq 'menu')) {
$self->_bug_message("Not in menu comment nor description",
$source_info, $current);
}
$current = $current->{'parent'}->{'parent'}->{'parent'};
}
push @{$current->{'contents'}}, { 'type' => 'menu_entry',
'parent' => $current,
};
$current = $current->{'contents'}->[-1];
$current->{'args'} = [ { 'type' => 'menu_entry_leading_text',
'text' => $leading_text,
'parent' => $current },
{ 'type' => 'menu_entry_name',
'parent' => $current } ];
$current = $current->{'args'}->[-1];
}
# after a separator in menu
} elsif ($current->{'args'} and @{$current->{'args'}}
and $current->{'args'}->[-1]->{'type'}
and $current->{'args'}->[-1]->{'type'} eq 'menu_entry_separator') {
print STDERR "AFTER menu_entry_separator\n" if ($self->{'DEBUG'});
my $separator = $current->{'args'}->[-1]->{'text'};
# separator is ::, we concatenate and let the while restart
# in order to collect spaces below
if ($separator eq ':' and $line =~ s/^(:)//) {
$current->{'args'}->[-1]->{'text'} .= $1;
# a . not followed by a space. Not a separator.
} elsif ($separator eq '.' and $line =~ /^\S/) {
pop @{$current->{'args'}};
$current = $current->{'args'}->[-1];
$current = _merge_text($self, $current, $separator);
# here we collect spaces following separators.
} elsif ($line =~ s/^([^\S\r\n]+)//) {
# FIXME a trailing end of line could be considered to be part
# of the separator. Right now it is part of the description,
# since it is catched (in the next while) as one of the case below
$current->{'args'}->[-1]->{'text'} .= $1;
# now handle the menu part that was closed
} elsif ($separator =~ /^::/) {
print STDERR "MENU NODE no name $separator\n" if ($self->{'DEBUG'});
# it was previously registered as menu_entry_name, it is
# changed to node
$current->{'args'}->[-2]->{'type'} = 'menu_entry_node';
$current = _enter_menu_entry_node($self, $current, $source_info);
# end of the menu entry name
} elsif ($separator =~ /^:/) {
print STDERR "MENU ENTRY $separator\n" if ($self->{'DEBUG'});
push @{$current->{'args'}}, { 'type' => 'menu_entry_node',
'parent' => $current };
$current = $current->{'args'}->[-1];
# anything else is the end of the menu node following a menu_entry_name
} else {
print STDERR "MENU NODE $separator\n" if ($self->{'DEBUG'});
$current = _enter_menu_entry_node($self, $current, $source_info);
}
# Any other @-command.
} elsif ($command) {
if (!$at_command) {
substr($line, 0, 2) = '';
} else {
substr($line, 0, $at_command_length) = '';
}
print STDERR "COMMAND $command\n" if ($self->{'DEBUG'});
# @value not expanded (expansion is done above), and @txiinternalvalue
if ($command eq 'value' or $command eq 'txiinternalvalue') {
$line =~ s/^\s*//
if ($self->{'IGNORE_SPACE_AFTER_BRACED_COMMAND_NAME'});
# REVALUE
if ($line =~ s/^{([\w\-][^\s{\\}~`\^+"<>|@]*)}//) {
my $value = $1;
if ($command eq 'value') {
if (not exists($self->{'values'}->{$value})) {
_abort_empty_line($self, $current);
# caller should expand something along
# gdt('@{No value for `{value}\'@}', {'value' => $value});
push @{$current->{'contents'}}, { 'cmdname' => $command,
'extra' => {'flag' => $value},
'parent' => $current };
$self->_line_warn(
sprintf(__("undefined flag: %s"), $value), $source_info);
# expansion of value already done above
#} else {
}
} else {
# txiinternalvalue
_abort_empty_line($self, $current);
my $new_element = { 'cmdname' => $command,
'args' => [],
'parent' => $current };
# type misc_arg?
push @{$new_element->{'args'}}, {'text' => $value,
'parent' => $new_element};
push @{$current->{'contents'}}, $new_element;
}
} else {
$self->_line_error(sprintf(__("bad syntax for %c%s"), ord('@'),
$command), $source_info);
}
goto funexit;
}
if (defined($deprecated_commands{$command})) {
$self->_line_warn(sprintf(__("%c%s is obsolete"),
ord('@'), $command), $source_info);
}
# special case with @ followed by a newline protecting end of lines
# in @def*
my $def_line_continuation
= ($self->_top_context() eq 'ct_def' and $command eq "\n");
if (not $def_line_continuation
and not _abort_empty_line($self, $current)
and $begin_line_commands{$command}) {
$self->_line_warn(
sprintf(__("\@%s should only appear at the beginning of a line"),
$command), $source_info);
}
_check_valid_nesting ($self, $current, $command, $source_info);
if ($def_line_continuation) {
$retval = $GET_A_NEW_LINE;
goto funexit;
}
unless ($self->{'no_paragraph_commands'}->{$command}) {
my $paragraph = _begin_paragraph($self, $current, $source_info);
$current = $paragraph if ($paragraph);
}
if ($self->{'close_paragraph_commands'}->{$command}) {
$current = _end_paragraph($self, $current, $source_info);
}
if ($self->{'close_preformatted_commands'}->{$command}) {
$current = _end_preformatted($self, $current, $source_info);
}
if ($in_index_commands{$command}
and $current->{'contents'}
and $current->{'contents'}->[-1]
and $current->{'contents'}->[-1]->{'text'}
# it is important to check if in an index command, as otherwise
# the internal space type is not processed and remains as is in
# the final tree.
and _is_index_element($self, $current->{'parent'})) {
if ($command eq 'subentry') {
_isolate_trailing_space($current, 'spaces_at_end');
} else {
# an internal and temporary space type that is converted to
# a normal space without type if followed by text or a
# "spaces_at_end" if followed by spaces only when the
# index or subentry command is done.
_isolate_trailing_space($current,
'internal_spaces_before_brace_in_index');
}
}
if (defined($nobrace_commands{$command})
and ($command ne 'item' or !_item_line_parent($current))) {
# symbol skipspace other
my $arg_spec = $nobrace_commands{$command};
my $misc;
if ($arg_spec ne 'skipspace') {
$misc = {'cmdname' => $command, 'parent' => $current};
push @{$current->{'contents'}}, $misc;
if ($in_heading_spec_commands{$command}) {
# TODO use a more generic system for check of @-command nesting
# in command on context stack
my $top_context_command = $self->_top_context_command();
if (not defined($top_context_command)
or not $heading_spec_commands{$top_context_command}) {
$self->_line_error(
sprintf(__("\@%s should only appear in heading or footing"),
$command), $source_info);
}
}
if ($arg_spec eq 'symbol') {
# FIXME generalize?
if ($command eq '\\' and $self->_top_context() ne 'ct_math') {
$self->_line_warn(sprintf(
__("\@%s should only appear in math context"),
$command), $source_info);
}
if ($command eq "\n") {
$current = _end_line($self, $current, $source_info);
$retval = $GET_A_NEW_LINE;
goto funexit;
}
} else { # other
_register_global_command($self, $misc, $source_info);
$current = _begin_preformatted($self, $current)
if ($close_preformatted_commands{$command});
}
} else {
if ($command eq 'item'
or $command eq 'headitem' or $command eq 'tab') {
my $parent;
# @itemize or @enumerate
if ($parent = _item_container_parent($current)) {
if ($command eq 'item') {
print STDERR "ITEM_CONTAINER\n" if ($self->{'DEBUG'});
$parent->{'items_count'}++;
$misc = { 'cmdname' => $command, 'parent' => $parent,
'extra' =>
{'item_number' => $parent->{'items_count'}} };
push @{$parent->{'contents'}}, $misc;
$current = $parent->{'contents'}->[-1];
} else {
$self->_line_error(sprintf(__(
"\@%s not meaningful inside `\@%s' block"),
$command, $parent->{'cmdname'}), $source_info);
}
$current = _begin_preformatted($self, $current);
# @*table
} elsif ($parent = _item_line_parent($current)) {
# @item and _item_line_parent is explicitly avoided in the if above
$self->_line_error(sprintf(__(
"\@%s not meaningful inside `\@%s' block"),
$command, $parent->{'cmdname'}), $source_info);
$current = _begin_preformatted($self, $current);
# @multitable
} elsif ($parent = _item_multitable_parent($current)) {
if (!$parent->{'extra'}->{'max_columns'}) {
$self->_line_warn(
sprintf(__("\@%s in empty multitable"),
$command), $source_info);
} elsif ($command eq 'tab') {
my $row = $parent->{'contents'}->[-1];
die if (!$row->{'type'});
if ($row->{'type'} eq 'before_item') {
$self->_line_error(__("\@tab before \@item"), $source_info);
} elsif ($row->{'cells_count'} >= $parent->{'extra'}->{'max_columns'}) {
$self->_line_error(sprintf(__(
"too many columns in multitable item (max %d)"),
$parent->{'extra'}->{'max_columns'}), $source_info);
} else {
$row->{'cells_count'}++;
$misc = { 'cmdname' => $command,
'parent' => $row,
'contents' => [],
'extra' =>
{'cell_number' => $row->{'cells_count'}} };
push @{$row->{'contents'}}, $misc;
$current = $row->{'contents'}->[-1];
print STDERR "TAB\n" if ($self->{'DEBUG'});
}
} else {
print STDERR "ROW\n" if ($self->{'DEBUG'});
$parent->{'rows_count'}++;
my $row = { 'type' => 'row', 'contents' => [],
'cells_count' => 1,
'extra' => {'row_number' => $parent->{'rows_count'} },
'parent' => $parent };
push @{$parent->{'contents'}}, $row;
$misc = { 'cmdname' => $command,
'parent' => $row,
'contents' => [],
'extra' => {'cell_number' => 1}};
push @{$row->{'contents'}}, $misc;
$current = $row->{'contents'}->[-1];
}
$current = _begin_preformatted($self, $current);
} elsif ($command eq 'tab') {
$self->_line_error(__(
"ignoring \@tab outside of multitable"), $source_info);
$current = _begin_preformatted($self, $current);
} else {
$self->_line_error(sprintf(__(
"\@%s outside of table or list"), $command), $source_info);
$current = _begin_preformatted($self, $current);
}
$misc->{'source_info'} = $source_info if (defined($misc));
} else {
$misc = { 'cmdname' => $command, 'parent' => $current,
'source_info' => $source_info };
push @{$current->{'contents'}}, $misc;
}
$line = _start_empty_line_after_command($line, $current, undef);
}
# line commands
} elsif (defined($self->{'line_commands'}->{$command})) {
if ($root_commands{$command} or $command eq 'bye') {
$current = _close_commands($self, $current, $source_info, undef,
$command);
if (!defined($current->{'parent'})) {
# if parse_texi_line is called on a line with a node/section then
# it will directly be in the root_line, otherwise it is not directly
# in the root, but in another container
#
# FIXME warn/error with a root command in parse_texi_line?
if ($current->{'type'} ne 'root_line') {
$self->_bug_message("no parent element", $source_info, $current);
die;
}
} else {
$current = $current->{'parent'};
}
}
# skipline text line lineraw /^\d$/
my $arg_spec = $self->{'line_commands'}->{$command};
my $misc;
# all the cases using the raw line
if ($arg_spec eq 'skipline' or $arg_spec eq 'lineraw'
or $arg_spec eq 'special') {
my $ignored = 0;
if ($command eq 'insertcopying') {
my $parent = $current;
while ($parent) {
if ($parent->{'cmdname'} and $parent->{'cmdname'} eq 'copying') {
$self->_line_error(
sprintf(__("\@%s not allowed inside `\@%s' block"),
$command, $parent->{'cmdname'}), $source_info);
$ignored = 1;
last;
}
$parent = $parent->{'parent'};
}
}
# complete the line if there was a user macro expansion
if ($line !~ /\n/) {
my ($new_line, $new_line_source_info)
= _new_line($self, $source_info);
$line .= $new_line if (defined($new_line));
}
$misc = {'cmdname' => $command,
'parent' => $current};
my $args = [];
my $has_comment;
if ($arg_spec eq 'lineraw' or $arg_spec eq 'skipline') {
$args = [ $line ];
} elsif ($arg_spec eq 'special') {
($args, $has_comment)
= _parse_special_misc_command($self, $line, $command, $source_info);
$misc->{'extra'} = {'arg_line' => $line};
}
# if using the @set txi* instead of a proper @-command, replace
# by the tree obtained with the @-command. Even though
# _end_line is called below, as $current is not line_arg
# there should not be anything done in addition than what is
# done for @clear or @set.
if (($command eq 'set' or $command eq 'clear')
and scalar(@$args) >= 1
and $set_flag_command_equivalent{$args->[0]}) {
my $arg;
if ($command eq 'set') {
$arg = 'on';
} else {
$arg = 'off';
}
$command = $set_flag_command_equivalent{$args->[0]};
$misc = {'cmdname' => $command,
'parent' => $current,
'source_info' => $source_info,
'extra' => {'misc_args' => [$arg],
'spaces_before_argument' => ' '}};
my $misc_line_args = {'type' => 'line_arg',
'parent' => $misc,
'extra' => {'spaces_after_argument' => "\n"}};
$misc->{'args'} = [$misc_line_args];
$misc_line_args->{'contents'} = [
{ 'text' => $arg,
'parent' => $misc_line_args, },
];
push @{$current->{'contents'}}, $misc;
} else {
if (!$ignored) {
push @{$current->{'contents'}}, $misc;
foreach my $arg (@$args) {
push @{$misc->{'args'}},
{ 'type' => 'misc_arg', 'text' => $arg,
'parent' => $current->{'contents'}->[-1] };
}
if (scalar(@$args) and $arg_spec ne 'skipline') {
#$misc->{'extra'} = {} if (!$misc->{'extra'});
$misc->{'extra'}->{'misc_args'} = $args;
}
} else {
$misc = undef;
}
}
if ($command eq 'raisesections') {
$self->{'sections_level'}++;
} elsif ($command eq 'lowersections') {
$self->{'sections_level'}--;
}
_register_global_command($self, $misc, $source_info)
if $misc;
# the end of line is ignored for special commands
if ($arg_spec ne 'special' or !$has_comment) {
$current = _end_line($self, $current, $source_info);
}
if ($command eq 'bye') {
$retval = $FINISHED_TOTALLY;
goto funexit;
}
# Even if _end_line is called, it is not done since there is
# no line_arg
$current = _begin_preformatted($self, $current)
if ($close_preformatted_commands{$command});
$retval = $GET_A_NEW_LINE;
goto funexit;
} else {
# $arg_spec is text, line or a number
# @item or @itemx in @table
if ($command eq 'item' or $command eq 'itemx') {
my $parent;
print STDERR "ITEM_LINE\n" if ($self->{'DEBUG'});
if ($parent = _item_line_parent($current)) {
$current = $parent;
_gather_previous_item($self, $current, $command, $source_info);
} else {
$self->_line_error(sprintf(__(
"\@%s outside of table or list"), $command), $source_info);
$current = _begin_preformatted($self, $current);
}
$misc = { 'cmdname' => $command, 'parent' => $current };
push @{$current->{'contents'}}, $misc;
$misc->{'source_info'} = $source_info;
} else {
$misc = { 'cmdname' => $command, 'source_info' => $source_info };
if ($command eq 'subentry') {
my $parent = $current->{'parent'};
if (!_is_index_element($self, $parent)) {
$self->_line_warn(
sprintf(__("\@%s should only appear in an index entry"),
$command), $source_info);
}
$parent->{'extra'}->{'subentry'} = $misc;
my $subentry_level = 1;
if ($parent->{'cmdname'} eq 'subentry') {
$subentry_level = $parent->{'extra'}->{'level'} + 1;
}
$misc->{'extra'} = {'level' => $subentry_level};
if ($subentry_level > 2) {
$self->_line_error(__(
"no more than two levels of index subentry are allowed"),
$source_info);
}
# Do not make the @subentry element a child of the index
# command. This means that spaces are preserved properly
# when converting back to Texinfo.
$current = _end_line($self, $current, $source_info);
} elsif ($sectioning_heading_commands{$command}) {
if ($self->{'sections_level'}) {
$misc->{'extra'} = {'sections_level' => $self->{'sections_level'}};
}
}
push @{$current->{'contents'}}, $misc;
$misc->{'parent'} = $current;
# def*x
if ($def_commands{$command}) {
my $base_command = $command;
$base_command =~ s/x$//;
# check that the def*x is first after @def*, no paragraph
# in-between.
my $after_paragraph = _check_no_text($current);
$self->_push_context('ct_def', $command);
$current->{'contents'}->[-1]->{'type'} = 'def_line';
$current->{'contents'}->[-1]->{'extra'}
= {'def_command' => $base_command,
'original_def_cmdname' => $command};
if (defined($self->{'values'}->{'txidefnamenospace'})) {
$current->{'contents'}->[-1]{'extra'}
->{'omit_def_name_space'} = 1;
}
if ($current->{'cmdname'}
and $current->{'cmdname'} eq $base_command) {
pop @{$current->{'contents'}};
_gather_def_item($current, $command);
push @{$current->{'contents'}}, $misc;
}
if (!$current->{'cmdname'}
or $current->{'cmdname'} ne $base_command
or $after_paragraph) {
$self->_line_error(sprintf(__(
"must be after `\@%s' to use `\@%s'"),
$base_command, $command), $source_info);
$current->{'contents'}->[-1]->{'extra'}->{'not_after_command'} = 1;
}
}
}
$current = $current->{'contents'}->[-1];
$current->{'args'} = [{ 'type' => 'line_arg',
'parent' => $current }];
# 'specific' commands arguments are handled in a specific way.
# The only other line commands that have more than one argument is
# node, so the following condition only applies to node
if ($self->{'line_commands'}->{$command} ne 'specific'
and $commands_args_number{$command}
and $commands_args_number{$command} > 1) {
$current->{'remaining_args'} = $commands_args_number{$command} - 1;
}
if ($command eq 'author') {
my $parent = $current;
my $found;
while ($parent->{'parent'}) {
$parent = $parent->{'parent'};
last if ($parent->{'type'}
and $parent->{'type'} eq 'brace_command_context');
if ($parent->{'cmdname'}) {
if ($parent->{'cmdname'} eq 'titlepage') {
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'titlepage'} = $parent;
$found = 1;
} elsif ($parent->{'cmdname'} eq 'quotation' or
$parent->{'cmdname'} eq 'smallquotation') {
#$parent->{'extra'} = {} if (!$parent->{'extra'});
push @{$parent->{'extra'}->{'authors'}}, $current;
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'quotation'} = $parent;
$found = 1;
}
last if ($found);
}
}
if (!$found) {
$self->_line_warn(sprintf(__(
"\@%s not meaningful outside `\@titlepage' and `\@quotation' environments"),
$command), $current->{'source_info'});
}
} elsif ($command eq 'dircategory' and $self->{'current_node'}) {
$self->_line_warn(__("\@dircategory after first node"),
$source_info);
} elsif ($command eq 'printindex') {
# Record that @printindex occurs in this node so we know it
# is an index node.
if ($self->{'current_node'}) {
$self->{'current_node'}->{'extra'}->{'isindex'} = 1;
}
}
$current = $current->{'args'}->[-1];
$self->_push_context('ct_line', $command)
unless ($def_commands{$command});
$line = _start_empty_line_after_command($line, $current, $misc);
}
_register_global_command($self, $misc, $source_info)
if $misc;
if ($command eq 'dircategory') {
push @{$self->{'info'}->{'dircategory_direntry'}}, $misc;
}
# @-command with matching @end opening
} elsif (exists($block_commands{$command})) {
if ($command eq 'macro' or $command eq 'rmacro') {
my $macro = _parse_macro_command_line($self, $command, $line,
$current, $source_info);
push @{$current->{'contents'}}, $macro;
$current = $current->{'contents'}->[-1];
$retval = $GET_A_NEW_LINE;
goto funexit;
} elsif ($block_commands{$command} eq 'conditional') {
my $ifvalue_true = 0;
if ($command eq 'ifclear' or $command eq 'ifset') {
# REVALUE
if ($line =~ /^\s+([\w\-][^\s{\\}~`\^+"<>|@]*)\s*(\@(c|comment)((\@|\s+).*)?)?$/) {
my $name = $1;
if ((exists($self->{'values'}->{$name}) and $command eq 'ifset')
or (!exists($self->{'values'}->{$name})
and $command eq 'ifclear')) {
$ifvalue_true = 1;
}
print STDERR "CONDITIONAL \@$command $name: $ifvalue_true\n"
if ($self->{'DEBUG'});
} elsif ($line !~ /\S/) {
$self->_line_error(sprintf(
__("%c%s requires a name"), ord('@'), $command), $source_info);
} else {
$self->_line_error(sprintf(
__("bad name for \@%s"), $command), $source_info);
}
} elsif ($command eq 'ifcommanddefined'
or $command eq 'ifcommandnotdefined') {
# REMACRO
if ($line =~ /^\s+([[:alnum:]][[:alnum:]\-]*)\s*(\@(c|comment)((\@|\s+).*)?)?$/) {
my $name = $1;
my $command_is_defined = (
exists($all_commands{$name})
or $self->{'macros'}->{$name}
or $self->{'definfoenclose'}->{$name}
or $self->{'aliases'}->{$name}
or $self->{'command_index'}->{$name}
);
if (($command_is_defined
and $command eq 'ifcommanddefined')
or (! $command_is_defined
and $command eq 'ifcommandnotdefined')) {
$ifvalue_true = 1;
}
print STDERR "CONDITIONAL \@$command $name: $ifvalue_true\n"
if ($self->{'DEBUG'});
} elsif ($line !~ /\S/) {
$self->_line_error(sprintf(
__("%c%s requires a name"), ord('@'), $command), $source_info);
} else {
$self->_line_error(sprintf(
__("bad name for \@%s"), $command), $source_info);
}
} elsif ($command =~ /^ifnot(.*)/) {
$ifvalue_true = 1 if !($self->{'expanded_formats_hash'}->{$1}
# exception as explained in the texinfo manual
or ($1 eq 'info'
and $self->{'expanded_formats_hash'}->{'plaintext'}));
print STDERR "CONDITIONAL \@$command format $1: $ifvalue_true\n"
if ($self->{'DEBUG'});
} else {
die unless ($command =~ /^if(.*)/);
$ifvalue_true = 1 if ($self->{'expanded_formats_hash'}->{$1}
or ($1 eq 'info'
and $self->{'expanded_formats_hash'}->{'plaintext'}));
print STDERR "CONDITIONAL \@$command format $1: $ifvalue_true\n"
if ($self->{'DEBUG'});
}
if ($ifvalue_true) {
push @{$self->{'conditionals_stack'}}, $command;
} else {
push @{$current->{'contents'}}, { 'cmdname' => $command,
'parent' => $current,
'contents' => [] };
$current = $current->{'contents'}->[-1];
}
# FIXME(Karl) ignore what is remaining on the line, to eat
# the end of line?
$retval = $GET_A_NEW_LINE;
goto funexit;
} else {
my $block;
# a menu command closes a menu_comment, but not the other
# block commands. This won't catch menu commands buried in
# other formats (that are incorrect anyway).
if ($block_commands{$command} eq 'menu' and $current->{'type'}
and ($current->{'type'} eq 'menu_comment'
or $current->{'type'} eq 'menu_entry_description')) {
my $menu;
$menu = $current->{'parent'};
pop @{$menu->{'contents'}}
if (!@{$current->{'contents'}});
if ($menu->{'type'} and $menu->{'type'} eq 'menu_entry') {
$menu = $menu->{'parent'};
}
$current = $menu;
}
# the def command holds a line_def* which corresponds with the
# definition line. This allows to have a treatement similar
# with def*x.
if ($def_commands{$command}) {
$self->_push_context('ct_def', $command);
$block = { 'parent' => $current,
'cmdname' => $command,
'contents' => [] };
push @{$current->{'contents'}}, $block;
$current = $current->{'contents'}->[-1];
push @{$current->{'contents'}}, {
'type' => 'def_line',
'parent' => $current,
'source_info' => $source_info,
'extra' =>
{'def_command' => $command,
'original_def_cmdname' => $command}
};
if (defined($self->{'values'}->{'txidefnamenospace'})) {
$current->{'contents'}->[-1]->{'extra'}
->{'omit_def_name_space'} = 1;
}
} else {
$block = { 'cmdname' => $command,
'parent' => $current,
'contents' => [] };
push @{$current->{'contents'}}, $block;
}
$current = $current->{'contents'}->[-1];
if ($preformatted_commands{$command}) {
$self->_push_context('ct_preformatted', $command);
} elsif ($math_commands{$command}) {
$self->_push_context('ct_math', $command);
} elsif ($block_commands{$command} eq 'format_raw') {
$self->_push_context('ct_rawpreformatted', $command);
}
if ($block_commands{$command} eq 'region') {
if (@{$self->{'regions_stack'}}) {
$self->_line_error(
sprintf(__("region %s inside region %s is not allowed"),
$command, $self->{'regions_stack'}->[-1]->{'cmdname'}),
$source_info);
}
push @{$self->{'regions_stack'}}, $block;
}
if ($block_commands{$command} eq 'menu') {
$self->_push_context('ct_preformatted', $command);
push @{$self->{'info'}->{'dircategory_direntry'}}, $block
if ($command eq 'direntry');
if ($self->{'current_node'}) {
if ($command eq 'direntry') {
if ($self->{'FORMAT_MENU'} eq 'menu') {
$self->_line_warn(__("\@direntry after first node"),
$source_info);
}
} elsif ($command eq 'menu') {
if (!(defined $current->{'parent'}->{'cmdname'})
or $root_commands{$current->{'parent'}->{'cmdname'}}) {
push @{$self->{'current_node'}->{'extra'}->{'menus'}}, $current;
} else {
$self->_line_warn(__("\@menu in invalid context"),
$source_info);
}
}
}
}
# cleaner, and more similar to XS parser, but not required, would have
# been initialized automatically.
$current->{'items_count'} = 0
if ($block_commands{$command}
and $block_commands{$command} eq 'item_container');
$current->{'args'} = [ {
'type' => 'block_line_arg',
'contents' => [],
'parent' => $current } ];
if ($commands_args_number{$command}) {
if ($commands_args_number{$command} - 1 > 0) {
$current->{'remaining_args'}
= $commands_args_number{$command} - 1;
}
} elsif ($variadic_commands{$command}) {
$current->{'remaining_args'} = -1; # unlimited args
}
$current = $current->{'args'}->[-1];
$self->_push_context('ct_line', $command)
unless ($def_commands{$command});
$block->{'source_info'} = $source_info;
_register_global_command($self, $block, $source_info);
$line = _start_empty_line_after_command($line, $current, $block);
}
} elsif (defined($self->{'brace_commands'}->{$command})) {
push @{$current->{'contents'}}, { 'cmdname' => $command,
'parent' => $current,
};
$current->{'contents'}->[-1]->{'source_info'} = $source_info;
if ($in_index_commands{$command}
and !_is_index_element($self, $current->{'parent'})) {
$self->_line_warn(
sprintf(__("\@%s should only appear in an index entry"),
$command), $source_info);
}
$current = $current->{'contents'}->[-1];
if ($command eq 'click') {
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'clickstyle'} = $self->{'clickstyle'};
} elsif ($command eq 'kbd'
and _kbd_formatted_as_code($self, $current)) {
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'code'} = 1;
}
if ($self->{'definfoenclose'}->{$command}) {
$current->{'type'} = 'definfoenclose_command';
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'begin'}
= $self->{'definfoenclose'}->{$command}->[0];
$current->{'extra'}->{'end'}
= $self->{'definfoenclose'}->{$command}->[1];
}
}
} elsif ($separator_match) {
my $separator = $separator_match;
substr ($line, 0, 1) = '';
print STDERR "SEPARATOR: $separator\n" if ($self->{'DEBUG'});
if ($separator eq '@') {
# this may happen with a @ at the very end of a file, therefore
# not followed by anything.
$self->_line_error(__("unexpected \@"), $source_info);
} elsif ($separator eq '{') {
_abort_empty_line($self, $current);
if ($current->{'cmdname'}
and defined($self->{'brace_commands'}->{$current->{'cmdname'}})) {
my $command = $current->{'cmdname'};
$current->{'args'} = [ { 'parent' => $current } ];
if (defined($commands_args_number{$command})
and $commands_args_number{$command} > 1) {
$current->{'remaining_args'}
= $commands_args_number{$command} - 1;
}
$current = $current->{'args'}->[-1];
if ($self->{'brace_commands'}->{$command} eq 'context') {
if ($command eq 'caption' or $command eq 'shortcaption') {
my $float;
if (!$current->{'parent'}->{'parent'}
or !$current->{'parent'}->{'parent'}->{'cmdname'}
or $current->{'parent'}->{'parent'}->{'cmdname'} ne 'float') {
$float = $current->{'parent'};
while ($float->{'parent'} and !($float->{'cmdname'}
and $float->{'cmdname'} eq 'float')) {
$float = $float->{'parent'};
}
if (!($float->{'cmdname'} and $float->{'cmdname'} eq 'float')) {
$self->_line_error(sprintf(__(
"\@%s is not meaningful outside `\@float' environment"),
$command), $source_info);
$float = undef;
} else {
$self->_line_warn(sprintf(__(
"\@%s should be right below `\@float'"),
$command), $source_info);
}
} else {
$float = $current->{'parent'}->{'parent'};
}
if ($float) {
if ($float->{'extra'}->{$command}) {
$self->_line_warn(sprintf(__("ignoring multiple \@%s"),
$command), $source_info);
} else {
#$current->{'parent'}->{'extra'} = {} if (!$current->{'parent'}->{'extra'});
$current->{'parent'}->{'extra'}->{'float'} = $float;
$float->{'extra'}->{$command} = $current->{'parent'};
}
}
}
if ($math_commands{$command}) {
$self->_push_context('ct_math', $command);
} else {
$self->_push_context('ct_brace_command', $command);
}
$line =~ s/([^\S\f\n]*)//;
$current->{'type'} = 'brace_command_context';
# internal_spaces_before_argument is a transient internal type,
# which should end up in extra spaces_before_argument.
push @{$current->{'contents'}}, {
'type' => 'internal_spaces_before_argument',
'text' => $1,
'parent' => $current,
'extra' => {'spaces_associated_command' => $current->{'parent'}}
};
} else {
$current->{'type'} = 'brace_command_arg';
# Commands that disregard leading whitespace.
if ($brace_commands{$command}
and ($brace_commands{$command} eq 'arguments'
or $brace_commands{$command} eq 'inline')) {
# internal_spaces_before_argument is a transient internal type,
# which should end up in extra spaces_before_argument.
push @{$current->{'contents'}}, {
'type' => 'internal_spaces_before_argument',
'text' => '',
'parent' => $current,
'extra' => {'spaces_associated_command' => $current}
};
}
$self->_push_context('ct_inlineraw', $command)
if ($command eq 'inlineraw');
}
print STDERR "OPENED \@$current->{'parent'}->{'cmdname'}, remaining: "
.(defined($current->{'parent'}->{'remaining_args'}) ? "remaining: $current->{'parent'}->{'remaining_args'}, " : '')
.($current->{'type'} ? "type: $current->{'type'}" : '')."\n"
if ($self->{'DEBUG'});
} elsif ($current->{'parent'}
and (($current->{'parent'}->{'cmdname'}
and $current->{'parent'}->{'cmdname'} eq 'multitable')
or ($current->{'parent'}->{'type'}
and $current->{'parent'}->{'type'} eq 'def_line'))) {
push @{$current->{'contents'}},
{ 'type' => 'bracketed',
'parent' => $current };
$current = $current->{'contents'}->[-1];
# we need the line number here in case @ protects end of line
$current->{'source_info'} = $source_info
if ($current->{'parent'}->{'parent'}->{'type'}
and $current->{'parent'}->{'parent'}->{'type'} eq 'def_line');
# internal_spaces_before_argument is a transient internal type,
# which should end up in extra spaces_before_argument.
push @{$current->{'contents'}},
{'type' => 'internal_spaces_before_argument',
'text' => '',
'parent' => $current,
'extra' => {'spaces_associated_command' => $current}
};
print STDERR "BRACKETED in def/multitable\n" if ($self->{'DEBUG'});
# lone braces accepted right in a rawpreformatted
} elsif ($current->{'type'}
and $current->{'type'} eq 'rawpreformatted') {
push @{$current->{'contents'}}, {'text' => '{',
'parent' => $current };
# matching braces accepted in a rawpreformatted or math or ignored
# code
} elsif ($self->_top_context() eq 'ct_math'
or $self->_top_context() eq 'ct_rawpreformatted'
or $self->_top_context() eq 'ct_inlineraw') {
push @{$current->{'contents'}},
{ 'type' => 'bracketed',
'parent' => $current, 'source_info' => $source_info };
$current = $current->{'contents'}->[-1];
print STDERR "BRACKETED in math/rawpreformatted/inlineraw\n"
if ($self->{'DEBUG'});
} else {
$self->_line_error(sprintf(__("misplaced %c"),
ord('{')), $source_info);
}
} elsif ($separator eq '}') {
_abort_empty_line($self, $current);
if ($current->{'type'} and ($current->{'type'} eq 'bracketed')) {
$current = $current->{'parent'};
# the following will not happen for footnote if there is
# a paragraph withing the footnote
} elsif ($current->{'parent'}
and $current->{'parent'}->{'cmdname'}
and exists $self->{'brace_commands'}->{$current->{'parent'}->{'cmdname'}}) {
# for math and footnote out of paragraph
if ($self->{'brace_commands'}->{$current->{'parent'}->{'cmdname'}} eq 'context') {
my $command_context = 'ct_brace_command';
if ($math_commands{$current->{'parent'}->{'cmdname'}}) {
$command_context = 'ct_math';
}
$self->_pop_context([$command_context], $source_info, $current,
"for brace command $current->{'parent'}->{'cmdname'}");
}
# first is the arg.
if ($brace_commands{$current->{'parent'}->{'cmdname'}}
and $brace_commands{$current->{'parent'}{'cmdname'}} eq 'arguments'
and $current->{'parent'}->{'cmdname'} ne 'math') {
_isolate_last_space($self, $current);
}
my $closed_command = $current->{'parent'}->{'cmdname'};
print STDERR "CLOSING(brace) \@$current->{'parent'}->{'cmdname'}\n"
if ($self->{'DEBUG'});
delete $current->{'parent'}->{'remaining_args'};
if (defined($brace_commands{$closed_command})
and $brace_commands{$closed_command} eq 'noarg'
and $current->{'contents'}
and @{$current->{'contents'}}) {
$self->_line_warn(sprintf(__(
"command \@%s does not accept arguments"),
$closed_command), $source_info);
}
if ($current->{'parent'}->{'cmdname'} eq 'anchor') {
$current->{'parent'}->{'source_info'} = $source_info;
my $parsed_anchor = _parse_node_manual($current);
if (_check_node_label($self, $parsed_anchor,
$current->{'parent'}->{'cmdname'}, $source_info)) {
_register_label($self->{'targets'}, $current->{'parent'},
$parsed_anchor);
if (@{$self->{'regions_stack'}}) {
#$current->{'extra'} = {} if (!$current->{'extra'});
$current->{'extra'}->{'region'} = $self->{'regions_stack'}->[-1];
}
}
} elsif ($ref_commands{$current->{'parent'}->{'cmdname'}}) {
my $ref = $current->{'parent'};
if (@{$ref->{'args'}}) {
my @args;
for $a (@{$ref->{'args'}}) {
if ($a->{'contents'} and @{$a->{'contents'}}) {
push @args, $a->{'contents'};
} else {
push @args, undef;
}
}
if (($closed_command eq 'inforef'
and !defined($args[0]) and !defined($args[2]))
or ($closed_command ne 'inforef'
and !defined($args[0]) and !defined($args[3])
and !defined($args[4]))) {
$self->_line_warn(sprintf(__(
"command \@%s missing a node or external manual argument"),
$closed_command), $source_info);
} else {
my $parsed_ref_node = _parse_node_manual($ref->{'args'}->[0]);
if (defined $parsed_ref_node) {
if ($closed_command ne 'inforef'
and !defined($args[3]) and !defined($args[4])
and !$parsed_ref_node->{'manual_content'}) {
push @{$self->{'internal_references'}}, $ref;
}
#$ref->{'extra'} = {} if (!$ref->{'extra'});
$ref->{'extra'}->{'node_argument'} = $parsed_ref_node
}
}
if (defined($args[1])) {
if (_check_empty_expansion($args[1])) {
$self->_line_warn(sprintf(__(
"in \@%s empty cross reference name after expansion `%s'"),
$closed_command,
Texinfo::Convert::Texinfo::convert_to_texinfo(
{'contents' => $args[1]})),
$source_info);
}
}
if ($closed_command ne 'inforef' and defined($args[2])) {
if (_check_empty_expansion($args[2])) {
$self->_line_warn(sprintf(__(
"in \@%s empty cross reference title after expansion `%s'"),
$closed_command,
Texinfo::Convert::Texinfo::convert_to_texinfo(
{'contents' => $args[2]})),
$source_info);
}
}
}
} elsif ($current->{'parent'}->{'cmdname'} eq 'image') {
my $image = $current->{'parent'};
if (!@{$image->{'args'}}
or !defined($image->{'args'}->[0])
or !$image->{'args'}->[0]->{'contents'}
or scalar(@{$image->{'args'}->[0]->{'contents'}}) == 0) {
$self->_line_error(
__("\@image missing filename argument"), $source_info);
}
if (defined $self->{'info'}->{'input_perl_encoding'}) {
#$image->{'extra'} = {} if (!$image->{'extra'});
$image->{'extra'}->{'input_perl_encoding'}
= $self->{'info'}->{'input_perl_encoding'};
}
} elsif($current->{'parent'}->{'cmdname'} eq 'dotless') {
my $dotless = $current->{'parent'};
if ($current->{'contents'}
and @{$current->{'contents'}}) {
my $text = $current->{'contents'}->[0]->{'text'};
if (!defined ($text)
or ($text ne 'i' and $text ne 'j')) {
$self->_line_error(sprintf(
__("%c%s expects `i' or `j' as argument, not `%s'"),
ord('@'), $dotless->{'cmdname'},
Texinfo::Convert::Texinfo::convert_to_texinfo($current)),
$source_info);
}
}
} elsif ($explained_commands{$current->{'parent'}->{'cmdname'}}
or ($brace_commands{$current->{'parent'}->{'cmdname'}}
and $brace_commands{$current->{'parent'}->{'cmdname'}} eq 'inline')) {
my $current_command = $current->{'parent'};
if ($brace_commands{$current_command->{'cmdname'}} eq 'inline') {
if ($current_command->{'cmdname'} eq 'inlineraw') {
$self->_pop_context(['ct_inlineraw'], $source_info, $current,
' inlineraw');
}
}
if (!@{$current_command->{'args'}}
or !defined($current_command->{'args'}->[0])
or !$current_command->{'args'}->[0]->{'contents'}
or scalar(@{$current_command->{'args'}->[0]->{'contents'}}) == 0) {
$self->_line_warn(
sprintf(__("\@%s missing first argument"),
$current_command->{'cmdname'}), $source_info);
}
} elsif ($current->{'parent'}->{'cmdname'} eq 'errormsg') {
my $error_message_text = $current->{'contents'}->[0]->{'text'};
$self->_line_error($error_message_text, $source_info)
if $error_message_text;
} elsif ($current->{'parent'}->{'cmdname'} eq 'U') {
my $arg;
if ($current->{'contents'} and $current->{'contents'}->[0]) {
$arg = $current->{'contents'}->[0]->{'text'};
}
if (!defined($arg) || !$arg) {
$self->_line_warn(__("no argument specified for \@U"),
$source_info);
} elsif ($arg !~ /^[0-9A-Fa-f]+$/) {
$self->_line_error(sprintf(__(
"non-hex digits in argument for \@U: %s"), $arg),
$source_info);
} elsif (length ($arg) < 4) {
# Perl doesn't mind, but too much trouble to do in TeX.
$self->_line_warn(sprintf(__(
"fewer than four hex digits in argument for \@U: %s"), $arg),
$source_info);
} else {
# we don't want to call hex at all if the value isn't
# going to fit; so first use eval to check.
# Since integer overflow is only a warning, have to make
# warnings fatal for the eval to be effective.
eval qq!use warnings FATAL => qw(all); hex("$arg")!;
if ($@) {
# leave clue in case something else went wrong.
warn "\@U hex($arg) eval failed: $@\n" if ($self->{'DEBUG'});
# argument likely exceeds size of integer
}
# ok, value can be given to hex(), so try it.
if ($@ or hex($arg) > 0x10FFFF) {
$self->_line_error(sprintf(__(
"argument for \@U exceeds Unicode maximum 0x10FFFF: %s"),
$arg),
$source_info);
}
}
# first parent is the brace command
} elsif (_parent_of_command_as_argument($current->{'parent'}->{'parent'})
and !$current->{'contents'}) {
_register_command_as_argument($self, $current->{'parent'});
} elsif ($in_index_commands{$current->{'parent'}->{'cmdname'}}) {
my $command = $current->{'parent'}->{'cmdname'};
my $index_element = $current->{'parent'}->{'parent'}->{'parent'};
if ($index_element
and _is_index_element($self, $index_element)) {
if ($command eq 'sortas') {
my ($arg, $superfluous_arg) = _convert_to_text($current);
if (defined($arg)) {
$index_element->{'extra'}->{$command} = $arg;
}
} else {
$index_element->{'extra'}->{$command} = $current->{'parent'};
}
}
}
_register_global_command($self, $current->{'parent'}, $source_info);
if ($command_ignore_space_after{$current->{'parent'}->{'cmdname'}}) {
push @{$current->{'parent'}->{'parent'}->{'contents'}},
{'type' => 'spaces_after_close_brace',
'text' => '',
'parent' => $current->{'parent'}->{'parent'}
};
}
$current = $current->{'parent'}->{'parent'};
$current = _begin_preformatted($self, $current)
if ($close_preformatted_commands{$closed_command});
# lone braces accepted right in a rawpreformatted
} elsif ($current->{'type'}
and $current->{'type'} eq 'rawpreformatted') {
push @{$current->{'contents'}}, {'text' => '}',
'parent' => $current };
# footnote caption closing, when there is a paragraph inside.
} elsif ($self->_top_context() eq 'ct_brace_command') {
# closing the context under broader situations
$current = _end_paragraph($self, $current, $source_info);
if ($current->{'parent'}
and $current->{'parent'}->{'cmdname'}
and $self->{'brace_commands'}
->{$current->{'parent'}->{'cmdname'}} eq 'context') {
$self->_pop_context(['ct_brace_command'], $source_info, $current,
"for brace isolated $current->{'parent'}->{'cmdname'}");
print STDERR "CLOSING(context command) \@$current->{'parent'}->{'cmdname'}\n"
if ($self->{'DEBUG'});
my $closed_command = $current->{'parent'}->{'cmdname'};
_register_global_command($self, $current->{'parent'}, $source_info);
$current = $current->{'parent'}->{'parent'};
$current = _begin_preformatted($self, $current)
if ($close_preformatted_commands{$closed_command});
}
} else {
$self->_line_error(sprintf(__("misplaced %c"),
ord('}')), $source_info);
}
} elsif ($separator eq ','
and $current->{'parent'}
and $current->{'parent'}->{'remaining_args'}) {
_abort_empty_line ($self, $current);
_isolate_last_space($self, $current);
my $type = $current->{'type'};
$current = $current->{'parent'};
if ($brace_commands{$current->{'cmdname'}}
and $brace_commands{$current->{'cmdname'}} eq 'inline') {
my $expandp = 0;
#$current->{'extra'} = {} if (!$current->{'extra'});
if (! $current->{'extra'}->{'format'}) {
my $inline_type;
if (defined $current->{'args'}->[0]
and $current->{'args'}->[0]->{'contents'}
and @{$current->{'args'}->[0]->{'contents'}}) {
$inline_type = $current->{'args'}->[0]->{'contents'}->[0]->{'text'};
}
if (!$inline_type) {
# condition is missing for some reason
print STDERR "INLINE COND MISSING\n"
if ($self->{'DEBUG'});
} elsif ($inline_format_commands{$current->{'cmdname'}}) {
if ($self->{'expanded_formats_hash'}->{$inline_type}) {
$expandp = 1;
$current->{'extra'}->{'expand_index'} = 1;
} else {
$expandp = 0;
}
} elsif (($current->{'cmdname'} eq 'inlineifset'
and exists($self->{'values'}->{$inline_type}))
or ($current->{'cmdname'} eq 'inlineifclear'
and ! exists($self->{'values'}->{$inline_type}))) {
$expandp = 1;
$current->{'extra'}->{'expand_index'} = 1;
} else {
$expandp = 0;
}
$current->{'extra'}->{'format'} = $inline_type;
# Skip first argument for a false @inlinefmtifelse
if (!$expandp and $current->{'cmdname'} eq 'inlinefmtifelse') {
$current->{'extra'}->{'expand_index'} = 2;
# Add a dummy argument for the first argument.
push @{$current->{'args'}}, {'type' => 'elided',
'parent' => $current,};
# Scan forward to get the next argument.
my $brace_count = 1;
while ($brace_count > 0) {
# Forward to next comma or brace
if ($line =~ s/[^{,}]*([,{}])//) {
if ($1 eq ',' and $brace_count == 1) {
last;
} elsif ($1 eq '{') {
$brace_count++;
} elsif ($1 eq '}') {
$brace_count--;
}
} else {
my $new_text;
($new_text, $source_info) = _next_text($self, $source_info);
if (!$new_text) {
$retval = $GET_A_NEW_LINE; # error - unbalanced brace
goto funexit;
}
$line .= $new_text;
}
}
if ($brace_count == 0) {
# second arg missing
$line = '}' . $line;
}
$current->{'remaining_args'}--;
$expandp = 1;
}
} elsif ($current->{'cmdname'} eq 'inlinefmtifelse') {
# Second arg of @inlinefmtifelse when condition is true.
# Discard second argument.
$expandp = 0;
}
# If this command is not being expanded, add a dummy argument,
# and scan forward to the closing brace.
if (!$expandp) {
push @{$current->{'args'}}, {'type' => 'elided',
'parent' => $current,};
my $brace_count = 1;
while ($brace_count > 0) {
if ($line =~ s/[^{}]*([{}])//) {
if ($1 eq '{') {
$brace_count++;
} else {
$brace_count--;
}
} else {
my $new_text;
($new_text, $source_info) = _next_text($self, $source_info);
if (!$new_text) {
$retval = $GET_A_NEW_LINE; # error - unbalanced brace
goto funexit;
}
$line .= $new_text;
}
}
$current = $current->{'args'}->[-1];
$line = '}' . $line;
goto funexit;
}
}
$current->{'remaining_args'}--;
push @{$current->{'args'}},
{ 'type' => $type, 'parent' => $current, 'contents' => [] };
$current = $current->{'args'}->[-1];
# internal_spaces_before_argument is a transient internal type,
# which should end up in extra spaces_before_argument.
push @{$current->{'contents'}},
{'type' => 'internal_spaces_before_argument',
'text' => '',
'parent' => $current,
'extra' => {'spaces_associated_command' => $current}
};
} elsif ($separator eq ',' and $current->{'type'}
and $current->{'type'} eq 'line_arg'
and $current->{'parent'}->{'cmdname'}
and $current->{'parent'}->{'cmdname'} eq 'node') {
$self->_line_warn(__("superfluous arguments for node"), $source_info);
# end of menu node (. must be followed by a space to stop the node).
} elsif (($separator =~ /[,\t.]/ and $current->{'type'}
and $current->{'type'} eq 'menu_entry_node')
or ($separator eq ':' and $current->{'type'}
and $current->{'type'} eq 'menu_entry_name')) {
$current = $current->{'parent'};
push @{$current->{'args'}}, { 'type' => 'menu_entry_separator',
'text' => $separator,
'parent' => $current };
} elsif ($separator eq "\f" and $current->{'type'}
and $current->{'type'} eq 'paragraph') {
# form feed stops and restart a paragraph.
$current = _end_paragraph($self, $current, $source_info);
push @{$current->{'contents'}}, {'text' => $separator,
'type' => 'empty_line',
'parent' => $current };
push @{$current->{'contents'}}, { 'type' => 'empty_line',
'text' => '',
'parent' => $current };
} else {
$current = _merge_text($self, $current, $separator);
}
# Misc text except end of line
} elsif (defined $misc_text) {
print STDERR "MISC TEXT: $misc_text\n" if ($self->{'DEBUG'});
my $new_text = $misc_text;
substr ($line, 0, length ($misc_text)) = '';
$current = _merge_text($self, $current, $new_text);
# end of line
} else {
print STDERR "END LINE: ". _print_current($current)."\n"
if ($self->{'DEBUG'});
if ($line =~ s/^(\n)//) {
$current = _merge_text($self, $current, $1);
} else {
if (scalar(@{$self->{'input'}})) {
$self->_bug_message("Text remaining without normal text but `$line'",
$source_info, $current);
die;
}
}
$current = _end_line($self, $current, $source_info);
$retval = $GET_A_NEW_LINE;
goto funexit;
}
funexit:
return ($current, $line, $source_info, $retval);
}
# the main subroutine
sub _parse_texi($$$)
{
my ($self, $root, $current) = @_;
my $source_info;
NEXT_LINE:
while (1) {
my $line;
($line, $source_info) = _next_text($self, $source_info);
last if (!defined($line));
if ($self->{'DEBUG'}) {
my $line_text = '';
$line_text = "$source_info->{'line_nr'}.$source_info->{'macro'}"
if ($source_info);
print STDERR "NEW LINE("
.join('|', $self->_get_context_stack())
.":@{$self->{'conditionals_stack'}}:$line_text): $line";
#print STDERR "CONTEXT_STACK ".join('|',$self->_get_context_stack())."\n";
#print STDERR " $current: ".Texinfo::Common::debug_print_element_short($current)."\n";
}
if (not
# all the format handled early that have specific containers
# 'raw' command or ignored conditional or verb or ignored raw format
(($current->{'cmdname'}
and $block_commands{$current->{'cmdname'}}
and ($block_commands{$current->{'cmdname'}} eq 'raw'
or $block_commands{$current->{'cmdname'}} eq 'conditional'
or ($block_commands{$current->{'cmdname'}} eq 'format_raw'
and not $self->{'expanded_formats_hash'}->{$current->{'cmdname'}})))
or
($current->{'parent'} and $current->{'parent'}->{'cmdname'}
and $current->{'parent'}->{'cmdname'} eq 'verb')
)
# not def line
and $self->_top_context() ne 'ct_def') {
next NEXT_LINE if _check_line_directive ($self, $line, $source_info);
print STDERR "BEGIN LINE\n" if ($self->{'DEBUG'});
if ($current->{'contents'}
and $current->{'contents'}->[-1]
and $current->{'contents'}->[-1]->{'type'}
and $current->{'contents'}->[-1]->{'type'}
eq 'internal_spaces_before_argument') {
# Empty spaces after brace or comma till the end of line.
# Remove this element and update 'extra' values.
_abort_empty_line($self, $current);
}
$line =~ s/^([^\S\r\n]*)//;
push @{$current->{'contents'}}, { 'type' => 'empty_line',
'text' => $1,
'parent' => $current };
}
while (1) {
my $status;
($current, $line, $source_info, $status)
= _process_remaining_on_line($self, $current, $line, $source_info);
if ($status == $GET_A_NEW_LINE) {
last;
} elsif ($status == $FINISHED_TOTALLY) {
goto finished_totally;
}
}
}
finished_totally:
while (@{$self->{'conditionals_stack'}}) {
my $end_conditional = pop @{$self->{'conditionals_stack'}};
$self->_line_error(sprintf(__("expected \@end %s"), $end_conditional),
$source_info);
}
$current = _close_commands($self, $current, $source_info);
my @context_stack = $self->_get_context_stack();
if (scalar(@context_stack) != 0) {
die($self->_bug_message("CONTEXT_STACK not empty at _parse_texi end: "
.join('|', @context_stack)));
}
# Setup labels info and nodes list based on 'targets'
Texinfo::Convert::NodeNameNormalization::set_nodes_list_labels($self,
$self->{'registrar'}, $self);
Texinfo::Translations::complete_indices($self);
return $root;
}
# parse special line @-commands, unmacro, set, clear, clickstyle.
# Also remove spaces or ignore text, as specified in the line_commands hash.
sub _parse_special_misc_command($$$$)
{
my ($self, $line, $command, $source_info) = @_;
my $args = [];
my $has_comment = 0;
my $remaining;
if ($command eq 'set') {
# REVALUE
if ($line =~ /^\s+([\w\-][^\s{\\}~`\^+"<>|@]*)(\@(c|comment)((\@|\s+).*)?|\s+(.*?))?\s*$/) {
if ($line =~ s/\@(c|comment)((\@|\s+).*)?$//) {
$has_comment = 1;
}
$line =~ /^\s+([\w\-][^\s{\\}~`\^+"<>|@]*)(\s+(.*?))?\s*$/;
my $name = $1;
my $arg = $3;
$arg = '' if (!defined($arg));
$args = [$name, $arg];
$self->{'values'}->{$name} = $arg;
} elsif ($line !~ /\S/) {
$self->_line_error(sprintf(
__("%c%s requires a name"), ord('@'), $command), $source_info);
} else {
$self->_line_error(sprintf(
__("bad name for \@%s"), $command), $source_info);
}
} elsif ($command eq 'clear') {
# REVALUE
if ($line =~ /^\s+([\w\-][^\s{\\}~`\^+"<>|@]*)\s*(\@(c|comment)((\@|\s+).*)?)?$/) {
$args = [$1];
delete $self->{'values'}->{$1};
$has_comment = 1 if (defined($3));
} elsif ($line !~ /\S/) {
$self->_line_error(sprintf(
__("%c%s requires a name"), ord('@'), $command), $source_info);
} else {
$self->_line_error(sprintf(
__("bad name for \@%s"), $command), $source_info);
}
} elsif ($command eq 'unmacro') {
# REMACRO
if ($line =~ /^\s+([[:alnum:]][[:alnum:]\-]*)\s*(\@(c|comment)((\@|\s+).*)?)?$/) {
$args = [$1];
delete $self->{'macros'}->{$1};
$has_comment = 1 if (defined($3));
print STDERR "UNMACRO $1\n" if ($self->{'DEBUG'});
} elsif ($line !~ /\S/) {
$self->_line_error(sprintf(
__("%c%s requires a name"), ord('@'), $command), $source_info);
} else {
$self->_line_error(sprintf(
__("bad name for \@%s"), $command), $source_info);
}
} elsif ($command eq 'clickstyle') {
# REMACRO
if ($line =~ /^\s+@([[:alnum:]][[:alnum:]\-]*)(\{\})?\s*/) {
$args = ['@'.$1];
$self->{'clickstyle'} = $1;
$remaining = $line;
$remaining =~ s/^\s+@([[:alnum:]][[:alnum:]\-]*)(\{\})?\s*(\@(c|comment)((\@|\s+).*)?)?//;
$has_comment = 1 if (defined($4));
} else {
$self->_line_error(sprintf(__(
"\@%s should only accept an \@-command as argument, not `%s'"),
$command, $line), $source_info);
}
} else {
die $self->_bug_message("Unknown special command $command", $source_info);
}
if (defined($remaining)) {
chomp($remaining);
if ($remaining ne '') {
$self->_line_warn(sprintf(__(
"remaining argument on \@%s line: %s"),
$command, $remaining), $source_info);
}
}
return ($args, $has_comment);
}
# at the end of an @-command line with arguments, parse the resulting
# text, to collect aliases, definfoenclose and collect errors on
# wrong arguments.
sub _parse_line_command_args($$$)
{
my ($self, $line_command, $source_info) = @_;
my $args;
my $command = $line_command->{'cmdname'};
my $arg = $line_command->{'args'}->[0];
if ($self->{'DEBUG'}) {
print STDERR "MISC ARGS \@$command\n";
if ($arg->{'contents'} and @{$arg->{'contents'}}) {
my $idx = 0;
foreach my $content (@{$arg->{'contents'}}) {
my $name = '';
$name = '@' . $content->{'cmdname'} if ($content->{'cmdname'});
my $type = ', t: ';
$type .= $content->{'type'} if ($content->{'type'});
my $text = ', ';
$type .= $content->{'text'} if ($content->{'text'});
print STDERR " -> $idx $name $type $text\n";
$idx++;
}
}
}
if (!$arg->{'contents'}) {
$self->_command_error($line_command, $source_info,
__("\@%s missing argument"), $command);
#$line_command->{'extra'} = {} if (!$line_command->{'extra'});
$line_command->{'extra'}->{'missing_argument'} = 1;
return undef;
}
if (@{$arg->{'contents'}} > 1
or (!defined($arg->{'contents'}->[0]->{'text'}))) {
$self->_line_error(sprintf(__("superfluous argument to \@%s"),
$command), $source_info);
}
return undef if (!defined($arg->{'contents'}->[0]->{'text'}));
my $line = $arg->{'contents'}->[0]->{'text'};
if ($command eq 'alias') {
# REMACRO
if ($line =~ s/^([[:alnum:]][[:alnum:]-]*)(\s*=\s*)([[:alnum:]][[:alnum:]-]*)$//) {
my $new_command = $1;
my $existing_command = $3;
$args = [$1, $3];
$self->{'aliases'}->{$new_command} = $existing_command;
if (exists($block_commands{$existing_command})) {
$self->_line_warn(sprintf(
__("environment command %s as argument to \@%s"),
$existing_command, $command), $source_info);
}
} else {
$self->_line_error(sprintf(
__("bad argument to \@%s"), $command), $source_info);
}
} elsif ($command eq 'definfoenclose') {
# REMACRO
# FIXME not clear if non ascii spaces are ok in the args
if ($line =~ s/^([[:alnum:]][[:alnum:]\-]*)\s*,\s*([^\s,]*)\s*,\s*([^\s,]*)$//) {
$args = [$1, $2, $3 ];
my ($cmd_name, $begin, $end) = ($1, $2, $3);
$self->{'definfoenclose'}->{$cmd_name} = [ $begin, $end ];
print STDERR "DEFINFOENCLOSE \@$cmd_name: $begin, $end\n"
if ($self->{'DEBUG'});
# consistent with XS parser, not actually used anywhere.
$self->{'brace_commands'}->{$cmd_name} = 'style_other';
# this allows to obtain the same result as the XS parser which checks
# dynamically the brace_commands type
$self->{'valid_nestings'}->{$cmd_name} = \%in_full_text_commands;
# note that a built-in command previously in a hash classifying the
# @-command will remain there, possibly having specific effects.
} else {
$self->_line_error(sprintf(__("bad argument to \@%s"), $command),
$source_info);
}
} elsif ($command eq 'columnfractions') {
my @possible_fractions = split (/\s+/, $line);
if (!@possible_fractions) {
$self->_line_error(sprintf(__("empty \@%s"), $command),
$source_info);
} else {
foreach my $fraction (@possible_fractions) {
if ($fraction =~ /^\d*\.\d+$|^\d+\.?$/) {
push @$args, $fraction;
} else {
$self->_line_error(sprintf(
__("column fraction not a number: %s"),
$fraction), $source_info);
}
}
}
} elsif ($command eq 'sp') {
if ($line =~ /^([0-9]+)$/) {
$args = [$1];
} else {
$self->_line_error(sprintf(__("\@sp arg must be numeric, not `%s'"),
$line), $source_info);
}
} elsif ($command eq 'defindex' || $command eq 'defcodeindex') {
# REMACRO
if ($line =~ /^([[:alnum:]][[:alnum:]\-]*)$/) {
my $name = $1;
if ($forbidden_index_name{$name}) {
$self->_line_error(sprintf(
__("reserved index name %s"), $name), $source_info);
} else {
my $in_code = 0;
$in_code = 1 if ($command eq 'defcodeindex');
$args = [$name];
$self->{'index_names'}->{$name} = {'in_code' => $in_code};
if (!exists($self->{'index_names'}->{$name}->{'name'})) {
$self->{'index_names'}->{$name}->{'name'} = $name;
}
if (!exists($self->{'index_names'}->{$name}->{'contained_indices'})) {
$self->{'index_names'}->{$name}->{'contained_indices'} = {$name => 1};
}
$self->{'line_commands'}->{$name.'index'} = 'line';
$self->{'no_paragraph_commands'}->{$name.'index'} = 1;
$self->{'valid_nestings'}->{$name.'index'} = \%in_simple_text_commands;
$self->{'command_index'}->{$name.'index'} = $name;
}
} else {
$self->_line_error(sprintf(
__("bad argument to \@%s: %s"), $command, $line), $source_info);
}
} elsif ($command eq 'synindex' || $command eq 'syncodeindex') {
# REMACRO
if ($line =~ /^([[:alnum:]][[:alnum:]\-]*)\s+([[:alnum:]][[:alnum:]\-]*)$/) {
my $index_from = $1;
my $index_to = $2;
$self->_line_error(sprintf(__("unknown source index in \@%s: %s"),
$command, $index_from), $source_info)
unless $self->{'index_names'}->{$index_from};
$self->_line_error(sprintf(__("unknown destination index in \@%s: %s"),
$command, $index_to), $source_info)
unless $self->{'index_names'}->{$index_to};
if ($self->{'index_names'}->{$index_from}
and $self->{'index_names'}->{$index_to}) {
my $current_to = $index_to;
# find the merged indices recursively avoiding loops
while ($current_to ne $index_from
and $self->{'merged_indices'}->{$current_to}) {
$current_to = $self->{'merged_indices'}->{$current_to};
}
if ($current_to ne $index_from) {
my $index_from_info = $self->{'index_names'}->{$index_from};
my $index_to_info = $self->{'index_names'}->{$current_to};
my $in_code = 0;
$in_code = 1 if ($command eq 'syncodeindex');
$self->{'merged_indices'}->{$index_from} = $current_to;
$index_from_info->{'in_code'} = $in_code;
if ($index_from_info->{'contained_indices'}) {
foreach my $contained_index (keys %{$index_from_info->{'contained_indices'}}) {
$index_to_info->{'contained_indices'}->{$contained_index} = 1;
$self->{'index_names'}->{$contained_index}->{'merged_in'} = $current_to;
$self->{'merged_indices'}->{$contained_index} = $current_to;
}
delete $index_from_info->{'contained_indices'};
}
$index_from_info->{'merged_in'} = $current_to;
$index_to_info->{'contained_indices'}->{$index_from} = 1;
$args = [$index_from, $index_to];
} else {
$self->_line_warn(sprintf(__(
"\@%s leads to a merging of %s in itself, ignoring"),
$command, $index_from), $source_info);
}
}
} else {
$self->_line_error(sprintf(__("bad argument to \@%s: %s"),
$command, $line), $source_info);
}
} elsif ($command eq 'printindex') {
# REMACRO
if ($line =~ /^([[:alnum:]][[:alnum:]\-]*)$/) {
my $name = $1;
if (!exists($self->{'index_names'}->{$name})) {
$self->_line_error(sprintf(__("unknown index `%s' in \@printindex"),
$name), $source_info);
} else {
if ($self->{'merged_indices'}->{$name}) {
$self->_line_warn(sprintf(__(
"printing an index `%s' merged in another one, `%s'"),
$name, $self->{'merged_indices'}->{$name}),
$source_info);
}
if (!defined($self->{'current_node'})
and !defined($self->{'current_section'})
and !scalar(@{$self->{'regions_stack'}})) {
$self->_line_warn(sprintf(__(
"printindex before document beginning: \@printindex %s"),
$name), $source_info);
}
$args = [$name];
}
} else {
$self->_line_error(sprintf(
__("bad argument to \@%s: %s"), $command, $line), $source_info);
}
} elsif ($command eq 'fonttextsize') {
if ($line eq '10' or $line eq '11') {
$args = [$line];
} else {
$self->_line_error(sprintf(__(
"Only \@%s 10 or 11 is supported, not `%s'"),
$command, $line), $source_info);
}
} elsif ($command eq 'footnotestyle') {
if ($line eq 'separate' or $line eq 'end') {
$args = [$line];
} else {
$self->_line_error(sprintf(__(
"\@%s arg must be `separate' or `end', not `%s'"),
$command, $line), $source_info);
}
} elsif ($command eq 'setchapternewpage') {
if ($line eq 'on' or $line eq 'off' or $line eq 'odd') {
$args = [$line];
} else {
$self->_line_error(sprintf(__(
"\@%s arg must be `on', `off' or `odd', not `%s'"),
$command, $line), $source_info);
}
} elsif ($command eq 'need') { # only a warning
if (($line =~ /^([0-9]+(\.[0-9]*)?)$/) or
($line =~ /^(\.[0-9]+)$/)) {
$args = [$1];
} else {
$self->_line_error(sprintf(__("bad argument to \@%s: %s"),
$command, $line), $source_info);
}
} elsif ($command eq 'paragraphindent') {
if ($line =~ /^([\w\-]+)$/) {
my $value = $1;
if ($value =~ /^([0-9]+)$/ or $value eq 'none' or $value eq 'asis') {
$args = [$1];
} else {
$self->_line_error(sprintf(__(
"\@paragraphindent arg must be numeric/`none'/`asis', not `%s'"),
$value), $source_info);
}
} else {
$self->_line_error(sprintf(__(
"\@paragraphindent arg must be numeric/`none'/`asis', not `%s'"),
$line), $source_info);
}
} elsif ($command eq 'firstparagraphindent') {
if ($line eq 'none' or $line eq 'insert') {
$args = [$line];
} else {
$self->_line_error(sprintf(__(
"\@firstparagraphindent arg must be `none' or `insert', not `%s'"),
$line), $source_info);
}
} elsif ($command eq 'exampleindent') {
if ($line =~ /^([0-9]+)$/) {
$args = [$1];
} elsif ($line =~ /^(asis)$/) {
$args = [$1];
} else {
$self->_line_error(sprintf(__(
"\@exampleindent arg must be numeric/`asis', not `%s'"),
$line), $source_info);
}
} elsif ($command eq 'frenchspacing'
or $command eq 'xrefautomaticsectiontitle'
or $command eq 'codequoteundirected'
or $command eq 'codequotebacktick'
or $command eq 'deftypefnnewline'
or $command eq 'microtype') {
if ($line eq 'on' or $line eq 'off') {
$args = [$line];
} else {
$self->_line_error(sprintf(__("expected \@%s on or off, not `%s'"),
$command, $line), $source_info);
}
} elsif ($command eq 'kbdinputstyle') {
if ($line eq 'code' or $line eq 'example' or $line eq 'distinct') {
$self->{'kbdinputstyle'} = $line;
$args = [$line];
} else {
$self->_line_error(sprintf(__(
"\@kbdinputstyle arg must be `code'/`example'/`distinct', not `%s'"),
$line), $source_info);
}
} elsif ($command eq 'allowcodebreaks') {
if ($line eq 'true' or $line eq 'false') {
$args = [$line];
} else {
$self->_line_error(sprintf(__(
"\@allowcodebreaks arg must be `true' or `false', not `%s'"),
$line), $source_info);
}
} elsif ($command eq 'urefbreakstyle') {
if ($line eq 'after' or $line eq 'before' or $line eq 'none') {
$args = [$line];
} else {
$self->_line_error(sprintf(__(
"\@urefbreakstyle arg must be `after'/`before'/`none', not `%s'"),
$line), $source_info);
}
} elsif ($command eq 'headings') {
if ($line eq 'off' or $line eq 'on' or $line eq 'single'
or $line eq 'double' or $line eq 'singleafter' or $line eq 'doubleafter') {
$args = [$line];
} else {
$self->_line_error(sprintf(__("bad argument to \@%s: %s"),
$command, $line), $source_info);
}
} elsif (grep {$_ eq $command} ('everyheadingmarks', 'everyfootingmarks',
'evenheadingmarks', 'oddheadingmarks',
'evenfootingmarks', 'oddfootingmarks')) {
if ($line eq 'top' or $line eq 'bottom') {
$args = [$line];
} else {
$self->_line_error(sprintf(__(
"\@%s arg must be `top' or `bottom', not `%s'"),
$command, $line), $source_info);
}
}
return $args;
}
1;
__END__
=head1 NAME
Texinfo::Parser - Parse Texinfo code into a Perl tree
=head1 SYNOPSIS
use Texinfo::Parser;
my $parser = Texinfo::Parser::parser();
my $tree = $parser->parse_texi_file("somefile.texi");
# a Texinfo::Report object in which the errors and warnings
# encountered while parsing are registered.
my $registrar = $parser->registered_errors();
my ($errors, $errors_count) = $registrar->errors();
foreach my $error_message (@$errors) {
warn $error_message->{'error_line'};
}
my $index_names = $parser->indices_information();
my $float_types_arrays = $parser->floats_information();
my $internal_references_array
= $parser->internal_references_information();
# $labels_information is an hash reference on normalized node/float/anchor names.
my ($labels_information, $targets_list, $nodes_list) = $parser->labels_information();
# A hash reference, keys are @-command names, value is an
# array reference holding all the corresponding @-commands.
my $global_commands_information = $parser->global_commands_information();
# a hash reference on document information (encodings,
# input file name, dircategory and direntry list, for example).
my $global_information = $parser->global_information();
=head1 NOTES
The Texinfo Perl module main purpose is to be used in C to convert
Texinfo to other formats. There is no promise of API stability.
=head1 DESCRIPTION
C will parse Texinfo text into a Perl tree. In one pass
it expands user-defined @-commands, conditionals (C<@ifset>, C<@ifinfo>...)
and C<@value> and constructs the tree. Some extra information is gathered
while doing the tree: for example, the C<@quotation> associated to an C<@author>
command, the number of columns in a multitable, or the node associated with a
section.
=head1 METHODS
No method is exported in the default case. The module allows both
an object-oriented syntax, or traditional function, with the parser
as an opaque data structure given as an argument to every function.
=head2 Initialization
The following method is used to construct a new C object:
=over
=item $parser = Texinfo::Parser::parser($options);
X>
X
This method creates a new parser. The options may be provided as a hash
reference. Most of those options correspond to Texinfo customization options
described in the Texinfo manual.
=over
=item CPP_LINE_DIRECTIVES
Handle cpp like synchronization lines if set. Set in the default case.
=item EXPANDED_FORMATS
An array reference of the output formats for which C<@ifI>
conditional blocks should be expanded. Default is empty.
=item FORMAT_MENU
Possible values are C, C