CloverBootloader/CloverPackage/package/bin/po4a/lib/Locale/Po4a/Texinfo.pm
2019-09-03 12:58:42 +03:00

546 lines
18 KiB
Perl

#!/usr/bin/perl -w
# Copyright (c) 2004-2007 by Nicolas FRANÇOIS <nicolas.francois@centraliens.net>
#
# This file is part of po4a.
#
# 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 2 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 po4a; if not, write to the Free Software
# Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
#
########################################################################
=encoding UTF-8
=head1 NAME
Locale::Po4a::Texinfo - convert Texinfo documents and derivates from/to PO files
=head1 DESCRIPTION
The po4a (PO for anything) project goal is to ease translations (and more
interestingly, the maintenance of translations) using gettext tools on
areas where they were not expected like documentation.
Locale::Po4a::Texinfo is a module to help the translation of Texinfo documents into
other [human] languages.
This module contains the definitions of common Texinfo commands and
environments.
=head1 STATUS OF THIS MODULE
This module is still beta.
Please send feedback and feature requests.
=head1 SEE ALSO
L<Locale::Po4a::TeX(3pm)|Locale::Po4a::TeX>,
L<Locale::Po4a::TransTractor(3pm)|Locale::Po4a::TransTractor>,
L<po4a(7)|po4a.7>
=head1 AUTHORS
Nicolas François <nicolas.francois@centraliens.net>
=head1 COPYRIGHT AND LICENSE
Copyright 2004-2007 by Nicolas FRANÇOIS <nicolas.francois@centraliens.net>.
This program is free software; you may redistribute it and/or modify it
under the terms of GPL (see COPYING file).
=cut
package Locale::Po4a::Texinfo;
use 5.006;
use strict;
use warnings;
require Exporter;
use vars qw($VERSION @ISA @EXPORT);
$VERSION= $Locale::Po4a::TeX::VERSION;
@ISA= qw(Locale::Po4a::TeX);
@EXPORT= qw();
use Locale::Po4a::Common;
use Locale::Po4a::TeX;
use subs qw(
&parse_definition_file
&register_generic_command &is_closed &translate_buffer
&register_verbatim_environment
&generic_command
&in_verbatim);
*parse_definition_file = \&Locale::Po4a::TeX::parse_definition_file;
*register_generic_command = \&Locale::Po4a::TeX::register_generic_command;
*register_verbatim_environment = \&Locale::Po4a::TeX::register_verbatim_environment;
*generic_command = \&Locale::Po4a::TeX::generic_command;
*is_closed = \&Locale::Po4a::TeX::is_closed;
*in_verbatim = \&Locale::Po4a::TeX::in_verbatim;
*translate_buffer = \&Locale::Po4a::TeX::translate_buffer;
use vars qw($RE_ESCAPE $ESCAPE
$RE_VERBATIM
$RE_COMMENT $RE_PRE_COMMENT
$no_wrap_environments $separated_commands
%commands %environments
%command_categories %separated
%env_separators %debug
%translate_buffer_env
@exclude_include @comments);
*RE_ESCAPE = \$Locale::Po4a::TeX::RE_ESCAPE;
*ESCAPE = \$Locale::Po4a::TeX::ESCAPE;
*RE_VERBATIM = \$Locale::Po4a::TeX::RE_VERBATIM;
*RE_COMMENT = \$Locale::Po4a::TeX::RE_COMMENT;
*RE_PRE_COMMENT = \$Locale::Po4a::TeX::RE_PRE_COMMENT;
*no_wrap_environments = \$Locale::Po4a::TeX::no_wrap_environments;
*separated_commands = \$Locale::Po4a::TeX::separated_commands;
*commands = \%Locale::Po4a::TeX::commands;
*environments = \%Locale::Po4a::TeX::environments;
*command_categories = \%Locale::Po4a::TeX::command_categories;
*separated = \%Locale::Po4a::TeX::separated;
*env_separators = \%Locale::Po4a::TeX::env_separators;
*debug = \%Locale::Po4a::TeX::debug;
*translate_buffer_env = \%Locale::Po4a::TeX::translate_buffer_env;
*exclude_include = \@Locale::Po4a::TeX::exclude_include;
*comments = \@Locale::Po4a::TeX::comments;
$ESCAPE = "\@";
$RE_ESCAPE = "\@";
$RE_VERBATIM = "\@example";
$RE_COMMENT = "\\\@(?:c|comment)\\b";
$RE_PRE_COMMENT = "(?<!\@)(?:\@\@)*";
my %break_line = ();
# translate_line_command indicate if the arguments to the command handled
# by line_command() should be translated:
# undefined: arguments are not translated
# 0: there should be no arguments
# 1: arguments should be translated
my %translate_line_command = ();
foreach (qw/example smallexample tex display smalldisplay verbatim format smallformat
flushleft flushright lisp smalllisp ignore/) {
register_verbatim_environment($_);
$commands{$_} = \&environment_line_command;
$translate_line_command{$_} = 0; # There should be no arguments
$break_line{$_} = 1;
}
my $docheader_pushed = 0;
# The header shall not be written before the Texinfo header (which include
# the \input command that define the texinfo macros)
sub docheader {
return "";
}
sub push_docheader {
return if $docheader_pushed;
my $self = shift;
$self->pushline(<<END);
\@c ===========================================================================
\@c
\@c This file was generated with po4a. Translate the source file.
\@c
\@c ===========================================================================
END
$docheader_pushed = 1;
}
sub parse {
my $self = shift;
my ($line,$ref);
my $paragraph = ""; # Buffer where we put the paragraph while building
my @env = (); # environment stack
my $t = "";
$docheader_pushed = 0;
LINE:
undef $self->{type};
($line,$ref)=$self->shiftline();
while (defined($line)) {
chomp($line);
$self->{ref}="$ref";
if ($line =~ /^\s*@\s*po4a\s*:/) {
parse_definition_line($self, $line);
goto LINE;
}
my $closed = 1;
if (!in_verbatim(@env)) {
$closed = is_closed($paragraph);
}
# if (not $closed) {
# print "not closed. line: '$line'\n para: '$paragraph'\n";
# }
if ($closed and $line =~ /^\s*$/) {
# An empty line. This indicates the end of the current
# paragraph.
$paragraph .= $line."\n";
if (length($paragraph)) {
($t, @env) = translate_buffer($self,$paragraph,undef,@env);
$self->pushline($t);
$paragraph="";
}
} elsif ($line =~ m/^\\input /) {
if (length($paragraph)) {
($t, @env) = translate_buffer($self,$paragraph,undef,@env);
$self->pushline($t);
$paragraph="";
}
$self->pushline($line."\n");
$self->push_docheader();
} elsif ($line =~ m/^$RE_COMMENT/) {
$self->push_docheader();
$self->pushline($line."\n");
} elsif ( $closed
and ($line =~ /^@([^ ]*?)(?: +(.*))?$/)
and (defined $commands{$1})
and ($break_line{$1})) {
if (length($paragraph)) {
($t, @env) = translate_buffer($self,$paragraph,undef,@env);
$self->pushline($t);
$paragraph="";
}
my $arg = $2;
my @args = ();
if (defined $arg and length $arg) {
# FIXME: keep the spaces ?
$arg =~ s/\s*$//s;
@args= (" ", $arg);
}
($t, @env) = &{$commands{$1}}($self, $1, "", \@args, \@env, 1);
$self->pushline($t."\n");
} else {
# continue the same paragraph
$paragraph .= $line."\n";
}
# Reinit the loop
($line,$ref)=$self->shiftline();
undef $self->{type};
}
if (length($paragraph)) {
($t, @env) = translate_buffer($self,$paragraph,undef,@env);
$self->pushline($t);
$paragraph="";
}
} # end of parse
sub line_command {
my $self = shift;
my ($command,$variant,$args,$env) = (shift,shift,shift,shift);
my $no_wrap = shift;
print "line_command($command,$variant,@$args,@$env,$no_wrap)="
if ($debug{'commands'});
my $translated = $ESCAPE.$command;
my $line = $args->[1];
if (defined $line and length $line) {
if ( defined $translate_line_command{$command}
and $translate_line_command{$command}) {
# $no_wrap could be forced to 1, but it should already be set
my ($t,$e) = $self->translate_buffer($line,$no_wrap,@$env,$command);
$translated .= " ".$t;
} else {
$translated .= " ".$line;
}
}
print "($translated,@$env)\n"
if ($debug{'commands'});
return ($translated,@$env);
}
sub defindex_line_command {
my $self = shift;
my ($command,$variant,$args,$env) = (shift,shift,shift,shift);
my $no_wrap = shift;
print "line_command($command,$variant,@$args,@$env,$no_wrap)="
if ($debug{'commands'});
my $idx = $$args[1]."index";
$commands{$idx} = \&line_command;
$break_line{$idx} = 1;
$translate_line_command{$idx} = 1;
return line_command($self,$command,$variant,$args,$env,$no_wrap);
}
sub translate_buffer_menu {
my ($self,$buffer,$no_wrap,@env) = (shift,shift,shift,@_);
print STDERR "translate_buffer_menu($buffer,$no_wrap,@env)="
if ($debug{'translate_buffer'});
my $translated_buffer = "";
my $spaces = "";
if ($buffer =~ m/(\s*)$/s) {
$spaces = $1;
}
while ($buffer =~ m/^(.*?)((?:\n|^)\* )(.*)$/s) {
my $sep = $2;
$buffer = $3;
my($t, @e) = $self->translate_buffer_menuentry($1, $no_wrap,
@env, "menuentry");
$translated_buffer .= $t.$sep;
}
my($t, @e) = $self->translate_buffer_menuentry($buffer, $no_wrap,
@env, "menuentry");
$translated_buffer .= $t;
$translated_buffer .= $spaces;
print STDERR "($translated_buffer,@env)\n"
if ($debug{'translate_buffer'});
return ($translated_buffer,@env);
}
$translate_buffer_env{"menu"} = \&translate_buffer_menu;
$translate_buffer_env{"detailmenu"} = \&translate_buffer_menu;
$translate_buffer_env{"direntry"} = \&translate_buffer_menu;
my $menu_width = 78;
my $menu_sep_width = 30;
sub translate_buffer_menuentry {
my ($self,$buffer,$no_wrap,@env) = (shift,shift,shift,@_);
print STDERR "translate_buffer_menuentry($buffer,$no_wrap,@env)="
if ($debug{'translate_buffer'});
my $translated_buffer = "";
if ( $buffer =~ m/^(.*?)(::)\s+(.*)$/s
or $buffer =~ m/^(.*?: .*?)(\.)\s+(.*)$/s) {
my ($name, $sep, $description) = ($1, $2, $3);
my ($t, @e) = $self->translate_buffer($name, $no_wrap, @env);
$translated_buffer = $t.$sep." ";
my $l = length($translated_buffer) + 2;
if ($l < $menu_sep_width-1) {
$translated_buffer .= ' 'x($menu_sep_width-1-$l);
$l = $menu_sep_width-1;
}
($t, @e) = $self->translate_buffer($description, $no_wrap, @env);
$t =~ s/\n//sg;
$t = Locale::Po4a::Po::wrap($t, $menu_width-$l-2);
my $spaces = ' 'x($l+2);
$t =~ s/\n/\n$spaces/sg;
$translated_buffer .= $t;
} else {
# FIXME: no-wrap if a line start by a space
my ($t, @e) = $self->translate_buffer($buffer, $no_wrap, @env);
$translated_buffer = $t;
}
print STDERR "($translated_buffer,@env)\n"
if ($debug{'translate_buffer'});
return ($translated_buffer,@env);
}
sub translate_buffer_ignore {
my ($self,$buffer,$no_wrap,@env) = (shift,shift,shift,@_);
print STDERR "translate_buffer_ignore($buffer,$no_wrap,@env);\n"
if ($debug{'translate_buffer'});
return ($buffer,@env);
}
$translate_buffer_env{"ignore"} = \&translate_buffer_ignore;
foreach (qw(appendix section cindex findex kindex opindex pindex vindex subsection
dircategory subtitle include
exdent center unnumberedsec
heading unnumbered unnumberedsubsec
unnumberedsubsubsec appendixsec appendixsubsec
appendixsubsubsec majorheading chapheading subheading
subsubheading shorttitlepage
subsubsection top item itemx chapter settitle
title author)) {
$commands{$_} = \&line_command;
$break_line{$_} = 1;
$translate_line_command{$_} = 1;
}
foreach (qw(c comment clear set setfilename setchapternewpage vskip synindex
syncodeindex need fonttextsize printindex headings finalout sp
definfoenclose)) {
$commands{$_} = \&line_command;
$break_line{$_} = 1;
}
foreach (qw(defcodeindex defindex)) {
$commands{$_} = \&defindex_line_command;
$break_line{$_} = 1;
}
# definfoenclose: command definition => translate?
foreach (qw(insertcopying page bye summarycontents shortcontents contents
noindent)) {
$commands{$_} = \&line_command;
$break_line{$_} = 1;
$translate_line_command{$_} = 0;
}
foreach (qw(defcv deffn
defivar defmac defmethod defop
defopt defspec deftp deftypecv
deftypefn deftypefun
deftypeivar deftypemethod
deftypeop deftypevar deftypevr
defun defvar defvr)) {
$commands{$_} = \&environment_line_command;
$translate_line_command{$_} = 1;
$break_line{$_} = 1;
}
foreach (qw(defcvx deffnx defivarx defmacx defmethodx defopx defoptx
defspecx deftpx deftypecvx deftypefnx deftypefunx deftypeivarx
deftypemethodx deftypeopx deftypevarx deftypevrx defunx
defvarx defvrx)) {
$commands{$_} = \&line_command;
$translate_line_command{$_} = 1;
$break_line{$_} = 1;
}
foreach (qw(titlefont w i r b sansserif sc slanted strong t cite email
footnote indicateurl emph ref xref pxref inforef kbd key
acronym),
# The following commands could cause problems since their arguments
# have a semantic and a translator could decide not to translate code but
# still translate theses short words if they appear in another context.
qw(file command dfn dmn option math code samp var)) {
register_generic_command("-$_,{_}");
}
register_generic_command("*anchor,{_}");
register_generic_command("*refill,");
$translate_line_command{'node'} = 1;
$no_wrap_environments .= " node";
$break_line{'node'} = 1;
# @node Comments, Minimum, Conventions, Overview
$commands{'node'} = sub {
my $self = shift;
my ($command,$variant,$args,$env) = (shift,shift,shift,shift);
my $no_wrap = shift;
print "node($command,$variant,@$args,@$env,$no_wrap)="
if ($debug{'commands'});
my $translated = $ESCAPE.$command;
my $line = $args->[1];
if (defined $line and length $line) {
my @pointers = split (/, */, $line);
my @t;
foreach (@pointers) {
push @t, $self->translate($_, $self->{ref}, $command, "wrap" => 0);
}
$translated .= " ".join(", ", @t);
}
print "($translated,@$env)\n"
if ($debug{'commands'});
return ($translated,@$env);
};
sub environment_command {
my $self = shift;
my ($command,$variant,$args,$env) = (shift,shift,shift,shift);
my $no_wrap = shift;
print "environment_command($command,$variant,@$args,@$env,$no_wrap)="
if ($debug{'commands'});
my ($t,@e)=("",());
($t, @e) = generic_command($self,$command,$variant,$args,$env,$no_wrap);
@e = (@$env, $command);
print "($t,@e)\n"
if ($debug{'commands'});
return ($t,@e);
}
sub environment_line_command {
my $self = shift;
my ($command,$variant,$args,$env) = (shift,shift,shift,shift);
my $no_wrap = shift;
print "environment_command_line($command,$variant,@$args,@$env,$no_wrap)="
if ($debug{'commands'});
my ($t,@e)=("",());
($t, @e) = line_command($self,$command,$variant,$args,$env,$no_wrap);
@e = (@$env, $command);
print "($t,@e)\n"
if ($debug{'commands'});
return ($t,@e);
}
## push the environment in the environment stack, and do not translate
## the command
#sub push_environment {
# my $self = shift;
# my ($command,$variant,$args,$env) = (shift,shift,shift,shift);
# print "push_environment($command,$variant,@$args,@$env)="
# if ($debug{'environments'});
#
# my ($t,@e) = generic_command($self,$command,$variant,$args,$env);
#
# print "($t,@e)\n"
# if ($debug{'environments'});
# return ($t,@e);
#}
#
foreach (qw(detailmenu menu titlepage group copying
documentdescription cartouche
direntry
ifdocbook ifhtml ifinfo ifplaintext iftex ifxml
ifnotdocbook ifnothtml ifnotinfo ifnotplaintext ifnottex ifnotxml)) {
$commands{$_} = \&environment_line_command;
$translate_line_command{$_} = 0;
$break_line{$_} = 1;
}
foreach (qw(enumerate multitable ifclear ifset)) {
$commands{$_} = \&environment_line_command;
$break_line{$_} = 1;
}
foreach (qw(quotation)) {
$commands{$_} = \&environment_line_command;
$translate_line_command{$_} = 1;
$break_line{$_} = 1;
}
$env_separators{'format'} = "(?:(?:^|\n)\\\*|END-INFO-DIR-ENTRY|START-INFO-DIR-ENTRY)";
$env_separators{'multitable'} = "(?:\@item|\@tab)";
my $end_command=$commands{'end'};
register_generic_command("*end, ");
$commands{'end'} = $end_command;
$break_line{'end'} = 1;
register_generic_command("*macro, ");
$commands{'macro'} = \&environment_command;
$break_line{'macro'} = 1;
register_generic_command("*itemize, ");
$commands{'itemize'} = \&environment_command;
$break_line{'itemize'} = 1;
register_generic_command("*table, ");
$commands{'table'} = \&environment_command;
$break_line{'table'} = 1;
# TODO: is_closed, use a regexp: \ does not escape the closing brace.
# TBC on LaTeX.
# In Texinfo, it appears with the "code" command. Maybe this command should
# be used as verbatim. (Expressions.texi)
# TODO: @include @ignore
# TBC: node Indices
1;