diff --git a/gramps2/ChangeLog b/gramps2/ChangeLog index a5e909a38..21937e38f 100644 --- a/gramps2/ChangeLog +++ b/gramps2/ChangeLog @@ -9,6 +9,7 @@ family relationships 2006-03-17 Alex Roitman + * intltool-*.in: remove from svn. * help: add new dir with new gnome-doc-utils infrastructure. * configure.in: Multiple improvements. diff --git a/gramps2/intltool-extract.in b/gramps2/intltool-extract.in deleted file mode 100644 index adfa97134..000000000 --- a/gramps2/intltool-extract.in +++ /dev/null @@ -1,839 +0,0 @@ -#!@INTLTOOL_PERL@ -w -# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*- - -# -# The Intltool Message Extractor -# -# Copyright (C) 2000-2001, 2003 Free Software Foundation. -# -# Intltool 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. -# -# Intltool 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, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. -# -# Authors: Kenneth Christiansen -# Darin Adler -# - -## Release information -my $PROGRAM = "intltool-extract"; -my $PACKAGE = "intltool"; -my $VERSION = "0.34.1"; - -## Loaded modules -use strict; -use File::Basename; -use Getopt::Long; - -## Scalars used by the option stuff -my $TYPE_ARG = "0"; -my $LOCAL_ARG = "0"; -my $HELP_ARG = "0"; -my $VERSION_ARG = "0"; -my $UPDATE_ARG = "0"; -my $QUIET_ARG = "0"; -my $SRCDIR_ARG = "."; - -my $FILE; -my $OUTFILE; - -my $gettext_type = ""; -my $input; -my %messages = (); -my %loc = (); -my %count = (); -my %comments = (); -my $strcount = 0; - -my $XMLCOMMENT = ""; - -## Use this instead of \w for XML files to handle more possible characters. -my $w = "[-A-Za-z0-9._:]"; - -## Always print first -$| = 1; - -## Handle options -GetOptions ( - "type=s" => \$TYPE_ARG, - "local|l" => \$LOCAL_ARG, - "help|h" => \$HELP_ARG, - "version|v" => \$VERSION_ARG, - "update" => \$UPDATE_ARG, - "quiet|q" => \$QUIET_ARG, - "srcdir=s" => \$SRCDIR_ARG, - ) or &error; - -&split_on_argument; - - -## Check for options. -## This section will check for the different options. - -sub split_on_argument { - - if ($VERSION_ARG) { - &version; - - } elsif ($HELP_ARG) { - &help; - - } elsif ($LOCAL_ARG) { - &place_local; - &extract; - - } elsif ($UPDATE_ARG) { - &place_normal; - &extract; - - } elsif (@ARGV > 0) { - &place_normal; - &message; - &extract; - - } else { - &help; - - } -} - -sub place_normal { - $FILE = $ARGV[0]; - $OUTFILE = "$FILE.h"; -} - -sub place_local { - $FILE = $ARGV[0]; - $OUTFILE = fileparse($FILE, ()); - if (!-e "tmp/") { - system("mkdir tmp/"); - } - $OUTFILE = "./tmp/$OUTFILE.h" -} - -sub determine_type { - if ($TYPE_ARG =~ /^gettext\/(.*)/) { - $gettext_type=$1 - } -} - -## Sub for printing release information -sub version{ - print <<_EOF_; -${PROGRAM} (${PACKAGE}) $VERSION -Copyright (C) 2000, 2003 Free Software Foundation, Inc. -Written by Kenneth Christiansen, 2000. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -_EOF_ - exit; -} - -## Sub for printing usage information -sub help { - print <<_EOF_; -Usage: ${PROGRAM} [OPTION]... [FILENAME] -Generates a header file from an XML source file. - -It grabs all strings between <_translatable_node> and its end tag in -XML files. Read manpage (man ${PROGRAM}) for more info. - - --type=TYPE Specify the file type of FILENAME. Currently supports: - "gettext/glade", "gettext/ini", "gettext/keys" - "gettext/rfc822deb", "gettext/schemas", - "gettext/scheme", "gettext/xml" - -l, --local Writes output into current working directory - (conflicts with --update) - --update Writes output into the same directory the source file - reside (conflicts with --local) - --srcdir Root of the source tree - -v, --version Output version information and exit - -h, --help Display this help and exit - -q, --quiet Quiet mode - -Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE") -or send email to . -_EOF_ - exit; -} - -## Sub for printing error messages -sub error{ - print STDERR "Try `${PROGRAM} --help' for more information.\n"; - exit; -} - -sub message { - print "Generating C format header file for translation.\n" unless $QUIET_ARG; -} - -sub extract { - &determine_type; - - &convert; - - open OUT, ">$OUTFILE"; - binmode (OUT) if $^O eq 'MSWin32'; - &msg_write; - close OUT; - - print "Wrote $OUTFILE\n" unless $QUIET_ARG; -} - -sub convert { - - ## Reading the file - { - local (*IN); - local $/; #slurp mode - open (IN, "<$SRCDIR_ARG/$FILE") || die "can't open $SRCDIR_ARG/$FILE: $!"; - $input = ; - } - - &type_ini if $gettext_type eq "ini"; - &type_keys if $gettext_type eq "keys"; - &type_xml if $gettext_type eq "xml"; - &type_glade if $gettext_type eq "glade"; - &type_scheme if $gettext_type eq "scheme"; - &type_schemas if $gettext_type eq "schemas"; - &type_rfc822deb if $gettext_type eq "rfc822deb"; -} - -sub entity_decode_minimal -{ - local ($_) = @_; - - s/'/'/g; # ' - s/"/"/g; # " - s/&/&/g; - - return $_; -} - -sub entity_decode -{ - local ($_) = @_; - - s/'/'/g; # ' - s/"/"/g; # " - s/&/&/g; - s/<//g; - - return $_; -} - -sub escape_char -{ - return '\"' if $_ eq '"'; - return '\n' if $_ eq "\n"; - return '\\' if $_ eq '\\'; - - return $_; -} - -sub escape -{ - my ($string) = @_; - return join "", map &escape_char, split //, $string; -} - -sub type_ini { - ### For generic translatable desktop files ### - while ($input =~ /^_.*=(.*)$/mg) { - $messages{$1} = []; - } -} - -sub type_keys { - ### For generic translatable mime/keys files ### - while ($input =~ /^\s*_\w+=(.*)$/mg) { - $messages{$1} = []; - } -} - -sub type_xml { - ### For generic translatable XML files ### - my $tree = readXml($input); - parseTree(0, $tree); -} - -sub print_var { - my $var = shift; - my $vartype = ref $var; - - if ($vartype =~ /ARRAY/) { - my @arr = @{$var}; - print "[ "; - foreach my $el (@arr) { - print_var($el); - print ", "; - } - print "] "; - } elsif ($vartype =~ /HASH/) { - my %hash = %{$var}; - print "{ "; - foreach my $key (keys %hash) { - print "$key => "; - print_var($hash{$key}); - print ", "; - } - print "} "; - } else { - print $var; - } -} - -# Same syntax as getAttributeString in intltool-merge.in.in, similar logic (look for ## differences comment) -sub getAttributeString -{ - my $sub = shift; - my $do_translate = shift || 1; - my $language = shift || ""; - my $translate = shift; - my $result = ""; - foreach my $e (reverse(sort(keys %{ $sub }))) { - my $key = $e; - my $string = $sub->{$e}; - my $quote = '"'; - - $string =~ s/^[\s]+//; - $string =~ s/[\s]+$//; - - if ($string =~ /^'.*'$/) - { - $quote = "'"; - } - $string =~ s/^['"]//g; - $string =~ s/['"]$//g; - - ## differences from intltool-merge.in.in - if ($key =~ /^_/) { - $comments{entity_decode($string)} = $XMLCOMMENT if $XMLCOMMENT; - $messages{entity_decode($string)} = []; - $$translate = 2; - } - ## differences end here from intltool-merge.in.in - $result .= " $key=$quote$string$quote"; - } - return $result; -} - -# Verbatim copy from intltool-merge.in.in -sub getXMLstring -{ - my $ref = shift; - my $spacepreserve = shift || 0; - my @list = @{ $ref }; - my $result = ""; - - my $count = scalar(@list); - my $attrs = $list[0]; - my $index = 1; - - $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); - $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); - - while ($index < $count) { - my $type = $list[$index]; - my $content = $list[$index+1]; - if (! $type ) { - # We've got CDATA - if ($content) { - # lets strip the whitespace here, and *ONLY* here - $content =~ s/\s+/ /gs if (!$spacepreserve); - $result .= $content; - } - } elsif ( "$type" ne "1" ) { - # We've got another element - $result .= "<$type"; - $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements - if ($content) { - my $subresult = getXMLstring($content, $spacepreserve); - if ($subresult) { - $result .= ">".$subresult . ""; - } else { - $result .= "/>"; - } - } else { - $result .= "/>"; - } - } - $index += 2; - } - return $result; -} - -# Verbatim copy from intltool-merge.in.in, except for MULTIPLE_OUTPUT handling removed -# Translate list of nodes if necessary -sub translate_subnodes -{ - my $fh = shift; - my $content = shift; - my $language = shift || ""; - my $singlelang = shift || 0; - my $spacepreserve = shift || 0; - - my @nodes = @{ $content }; - - my $count = scalar(@nodes); - my $index = 0; - while ($index < $count) { - my $type = $nodes[$index]; - my $rest = $nodes[$index+1]; - traverse($fh, $type, $rest, $language, $spacepreserve); - $index += 2; - } -} - -# Based on traverse() in intltool-merge.in.in -sub traverse -{ - my $fh = shift; # unused, to allow us to sync code between -merge and -extract - my $nodename = shift; - my $content = shift; - my $language = shift || ""; - my $spacepreserve = shift || 0; - - if ($nodename && "$nodename" eq "1") { - $XMLCOMMENT = $content; - } elsif ($nodename) { - # element - my @all = @{ $content }; - my $attrs = shift @all; - my $translate = 0; - my $outattr = getAttributeString($attrs, 1, $language, \$translate); - - if ($nodename =~ /^_/) { - $translate = 1; - $nodename =~ s/^_//; - } - my $lookup = ''; - - $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); - $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); - - if ($translate) { - $lookup = getXMLstring($content, $spacepreserve); - if (!$spacepreserve) { - $lookup =~ s/^\s+//s; - $lookup =~ s/\s+$//s; - } - - if ($lookup && $translate != 2) { - $comments{$lookup} = $XMLCOMMENT if $XMLCOMMENT; - $messages{$lookup} = []; - } elsif ($translate == 2) { - translate_subnodes($fh, \@all, $language, 1, $spacepreserve); - } - } else { - $XMLCOMMENT = ""; - my $count = scalar(@all); - if ($count > 0) { - my $index = 0; - while ($index < $count) { - my $type = $all[$index]; - my $rest = $all[$index+1]; - traverse($fh, $type, $rest, $language, $spacepreserve); - $index += 2; - } - } - } - $XMLCOMMENT = ""; - } -} - - -# Verbatim copy from intltool-merge.in.in, $fh for compatibility -sub parseTree -{ - my $fh = shift; - my $ref = shift; - my $language = shift || ""; - - my $name = shift @{ $ref }; - my $cont = shift @{ $ref }; - - while (!$name || "$name" eq "1") { - $name = shift @{ $ref }; - $cont = shift @{ $ref }; - } - - my $spacepreserve = 0; - my $attrs = @{$cont}[0]; - $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); - - traverse($fh, $name, $cont, $language, $spacepreserve); -} - -# Verbatim copy from intltool-merge.in.in -sub intltool_tree_comment -{ - my $expat = shift; - my $data = shift; - my $clist = $expat->{Curlist}; - my $pos = $#$clist; - - push @$clist, 1 => $data; -} - -# Verbatim copy from intltool-merge.in.in -sub intltool_tree_cdatastart -{ - my $expat = shift; - my $clist = $expat->{Curlist}; - my $pos = $#$clist; - - push @$clist, 0 => $expat->original_string(); -} - -# Verbatim copy from intltool-merge.in.in -sub intltool_tree_cdataend -{ - my $expat = shift; - my $clist = $expat->{Curlist}; - my $pos = $#$clist; - - $clist->[$pos] .= $expat->original_string(); -} - -# Verbatim copy from intltool-merge.in.in -sub intltool_tree_char -{ - my $expat = shift; - my $text = shift; - my $clist = $expat->{Curlist}; - my $pos = $#$clist; - - # Use original_string so that we retain escaped entities - # in CDATA sections. - # - if ($pos > 0 and $clist->[$pos - 1] eq '0') { - $clist->[$pos] .= $expat->original_string(); - } else { - push @$clist, 0 => $expat->original_string(); - } -} - -# Verbatim copy from intltool-merge.in.in -sub intltool_tree_start -{ - my $expat = shift; - my $tag = shift; - my @origlist = (); - - # Use original_string so that we retain escaped entities - # in attribute values. We must convert the string to an - # @origlist array to conform to the structure of the Tree - # Style. - # - my @original_array = split /\x/, $expat->original_string(); - my $source = $expat->original_string(); - - # Remove leading tag. - # - $source =~ s|^\s*<\s*(\S+)||s; - - # Grab attribute key/value pairs and push onto @origlist array. - # - while ($source) - { - if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/) - { - $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s; - push @origlist, $1; - push @origlist, '"' . $2 . '"'; - } - elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/) - { - $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s; - push @origlist, $1; - push @origlist, "'" . $2 . "'"; - } - else - { - last; - } - } - - my $ol = [ { @origlist } ]; - - push @{ $expat->{Lists} }, $expat->{Curlist}; - push @{ $expat->{Curlist} }, $tag => $ol; - $expat->{Curlist} = $ol; -} - -# Copied from intltool-merge.in.in and added comment handler. -sub readXml -{ - my $xmldoc = shift || return; - my $ret = eval 'require XML::Parser'; - if(!$ret) { - die "You must have XML::Parser installed to run $0\n\n"; - } - my $xp = new XML::Parser(Style => 'Tree'); - $xp->setHandlers(Char => \&intltool_tree_char); - $xp->setHandlers(Start => \&intltool_tree_start); - $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart); - $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend); - - ## differences from intltool-merge.in.in - $xp->setHandlers(Comment => \&intltool_tree_comment); - ## differences end here from intltool-merge.in.in - - my $tree = $xp->parse($xmldoc); - #print_var($tree); - -# Hello thereHowdydo -# would be: -# [foo, [{}, 1, "comment", head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]], bar, -# [{}, 0, "Howdy", ref, [{}]], 0, "do" ] ] - - return $tree; -} - -sub type_schemas { - ### For schemas XML files ### - - # FIXME: We should handle escaped < (less than) - while ($input =~ / - \s* - (\s*(?:\s*)?(.*?)\s*<\/default>\s*)? - (\s*(?:\s*)?(.*?)\s*<\/short>\s*)? - (\s*(?:\s*)?(.*?)\s*<\/long>\s*)? - <\/locale> - /sgx) { - my @totranslate = ($3,$6,$9); - my @eachcomment = ($2,$5,$8); - foreach (@totranslate) { - my $currentcomment = shift @eachcomment; - next if !$_; - s/\s+/ /g; - $messages{entity_decode_minimal($_)} = []; - $comments{entity_decode_minimal($_)} = $currentcomment if (defined($currentcomment)); - } - } -} - -sub type_rfc822deb { - ### For rfc822-style Debian configuration files ### - - my $lineno = 1; - my $type = ''; - while ($input =~ /\G(.*?)(^|\n)(_+)([^:]+):[ \t]*(.*?)(?=\n\S|$)/sg) - { - my ($pre, $newline, $underscore, $tag, $text) = ($1, $2, $3, $4, $5); - while ($pre =~ m/\n/g) - { - $lineno ++; - } - $lineno += length($newline); - my @str_list = rfc822deb_split(length($underscore), $text); - for my $str (@str_list) - { - $strcount++; - $messages{$str} = []; - $loc{$str} = $lineno; - $count{$str} = $strcount; - my $usercomment = ''; - while($pre =~ s/(^|\n)#([^\n]*)$//s) - { - $usercomment = "\n" . $2 . $usercomment; - } - $comments{$str} = $tag . $usercomment; - } - $lineno += ($text =~ s/\n//g); - } -} - -sub rfc822deb_split { - # Debian defines a special way to deal with rfc822-style files: - # when a value contain newlines, it consists of - # 1. a short form (first line) - # 2. a long description, all lines begin with a space, - # and paragraphs are separated by a single dot on a line - # This routine returns an array of all paragraphs, and reformat - # them. - # When first argument is 2, the string is a comma separated list of - # values. - my $type = shift; - my $text = shift; - $text =~ s/^[ \t]//mg; - return (split(/, */, $text, 0)) if $type ne 1; - return ($text) if $text !~ /\n/; - - $text =~ s/([^\n]*)\n//; - my @list = ($1); - my $str = ''; - for my $line (split (/\n/, $text)) - { - chomp $line; - if ($line =~ /^\.\s*$/) - { - # New paragraph - $str =~ s/\s*$//; - push(@list, $str); - $str = ''; - } - elsif ($line =~ /^\s/) - { - # Line which must not be reformatted - $str .= "\n" if length ($str) && $str !~ /\n$/; - $line =~ s/\s+$//; - $str .= $line."\n"; - } - else - { - # Continuation line, remove newline - $str .= " " if length ($str) && $str !~ /\n$/; - $str .= $line; - } - } - $str =~ s/\s*$//; - push(@list, $str) if length ($str); - return @list; -} - -sub type_glade { - ### For translatable Glade XML files ### - - my $tags = "label|title|text|format|copyright|comments|preview_text|tooltip|message"; - - while ($input =~ /<($tags)>([^<]+)<\/($tags)>/sg) { - # Glade sometimes uses tags that normally mark translatable things for - # little bits of non-translatable content. We work around this by not - # translating strings that only includes something like label4 or window1. - $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label|dialog)[0-9]+$/; - } - - while ($input =~ /(..[^<]*)<\/items>/sg) { - for my $item (split (/\n/, $1)) { - $messages{entity_decode($item)} = []; - } - } - - ## handle new glade files - while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"(?:\s+[^>]*comments\s*=\s*"([^"]*)")?[^>]*>([^<]+)<\/\1>/sg) { - $messages{entity_decode($3)} = [] unless $3 =~ /^(window|label)[0-9]+$/; - if (defined($2) and !($3 =~ /^(window|label)[0-9]+$/)) { - $comments{entity_decode($3)} = entity_decode($2) ; - } - } - while ($input =~ /]*)"\s+description="([^>]+)"\/>/sg) { - $messages{entity_decode_minimal($2)} = []; - } -} - -sub type_scheme { - my ($line, $i, $state, $str, $trcomment, $char); - for $line (split(/\n/, $input)) { - $i = 0; - $state = 0; # 0 - nothing, 1 - string, 2 - translatable string - while ($i < length($line)) { - if (substr($line,$i,1) eq "\"") { - if ($state == 2) { - $comments{$str} = $trcomment if ($trcomment); - $messages{$str} = []; - $str = ''; - $state = 0; $trcomment = ""; - } elsif ($state == 1) { - $str = ''; - $state = 0; $trcomment = ""; - } else { - $state = 1; - $str = ''; - if ($i>0 && substr($line,$i-1,1) eq '_') { - $state = 2; - } - } - } elsif (!$state) { - if (substr($line,$i,1) eq ";") { - $trcomment = substr($line,$i+1); - $trcomment =~ s/^;*\s*//; - $i = length($line); - } elsif ($trcomment && substr($line,$i,1) !~ /\s|\(|\)|_/) { - $trcomment = ""; - } - } else { - if (substr($line,$i,1) eq "\\") { - $char = substr($line,$i+1,1); - if ($char ne "\"" && $char ne "\\") { - $str = $str . "\\"; - } - $i++; - } - $str = $str . substr($line,$i,1); - } - $i++; - } - } -} - -sub msg_write { - my @msgids; - if (%count) - { - @msgids = sort { $count{$a} <=> $count{$b} } keys %count; - } - else - { - @msgids = sort keys %messages; - } - for my $message (@msgids) - { - my $offsetlines = 1; - $offsetlines++ if $message =~ /%/; - if (defined ($comments{$message})) - { - while ($comments{$message} =~ m/\n/g) - { - $offsetlines++; - } - } - print OUT "# ".($loc{$message} - $offsetlines). " \"$FILE\"\n" - if defined $loc{$message}; - print OUT "/* ".$comments{$message}." */\n" - if defined $comments{$message}; - print OUT "/* xgettext:no-c-format */\n" if $message =~ /%/; - - my @lines = split (/\n/, $message, -1); - for (my $n = 0; $n < @lines; $n++) - { - if ($n == 0) - { - print OUT "char *s = N_(\""; - } - else - { - print OUT " \""; - } - - print OUT escape($lines[$n]); - - if ($n < @lines - 1) - { - print OUT "\\n\"\n"; - } - else - { - print OUT "\");\n"; - } - } - } -} - diff --git a/gramps2/intltool-merge.in b/gramps2/intltool-merge.in deleted file mode 100644 index 9b3a539d8..000000000 --- a/gramps2/intltool-merge.in +++ /dev/null @@ -1,1356 +0,0 @@ -#!@INTLTOOL_PERL@ -w -# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*- - -# -# The Intltool Message Merger -# -# Copyright (C) 2000, 2003 Free Software Foundation. -# Copyright (C) 2000, 2001 Eazel, Inc -# -# Intltool is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# version 2 published by the Free Software Foundation. -# -# Intltool 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, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. -# -# Authors: Maciej Stachowiak -# Kenneth Christiansen -# Darin Adler -# -# Proper XML UTF-8'ification written by Cyrille Chepelov -# - -## Release information -my $PROGRAM = "intltool-merge"; -my $PACKAGE = "intltool"; -my $VERSION = "0.34.1"; - -## Loaded modules -use strict; -use Getopt::Long; -use Text::Wrap; -use File::Basename; - -my $must_end_tag = -1; -my $last_depth = -1; -my $translation_depth = -1; -my @tag_stack = (); -my @entered_tag = (); -my @translation_strings = (); -my $leading_space = ""; - -## Scalars used by the option stuff -my $HELP_ARG = 0; -my $VERSION_ARG = 0; -my $BA_STYLE_ARG = 0; -my $XML_STYLE_ARG = 0; -my $KEYS_STYLE_ARG = 0; -my $DESKTOP_STYLE_ARG = 0; -my $SCHEMAS_STYLE_ARG = 0; -my $RFC822DEB_STYLE_ARG = 0; -my $QUIET_ARG = 0; -my $PASS_THROUGH_ARG = 0; -my $UTF8_ARG = 0; -my $MULTIPLE_OUTPUT = 0; -my $cache_file; - -## Handle options -GetOptions -( - "help" => \$HELP_ARG, - "version" => \$VERSION_ARG, - "quiet|q" => \$QUIET_ARG, - "oaf-style|o" => \$BA_STYLE_ARG, ## for compatibility - "ba-style|b" => \$BA_STYLE_ARG, - "xml-style|x" => \$XML_STYLE_ARG, - "keys-style|k" => \$KEYS_STYLE_ARG, - "desktop-style|d" => \$DESKTOP_STYLE_ARG, - "schemas-style|s" => \$SCHEMAS_STYLE_ARG, - "rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG, - "pass-through|p" => \$PASS_THROUGH_ARG, - "utf8|u" => \$UTF8_ARG, - "multiple-output|m" => \$MULTIPLE_OUTPUT, - "cache|c=s" => \$cache_file - ) or &error; - -my $PO_DIR; -my $FILE; -my $OUTFILE; - -my %po_files_by_lang = (); -my %translations = (); -my $iconv = $ENV{"ICONV"} || $ENV{"INTLTOOL_ICONV"} || "/usr/bin/iconv"; -my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null'); - -# Use this instead of \w for XML files to handle more possible characters. -my $w = "[-A-Za-z0-9._:]"; - -# XML quoted string contents -my $q = "[^\\\"]*"; - -## Check for options. - -if ($VERSION_ARG) -{ - &print_version; -} -elsif ($HELP_ARG) -{ - &print_help; -} -elsif ($BA_STYLE_ARG && @ARGV > 2) -{ - &utf8_sanity_check; - &preparation; - &print_message; - &ba_merge_translations; - &finalize; -} -elsif ($XML_STYLE_ARG && @ARGV > 2) -{ - &utf8_sanity_check; - &preparation; - &print_message; - &xml_merge_output; - &finalize; -} -elsif ($KEYS_STYLE_ARG && @ARGV > 2) -{ - &utf8_sanity_check; - &preparation; - &print_message; - &keys_merge_translations; - &finalize; -} -elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) -{ - &utf8_sanity_check; - &preparation; - &print_message; - &desktop_merge_translations; - &finalize; -} -elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2) -{ - &utf8_sanity_check; - &preparation; - &print_message; - &schemas_merge_translations; - &finalize; -} -elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2) -{ - &preparation; - &print_message; - &rfc822deb_merge_translations; - &finalize; -} -else -{ - &print_help; -} - -exit; - -## Sub for printing release information -sub print_version -{ - print <<_EOF_; -${PROGRAM} (${PACKAGE}) ${VERSION} -Written by Maciej Stachowiak, Darin Adler and Kenneth Christiansen. - -Copyright (C) 2000-2003 Free Software Foundation, Inc. -Copyright (C) 2000-2001 Eazel, Inc. -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -_EOF_ - exit; -} - -## Sub for printing usage information -sub print_help -{ - print <<_EOF_; -Usage: ${PROGRAM} [OPTION]... PO_DIRECTORY FILENAME OUTPUT_FILE -Generates an output file that includes some localized attributes from an -untranslated source file. - -Mandatory options: (exactly one must be specified) - -b, --ba-style includes translations in the bonobo-activation style - -d, --desktop-style includes translations in the desktop style - -k, --keys-style includes translations in the keys style - -s, --schemas-style includes translations in the schemas style - -r, --rfc822deb-style includes translations in the RFC822 style - -x, --xml-style includes translations in the standard xml style - -Other options: - -u, --utf8 convert all strings to UTF-8 before merging - (default for everything except RFC822 style) - -p, --pass-through deprecated, does nothing and issues a warning - -m, --multiple-output output one localized file per locale, instead of - a single file containing all localized elements - -c, --cache=FILE specify cache file name - (usually \$top_builddir/po/.intltool-merge-cache) - -q, --quiet suppress most messages - --help display this help and exit - --version output version information and exit - -Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE") -or send email to . -_EOF_ - exit; -} - - -## Sub for printing error messages -sub print_error -{ - print STDERR "Try `${PROGRAM} --help' for more information.\n"; - exit; -} - - -sub print_message -{ - print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG; -} - - -sub preparation -{ - $PO_DIR = $ARGV[0]; - $FILE = $ARGV[1]; - $OUTFILE = $ARGV[2]; - - &gather_po_files; - &get_translation_database; -} - -# General-purpose code for looking up translations in .po files - -sub po_file2lang -{ - my ($tmp) = @_; - $tmp =~ s/^.*\/(.*)\.po$/$1/; - return $tmp; -} - -sub gather_po_files -{ - for my $po_file (glob "$PO_DIR/*.po") { - $po_files_by_lang{po_file2lang($po_file)} = $po_file; - } -} - -sub get_local_charset -{ - my ($encoding) = @_; - my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "/usr/lib/charset.alias"; - - # seek character encoding aliases in charset.alias (glib) - - if (open CHARSET_ALIAS, $alias_file) - { - while () - { - next if /^\#/; - return $1 if (/^\s*([-._a-zA-Z0-9]+)\s+$encoding\b/i) - } - - close CHARSET_ALIAS; - } - - # if not found, return input string - - return $encoding; -} - -sub get_po_encoding -{ - my ($in_po_file) = @_; - my $encoding = ""; - - open IN_PO_FILE, $in_po_file or die; - while () - { - ## example: "Content-Type: text/plain; charset=ISO-8859-1\n" - if (/Content-Type\:.*charset=([-a-zA-Z0-9]+)\\n/) - { - $encoding = $1; - last; - } - } - close IN_PO_FILE; - - if (!$encoding) - { - print STDERR "Warning: no encoding found in $in_po_file. Assuming ISO-8859-1\n" unless $QUIET_ARG; - $encoding = "ISO-8859-1"; - } - - system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull"); - if ($?) { - $encoding = get_local_charset($encoding); - } - - return $encoding -} - -sub utf8_sanity_check -{ - print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG; - $UTF8_ARG = 1; -} - -sub get_translation_database -{ - if ($cache_file) { - &get_cached_translation_database; - } else { - &create_translation_database; - } -} - -sub get_newest_po_age -{ - my $newest_age; - - foreach my $file (values %po_files_by_lang) - { - my $file_age = -M $file; - $newest_age = $file_age if !$newest_age || $file_age < $newest_age; - } - - $newest_age = 0 if !$newest_age; - - return $newest_age; -} - -sub create_cache -{ - print "Generating and caching the translation database\n" unless $QUIET_ARG; - - &create_translation_database; - - open CACHE, ">$cache_file" || die; - print CACHE join "\x01", %translations; - close CACHE; -} - -sub load_cache -{ - print "Found cached translation database\n" unless $QUIET_ARG; - - my $contents; - open CACHE, "<$cache_file" || die; - { - local $/; - $contents = ; - } - close CACHE; - %translations = split "\x01", $contents; -} - -sub get_cached_translation_database -{ - my $cache_file_age = -M $cache_file; - if (defined $cache_file_age) - { - if ($cache_file_age <= &get_newest_po_age) - { - &load_cache; - return; - } - print "Found too-old cached translation database\n" unless $QUIET_ARG; - } - - &create_cache; -} - -sub create_translation_database -{ - for my $lang (keys %po_files_by_lang) - { - my $po_file = $po_files_by_lang{$lang}; - - if ($UTF8_ARG) - { - my $encoding = get_po_encoding ($po_file); - - if (lc $encoding eq "utf-8") - { - open PO_FILE, "<$po_file"; - } - else - { - print STDERR "WARNING: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;; - - open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|"; - } - } - else - { - open PO_FILE, "<$po_file"; - } - - my $nextfuzzy = 0; - my $inmsgid = 0; - my $inmsgstr = 0; - my $msgid = ""; - my $msgstr = ""; - - while () - { - $nextfuzzy = 1 if /^#, fuzzy/; - - if (/^msgid "((\\.|[^\\])*)"/ ) - { - $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr; - $msgid = ""; - $msgstr = ""; - - if ($nextfuzzy) { - $inmsgid = 0; - } else { - $msgid = unescape_po_string($1); - $inmsgid = 1; - } - $inmsgstr = 0; - $nextfuzzy = 0; - } - - if (/^msgstr "((\\.|[^\\])*)"/) - { - $msgstr = unescape_po_string($1); - $inmsgstr = 1; - $inmsgid = 0; - } - - if (/^"((\\.|[^\\])*)"/) - { - $msgid .= unescape_po_string($1) if $inmsgid; - $msgstr .= unescape_po_string($1) if $inmsgstr; - } - } - $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr; - } -} - -sub finalize -{ -} - -sub unescape_one_sequence -{ - my ($sequence) = @_; - - return "\\" if $sequence eq "\\\\"; - return "\"" if $sequence eq "\\\""; - return "\n" if $sequence eq "\\n"; - return "\r" if $sequence eq "\\r"; - return "\t" if $sequence eq "\\t"; - return "\b" if $sequence eq "\\b"; - return "\f" if $sequence eq "\\f"; - return "\a" if $sequence eq "\\a"; - return chr(11) if $sequence eq "\\v"; # vertical tab, see ascii(7) - - return chr(hex($1)) if ($sequence =~ /\\x([0-9a-fA-F]{2})/); - return chr(oct($1)) if ($sequence =~ /\\([0-7]{3})/); - - # FIXME: Is \0 supported as well? Kenneth and Rodney don't want it, see bug #48489 - - return $sequence; -} - -sub unescape_po_string -{ - my ($string) = @_; - - $string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg; - - return $string; -} - -## NOTE: deal with < - < but not > - > because it seems its ok to have -## > in the entity. For further info please look at #84738. -sub entity_decode -{ - local ($_) = @_; - - s/'/'/g; # ' - s/"/"/g; # " - s/&/&/g; - s/</; - close INPUT; - } - - open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!"; - # Binmode so that selftest works ok if using a native Win32 Perl... - binmode (OUTPUT) if $^O eq 'MSWin32'; - - while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) - { - print OUTPUT $1; - - my $node = $2 . "\n"; - - my @strings = (); - $_ = $node; - while (s/(\s)_($w+\s*=\s*"($q)")/$1$2/s) { - push @strings, entity_decode($3); - } - print OUTPUT; - - my %langs; - for my $string (@strings) - { - for my $lang (keys %po_files_by_lang) - { - $langs{$lang} = 1 if $translations{$lang, $string}; - } - } - - for my $lang (sort keys %langs) - { - $_ = $node; - s/(\sname\s*=\s*)"($q)"/$1"$2-$lang"/s; - s/(\s)_($w+\s*=\s*")($q)"/$1 . $2 . entity_encoded_translation($lang, $3) . '"'/seg; - print OUTPUT; - } - } - - print OUTPUT $source; - - close OUTPUT; -} - - -## XML (non-bonobo-activation) merge code - - -# Process tag attributes -# Only parameter is a HASH containing attributes -> values mapping -sub getAttributeString -{ - my $sub = shift; - my $do_translate = shift || 0; - my $language = shift || ""; - my $result = ""; - my $translate = shift; - foreach my $e (reverse(sort(keys %{ $sub }))) { - my $key = $e; - my $string = $sub->{$e}; - my $quote = '"'; - - $string =~ s/^[\s]+//; - $string =~ s/[\s]+$//; - - if ($string =~ /^'.*'$/) - { - $quote = "'"; - } - $string =~ s/^['"]//g; - $string =~ s/['"]$//g; - - if ($do_translate && $key =~ /^_/) { - $key =~ s|^_||g; - if ($language) { - # Handle translation - my $decode_string = entity_decode($string); - my $translation = $translations{$language, $decode_string}; - if ($translation) { - $translation = entity_encode($translation); - $string = $translation; - } - $$translate = 2; - } else { - $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate - } - } - - $result .= " $key=$quote$string$quote"; - } - return $result; -} - -# Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree -sub getXMLstring -{ - my $ref = shift; - my $spacepreserve = shift || 0; - my @list = @{ $ref }; - my $result = ""; - - my $count = scalar(@list); - my $attrs = $list[0]; - my $index = 1; - - $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); - $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); - - while ($index < $count) { - my $type = $list[$index]; - my $content = $list[$index+1]; - if (! $type ) { - # We've got CDATA - if ($content) { - # lets strip the whitespace here, and *ONLY* here - $content =~ s/\s+/ /gs if (!$spacepreserve); - $result .= $content; - } - } elsif ( "$type" ne "1" ) { - # We've got another element - $result .= "<$type"; - $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements - if ($content) { - my $subresult = getXMLstring($content, $spacepreserve); - if ($subresult) { - $result .= ">".$subresult . ""; - } else { - $result .= "/>"; - } - } else { - $result .= "/>"; - } - } - $index += 2; - } - return $result; -} - -# Translate list of nodes if necessary -sub translate_subnodes -{ - my $fh = shift; - my $content = shift; - my $language = shift || ""; - my $singlelang = shift || 0; - my $spacepreserve = shift || 0; - - my @nodes = @{ $content }; - - my $count = scalar(@nodes); - my $index = 0; - while ($index < $count) { - my $type = $nodes[$index]; - my $rest = $nodes[$index+1]; - if ($singlelang) { - my $oldMO = $MULTIPLE_OUTPUT; - $MULTIPLE_OUTPUT = 1; - traverse($fh, $type, $rest, $language, $spacepreserve); - $MULTIPLE_OUTPUT = $oldMO; - } else { - traverse($fh, $type, $rest, $language, $spacepreserve); - } - $index += 2; - } -} - -sub isWellFormedXmlFragment -{ - my $ret = eval 'require XML::Parser'; - if(!$ret) { - die "You must have XML::Parser installed to run $0\n\n"; - } - - my $fragment = shift; - return 0 if (!$fragment); - - $fragment = "$fragment"; - my $xp = new XML::Parser(Style => 'Tree'); - my $tree = 0; - eval { $tree = $xp->parse($fragment); }; - return $tree; -} - -sub traverse -{ - my $fh = shift; - my $nodename = shift; - my $content = shift; - my $language = shift || ""; - my $spacepreserve = shift || 0; - - if (!$nodename) { - if ($content =~ /^[\s]*$/) { - $leading_space .= $content; - } - print $fh $content; - } else { - # element - my @all = @{ $content }; - my $attrs = shift @all; - my $translate = 0; - my $outattr = getAttributeString($attrs, 1, $language, \$translate); - - if ($nodename =~ /^_/) { - $translate = 1; - $nodename =~ s/^_//; - } - my $lookup = ''; - - $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); - $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); - - print $fh "<$nodename", $outattr; - if ($translate) { - $lookup = getXMLstring($content, $spacepreserve); - if (!$spacepreserve) { - $lookup =~ s/^\s+//s; - $lookup =~ s/\s+$//s; - } - - if ($lookup || $translate == 2) { - my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup}); - if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) { - $translation = $lookup if (!$translation); - print $fh " xml:lang=\"", $language, "\"" if $language; - print $fh ">"; - if ($translate == 2) { - translate_subnodes($fh, \@all, $language, 1, $spacepreserve); - } else { - print $fh $translation; - } - print $fh ""; - - return; # this means there will be no same translation with xml:lang="$language"... - # if we want them both, just remove this "return" - } else { - print $fh ">"; - if ($translate == 2) { - translate_subnodes($fh, \@all, $language, 1, $spacepreserve); - } else { - print $fh $lookup; - } - print $fh ""; - } - } else { - print $fh "/>"; - } - - for my $lang (sort keys %po_files_by_lang) { - if ($MULTIPLE_OUTPUT && $lang ne "$language") { - next; - } - if ($lang) { - # Handle translation - # - my $translate = 0; - my $localattrs = getAttributeString($attrs, 1, $lang, \$translate); - my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup}); - if ($translate && !$translation) { - $translation = $lookup; - } - - if ($translation || $translate) { - print $fh "\n"; - $leading_space =~ s/.*\n//g; - print $fh $leading_space; - print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">"; - if ($translate == 2) { - translate_subnodes($fh, \@all, $lang, 1, $spacepreserve); - } else { - print $fh $translation; - } - print $fh ""; - } - } - } - - } else { - my $count = scalar(@all); - if ($count > 0) { - print $fh ">"; - my $index = 0; - while ($index < $count) { - my $type = $all[$index]; - my $rest = $all[$index+1]; - traverse($fh, $type, $rest, $language, $spacepreserve); - $index += 2; - } - print $fh ""; - } else { - print $fh "/>"; - } - } - } -} - -sub intltool_tree_comment -{ - my $expat = shift; - my $data = shift; - my $clist = $expat->{Curlist}; - my $pos = $#$clist; - - push @$clist, 1 => $data; -} - -sub intltool_tree_cdatastart -{ - my $expat = shift; - my $clist = $expat->{Curlist}; - my $pos = $#$clist; - - push @$clist, 0 => $expat->original_string(); -} - -sub intltool_tree_cdataend -{ - my $expat = shift; - my $clist = $expat->{Curlist}; - my $pos = $#$clist; - - $clist->[$pos] .= $expat->original_string(); -} - -sub intltool_tree_char -{ - my $expat = shift; - my $text = shift; - my $clist = $expat->{Curlist}; - my $pos = $#$clist; - - # Use original_string so that we retain escaped entities - # in CDATA sections. - # - if ($pos > 0 and $clist->[$pos - 1] eq '0') { - $clist->[$pos] .= $expat->original_string(); - } else { - push @$clist, 0 => $expat->original_string(); - } -} - -sub intltool_tree_start -{ - my $expat = shift; - my $tag = shift; - my @origlist = (); - - # Use original_string so that we retain escaped entities - # in attribute values. We must convert the string to an - # @origlist array to conform to the structure of the Tree - # Style. - # - my @original_array = split /\x/, $expat->original_string(); - my $source = $expat->original_string(); - - # Remove leading tag. - # - $source =~ s|^\s*<\s*(\S+)||s; - - # Grab attribute key/value pairs and push onto @origlist array. - # - while ($source) - { - if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/) - { - $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s; - push @origlist, $1; - push @origlist, '"' . $2 . '"'; - } - elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/) - { - $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s; - push @origlist, $1; - push @origlist, "'" . $2 . "'"; - } - else - { - last; - } - } - - my $ol = [ { @origlist } ]; - - push @{ $expat->{Lists} }, $expat->{Curlist}; - push @{ $expat->{Curlist} }, $tag => $ol; - $expat->{Curlist} = $ol; -} - -sub readXml -{ - my $filename = shift || return; - if(!-f $filename) { - die "ERROR Cannot find filename: $filename\n"; - } - - my $ret = eval 'require XML::Parser'; - if(!$ret) { - die "You must have XML::Parser installed to run $0\n\n"; - } - my $xp = new XML::Parser(Style => 'Tree'); - $xp->setHandlers(Char => \&intltool_tree_char); - $xp->setHandlers(Start => \&intltool_tree_start); - $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart); - $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend); - my $tree = $xp->parsefile($filename); - -# Hello thereHowdydo -# would be: -# [foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]], bar, [{}, -# 0, "Howdy", ref, [{}]], 0, "do" ] ] - - return $tree; -} - -sub print_header -{ - my $infile = shift; - my $fh = shift; - my $source; - - if(!-f $infile) { - die "ERROR Cannot find filename: $infile\n"; - } - - print $fh qq{\n}; - { - local $/; - open DOCINPUT, "<${FILE}" or die; - $source = ; - close DOCINPUT; - } - if ($source =~ /()/s) - { - print $fh "$1\n"; - } - elsif ($source =~ /(]*>)/s) - { - print $fh "$1\n"; - } -} - -sub parseTree -{ - my $fh = shift; - my $ref = shift; - my $language = shift || ""; - - my $name = shift @{ $ref }; - my $cont = shift @{ $ref }; - - while (!$name || "$name" eq "1") { - $name = shift @{ $ref }; - $cont = shift @{ $ref }; - } - - my $spacepreserve = 0; - my $attrs = @{$cont}[0]; - $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); - - traverse($fh, $name, $cont, $language, $spacepreserve); -} - -sub xml_merge_output -{ - my $source; - - if ($MULTIPLE_OUTPUT) { - for my $lang (sort keys %po_files_by_lang) { - if ( ! -e $lang ) { - mkdir $lang or die "Cannot create subdirectory $lang: $!\n"; - } - open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n"; - binmode (OUTPUT) if $^O eq 'MSWin32'; - my $tree = readXml($FILE); - print_header($FILE, \*OUTPUT); - parseTree(\*OUTPUT, $tree, $lang); - close OUTPUT; - print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG; - } - } - open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n"; - binmode (OUTPUT) if $^O eq 'MSWin32'; - my $tree = readXml($FILE); - print_header($FILE, \*OUTPUT); - parseTree(\*OUTPUT, $tree); - close OUTPUT; - print "CREATED $OUTFILE\n" unless $QUIET_ARG; -} - -sub keys_merge_translations -{ - open INPUT, "<${FILE}" or die; - open OUTPUT, ">${OUTFILE}" or die; - binmode (OUTPUT) if $^O eq 'MSWin32'; - - while () - { - if (s/^(\s*)_(\w+=(.*))/$1$2/) - { - my $string = $3; - - print OUTPUT; - - my $non_translated_line = $_; - - for my $lang (sort keys %po_files_by_lang) - { - my $translation = $translations{$lang, $string}; - next if !$translation; - - $_ = $non_translated_line; - s/(\w+)=.*/[$lang]$1=$translation/; - print OUTPUT; - } - } - else - { - print OUTPUT; - } - } - - close OUTPUT; - close INPUT; -} - -sub desktop_merge_translations -{ - open INPUT, "<${FILE}" or die; - open OUTPUT, ">${OUTFILE}" or die; - binmode (OUTPUT) if $^O eq 'MSWin32'; - - while () - { - if (s/^(\s*)_(\w+=(.*))/$1$2/) - { - my $string = $3; - - print OUTPUT; - - my $non_translated_line = $_; - - for my $lang (sort keys %po_files_by_lang) - { - my $translation = $translations{$lang, $string}; - next if !$translation; - - $_ = $non_translated_line; - s/(\w+)=.*/${1}[$lang]=$translation/; - print OUTPUT; - } - } - else - { - print OUTPUT; - } - } - - close OUTPUT; - close INPUT; -} - -sub schemas_merge_translations -{ - my $source; - - { - local $/; # slurp mode - open INPUT, "<$FILE" or die "can't open $FILE: $!"; - $source = ; - close INPUT; - } - - open OUTPUT, ">$OUTFILE" or die; - binmode (OUTPUT) if $^O eq 'MSWin32'; - - # FIXME: support attribute translations - - # Empty nodes never need translation, so unmark all of them. - # For example, <_foo/> is just replaced by . - $source =~ s|<\s*_($w+)\s*/>|<$1/>|g; - - while ($source =~ s/ - (.*?) - (\s+)((\s*) - (\s*(?:\s*)?(.*?)\s*<\/default>)?(\s*) - (\s*(?:\s*)?(.*?)\s*<\/short>)?(\s*) - (\s*(?:\s*)?(.*?)\s*<\/long>)?(\s*) - <\/locale>) - //sx) - { - print OUTPUT $1; - - my $locale_start_spaces = $2 ? $2 : ''; - my $default_spaces = $4 ? $4 : ''; - my $short_spaces = $7 ? $7 : ''; - my $long_spaces = $10 ? $10 : ''; - my $locale_end_spaces = $13 ? $13 : ''; - my $c_default_block = $3 ? $3 : ''; - my $default_string = $6 ? $6 : ''; - my $short_string = $9 ? $9 : ''; - my $long_string = $12 ? $12 : ''; - - print OUTPUT "$locale_start_spaces$c_default_block"; - - $default_string =~ s/\s+/ /g; - $default_string = entity_decode($default_string); - $short_string =~ s/\s+/ /g; - $short_string = entity_decode($short_string); - $long_string =~ s/\s+/ /g; - $long_string = entity_decode($long_string); - - for my $lang (sort keys %po_files_by_lang) - { - my $default_translation = $translations{$lang, $default_string}; - my $short_translation = $translations{$lang, $short_string}; - my $long_translation = $translations{$lang, $long_string}; - - next if (!$default_translation && !$short_translation && - !$long_translation); - - print OUTPUT "\n$locale_start_spaces"; - - print OUTPUT "$default_spaces"; - - if ($default_translation) - { - $default_translation = entity_encode($default_translation); - print OUTPUT "$default_translation"; - } - - print OUTPUT "$short_spaces"; - - if ($short_translation) - { - $short_translation = entity_encode($short_translation); - print OUTPUT "$short_translation"; - } - - print OUTPUT "$long_spaces"; - - if ($long_translation) - { - $long_translation = entity_encode($long_translation); - print OUTPUT "$long_translation"; - } - - print OUTPUT "$locale_end_spaces"; - } - } - - print OUTPUT $source; - - close OUTPUT; -} - -sub rfc822deb_merge_translations -{ - my %encodings = (); - for my $lang (keys %po_files_by_lang) { - $encodings{$lang} = ($UTF8_ARG ? 'UTF-8' : get_po_encoding($po_files_by_lang{$lang})); - } - - my $source; - - $Text::Wrap::huge = 'overflow'; - $Text::Wrap::break = qr/\n|\s(?=\S)/; - - { - local $/; # slurp mode - open INPUT, "<$FILE" or die "can't open $FILE: $!"; - $source = ; - close INPUT; - } - - open OUTPUT, ">${OUTFILE}" or die; - binmode (OUTPUT) if $^O eq 'MSWin32'; - - while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg) - { - my $sep = $1; - my $non_translated_line = $3.$4; - my $string = $5; - my $underscore = length($2); - next if $underscore eq 0 && $non_translated_line =~ /^#/; - # Remove [] dummy strings - my $stripped = $string; - $stripped =~ s/\[\s[^\[\]]*\],/,/g if $underscore eq 2; - $stripped =~ s/\[\s[^\[\]]*\]$//; - $non_translated_line .= $stripped; - - print OUTPUT $sep.$non_translated_line; - - if ($underscore) - { - my @str_list = rfc822deb_split($underscore, $string); - - for my $lang (sort keys %po_files_by_lang) - { - my $is_translated = 1; - my $str_translated = ''; - my $first = 1; - - for my $str (@str_list) - { - my $translation = $translations{$lang, $str}; - - if (!$translation) - { - $is_translated = 0; - last; - } - - # $translation may also contain [] dummy - # strings, mostly to indicate an empty string - $translation =~ s/\[\s[^\[\]]*\]$//; - - if ($first) - { - if ($underscore eq 2) - { - $str_translated .= $translation; - } - else - { - $str_translated .= - Text::Tabs::expand($translation) . - "\n"; - } - } - else - { - if ($underscore eq 2) - { - $str_translated .= ', ' . $translation; - } - else - { - $str_translated .= Text::Tabs::expand( - Text::Wrap::wrap(' ', ' ', $translation)) . - "\n .\n"; - } - } - $first = 0; - - # To fix some problems with Text::Wrap::wrap - $str_translated =~ s/(\n )+\n/\n .\n/g; - } - next unless $is_translated; - - $str_translated =~ s/\n \.\n$//; - $str_translated =~ s/\s+$//; - - $_ = $non_translated_line; - s/^(\w+):\s*.*/$sep${1}-$lang.$encodings{$lang}: $str_translated/s; - print OUTPUT; - } - } - } - print OUTPUT "\n"; - - close OUTPUT; - close INPUT; -} - -sub rfc822deb_split -{ - # Debian defines a special way to deal with rfc822-style files: - # when a value contain newlines, it consists of - # 1. a short form (first line) - # 2. a long description, all lines begin with a space, - # and paragraphs are separated by a single dot on a line - # This routine returns an array of all paragraphs, and reformat - # them. - # When first argument is 2, the string is a comma separated list of - # values. - my $type = shift; - my $text = shift; - $text =~ s/^[ \t]//mg; - return (split(/, */, $text, 0)) if $type ne 1; - return ($text) if $text !~ /\n/; - - $text =~ s/([^\n]*)\n//; - my @list = ($1); - my $str = ''; - - for my $line (split (/\n/, $text)) - { - chomp $line; - if ($line =~ /^\.\s*$/) - { - # New paragraph - $str =~ s/\s*$//; - push(@list, $str); - $str = ''; - } - elsif ($line =~ /^\s/) - { - # Line which must not be reformatted - $str .= "\n" if length ($str) && $str !~ /\n$/; - $line =~ s/\s+$//; - $str .= $line."\n"; - } - else - { - # Continuation line, remove newline - $str .= " " if length ($str) && $str !~ /\n$/; - $str .= $line; - } - } - - $str =~ s/\s*$//; - push(@list, $str) if length ($str); - - return @list; -} - diff --git a/gramps2/intltool-update.in b/gramps2/intltool-update.in deleted file mode 100644 index f251956ca..000000000 --- a/gramps2/intltool-update.in +++ /dev/null @@ -1,1065 +0,0 @@ -#!@INTLTOOL_PERL@ -w -# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*- - -# -# The Intltool Message Updater -# -# Copyright (C) 2000-2003 Free Software Foundation. -# -# Intltool is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# version 2 published by the Free Software Foundation. -# -# Intltool 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, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. -# -# Authors: Kenneth Christiansen -# Maciej Stachowiak -# Darin Adler - -## Release information -my $PROGRAM = "intltool-update"; -my $VERSION = "0.34.1"; -my $PACKAGE = "intltool"; - -## Loaded modules -use strict; -use Getopt::Long; -use Cwd; -use File::Copy; -use File::Find; - -## Scalars used by the option stuff -my $HELP_ARG = 0; -my $VERSION_ARG = 0; -my $DIST_ARG = 0; -my $POT_ARG = 0; -my $HEADERS_ARG = 0; -my $MAINTAIN_ARG = 0; -my $REPORT_ARG = 0; -my $VERBOSE = 0; -my $GETTEXT_PACKAGE = ""; -my $OUTPUT_FILE = ""; - -my @languages; -my %varhash = (); -my %po_files_by_lang = (); - -# Regular expressions to categorize file types. -# FIXME: Please check if the following is correct - -my $xml_support = -"xml(?:\\.in)*|". # http://www.w3.org/XML/ (Note: .in is not required) -"ui|". # Bonobo specific - User Interface desc. files -"lang|". # ? -"glade2?(?:\\.in)*|". # Glade specific - User Interface desc. files (Note: .in is not required) -"scm(?:\\.in)*|". # ? (Note: .in is not required) -"oaf(?:\\.in)+|". # DEPRECATED: Replaces by Bonobo .server files -"etspec|". # ? -"server(?:\\.in)+|". # Bonobo specific -"sheet(?:\\.in)+|". # ? -"schemas(?:\\.in)+|". # GConf specific -"pong(?:\\.in)+|". # DEPRECATED: PONG is not used [by GNOME] any longer. -"kbd(?:\\.in)+"; # GOK specific. - -my $ini_support = -"icon(?:\\.in)+|". # http://www.freedesktop.org/Standards/icon-theme-spec -"desktop(?:\\.in)+|". # http://www.freedesktop.org/Standards/menu-spec -"caves(?:\\.in)+|". # GNOME Games specific -"directory(?:\\.in)+|". # http://www.freedesktop.org/Standards/menu-spec -"soundlist(?:\\.in)+|". # GNOME specific -"keys(?:\\.in)+|". # GNOME Mime database specific -"theme(?:\\.in)+"; # http://www.freedesktop.org/Standards/icon-theme-spec - -my $buildin_gettext_support = -"c|y|cs|cc|cpp|c\\+\\+|h|hh|gob|py"; - -## Always flush buffer when printing -$| = 1; - -## Sometimes the source tree will be rooted somewhere else. -my $SRCDIR = "."; -my $POTFILES_in; - -$SRCDIR = $ENV{"srcdir"} if $ENV{"srcdir"}; -$POTFILES_in = "<$SRCDIR/POTFILES.in"; - -my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null'); - -## Handle options -GetOptions -( - "help" => \$HELP_ARG, - "version" => \$VERSION_ARG, - "dist|d" => \$DIST_ARG, - "pot|p" => \$POT_ARG, - "headers|s" => \$HEADERS_ARG, - "maintain|m" => \$MAINTAIN_ARG, - "report|r" => \$REPORT_ARG, - "verbose|x" => \$VERBOSE, - "gettext-package|g=s" => \$GETTEXT_PACKAGE, - "output-file|o=s" => \$OUTPUT_FILE, - ) or &Console_WriteError_InvalidOption; - -&Console_Write_IntltoolHelp if $HELP_ARG; -&Console_Write_IntltoolVersion if $VERSION_ARG; - -my $arg_count = ($DIST_ARG > 0) - + ($POT_ARG > 0) - + ($HEADERS_ARG > 0) - + ($MAINTAIN_ARG > 0) - + ($REPORT_ARG > 0); - -&Console_Write_IntltoolHelp if $arg_count > 1; - -# --version and --help don't require a module name -my $MODULE = $GETTEXT_PACKAGE || &FindPackageName; - -if ($POT_ARG) -{ - &GenerateHeaders; - &GeneratePOTemplate; -} -elsif ($HEADERS_ARG) -{ - &GenerateHeaders; -} -elsif ($MAINTAIN_ARG) -{ - &FindLeftoutFiles; -} -elsif ($REPORT_ARG) -{ - &GenerateHeaders; - &GeneratePOTemplate; - &Console_Write_CoverageReport; -} -elsif ((defined $ARGV[0]) && $ARGV[0] =~ /^[a-z]/) -{ - my $lang = $ARGV[0]; - - ## Report error if the language file supplied - ## to the command line is non-existent - &Console_WriteError_NotExisting("$SRCDIR/$lang.po") - if ! -s "$SRCDIR/$lang.po"; - - if (!$DIST_ARG) - { - print "Working, please wait..." if $VERBOSE; - &GenerateHeaders; - &GeneratePOTemplate; - } - &POFile_Update ($lang, $OUTPUT_FILE); - &Console_Write_TranslationStatus ($lang, $OUTPUT_FILE); -} -else -{ - &Console_Write_IntltoolHelp; -} - -exit; - -######### - -sub Console_Write_IntltoolVersion -{ - print <<_EOF_; -${PROGRAM} (${PACKAGE}) $VERSION -Written by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler. - -Copyright (C) 2000-2003 Free Software Foundation, Inc. -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -_EOF_ - exit; -} - -sub Console_Write_IntltoolHelp -{ - print <<_EOF_; -Usage: ${PROGRAM} [OPTION]... LANGCODE -Updates PO template files and merge them with the translations. - -Mode of operation (only one is allowed): - -p, --pot generate the PO template only - -s, --headers generate the header files in POTFILES.in - -m, --maintain search for left out files from POTFILES.in - -r, --report display a status report for the module - -d, --dist merge LANGCODE.po with existing PO template - -Extra options: - -g, --gettext-package=NAME override PO template name, useful with --pot - -o, --output-file=FILE write merged translation to FILE - -x, --verbose display lots of feedback - --help display this help and exit - --version output version information and exit - -Examples of use: -${PROGRAM} --pot just create a new PO template -${PROGRAM} xy create new PO template and merge xy.po with it - -Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE") -or send email to . -_EOF_ - exit; -} - -sub echo_n -{ - my $str = shift; - my $ret = `echo "$str"`; - - $ret =~ s/\n$//; # do we need the "s" flag? - - return $ret; -} - -sub POFile_DetermineType ($) -{ - my $type = $_; - my $gettext_type; - - my $xml_regex = "(?:" . $xml_support . ")"; - my $ini_regex = "(?:" . $ini_support . ")"; - my $buildin_regex = "(?:" . $buildin_gettext_support . ")"; - - if ($type =~ /\[type: gettext\/([^\]].*)]/) - { - $gettext_type=$1; - } - elsif ($type =~ /schemas(\.in)+$/) - { - $gettext_type="schemas"; - } - elsif ($type =~ /glade2?(\.in)*$/) - { - $gettext_type="glade"; - } - elsif ($type =~ /scm(\.in)*$/) - { - $gettext_type="scheme"; - } - elsif ($type =~ /keys(\.in)+$/) - { - $gettext_type="keys"; - } - - # bucket types - - elsif ($type =~ /$xml_regex$/) - { - $gettext_type="xml"; - } - elsif ($type =~ /$ini_regex$/) - { - $gettext_type="ini"; - } - elsif ($type =~ /$buildin_regex$/) - { - $gettext_type="buildin"; - } - else - { - $gettext_type="unknown"; - } - - return "gettext\/$gettext_type"; -} - -sub TextFile_DetermineEncoding ($) -{ - my $gettext_code="ASCII"; # All files are ASCII by default - my $filetype=`file $_ | cut -d ' ' -f 2`; - - if ($? eq "0") - { - if ($filetype =~ /^(ISO|UTF)/) - { - chomp ($gettext_code = $filetype); - } - elsif ($filetype =~ /^XML/) - { - $gettext_code="UTF-8"; # We asume that .glade and other .xml files are UTF-8 - } - } - - return $gettext_code; -} - -sub isNotValidMissing -{ - my ($file) = @_; - - return if $file =~ /^\{arch\}\/.*$/; - return if $file =~ /^$varhash{"PACKAGE"}-$varhash{"VERSION"}\/.*$/; -} - -sub FindLeftoutFiles -{ - my (@buf_i18n_plain, - @buf_i18n_xml, - @buf_i18n_xml_unmarked, - @buf_i18n_ini, - @buf_potfiles, - @buf_potfiles_ignore, - @buf_allfiles, - @buf_allfiles_sorted, - @buf_potfiles_sorted - ); - - ## Search and find all translatable files - find sub { - push @buf_i18n_plain, "$File::Find::name" if /\.($buildin_gettext_support)$/; - push @buf_i18n_xml, "$File::Find::name" if /\.($xml_support)$/; - push @buf_i18n_ini, "$File::Find::name" if /\.($ini_support)$/; - push @buf_i18n_xml_unmarked, "$File::Find::name" if /\.(schemas(\.in)+)$/; - }, ".."; - - - open POTFILES, $POTFILES_in or die "$PROGRAM: there's no POTFILES.in!\n"; - @buf_potfiles = grep !/^(#|\s*$)/, ; - close POTFILES; - - foreach (@buf_potfiles) { - s/^\[.*]\s*//; - } - - print "Searching for missing translatable files...\n" if $VERBOSE; - - ## Check if we should ignore some found files, when - ## comparing with POTFILES.in - foreach my $ignore ("POTFILES.skip", "POTFILES.ignore") - { - (-s $ignore) or next; - - if ("$ignore" eq "POTFILES.ignore") - { - print "The usage of POTFILES.ignore is deprecated. Please consider moving the\n". - "content of this file to POTFILES.skip.\n"; - } - - print "Found $ignore: Ignoring files...\n" if $VERBOSE; - open FILE, "<$ignore" or die "ERROR: Failed to open $ignore!\n"; - - while () - { - push @buf_potfiles_ignore, $_ unless /^(#|\s*$)/; - } - close FILE; - - @buf_potfiles = (@buf_potfiles_ignore, @buf_potfiles); - } - - foreach my $file (@buf_i18n_plain) - { - my $in_comment = 0; - my $in_macro = 0; - - open FILE, "<$file"; - while () - { - # Handle continued multi-line comment. - if ($in_comment) - { - next unless s-.*\*/--; - $in_comment = 0; - } - - # Handle continued macro. - if ($in_macro) - { - $in_macro = 0 unless /\\$/; - next; - } - - # Handle start of macro (or any preprocessor directive). - if (/^\s*\#/) - { - $in_macro = 1 if /^([^\\]|\\.)*\\$/; - next; - } - - # Handle comments and quoted text. - while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy - { - my $match = $1; - if ($match eq "/*") - { - if (!s-/\*.*?\*/--) - { - s-/\*.*--; - $in_comment = 1; - } - } - elsif ($match eq "//") - { - s-//.*--; - } - else # ' or " - { - if (!s-$match([^\\]|\\.)*?$match-QUOTEDTEXT-) - { - warn "mismatched quotes at line $. in $file\n"; - s-$match.*--; - } - } - } - - if (/\.GetString ?\(QUOTEDTEXT/) - { - if (defined isNotValidMissing (unpack("x3 A*", $file))) { - ## Remove the first 3 chars and add newline - push @buf_allfiles, unpack("x3 A*", $file) . "\n"; - } - last; - } - - if (/_\(QUOTEDTEXT/) - { - if (defined isNotValidMissing (unpack("x3 A*", $file))) { - ## Remove the first 3 chars and add newline - push @buf_allfiles, unpack("x3 A*", $file) . "\n"; - } - last; - } - } - close FILE; - } - - foreach my $file (@buf_i18n_xml) - { - open FILE, "<$file"; - - while () - { - # FIXME: share the pattern matching code with intltool-extract - if (/\s_[-A-Za-z0-9._:]+\s*=\s*\"([^"]+)\"/ || /<_[^>]+>/ || /translatable=\"yes\"/) - { - if (defined isNotValidMissing (unpack("x3 A*", $file))) { - push @buf_allfiles, unpack("x3 A*", $file) . "\n"; - } - last; - } - } - close FILE; - } - - foreach my $file (@buf_i18n_ini) - { - open FILE, "<$file"; - while () - { - if (/_(.*)=/) - { - if (defined isNotValidMissing (unpack("x3 A*", $file))) { - push @buf_allfiles, unpack("x3 A*", $file) . "\n"; - } - last; - } - } - close FILE; - } - - foreach my $file (@buf_i18n_xml_unmarked) - { - if (defined isNotValidMissing (unpack("x3 A*", $file))) { - push @buf_allfiles, unpack("x3 A*", $file) . "\n"; - } - } - - - @buf_allfiles_sorted = sort (@buf_allfiles); - @buf_potfiles_sorted = sort (@buf_potfiles); - - my %in2; - foreach (@buf_potfiles_sorted) - { - $in2{$_} = 1; - } - - my @result; - - foreach (@buf_allfiles_sorted) - { - if (!exists($in2{$_})) - { - push @result, $_ - } - } - - my @buf_potfiles_notexist; - - foreach (@buf_potfiles_sorted) - { - chomp (my $dummy = $_); - if ("$dummy" ne "" and ! -f "../$dummy") - { - push @buf_potfiles_notexist, $_; - } - } - - ## Save file with information about the files missing - ## if any, and give information about this procedure. - if (@result + @buf_potfiles_notexist > 0) - { - if (@result) - { - print "\n" if $VERBOSE; - unlink "missing"; - open OUT, ">missing"; - print OUT @result; - close OUT; - warn "\e[1mThe following files contain translations and are currently not in use. Please\e[0m\n". - "\e[1mconsider adding these to the POTFILES.in file, located in the po/ directory.\e[0m\n\n"; - print STDERR @result, "\n"; - warn "If some of these files are left out on purpose then please add them to\n". - "POTFILES.skip instead of POTFILES.in. A file \e[1m'missing'\e[0m containing this list\n". - "of left out files has been written in the current directory.\n"; - } - if (@buf_potfiles_notexist) - { - unlink "notexist"; - open OUT, ">notexist"; - print OUT @buf_potfiles_notexist; - close OUT; - warn "\n" if ($VERBOSE or @result); - warn "\e[1mThe following files do not exist anymore:\e[0m\n\n"; - warn @buf_potfiles_notexist, "\n"; - warn "Please remove them from POTFILES.in or POTFILES.skip. A file \e[1m'notexist'\e[0m\n". - "containing this list of absent files has been written in the current directory.\n"; - } - } - - ## If there is nothing to complain about, notify the user - else { - print "\nAll files containing translations are present in POTFILES.in.\n" if $VERBOSE; - } -} - -sub Console_WriteError_InvalidOption -{ - ## Handle invalid arguments - print STDERR "Try `${PROGRAM} --help' for more information.\n"; - exit 1; -} - -sub GenerateHeaders -{ - my $EXTRACT = "@INTLTOOL_EXTRACT@"; - chomp $EXTRACT; - - $EXTRACT = $ENV{"INTLTOOL_EXTRACT"} if $ENV{"INTLTOOL_EXTRACT"}; - - ## Generate the .h header files, so we can allow glade and - ## xml translation support - if (! -x "$EXTRACT") - { - print STDERR "\n *** The intltool-extract script wasn't found!" - ."\n *** Without it, intltool-update can not generate files.\n"; - exit; - } - else - { - open (FILE, $POTFILES_in) or die "$PROGRAM: POTFILES.in not found.\n"; - - while () - { - chomp; - next if /^\[\s*encoding/; - - ## Find xml files in POTFILES.in and generate the - ## files with help from the extract script - - my $gettext_type= &POFile_DetermineType ($1); - - if (/\.($xml_support|$ini_support)$/ || /^\[/) - { - s/^\[[^\[].*]\s*//; - - my $filename = "../$_"; - - if ($VERBOSE) - { - system ($EXTRACT, "--update", "--srcdir=$SRCDIR", - "--type=$gettext_type", $filename); - } - else - { - system ($EXTRACT, "--update", "--type=$gettext_type", - "--srcdir=$SRCDIR", "--quiet", $filename); - } - } - } - close FILE; - } -} - -# -# Generate .pot file from POTFILES.in -# -sub GeneratePOTemplate -{ - my $XGETTEXT = $ENV{"XGETTEXT"} || "/usr/bin/xgettext"; - my $XGETTEXT_ARGS = $ENV{"XGETTEXT_ARGS"} || ''; - chomp $XGETTEXT; - - if (! -x $XGETTEXT) - { - print STDERR " *** xgettext is not found on this system!\n". - " *** Without it, intltool-update can not extract strings.\n"; - exit; - } - - print "Building $MODULE.pot...\n" if $VERBOSE; - - open INFILE, $POTFILES_in; - unlink "POTFILES.in.temp"; - open OUTFILE, ">POTFILES.in.temp" or die("Cannot open POTFILES.in.temp for writing"); - - my $gettext_support_nonascii = 0; - - # checks for GNU gettext >= 0.12 - my $dummy = `$XGETTEXT --version --from-code=UTF-8 >$devnull 2>$devnull`; - if ($? == 0) - { - $gettext_support_nonascii = 1; - } - else - { - # urge everybody to upgrade gettext - print STDERR "WARNING: This version of gettext does not support extracting non-ASCII\n". - " strings. That means you should install a version of gettext\n". - " that supports non-ASCII strings (such as GNU gettext >= 0.12),\n". - " or have to let non-ASCII strings untranslated. (If there is any)\n"; - } - - my $encoding = "ASCII"; - my $forced_gettext_code; - my @temp_headers; - my $encoding_problem_is_reported = 0; - - while () - { - next if (/^#/ or /^\s*$/); - - chomp; - - my $gettext_code; - - if (/^\[\s*encoding:\s*(.*)\s*\]/) - { - $forced_gettext_code=$1; - } - elsif (/\.($xml_support|$ini_support)$/ || /^\[/) - { - s/^\[.*]\s*//; - print OUTFILE "../$_.h\n"; - push @temp_headers, "../$_.h"; - $gettext_code = &TextFile_DetermineEncoding ("../$_.h") if ($gettext_support_nonascii and not defined $forced_gettext_code); - } - else - { - if ($SRCDIR eq ".") { - print OUTFILE "../$_\n"; - } else { - print OUTFILE "$SRCDIR/../$_\n"; - } - $gettext_code = &TextFile_DetermineEncoding ("../$_") if ($gettext_support_nonascii and not defined $forced_gettext_code); - } - - next if (! $gettext_support_nonascii); - - if (defined $forced_gettext_code) - { - $encoding=$forced_gettext_code; - } - elsif (defined $gettext_code and "$encoding" ne "$gettext_code") - { - if ($encoding eq "ASCII") - { - $encoding=$gettext_code; - } - elsif ($gettext_code ne "ASCII") - { - # Only report once because the message is quite long - if (! $encoding_problem_is_reported) - { - print STDERR "WARNING: You should use the same file encoding for all your project files,\n". - " but $PROGRAM thinks that most of the source files are in\n". - " $encoding encoding, while \"$_\" is (likely) in\n". - " $gettext_code encoding. If you are sure that all translatable strings\n". - " are in same encoding (say UTF-8), please \e[1m*prepend*\e[0m the following\n". - " line to POTFILES.in:\n\n". - " [encoding: UTF-8]\n\n". - " and make sure that configure.in/ac checks for $PACKAGE >= 0.27 .\n". - "(such warning message will only be reported once.)\n"; - $encoding_problem_is_reported = 1; - } - } - } - } - - close OUTFILE; - close INFILE; - - unlink "$MODULE.pot"; - my @xgettext_argument=("$XGETTEXT", - "--add-comments", - "--directory\=\.", - "--output\=$MODULE\.pot", - "--files-from\=\.\/POTFILES\.in\.temp"); - my $XGETTEXT_KEYWORDS = &FindPOTKeywords; - push @xgettext_argument, $XGETTEXT_KEYWORDS; - push @xgettext_argument, "--from-code\=$encoding" if ($gettext_support_nonascii); - push @xgettext_argument, $XGETTEXT_ARGS if $XGETTEXT_ARGS; - my $xgettext_command = join ' ', @xgettext_argument; - - # intercept xgettext error message - print "Running $xgettext_command\n" if $VERBOSE; - my $xgettext_error_msg = `$xgettext_command 2>\&1`; - my $command_failed = $?; - - unlink "POTFILES.in.temp"; - - print "Removing generated header (.h) files..." if $VERBOSE; - unlink foreach (@temp_headers); - print "done.\n" if $VERBOSE; - - if (! $command_failed) - { - if (! -e "$MODULE.pot") - { - print "None of the files in POTFILES.in contain strings marked for translation.\n" if $VERBOSE; - } - else - { - print "Wrote $MODULE.pot\n" if $VERBOSE; - } - } - else - { - if ($xgettext_error_msg =~ /--from-code/) - { - # replace non-ASCII error message with a more useful one. - print STDERR "ERROR: xgettext failed to generate PO template file because there is non-ASCII\n". - " string marked for translation. Please make sure that all strings marked\n". - " for translation are in uniform encoding (say UTF-8), then \e[1m*prepend*\e[0m the\n". - " following line to POTFILES.in and rerun $PROGRAM:\n\n". - " [encoding: UTF-8]\n\n"; - } - else - { - print STDERR "$xgettext_error_msg"; - if (-e "$MODULE.pot") - { - # is this possible? - print STDERR "ERROR: xgettext failed but still managed to generate PO template file.\n". - " Please consult error message above if there is any.\n"; - } - else - { - print STDERR "ERROR: xgettext failed to generate PO template file. Please consult\n". - " error message above if there is any.\n"; - } - } - exit (1); - } -} - -sub POFile_Update -{ - -f "$MODULE.pot" or die "$PROGRAM: $MODULE.pot does not exist.\n"; - - my $MSGMERGE = $ENV{"MSGMERGE"} || "/usr/bin/msgmerge"; - my ($lang, $outfile) = @_; - - print "Merging $SRCDIR/$lang.po with $MODULE.pot..." if $VERBOSE; - - my $infile = "$SRCDIR/$lang.po"; - $outfile = "$SRCDIR/$lang.po" if ($outfile eq ""); - - # I think msgmerge won't overwrite old file if merge is not successful - system ("$MSGMERGE", "-o", $outfile, $infile, "$MODULE.pot"); -} - -sub Console_WriteError_NotExisting -{ - my ($file) = @_; - - ## Report error if supplied language file is non-existing - print STDERR "$PROGRAM: $file does not exist!\n"; - print STDERR "Try '$PROGRAM --help' for more information.\n"; - exit; -} - -sub GatherPOFiles -{ - my @po_files = glob ("./*.po"); - - @languages = map (&POFile_GetLanguage, @po_files); - - foreach my $lang (@languages) - { - $po_files_by_lang{$lang} = shift (@po_files); - } -} - -sub POFile_GetLanguage ($) -{ - s/^(.*\/)?(.+)\.po$/$2/; - return $_; -} - -sub Console_Write_TranslationStatus -{ - my ($lang, $output_file) = @_; - my $MSGFMT = $ENV{"MSGFMT"} || "/usr/bin/msgfmt"; - - $output_file = "$SRCDIR/$lang.po" if ($output_file eq ""); - - system ("$MSGFMT", "-o", "$devnull", "--verbose", $output_file); -} - -sub Console_Write_CoverageReport -{ - my $MSGFMT = $ENV{"MSGFMT"} || "/usr/bin/msgfmt"; - - &GatherPOFiles; - - foreach my $lang (@languages) - { - print "$lang: "; - &POFile_Update ($lang, ""); - } - - print "\n\n * Current translation support in $MODULE \n\n"; - - foreach my $lang (@languages) - { - print "$lang: "; - system ("$MSGFMT", "-o", "$devnull", "--verbose", "$SRCDIR/$lang.po"); - } -} - -sub SubstituteVariable -{ - my ($str) = @_; - - # always need to rewind file whenever it has been accessed - seek (CONF, 0, 0); - - # cache each variable. varhash is global to we can add - # variables elsewhere. - while () - { - if (/^(\w+)=(.*)$/) - { - ($varhash{$1} = $2) =~ s/^["'](.*)["']$/$1/; - } - } - - if ($str =~ /^(.*)\${?([A-Z_]+)}?(.*)$/) - { - my $rest = $3; - my $untouched = $1; - my $sub = $varhash{$2}; - - return SubstituteVariable ("$untouched$sub$rest"); - } - - # We're using Perl backticks ` and "echo -n" here in order to - # expand any shell escapes (such as backticks themselves) in every variable - return echo_n ($str); -} - -sub CONF_Handle_Open -{ - my $base_dirname = getcwd(); - $base_dirname =~ s@.*/@@; - - my ($conf_in, $src_dir); - - if ($base_dirname =~ /^po(-.+)?$/) - { - if (-f "Makevars") - { - my $makefile_source; - - local (*IN); - open (IN, ") - { - if (/^top_builddir[ \t]*=/) - { - $src_dir = $_; - $src_dir =~ s/^top_builddir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/; - - chomp $src_dir; - if (-f "$src_dir" . "/configure.ac") { - $conf_in = "$src_dir" . "/configure.ac" . "\n"; - } else { - $conf_in = "$src_dir" . "/configure.in" . "\n"; - } - last; - } - } - close IN; - - $conf_in || die "Cannot find top_builddir in Makevars."; - } - elsif (-f "../configure.ac") - { - $conf_in = "../configure.ac"; - } - elsif (-f "../configure.in") - { - $conf_in = "../configure.in"; - } - else - { - my $makefile_source; - - local (*IN); - open (IN, ") - { - if (/^top_srcdir[ \t]*=/) - { - $src_dir = $_; - $src_dir =~ s/^top_srcdir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/; - - chomp $src_dir; - $conf_in = "$src_dir" . "/configure.in" . "\n"; - - last; - } - } - close IN; - - $conf_in || die "Cannot find top_srcdir in Makefile."; - } - - open (CONF, "<$conf_in"); - } - else - { - print STDERR "$PROGRAM: Unable to proceed.\n" . - "Make sure to run this script inside the po directory.\n"; - exit; - } -} - -sub FindPackageName -{ - my $version; - my $domain = &FindMakevarsDomain; - my $name = $domain || "untitled"; - - &CONF_Handle_Open; - - my $conf_source; { - local (*IN); - open (IN, "<&CONF") || return $name; - seek (IN, 0, 0); - local $/; # slurp mode - $conf_source = ; - close IN; - } - - # priority for getting package name: - # 1. GETTEXT_PACKAGE - # 2. first argument of AC_INIT (with >= 2 arguments) - # 3. first argument of AM_INIT_AUTOMAKE (with >= 2 argument) - - # /^AM_INIT_AUTOMAKE\([\s\[]*([^,\)\s\]]+)/m - # the \s makes this not work, why? - if ($conf_source =~ /^AM_INIT_AUTOMAKE\(([^,\)]+),([^,\)]+)/m) - { - ($name, $version) = ($1, $2); - $name =~ s/[\[\]\s]//g; - $version =~ s/[\[\]\s]//g; - $varhash{"AC_PACKAGE_NAME"} = $name; - $varhash{"PACKAGE"} = $name; - $varhash{"AC_PACKAGE_VERSION"} = $version; - $varhash{"VERSION"} = $version; - } - - if ($conf_source =~ /^AC_INIT\(([^,\)]+),([^,\)]+)/m) - { - ($name, $version) = ($1, $2); - $name =~ s/[\[\]\s]//g; - $version =~ s/[\[\]\s]//g; - $varhash{"AC_PACKAGE_NAME"} = $name; - $varhash{"PACKAGE"} = $name; - $varhash{"AC_PACKAGE_VERSION"} = $version; - $varhash{"VERSION"} = $version; - } - - # \s makes this not work, why? - $name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=\[?([^\n\]]+)/m; - - # prepend '$' to auto* internal variables, usually they are - # used in configure.in/ac without the '$' - $name =~ s/AC_/\$AC_/g; - $name =~ s/\$\$/\$/g; - - $name = $domain if $domain; - - $name = SubstituteVariable ($name); - $name =~ s/^["'](.*)["']$/$1/; - - return $name if $name; -} - - -sub FindPOTKeywords -{ - - my $keywords = "--keyword\=\_ --keyword\=N\_ --keyword\=U\_ --keyword\=Q\_"; - my $varname = "XGETTEXT_OPTIONS"; - my $make_source; { - local (*IN); - open (IN, "; - close IN; - } - - $keywords = $1 if $make_source =~ /^$varname[ ]*=\[?([^\n\]]+)/m; - - return $keywords; -} - -sub FindMakevarsDomain -{ - - my $domain = ""; - my $makevars_source; { - local (*IN); - open (IN, "; - close IN; - } - - $domain = $1 if $makevars_source =~ /^DOMAIN[ ]*=\[?([^\n\]\$]+)/m; - $domain =~ s/^\s+//; - $domain =~ s/\s+$//; - - return $domain; -}