/usr/lib/ocaml/gettext/gettextRealize.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 | (**************************************************************************)
(* 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 *)
(**************************************************************************)
(** Module type for the function realize.
@author Sylvain Le Gall
*)
open GettextTypes;;
open GettextUtils;;
open GettextCategory;;
module Generic : (
functor (Translate: GettextTranslate.TRANSLATE_TYPE) ->
functor (Charset: GettextCharset.CHARSET_TYPE) ->
functor (Locale: GettextLocale.LOCALE_TYPE) -> REALIZE_TYPE) =
functor (Translate: GettextTranslate.TRANSLATE_TYPE) ->
functor (Charset: GettextCharset.CHARSET_TYPE) ->
functor (Locale: GettextLocale.LOCALE_TYPE) ->
struct
module MapTranslate = Map.Make(struct
type t = textdomain * category
let compare (t1,c1) (t2,c2) =
match String.compare t1 t2 with
0 -> GettextCategory.compare c1 c2
| x -> x
end)
let add_textdomain_category t map_translate textdomain category =
try
let filename =
GettextDomain.find
t
(fst (Locale.get_locale t category))
category
textdomain
in
let in_enc =
let chn =
open_in_bin filename
in
let mo_header = GettextMo.input_mo_header chn
in
let mo_informations = GettextMo.input_mo_informations t.failsafe chn mo_header
in
close_in chn;
mo_informations.content_type_charset
in
let out_enc =
try
match (MapTextdomain.find textdomain t.textdomains) with
(Some codeset, _) -> codeset
| (None, _) -> snd (Locale.get_locale t category)
with Not_found ->
snd (Locale.get_locale t category)
in
let recode =
Charset.recode (Charset.create t in_enc out_enc)
in
MapTranslate.add
(textdomain,category)
(Translate.create t filename recode)
map_translate
with DomainFileDoesntExist(filenames) ->
map_translate
let add_textdomain t map_translate textdomain =
List.fold_left (
fun m category ->
add_textdomain_category t m textdomain category
) map_translate GettextCategory.categories
let realize t =
let map_translate =
MapTextdomain.fold (
fun textdomain _ m ->
add_textdomain t m textdomain
) t.textdomains MapTranslate.empty
in
let dummy_translate =
GettextTranslate.Dummy.create t "(none)" ( fun s -> s )
in
fun printf_format opt str plural_form category ->
(
let textdomain =
match opt with
Some textdomain -> textdomain
| None -> t.default
in
try
Translate.translate (
MapTranslate.find (textdomain,category) map_translate
) printf_format str plural_form
with Not_found ->
GettextTranslate.Dummy.translate
dummy_translate
printf_format str plural_form
)
end
;;
|