/usr/lib/ocaml/gettext-stub/gettextStub.ml is in libgettext-ocaml-dev 0.3.5-2build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 | (**************************************************************************)
(* 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 *)
(**************************************************************************)
(** Concrete implementation based on native gettext library.
@see <http://www.gnu.org/software/gettext/gettext.html/> Gettext library
@author Sylvain Le Gall
*)
(** {1 Concrete implementations} *)
open GettextTypes;;
open GettextUtils;;
open GettextCategory;;
(** Native implementation of gettext. All translation are bound to C library
call. Still use check_format, to ensure that strings follow printf format.
*)
module Native : GettextTypes.REALIZE_TYPE =
struct
(**/**)
let realize t =
(* Here we do the binding between C library call and the information we
have in parameter t. *)
let native_category_of_category cat =
match cat with
GettextCategory.LC_CTYPE -> GettextStubCompat.LC_CTYPE
| GettextCategory.LC_NUMERIC -> GettextStubCompat.LC_NUMERIC
| GettextCategory.LC_TIME -> GettextStubCompat.LC_TIME
| GettextCategory.LC_COLLATE -> GettextStubCompat.LC_COLLATE
| GettextCategory.LC_MONETARY -> GettextStubCompat.LC_MONETARY
| GettextCategory.LC_MESSAGES -> GettextStubCompat.LC_MESSAGES
| GettextCategory.LC_ALL -> GettextStubCompat.LC_ALL
in
let default_dir =
match t.path with
default_dir :: _ ->
Some default_dir
| [] ->
None
in
let bind_textdomain_one textdomain (codeset_opt,dir_opt) =
(
let codeset =
match codeset_opt with
Some codeset ->
codeset
| None ->
t.codeset
in
ignore(GettextStubCompat.bind_textdomain_codeset textdomain codeset)
);
(
match dir_opt with
| Some dir ->
ignore(GettextStubCompat.bindtextdomain textdomain dir)
| None ->
(
match default_dir with
| Some dir ->
ignore(GettextStubCompat.bindtextdomain textdomain dir)
| None ->
()
)
)
in
(* We only use the first path of t.path, since there is no notion of search path
in native gettext. So the MO file should be in :
- first component of t.path,
- directory pointed by bindtextdomain,
- default directory of gettext.
*)
let _ =
GettextStubCompat.textdomain t.default
in
let _ =
match t.language with
Some language ->
(
try
GettextStubCompat.setlocale GettextStubCompat.LC_ALL language
with Failure("setlocale(invalid localization)") as exc ->
let () =
fail_or_continue t.failsafe exc ()
in
GettextStubCompat.setlocale GettextStubCompat.LC_ALL ""
)
| None ->
GettextStubCompat.setlocale GettextStubCompat.LC_ALL ""
in
let () =
MapCategory.iter
(fun cat locale ->
ignore(GettextStubCompat.setlocale
(native_category_of_category cat) locale))
t.categories
in
let () =
MapTextdomain.iter bind_textdomain_one t.textdomains
in
fun printf_format textdomain_opt str_id str_plural_opt cat ->
let check x =
if printf_format then
match GettextFormat.check_format t.failsafe (Singular(str_id,x)) with
| Singular(_, str) -> str
| _ -> str_id
else
x
in
let ncat =
native_category_of_category cat
in
let textdomain =
match textdomain_opt with
Some textdomain ->
textdomain
| None ->
t.default
in
let translation =
match str_plural_opt with
Some(str_plural,n) ->
GettextStubCompat.dcngettext textdomain str_id str_plural n ncat
| None ->
GettextStubCompat.dcgettext textdomain str_id ncat
in
check translation
end
;;
(** Native implementation of gettext. Use the Native module, but use
informations provided to preload all textdomain translation. The preload
is made by trying to translate the string "", which is mandatory in MO file.
This is not the default behavior of gettext. Use this module if you know
that it is better to preload all string. Don't use this module if you think
you will only have a few strings to translate.
*)
module Preload : GettextTypes.REALIZE_TYPE =
struct
(**/**)
let realize t =
let t' = Native.realize t
in
let () =
MapTextdomain.iter
(fun textdomain _ ->
(* We only load LC_MESSAGES, since it is what is mainly use with
* gettext. Anyway, this is just a local optimization...
*)
ignore(t' false (Some textdomain) "" None LC_MESSAGES))
t.textdomains
in
t'
end
;;
|