tqt3/bin/tqtfindtr

#!/usr/bin/perl -w

# See TQt I18N documentation for usage information.

use POSIX qw(strftime);

$projectid='PROJECT VERSION';
$datetime = strftime "%Y-%m-%d %X %Z", localtime;
$charset='iso-8859-1';
$translator='FULLNAME <EMAIL@ADDRESS>';
$revision_date='YYYY-MM-DD';

$real_mark = "tr";
$noop_mark = "TQT_TR_NOOP";
$scoped_mark = "qApp->translate";
$noop_scoped_mark = "TQT_TRANSLATE_NOOP";

$header=
'# This is a TQt message file in .po format.  Each msgid starts with
# a scope.  This scope should *NOT* be translated - eg. translating
# from French to English, "Foo::Bar" would be translated to "Pub",
# not "Foo::Pub".
msgid ""
msgstr ""
"Project-Id-Version: '.$projectid.'\n"
"POT-Creation-Date: '.$datetime.'\n"
"PO-Revision-Date: '.$revision_date.'\n"
"Last-Translator: '.$translator.'\n"
"Content-Type: text/plain; charset='.$charset.'\n"

';




$scope = "";

if ( $#ARGV < 0 ) {
    print STDERR "Usage:  tqtfindtr sourcefile ...  >project.po\n";
    exit 1;
}


sub outmsg {
    my ($file, $line, $scope, $msgid) = @_;
    # unesc
    $msgid =~ s/$esc:$esc:$esc/::/gs;
    $msgid =~ s|$esc/$esc/$esc|//|gs;

    # Remove blank lines
    $msgid =~ s/\n\n+/\n/gs;
    $msgid = "\"\"\n$msgid" if $msgid =~ /\n/s;
    print "#: $file:$line\n";
    $msgid =~ s/^"//; #"emacs bug
    print "msgid \"${scope}::$msgid\n";
    #print "msgstr \"$msgid\n";
    print "msgstr \"\"\n";
    print "\n";
}

sub justlines {
    my $l = @_;
    $l =~ tr|\n||dc;
    return $l;
}

print $header;


foreach $file ( @ARGV ) {
    next unless open( I, "< $file" );

    $source = join( "", <I> );

    # Find esc. Avoid bad case 1/// -> 1/1/1/1 -> ///1
    $esc = 1;
    while ( $source =~ m!(?:$esc/$esc/$esc)|(?:$esc///)
	    |(?:$esc:$esc:$esc)|(?:$esc:\:\:)! ) {
	$esc++;
    }

    # Hide quoted :: in practically all strings
    $source =~ s/\"([^"\n]*)::([^"\n]*)\"/\"$1$esc:$esc:$esc$2\"/g;

    # Hide quoted // in practically all strings
    $source =~ s|\"([^"\n]*)//([^"\n]*)\"|\"$1$esc/$esc/$esc$2\"|g;


    # strip comments -- does not handle "/*" in strings
    while( $source =~ s|/\*(.*?)\*/|justlines($1)|ges ) { }
    while( $source =~ s|//(.*?)\n|\n|g ) { }

    while( $source =~ /
	    (?:
		# Some doublequotes are "escaped" to help vim syntax highlight

		# $1 = scope; $2 = parameters etc.
		(?:
		    # Scoped function name ($1 is scope).
		    (\w+)::(?:\w+)
		    \s*
		    # Parameters etc up to open-curly - no semicolons
		    \(([^();]*)\)
		    \s*
		    (?:\{|:)
		)
	      |
		# $3 - one-argument msgid
		(?:\b
		    # One of the marks
		    (?:$real_mark|$noop_mark)
		    \s*
		    # The parameter
		    \(\s*((?:"(?:[^"]|[^\\]\\")*"\s*)+)\)
		)
	      |
		# $4,$5 - two-argument msgid
		(?:\b
		    # One of the scoped marks
		    (?:$scoped_mark|$noop_scoped_mark)
		    \s*
		    # The parameters
		    \(
			# The scope parameter
			\s*"([^\"]*)"
			\s*,\s*
			# The msgid parameter
			\s*((?:\"(?:[^"]|[^\\]\\")*"\s*)+) #"emacs
		    \)
		)
	      |
		# $6,$7 - scoped one-argument msgid
		(?:\b
		    # The scope
		    (\w+)::
		    # One of the marks
		    (?:$real_mark)
		    \s*
		    # The parameter
		    \(\s*((?:"(?:[^"]|[^\\]\\")*"\s*)+)\)
		)
	    )/gsx )
    {
	@lines = split /^/m, "$`";
	$line = @lines;
	if ( defined( $1 ) ) {
	    if ( $scope ne $1 ) {
		$sc=$1;
		$etc=$2;
		# remove strings
		$etc =~ s/"(?:[^"]|[^\\]\\")"//g;
		# count ( and )
		@open = split /\(/m, $etc;
		@close = split /\)/m, $etc;
		if ( $#open == $#close ) {
		    $scope = $sc;
		}
	    }
	    next;
	}

       	if ( defined( $3 ) ) {
	    $this_scope = $scope;
	    $msgid = $3;
	} elsif ( defined( $4 ) ) {
	    $this_scope = $4;
	    $msgid = $5;
	} elsif ( defined( $6 ) ) {
	    $this_scope = $6;
	    $msgid = $7;
	} else {
	    next;
	}

	$msgid =~ s/^\s*//;
	$msgid =~ s/\s*$//;

	# Might still be non-unique eg. tr("A" "B")  vs.  tr("A"  "B").

	$location{"${this_scope}::${msgid}"} = "$file:$line";
    }
}

for $scoped_msgid ( sort keys %location ) {
    ($scope,$msgid) = $scoped_msgid =~ m/([^:]*)::(.*)/s;
    ($file,$line) = $location{$scoped_msgid} =~ m/([^:]*):(.*)/s;
    outmsg($file,$line,$scope,$msgid);
}