Improve handling of non-BMP characters with Tcl 9.0.

* gettext-tools/src/write-tcl.c (hexdigit): New variable.
(write_tcl8_string): Renamed from write_tcl_string. Enable the escaping of
braces.
(write_tcl9_string, is_entirely_ucs2, write_tcl_string): New functions.
* gettext-tools/tests/msgfmt-tcl-1: New file.
* gettext-tools/tests/testdata/tcltest_pl.po: New file.
* gettext-tools/tests/testdata/tcltest_pl.msg: New file.
* gettext-tools/tests/msgfmt-tcl-2: New file.
* gettext-tools/tests/testdata/tcltest_cs.po: New file.
* gettext-tools/tests/testdata/tcltest_cs.msg: New file.
* gettext-tools/tests/Makefile.am (TESTS): Add msgfmt-tcl-1, msgfmt-tcl-2.
(EXTRA_DIST): Add the new testdata files.
* NEWS: Mention the change.

diff --git a/NEWS b/NEWS
index e230c831fe7b86bed26781f55a0d6002e1857634..ccd390ce6a6526ea620f691c99a9a0c1df043db4 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -7,6 +7,9 @@ Version 0.23 - August 2024
   - Vala: Improved recognition of format strings when the string.printf method
     is used.
   - Glade: xgettext has improved support for GtkBuilder 4.
+  - Tcl: With the forthcoming Tcl 9.0, characters outside the Unicode BMP
+    in Tcl message catalogs (.msg files) will work regardless of the locale's
+    encoding.
 
 * Runtime behaviour:
   - In the C.UTF-8 locale, like in the C locale, the *gettext() functions

diff --git a/gettext-tools/src/write-tcl.c b/gettext-tools/src/write-tcl.c
index 581317976b7d02b17aa5f1b7174cd915d0a14a97..fd4c29aaefbd7bf0e3ebaa2881def1ae1cbbd1d2 100644 (file)
--- a/gettext-tools/src/write-tcl.c
+++ b/gettext-tools/src/write-tcl.c
@@ -46,16 +46,17 @@
 #define _(str) gettext (str)
 
 
-/* Write a string in Tcl Unicode notation to the given stream.
+static const char hexdigit[] = "0123456789abcdef";
+
+/* Write a string in Tcl 8 Unicode notation to the given stream.
    Tcl 8 uses Unicode for its internal string representation.
    In tcl-8.3.3, the .msg files are read in using the locale dependent
    encoding.  The only way to specify strings in an encoding independent
    form is the \unnnn notation.  Newer tcl versions have this fixed:
    they read the .msg files in UTF-8 encoding.  */
 static void
-write_tcl_string (FILE *stream, const char *str)
+write_tcl8_string (FILE *stream, const char *str)
 {
-  static const char hexdigit[] = "0123456789abcdef";
   const char *str_limit = str + strlen (str);
 
   fprintf (stream, "\"");
@@ -81,14 +82,12 @@ write_tcl_string (FILE *stream, const char *str)
             fprintf (stream, "\\\\");
           else if (uc == 0x005d)
             fprintf (stream, "\\]");
-          /* No need to escape '{' and '}' because we don't have opening
-             braces outside the strings.  */
-#if 0
+          /* Need to escape '{' and '}' because we have opening braces
+             outside the strings.  */
           else if (uc == 0x007b)
             fprintf (stream, "\\{");
           else if (uc == 0x007d)
             fprintf (stream, "\\}");
-#endif
           else if (uc >= 0x0020 && uc < 0x007f)
             fprintf (stream, "%c", (int) uc);
           else
@@ -109,6 +108,104 @@ write_tcl_string (FILE *stream, const char *str)
 }
 
 
