(**************************************************************************)
(* 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 GettextUtils;;
open GettextTypes;;
open GettextMo;;
open FileUtil;;
open FilePath;;
(** empty_po : value representing an empty PO *)
let empty_po =
GettextPo_utils.empty_po
;;
(** add_po_translation_no_domain po (comment_lst,location_lst,translation) : add a translation
to a corpus of already defined translation with no domain defined. If the
translation already exist, they are merged concerning location, and
follow these rules for the translation itself :
- singular and singular : if there is an empty string ( "" ) in one
of the translation, use the other translation,
- plural and plural : if there is an empty string list ( [ "" ; "" ] ) in
one of the translaiton, use the other translation,
- singular and plural : merge into a plural form.
There is checks during the merge that can raise PoInconsistentMerge :
- for one singular string if the two plural strings differs
- if there is some elements that differs ( considering the special case of
the empty string ) in the translation
*)
let add_po_translation_no_domain po po_translation =
try
GettextPo_utils.add_po_translation_no_domain po po_translation
with PoInconsistentMerge(str1,str2) ->
raise (PoInconsistentMerge(str1,str2))
;;
(** add_po_translation_domain po domain (comment_lst,location_lst,translation) : add a
translation to the already defined translation with the domain defined.
See add_translation_no_domain for details.
*)
let add_po_translation_domain po domain po_translation =
try
GettextPo_utils.add_po_translation_domain po domain po_translation
with PoInconsistentMerge(str1,str2) ->
raise (PoInconsistentMerge(str1,str2))
;;
(** merge_po po1 po2 : merge two PO. The rule for merging are the same as
defined in add_po_translation_no_domain. Can raise PoInconsistentMerge
*)
let merge_po po1 po2 =
(* We take po2 as the initial set, we merge po1 into po2 beginning with
po1.no_domain and then po1.domain *)
let merge_no_domain =
MapString.fold (
fun _ translation po ->
add_po_translation_no_domain po translation
) po1.no_domain po2
in
let merge_one_domain domain map_domain po =
MapString.fold (
fun _ translation po ->
add_po_translation_domain domain po translation
) map_domain po
in
MapTextdomain.fold merge_one_domain po1.domain merge_no_domain
;;
(** merge_pot po pot : merge a PO with a POT. Only consider strings that
exists in the pot. Always use location as defined in the POT. If a string
is not found, use the translation provided in the POT. If a plural is found
and a singular should be used, downgrade the plural to singular. If a
singular is found and a plural should be used, upgrade singular to plural,
using the strings provided in the POT for ending the translation.
*)
let merge_pot pot po =
let order_po_map ?(domain) () =
match domain with
None ->
po.no_domain :: (
MapTextdomain.fold ( fun _ x lst -> x :: lst )
po.domain []
)
| Some domain ->
let tl =
po.no_domain :: (
MapTextdomain.fold (
fun key x lst ->
if key = domain then
lst
else
x :: lst
) po.domain []
)
in
try
(MapTextdomain.find domain po.domain) :: tl
with Not_found ->
tl
in
let merge_translation map_lst key commented_translation_pot =
let translation_pot =
commented_translation_pot.po_comment_translation
in
let translation_merged =
try
let (commented_translation_po) =
let map_po =
List.find (MapString.mem key) map_lst
in
MapString.find key map_po
in
let translation_po =
commented_translation_po.po_comment_translation
in
(* Implementation of the rule given above *)
match (translation_pot,translation_po) with
PoSingular(str_id,_), PoPlural(_, _, str :: _ ) ->
PoSingular(str_id, str)
| PoPlural(str_id, str_plural, _ :: tl ), PoSingular(_, str) ->
PoPlural(str_id, str_plural, str :: tl)
| PoPlural(str_id, str_plural, []), PoSingular(_, str) ->
PoPlural(str_id, str_plural, str :: [])
| _, translation ->
translation
with Not_found ->
(* Fallback to the translation provided in the POT *)
translation_pot
in
{
commented_translation_pot with
po_comment_translation = translation_merged
}
in
(* We begin with an empty po, and merge everything according to the rule
above. *)
let merge_no_domain =
MapString.fold (
fun key pot_translation po ->
add_po_translation_no_domain po
(merge_translation (order_po_map ()) key pot_translation)
) pot.no_domain empty_po
in
let merge_one_domain domain map_domain po =
MapString.fold (
fun key pot_translation po ->
add_po_translation_domain domain po
(merge_translation (order_po_map ~domain:domain ()) key pot_translation)
) map_domain po
in
MapTextdomain.fold merge_one_domain pot.domain merge_no_domain
;;
let input_po chn =
let lexbuf = Lexing.from_channel chn
in
try
GettextPo_parser.msgfmt GettextPo_lexer.token lexbuf
with
Parsing.Parse_error ->
raise (PoInvalidFile ("parse error",lexbuf,chn))
| Failure(s) ->
raise (PoInvalidFile (s,lexbuf,chn))
| PoInconsistentMerge(str1,str2) ->
raise (PoInconsistentMerge(str1,str2))
;;
let output_po chn po =
let comment_max_length =
80
in
let fpf x =
Printf.fprintf chn x
in
let escape_string str =
let rec escape_string_aux buff i =
if i < String.length str then
let () =
match String.get str i with
| '\n' -> Buffer.add_string buff "\\n"
| '\t' -> Buffer.add_string buff "\\t"
| '\b' -> Buffer.add_string buff "\\b"
| '\r' -> Buffer.add_string buff "\\r"
| '\012' -> Buffer.add_string buff "\\f"
| '\011' -> Buffer.add_string buff "\\v"
| '\007' -> Buffer.add_string buff "\\a"
| '"' -> Buffer.add_string buff "\\\""
| '\\' -> Buffer.add_string buff "\\\\"
| e ->
Buffer.add_char buff e
in
escape_string_aux buff (i+1)
else
(
)
in
let buff =
Buffer.create ((String.length str) + 2)
in
Buffer.add_char buff '"';
escape_string_aux buff 0;
Buffer.add_char buff '"';
Buffer.contents buff
in
let hyphens chn lst =
match lst with
[] ->
()
| lst ->
Printf.fprintf chn
"%s"
(String.concat "\n" (List.map escape_string lst))
in
let comment_line str_hyphen str_sep line_max_length token_lst =
let str_len =
(List.fold_left (fun acc str -> acc + (String.length str)) 0 token_lst)
+
((List.length token_lst) * (String.length str_sep))
in
let buff =
Buffer.create
(str_len + (String.length str_hyphen) * (str_len / line_max_length))
in
let rec comment_line_aux first_token line_length lst =
match lst with
| str :: tl ->
let sep_length =
if first_token then
0
else if (String.length str) + line_length > line_max_length then
(
Buffer.add_char buff '\n';
Buffer.add_string buff str_hyphen;
Buffer.add_string buff str_sep;
(String.length str_hyphen) + (String.length str_sep)
)
else
(
Buffer.add_string buff str_sep;
String.length str_sep
)
in
Buffer.add_string buff str;
comment_line_aux false (sep_length + (String.length str) + line_length) tl
| [] ->
Buffer.contents buff
in
comment_line_aux true 0 token_lst
in
let rec output_po_translation_aux _ commented_translation =
(
match commented_translation.po_comment_filepos with
| [] ->
()
| lst ->
fpf "%s\n"
(comment_line
"#."
" "
comment_max_length
("#:" :: (List.map (fun (str,line) -> Printf.sprintf "%s:%d" str line) lst)))
);
(
match commented_translation.po_comment_special with
| [] ->
()
| lst ->
fpf "%s\n"
(comment_line
"#."
" "
comment_max_length
("#," :: lst))
);
(
match commented_translation.po_comment_translation with
PoSingular(id,str) ->
(
fpf "msgid %a\n" hyphens id;
fpf "msgstr %a\n" hyphens str
)
| PoPlural(id,id_plural,lst) ->
(
fpf "msgid %a\n" hyphens id;
fpf "msgid_plural %a\n" hyphens id_plural;
let _ = List.fold_left
( fun i s ->
fpf "msgstr[%i] %a\n" i hyphens s;
i + 1
) 0 lst
in
()
)
);
fpf "\n"
in
MapString.iter output_po_translation_aux po.no_domain;
MapTextdomain.iter (
fun domain map ->
fpf "domain %S\n\n" domain;
MapString.iter output_po_translation_aux map
) po.domain
;;
let translation_of_po_translation po_translation =
match po_translation with
PoSingular(id, str) ->
Singular(String.concat "" id, String.concat "" str)
| PoPlural(id, id_plural, lst) ->
Plural (
String.concat "" id,
String.concat "" id_plural,
List.map (String.concat "") lst
)
;;