← Back to branch summary

~ubuntu-branches/ubuntu/dapper/xscreensaver/dapper

« back to all changes in this revision

Viewing changes to intltool-extract.in

  • Committer: Bazaar Package Importer
  • Author(s): Oliver Grawert
  • Date: 2005-10-11 21:00:42 UTC
  • mfrom: (2.1.1 sarge)
  • Revision ID: james.westby@ubuntu.com-20051011210042-u7q6zslgevdxspr3
Tags: 4.21-4ubuntu17
updated pt_BR again, fixed to UTF-8 

Show diffs side-by-side

added added

removed removed

Lines of Context:
intltool-extract.in
 
1
#!@INTLTOOL_PERL@ -w 
 
2
# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-
 
3
 
 
4
#
 
5
#  The Intltool Message Extractor
 
6
#
 
7
#  Copyright (C) 2000-2001 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 as
 
11
#  published by the Free Software Foundation; either version 2 of the
 
12
#  License, or (at your option) any later version.
 
13
#
 
14
#  Intltool is distributed in the hope that it will be useful,
 
15
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
17
#  General Public License for more details.
 
18
#
 
19
#  You should have received a copy of the GNU General Public License
 
20
#  along with this program; if not, write to the Free Software
 
21
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
22
#
 
23
#  As a special exception to the GNU General Public License, if you
 
24
#  distribute this file as part of a program that contains a
 
25
#  configuration script generated by Autoconf, you may include it under
 
26
#  the same distribution terms that you use for the rest of that program.
 
27
#
 
28
#  Authors: Kenneth Christiansen <kenneth@gnu.org>
 
29
#           Darin Adler <darin@bentspoon.com>
 
30
#
 
31
 
 
32
## Release information
 
33
my $PROGRAM      = "intltool-extract";
 
34
my $PACKAGE      = "intltool";
 
35
my $VERSION      = "0.18";
 
36
 
 
37
## Loaded modules
 
38
use strict; 
 
39
use File::Basename;
 
40
use Getopt::Long;
 
41
 
 
42
## Scalars used by the option stuff
 
43
my $TYPE_ARG    = "0";
 
44
my $LOCAL_ARG   = "0";
 
45
my $HELP_ARG    = "0";
 
46
my $VERSION_ARG = "0";
 
47
my $UPDATE_ARG  = "0";
 
48
my $QUIET_ARG   = "0";
 
49
 
 
50
my $FILE;
 
51
my $OUTFILE;
 
52
 
 
53
my $gettext_type = "";
 
54
my $input;
 
55
my %messages = ();
 
56
 
 
57
## Use this instead of \w for XML files to handle more possible characters.
 
58
my $w = "[-A-Za-z0-9._:]";
 
59
 
 
60
## Always print first
 
61
$| = 1;
 
62
 
 
63
## Handle options
 
64
GetOptions (
 
65
            "type=s"     => \$TYPE_ARG,
 
66
            "local|l"    => \$LOCAL_ARG,
 
67
            "help|h"     => \$HELP_ARG,
 
68
            "version|v"  => \$VERSION_ARG,
 
69
            "update"     => \$UPDATE_ARG,
 
70
            "quiet|q"    => \$QUIET_ARG,
 
71
            ) or &error;
 
72
 
 
73
&split_on_argument;
 
74
 
 
75
 
 
76
## Check for options. 
 
77
## This section will check for the different options.
 
78
 
 
79
sub split_on_argument {
 
80
 
 
81
    if ($VERSION_ARG) {
 
82
        &version;
 
83
 
 
84
    } elsif ($HELP_ARG) {
 
85
        &help;
 
86
        
 
87
    } elsif ($LOCAL_ARG) {
 
88
        &place_local;
 
89
        &extract;
 
90
 
 
91
    } elsif ($UPDATE_ARG) {
 
92
        &place_normal;
 
93
        &extract;
 
94
 
 
95
    } elsif (@ARGV > 0) {
 
96
        &place_normal;
 
97
        &message;
 
98
        &extract;
 
99
 
 
100
    } else {
 
101
        &help;
 
102
 
 
103
    }  
 
104
}    
 
