Use xgettext built-in scheme support for .scm files and add support to `intltool-update -m` for detecting missing .scm files. Fixes #790574.

7 files changed, 42 insertions, 98 deletions

diff --git a/intltool-extract.in b/intltool-extract.in
index 15cd622..1645fac 100644
--- a/intltool-extract.in
+++ b/intltool-extract.in
@@ -164,11 +164,11 @@ XML files. Read manpage (man ${PROGRAM}) for more info.
       --type=TYPE   Specify the file type of FILENAME. Currently supports:
                     "gettext/glade", "gettext/ini", "gettext/keys"
                     "gettext/rfc822deb", "gettext/schemas",
-                    "gettext/scheme", "gettext/xml", "gettext/quoted",
-                    "gettext/quotedxml", "gettext/tlk"
+                    "gettext/xml", "gettext/quoted", "gettext/quotedxml",
+                    "gettext/tlk"
   -l, --local       Writes output into current working directory
                     (conflicts with --update)
-      --update      Writes output into the same directory the source file 
+      --update      Writes output into the same directory the source file
                     reside (conflicts with --local)
       --srcdir      Root of the source tree
   -v, --version     Output version information and exit
@@ -219,7 +219,6 @@ sub convert {
     &type_keys if $gettext_type eq "keys";
     &type_xml if $gettext_type eq "xml";
     &type_glade if $gettext_type eq "glade";
-    &type_scheme if $gettext_type eq "scheme";
     &type_schemas  if $gettext_type eq "schemas";
     &type_rfc822deb  if $gettext_type eq "rfc822deb";
     &type_quoted if $gettext_type eq "quoted";
@@ -798,51 +797,6 @@ sub type_glade {
     }
 }
 