+/* Write a string in Tcl 9 Unicode notation to the given stream.
+   Tcl 9 uses Unicode for its internal string representation,
+   but unlike Tcl 8, requires \Uxxxxxxxx syntax instead of \uxxxx\uyyyy
+   syntax (understood by Tcl 8.6) for characters outside the BMP.  */
+static void
+write_tcl9_string (FILE *stream, const char *str)
+{
+  const char *str_limit = str + strlen (str);
+
+  fprintf (stream, "\"");
+  while (str < str_limit)
+    {
+      ucs4_t uc;
+      unsigned int count;
+      count = u8_mbtouc (&uc, (const unsigned char *) str, str_limit - str);
+      if (uc < 0x10000)
+        {
+          /* Single UCS-2 'char'.  */
+          if (uc == 0x000a)
+            fprintf (stream, "\\n");
+          else if (uc == 0x000d)
+            fprintf (stream, "\\r");
+          else if (uc == 0x0022)
+            fprintf (stream, "\\\"");
+          else if (uc == 0x0024)
+            fprintf (stream, "\\$");
+          else if (uc == 0x005b)
+            fprintf (stream, "\\[");
+          else if (uc == 0x005c)
+            fprintf (stream, "\\\\");
+          else if (uc == 0x005d)
+            fprintf (stream, "\\]");
+          /* Need to escape '{' and '}' because we have opening braces
+             outside the strings.  */
+          else if (uc == 0x007b)
+            fprintf (stream, "\\{");
+          else if (uc == 0x007d)
+            fprintf (stream, "\\}");
+          else if (uc >= 0x0020 && uc < 0x007f)
+            fprintf (stream, "%c", (int) uc);
+          else
+            fprintf (stream, "\\u%c%c%c%c",
+                     hexdigit[(uc >> 12) & 0x0f], hexdigit[(uc >> 8) & 0x0f],
+                     hexdigit[(uc >> 4) & 0x0f], hexdigit[uc & 0x0f]);
+        }
+      else
+        fprintf (stream, "\\U%c%c%c%c%c%c%c%c",
+                 hexdigit[(uc >> 28) & 0x0f], hexdigit[(uc >> 24) & 0x0f],
+                 hexdigit[(uc >> 20) & 0x0f], hexdigit[(uc >> 16) & 0x0f],
+                 hexdigit[(uc >> 12) & 0x0f], hexdigit[(uc >> 8) & 0x0f],
+                 hexdigit[(uc >> 4) & 0x0f], hexdigit[uc & 0x0f]);
+      str += count;
+    }
+  fprintf (stream, "\"");
+}
+
+
+/* Determine whether a string has no characters outside the Unicode BMP.  */
+static bool
+is_entirely_ucs2 (const char *str)
+{
+  const char *str_limit = str + strlen (str);
+  while (str < str_limit)
+    {
+      ucs4_t uc;
+      unsigned int count;
+      count = u8_mbtouc (&uc, (const unsigned char *) str, str_limit - str);
+      if (uc >= 0x10000)
+        return false;
+      str += count;
+    }
+  return true;
+}
+
+
+/* Write a string either as a Tcl string literal or as a Tcl expression.  */
+static void
+write_tcl_string (FILE *stream, const char *str)
+{
+  if (is_entirely_ucs2 (str))
+    /* write_tcl8_string and write_tcl9_string produce the same external
+       representation for this string.  */
+    write_tcl8_string (stream, str);
+  else
+    {
+      /* Use this syntax:
+         [expr { $tcl_version < 9 ? "😃" : "\U0001F603" }]
+         So that we don't need to assume an UTF-8 locale in Tcl >= 9.0.
+         Cf. <https://core.tcl-lang.org/tcl/tktview/d10d6ddf295864389294b966163a23a58b9a1e72>  */
+      fprintf (stream, "[expr { $tcl_version < 9 ? ");
+      write_tcl8_string (stream, str);
+      fprintf (stream, " : ");
+      write_tcl9_string (stream, str);
+      fprintf (stream, " }]");
+    }
+}
+
+
 static void
 write_msg (FILE *output_file, message_list_ty *mlp, const char *locale_name)
 {

diff --git a/gettext-tools/tests/Makefile.am b/gettext-tools/tests/Makefile.am
index 019c6dd7bbf1b2cd46b676d14d48ae8ed53a1303..cd06a0d6ebf5c1f123fcb6bd4bdc1b946297e871 100644 (file)
--- a/gettext-tools/tests/Makefile.am
+++ b/gettext-tools/tests/Makefile.am
@@ -54,6 +54,7 @@ TESTS = gettext-1 gettext-2 \
        msgfmt-8 msgfmt-9 msgfmt-10 msgfmt-11 msgfmt-12 msgfmt-13 msgfmt-14 \
        msgfmt-15 msgfmt-16 msgfmt-17 msgfmt-18 msgfmt-19 msgfmt-20 \
        msgfmt-properties-1 \
+       msgfmt-tcl-1 msgfmt-tcl-2 \
        msgfmt-qt-1 msgfmt-qt-2 \
        msgfmt-desktop-1 msgfmt-desktop-2 msgfmt-desktop-3 \
        msgfmt-xml-1 msgfmt-xml-2 \
@@ -252,6 +253,8 @@ EXTRA_DIST += init.sh init.cfg $(TESTS) \
        xgettext-1 \
        xgettext-c-1 xg-c-comment-6.c xg-c-escape-3.c xg-vala-2.vala \
        common/supplemental/plurals.xml \
+       testdata/tcltest_pl.po testdata/tcltest_pl.msg \
+       testdata/tcltest_cs.po testdata/tcltest_cs.msg \
        testdata/xg-el-so-3.el testdata/xg-el-so-4.el \
        testdata/xg-pl-so-5.pl \
        testdata/xg-po-3.po testdata/xg-po-4.po

diff --git a/gettext-tools/tests/msgfmt-tcl-1 b/gettext-tools/tests/msgfmt-tcl-1
new file mode 100755 (executable)
index 0000000..4734301
--- /dev/null
+++ b/gettext-tools/tests/msgfmt-tcl-1
@@ -0,0 +1,13 @@
+#! /bin/sh
+. "${srcdir=.}/init.sh"; path_prepend_ . ../src
+
+# Test output in Tcl .msg format.
+
+: ${MSGFMT=msgfmt}
+${MSGFMT} --tcl -l pl -d . "$wabs_srcdir"/testdata/tcltest_pl.po || Exit 1
+
+: ${DIFF=diff}
+${DIFF} "$abs_srcdir"/testdata/tcltest_pl.msg pl.msg
+result=$?
+
+exit $result

diff --git a/gettext-tools/tests/msgfmt-tcl-2 b/gettext-tools/tests/msgfmt-tcl-2
new file mode 100755 (executable)
index 0000000..ef6f454
--- /dev/null
+++ b/gettext-tools/tests/msgfmt-tcl-2
@@ -0,0 +1,13 @@
+#! /bin/sh
+. "${srcdir=.}/init.sh"; path_prepend_ . ../src
+
+# Test output in Tcl .msg format with characters outside the BMP.
+
+: ${MSGFMT=msgfmt}
+${MSGFMT} --tcl -l cs -d . "$wabs_srcdir"/testdata/tcltest_cs.po || Exit 1
+
+: ${DIFF=diff}
+${DIFF} "$abs_srcdir"/testdata/tcltest_cs.msg cs.msg
+result=$?
+
+exit $result

diff --git a/gettext-tools/tests/testdata/tcltest_cs.msg b/gettext-tools/tests/testdata/tcltest_cs.msg
new file mode 100644 (file)
index 0000000..a2a27a2
--- /dev/null
+++ b/gettext-tools/tests/testdata/tcltest_cs.msg
@@ -0,0 +1,2 @@
+set ::msgcat::header "Project-Id-Version: hello-tcl 0\nReport-Msgid-Bugs-To: bug-gnu-gettext@gnu.org\nPO-Revision-Date: 2003-10-20 10:13+0200\nLast-Translator: Marek \u010cernock\u00fd <marek@manet.cz>\nLanguage-Team: Czech <cs@li.org>\nMIME-Version: 1.0\nContent-Type: text/plain; charset=UTF-8\nContent-Transfer-Encoding: 8bit\nPlural-Forms: nplurals=3; plural=(n==1) ? 0 : (n>=2 && n<=4) ? 1 : 2;\n"
+::msgcat::mcset cs "Hello, world!" [expr { $tcl_version < 9 ? "Ahoj sv\u011bte 😃!" : "Ahoj sv\u011bte \U0001f603!" }]

diff --git a/gettext-tools/tests/testdata/tcltest_cs.po b/gettext-tools/tests/testdata/tcltest_cs.po
new file mode 100644 (file)
index 0000000..8b09ff7
--- /dev/null
+++ b/gettext-tools/tests/testdata/tcltest_cs.po
@@ -0,0 +1,21 @@
+# Polish translations for hello-tcl package.
+# Copyright (C) 2003-2011 Yoyodyne, Inc.
+# This file is distributed under the same license as the hello-tcl package.
+# Marek Černocký <marek@manet.cz>, 2011.
+#
+msgid ""
+msgstr ""
+"Project-Id-Version: hello-tcl 0\n"
+"Report-Msgid-Bugs-To: bug-gnu-gettext@gnu.org\n"
+"POT-Creation-Date: 2003-10-20 10:14+0200\n"
+"PO-Revision-Date: 2003-10-20 10:13+0200\n"
+"Last-Translator: Marek Černocký <marek@manet.cz>\n"
+"Language-Team: Czech <cs@li.org>\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"Plural-Forms: nplurals=3; plural=(n==1) ? 0 : (n>=2 && n<=4) ? 1 : 2;\n"
+
+#: hello.tcl:11
+msgid "Hello, world!"
+msgstr "Ahoj světe 😃!"

diff --git a/gettext-tools/tests/testdata/tcltest_pl.msg b/gettext-tools/tests/testdata/tcltest_pl.msg
new file mode 100644 (file)
index 0000000..269894e
--- /dev/null
+++ b/gettext-tools/tests/testdata/tcltest_pl.msg
@@ -0,0 +1,3 @@
+set ::msgcat::header "Project-Id-Version: hello-tcl 0\nReport-Msgid-Bugs-To: bug-gnu-gettext@gnu.org\nPO-Revision-Date: 2003-10-20 10:13+0200\nLast-Translator: Bruno Haible <bruno@clisp.org>\nLanguage-Team: Polish <pl@li.org>\nMIME-Version: 1.0\nContent-Type: text/plain; charset=UTF-8\nContent-Transfer-Encoding: 8bit\nPlural-Forms: nplurals=3; plural=(n==1 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 || n%100>=20) ? 1 : 2);\n"
+::msgcat::mcset pl "Written by Fran\u00e7ois Pinard." "Program napisa\u0142 Fran\u00e7ois Pinard."
+::msgcat::mcset pl "error %1." "b\u0142\u0105d %1."

diff --git a/gettext-tools/tests/testdata/tcltest_pl.po b/gettext-tools/tests/testdata/tcltest_pl.po
new file mode 100644 (file)
index 0000000..94bb725
--- /dev/null
+++ b/gettext-tools/tests/testdata/tcltest_pl.po
@@ -0,0 +1,26 @@
+# Polish translations for hello-tcl package.
+# Copyright (C) 2003 Yoyodyne, Inc.
+# This file is distributed under the same license as the hello-tcl package.
+# Bruno Haible <bruno@clisp.org>, 2003.
+#
+msgid ""
+msgstr ""
+"Project-Id-Version: hello-tcl 0\n"
+"Report-Msgid-Bugs-To: bug-gnu-gettext@gnu.org\n"
+"POT-Creation-Date: 2003-10-20 10:14+0200\n"
+"PO-Revision-Date: 2003-10-20 10:13+0200\n"
+"Last-Translator: Bruno Haible <bruno@clisp.org>\n"
+"Language-Team: Polish <pl@li.org>\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=ISO-8859-2\n"
+"Content-Transfer-Encoding: 8bit\n"
+"Plural-Forms: nplurals=3; plural=(n==1 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 "
+"|| n%100>=20) ? 1 : 2);\n"
+
+#: hello.cc:45
+msgid "Written by François Pinard."
+msgstr "Program napisa³ François Pinard."
+
+#: hello.cc:52
+msgid "error %1."
+msgstr "b³±d %1."