aboutsummaryrefslogblamecommitdiffstats
path: root/po/ui-extract.pl
blob: a7ccf78bfcbf20e7d394ce429cbcdb78dec0cc75 (plain) (tree)





















































































































































































                                                                                          
#!/usr/bin/perl -w 

#  The XML UI Translation Extractor
#  (C) 2000 The Free Software Foundation
#
#  Authors: Kenneth Christiansen <kenneth@gnu.org>

use strict;
use Getopt::Long;

my $VERSION     = "0.6.1";

my $FILE    = $ARGV[0];
my $HELP_ARG    = "0";
my $VERSION_ARG = "0";
my $UPDATE_ARG  = "0";
my %string  = ();
my $n       = 0;

$| = 1;

GetOptions (
        "help|h|?"   => \$HELP_ARG,
        "version|v"  => \$VERSION_ARG,
        "update"     => \$UPDATE_ARG,
        ) or &Error;

&SplitOnArgument;


#---------------------------------------------------
# Check for options. 
# This section will check for the different options.
#---------------------------------------------------

sub SplitOnArgument {

    if ($VERSION_ARG) {
    &Version;

    } elsif ($HELP_ARG) {
    &Help;   

    } elsif ($UPDATE_ARG) {
        &Xmlfiles;

    } elsif (@ARGV > 0) {
    &Message;
    &Xmlfiles;

    } else {
    &Help;

    }  
}    

#-------------------
sub Version{
    print "The XML UI Translations Extractor $VERSION\n";
    print "Written by Kenneth Christiansen, 2000.\n\n";
    print "Copyright (C) 2000 Free Software Foundation, Inc.\n";
    print "This is free software; see the source for copying conditions.  There is NO\n";
    print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
    exit;
}

#-------------------  
sub Help{
    print "Usage: ui-extract.pl [FILENAME] [OPTIONS] ...\n";
    print "Generates a headerfile from an xml source.\n\nGraps all strings ";
    print "between <_translatable_node> and it's end tag,\nwhere tag are all allowed ";
    print "xml tags. Read the docs for more info.\n\n"; 
    print "  -V, --version                shows the version\n";
    print "  -H, --help                   shows this help page\n";
    print "\nReport bugs to <kenneth\@gnu.org>.\n";
    exit;
}

#------------------- 
sub Error{
#   print "ui-extract: invalid option @ARGV\n";
    print "Try `ui-extract.pl --help' for more information.\n";
    exit;
}

sub Message {
    print "Generating headerfile for XML translation.\n";
}

sub Xmlfiles {

   if (-s "$FILE.h"){
    unlink "$FILE.h";
   }

    &Convert ($FILE);


    open OUT, ">>$FILE.h";
    &addMessages;
    close OUT;

    print  "Wrote $FILE.h\n";
}

#-------------------
sub Convert($) {

    if ($ARGV[1]){
        $FILE   = $ARGV[1];
    } else {
        $FILE   = $ARGV[0];
    }

    #-----------------
    # Reading the file
    #-----------------
    my $input; {
    local (*IN);
    local $/; #slurp mode
    open (IN, "<$FILE") || die "can't open $FILE: $!";
    $input = <IN>;
    }
 
    if (!-s "$FILE.h"){
        open OUT, ">$FILE.h";

    print OUT "/*\n";
        print OUT " * Translatable strings file generated by extract-ui.\n";
        print OUT " * Add this file to your project's POTFILES.in\n";
        print OUT " * DO NOT compile it as part of your application.\n";
        print OUT " */\n\n"; 
            
        }   
        close OUT;

    ### For generic translatable XML files ###
 
        if ($FILE =~ /xml$/sg){
        while ($input =~ /[\t\n\s]_[a-zA-Z0-9_]+=\"([^\"]+)\"/sg) {
        $string{$1} = [];
        }

    while ($input =~ /<_[a-zA-Z0-9_]+>(..[^_]*)<\/_[a-zA-Z0-9_]+>/sg) {
        $string{$1} = [];
    }}

        ### For translatable Glade XML files ###

        if ($FILE =~ /glade$/sg){
        my $translate = "label|title|text|format|copyright|comments|preview_text|tooltip";

        while ($input =~ /<($translate)>(..[^<]*)<\/($translate)>/sg) {
                $string{$2} = [];
        }}
    }

sub addMessages{

    foreach my $theMessage (sort keys %string) {
    my ($lineNo,$fileName) = @{ $string{$theMessage} };

    if ($theMessage =~ /\n/) {
    print OUT "gchar *s = N_("; 

    $n = 1;
        for (split /\n/, $theMessage) {
        $_ =~ s/^\s+//mg;
        if ($n > 1) { print OUT "              ";}
            $n++;
        print OUT "\"$_\");\n";
    }

    } else {
        
        print OUT "gchar *s = N_(\"$theMessage\");\n";

    }
        
    }
}