ocaml-gettext/0009-Convert-from-camlp4-to-ppx-for-translatable-string-e.patch
Richard W.M. Jones bf0bebee85 Remove camlp4 dependency.
Add all upstream patches since 0.3.7.
2019-07-19 10:54:04 +01:00

598 lines
21 KiB
Diff

From 739e3a900993299e7e8b90af3da565417eb84412 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Fri, 12 Jul 2019 16:02:16 +0100
Subject: [PATCH 9/9] Convert from camlp4 to ppx for translatable string
extraction.
---
aclocal.m4 | 6 +-
configure.in | 3 -
libgettext-ocaml/Makefile | 17 ---
libgettext-ocaml/pr_gettext.ml | 218 -------------------------------
ocaml-gettext/Makefile | 11 +-
ocaml-gettext/OCamlGettext.ml | 2 +-
ocaml-gettext/xgettext.ml | 228 +++++++++++++++++++++++++++++++++
test/test.ml | 4 +-
8 files changed, 234 insertions(+), 255 deletions(-)
delete mode 100644 libgettext-ocaml/pr_gettext.ml
create mode 100644 ocaml-gettext/xgettext.ml
diff --git a/aclocal.m4 b/aclocal.m4
index 72a27da..2a1110f 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -204,7 +204,7 @@ else
fi
])
-# AC_CHECK_[CAMLP4,CAMLIDL,OCAMLMKLIB,MKCAMLP4] ([ACTION-IF-FOUND],[ACTION-IF-NOT-FOUND])
+# AC_CHECK_[CAMLIDL,OCAMLMKLIB] ([ACTION-IF-FOUND],[ACTION-IF-NOT-FOUND])
#---------------------------------------------------------
# Subst the corresponding var
AC_DEFUN([AC_CHECK_STAR],
@@ -219,12 +219,8 @@ else
fi
AC_SUBST($1)
])
-AC_DEFUN([AC_CHECK_CAMLP4], [AC_CHECK_STAR(CAMLP4,camlp4,$1,$2)])
-AC_DEFUN([AC_CHECK_CAMLP4OF], [AC_CHECK_STAR(CAMLP4OF,camlp4of,$1,$2)])
-AC_DEFUN([AC_CHECK_CAMLP4O], [AC_CHECK_STAR(CAMLP4O,camlp4o,$1,$2)])
AC_DEFUN([AC_CHECK_CAMLIDL], [AC_CHECK_STAR(CAMLIDL,camlidl,$1,$2)])
AC_DEFUN([AC_CHECK_OCAMLMKLIB], [AC_CHECK_STAR(OCAMLMKLIB,ocamlmklib,$1,$2)])
-AC_DEFUN([AC_CHECK_MKCAMLP4], [AC_CHECK_STAR(MKCAMLP4,mkcamlp4,$1,$2)])
AC_DEFUN([AC_CHECK_OCAMLDOC], [AC_CHECK_STAR(OCAMLDOC,ocamldoc,$1,$2)])
AC_DEFUN([AC_CHECK_XSLTPROC], [AC_CHECK_STAR(XSLTPROC,xsltproc,$1,$2)])
AC_DEFUN([AC_CHECK_XMLLINT], [AC_CHECK_STAR(XMLLINT,xmllint,$1,$2)])
diff --git a/configure.in b/configure.in
index 9840d2b..3ef4c8d 100644
--- a/configure.in
+++ b/configure.in
@@ -85,9 +85,6 @@ AC_CHECK_OCAMLOPT([],[AC_MSG_WARN(Cannot find ocamlopt, byte compilation only)])
AC_CHECK_OCAMLLEX([],[AC_MSG_ERROR(Cannot find ocamllex.)])
AC_CHECK_OCAMLYACC([],[AC_MSG_ERROR(Cannot find ocamlyacc.)])
AC_CHECK_OCAMLFIND([],[AC_MSG_ERROR(Cannot find ocamlfind.)])
-AC_CHECK_CAMLP4([],[AC_MSG_ERROR(Cannot find camlp4.)])
-AC_CHECK_CAMLP4O([],[AC_MSG_ERROR(Cannot find camlp4o.)])
-AC_CHECK_CAMLP4OF([],[AC_MSG_ERROR(Cannot find camlp4of.)])
AC_CHECK_OCAMLMKLIB([],[AC_MSG_ERROR(Cannot find ocamlmklib.)])
if test "x$BUILD_DOC" = "xyes"; then
diff --git a/libgettext-ocaml/Makefile b/libgettext-ocaml/Makefile
index 1a155c1..e64e0a1 100644
--- a/libgettext-ocaml/Makefile
+++ b/libgettext-ocaml/Makefile
@@ -161,22 +161,5 @@ clean::
-$(RM) gettextCompile.mli
-$(RM) gettextMo.mli
-########################
-# Pa_gettext extension #
-########################
-
-INSTALLIB += \
- pr_gettext.cmo
-
-pr_gettext.cmo: pr_gettext.ml
- ocamlc \
- -I +camlp4 \
- -I $(shell ocamlc -where)/camlp4/Camlp4Parsers \
- -pp camlp4of \
- camlp4lib.cma \
- gettextBase.cma \
- gettextExtension.cma \
- -c $< -o $@
-
include ../ConfMakefile
include ../TopMakefile
diff --git a/libgettext-ocaml/pr_gettext.ml b/libgettext-ocaml/pr_gettext.ml
deleted file mode 100644
index 47d93e5..0000000
--- a/libgettext-ocaml/pr_gettext.ml
+++ /dev/null
@@ -1,218 +0,0 @@
-(**************************************************************************)
-(* ocaml-gettext: a library to translate messages *)
-(* *)
-(* Copyright (C) 2003-2008 Sylvain Le Gall <sylvain@le-gall.net> *)
-(* *)
-(* This library is free software; you can redistribute it and/or *)
-(* modify it under the terms of the GNU Lesser General Public *)
-(* License as published by the Free Software Foundation; either *)
-(* version 2.1 of the License, or (at your option) any later version; *)
-(* with the OCaml static compilation exception. *)
-(* *)
-(* This library is distributed in the hope that it will be useful, *)
-(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
-(* Lesser General Public License for more details. *)
-(* *)
-(* You should have received a copy of the GNU Lesser General Public *)
-(* License along with this library; if not, write to the Free Software *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
-(* USA *)
-(**************************************************************************)
-
-(** Camlp4 dumper to extract strings.
- @author Sylvain Le Gall
- @author Richard W.M. Jones (translation to OCaml 3.10.X new camlp4)
- *)
-
-(* Extract the string which should be used for a gettext translation. Output a
- po_content list through the function Marshal.to_channel
- Functions that are looked for :
-Functions Arg 1 Arg 2 Arg 3 Arg 4 Arg 5 Arg 6 ...
-s_ singular
-f_ singular
-sn_ singular plural _
-fn_ singular plural _
-gettext _ singular
-fgettext _ singular
-dgettext _ domain singular
-fdgettext _ domain singular
-dcgettext _ domain singular _
-fdcgettext _ domain singular _
-ngettext _ singular plural _
-fngettext _ singular plural _
-dngettext _ domain singular plural _
-fdngettext _ domain singular plural _
-dcngettext _ domain singular plural _ _
-fdcngettext _ domain singular plural _ _
-
-
-All this function name should also be matched when they are called using a
-module.
-
-*)
-
-open Format
-open GettextTypes
-open GettextPo
-
-let default_textdomain = ref None
-
-module Id = struct
- (* name is printed with the -loaded-modules switch *)
- let name = "pr_gettext"
- (* cvs id's seem to be the preferred version string *)
- let version = "$Id$"
-end
-
-module Make (Syntax : Camlp4.Sig.Camlp4Syntax)
- : Camlp4.Sig.Printer(Syntax.Ast).S =
-struct
- module Loc = Syntax.Loc
- module Ast = Syntax.Ast
-
- type t =
- {
- po_content: po_content;
- translated: SetString.t;
- }
-
- let string_of_ocaml_string str =
- Scanf.sscanf
- (Printf.sprintf "\"%s\"" str)
- "%S"
- (fun s -> s)
-
-
- let add_translation t loc ocaml_singular plural_opt domain =
- let filepos =
- Loc.file_name loc, Loc.start_line loc
- in
- let singular =
- string_of_ocaml_string ocaml_singular
- in
- let translated =
- SetString.add ocaml_singular t.translated
- in
- let translated, translation =
- match plural_opt with
- | Some ocaml_plural ->
- let plural =
- string_of_ocaml_string ocaml_plural
- in
- SetString.add ocaml_plural translated,
- {
- po_comment_special = [];
- po_comment_filepos = [filepos];
- po_comment_translation = PoPlural([singular],[plural],[[""];[""]]);
- }
- | None ->
- translated,
- {
- po_comment_special = [];
- po_comment_filepos = [filepos];
- po_comment_translation = PoSingular([singular],[""]);
- }
- in
- let po_content =
- match domain, !default_textdomain with
- | Some domain, _ ->
- add_po_translation_domain domain t.po_content translation
- | None, Some domain ->
- add_po_translation_domain domain t.po_content translation
- | None, None ->
- add_po_translation_no_domain t.po_content translation
- in
- {t with
- po_content = po_content;
- translated = translated}
-
- let output_translations ?output_file t =
- let fd =
- match output_file with
- | Some f -> open_out f
- | None -> stdout
- in
- Marshal.to_channel fd t.po_content []
-
- (* Check if the given node belong to the given functions *)
- let is_like e functions =
- let rec function_name e =
- match e with
- | <:ident<$_$.$id:e$>> ->
- function_name e
- | <:ident<$lid:s$>> ->
- s
- | _ ->
- raise Not_found
- in
- try
- List.mem (function_name e) functions
- with Not_found ->
- false
-
- class visitor = object
- inherit Ast.fold as super
-
- val t =
- {
- po_content = empty_po;
- translated = SetString.empty;
- }
-
- method t = t
-
- method expr = function
- | <:expr@loc< $id:e$ $str:singular$ >> when
- is_like e ["s_"; "f_"] ->
- (* Add a singular / default domain string *)
- {< t = add_translation t loc singular None None >}
-
- | <:expr@loc< $id:e$ $str:singular$ $str:plural$ >> when
- is_like e ["sn_"; "fn_"] ->
- (* Add a plural / default domain string *)
- {< t = add_translation t loc singular (Some plural) None >}
-
- | <:expr@loc< $id:e$ $expr$ $str:singular$ >> when
- is_like e ["gettext"; "fgettext"] ->
- (* Add a singular / default domain string *)
- {< t = add_translation t loc singular None None >}
-
- | <:expr@loc< $id:e$ $expr$ $str:domain$ $str:singular$ >> when
- is_like e ["dgettext"; "fdgettext"; "dcgettext"; "fdcgettext"] ->
- (* Add a singular / defined domain string *)
- {< t = add_translation t loc singular None (Some domain) >}
-
- | <:expr@loc< $id:e$ $expr$ $str:singular$ $str:plural$ >> when
- is_like e ["ngettext"; "fngettext"] ->
- (* Add a plural / default domain string *)
- {< t = add_translation t loc singular (Some plural) None >}
-
- | <:expr@loc< $id:e$ $expr$ $str:domain$ $str:singular$ $str:plural$ >> when
- is_like e ["dngettext"; "fdngettext"; "dcngettext"; "fdcngettext"] ->
- (* Add a plural / defined domain string *)
- {< t = add_translation t loc singular (Some plural) (Some domain) >}
-
- | e -> super#expr e
-
- end
-
- (* Called on *.mli files, but cannot contain translateable strings. *)
- let print_interf ?input_file ?output_file _ = ()
-
- (* Called on *.ml files. *)
- let print_implem ?input_file ?output_file ast =
- let visitor = (new visitor)#str_item in
- let t = (visitor ast)#t in
- output_translations ?output_file t
-end
-
-(* Register the new printer. *)
-module M = Camlp4.Register.OCamlPrinter(Id)(Make) ;;
-
-(* XXX How to do this?
-Pcaml.add_option "-default-textdomain"
- (Arg.String ( fun textdomain -> default_textdomain := Some textdomain ) )
- "<textdomain> Defines the default textdomain"
-;;
-*)
diff --git a/ocaml-gettext/Makefile b/ocaml-gettext/Makefile
index d5f37fa..0c1199e 100644
--- a/ocaml-gettext/Makefile
+++ b/ocaml-gettext/Makefile
@@ -61,14 +61,9 @@ install: ocaml-xgettext-install
uninstall: ocaml-xgettext-uninstall
-ocaml-xgettext: $(BUILDBIN)
- $(OCAMLC) \
- -I +camlp4 dynlink.cma camlp4lib.cma \
- `$(OCAMLFIND) query -r -predicates byte gettext.extract -i-format` \
- `$(OCAMLFIND) query -r -predicates byte gettext.extract -a-format` \
- `$(OCAMLFIND) query -r -predicates byte gettext.extract -o-format` \
- Camlp4Bin.cmo \
- -o $@
+ocaml-xgettext: xgettext.ml
+ $(OCAMLC) -I ../libgettext-ocaml -I +compiler-libs \
+ ocamlcommon.cma gettextBase.cma gettextExtension.cma $< -o $@
$(INSTALL_SCRIPT) -t $(BUILDBIN) $@
ocaml-xgettext-install:
diff --git a/ocaml-gettext/OCamlGettext.ml b/ocaml-gettext/OCamlGettext.ml
index 837057e..d643a9b 100644
--- a/ocaml-gettext/OCamlGettext.ml
+++ b/ocaml-gettext/OCamlGettext.ml
@@ -283,7 +283,7 @@ let () =
{
action_option = None;
extract_command = "ocaml-xgettext";
- extract_default_option = "-I +camlp4 pa_o.cmo";
+ extract_default_option = "";
extract_filename_options = [];
extract_pot = "messages.pot";
compile_output_file_option = None;
diff --git a/ocaml-gettext/xgettext.ml b/ocaml-gettext/xgettext.ml
new file mode 100644
index 0000000..76232d8
--- /dev/null
+++ b/ocaml-gettext/xgettext.ml
@@ -0,0 +1,228 @@
+(**************************************************************************)
+(* ocaml-gettext: a library to translate messages *)
+(* *)
+(* Copyright (C) 2003-2008 Sylvain Le Gall <sylvain@le-gall.net> *)
+(* *)
+(* This library is free software; you can redistribute it and/or *)
+(* modify it under the terms of the GNU Lesser General Public *)
+(* License as published by the Free Software Foundation; either *)
+(* version 2.1 of the License, or (at your option) any later version; *)
+(* with the OCaml static compilation exception. *)
+(* *)
+(* This library is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
+(* Lesser General Public License for more details. *)
+(* *)
+(* You should have received a copy of the GNU Lesser General Public *)
+(* License along with this library; if not, write to the Free Software *)
+(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
+(* USA *)
+(**************************************************************************)
+
+(** PPX dumper to extract strings.
+ @author Richard W.M. Jones
+ @author Sylvain Le Gall
+ *)
+
+(* Extract the string which should be used for a gettext translation. Output a
+ po_content list through the function Marshal.to_channel
+ Functions that are looked for :
+
+Functions Arg 1 Arg 2 Arg 3 Arg 4 Arg 5 Arg 6 ...
+s_ singular
+f_ singular
+sn_ singular plural _
+fn_ singular plural _
+gettext _ singular
+fgettext _ singular
+dgettext _ domain singular
+fdgettext _ domain singular
+dcgettext _ domain singular _
+fdcgettext _ domain singular _
+ngettext _ singular plural _
+fngettext _ singular plural _
+dngettext _ domain singular plural _
+fdngettext _ domain singular plural _
+dcngettext _ domain singular plural _ _
+fdcngettext _ domain singular plural _ _
+
+All this function name should also be matched when they are called using a
+module.
+
+*)
+
+open GettextTypes
+open GettextPo
+open Parsetree
+open Longident
+open Location
+
+type t = {
+ po_content: po_content;
+ translated: SetString.t;
+}
+
+let string_of_ocaml_string str =
+ Scanf.sscanf
+ (Printf.sprintf "\"%s\"" str)
+ "%S"
+ (fun s -> s)
+
+let translations = ref { po_content = empty_po; translated = SetString.empty }
+
+let default_textdomain = ref None
+
+let current_file = ref ""
+
+let add_translation loc ocaml_singular plural_opt domain =
+ let t = !translations in
+
+ let filepos =
+ let start = loc.Location.loc_start in
+ let fname =
+ match start.Lexing.pos_fname with "" -> !current_file
+ | fname -> fname in
+ fname, start.Lexing.pos_lnum
+ in
+ let singular =
+ string_of_ocaml_string ocaml_singular
+ in
+ let translated =
+ SetString.add ocaml_singular t.translated
+ in
+ let translated, translation =
+ match plural_opt with
+ | Some ocaml_plural ->
+ let plural =
+ string_of_ocaml_string ocaml_plural
+ in
+ SetString.add ocaml_plural translated,
+ {
+ po_comment_special = [];
+ po_comment_filepos = [filepos];
+ po_comment_translation = PoPlural([singular],[plural],[[""];[""]]);
+ }
+ | None ->
+ translated,
+ {
+ po_comment_special = [];
+ po_comment_filepos = [filepos];
+ po_comment_translation = PoSingular([singular],[""]);
+ }
+ in
+ let po_content =
+ match domain, !default_textdomain with
+ | Some domain, _ ->
+ add_po_translation_domain domain t.po_content translation
+ | None, Some domain ->
+ add_po_translation_domain domain t.po_content translation
+ | None, None ->
+ add_po_translation_no_domain t.po_content translation
+ in
+
+ translations := { po_content; translated }
+
+let output_translations ?output_file t =
+ let fd =
+ match output_file with
+ | Some f -> open_out f
+ | None -> stdout
+ in
+ Marshal.to_channel fd t.po_content []
+
+let rec is_like lid = function
+ | [] -> false
+ | func :: functions ->
+ match lid with
+ | Lident f
+ | Ldot (_, f) when f = func -> true
+ | _ -> is_like lid functions
+
+let visit_expr (iterator : Ast_iterator.iterator) expr =
+ let loc = expr.pexp_loc in
+ match expr.pexp_desc with
+ | Pexp_apply (
+ { pexp_desc = Pexp_ident ({ Asttypes.txt = lid })},
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (singular, _)) }) ::
+ _)
+ when is_like lid ["s_"; "f_"] ->
+ (* Add a singular / default domain string *)
+ add_translation loc singular None None
+
+ | Pexp_apply (
+ { pexp_desc = Pexp_ident ({ Asttypes.txt = lid })},
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (singular, _)) }) ::
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (plural, _)) }) ::
+ _)
+ when is_like lid ["sn_"; "fn_"] ->
+ (* Add a plural / default domain string *)
+ add_translation loc singular (Some plural) None
+
+ | Pexp_apply (
+ { pexp_desc = Pexp_ident ({ Asttypes.txt = lid })},
+ (_ ::
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (singular, _)) }) ::
+ _))
+ when is_like lid ["gettext"; "fgettext"] ->
+ (* Add a singular / default domain string *)
+ add_translation loc singular None None
+
+ | Pexp_apply (
+ { pexp_desc = Pexp_ident ({ Asttypes.txt = lid })},
+ (_ ::
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (domain, _)) }) ::
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (singular, _)) }) ::
+ _))
+ when is_like lid ["dgettext"; "fdgettext"; "dcgettext"; "fdcgettext"] ->
+ (* Add a singular / defined domain string *)
+ add_translation loc singular None (Some domain)
+
+ | Pexp_apply (
+ { pexp_desc = Pexp_ident ({ Asttypes.txt = lid })},
+ (_ ::
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (singular, _)) }) ::
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (plural, _)) }) ::
+ _))
+ when is_like lid ["ngettext"; "fngettext"] ->
+ (* Add a plural / default domain string *)
+ add_translation loc singular (Some plural) None
+
+ | Pexp_apply (
+ { pexp_desc = Pexp_ident ({ Asttypes.txt = lid })},
+ (_ ::
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (domain, _)) }) ::
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (singular, _)) }) ::
+ (Asttypes.Nolabel,
+ { pexp_desc = Pexp_constant (Pconst_string (plural, _)) }) ::
+ _))
+ when is_like lid ["dngettext"; "fdngettext"; "dcngettext"; "fdcngettext"] ->
+ (* Add a plural / defined domain string *)
+ add_translation loc singular (Some plural) (Some domain)
+
+ | _ ->
+ Ast_iterator.default_iterator.expr iterator expr
+
+let ast_iterator =
+ { Ast_iterator.default_iterator with expr = visit_expr }
+
+let go fn =
+ current_file := fn;
+ let lexbuf = Lexing.from_channel (open_in fn) in
+ let structure = Parse.implementation lexbuf in
+ ast_iterator.Ast_iterator.structure ast_iterator structure
+
+let () =
+ (* XXX Add -default-textdomain option which sets default_textdomain. *)
+ Arg.parse [] go "";
+ output_translations !translations
diff --git a/test/test.ml b/test/test.ml
index bf59889..331c677 100644
--- a/test/test.ml
+++ b/test/test.ml
@@ -353,9 +353,7 @@ let compatibility_test tests =
(*******************************************)
let extract_test tests =
- let default_options =
- "-I +camlp4 pa_o.cmo"
- in
+ let default_options = "" in
let filename_options =
MapString.empty
in
--
2.22.0