[PATCH] Added pgettext and npgettext i18n procedures

["Carlos Durán Domínguez" <wurt@wurtshell.com>]

I wanted to add i18n functions that depends on context. The older libguile/libgettext.h header did not reference the pgettext family functions, so I updated to the last version of gettext.

* libguile/gettext.h libguile/gettext.c (pgettext): New procedure.
* libguile/gettext.h libguile/gettext.c (npgettext): New procedure.
* libguile/libgettext.h: Update to add other i18n functions.
* doc/ref/api-i18n.texi: Document new procedures.
---
 doc/ref/api-i18n.texi |  24 ++++
 libguile/gettext.c    | 132 ++++++++++++++++++++++
 libguile/gettext.h    |   2 +
 libguile/libgettext.h | 254 ++++++++++++++++++++++++++++++++++++++++--
 4 files changed, 402 insertions(+), 10 deletions(-)

diff --git a/doc/ref/api-i18n.texi b/doc/ref/api-i18n.texi
index 7c49b0a23..a10e67d6f 100644
--- a/doc/ref/api-i18n.texi
+++ b/doc/ref/api-i18n.texi
@@ -564,6 +564,30 @@ translators to give correct forms (@pxref{Plural forms,, Additional
 functions for plural forms, gettext, GNU @code{gettext} utilities}).
 @end deffn
 
+@deffn {Scheme Procedure} pgettext ctxt msg [domain [category]]
+@deffnx {C Function} scm_pgettext (ctxt, msg, domain, category)
+Return the translation of @var{msg} in @var{domain} restricted to the
+context given by @var{ctxt}. @var{domain} is optional and defaults to
+the domain set through @code{textdomain} below. @var{category} is optional and
+defaults to @code{LC_MESSAGES} (@pxref{Locales}).
+
+It works almost like @code{gettext} but it is used to differenciate the
+same string from different contexts.
+@end deffn
+
+@deffn {Scheme Procedure} npgettext ctxt msg msgplural [domain [category]]
+@deffnx {C Function} scm_npgettext (ctxt, msg, msgplural, domain, category)
+Return the translation of @var{msg}/@var{msgplural} in @var{domain}
+restricted to the context given by @var{ctxt}, with the plural form
+chosen appropriately for the number @var{n}.  @var{domain} is optional
+and defaults to the domain set through @code{textdomain}
+below. @var{category} is optional and defaults to @code{LC_MESSAGES}
+(@pxref{Locales}).
+
+It works almost like @code{ngettext} but it is used to differenciate the
+same string from different contexts.
+@end deffn
+
 @deffn {Scheme Procedure} textdomain [domain]
 @deffnx {C Function} scm_textdomain (domain)
 Get or set the default gettext domain.  When called with no parameter
