diff options
Diffstat (limited to 'scripts/extractrc')
| -rwxr-xr-x | scripts/extractrc | 174 |
1 files changed, 174 insertions, 0 deletions
diff --git a/scripts/extractrc b/scripts/extractrc new file mode 100755 index 00000000..54c1123a --- /dev/null +++ b/scripts/extractrc @@ -0,0 +1,174 @@ +#! /usr/bin/env perl + +### TODO: other copyrights, license? +# Copyright (c) 2004 Richard Evans <rich@ridas.com> + +sub usage +{ + warn <<"EOF"; + +extractrc [flags] filenames + +This script extracts messages from designer (.ui) and XMLGUI (.rc) files and +writes on standard output (usually redirected to rc.cpp) the equivalent +i18n() calls so that xgettext can parse them. + +--tag=name : Also extract the tag name(s). Repeat the flag to specify + multiple names: --tag=tag_one --tag=tag_two + +--tag-group=group : Use a group of tags - uses 'default' if omitted. + Valid groups are: @{[TAG_GROUPS()]} + +--context=name : Give i18n calls a context name: i18n("name", ...) +--lines : Include source line numbers in comments (deprecated, it is switched on by default now) +--help|? : Display this summary + +EOF + + exit; +} + +########################################################################################### + +use strict; +use warnings; +use Getopt::Long; + +use constant TAG_GROUP => +{ + default => "[tT][eE][xX][tT]|title|string|whatsthis|tooltip|label", + koffice => "Example|GroupName|Text|Comment|Syntax|TypeName", + none => "", +}; + +use constant TAG_GROUPS => join ", ", map "'$_'", sort keys %{&TAG_GROUP}; + + +########################################################################################### +# Add options here as necessary - perldoc Getopt::Long for details on GetOptions + +GetOptions ( "tag=s" => \my @opt_extra_tags, + "tag-group=s" => \my $opt_tag_group, + "context=s" => \my $opt_context, # I18N context + "lines" => \my $opt_lines, + "help|?" => \&usage ); + +unless( @ARGV ) +{ + warn "No filename specified"; + exit; +} + +$opt_tag_group ||= "default"; + +die "Unknown tag group: '$opt_tag_group', should be one of " . TAG_GROUPS + unless exists TAG_GROUP->{$opt_tag_group}; + +my $tags = TAG_GROUP->{$opt_tag_group}; +my $extra_tags = join "", map "|" . quotemeta, @opt_extra_tags; +my $text_string = qr/($tags$extra_tags)( [^>]*)?>/; # Precompile regexp + + +########################################################################################### +# Program start proper - NB $. is the current line number + +for my $file_name ( @ARGV ) +{ + my $fh; + + unless ( open $fh, "<", $file_name ) + { + # warn "Failed to open: '$file_name': $!"; + next; + } + + my $string = ""; + my $in_text = 0; + my $start_line_no = 0; + my $in_skipped_prop = 0; + my $tag = ""; + my $attr = ""; + my $context = ""; + + while ( <$fh> ) + { + last if $. == 1 and $_ !~ /^(?:<!DOCTYPE|<\?xml|<!--)/; + + chomp; + + $string .= "\n" . $_; + + # 'database', 'associations' properties contain strings that shouldn't be translated + + if ( $in_skipped_prop == 0 and $string =~ /<property name=\"(?:database|associations|populationText)\"/ ) + { + $in_skipped_prop = 1; + } + elsif ( $in_skipped_prop and $string =~ /<\/property/ ) + { + $string = ""; + $in_skipped_prop = 0; + } + + $context = $opt_context; + + unless ( $in_skipped_prop or $in_text ) + { + if ( ($tag, $attr) = $string =~ /<$text_string/o ) + { + ($attr) = $attr =~ /\w*context=\"([^\"]*)\"/ if $attr; + $context = $attr if $attr; + + $string =~ s/^.*<$text_string//so; + $in_text = 1; + $start_line_no = $.; + } + else + { + $string = ""; + } + } + + next unless $in_text; + next unless $string =~ /<\/$text_string/o; + + my $text = $string; + + $text =~ s/<\/$text_string.*$//o; + $text =~ s/</</g; + $text =~ s/>/>/g; + $text =~ s/&/&/g; + + # We need to escape characters exactly like uic does it: + $text =~ s/\\/\\\\/g; # escape \ + $text =~ s/\"/\\\"/g; # escape " + $text =~ s/\r//g; # remove CR (Carriage Return) + $text =~ s/\n/\\n\"\n\"/g; # escape LF (Line Feed). uic also change the code line at a LF, we do not do that. + + if ( $text cmp "" ) + { + print "//i18n: file $file_name line $.\n"; + print "// xgettext: no-c-format\n"; + print q|i18n("|; + print qq|$context","| if $context; # We have a I18N context + print qq|$text");\n|; + } + else + { + #print "// Skipped empty message at $file_name line $.\n"; + # - seems this comment may confuse old custom xgettext of KDE3; not needed anyway + } + + $string =~ s/^.*<\/$text_string//o; + $in_text = 0; + + # Text can be multiline in .ui files (possibly), but we warn about it in XMLGUI .rc files. + + warn "there is <text> floating in: '$file_name'" if $. != $start_line_no and $file_name =~ /\.rc$/i; + } + + close $fh or warn "Failed to close: '$file_name': $!"; + + die "parsing error in $file_name" if $in_text; +} + |