From 476e2ce6d7b6716f38db64526df9be028391c5de Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miguel=20=C3=81ngel=20Arruga=20Vivas?=
 <rosen644835@gmail.com>
Date: Tue, 22 Dec 2020 01:24:51 +0100
Subject: [PATCH] xgettext: Implement --rnrs option for Scheme.

* gettext-tools/src/x-scheme.c (hungry_eol_spaces): New variable.
(x_scheme_rnrs, skip_spaces): New functions.
(read_object): Check hungry_eol_spaces and call skip_spaces.
* gettext-tools/src/x-scheme.h (x_scheme_rnrs): New prototype.
* gettext-tools/src/xgettext.c (long_options): Add --rnrs option.
(main): Handle --rnrs option.
* gettext-tools/tests/Makefile.am (TESTS): Add xgettext-scheme-5.
* gettext-tools/tests/xgettext-scheme-5: New test case.
---
 gettext-tools/src/x-scheme.c          | 38 +++++++++++++++++++++
 gettext-tools/src/x-scheme.h          |  1 +
 gettext-tools/src/xgettext.c          |  5 +++
 gettext-tools/tests/Makefile.am       |  2 +-
 gettext-tools/tests/xgettext-scheme-5 | 49 +++++++++++++++++++++++++++
 5 files changed, 94 insertions(+), 1 deletion(-)
 create mode 100644 gettext-tools/tests/xgettext-scheme-5

diff --git a/gettext-tools/src/x-scheme.c b/gettext-tools/src/x-scheme.c
index f879ab026..70d9004ca 100644
--- a/gettext-tools/src/x-scheme.c
+++ b/gettext-tools/src/x-scheme.c
@@ -74,8 +74,24 @@
    - Read macros and dispatch macro character '#'.  Needed to be able to
      tell which is the n-th argument of a function call.
 
+   The flag --rnrs 6 and --rnrs 7 additionally implement the following
+   syntax rules:
+
+   - The leading spaces inside a string after a backslash and a new
+     line are ignored.
  */
 
+/* ========================= Lexer customization.  ========================= */
+
+static bool hungry_eol_spaces = false;
+
+void
+x_scheme_rnrs (const char *version)
+{
+  if (strcmp (version, "6") == 0 || strcmp (version, "7") == 0)
+    hungry_eol_spaces = true;
+}
+
 
 /* ====================== Keyword set customization.  ====================== */
 
@@ -186,6 +202,26 @@ do_ungetc (int c)
   ungetc (c, fp);
 }
 
+static void
+skip_spaces ()
+{
+  int c;
+  for (;;)
+    {
+      c = do_getc ();
+
+      /* Invalid input.  Be tolerant, no error message.  */
+      if (c == EOF)
+        return;
+
+      /* Any other character isn't ignored.  */
+      if (c != ' ' && c != '\t')
+        break;
+    }
+
+  /* Restore last character.  */
+  do_ungetc (c);
+}
 
 /* ========================== Reading of tokens.  ========================== */
 