105
 
 
106
sub place_normal {
 
107
    $FILE        = $ARGV[0];
 
108
    $OUTFILE     = "$FILE.h";
 
109
}   
 
110
 
 
111
sub place_local {
 
112
    $OUTFILE     = fileparse($FILE, ());
 
113
    if (!-e "tmp/") { 
 
114
        system("mkdir tmp/"); 
 
115
    }
 
116
    $OUTFILE     = "./tmp/$OUTFILE.h"
 
117
}
 
118
 
 
119
sub determine_type {
 
120
   if ($TYPE_ARG =~ /^gettext\/(.*)/) {
 
121
        $gettext_type=$1
 
122
   }
 
123
}
 
124
 
 
125
## Sub for printing release information
 
126
sub version{
 
127
    print "${PROGRAM} (${PACKAGE}) $VERSION\n";
 
128
    print "Copyright (C) 2000 Free Software Foundation, Inc.\n";
 
129
    print "Written by Kenneth Christiansen, 2000.\n\n";
 
130
    print "This is free software; see the source for copying conditions. There is NO\n";
 
131
    print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
 
132
    exit;
 
133
}
 
134
 
 
135
## Sub for printing usage information
 
136
sub help{
 
137
    print "Usage: ${PROGRAM} [FILENAME] [OPTIONS] ...\n";
 
138
    print "Generates a header file from an xml source file.\n\nGrabs all strings ";
 
139
    print "between <_translatable_node> and it's end tag,\nwhere tag are all allowed ";
 
140
    print "xml tags. Read the docs for more info.\n\n"; 
 
141
    print "  -v, --version                shows the version\n";
 
142
    print "  -h, --help                   shows this help page\n";
 
143
    print "  -q, --quiet                  quiet mode\n";
 
144
    print "\nReport bugs to <kenneth\@gnu.org>.\n";
 
145
    exit;
 
146
}
 
147
 
 
148
## Sub for printing error messages
 
149
sub error{
 
150
    print "Try `${PROGRAM} --help' for more information.\n";
 
151
    exit;
 
152
}
 
153
 
 
154
sub message {
 
155
    print "Generating C format header file for translation.\n";
 
156
}
 
157
 
 
158
sub extract {
 
159
    &determine_type;
 
160
 
 
161
    &convert ($FILE);
 
162
 
 
163
    open OUT, ">$OUTFILE";
 
164
    &msg_write;
 
165
    close OUT;
 
166
 
 
167
    print "Wrote $OUTFILE\n" unless $QUIET_ARG;
 
168
}
 
169
 
 
170
sub convert($) {
 
171
 
 
172
    ## Reading the file
 
173
    {
 
174
        local (*IN);
 
175
        local $/; #slurp mode
 
176
        open (IN, "<$FILE") || die "can't open $FILE: $!";
 
177
        $input = <IN>;
 
178
    }
 
179
 
 
180
    &type_ini if $gettext_type eq "ini";
 
181
    &type_keys if $gettext_type eq "keys";
 
182
    &type_xml if $gettext_type eq "xml";
 
183
    &type_glade if $gettext_type eq "glade";
 
184
    &type_scheme if $gettext_type eq "scheme";
 
185
}
 
186
 
 
187
sub entity_decode_minimal
 
188
{
 
189
    local ($_) = @_;
 
190
 
 
191
    s/&apos;/'/g; # '
 
192
    s/&quot;/"/g; # "
 
193
    s/&amp;/&/g;
 
194
 
 
195
    return $_;
 
196
}
 
197
 
 
198
sub entity_decode
 
