Changeset View
Changeset View
Standalone View
Standalone View
krita/action_i18n.pl
- This file was added.
Property | Old Value | New Value |
---|---|---|
File Mode | null | 100755 |
1 | #! /usr/bin/env perl | ||||
---|---|---|---|---|---|
2 | | ||||
3 | ### TODO: other copyrights, license? | ||||
4 | # Copyright (c) 2004 Richard Evans <rich@ridas.com> | ||||
5 | | ||||
6 | sub usage | ||||
7 | { | ||||
8 | warn <<"EOF"; | ||||
9 | | ||||
10 | extractrc [flags] filenames | ||||
11 | | ||||
12 | This script extracts messages from designer (.ui) and XMLGUI (.rc) files and | ||||
13 | writes on standard output (usually redirected to rc.cpp) the equivalent | ||||
14 | i18n() calls so that xgettext can parse them. | ||||
15 | | ||||
16 | --tag=name : Also extract the tag name(s). Repeat the flag to specify | ||||
17 | multiple names: --tag=tag_one --tag=tag_two | ||||
18 | | ||||
19 | --tag-group=group : Use a group of tags - uses 'default' if omitted. | ||||
20 | Valid groups are: @{[TAG_GROUPS()]} | ||||
21 | | ||||
22 | --context=name : Give i18n calls a context name: i18nc("name", ...) | ||||
23 | --lines : Include source line numbers in comments (deprecated, it is switched on by default now) | ||||
24 | --cstart=chars : Start of to-EOL style comments in output, defaults to // | ||||
25 | --language=lang : Create i18n calls appropriate for KDE bindings | ||||
26 | in the given language. Currently known languages: | ||||
27 | C++ (default), Python | ||||
28 | --ignore-no-input : Do not warn if there were no filenames specified | ||||
29 | --help|? : Display this summary | ||||
30 | --no-unescape-xml : Don't do xml unescaping | ||||
31 | | ||||
32 | EOF | ||||
33 | | ||||
34 | exit; | ||||
35 | } | ||||
36 | | ||||
37 | ########################################################################################### | ||||
38 | | ||||
39 | use strict; | ||||
40 | use warnings; | ||||
41 | use Getopt::Long; | ||||
42 | use Data::Dumper; # Provides debugging command: print Dumper(\%hash); | ||||
43 | | ||||
44 | use constant TAG_GROUP => | ||||
45 | { | ||||
46 | default => "[tT][eE][xX][tT]|title|string|whatsthis|toolTip|label", | ||||
47 | koffice => "Example|GroupName|Text|Comment|Syntax|TypeName", | ||||
48 | krita => "[tT][eE][xX][tT]|title|string|whatsThis|toolTip|iconText", | ||||
49 | none => "", | ||||
50 | }; | ||||
51 | | ||||
52 | use constant TAG_GROUPS => join ", ", map "'$_'", sort keys %{&TAG_GROUP}; | ||||
53 | | ||||
54 | # Specification to extract nice element-context for strings. | ||||
55 | use constant CONTEXT_SPEC => | ||||
56 | { | ||||
57 | # Data structure: extension => {tag => [ctxlevel, [attribute, ...]], ...} | ||||
58 | # Order of attributes determines their order in the extracted comment. | ||||
59 | "ui" => { | ||||
60 | "widget" => [10, ["class", "name"]], | ||||
61 | "item" => [15, []], | ||||
62 | "property" => [20, ["name"]], | ||||
63 | "attribute" => [20, ["name"]], | ||||
64 | }, | ||||
65 | "rc" => { | ||||
66 | "Menu" => [10, ["name"]], | ||||
67 | "ToolBar" => [10, ["name"]], | ||||
68 | }, | ||||
69 | "kcfg" => { | ||||
70 | "group" => [10, ["name"]], | ||||
71 | "entry" => [20, ["name"]], | ||||
72 | "whatsthis" => [30, []], | ||||
73 | "tooltip" => [30, []], | ||||
74 | "label" => [30, []], | ||||
75 | }, | ||||
76 | "action" => { | ||||
77 | "action" => [20, ["name"]], | ||||
78 | } | ||||
79 | }; | ||||
80 | | ||||
81 | # Specification to exclude strings by trailing section of element-context. | ||||
82 | use constant CONTEXT_EXCLUDE => | ||||
83 | [ | ||||
84 | # Data structure: [[tag, attribute, attrvalue], [...]] | ||||
85 | # Empty ("") attribute means all elements with given tag, | ||||
86 | # empty attrvalue means element with given tag and attribute of any value. | ||||
87 | [["widget", "class", "KFontComboBox"], ["item", "", ""], ["property", "", ""]], | ||||
88 | [["widget", "class", "KPushButton"], ["attribute", "name", "buttonGroup"]], | ||||
89 | [["widget", "class", "QRadioButton"], ["attribute", "name", "buttonGroup"]], | ||||
90 | [["widget", "class", "QToolButton"], ["attribute", "name", "buttonGroup"]], | ||||
91 | [["widget", "class", "QCheckBox"], ["attribute", "name", "buttonGroup"]], | ||||
92 | [["widget", "class", "QPushButton"], ["attribute", "name", "buttonGroup"]], | ||||
93 | [["widget", "class", "KTimeZoneWidget"], ["property", "name", "text"]], | ||||
94 | ]; | ||||
95 | | ||||
96 | # The parts between the tags of the extensions will be copied verbatim | ||||
97 | # Same data structure as in CONTEXT_EXCLUDE, but per extension. | ||||
98 | my %EXTENSION_VERBATIM_TAGS = ( | ||||
99 | "kcfg" => [["code", "", ""], ["default", "code", "true"], | ||||
100 | ["min", "code", "true"], ["max", "code", "true"]], | ||||
101 | ); | ||||
102 | | ||||
103 | # Add attribute lists as hashes, for membership checks. | ||||
104 | for my $ext ( keys %{&CONTEXT_SPEC} ) { | ||||
105 | for my $tag ( keys %{CONTEXT_SPEC->{$ext}} ) { | ||||
106 | my $arr = CONTEXT_SPEC->{$ext}{$tag}[1]; | ||||
107 | CONTEXT_SPEC->{$ext}{$tag}[2] = {map {$_ => 1} @{$arr}}; | ||||
108 | } | ||||
109 | } | ||||
110 | | ||||
111 | ########################################################################################### | ||||
112 | # Add options here as necessary - perldoc Getopt::Long for details on GetOptions | ||||
113 | | ||||
114 | GetOptions ( "tag=s" => \my @opt_extra_tags, | ||||
115 | "tag-group=s" => \my $opt_tag_group, | ||||
116 | "context=s" => \my $opt_context, # I18N context | ||||
117 | "lines" => \my $opt_lines, | ||||
118 | "cstart=s" => \my $opt_cstart, | ||||
119 | "language=s" => \my $opt_language, | ||||
120 | "ignore-no-input" => \my $opt_ignore_no_input, | ||||
121 | "no-unescape-xml" => \my $opt_no_unescape_xml, | ||||
122 | "help|?" => \&usage ); | ||||
123 | | ||||
124 | unless( @ARGV ) | ||||
125 | { | ||||
126 | warn "No filename specified" unless $opt_ignore_no_input; | ||||
127 | exit; | ||||
128 | } | ||||
129 | | ||||
130 | $opt_tag_group ||= "default"; | ||||
131 | | ||||
132 | die "Unknown tag group: '$opt_tag_group', should be one of " . TAG_GROUPS | ||||
133 | unless exists TAG_GROUP->{$opt_tag_group}; | ||||
134 | | ||||
135 | my $tags = TAG_GROUP->{$opt_tag_group}; | ||||
136 | my $extra_tags = join "", map "|" . quotemeta, @opt_extra_tags; | ||||
137 | my $text_string = qr/($tags$extra_tags)( [^>]*)?>/; # Precompile regexp | ||||
138 | my $cstart = $opt_cstart; # no default, selected by language if not given | ||||
139 | my $language = $opt_language || "C++"; | ||||
140 | my $context_known_exts = join "|", keys %{&CONTEXT_SPEC}; | ||||
141 | | ||||
142 | ########################################################################################### | ||||
143 | | ||||
144 | # Unescape basic XML entities. | ||||
145 | sub unescape_xml ($) { | ||||
146 | my $text = shift; | ||||
147 | | ||||
148 | if (not $opt_no_unescape_xml) { | ||||
149 | $text =~ s/</</g; | ||||
150 | $text =~ s/>/>/g; | ||||
151 | $text =~ s/&/&/g; | ||||
152 | $text =~ s/"/"/g; | ||||
153 | } | ||||
154 | | ||||
155 | return $text; | ||||
156 | } | ||||
157 | | ||||
158 | # Convert uic to C escaping. | ||||
159 | sub escape_uic_to_c ($) { | ||||
160 | my $text = shift; | ||||
161 | | ||||
162 | $text = unescape_xml($text); | ||||
163 | | ||||
164 | $text =~ s/\\/\\\\/g; # escape \ | ||||
165 | $text =~ s/\"/\\\"/g; # escape " | ||||
166 | $text =~ s/\r//g; # remove CR (Carriage Return) | ||||
167 | $text =~ s/\n/\\n\"\n\"/g; # escape LF (Line Feed). uic also change the code line at a LF, we do not do that. | ||||
168 | | ||||
169 | return $text; | ||||
170 | } | ||||
171 | | ||||
172 | ########################################################################################### | ||||
173 | | ||||
174 | sub dummy_call_infix { | ||||
175 | my ($cstart, $stend, $ctxt, $text, @cmnts) = @_; | ||||
176 | for my $cmnt (@cmnts) { | ||||
177 | print qq|$cstart $cmnt\n|; | ||||
178 | } | ||||
179 | if (defined $text) { | ||||
180 | $text = escape_uic_to_c($text); | ||||
181 | if (defined $ctxt) { | ||||
182 | $ctxt = escape_uic_to_c($ctxt); | ||||
183 | print qq|i18nc("$ctxt", "$text")$stend\n|; | ||||
184 | } else { | ||||
185 | print qq|i18n("$text")$stend\n|; | ||||
186 | } | ||||
187 | } | ||||
188 | } | ||||
189 | | ||||
190 | my %dummy_calls = ( | ||||
191 | "C++" => sub { | ||||
192 | dummy_call_infix($cstart || "//", ";", @_); | ||||
193 | }, | ||||
194 | "Python" => sub { | ||||
195 | dummy_call_infix($cstart || "#", "", @_); | ||||
196 | }, | ||||
197 | ); | ||||
198 | | ||||
199 | die "unknown language '$language'" if not defined $dummy_calls{$language}; | ||||
200 | my $dummy_call = $dummy_calls{$language}; | ||||
201 | | ||||
202 | # Program start proper - outer loop runs once for each file in the argument list. | ||||
203 | for my $file_name ( @ARGV ) | ||||
204 | { | ||||
205 | my $fh; | ||||
206 | | ||||
207 | unless ( open $fh, "<", $file_name ) | ||||
208 | { | ||||
209 | # warn "Failed to open: '$file_name': $!"; | ||||
210 | next; | ||||
211 | } | ||||
212 | | ||||
213 | # Ready element-context extraction. | ||||
214 | my $context_ext; | ||||
215 | my $context_string; # Regexp used to validate context | ||||
216 | if ( $file_name =~ /\.($context_known_exts)(\.(in|cmake))?$/ ) { | ||||
217 | $context_ext = $1; | ||||
218 | my $context_tag_gr = join "|", keys %{CONTEXT_SPEC->{$context_ext}}; | ||||
219 | $context_string = qr/($context_tag_gr)( [^>]*)?>/; # precompile regexp | ||||
220 | } | ||||
221 | | ||||
222 | my $string = ""; | ||||
223 | my $origstring = ""; | ||||
224 | my $in_text = 0; # Are we currently inside a block of raw text? | ||||
225 | my $start_line_no = 0; | ||||
226 | my $in_skipped_prop = 0; # Are we currently inside XML property that shouldn't be translated? | ||||
227 | my $tag = ""; | ||||
228 | my $attr = ""; | ||||
229 | my $context = ""; | ||||
230 | my $notr = ""; | ||||
231 | | ||||
232 | # Element-context data: [[level, tag, [[attribute, value], ...]], ...] | ||||
233 | # such that subarrays are ordered increasing by level. | ||||
234 | my @context = (); | ||||
235 | | ||||
236 | # All comments to pending dummy call. | ||||
237 | my @comments = (); | ||||
238 | | ||||
239 | # Begin looping through the file | ||||
240 | while ( <$fh> ) | ||||
241 | { | ||||
242 | # If your Perl is a bit rusty: $. is the current line number | ||||
243 | # Also, =~ and !~ are pattern-matching operators. :) | ||||
244 | if ( $. == 1 and $_ !~ /^(?:<!DOCTYPE|<\?xml|<!--|<ui version=)/ ) | ||||
245 | { | ||||
246 | print STDERR "Warning: $file_name does not have a recognised first line and texts won't be extracted\n"; | ||||
247 | last; | ||||
248 | } | ||||
249 | | ||||
250 | chomp; | ||||
251 | | ||||
252 | $string .= "\n" . $_; | ||||
253 | $origstring = $string; | ||||
254 | | ||||
255 | # 'database', 'associations', 'populationText' and 'styleSheet' properties contain strings that shouldn't be translated | ||||
256 | if ( $in_skipped_prop == 0 and $string =~ /<property name=\"(?:database|associations|populationText|styleSheet)\"/ ) | ||||
257 | { | ||||
258 | $in_skipped_prop = 1; | ||||
259 | } | ||||
260 | elsif ( $in_skipped_prop and $string =~ /<\/property/ ) | ||||
261 | { | ||||
262 | $string = ""; | ||||
263 | $in_skipped_prop = 0; | ||||
264 | } | ||||
265 | | ||||
266 | $context = $opt_context unless $in_text; | ||||
267 | $notr = "" unless $in_text; | ||||
268 | | ||||
269 | # print "context = " . $opt_context . "\n"; | ||||
270 | | ||||
271 | unless ( $in_skipped_prop or $in_text ) | ||||
272 | { | ||||
273 | # Check if this line contains context-worthy element. | ||||
274 | if ( $context_ext | ||||
275 | and ( ($tag, $attr) = $string =~ /<$context_string/ ) # no /o here | ||||
276 | and exists CONTEXT_SPEC->{$context_ext}{$tag} ) | ||||
277 | { | ||||
278 | my @atts; | ||||
279 | for my $context_att ( @{CONTEXT_SPEC->{$context_ext}{$tag}[1]} ) | ||||
280 | { | ||||
281 | if ( $attr and $attr =~ /\b$context_att\s*=\s*(["'])([^"']*?)\1/ ) | ||||
282 | { | ||||
283 | my $aval = $2; | ||||
284 | push @atts, [$context_att, $aval]; | ||||
285 | } | ||||
286 | } | ||||
287 | # Kill all tags in element-context with level higer or equal to this, | ||||
288 | # and add it to the end. | ||||
289 | my $clevel = CONTEXT_SPEC->{$context_ext}{$tag}[0]; | ||||
290 | for ( my $i = 0; $i < @context; ++$i ) | ||||
291 | { | ||||
292 | if ( $clevel <= $context[$i][0] ) | ||||
293 | { | ||||
294 | @context = @context[0 .. ($i - 1)]; | ||||
295 | last; | ||||
296 | } | ||||
297 | } | ||||
298 | push @context, [$clevel, $tag, [@atts]]; | ||||
299 | } | ||||
300 | | ||||
301 | if ( ($tag, $attr) = $string =~ /<$text_string/o ) | ||||
302 | { | ||||
303 | my ($attr_comment) = $attr =~ /\bcomment=\"([^\"]*)\"/ if $attr; | ||||
304 | $context = $attr_comment if $attr_comment; | ||||
305 | my ($attr_context) = $attr =~ /\bcontext=\"([^\"]*)\"/ if $attr; | ||||
306 | $context = $attr_context if $attr_context; | ||||
307 | # It is unlikely that both attributes 'context' and 'comment' | ||||
308 | # will be present, but if so happens, 'context' has priority. | ||||
309 | my ($attr_extracomment) = $attr =~ /\bextracomment=\"([^\"]*)\"/ if $attr; | ||||
310 | push @comments, "i18n: $attr_extracomment" if $attr_extracomment; | ||||
311 | | ||||
312 | my ($attr_notr) = $attr =~ /\bnotr=\"([^\"]*)\"/ if $attr; | ||||
313 | $notr = $attr_notr if $attr_notr; | ||||
314 | | ||||
315 | my $nongreedystring = $string; | ||||
316 | $string =~ s/^.*<$text_string//so; | ||||
317 | $nongreedystring =~ s/^.*?<$text_string//so; | ||||
318 | if ($string cmp $nongreedystring) | ||||
319 | { | ||||
320 | print STDERR "Warning: Line $origstring in file $file_name has more than one tag to extract on the same line, that is not supported by extractrc\n"; | ||||
321 | } | ||||
322 | if ( not $attr or $attr !~ /\/ *$/ ) | ||||
323 | { | ||||
324 | $in_text = 1; | ||||
325 | $start_line_no = $.; | ||||
326 | } | ||||
327 | } | ||||
328 | else | ||||
329 | { | ||||
330 | @comments = (); | ||||
331 | $string = ""; | ||||
332 | } | ||||
333 | } | ||||
334 | | ||||
335 | next unless $in_text; | ||||
336 | next unless $string =~ /<\/$text_string/o; | ||||
337 | | ||||
338 | my $text = $string; | ||||
339 | $text =~ s/<\/$text_string.*$//o; | ||||
340 | | ||||
341 | if ( $text cmp "" ) | ||||
342 | { | ||||
343 | # See if the string should be excluded by trailing element-context. | ||||
344 | my $exclude_by_context = 0; | ||||
345 | my @rev_context = reverse @context; | ||||
346 | for my $context_tail (@{&CONTEXT_EXCLUDE}) | ||||
347 | { | ||||
348 | my @rev_context_tail = reverse @{$context_tail}; | ||||
349 | my $i = 0; | ||||
350 | $exclude_by_context = (@rev_context > 0 and @rev_context_tail > 0); | ||||
351 | while ($i < @rev_context and $i < @rev_context_tail) | ||||
352 | { | ||||
353 | my ($tag, $attr, $aval) = @{$rev_context_tail[$i]}; | ||||
354 | $exclude_by_context = (not $tag or ($tag eq $rev_context[$i][1])); | ||||
355 | if ($exclude_by_context and $attr) | ||||
356 | { | ||||
357 | $exclude_by_context = 0; | ||||
358 | for my $context_attr_aval (@{$rev_context[$i][2]}) | ||||
359 | { | ||||
360 | if ($attr eq $context_attr_aval->[0]) | ||||
361 | { | ||||
362 | $exclude_by_context = $aval ? $aval eq $context_attr_aval->[1] : 1; | ||||
363 | last; | ||||
364 | } | ||||
365 | } | ||||
366 | } | ||||
367 | last if not $exclude_by_context; | ||||
368 | ++$i; | ||||
369 | } | ||||
370 | last if $exclude_by_context; | ||||
371 | } | ||||
372 | | ||||
373 | if (($context and $context eq "KDE::DoNotExtract") or ($notr eq "true")) | ||||
374 | { | ||||
375 | push @comments, "Manually excluded message at $file_name line $."; | ||||
376 | } | ||||
377 | elsif ( $exclude_by_context ) | ||||
378 | { | ||||
379 | push @comments, "Automatically excluded message at $file_name line $."; | ||||
380 | } | ||||
381 | else | ||||
382 | { | ||||
383 | # Write everything to file | ||||
384 | (my $clean_file_name = $file_name) =~ s/^\.\///; | ||||
385 | push @comments, "i18n: file: $clean_file_name:$."; | ||||
386 | if ( @context ) { | ||||
387 | # Format element-context. | ||||
388 | my @tag_gr; | ||||
389 | for my $tgr (reverse @context) | ||||
390 | { | ||||
391 | my @attr_gr; | ||||
392 | for my $agr ( @{$tgr->[2]} ) | ||||
393 | { | ||||
394 | #push @attr_gr, "$agr->[0]=$agr->[1]"; | ||||
395 | push @attr_gr, "$agr->[1]"; # no real nead for attribute name | ||||
396 | } | ||||
397 | my $attr = join(", ", @attr_gr); | ||||
398 | push @tag_gr, "$tgr->[1] ($attr)" if $attr; | ||||
399 | push @tag_gr, "$tgr->[1]" if not $attr; | ||||
400 | } | ||||
401 | my $context_str = join ", ", @tag_gr; | ||||
402 | push @comments, "i18n: context: $context_str"; | ||||
403 | } | ||||
404 | push @comments, "xgettext: no-c-format" if $text =~ /%/o; | ||||
405 | $dummy_call->($context, $text, @comments); | ||||
406 | @comments = (); | ||||
407 | } | ||||
408 | } | ||||
409 | else | ||||
410 | { | ||||
411 | push @comments, "Skipped empty message at $file_name line $."; | ||||
412 | } | ||||
413 | | ||||
414 | $string =~ s/^.*<\/$text_string//o; | ||||
415 | $in_text = 0; | ||||
416 | | ||||
417 | # Text can be multiline in .ui files (possibly), but we warn about it in XMLGUI .rc files. | ||||
418 | | ||||
419 | warn "there is <text> floating in: '$file_name'" if $. != $start_line_no and $file_name =~ /\.rc$/i; | ||||
420 | } | ||||
421 | | ||||
422 | close $fh or warn "Failed to close: '$file_name': $!"; | ||||
423 | | ||||
424 | die "parsing error in $file_name" if $in_text; | ||||
425 | | ||||
426 | if ($context_ext && exists $EXTENSION_VERBATIM_TAGS{$context_ext}) | ||||
427 | { | ||||
428 | unless ( open $fh, "<", $file_name ) | ||||
429 | { | ||||
430 | # warn "Failed to open: '$file_name': $!"; | ||||
431 | next; | ||||
432 | } | ||||
433 | | ||||
434 | while ( <$fh> ) | ||||
435 | { | ||||
436 | chomp; | ||||
437 | $string .= "\n" . $_; | ||||
438 | | ||||
439 | for my $elspec (@{ $EXTENSION_VERBATIM_TAGS{$context_ext} }) | ||||
440 | { | ||||
441 | my ($tag, $attr, $aval) = @{$elspec}; | ||||
442 | my $rx; | ||||
443 | if ($attr and $aval) { | ||||
444 | $rx = qr/<$tag[^<]*$attr=["']$aval["'][^<]*>(.*)<\/$tag>/s | ||||
445 | } elsif ($attr) { | ||||
446 | $rx = qr/<$tag[^<]*$attr=[^<]*>(.*)<\/$tag>/s | ||||
447 | } else { | ||||
448 | $rx = qr/<$tag>(.*)<\/$tag>/s | ||||
449 | } | ||||
450 | if ($string =~ $rx) | ||||
451 | { | ||||
452 | # Add comment before any line that has an i18n substring in it. | ||||
453 | my @matched = split /\n/, $1; | ||||
454 | my $mlno = $.; | ||||
455 | (my $norm_fname = $file_name) =~ s/^\.\///; | ||||
456 | for my $mline (@matched) { | ||||
457 | # Assume verbatim code is in language given by --language. | ||||
458 | # Therefore format only comment, and write code line as-is. | ||||
459 | if ($mline =~ /i18n/) { | ||||
460 | $dummy_call->(undef, undef, ("i18n: file: $norm_fname:$mlno")); | ||||
461 | } | ||||
462 | $mline = unescape_xml($mline); | ||||
463 | print "$mline\n"; | ||||
464 | ++$mlno; | ||||
465 | } | ||||
466 | $string = ""; | ||||
467 | } | ||||
468 | } | ||||
469 | } | ||||
470 | | ||||
471 | close $fh or warn "Failed to close: '$file_name': $!"; | ||||
472 | } | ||||
473 | } |