diff --git a/libguile/gettext.c b/libguile/gettext.c
index b9af4d313..9a996e352 100644
--- a/libguile/gettext.c
+++ b/libguile/gettext.c
@@ -206,6 +206,138 @@ SCM_DEFINE (scm_ngettext, "ngettext", 3, 2, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_pgettext, "pgettext", 2, 2, 0,
+	    (SCM msgctxt, SCM msgid, SCM domain, SCM category),
+	    "Return the translation of @var{msgid} in the message domain "
+	    "@var{domain} restricted to the context given by MSGCTXT. "
+	    "@var{domain} is optional and defaults to the domain set through "
+	    "(textdomain).  @var{category} is optional and defaults to "
+	    "LC_MESSAGES.")
+#define FUNC_NAME s_scm_pgettext
+{
+  char *c_msgctxt;
+  char *c_msgid;
+  char const *c_result;
+  SCM result;
+
+  scm_dynwind_begin (0);
+
+  c_msgctxt = scm_to_locale_string (msgctxt);
+  scm_dynwind_free (c_msgctxt);
+
+  c_msgid = scm_to_locale_string (msgid);
+  scm_dynwind_free (c_msgid);
+
+  if (SCM_UNBNDP (domain))
+    {
+      /* 1 argument case.  */
+      c_result = pgettext_expr (c_msgctxt, c_msgid);
+    }
+  else
+    {
+      char *c_domain;
+
+      c_domain = scm_to_locale_string (domain);
+      scm_dynwind_free (c_domain);
+
+      if (SCM_UNBNDP (category))
+	{
+	  /* 2 argument case.  */
+	  c_result = dpgettext_expr (c_domain, c_msgctxt, c_msgid);
+	}
+      else
+	{
+	  /* 3 argument case.  */
+	  int c_category;
+
+	  c_category = scm_i_to_lc_category (category, 0);
+	  c_result = dcpgettext_expr (c_domain, c_msgctxt, c_msgid, c_category);
+	}
+    }
+
+  if (c_result == c_msgid)
+    result = msgid;
+  else
+    result = scm_from_locale_string (c_result);
+
+  scm_dynwind_end ();
+  return result;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_npgettext, "npgettext", 4, 2, 0,
+	    (SCM msgctxt, SCM msgid, SCM msgid_plural, SCM n, SCM domain,
+             SCM category),
+	    "Return the translation of @var{msgid}/@var{msgid_plural} in the "
+	    "message domain @var{domain} restricted to the context given by "
+            "MSGCTXT, with the plural form being chosen appropriately for the "
+	    "number @var{n}.  @var{domain} is optional and defaults to the "
+	    "domain set through (textdomain). @var{category} is optional and "
+	    "defaults to LC_MESSAGES.")
+#define FUNC_NAME s_scm_npgettext
+{
+  char *c_msgctxt;
+  char *c_msgid;
+  char *c_msgid_plural;
+  unsigned long c_n;
+  const char *c_result;
+  SCM result;
+
+  scm_dynwind_begin (0);
+
+  c_msgctxt = scm_to_locale_string (msgctxt);
+  scm_dynwind_free (c_msgctxt);
+
+  c_msgid = scm_to_locale_string (msgid);
+  scm_dynwind_free (c_msgid);
+
+  c_msgid_plural = scm_to_locale_string (msgid_plural);
+  scm_dynwind_free (c_msgid_plural);
+
+  c_n = scm_to_ulong (n);
+
+  if (SCM_UNBNDP (domain))
+    {
+      /* 3 argument case.  */
+      c_result = npgettext_expr (c_msgctxt, c_msgid, c_msgid_plural, c_n);
+    }
+  else
+    {
+      char *c_domain;
+
+      c_domain = scm_to_locale_string (domain);
+      scm_dynwind_free (c_domain);
+
+      if (SCM_UNBNDP (category))
+	{
+	  /* 4 argument case.  */
+	  c_result = dnpgettext_expr (c_domain, c_msgctxt, c_msgid,
+                                      c_msgid_plural, c_n);
+	}
+      else
+	{
+	  /* 5 argument case.  */
+	  int c_category;
+
+	  c_category = scm_i_to_lc_category (category, 0);
+	  c_result = dcnpgettext_expr (c_domain, c_msgctxt, c_msgid,
+                                       c_msgid_plural, c_n, c_category);
+	}
+    }
+
+  if (c_result == c_msgid)
+    result = msgid;
+  else if (c_result == c_msgid_plural)
+    result = msgid_plural;
+  else
+    result = scm_from_locale_string (c_result);
+
+  scm_dynwind_end ();
+  return result;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_textdomain, "textdomain", 0, 1, 0,
 	    (SCM domainname),
 	    "If optional parameter @var{domainname} is supplied, "
diff --git a/libguile/gettext.h b/libguile/gettext.h
index 40f5bf43e..6761505be 100644
--- a/libguile/gettext.h
+++ b/libguile/gettext.h
@@ -24,6 +24,8 @@
 
 SCM_API SCM scm_gettext (SCM msgid, SCM domainname, SCM category);
 SCM_API SCM scm_ngettext (SCM msgid, SCM msgid_plural, SCM n, SCM domainname, SCM category);
+SCM_API SCM scm_pgettext (SCM msgctxt, SCM msgid, SCM domainname, SCM category);
+SCM_API SCM scm_npgettext (SCM msgctxt, SCM msgid, SCM msgid_plural, SCM n, SCM domainname, SCM category);
 SCM_API SCM scm_textdomain (SCM domainname);
 SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory);
 SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding);
