summaryrefslogtreecommitdiffstats
path: root/lib/Locale/Po4a/Texinfo.pm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/Locale/Po4a/Texinfo.pm613
1 files changed, 613 insertions, 0 deletions
diff --git a/lib/Locale/Po4a/Texinfo.pm b/lib/Locale/Po4a/Texinfo.pm
new file mode 100644
index 0000000..ca8b289
--- /dev/null
+++ b/lib/Locale/Po4a/Texinfo.pm
@@ -0,0 +1,613 @@
+#!/usr/bin/perl -w
+
+# Copyright © 2004-2007 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.
+
+Only the comments starting with 'TRANSLATORS' are added to the PO files to guide the translators.
+
+=head1 STATUS OF THIS MODULE
+
+This module is still beta and not ready for production use.
+Please send patches to contribute, not bug reports as we don't know how to deal with them.
+
+=head1 OPTIONS ACCEPTED BY THIS MODULE
+
+These are this module's particular options:
+
+=over 4
+
+=item no-warn
+
+Do not warn about the current state of this module.
+
+=back
+
+=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 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 v2.0 or later (see the COPYING file).
+
+=cut
+
+package Locale::Po4a::Texinfo;
+
+use 5.16.0;
+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;
+
+ print STDERR "The TexInfo module of po4a is not ready for production use, and needs a new maintainer.\n"
+ . "Please contact the po4a team if you want to help: send us patches, not bug reports.\n"
+ . "(use -o no-warn to remove this message)\n"
+ unless $self->{options}{'no-warn'};
+ 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/ ) {
+ if ( $line =~ m/^\@(?:c|comment).*?TRANSLATORS:(.*)$/ ) {
+ $self->add_comment($1);
+ }
+ $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;
+ }
+ if ($description) {
+ ( $t, @e ) = $self->translate_buffer( $description, $no_wrap, @env );
+ }
+
+ # Replace newlines with space for proper wrapping
+ # See https://github.com/mquinson/po4a/issues/122
+ $t =~ s/\n/ /sg;
+
+ # Remove trailing spaces
+ $t =~ s/\s*$//;
+ $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 tindex 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 smallquotation
+ indentedblock smallindentedblock
+ raggedright)
+ )
+{
+ $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;
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-21 09:59:06 +0000