i18n improvements

1 files changed, 508 insertions, 0 deletions

diff --git a/po/pl_create_placeholder b/po/pl_create_placeholder
new file mode 100755
index 00000000..3a34cbdb
--- /dev/null
+++ b/po/pl_create_placeholder
@@ -0,0 +1,508 @@
+#!/usr/bin/perl
+
+# modified xplgettext from perl-gettext (pablo)
+
+# this program extracts internationalizable strings from a perl program.
+
+# forward declaration of subroutines.
+sub unescapeDQString;
+sub replaceString($$$$);
+sub doWarn($$);
+sub displayHelp();
+sub doNotify($);
+
+
+# we do the option handling first.
+use Getopt::Long;
+Getopt::Long::config("no_ignore_case", 
+                     "no_auto_abbrev", 
+                     "require_order",
+                     "bundling");
+# since get options doesn't seem to handle '-' as option well,
+# we'll preprocess here
+foreach $i (0 ... $#ARGV)
+{
+   if($opt eq '-')
+   {
+      $ARGV[$i] = '__stdin__';
+   }
+}
+
+if(!GetOptions(\%opts,
+#           'default-domain|d=s',
+#           'directory|D=s',
+#           'no-escape|e',
+#           'escape|E',
+#           'files-from=s',
+#           'sort-by-file|F',
+#           'help|h',
+#           'indent|i',
+#           'join-existing|j',
+#           'keyword|k:s@',
+#           'string-limit|l=i',
+#           'msgstr-prefix|m:s',
+#           'msgstr-suffix|M:s',
+#           'no-location',
+#           'add-location|n',
+#           'omit-header',
+#           'sort-output|s',
+#           'strict',
+           'verbose|v',
+#           'version|V',
+#           'exclude-file|x=s'
+           ) || defined($opts{"help"}))
+{
+   displayHelp;
+}
+
+# check if we have any file names to deal with.
+if($#ARGV == -1)
+{
+   doWarn 1, 'File name not specified.  Standard in is used instead.';
+   push @ARGV, '__stdin__';
+}
+
+
+# keeps track of the state of the parser.  basically means what we are 
+# looking for next.
+$state = 'func_head';
+
+# initialize the text temporarry strage.
+$text = "";
+
+# repeat for all the lines.
+for($i = 0; $i <= $#ARGV; $i++)
+{
+   # this keeps track of the line number.
+   $linenum = 0;
+
+   # open the file.  we take '__stdin__' as standard in.
+   $ARGV[$i] = '-' if $ARGV[$i] eq '__stdin__';
+   if(!open(IN, "< $ARGV[$i]"))
+   {
+      # failed to open the file.
+      doWarn 0, "Failed to open input file $ARGV[$i].";
+      next;
+   }
+   doNotify "File $ARGV[$i] opened.";
+
+   # keep track of the files successfully opened.
+   push @files, $ARGV[$i];
+
+   while(<IN>)
+   {
+      $linenum++;
+   
+      # discard the comment lines.
+      if(/^\s*\#/)
+      {
+         next;
+      }
+   
+      # our assumption is that 'I_(' won't appear anywhere other than where 
+      # internationalizable text is being marked.
+      chop;
+      $line = $_;
+      while ($line)
+      {
+         if($state eq 'func_head')
+         {
+            # this means we are looking for the beginning of funciton call.
+            #if($line =~ s/.*?I\_\(//)
+            if($line =~ s/.*?\_\(//)
+            {
+               $state = 'quote_begin';
+               next;
+            }
+
+            # nothing interesting in this line.
+            last;
+         }
+   
+         elsif($state eq 'quote_begin')
+         {
+            # we are looking for left quote.  there can be two of them.
+            if($line =~ s/^\s*([\"\'])//)
+            {
+               # this has to happen.  check what kind of quoting we have.
+               $start_line = $linenum;
+               if($1 eq '"')
+               {
+                  $state = 'dq_text';
+               }
+               else
+               {
+                  $state = 'sq_text';
+               }
+            }
+            else
+            {
+               # otherwise, this is something we can't handle.
+               doWarn 1, "Unrecognizable expression within I_" .
+                            " function call. (line: $linenum)";
+               $state = 'dynamic_text';
+            }
+   
+            # lines can't end in this state.
+            next;
+         }
+   
+         elsif($state eq 'dq_text')
+         {
+            # we are only interested in another double quote which is not
+            # preceded by a back slash.
+            if($line =~ s/(.*?)\"//)
+            {
+               # check if we have a back slash preceding it.
+               $t = $1;
+               if($t =~ /\\$/)
+               {
+                  # the double quote was within the string still.
+                  $text .= unescapeDQString($t + '"');
+               }
+               else
+               {
+                  # end of the string.
+                  $text .= unescapeDQString($t);
+                  $state = 'end_text';
+               }
+               next;
+            }
+
+            # all this line is the string.
+            $text .= unescapeDQString($line . '\n');
+            last;
+         }
+   
+         elsif($state eq 'sq_text')
+         {
+            # we are only interested in another single quote which is not 
+            # preceded by a back slash.
+            if($line =~ s/(.*?)\'//)
+            {
+               # check if we have a back slash preceding it.
+               $t = $1;
+               if($t =~ s/\\$//)
+               {
+                  # the single quote was still in the string.
+                  $text .= unescapeDQString($t + "'");
+               }
+               else
+               {
+                  # end of the string.
+                  $text .= unescapeDQString($t);
+                  $state = 'end_text';
+               }
+               next;
+            }
+
+            # all this line is the string.
+            $text .= unescapeDQStrig($line . '\n');
+            last;
+         }
+   
+         elsif($state eq 'dynamic_text')
+         {
+            # we can't really handle this situation, so we'll look for
+            # a close pharenthy to return to the normal state.
+            if($line =~ s/.*?\)//)
+            {
+               # we can go back to the normal state.
+               $state = 'func_head';
+               next;
+            }
+
+            # we have to find the close pharenthy to go
+            # back to the normal state.
+            last;
+         }
+   
+         elsif($state eq 'end_text')
+         {
+            # we allow only period to appear between strings.
+            if($line =~ s/^\s*([\.\)])//)
+            {
+               # check what we've got.
+               if($1 eq '.')
+               {
+                  # another string should be comming.
+                  $state = 'quote_begin';
+               }
+               else
+               {
+                  # we ended the function call.
+                  $state = 'func_head';
+   
+                  # check if the string is a valid one.
+                  if($text eq "")
+                  {
+                     # we don't accept null strings.
+                     doWarn 1, "Null string appeared. (line: $linenum)";
+                  }
+                  else
+                  {
+                     # check if this string has appeared before.
+                     if(exists($msgs{$text}))
+                     {
+                        # it does exit.
+                        $msgs{$text} .= " $ARGV[$i]:$start_line";
+                     }
+                     else
+                     {
+                        # first time.
+                        $msgs{$text} = "$ARGV[$i]:$start_line";
+                     }
+                     $text = "";
+                  }
+               }
+               next;
+            }
+            else
+            {
+               # something weird follows the text.
+               # in this case, we ignore the string processed too.
+               doWarn 1, 'Unrecognizable expression within I_' .
+                            " function call. (line: $linenum)";
+               $text = "";
+               $state = 'dynamic_text';
+               next;
+            }
+         }
+   
+         else
+         {
+            # this should not happen.
+            doWarn 2, "Unknown state $state.";
+            last;
+         }
+
+         # end of while loop for state processing.
+      }
+      # end of while loop for input lines.
+   }
+   # end of for loop for input files.
+} 
+
+
+# we should have all the data we need now.
+# output the message file.
+if(!open(OUT, ">&STDOUT"))
+{
+   doWarn 0, 'Failed to open file placeholder.h.';
+   exit(0);
+}
+
+# go through all the strings gathered.
+foreach $msgid (keys(%msgs))
+{
+   # we find out if the text has to be split into lines.
+   $#lines = - 1;
+   while($msgid =~ /(.*?\\n)/gc)
+   {
+      push @lines, $1;
+   }
+   if(pos($msgid) < length($msgid))
+   {
+      # we have another line.
+      push @lines, substr($msgid, pos($msgid));
+   }
+
+   # check how many lines we have.
+   if($#lines == 0)
+   {
+# only multiline aren't found by xgettext
+      # one line format.
+      #print OUT "N_(\"$lines[0]\"),\n";
+   }
+   else
+   {
+      # multi-line format.
+      print OUT "N_(\"\"\n";
+      foreach $line (@lines)
+      {
+         print OUT "\"$line\"\n"
+      }
+      print OUT "\"\"),\n";
+   }
+}
+
+
+# successfully completed the mission.
+exit 0;
+
+
+######################################################################
+# helper funciton section
+######################################################################
+
+# this function has to return a value, so it doesn't deserve
+# the statement style call, and therefore doesn't deserve prototype.
+sub unescapeDQString
+{
+   my $str = shift;
+
+   # check all the back slashes.
+   while($str =~ /\\/g)
+   {
+      # we found a back slash.  let's check what the following
+      # character is.
+      my $char = substr($str, pos($str));
+
+      if($char eq '')
+      {
+         # since we assume one call of this function is for one
+         # complete string (term in string expression), we
+         # assume we don't have to worry about escape sequences
+         # span multiple calls.
+         
+         # it was the last character in the string.  this shouldn't
+         # happen, but we respect the back slash.
+         doWarn 2, "Back slash found at the end of string. (line: $lnenum)";
+         $str .= '\\';
+         last;
+      }
+
+      elsif($char =~ /^([tn]|[0-8][0-8][0-8])/)
+      {
+         # valid sequence.  no problem.
+         next;
+      }
+
+      elsif($char =~ /^[rfb]/)
+      {
+         # we warn, and use them as is.
+         doWarn 1, "International string sholdn't contain \\$&.";
+         next;
+      }
+
+      elsif($char =~ /^[ae]/)
+      {
+         # we warn, and convert.
+         doWarn 1, "International string shouldn't contain \\$&.";
+         replaceString \$str, $& eq 'a' ? '007' : '033', 0, 1;
+         next;
+      }
+
+      elsif($char =~ /^x([0-9a-fA-F][0-9a-fA-F])/)
+      {
+         # here, we do the conversion silently.
+         replaceString \$str, sprintf("%03o", hex($1)), 0, 3;
+         next;
+      }
+
+      elsif($char =~ /^c(.)/)
+      {
+         # we warn, and convert.
+         doWarn 1, "International string shouldn't contain \\$&.";
+         my $ctrl = ord($1) - 64;
+         if($ctrl < 255 || $ctrl < 0)
+         {
+            doWarn 1, "Unrecognizable control sequence \\$&.";
+            next;
+         }
+         replaceString \$str, sprintf("%03o", $ctrl), 0, 2;
+         next;
+      }
+
+      elsif($char =~ /^[luLUEQ]/)
+      {
+         # perl special escape sequences.
+         # we'll let them keep the slashes.
+         replaceString \$str, '\\', 0, 0;
+         next;
+      }
+
+      else
+      {
+         # in all other cases, the slash needs to be discarded.
+         replaceString \$str, '', -1, 1;
+         next;
+      }
+      # end of while loop for slashes.
+   }
+
+   # return value is the converted string.
+   $str;
+}
+
+
+# this one replaces a part of string in the specified position.
+# it also sets the search position to the end of the replaced substring.
+# the arguments are
+#     - reference of the target string
+#     - replacement text
+#     - starting position of the substring replaced (relative to pos)
+#     - length of the substring replaced
+sub replaceString($$$$)
+{
+   my $str_ref     = shift;
+   my $replace_str = shift;
+   my $del_start   = shift;
+   my $num_del     = shift;
+
+   my $p = pos($$str_ref);
+   $$str_ref = substr($$str_ref, 0, $p + $del_start) . 
+              $replace_str .
+              substr($$str_ref, $p + $del_start + $num_del);
+
+   # adjust the search position.
+   pos($$str_ref) = $p + $del_start + length($replace_str);
+}
+
+
+# sends warning to standard error.  the first argument is for the
+# warning level:
+#     0: critical - always show
+#     1: warning  - show if verbose
+#     2: bug      - shouldn't happen
+# the second argument is the message to be displayed.
+sub doWarn($$)
+{
+   my $level   = shift;
+   my $message = shift;
+
+   if($level == 0)
+   {
+      # critical error.
+      warn "ERROR:  " . $message . "\n";
+   }
+
+   elsif($level == 1)
+   {
+      # warning. 
+      warn "WARNING:  " . $message . "\n" if exists($opts{"verbose"});
+   }
+
+   elsif($level == 2)
+   {
+      # programming error (of plxgettext).
+      warn "BUG:  " . $message . "\n";
+   }
+
+   else
+   {
+      # shouldn't happen.  let's do a recursive call.
+      doWarn 2, 'Invalid warning level specified.';
+   }
+}
+
+
+# tell user what we are doing.
+sub doNotify($)
+{
+   my $msg = shift;
+
+   if(!defined($opts{"verbose"}))
+   {
+      # nothing we can do.
+      return;
+   }
+
+   print $msg . "\n";
+}
+
+
+# show the help message.
+sub displayHelp()
+{
+}