diff --git a/libguile/libgettext.h b/libguile/libgettext.h
index 780ff1ade..d69051c39 100644
--- a/libguile/libgettext.h
+++ b/libguile/libgettext.h
@@ -1,5 +1,6 @@
 /* Convenience header for conditional use of GNU <libintl.h>.
-   Copyright 1995-1998, 2000-2002, 2    Free Software Foundation, Inc.
+   Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2020 Free Software
+   Foundation, Inc.
 
    This file is part of Guile.
 
@@ -20,12 +21,25 @@
 #ifndef _LIBGETTEXT_H
 #define _LIBGETTEXT_H 1
 
-/* NLS can be disabled through the configure --disable-nls option.  */
-#if ENABLE_NLS
+/* NLS can be disabled through the configure --disable-nls option
+   or through "#define ENABLE NLS 0" before including this file.  */
+#if defined ENABLE_NLS && ENABLE_NLS
 
 /* Get declarations of GNU message catalog functions.  */
 # include <libintl.h>
 
+/* You can set the DEFAULT_TEXT_DOMAIN macro to specify the domain used by
+   the gettext() and ngettext() macros.  This is an alternative to calling
+   textdomain(), and is useful for libraries.  */
+# ifdef DEFAULT_TEXT_DOMAIN
+#  undef gettext
+#  define gettext(Msgid) \
+     dgettext (DEFAULT_TEXT_DOMAIN, Msgid)
+#  undef ngettext
+#  define ngettext(Msgid1, Msgid2, N) \
+     dngettext (DEFAULT_TEXT_DOMAIN, Msgid1, Msgid2, N)
+# endif
+
 #else
 
 /* Solaris /usr/include/locale.h includes /usr/include/libintl.h, which
@@ -38,26 +52,56 @@
 # include <locale.h>
 #endif
 
+/* Many header files from the libstdc++ coming with g++ 3.3 or newer include
+   <libintl.h>, which chokes if dcgettext is defined as a macro.  So include
+   it now, to make later inclusions of <libintl.h> a NOP.  */
+#if defined(__cplusplus) && defined(__GNUG__) && (__GNUC__ >= 3)
+# include <cstdlib>
+# if (__GLIBC__ >= 2 && !defined __UCLIBC__) || _GLIBCXX_HAVE_LIBINTL_H
+#  include <libintl.h>
+# endif
+#endif
+
 /* Disabled NLS.
    The casts to 'const char *' serve the purpose of producing warnings
    for invalid uses of the value returned from these functions.
    On pre-ANSI systems without 'const', the config.h file is supposed to
    contain "#define const".  */
+# undef gettext
 # define gettext(Msgid) ((const char *) (Msgid))
-# define dgettext(Domainname, Msgid) ((const char *) (Msgid))
-# define dcgettext(Domainname, Msgid, Category) ((const char *) (Msgid))
+# undef dgettext
+# define dgettext(Domainname, Msgid) ((void) (Domainname), gettext (Msgid))
+# undef dcgettext
+# define dcgettext(Domainname, Msgid, Category) \
+    ((void) (Category), dgettext (Domainname, Msgid))
+# undef ngettext
 # define ngettext(Msgid1, Msgid2, N) \
-    ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
+    ((N) == 1 \
+     ? ((void) (Msgid2), (const char *) (Msgid1)) \
+     : ((void) (Msgid1), (const char *) (Msgid2)))
+# undef dngettext
 # define dngettext(Domainname, Msgid1, Msgid2, N) \
-    ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
+    ((void) (Domainname), ngettext (Msgid1, Msgid2, N))
+# undef dcngettext
 # define dcngettext(Domainname, Msgid1, Msgid2, N, Category) \
-    ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
+    ((void) (Category), dngettext (Domainname, Msgid1, Msgid2, N))
+# undef textdomain
 # define textdomain(Domainname) ((const char *) (Domainname))
