Add new netstatus plugin ported from GNOME netstatus panel applet.
[lxde/lxpanel.git] / intltool-update.in
1 #!@INTLTOOL_PERL@ -w
2 # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-
3
4 #
5 #  The Intltool Message Updater
6 #
7 #  Copyright (C) 2000-2003 Free Software Foundation.
8 #
9 #  Intltool is free software; you can redistribute it and/or
10 #  modify it under the terms of the GNU General Public License 
11 #  version 2 published by the Free Software Foundation.
12 #
13 #  Intltool is distributed in the hope that it will be useful,
14 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
15 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16 #  General Public License for more details.
17 #
18 #  You should have received a copy of the GNU General Public License
19 #  along with this program; if not, write to the Free Software
20 #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 #
22 #  As a special exception to the GNU General Public License, if you
23 #  distribute this file as part of a program that contains a
24 #  configuration script generated by Autoconf, you may include it under
25 #  the same distribution terms that you use for the rest of that program.
26 #
27 #  Authors: Kenneth Christiansen <kenneth@gnu.org>
28 #           Maciej Stachowiak
29 #           Darin Adler <darin@bentspoon.com>
30
31 ## Release information
32 my $PROGRAM = "intltool-update";
33 my $VERSION = "0.35.0";
34 my $PACKAGE = "intltool";
35
36 ## Loaded modules
37 use strict;
38 use Getopt::Long;
39 use Cwd;
40 use File::Copy;
41 use File::Find;
42
43 ## Scalars used by the option stuff
44 my $HELP_ARG       = 0;
45 my $VERSION_ARG    = 0;
46 my $DIST_ARG       = 0;
47 my $POT_ARG        = 0;
48 my $HEADERS_ARG    = 0;
49 my $MAINTAIN_ARG   = 0;
50 my $REPORT_ARG     = 0;
51 my $VERBOSE        = 0;
52 my $GETTEXT_PACKAGE = "";
53 my $OUTPUT_FILE    = "";
54
55 my @languages;
56 my %varhash = ();
57 my %po_files_by_lang = ();
58
59 # Regular expressions to categorize file types.
60 # FIXME: Please check if the following is correct
61
62 my $xml_support =
63 "xml(?:\\.in)*|".       # http://www.w3.org/XML/ (Note: .in is not required)
64 "ui|".                  # Bonobo specific - User Interface desc. files
65 "lang|".                # ?
66 "glade2?(?:\\.in)*|".   # Glade specific - User Interface desc. files (Note: .in is not required)
67 "scm(?:\\.in)*|".       # ? (Note: .in is not required)
68 "oaf(?:\\.in)+|".       # DEPRECATED: Replaces by Bonobo .server files 
69 "etspec|".              # ?
70 "server(?:\\.in)+|".    # Bonobo specific
71 "sheet(?:\\.in)+|".     # ?
72 "schemas(?:\\.in)+|".   # GConf specific
73 "pong(?:\\.in)+|".      # DEPRECATED: PONG is not used [by GNOME] any longer.
74 "kbd(?:\\.in)+";        # GOK specific. 
75
76 my $ini_support =
77 "icon(?:\\.in)+|".      # http://www.freedesktop.org/Standards/icon-theme-spec
78 "desktop(?:\\.in)+|".   # http://www.freedesktop.org/Standards/menu-spec
79 "caves(?:\\.in)+|".     # GNOME Games specific
80 "directory(?:\\.in)+|". # http://www.freedesktop.org/Standards/menu-spec
81 "soundlist(?:\\.in)+|". # GNOME specific
82 "keys(?:\\.in)+|".      # GNOME Mime database specific
83 "theme(?:\\.in)+|".     # http://www.freedesktop.org/Standards/icon-theme-spec
84 "service(?:\\.in)+";    # DBus specific
85
86 my $buildin_gettext_support = 
87 "c|y|cs|cc|cpp|c\\+\\+|h|hh|gob|py";
88
89 ## Always flush buffer when printing
90 $| = 1;
91
92 ## Sometimes the source tree will be rooted somewhere else.
93 my $SRCDIR = ".";
94 my $POTFILES_in;
95
96 $SRCDIR = $ENV{"srcdir"} if $ENV{"srcdir"};
97 $POTFILES_in = "<$SRCDIR/POTFILES.in";
98
99 my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
100
101 ## Handle options
102 GetOptions 
103 (
104  "help"                => \$HELP_ARG,
105  "version"             => \$VERSION_ARG,
106  "dist|d"              => \$DIST_ARG,
107  "pot|p"               => \$POT_ARG,
108  "headers|s"           => \$HEADERS_ARG,
109  "maintain|m"          => \$MAINTAIN_ARG,
110  "report|r"            => \$REPORT_ARG,
111  "verbose|x"           => \$VERBOSE,
112  "gettext-package|g=s" => \$GETTEXT_PACKAGE,
113  "output-file|o=s"     => \$OUTPUT_FILE,
114  ) or &Console_WriteError_InvalidOption;
115
116 &Console_Write_IntltoolHelp if $HELP_ARG;
117 &Console_Write_IntltoolVersion if $VERSION_ARG;
118
119 my $arg_count = ($DIST_ARG > 0)
120     + ($POT_ARG > 0)
121     + ($HEADERS_ARG > 0)
122     + ($MAINTAIN_ARG > 0)
123     + ($REPORT_ARG > 0);
124
125 &Console_Write_IntltoolHelp if $arg_count > 1;
126
127 # --version and --help don't require a module name
128 my $MODULE = $GETTEXT_PACKAGE || &FindPackageName || "unknown";
129
130 if ($POT_ARG)
131 {
132     &GenerateHeaders;
133     &GeneratePOTemplate;
134 }
135 elsif ($HEADERS_ARG)
136 {
137     &GenerateHeaders;
138 }
139 elsif ($MAINTAIN_ARG)
140 {
141     &FindLeftoutFiles;
142 }
143 elsif ($REPORT_ARG)
144 {
145     &GenerateHeaders;
146     &GeneratePOTemplate;
147     &Console_Write_CoverageReport;
148 }
149 elsif ((defined $ARGV[0]) && $ARGV[0] =~ /^[a-z]/)
150 {
151     my $lang = $ARGV[0];
152
153     ## Report error if the language file supplied
154     ## to the command line is non-existent
155     &Console_WriteError_NotExisting("$SRCDIR/$lang.po")
156         if ! -s "$SRCDIR/$lang.po";
157
158     if (!$DIST_ARG)
159     {
160         print "Working, please wait..." if $VERBOSE;
161         &GenerateHeaders;
162         &GeneratePOTemplate;
163     }
164     &POFile_Update ($lang, $OUTPUT_FILE);
165     &Console_Write_TranslationStatus ($lang, $OUTPUT_FILE);
166
167 else 
168 {
169     &Console_Write_IntltoolHelp;
170 }
171
172 exit;
173
174 #########
175
176 sub Console_Write_IntltoolVersion
177 {
178     print <<_EOF_;
179 ${PROGRAM} (${PACKAGE}) $VERSION
180 Written by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler.
181
182 Copyright (C) 2000-2003 Free Software Foundation, Inc.
183 This is free software; see the source for copying conditions.  There is NO
184 warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
185 _EOF_
186     exit;
187 }
188
189 sub Console_Write_IntltoolHelp
190 {
191     print <<_EOF_;
192 Usage: ${PROGRAM} [OPTION]... LANGCODE
193 Updates PO template files and merge them with the translations.
194
195 Mode of operation (only one is allowed):
196   -p, --pot                   generate the PO template only
197   -s, --headers               generate the header files in POTFILES.in
198   -m, --maintain              search for left out files from POTFILES.in
199   -r, --report                display a status report for the module
200   -d, --dist                  merge LANGCODE.po with existing PO template
201
202 Extra options:
203   -g, --gettext-package=NAME  override PO template name, useful with --pot
204   -o, --output-file=FILE      write merged translation to FILE
205   -x, --verbose               display lots of feedback
206       --help                  display this help and exit
207       --version               output version information and exit
208
209 Examples of use:
210 ${PROGRAM} --pot    just create a new PO template
211 ${PROGRAM} xy       create new PO template and merge xy.po with it
212
213 Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
214 or send email to <xml-i18n-tools\@gnome.org>.
215 _EOF_
216     exit;
217 }
218
219 sub echo_n
220 {
221     my $str = shift;
222     my $ret = `echo "$str"`;
223
224     $ret =~ s/\n$//; # do we need the "s" flag?
225
226     return $ret;
227 }
228
229 sub POFile_DetermineType ($) 
230 {
231    my $type = $_;
232    my $gettext_type;
233
234    my $xml_regex     = "(?:" . $xml_support . ")";
235    my $ini_regex     = "(?:" . $ini_support . ")";
236    my $buildin_regex = "(?:" . $buildin_gettext_support . ")";
237
238    if ($type =~ /\[type: gettext\/([^\]].*)]/) 
239    {
240         $gettext_type=$1;
241    }
242    elsif ($type =~ /schemas(\.in)+$/) 
243    {
244         $gettext_type="schemas";
245    }
246    elsif ($type =~ /glade2?(\.in)*$/) 
247    {
248        $gettext_type="glade";
249    }
250    elsif ($type =~ /scm(\.in)*$/) 
251    {
252        $gettext_type="scheme";
253    }
254    elsif ($type =~ /keys(\.in)+$/) 
255    {
256        $gettext_type="keys";
257    }
258
259    # bucket types
260
261    elsif ($type =~ /$xml_regex$/) 
262    {
263        $gettext_type="xml";
264    }
265    elsif ($type =~ /$ini_regex$/) 
266    { 
267        $gettext_type="ini";
268    }
269    elsif ($type =~ /$buildin_regex$/) 
270    {
271        $gettext_type="buildin";
272    }
273    else
274    { 
275        $gettext_type="unknown"; 
276    }
277
278    return "gettext\/$gettext_type";
279 }
280
281 sub TextFile_DetermineEncoding ($) 
282 {
283     my $gettext_code="ASCII"; # All files are ASCII by default
284     my $filetype=`file $_ | cut -d ' ' -f 2`;
285
286     if ($? eq "0")
287     {
288         if ($filetype =~ /^(ISO|UTF)/)
289         {
290             chomp ($gettext_code = $filetype);
291         }
292         elsif ($filetype =~ /^XML/)
293         {
294             $gettext_code="UTF-8"; # We asume that .glade and other .xml files are UTF-8
295         }
296     }
297
298     return $gettext_code;
299 }
300
301 sub isNotValidMissing
302 {
303     my ($file) = @_;
304
305     return if $file =~ /^\{arch\}\/.*$/;
306     return if $file =~ /^$varhash{"PACKAGE"}-$varhash{"VERSION"}\/.*$/;
307 }
308
309 sub FindLeftoutFiles
310 {
311     my (@buf_i18n_plain,
312         @buf_i18n_xml,
313         @buf_i18n_xml_unmarked,
314         @buf_i18n_ini,
315         @buf_potfiles,
316         @buf_potfiles_ignore,
317         @buf_allfiles,
318         @buf_allfiles_sorted,
319         @buf_potfiles_sorted
320     );
321
322     ## Search and find all translatable files
323     find sub { 
324         push @buf_i18n_plain,        "$File::Find::name" if /\.($buildin_gettext_support)$/;
325         push @buf_i18n_xml,          "$File::Find::name" if /\.($xml_support)$/;
326         push @buf_i18n_ini,          "$File::Find::name" if /\.($ini_support)$/;
327         push @buf_i18n_xml_unmarked, "$File::Find::name" if /\.(schemas(\.in)+)$/;
328         }, "..";
329
330
331     open POTFILES, $POTFILES_in or die "$PROGRAM:  there's no POTFILES.in!\n";
332     @buf_potfiles = grep !/^(#|\s*$)/, <POTFILES>;
333     close POTFILES;
334
335     foreach (@buf_potfiles) {
336         s/^\[.*]\s*//;
337     }
338
339     print "Searching for missing translatable files...\n" if $VERBOSE;
340
341     ## Check if we should ignore some found files, when
342     ## comparing with POTFILES.in
343     foreach my $ignore ("POTFILES.skip", "POTFILES.ignore")
344     {
345         (-s $ignore) or next;
346
347         if ("$ignore" eq "POTFILES.ignore")
348         {
349             print "The usage of POTFILES.ignore is deprecated. Please consider moving the\n".
350                   "content of this file to POTFILES.skip.\n";
351         }
352
353         print "Found $ignore: Ignoring files...\n" if $VERBOSE;
354         open FILE, "<$ignore" or die "ERROR: Failed to open $ignore!\n";
355             
356         while (<FILE>)
357         {
358             push @buf_potfiles_ignore, $_ unless /^(#|\s*$)/;
359         }
360         close FILE;
361
362         @buf_potfiles = (@buf_potfiles_ignore, @buf_potfiles);
363     }
364
365     foreach my $file (@buf_i18n_plain)
366     {
367         my $in_comment = 0;
368         my $in_macro = 0;
369
370         open FILE, "<$file";
371         while (<FILE>)
372         {
373             # Handle continued multi-line comment.
374             if ($in_comment)
375             {
376                 next unless s-.*\*/--;
377                 $in_comment = 0;
378             }
379
380             # Handle continued macro.
381             if ($in_macro)
382             {
383                 $in_macro = 0 unless /\\$/;
384                 next;
385             }
386
387             # Handle start of macro (or any preprocessor directive).
388             if (/^\s*\#/)
389             {
390                 $in_macro = 1 if /^([^\\]|\\.)*\\$/;
391                 next;
392             }
393
394             # Handle comments and quoted text.
395             while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
396             {
397                 my $match = $1;
398                 if ($match eq "/*")
399                 {
400                     if (!s-/\*.*?\*/--)
401                     {
402                         s-/\*.*--;
403                         $in_comment = 1;
404                     }
405                 }
406                 elsif ($match eq "//")
407                 {
408                     s-//.*--;
409                 }
410                 else # ' or "
411                 {
412                     if (!s-$match([^\\]|\\.)*?$match-QUOTEDTEXT-)
413                     {
414                         warn "mismatched quotes at line $. in $file\n";
415                         s-$match.*--;
416                     }
417                 }
418             }       
419
420             if (/\.GetString ?\(QUOTEDTEXT/)
421             {
422                 if (defined isNotValidMissing (unpack("x3 A*", $file))) {
423                     ## Remove the first 3 chars and add newline
424                     push @buf_allfiles, unpack("x3 A*", $file) . "\n";
425                 }
426                 last;
427             }
428
429             if (/_\(QUOTEDTEXT/)
430             {
431                 if (defined isNotValidMissing (unpack("x3 A*", $file))) {
432                     ## Remove the first 3 chars and add newline
433                     push @buf_allfiles, unpack("x3 A*", $file) . "\n";
434                 }
435                 last;
436             }
437         }
438         close FILE;
439     }
440
441     foreach my $file (@buf_i18n_xml) 
442     {
443         open FILE, "<$file";
444         
445         while (<FILE>) 
446         {
447             # FIXME: share the pattern matching code with intltool-extract
448             if (/\s_[-A-Za-z0-9._:]+\s*=\s*\"([^"]+)\"/ || /<_[^>]+>/ || /translatable=\"yes\"/)
449             {
450                 if (defined isNotValidMissing (unpack("x3 A*", $file))) {
451                     push @buf_allfiles, unpack("x3 A*", $file) . "\n";
452                 }
453                 last;
454             }
455         }
456         close FILE;
457     }
458
459     foreach my $file (@buf_i18n_ini)
460     {
461         open FILE, "<$file";
462         while (<FILE>) 
463         {
464             if (/_(.*)=/)
465             {
466                 if (defined isNotValidMissing (unpack("x3 A*", $file))) {
467                     push @buf_allfiles, unpack("x3 A*", $file) . "\n";
468                 }
469                 last;
470             }
471         }
472         close FILE;
473     }
474
475     foreach my $file (@buf_i18n_xml_unmarked)
476     {
477         if (defined isNotValidMissing (unpack("x3 A*", $file))) {
478             push @buf_allfiles, unpack("x3 A*", $file) . "\n";
479         }
480     }
481
482
483     @buf_allfiles_sorted = sort (@buf_allfiles);
484     @buf_potfiles_sorted = sort (@buf_potfiles);
485
486     my %in2;
487     foreach (@buf_potfiles_sorted) 
488     {
489         $in2{$_} = 1;
490     }
491
492     my @result;
493
494     foreach (@buf_allfiles_sorted)
495     {
496         if (!exists($in2{$_}))
497         {
498             push @result, $_
499         }
500     }
501
502     my @buf_potfiles_notexist;
503
504     foreach (@buf_potfiles_sorted)
505     {
506         chomp (my $dummy = $_);
507         if ("$dummy" ne "" and ! -f "../$dummy")
508         {
509             push @buf_potfiles_notexist, $_;
510         }
511     }
512
513     ## Save file with information about the files missing
514     ## if any, and give information about this procedure.
515     if (@result + @buf_potfiles_notexist > 0)
516     {
517         if (@result) 
518         {
519             print "\n" if $VERBOSE;
520             unlink "missing";
521             open OUT, ">missing";
522             print OUT @result;
523             close OUT;
524             warn "\e[1mThe following files contain translations and are currently not in use. Please\e[0m\n".
525                  "\e[1mconsider adding these to the POTFILES.in file, located in the po/ directory.\e[0m\n\n";
526             print STDERR @result, "\n";
527             warn "If some of these files are left out on purpose then please add them to\n".
528                  "POTFILES.skip instead of POTFILES.in. A file \e[1m'missing'\e[0m containing this list\n".
529                  "of left out files has been written in the current directory.\n";
530         }
531         if (@buf_potfiles_notexist)
532         {
533             unlink "notexist";
534             open OUT, ">notexist";
535             print OUT @buf_potfiles_notexist;
536             close OUT;
537             warn "\n" if ($VERBOSE or @result);
538             warn "\e[1mThe following files do not exist anymore:\e[0m\n\n";
539             warn @buf_potfiles_notexist, "\n";
540             warn "Please remove them from POTFILES.in or POTFILES.skip. A file \e[1m'notexist'\e[0m\n".
541                  "containing this list of absent files has been written in the current directory.\n";
542         }
543     }
544
545     ## If there is nothing to complain about, notify the user
546     else {
547         print "\nAll files containing translations are present in POTFILES.in.\n" if $VERBOSE;
548     }
549 }
550
551 sub Console_WriteError_InvalidOption
552 {
553     ## Handle invalid arguments
554     print STDERR "Try `${PROGRAM} --help' for more information.\n";
555     exit 1;
556 }
557
558 sub GenerateHeaders
559 {
560     my $EXTRACT = "@INTLTOOL_EXTRACT@";
561     chomp $EXTRACT;
562
563     $EXTRACT = $ENV{"INTLTOOL_EXTRACT"} if $ENV{"INTLTOOL_EXTRACT"};
564
565     ## Generate the .h header files, so we can allow glade and
566     ## xml translation support
567     if (! -x "$EXTRACT")
568     {
569         print STDERR "\n *** The intltool-extract script wasn't found!"
570              ."\n *** Without it, intltool-update can not generate files.\n";
571         exit;
572     }
573     else
574     {
575         open (FILE, $POTFILES_in) or die "$PROGRAM: POTFILES.in not found.\n";
576         
577         while (<FILE>) 
578         {
579            chomp;
580            next if /^\[\s*encoding/;
581
582            ## Find xml files in POTFILES.in and generate the
583            ## files with help from the extract script
584
585            my $gettext_type= &POFile_DetermineType ($1);
586
587            if (/\.($xml_support|$ini_support)$/ || /^\[/)
588            {
589                s/^\[[^\[].*]\s*//;
590
591                my $filename = "../$_";
592
593                if ($VERBOSE)
594                {
595                    system ($EXTRACT, "--update", "--srcdir=$SRCDIR",
596                            "--type=$gettext_type", $filename);
597                } 
598                else 
599                {
600                    system ($EXTRACT, "--update", "--type=$gettext_type", 
601                            "--srcdir=$SRCDIR", "--quiet", $filename);
602                }
603            }
604        }
605        close FILE;
606    }
607 }
608
609 #
610 # Generate .pot file from POTFILES.in
611 #
612 sub GeneratePOTemplate
613 {
614     my $XGETTEXT = $ENV{"XGETTEXT"} || "@INTLTOOL_XGETTEXT@";
615     my $XGETTEXT_ARGS = $ENV{"XGETTEXT_ARGS"} || '';
616     chomp $XGETTEXT;
617
618     if (! -x $XGETTEXT)
619     {
620         print STDERR " *** xgettext is not found on this system!\n".
621                      " *** Without it, intltool-update can not extract strings.\n";
622         exit;
623     }
624
625     print "Building $MODULE.pot...\n" if $VERBOSE;
626
627     open INFILE, $POTFILES_in;
628     unlink "POTFILES.in.temp";
629     open OUTFILE, ">POTFILES.in.temp" or die("Cannot open POTFILES.in.temp for writing");
630
631     my $gettext_support_nonascii = 0;
632
633     # checks for GNU gettext >= 0.12
634     my $dummy = `$XGETTEXT --version --from-code=UTF-8 >$devnull 2>$devnull`;
635     if ($? == 0)
636     {
637         $gettext_support_nonascii = 1;
638     }
639     else
640     {
641         # urge everybody to upgrade gettext
642         print STDERR "WARNING: This version of gettext does not support extracting non-ASCII\n".
643                      "         strings. That means you should install a version of gettext\n".
644                      "         that supports non-ASCII strings (such as GNU gettext >= 0.12),\n".
645                      "         or have to let non-ASCII strings untranslated. (If there is any)\n";
646     }
647
648     my $encoding = "ASCII";
649     my $forced_gettext_code;
650     my @temp_headers;
651     my $encoding_problem_is_reported = 0;
652
653     while (<INFILE>) 
654     {
655         next if (/^#/ or /^\s*$/);
656
657         chomp;
658
659         my $gettext_code;
660
661         if (/^\[\s*encoding:\s*(.*)\s*\]/)
662         {
663             $forced_gettext_code=$1;
664         }
665         elsif (/\.($xml_support|$ini_support)$/ || /^\[/)
666         {
667             s/^\[.*]\s*//;
668             print OUTFILE "../$_.h\n";
669             push @temp_headers, "../$_.h";
670             $gettext_code = &TextFile_DetermineEncoding ("../$_.h") if ($gettext_support_nonascii and not defined $forced_gettext_code);
671         } 
672         else 
673         {
674             if ($SRCDIR eq ".") {
675                 print OUTFILE "../$_\n";
676             } else {
677                 print OUTFILE "$SRCDIR/../$_\n";
678             }
679             $gettext_code = &TextFile_DetermineEncoding ("../$_") if ($gettext_support_nonascii and not defined $forced_gettext_code);
680         }
681
682         next if (! $gettext_support_nonascii);
683
684         if (defined $forced_gettext_code)
685         {
686             $encoding=$forced_gettext_code;
687         }
688         elsif (defined $gettext_code and "$encoding" ne "$gettext_code")
689         {
690             if ($encoding eq "ASCII")
691             {
692                 $encoding=$gettext_code;
693             }
694             elsif ($gettext_code ne "ASCII")
695             {
696                 # Only report once because the message is quite long
697                 if (! $encoding_problem_is_reported)
698                 {
699                     print STDERR "WARNING: You should use the same file encoding for all your project files,\n".
700                                  "         but $PROGRAM thinks that most of the source files are in\n".
701                                  "         $encoding encoding, while \"$_\" is (likely) in\n".
702                                  "         $gettext_code encoding. If you are sure that all translatable strings\n".
703                                  "         are in same encoding (say UTF-8), please \e[1m*prepend*\e[0m the following\n".
704                                  "         line to POTFILES.in:\n\n".
705                                  "                 [encoding: UTF-8]\n\n".
706                                  "         and make sure that configure.in/ac checks for $PACKAGE >= 0.27 .\n".
707                                  "(such warning message will only be reported once.)\n";
708                     $encoding_problem_is_reported = 1;
709                 }
710             }
711         }
712     }
713
714     close OUTFILE;
715     close INFILE;
716
717     unlink "$MODULE.pot";
718     my @xgettext_argument=("$XGETTEXT",
719                            "--add-comments",
720                            "--directory\=\.",
721                            "--output\=$MODULE\.pot",
722                            "--files-from\=\.\/POTFILES\.in\.temp");
723     my $XGETTEXT_KEYWORDS = &FindPOTKeywords;
724     push @xgettext_argument, $XGETTEXT_KEYWORDS;
725     my $MSGID_BUGS_ADDRESS = &FindMakevarsBugAddress;
726     push @xgettext_argument, "--msgid-bugs-address\=$MSGID_BUGS_ADDRESS" if $MSGID_BUGS_ADDRESS;
727     push @xgettext_argument, "--from-code\=$encoding" if ($gettext_support_nonascii);
728     push @xgettext_argument, $XGETTEXT_ARGS if $XGETTEXT_ARGS;
729     my $xgettext_command = join ' ', @xgettext_argument;
730
731     # intercept xgettext error message
732     print "Running $xgettext_command\n" if $VERBOSE;
733     my $xgettext_error_msg = `$xgettext_command 2>\&1`;
734     my $command_failed = $?;
735
736     unlink "POTFILES.in.temp";
737
738     print "Removing generated header (.h) files..." if $VERBOSE;
739     unlink foreach (@temp_headers);
740     print "done.\n" if $VERBOSE;
741
742     if (! $command_failed)
743     {
744         if (! -e "$MODULE.pot")
745         {
746             print "None of the files in POTFILES.in contain strings marked for translation.\n" if $VERBOSE;
747         }
748         else
749         {
750             print "Wrote $MODULE.pot\n" if $VERBOSE;
751         }
752     }
753     else
754     {
755         if ($xgettext_error_msg =~ /--from-code/)
756         {
757             # replace non-ASCII error message with a more useful one.
758             print STDERR "ERROR: xgettext failed to generate PO template file because there is non-ASCII\n".
759                          "       string marked for translation. Please make sure that all strings marked\n".
760                          "       for translation are in uniform encoding (say UTF-8), then \e[1m*prepend*\e[0m the\n".
761                          "       following line to POTFILES.in and rerun $PROGRAM:\n\n".
762                          "           [encoding: UTF-8]\n\n";
763         }
764         else
765         {
766             print STDERR "$xgettext_error_msg";
767             if (-e "$MODULE.pot")
768             {
769                 # is this possible?
770                 print STDERR "ERROR: xgettext failed but still managed to generate PO template file.\n".
771                              "       Please consult error message above if there is any.\n";
772             }
773             else
774             {
775                 print STDERR "ERROR: xgettext failed to generate PO template file. Please consult\n".
776                              "       error message above if there is any.\n";
777             }
778         }
779         exit (1);
780     }
781 }
782
783 sub POFile_Update
784 {
785     -f "$MODULE.pot" or die "$PROGRAM: $MODULE.pot does not exist.\n";
786
787     my $MSGMERGE = $ENV{"MSGMERGE"} || "@INTLTOOL_MSGMERGE@";
788     my ($lang, $outfile) = @_;
789
790     print "Merging $SRCDIR/$lang.po with $MODULE.pot..." if $VERBOSE;
791
792     my $infile = "$SRCDIR/$lang.po";
793     $outfile = "$SRCDIR/$lang.po" if ($outfile eq "");
794
795     # I think msgmerge won't overwrite old file if merge is not successful
796     system ("$MSGMERGE", "-o", $outfile, $infile, "$MODULE.pot");
797 }
798
799 sub Console_WriteError_NotExisting
800 {
801     my ($file) = @_;
802
803     ## Report error if supplied language file is non-existing
804     print STDERR "$PROGRAM: $file does not exist!\n";
805     print STDERR "Try '$PROGRAM --help' for more information.\n";
806     exit;
807 }
808
809 sub GatherPOFiles
810 {
811     my @po_files = glob ("./*.po");
812
813     @languages = map (&POFile_GetLanguage, @po_files);
814
815     foreach my $lang (@languages) 
816     {
817         $po_files_by_lang{$lang} = shift (@po_files);
818     }
819 }
820
821 sub POFile_GetLanguage ($)
822 {
823     s/^(.*\/)?(.+)\.po$/$2/;
824     return $_;
825 }
826
827 sub Console_Write_TranslationStatus
828 {
829     my ($lang, $output_file) = @_;
830     my $MSGFMT = $ENV{"MSGFMT"} || "@INTLTOOL_MSGFMT@";
831
832     $output_file = "$SRCDIR/$lang.po" if ($output_file eq "");
833
834     system ("$MSGFMT", "-o", "$devnull", "--verbose", $output_file);
835 }
836
837 sub Console_Write_CoverageReport
838 {
839     my $MSGFMT = $ENV{"MSGFMT"} || "@INTLTOOL_MSGFMT@";
840
841     &GatherPOFiles;
842
843     foreach my $lang (@languages) 
844     {
845         print "$lang: ";
846         &POFile_Update ($lang, "");
847     }
848
849     print "\n\n * Current translation support in $MODULE \n\n";
850
851     foreach my $lang (@languages)
852     {
853         print "$lang: ";
854         system ("$MSGFMT", "-o", "$devnull", "--verbose", "$SRCDIR/$lang.po");
855     }
856 }
857
858 sub SubstituteVariable
859 {
860     my ($str) = @_;
861     
862     # always need to rewind file whenever it has been accessed
863     seek (CONF, 0, 0);
864
865     # cache each variable. varhash is global to we can add
866     # variables elsewhere.
867     while (<CONF>)
868     {
869         if (/^(\w+)=(.*)$/)
870         {
871             ($varhash{$1} = $2) =~  s/^["'](.*)["']$/$1/;
872         }
873     }
874     
875     if ($str =~ /^(.*)\${?([A-Z_]+)}?(.*)$/)
876     {
877         my $rest = $3;
878         my $untouched = $1;
879         my $sub = "";
880         # Ignore recursive definitions of variables
881         $sub = $varhash{$2} if defined $varhash{$2} and $varhash{$2} !~ /\${?$2}?/;
882
883         return SubstituteVariable ("$untouched$sub$rest");
884     }
885     
886     # We're using Perl backticks ` and "echo -n" here in order to 
887     # expand any shell escapes (such as backticks themselves) in every variable
888     return echo_n ($str);
889 }
890
891 sub CONF_Handle_Open
892 {
893     my $base_dirname = getcwd();
894     $base_dirname =~ s@.*/@@;
895
896     my ($conf_in, $src_dir);
897
898     if ($base_dirname =~ /^po(-.+)?$/) 
899     {
900         if (-f "Makevars") 
901         {
902             my $makefile_source;
903
904             local (*IN);
905             open (IN, "<Makevars") || die "can't open Makevars: $!";
906
907             while (<IN>) 
908             {
909                 if (/^top_builddir[ \t]*=/) 
910                 {
911                     $src_dir = $_;
912                     $src_dir =~ s/^top_builddir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;
913
914                     chomp $src_dir;
915                     if (-f "$src_dir" . "/configure.ac") {
916                         $conf_in = "$src_dir" . "/configure.ac" . "\n";
917                     } else {
918                         $conf_in = "$src_dir" . "/configure.in" . "\n";
919                     }
920                     last;
921                 }
922             }
923             close IN;
924
925             $conf_in || die "Cannot find top_builddir in Makevars.";
926         }
927         elsif (-f "../configure.ac") 
928         {
929             $conf_in = "../configure.ac";
930         } 
931         elsif (-f "../configure.in") 
932         {
933             $conf_in = "../configure.in";
934         } 
935         else 
936         {
937             my $makefile_source;
938
939             local (*IN);
940             open (IN, "<Makefile") || return;
941
942             while (<IN>) 
943             {
944                 if (/^top_srcdir[ \t]*=/) 
945                 {
946                     $src_dir = $_;                  
947                     $src_dir =~ s/^top_srcdir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;
948
949                     chomp $src_dir;
950                     $conf_in = "$src_dir" . "/configure.in" . "\n";
951
952                     last;
953                 }
954             }
955             close IN;
956
957             $conf_in || die "Cannot find top_srcdir in Makefile.";
958         }
959
960         open (CONF, "<$conf_in");
961     }
962     else
963     {
964         print STDERR "$PROGRAM: Unable to proceed.\n" .
965                      "Make sure to run this script inside the po directory.\n";
966         exit;
967     }
968 }
969
970 sub FindPackageName
971 {
972     my $version;
973     my $domain = &FindMakevarsDomain;
974     my $name = $domain || "untitled";
975
976     &CONF_Handle_Open;
977
978     my $conf_source; {
979         local (*IN);
980         open (IN, "<&CONF") || return $name;
981         seek (IN, 0, 0);
982         local $/; # slurp mode
983         $conf_source = <IN>;
984         close IN;
985     }
986
987     # priority for getting package name:
988     # 1. GETTEXT_PACKAGE
989     # 2. first argument of AC_INIT (with >= 2 arguments)
990     # 3. first argument of AM_INIT_AUTOMAKE (with >= 2 argument)
991
992     # /^AM_INIT_AUTOMAKE\([\s\[]*([^,\)\s\]]+)/m 
993     # the \s makes this not work, why?
994     if ($conf_source =~ /^AM_INIT_AUTOMAKE\(([^,\)]+),([^,\)]+)/m)
995     {
996         ($name, $version) = ($1, $2);
997         $name    =~ s/[\[\]\s]//g;
998         $version =~ s/[\[\]\s]//g;
999         $varhash{"PACKAGE_NAME"} = $name if (not $name =~ /\${?AC_PACKAGE_NAME}?/);
1000         $varhash{"PACKAGE"} = $name if (not $name =~ /\${?PACKAGE}?/);
1001         $varhash{"PACKAGE_VERSION"} = $version if (not $name =~ /\${?AC_PACKAGE_VERSION}?/);
1002         $varhash{"VERSION"} = $version if (not $name =~ /\${?VERSION}?/);
1003     }
1004     
1005     if ($conf_source =~ /^AC_INIT\(([^,\)]+),([^,\)]+)/m) 
1006     {
1007         ($name, $version) = ($1, $2);
1008         $name    =~ s/[\[\]\s]//g;
1009         $version =~ s/[\[\]\s]//g;
1010         $varhash{"PACKAGE_NAME"} = $name if (not $name =~ /\${?AC_PACKAGE_NAME}?/);
1011         $varhash{"PACKAGE"} = $name if (not $name =~ /\${?PACKAGE}?/);
1012         $varhash{"PACKAGE_VERSION"} = $version if (not $name =~ /\${?AC_PACKAGE_VERSION}?/);
1013         $varhash{"VERSION"} = $version if (not $name =~ /\${?VERSION}?/);
1014     }
1015
1016     # \s makes this not work, why?
1017     $name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=\[?([^\n\]]+)/m;
1018     
1019     # m4 macros AC_PACKAGE_NAME, AC_PACKAGE_VERSION etc. have same value
1020     # as corresponding $PACKAGE_NAME, $PACKAGE_VERSION etc. shell variables.
1021     $name =~ s/\bAC_PACKAGE_/\$PACKAGE_/g;
1022
1023     $name = $domain if $domain;
1024
1025     $name = SubstituteVariable ($name);
1026     $name =~ s/^["'](.*)["']$/$1/;
1027
1028     return $name if $name;
1029 }
1030
1031
1032 sub FindPOTKeywords
1033 {
1034
1035     my $keywords = "--keyword\=\_ --keyword\=N\_ --keyword\=U\_ --keyword\=Q\_";
1036     my $varname = "XGETTEXT_OPTIONS";
1037     my $make_source; {
1038         local (*IN);
1039         open (IN, "<Makevars") || (open(IN, "<Makefile.in.in") && ($varname = "XGETTEXT_KEYWORDS")) || return $keywords;
1040         seek (IN, 0, 0);
1041         local $/; # slurp mode
1042         $make_source = <IN>;
1043         close IN;
1044     }
1045
1046     $keywords = $1 if $make_source =~ /^$varname[ ]*=\[?([^\n\]]+)/m;
1047     
1048     return $keywords;
1049 }
1050
1051 sub FindMakevarsDomain
1052 {
1053
1054     my $domain = "";
1055     my $makevars_source; { 
1056         local (*IN);
1057         open (IN, "<Makevars") || return $domain;
1058         seek (IN, 0, 0);
1059         local $/; # slurp mode
1060         $makevars_source = <IN>;
1061         close IN;
1062     }
1063
1064     $domain = $1 if $makevars_source =~ /^DOMAIN[ ]*=\[?([^\n\]\$]+)/m;
1065     $domain =~ s/^\s+//;
1066     $domain =~ s/\s+$//;
1067     
1068     return $domain;
1069 }
1070
1071 sub FindMakevarsBugAddress
1072 {
1073
1074     my $address = "";
1075     my $makevars_source; { 
1076         local (*IN);
1077         open (IN, "<Makevars") || return undef;
1078         seek (IN, 0, 0);
1079         local $/; # slurp mode
1080         $makevars_source = <IN>;
1081         close IN;
1082     }
1083
1084     $address = $1 if $makevars_source =~ /^MSGID_BUGS_ADDRESS[ ]*=\[?([^\n\]\$]+)/m;
1085     $address =~ s/^\s+//;
1086     $address =~ s/\s+$//;
1087     
1088     return $address;
1089 }