Perl supports pgettext() and similar functions

diff --git a/NEWS b/NEWS
index 83f12805eb901acaa0d6c69314c240e35db0bff3..d13901722510d93d4792587231057688d6d41700 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,6 +1,13 @@
 * Runtime behaviour:
   - update-po target in Makefile.in.in now uses msgfmt --previous.
 
+* Programming languages support:
+  - Perl:
+    o Native support for context functions (pgettext, dpgettext, dcpgettext,
+      npgettext, dnpgettext, dcnpgettext).
+    o better detection of question mark and slash as operators (as opposed 
+      to regular expression delimiters).
+
 Version 0.19.8 - June 2016
 
 * Support for reproducible builds:

diff --git a/gettext-tools/doc/gettext.texi b/gettext-tools/doc/gettext.texi
index 1e332beaf37e7d8eff2a5a259b8b4158efcc4215..a46b5d881408db093ed38d81ecbf8ceea1de5a9e 100644 (file)
--- a/gettext-tools/doc/gettext.texi
+++ b/gettext-tools/doc/gettext.texi
@@ -11003,7 +11003,9 @@ perl
 
 @item gettext/ngettext functions
 @code{gettext}, @code{dgettext}, @code{dcgettext}, @code{ngettext},
-@code{dngettext}, @code{dcngettext}
+@code{dngettext}, @code{dcngettext}, @code{pgettext}, @code{dpgettext},
+@code{dcpgettext}, @code{npgettext}, @code{dnpgettext},
+@code{dcnpgettext}
 
 @item textdomain
 @code{textdomain} function
@@ -11027,7 +11029,8 @@ http://www.cpan.org/).
 platform dependent: gettext_pp emulates, gettext_xs uses GNU gettext
 
 @item Extractor
-@code{xgettext -k__ -k\$__ -k%__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -kN__ -k}
+@code{xgettext -k__ -k\$__ -k%__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 
+-kN__ -kN__n:1,2 -k__p:1c,2 -k__np:1c,2,3 -kN__p:1c,2 -kN__np:1c,2,3}
 
 @item Formatting with positions
 Both kinds of format strings support formatting with positions.

diff --git a/gettext-tools/src/x-perl.c b/gettext-tools/src/x-perl.c
index b0704a6a107a50b0585e5f62ec8e36ee95a0d01e..2ee11d75fac39559b71828f6ede89ad768a18067 100644 (file)
--- a/gettext-tools/src/x-perl.c
+++ b/gettext-tools/src/x-perl.c
@@ -109,6 +109,13 @@ init_keywords ()
       x_perl_keyword ("dngettext:2,3");
       x_perl_keyword ("dcngettext:2,3");
       x_perl_keyword ("gettext_noop");
+      x_perl_keyword ("pgettext:1c,2");
+      x_perl_keyword ("dpgettext:2c,3");
+      x_perl_keyword ("dcpgettext:2c,3");
+      x_perl_keyword ("npgettext:1c,2,3");
+      x_perl_keyword ("dnpgettext:2c,3,4");
+      x_perl_keyword ("dcnpgettext:2c,3,4");
+
 #if 0
       x_perl_keyword ("__");
       x_perl_keyword ("$__");
@@ -126,6 +133,7 @@ init_keywords ()
 void
 init_flag_table_perl ()
 {
+  /* Gettext binding for Perl.  */
   xgettext_record_flag ("gettext:1:pass-perl-format");
   xgettext_record_flag ("gettext:1:pass-perl-brace-format");
   xgettext_record_flag ("%gettext:1:pass-perl-format");
@@ -150,9 +158,30 @@ init_flag_table_perl ()
   xgettext_record_flag ("dcngettext:3:pass-perl-brace-format");
   xgettext_record_flag ("gettext_noop:1:pass-perl-format");
   xgettext_record_flag ("gettext_noop:1:pass-perl-brace-format");
+  xgettext_record_flag ("pgettext:2:pass-perl-format");
+  xgettext_record_flag ("pgettext:2:pass-perl-brace-format");
+  xgettext_record_flag ("dpgettext:3:pass-perl-format");
+  xgettext_record_flag ("dpgettext:3:pass-perl-brace-format");
+  xgettext_record_flag ("dcpgettext:3:pass-perl-format");
+  xgettext_record_flag ("dcpgettext:3:pass-perl-brace-format");
+  xgettext_record_flag ("npgettext:2:pass-perl-format");
+  xgettext_record_flag ("npgettext:3:pass-perl-format");
+  xgettext_record_flag ("npgettext:2:pass-perl-brace-format");
+  xgettext_record_flag ("npgettext:3:pass-perl-brace-format");
+  xgettext_record_flag ("dnpgettext:3:pass-perl-format");
+  xgettext_record_flag ("dnpgettext:4:pass-perl-format");
+  xgettext_record_flag ("dnpgettext:3:pass-perl-brace-format");
+  xgettext_record_flag ("dnpgettext:4:pass-perl-brace-format");
+  xgettext_record_flag ("dcnpgettext:3:pass-perl-format");
+  xgettext_record_flag ("dcnpgettext:4:pass-perl-format");
+  xgettext_record_flag ("dcnpgettext:3:pass-perl-brace-format");
+  xgettext_record_flag ("dcnpgettext:4:pass-perl-brace-format");
+
+  /* Perl builtins.  */
   xgettext_record_flag ("printf:1:perl-format"); /* argument 1 or 2 ?? */
   xgettext_record_flag ("sprintf:1:perl-format");
 #if 0
+  /* Shortcuts from libintl-perl.  */
   xgettext_record_flag ("__:1:pass-perl-format");
   xgettext_record_flag ("__:1:pass-perl-brace-format");
   xgettext_record_flag ("%__:1:pass-perl-format");

diff --git a/gettext-tools/tests/xgettext-perl-1 b/gettext-tools/tests/xgettext-perl-1
index 1f9c9bfe5a0fec8f03a81f861de70429e3eb73f0..16df3340321f04e770949c27998761c5021ecf9f 100755 (executable)
--- a/gettext-tools/tests/xgettext-perl-1
+++ b/gettext-tools/tests/xgettext-perl-1
@@ -145,6 +145,14 @@ gettext "Before slash-slash";
 print $foo // 'undef';
 gettext "After slash-slash";
 
+pgettext "context", "message",
+dpgettext "my domain", "context", "message";
+dcpgettext "my domain", "context", "message", LC_MESSAGES;
+npgettext "context", "one message", "many messages";
+dnpgettext "my domain", "context", "one message", "many messages";
+dcnpgettext "my domain", "context", "one message", "many messages",
+            LC_MESSAGES;
+
 __END__
 gettext "Discarded!";
 EOF
@@ -324,6 +332,18 @@ msgstr ""
 #: xg-pl-1.pl:140
 msgid "After slash-slash"
 msgstr ""
+
+#: xg-pl-1.pl:142 xg-pl-1.pl:143 xg-pl-1.pl:144
+msgctxt "context"
+msgid "message"
+msgstr ""
+
+#: xg-pl-1.pl:145 xg-pl-1.pl:146 xg-pl-1.pl:147
+msgctxt "context"
+msgid "one message"
+msgid_plural "many messages"
+msgstr[0] ""
+msgstr[1] ""
 EOF
 
 : ${DIFF=diff}