-# define bindtextdomain(Domainname, Dirname) ((const char *) (Dirname))
-# define bind_textdomain_codeset(Domainname, Codeset) ((const char *) (Codeset))
+# undef bindtextdomain
+# define bindtextdomain(Domainname, Dirname) \
+    ((void) (Domainname), (const char *) (Dirname))
+# undef bind_textdomain_codeset
+# define bind_textdomain_codeset(Domainname, Codeset) \
+    ((void) (Domainname), (const char *) (Codeset))
 
 #endif
 
+/* Prefer gnulib's setlocale override over libintl's setlocale override.  */
+#ifdef GNULIB_defined_setlocale
+# undef setlocale
+# define setlocale rpl_setlocale
+#endif
+
 /* A pseudo function call that serves as a marker for the automated
    extraction of messages, but does not call gettext().  The run-time
    translation is done at a different place in the code.
@@ -67,4 +111,194 @@
    initializer for static 'char[]' or 'const char[]' variables.  */
 #define gettext_noop(String) String
 
+/* The separator between msgctxt and msgid in a .mo file.  */
+#define GETTEXT_CONTEXT_GLUE "\004"
+
+/* Pseudo function calls, taking a MSGCTXT and a MSGID instead of just a
+   MSGID.  MSGCTXT and MSGID must be string literals.  MSGCTXT should be
+   short and rarely need to change.
+   The letter 'p' stands for 'particular' or 'special'.  */
+#ifdef DEFAULT_TEXT_DOMAIN
+# define pgettext(Msgctxt, Msgid) \
+   pgettext_aux (DEFAULT_TEXT_DOMAIN, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, LC_MESSAGES)
+#else
+# define pgettext(Msgctxt, Msgid) \
+   pgettext_aux (NULL, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, LC_MESSAGES)
+#endif
+#define dpgettext(Domainname, Msgctxt, Msgid) \
+  pgettext_aux (Domainname, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, LC_MESSAGES)
+#define dcpgettext(Domainname, Msgctxt, Msgid, Category) \
+  pgettext_aux (Domainname, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, Category)
+#ifdef DEFAULT_TEXT_DOMAIN
+# define npgettext(Msgctxt, Msgid, MsgidPlural, N) \
+   npgettext_aux (DEFAULT_TEXT_DOMAIN, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, MsgidPlural, N, LC_MESSAGES)
+#else
+# define npgettext(Msgctxt, Msgid, MsgidPlural, N) \
+   npgettext_aux (NULL, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, MsgidPlural, N, LC_MESSAGES)
+#endif
+#define dnpgettext(Domainname, Msgctxt, Msgid, MsgidPlural, N) \
+  npgettext_aux (Domainname, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, MsgidPlural, N, LC_MESSAGES)
+#define dcnpgettext(Domainname, Msgctxt, Msgid, MsgidPlural, N, Category) \
+  npgettext_aux (Domainname, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, MsgidPlural, N, Category)
+
+#if defined __GNUC__ || defined __clang__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static const char *
+pgettext_aux (const char *domain,
+              const char *msg_ctxt_id, const char *msgid,
+              int category)
+{
+  const char *translation = dcgettext (domain, msg_ctxt_id, category);
+  if (translation == msg_ctxt_id)
+    return msgid;
+  else
+    return translation;
+}
+
+#if defined __GNUC__ || defined __clang__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static const char *
+npgettext_aux (const char *domain,
+               const char *msg_ctxt_id, const char *msgid,
+               const char *msgid_plural, unsigned long int n,
+               int category)
+{
+  const char *translation =
+    dcngettext (domain, msg_ctxt_id, msgid_plural, n, category);
+  if (translation == msg_ctxt_id || translation == msgid_plural)
+    return (n == 1 ? msgid : msgid_plural);
+  else
+    return translation;
+}
+
+/* The same thing extended for non-constant arguments.  Here MSGCTXT and MSGID
+   can be arbitrary expressions.  But for string literals these macros are
+   less efficient than those above.  */
+
+#include <string.h>
+
+/* GNULIB_NO_VLA can be defined to disable use of VLAs even if supported.
+   This relates to the -Wvla and -Wvla-larger-than warnings, enabled in
+   the default GCC many warnings set.  This allows programs to disable use
+   of VLAs, which may be unintended, or may be awkward to support portably,
+   or may have security implications due to non-deterministic stack usage.  */
+
+#if (!defined GNULIB_NO_VLA \
+     && (((__GNUC__ >= 3 || defined __clang__) && !defined __STRICT_ANSI__) \
+         /* || (__STDC_VERSION__ == 199901L && !defined __HP_cc)
+            || (__STDC_VERSION__ >= 201112L && !defined __STDC_NO_VLA__) */ ))
+# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 1
+#else
+# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 0
+#endif
+
+#if !_LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS
+#include <stdlib.h>
+#endif
+
+#define pgettext_expr(Msgctxt, Msgid) \
+  dcpgettext_expr (NULL, Msgctxt, Msgid, LC_MESSAGES)
+#define dpgettext_expr(Domainname, Msgctxt, Msgid) \
+  dcpgettext_expr (Domainname, Msgctxt, Msgid, LC_MESSAGES)
+
+#if defined __GNUC__ || defined __clang__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static const char *
+dcpgettext_expr (const char *domain,
+                 const char *msgctxt, const char *msgid,
+                 int category)
+{
+  size_t msgctxt_len = strlen (msgctxt) + 1;
+  size_t msgid_len = strlen (msgid) + 1;
+  const char *translation;
+#if _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS
+  char msg_ctxt_id[msgctxt_len + msgid_len];
+#else
+  char buf[1024];
+  char *msg_ctxt_id =
+    (msgctxt_len + msgid_len <= sizeof (buf)
+     ? buf
+     : (char *) malloc (msgctxt_len + msgid_len));
+  if (msg_ctxt_id != NULL)
+#endif
+    {
+      int found_translation;
+      memcpy (msg_ctxt_id, msgctxt, msgctxt_len - 1);
+      msg_ctxt_id[msgctxt_len - 1] = '\004';
+      memcpy (msg_ctxt_id + msgctxt_len, msgid, msgid_len);
+      translation = dcgettext (domain, msg_ctxt_id, category);
+      found_translation = (translation != msg_ctxt_id);
+#if !_LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS
+      if (msg_ctxt_id != buf)
+        free (msg_ctxt_id);
+#endif
+      if (found_translation)
+        return translation;
+    }
+  return msgid;
+}
+
+#define npgettext_expr(Msgctxt, Msgid, MsgidPlural, N) \
+  dcnpgettext_expr (NULL, Msgctxt, Msgid, MsgidPlural, N, LC_MESSAGES)
+#define dnpgettext_expr(Domainname, Msgctxt, Msgid, MsgidPlural, N) \
+  dcnpgettext_expr (Domainname, Msgctxt, Msgid, MsgidPlural, N, LC_MESSAGES)
+
+#if defined __GNUC__ || defined __clang__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static const char *
+dcnpgettext_expr (const char *domain,
+                  const char *msgctxt, const char *msgid,
+                  const char *msgid_plural, unsigned long int n,
+                  int category)
+{
+  size_t msgctxt_len = strlen (msgctxt) + 1;
+  size_t msgid_len = strlen (msgid) + 1;
+  const char *translation;
+#if _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS
+  char msg_ctxt_id[msgctxt_len + msgid_len];
+#else
+  char buf[1024];
+  char *msg_ctxt_id =
+    (msgctxt_len + msgid_len <= sizeof (buf)
+     ? buf
+     : (char *) malloc (msgctxt_len + msgid_len));
+  if (msg_ctxt_id != NULL)
+#endif
+    {
+      int found_translation;
+      memcpy (msg_ctxt_id, msgctxt, msgctxt_len - 1);
+      msg_ctxt_id[msgctxt_len - 1] = '\004';
+      memcpy (msg_ctxt_id + msgctxt_len, msgid, msgid_len);
+      translation = dcngettext (domain, msg_ctxt_id, msgid_plural, n, category);
+      found_translation = !(translation == msg_ctxt_id || translation == msgid_plural);
+#if !_LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS
+      if (msg_ctxt_id != buf)
+        free (msg_ctxt_id);
+#endif
+      if (found_translation)
+        return translation;
+    }
+  return (n == 1 ? msgid : msgid_plural);
+}
+
 #endif /* _LIBGETTEXT_H */
-- 
2.41.0