Source file gettextModules.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
(**************************************************************************)
(*  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                                                                   *)
(**************************************************************************)

(**
    @author Sylvain Le Gall
  *)

open GettextTypes
open GettextCategory

(** Function for manipulation the type t *)

let upgrade_textdomain t k value =
  let current_codeset, current_dir =
    try MapTextdomain.find k t.textdomains with Not_found -> (None, None)
  in
  let new_value =
    match value with
    | None, None -> (current_codeset, current_dir)
    | None, new_dir -> (current_codeset, new_dir)
    | new_codeset, None -> (new_codeset, current_dir)
    | new_codeset, new_dir -> (new_codeset, new_dir)
  in
  { t with textdomains = MapTextdomain.add k new_value t.textdomains }

let create ?(failsafe = Ignore) ?(categories = []) ?(codesets = [])
    ?(dirs = []) ?(textdomains = []) ?(codeset = GettextConfig.default_codeset)
    ?(path = GettextConfig.default_path) ?language textdomain =
  let map_categories =
    List.fold_left
      (fun map (category, locale) -> MapCategory.add category locale map)
      MapCategory.empty categories
  in
  let result =
    {
      failsafe;
      textdomains = MapTextdomain.empty;
      categories = map_categories;
      language;
      codeset;
      path;
      default = textdomain;
    }
  in
  (* Apply any upgrade required by the different settings provided *)
  let apply_upgrade t lst =
    List.fold_left
      (fun t (textdomain, changes) -> upgrade_textdomain t textdomain changes)
      t lst
  in
  (* All changes from the setting of textdomains *)
  let textdomains_changes =
    List.map
      (fun textdomain -> (textdomain, (None, None)))
      (textdomain :: textdomains)
  in
  (* All changes from the setting of codesets *)
  let codesets_changes =
    List.map
      (fun (textdomain, codeset) -> (textdomain, (Some codeset, None)))
      codesets
  in
  (* All changes from the setting of dirs *)
  let dirs_changes =
    List.map (fun (textdomain, dir) -> (textdomain, (None, Some dir))) dirs
  in
  apply_upgrade result (textdomains_changes @ codesets_changes @ dirs_changes)