199
{
 
200
    local ($_) = @_;
 
201
 
 
202
    s/&apos;/'/g; # '
 
203
    s/&quot;/"/g; # "
 
204
    s/&amp;/&/g;
 
205
    s/&lt;/</g;
 
206
    s/&gt;/>/g;
 
207
 
 
208
    return $_;
 
209
}
 
210
 
 
211
sub escape_char
 
212
{
 
213
    return '\"' if $_ eq '"';
 
214
    return '\n' if $_ eq "\n";
 
215
    return '\\' if $_ eq '\\';
 
216
 
 
217
    return $_;
 
218
}
 
219
 
 
220
sub escape
 
221
{
 
222
    my ($string) = @_;
 
223
    return join "", map &escape_char, split //, $string;
 
224
}
 
225
 
 
226
sub type_ini {
 
227
    ### For generic translatable desktop files ###
 
228
    while ($input =~ /^_.*=(.*)$/mg) {
 
229
        $messages{$1} = [];
 
230
    }
 
231
}
 
232
 
 
233
sub type_keys {
 
234
    ### For generic translatable mime/keys files ###
 
235
    while ($input =~ /^\s*_\w+=(.*)$/mg) {
 
236
        $messages{$1} = [];
 
237
    }
 
238
}
 
239
 
 
240
sub type_xml {
 
241
    ### For generic translatable XML files ###
 
242
        
 
243
    while ($input =~ /\s_$w+=\"([^"]+)\"/sg) { # "
 
244
        $messages{entity_decode_minimal($1)} = [];
 
245
    }
 
246
 
 
247
    while ($input =~ /<_($w+)>(.+?)<\/_\1>/sg) {
 
248
        $_ = $2;
 
249
        s/\s+/ /g;
 
250
        s/^ //;
 
251
        s/ $//;
 
252
        $messages{entity_decode_minimal($_)} = [];
 
253
    }
 
254
}
 
255
 
 
256
sub type_glade {
 
257
    ### For translatable Glade XML files ###
 
258
 
 
259
    my $tags = "label|title|text|format|copyright|comments|preview_text|tooltip|message";
 
260
 
 
261
    while ($input =~ /<($tags)>([^<]+)<\/($tags)>/sg) {
 
262
        # Glade sometimes uses tags that normally mark translatable things for
 
263
        # little bits of non-translatable content. We work around this by not
 
264
        # translating strings that only includes something like label4 or window1.
 
265
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
 
266
    }
 
267
    
 
268
    while ($input =~ /<items>(..[^<]*)<\/items>/sg) {
 
269
        for my $item (split (/\n/, $1)) {
 
270
            $messages{entity_decode($item)} = [];
 
271
        }
 
272
    }
 
273
 
 
274
    ## handle new glade files
 
275
    while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"[^>]*>([^<]+)<\/\1>/sg) {
 
276
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
 
277
    }
 
278
 
 
279
}
 
280
 
 
281
sub type_scheme {
 
282
    while ($input =~ /_\(?"((?:[^"\\]+|\\.)*)"\)?/sg) {
 
283
        $messages{$1} = [];
 
284
    }
 
285
}
 
286
 
 
287
sub msg_write {
 
288
    for my $message (sort keys %messages) { 
 
289
        print OUT "/* xgettext:no-c-format */\n" if $message =~ /%/;
 
290
        
 
291
        my @lines = split (/\n/, $message);
 
292
        for (my $n = 0; $n < @lines; $n++) {
 
293
            if ($n == 0) { 
 
294
                print OUT "char *s = N_(\""; 
 
295
            } else {  
 
296
                print OUT "             \""; 
 
297
            }
 
298
 
 
299
            print OUT escape($lines[$n]);
 
300
 
 
301
            if ($n < @lines - 1) { 
 
302
                print OUT "\\n\"\n"; 
 
303
            } else { 
 
304
                print OUT "\");\n";  
 
305
            }
 
306
        }
 
307
    }
 
308
}
 
309