scheme: Recognize GIMP script-fu extension _"abc"

* gettext-tools/src/x-scheme.c (read_object): Recognize _"abc".

7 files changed, 91 insertions, 2 deletions

diff --git a/gettext-tools/doc/ChangeLog b/gettext-tools/doc/ChangeLog
index f12e3dc..5986b05 100644
--- a/gettext-tools/doc/ChangeLog
+++ b/gettext-tools/doc/ChangeLog
@@ -1,3 +1,7 @@
+2014-04-30  Daiki Ueno  <ueno@gnu.org>
+
+	* gettext.texi (Scheme): Document gettext shorthand form _"abc".
+
 2014-04-22  Daiki Ueno  <ueno@gnu.org>
 
 	build: Use git-version-gen intead of version.sh
diff --git a/gettext-tools/doc/gettext.texi b/gettext-tools/doc/gettext.texi
index 9e2ac39..a35b7ac 100644
--- a/gettext-tools/doc/gettext.texi
+++ b/gettext-tools/doc/gettext.texi
@@ -10034,7 +10034,7 @@ guile
 @code{"abc"}
 
 @item gettext shorthand
-@code{(_ "abc")}
+@code{(_ "abc")}, @code{_"abc"}
 
 @item gettext/ngettext functions
 @code{gettext}, @code{ngettext}
diff --git a/gettext-tools/src/ChangeLog b/gettext-tools/src/ChangeLog
index 98a425f..c7c953f 100644
--- a/gettext-tools/src/ChangeLog
+++ b/gettext-tools/src/ChangeLog
@@ -1,5 +1,10 @@
 2014-04-30  Daiki Ueno  <ueno@gnu.org>
 
+	scheme: Recognize GIMP script-fu extension _"abc"
+	* x-scheme.c (read_object): Recognize _"abc".
+
+2014-04-30  Daiki Ueno  <ueno@gnu.org>
+
 	format-python-brace: Limit acceptable format specifiers
 	Problem reported by Kovid Goyal at:
 	<https://savannah.gnu.org/bugs/?41668>.
diff --git a/gettext-tools/src/x-scheme.c b/gettext-tools/src/x-scheme.c
index 1ddcb2d..361156a 100644
--- a/gettext-tools/src/x-scheme.c
+++ b/gettext-tools/src/x-scheme.c
@@ -682,6 +682,7 @@ read_object (struct object *op, flag_context_ty outer_context)
   for (;;)
     {
       int c = do_getc ();
+      bool seen_underscore_prefix = false;
 
       switch (c)
         {
@@ -1167,6 +1168,33 @@ read_object (struct object *op, flag_context_ty outer_context)
             abort ();
           }
 
+        case '_':
+          /* GIMP script-fu extension: '_' before a string literal is
+             considered a gettext call on the string.  */
+          {
+            int c = do_getc ();
+            if (c == EOF)
+              /* Invalid input.  Be tolerant, no error message.  */
+              {
+                op->type = t_other;
+                return;
+              }
+            if (c != '"')
+              {
+                do_ungetc (c);
+
+                /* If '_' is not followed by a string literal,
+                   consider it a part of symbol.  */
+                op->token = XMALLOC (struct token);
+                read_token (op->token, '_');
+                op->type = t_symbol;
+                last_non_comment_line = line_number;
+                return;
+              }
+            seen_underscore_prefix = true;
+          }
+          /*FALLTHROUGH*/
+
         case '"':
           {
             op->token = XMALLOC (struct token);
@@ -1220,7 +1248,7 @@ read_object (struct object *op, flag_context_ty outer_context)
               }
             op->type = t_string;
 
-            if (extract_all)
+            if (seen_underscore_prefix || extract_all)
               {
                 lex_pos_ty pos;
 
diff --git a/gettext-tools/tests/ChangeLog b/gettext-tools/tests/ChangeLog
index a82a570..740bf5a 100644
--- a/gettext-tools/tests/ChangeLog
+++ b/gettext-tools/tests/ChangeLog
@@ -1,5 +1,10 @@
 2014-04-30  Daiki Ueno  <ueno@gnu.org>
 
+	* xgettext-scheme-4: New file.
+	* Makefile.am (TESTS): Add new test.
+
+2014-04-30  Daiki Ueno  <ueno@gnu.org>
+
 	format-python-brace: Limit acceptable format specifiers
 	* format-python-brace-1: Add tests for standard format specifiers.
 
diff --git a/gettext-tools/tests/Makefile.am b/gettext-tools/tests/Makefile.am
index 490c2c8..e6ef6b8 100644
--- a/gettext-tools/tests/Makefile.am
+++ b/gettext-tools/tests/Makefile.am
@@ -95,6 +95,7 @@ TESTS = gettext-1 gettext-2 gettext-3 gettext-4 gettext-5 gettext-6 gettext-7 \
 	xgettext-python-1 xgettext-python-2 xgettext-python-3 \
 	xgettext-python-4 \
 	xgettext-scheme-1 xgettext-scheme-2 xgettext-scheme-3 \
+	xgettext-scheme-4 \
 	xgettext-sh-1 xgettext-sh-2 xgettext-sh-3 xgettext-sh-4 xgettext-sh-5 \
 	xgettext-sh-6 \
 	xgettext-smalltalk-1 xgettext-smalltalk-2 \
diff --git a/gettext-tools/tests/xgettext-scheme-4 b/gettext-tools/tests/xgettext-scheme-4
new file mode 100644
index 0000000..3566d6b
--- /dev/null
+++ b/gettext-tools/tests/xgettext-scheme-4
@@ -0,0 +1,46 @@
+#!/bin/sh
+. "${srcdir=.}/init.sh"; path_prepend_ . ../src
+
+# Test Scheme support: GIMP script-fu extension _"..."
+
+cat <<EOF > xg-sc-4.scm
+(script-fu-register "script-fu-paste-as-brush"
+  _"New _Brush..."
+  _"Paste the clipboard contents into a new brush"
+  "Michael Natterer <mitch@gimp.org>"
+  "Michael Natterer"
+  "2005-09-25"
+  ""
+  SF-STRING     _"Brush name" "My Brush"
+  SF-STRING     _"File name"  "mybrush"
+  SF-ADJUSTMENT _"Spacing"    '(25 0 1000 1 1 1 0)
+)
+EOF
+
+: ${XGETTEXT=xgettext}
+${XGETTEXT} -k_ --omit-header --no-location --add-comments=TRANSLATORS: \
+  -d xg-sc-4.tmp xg-sc-4.scm || exit 1
+LC_ALL=C tr -d '\r' < xg-sc-4.tmp.po > xg-sc-4.po || exit 1
+
+cat <<EOF > xg-sc-4.ok
+msgid "New _Brush..."
+msgstr ""
+
+msgid "Paste the clipboard contents into a new brush"
+msgstr ""
+
+msgid "Brush name"
+msgstr ""
+
+msgid "File name"
+msgstr ""
+
+msgid "Spacing"
+msgstr ""
+EOF
+
+: ${DIFF=diff}
+${DIFF} xg-sc-4.ok xg-sc-4.po
+result=$?
+
+exit $result