Source file gettextRealize.ml

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
(**************************************************************************)
(*  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 GettextCategory

module Generic : functor
  (Translate : GettextTranslate.TRANSLATE_TYPE)
  (Charset : GettextCharset.CHARSET_TYPE)
  (Locale : GettextLocale.LOCALE_TYPE)
  -> REALIZE_TYPE =
functor
  (Translate : GettextTranslate.TRANSLATE_TYPE)
  (Charset : GettextCharset.CHARSET_TYPE)
  (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