-sub type_scheme {
-    my ($line, $i, $state, $str, $trcomment, $char);
-    for $line (split(/\n/, $input)) {
-        $i = 0;
-        $state = 0; # 0 - nothing, 1 - string, 2 - translatable string
-        while ($i < length($line)) {
-            if (substr($line,$i,1) eq "\"") {
-                if ($state == 2) {
-                    $comments{$str} = $trcomment if ($trcomment);
-                    add_message($str);
-                    $str = '';
-                    $state = 0; $trcomment = "";
-                } elsif ($state == 1) {
-                    $str = '';
-                    $state = 0; $trcomment = "";
-                } else {
-                    $state = 1;
-                    $str = '';
-                    if ($i>0 && substr($line,$i-1,1) eq '_') {
-                        $state = 2;
-                    }
-                }
-            } elsif (!$state) {
-                if (substr($line,$i,1) eq ";") {
-                    $trcomment = substr($line,$i+1);
-                    $trcomment =~ s/^;*\s*//;
-                    $i = length($line);
-                } elsif ($trcomment && substr($line,$i,1) !~ /\s|\(|\)|_/) {
-                    $trcomment = "";
-                }
-            } else {
-                if (substr($line,$i,1) eq "\\") {
-                    $char = substr($line,$i+1,1);
-                    if ($char ne "\"" && $char ne "\\") {
-                       $str = $str . "\\";
-                    }
-                    $i++;
-                }
-                $str = $str . substr($line,$i,1);
-            }
-            $i++;
-        }
-    }
-}
-
 sub type_tlk {
     my ($ftype, $fvers, $langid, $strcount, $stroff);
     my $count = 0;
@@ -861,7 +815,7 @@ sub type_tlk {
                       $inputa[18] . $inputa[19]);
 
     use bytes;
-    $strdata = bytes::substr ($input, $stroff); 
+    $strdata = bytes::substr ($input, $stroff);
 
     my $sinpos = 20;
 
diff --git a/intltool-update.in b/intltool-update.in
index 5b3bf42..58add1d 100644
--- a/intltool-update.in
+++ b/intltool-update.in
@@ -64,7 +64,6 @@ my $xml_support =
 "ui|".			# Bonobo specific - User Interface desc. files
 "lang|".		# ?
 "glade2?(?:\\.in)*|".	# Glade specific - User Interface desc. files (Note: .in is not required)
-"scm(?:\\.in)*|".	# ? (Note: .in is not required)
 "oaf(?:\\.in)+|".	# DEPRECATED: Replaces by Bonobo .server files
 "etspec|".		# ?
 "server(?:\\.in)+|".	# Bonobo specific
@@ -88,7 +87,7 @@ my $tlk_support =
 "tlk(?:\\.in)+";        # Bioware Aurora Talk Table Format
 
 my $buildin_gettext_support =
-"c|y|cs|cc|cpp|c\\+\\+|h|hh|gob|py(?:\\.in)*";
+"c|y|cs|cc|cpp|c\\+\\+|h|hh|gob|py|scm(?:\\.in)*";
 
 ## Always flush buffer when printing
 $| = 1;
@@ -451,10 +450,21 @@ sub FindLeftoutFiles
 	my $in_comment = 0;
 	my $in_macro = 0;
         my $in_string = 0;
+        my @multiline_quotes;
+        if ($file =~ /\.scm/) {
+            @multiline_quotes = ('"');
+        } else {
+            @multiline_quotes = ("'''", '"""');
+        }
 
 	open FILE, "<$file";
 	while (<FILE>)
 	{
+            if ($file =~ /\.scm/) {
+                # Strip single quotes from .scm files.
+                s-\'--g;
+            }
+
 	    # Handle continued multi-line comment.
 	    if ($in_comment)
 	    {
@@ -465,7 +475,11 @@ sub FindLeftoutFiles
             # Handle continued multi-line string.
             if ($in_string)
             {
-                next unless s/.*(\'\'\'|\"\"\")//;
+                my $pattern = join '|', @multiline_quotes;
+                if (!s/.*$pattern//) {
+                    s///s;
+                    next;
+                };
                 $in_string = 0;
             }
 
@@ -499,11 +513,11 @@ sub FindLeftoutFiles
 		{
 		    s-//.*--;
 		}
-                elsif ($match eq "\"\"\"" or $match eq "\'\'\'")
+                elsif (grep($match, @multiline_quotes))
                 {
-                    if (!s-$match.*?$match--)
+                    if (!s-$match(\\$match|[^$match])*$match-QUOTEDTEXT-g)
                     {
-                        s-$match.*--;
+                        s-$match.*-QUOTEDTEXT-s;
                         $in_string = 1;
                     }
                 }
@@ -529,7 +543,7 @@ sub FindLeftoutFiles
 	    }
 
             ## C_ N_ NC_ Q_ and _ are the macros defined in gi8n.h
-	    if (/(NC_|[NCQ]_|[^_]_|(^|$)[_]) *\(QUOTEDTEXT/m)
+	    if (/(NC_|[NCQ]_|[^_]_|(^|$)[_]) *\(?QUOTEDTEXT/m)
 	    {
                 AddFileToListIfMissing($file, \@buf_allfiles);
 		last;
diff --git a/tests/cases/Makefile.am b/tests/cases/Makefile.am
index 0690621..8636eac 100644
--- a/tests/cases/Makefile.am
+++ b/tests/cases/Makefile.am
@@ -41,7 +41,6 @@ EXTRA_DIST =					\
 	test-quoted.po				\
 	test.po 				\
 	test.schemas.in				\
-	test.scm				\
 	unicodetext.xml.in			\
 	$(NULL)
 
@@ -69,7 +68,6 @@ CLEANFILES =					\
 	test-quoted.dtd.h			\
 	test.schemas				\
 	test.schemas.in.h			\
-	test.scm.h				\
 	unicodetext.xml.in.h			\
 	extract1.desktop.in			\
 	extract3.xml.in.h			\
diff --git a/tests/cases/test.scm b/tests/cases/test.scm
deleted file mode 100644
index 9467009..0000000
--- a/tests/cases/test.scm
+++ /dev/null
@@ -1,16 +0,0 @@
-;; regular comment
-
-("some " "basic" "strings") ; silly comment
-(_"translatable string")
-
-;; _"this"
-
-;; nasty comment _"
-("nasty string; haha" ; this is a fine comment for translators
-   _"nice string; thanks") ; all well
-
-(_"multiple" _"translations; per line")
-
-"not for_" _"translation" ; so "what?
-
-_"another \" string" "so \"what" _"here"
diff --git a/tests/results/Makefile.am b/tests/results/Makefile.am
index ff9d8da..40a2e69 100644
--- a/tests/results/Makefile.am
+++ b/tests/results/Makefile.am
@@ -37,6 +37,5 @@ EXTRA_DIST =					\
 	test-quoted.dtd.h			\
 	test.schemas				\
 	test.schemas.in.h			\
-	test.scm.h				\
 	unicodetext.xml.in.h			\
 	$(NULL)
diff --git a/tests/results/test.scm.h b/tests/results/test.scm.h.THIS
index e514380..e514380 100644
--- a/tests/results/test.scm.h
+++ b/tests/results/test.scm.h.THIS
diff --git a/tests/selftest.pl.in b/tests/selftest.pl.in
index 5988694..b016a18 100755
--- a/tests/selftest.pl.in
+++ b/tests/selftest.pl.in
@@ -197,94 +197,89 @@ $case = "extract-comments.xml";
 system("$INTLTOOL_EXTRACT --type=gettext/xml --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);
 
-print "21. Extract messages from Scheme file:                               ";
-$case = "test.scm";
-system("$INTLTOOL_EXTRACT --type=gettext/scheme --quiet --update cases/$case") == 0 or $failed = 1;
-check_extract_result($case);
-
-print "22. Merge into file with CDATA sections:                             ";
+print "21. Merge into file with CDATA sections:                             ";
 $case = "merge-cdata.xml";
 system("$INTLTOOL_MERGE -x --quiet cases cases/$case.in cases/$case") == 0 or $failed = 1;
 check_merge_result($case);
 
-print "23. Merge into XML file with deep translation/attribute nesting:     ";
+print "22. Merge into XML file with deep translation/attribute nesting:     ";
 $case = "merge-deepattr.xml";
 system("$INTLTOOL_MERGE -x --quiet cases cases/$case.in cases/$case") == 0 or $failed = 1;
 check_merge_result($case);
 
-print "24. Ignore empty strings from XML file                               ";
+print "23. Ignore empty strings from XML file                               ";
 $case = "extract12.xml.in";
 system("$INTLTOOL_EXTRACT --type=gettext/xml --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);
 
-print "25. Extract messages from a xml file using inherited xml:space:      ";
+print "24. Extract messages from a xml file using inherited xml:space:      ";
 $case = "space-preserve.xml.in";
 system("$INTLTOOL_EXTRACT --type=gettext/xml --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);
 
-print "26. Merge messages into xml file using inherited xml:space:          ";
+print "25. Merge messages into xml file using inherited xml:space:          ";
 $case = "space-preserve.xml";
 system("$INTLTOOL_MERGE -x --quiet cases cases/$case.in cases/$case") == 0 or $failed = 1;
 check_merge_result($case);
 
-print "27. Merge non-well-formed translations into xml file:                ";
+print "26. Merge non-well-formed translations into xml file:                ";
 $case = "merge11.xml";
 system("$INTLTOOL_MERGE -x --quiet cases cases/$case.in cases/$case") == 0 or $failed = 1;
 check_merge_result($case);
  
-print "28. Extract UTF-8 encoded messages/comments from xml file:           ";
+print "27. Extract UTF-8 encoded messages/comments from xml file:           ";
 $case = "unicodetext.xml.in";
 system("$INTLTOOL_EXTRACT --type=gettext/xml --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);
 
-print "29. Extract iso-8859-1 encoded messages/comments from xml file:      ";
+print "28. Extract iso-8859-1 encoded messages/comments from xml file:      ";
 $case = "iso88591text.xml.in";
 system("$INTLTOOL_EXTRACT --type=gettext/xml --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);
 
-print "30. Extract messages from a quoted style file:                       ";
+print "29. Extract messages from a quoted style file:                       ";
 $case = "test-quoted.dtd";
 system("$INTLTOOL_EXTRACT --type=gettext/quoted --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);
 
-print "31. Merge translations into multiple quoted style files:             ";
+print "30. Merge translations into multiple quoted style files:             ";
 $case = "test-quoted.dtd";
 system("$INTLTOOL_MERGE --quoted-style --quiet --multiple-output cases cases/$case $case") == 0 or $failed = 1;
 check_multimerge_result($case, "test-quoted");
 
-print "32. Extract comments for translators from a .desktop.in file:        ";
+print "31. Extract comments for translators from a .desktop.in file:        ";
 $case = "extract13.desktop.in";
 system("$INTLTOOL_EXTRACT --type=gettext/ini --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);
 
-print "33. Merge translations from a .desktop.in file:                      ";
+print "32. Merge translations from a .desktop.in file:                      ";
 $case = "extract13.desktop.in";
 $result = $case;
 ($result = $case) =~ s/\.in//;
 system("$INTLTOOL_MERGE -d --quiet cases cases/$case cases/$result") == 0 or $failed = 1;
 check_merge_result($case);
 
-print "34. Decode XML entities in the right order when extracting:          ";
+print "33. Decode XML entities in the right order when extracting:          ";
 $case = "extract14.xml.in";
 system("$INTLTOOL_EXTRACT --type=gettext/xml --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);
 
-print "35. Merge XML translations, decoding entities in the right order:    ";
+print "34. Merge XML translations, decoding entities in the right order:    ";
 $case = "merge12.xml";
 system("$INTLTOOL_MERGE -x --quiet cases cases/$case.in cases/$case") == 0 or $failed = 1;
 check_merge_result($case);
 
-print "36. Extract messages from an XML file with msgctxts:                 ";
+print "35. Extract messages from an XML file with msgctxts:                 ";
 $case = "context.xml.in";
 system("$INTLTOOL_EXTRACT --type=gettext/xml --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);
 
-print "37. Merge translations into an XML file with msgctxts:               ";
+print "36. Merge translations into an XML file with msgctxts:               ";
 $case = "context.xml";
 system("$INTLTOOL_MERGE -x --quiet cases cases/$case.in cases/$case") == 0 or $failed = 1;
 check_merge_result($case);
 
-print "38. Extract messages from an GtkBuilder XML file with msgctxts:      ";
+print "37. Extract messages from an GtkBuilder XML file with msgctxts:      ";
 $case = "extract-gtkbuilder.ui";
 system("$INTLTOOL_EXTRACT --type=gettext/glade --quiet --update cases/$case") == 0 or $failed = 1;
 check_extract_result($case);