← Back to branch summary

~ubuntu-branches/ubuntu/lucid/ocaml-gettext/lucid

« back to all changes in this revision

Viewing changes to libgettext-ocaml/gettextDomain.ml

  • Committer: Bazaar Package Importer
  • Author(s): Sylvain Le Gall
  • Date: 2008-04-30 00:20:58 UTC
  • Revision ID: james.westby@ubuntu.com-20080430002058-y617t2epr9ba0b7e
Tags: upstream-0.3.0
Import upstream version 0.3.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
libgettext-ocaml/gettextDomain.ml
 
1
(**************************************************************************)
 
2
(*  ocaml-gettext: a library to translate messages                        *)
 
3
(*                                                                        *)
 
4
(*  Copyright (C) 2003-2008 Sylvain Le Gall <sylvain@le-gall.net>         *)
 
5
(*                                                                        *)
 
6
(*  This library is free software; you can redistribute it and/or         *)
 
7
(*  modify it under the terms of the GNU Lesser General Public            *)
 
8
(*  License as published by the Free Software Foundation; either          *)
 
9
(*  version 2.1 of the License, or (at your option) any later version;    *)
 
10
(*  with the OCaml static compilation exception.                          *)
 
11
(*                                                                        *)
 
12
(*  This library is distributed in the hope that it will be useful,       *)
 
13
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 
14
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
 
15
(*  Lesser General Public License for more details.                       *)
 
16
(*                                                                        *)
 
17
(*  You should have received a copy of the GNU Lesser General Public      *)
 
18
(*  License along with this library; if not, write to the Free Software   *)
 
19
(*  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307   *)
 
20
(*  USA                                                                   *)
 
21
(**************************************************************************)
 
22
 
 
23
(** Signature of module for domain management.
 
24
    @author Sylvain Le Gall
 
25
  *)
 
26
 
 
27
open FilePath;;
 
28
open FilePath.DefaultPath;;
 
29
open FileUtil;;
 
30
open FileUtil.StrUtil;;
 
31
open GettextTypes;;
 
32
open GettextUtils;;
 
33
open GettextCategory;;
 
34
 
 
35
(* BUG : a mettre � jour *)
 
36
(** compute_path textdomain category t : return the path to the 
 
37
    mo file corresponding to textdomain and category. Language is 
 
38
    guessed from category binding. If the textdomain is not found,
 
39
    it tries to use the build default to find the file. The file 
 
40
    returned exists and is readable. If such a file doesn't exists 
 
41
    an exception DomainFileDoesntExist is thrown. If the function is 
 
42
    unable to guess the current language an exception 
 
43
    DomainLanguageNotSet is thrown.
 
44
*)
 
45
 
 
46
let make_filename dir language category textdomain = 
 
47
  (* http://www.gnu.org/software/gettext/manual/html_mono/gettext.html#SEC148 
 
48
    dir_name/locale/LC_category/domain_name.mo *)
 
49
  make_filename [
 
50
    (* BUG : should use add_extension *)
 
51
    dir; language; string_of_category category; textdomain ^ ".mo" 
 
52
  ]
 
53
;;
 
54
 
 
55
 
 
56
let find t languages category textdomain = 
 
57
  let search_path =
 
58
    (
 
59
      try 
 
60
        match MapTextdomain.find textdomain t.textdomains with 
 
61
          (_,Some dir) -> [dir]
 
62
        | (_,None) -> []
 
63
      with Not_found ->
 
64
        []
 
65
      ) @ t.path
 
66
  in
 
67
  let ctest = test (And(Exists,Is_readable))
 
68
  in
 
69
  let rec find_mo_file_aux dir languages =
 
70
    match languages with 
 
71
     language :: tl ->
 
72
       let current_filename = make_filename dir language category textdomain
 
73
       in
 
74
       if ctest current_filename then
 
75
         current_filename
 
76
       else
 
77
         find_mo_file_aux dir tl
 
78
    |  [] ->
 
79
        raise Not_found
 
80
  in
 
81
  let rec find_mo_file path languages =
 
82
    match path with
 
83
      dir :: tl ->
 
84
        (
 
85
          try
 
86
            find_mo_file_aux dir languages
 
87
          with Not_found ->
 
88
            find_mo_file tl languages
 
89
        )
 
90
    | [] ->
 
91
        raise Not_found 
 
92
  in
 
93
  try
 
94
    find_mo_file search_path languages
 
95
  with Not_found ->
 
96
    raise (DomainFileDoesntExist(
 
97
        List.flatten (
 
98
          List.map ( 
 
99
            fun dir ->
 
100
              List.map (
 
101
                fun language ->
 
102
                  make_filename dir language category textdomain
 
103
            ) languages
 
104
          ) search_path
 
105
        )
 
106
      )
 
107
    )
 
108
;;