@@ -1295,6 +1331,8 @@ read_object (struct object *op, flag_context_ty outer_context)
                     switch (c)
                       {
                       case '\n':
+                        if (hungry_eol_spaces)
+                          skip_spaces ();
                         continue;
                       case '0':
                         c = '\0';
diff --git a/gettext-tools/src/x-scheme.h b/gettext-tools/src/x-scheme.h
index cff03ac21..10d0908eb 100644
--- a/gettext-tools/src/x-scheme.h
+++ b/gettext-tools/src/x-scheme.h
@@ -43,6 +43,7 @@ extern void extract_scheme (FILE *fp, const char *real_filename,
 
 /* Handling of options specific to this language.  */
 
+extern void x_scheme_rnrs (const char *version);
 extern void x_scheme_extract_all (void);
 extern void x_scheme_keyword (const char *name);
 
diff --git a/gettext-tools/src/xgettext.c b/gettext-tools/src/xgettext.c
index 1dce01efb..cae1f9001 100644
--- a/gettext-tools/src/xgettext.c
+++ b/gettext-tools/src/xgettext.c
@@ -261,6 +261,7 @@ static const struct option long_options[] =
   { "package-version", required_argument, NULL, CHAR_MAX + 13 },
   { "properties-output", no_argument, NULL, CHAR_MAX + 6 },
   { "qt", no_argument, NULL, CHAR_MAX + 9 },
+  { "rnrs", required_argument, NULL, CHAR_MAX + 21 },
   { "sentence-end", required_argument, NULL, CHAR_MAX + 18 },
   { "sort-by-file", no_argument, NULL, 'F' },
   { "sort-output", no_argument, NULL, 's' },
@@ -673,6 +674,10 @@ main (int argc, char *argv[])
         add_itstool_comments = true;
         break;
 
+      case CHAR_MAX + 21: /* --rnrs */
+        x_scheme_rnrs (optarg);
+        break;
+
       default:
         usage (EXIT_FAILURE);
         /* NOTREACHED */
diff --git a/gettext-tools/tests/Makefile.am b/gettext-tools/tests/Makefile.am
index 5e1377594..321dae854 100644
--- a/gettext-tools/tests/Makefile.am
+++ b/gettext-tools/tests/Makefile.am
@@ -117,7 +117,7 @@ TESTS = gettext-1 gettext-2 \
 	xgettext-python-4 \
 	xgettext-ruby-1 \
 	xgettext-scheme-1 xgettext-scheme-2 xgettext-scheme-3 \
-	xgettext-scheme-4 \
+	xgettext-scheme-4 xgettext-scheme-5 \
 	xgettext-sh-1 xgettext-sh-2 xgettext-sh-3 xgettext-sh-4 xgettext-sh-5 \
 	xgettext-sh-6 xgettext-sh-7 \
 	xgettext-smalltalk-1 xgettext-smalltalk-2 \
diff --git a/gettext-tools/tests/xgettext-scheme-5 b/gettext-tools/tests/xgettext-scheme-5
new file mode 100644
index 000000000..b787d8c3b
--- /dev/null
+++ b/gettext-tools/tests/xgettext-scheme-5
@@ -0,0 +1,49 @@
+#!/bin/sh
+. "${srcdir=.}/init.sh"; path_prepend_ . ../src
+
+# Test RnRS Scheme support.
+
+# This string contains a TAB character to ensure it is properly
+# handled.
+cat <<EOF > xg-sc-5.scm
+(gettext "String \\
+          indented without \\
+	  extra spaces")
+EOF
+
+: ${XGETTEXT=xgettext}
+# R5RS is the default mode.
+${XGETTEXT} --omit-header --no-location \
+  -d xg-sc-5r5.tmp xg-sc-5.scm || Exit 1
+LC_ALL=C tr -d '\r' < xg-sc-5r5.tmp.po > xg-sc-5r5.po || Exit 1
+
+cat <<EOF > xg-sc-5r5.ok
+msgid "String           indented without \\t  extra spaces"
+msgstr ""
+EOF
+
+: ${DIFF=diff}
+${DIFF} xg-sc-5r5.ok xg-sc-5r5.po || Exit 1
+
+# R6RS already implements string indentation.
+${XGETTEXT} --omit-header --no-location --rnrs 6 \
+  -d xg-sc-5r6.tmp xg-sc-5.scm || Exit 1
+LC_ALL=C tr -d '\r' < xg-sc-5r6.tmp.po > xg-sc-5r6.po || Exit 1
+
+cat <<EOF > xg-sc-5r6.ok
+msgid "String indented without extra spaces"
+msgstr ""
+EOF
+
+: ${DIFF=diff}
+${DIFF} xg-sc-5r6.ok xg-sc-5r6.po || Exit 1
+
+# R7RS produces the same output as R6RS.
+${XGETTEXT} --omit-header --no-location --rnrs 7 \
+  -d xg-sc-5r7.tmp xg-sc-5.scm || Exit 1
+LC_ALL=C tr -d '\r' < xg-sc-5r7.tmp.po > xg-sc-5r7.po || Exit 1
+
+${DIFF} xg-sc-5r6.ok xg-sc-5r7.po
+result=$?
+
+Exit $result
-- 
2.29.2

