1/*  Part of Extended Libraries for SWI-Prolog
    2
    3    Author:        Edison Mera
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/xlibrary
    6    Copyright (C): 2014, Process Design Center, Breda, The Netherlands.
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(i18n_support, [current_pot_file/2,
   36                         i18n_to_translate/4,
   37                         i18n_process_term/4,
   38                         expand_i18n_term/4,
   39                         i18n_record/4,
   40                         current_i18n_record/4,
   41                         i18n_entry_expander/4,
   42                         i18n_entry/4,
   43                         reference/2,
   44                         language_t/1,
   45                         language/1,
   46                         i18n_entry_exact/4,
   47                         show_i18n_terms/1,
   48                         dictionary/1,
   49                         variable_name/1,
   50                         get_lang_file/2,
   51                         get_lang_file/3,
   52                         '=~'/2,
   53                         '~='/2,
   54                         '=~~'/2]).   55
   56:- use_module(library(lists)).   57:- use_module(library(apply)).   58:- use_module(library(pairs)).   59:- use_module(library(readutil)).   60:- use_module(library(clambda)).   61:- use_module(library(language_iso)).   62:- use_module(library(i18n/i18n_op)).   63:- use_module(library(i18n/i18n_parser)).   64:- init_expansors.   65
   66/*
   67
   68  Note: For variables, use this pattern: Trans= ~Var, This will allow
   69  to solve ~/1 at Run-Time and unify the translation of Var with
   70  Trans.  To force Run-Time translation, use Trans =~ Var. Note that
   71  =~/2 is the predicate that performs Run-Time translation, while ~/1
   72  is a term that is expanded to the translation at Compile-Time.
   73
   74  The system support one po file per several modules, but one module
   75  can not have several po files.  If there are no user resource file
   76  defined, nor a custom i18n_resource/1 declaration, the system will
   77  assume a separated po file per module using the module as base name
   78  as default using the predicate i18n_support:i18n_resource_dir/1.
   79
   80  Implementors: To extend current functionality, which nowadays is a
   81  minimum to cover basic needs, please read this before to start:
   82
   83  http://www.gnu.org/software/gettext/manual/gettext.html#PO-Files
   84
   85*/
   86
   87:- dynamic
   88    i18n_resource_dir/1,      % Global directory where the resources are stored.
   89    i18n_record/4,
   90    language/1,
   91    dictionary/1.   92
   93:- multifile
   94    i18n_resource_dir/1,
   95    i18n_resourceterm/2,
   96    i18n_resource/2,
   97    i18n_record/4,
   98    language/1,
   99    dictionary/1.               % for reverse translations, you can use more
  100                                % than one dictionary
  101
  102:- public
  103    i18n_resourceterm/2.  104
  105:- volatile i18n_record/4.  % Only useful during compilation and debugging, save
  106                            % space in the final binary.
  107
  108:- multifile variable_name/1. % Name of variable names that set the language
  109:- dynamic variable_name/1.  110
  111% Meta predicate declarations should be placed before its usage to allow correct
  112% expansion
  113
  114:- meta_predicate
  115    i18n_process_term(3,+,?,?),
  116    '=~'(-,:),
  117    '~='(-,:),
  118    '=~~'(-,:),
  119    i18n_entry(1,+,?,?),
  120    i18n_entry_exact(1,+,?,?),
  121    i18n_entry_partial(1,+,?,?),
  122    expand_i18n_term_trans(4,+,?,-),
  123    expand_i18n_term_rtrans(4,+,?,-),
  124    expand_i18n_term(4,+,?,-),
  125    expand_i18n_term_arg(+,2,+,?,?).  126
  127% Some standard places where the language is defined:
  128variable_name('LC_MESSAGES').
  129variable_name('LANG').
  130
  131language_t(Lang) :-
  132    language_iso(_, _, _, _, Lang, _, _, _, _, _).
 language(+Lang:language_t) is semidet
language(-Lang:language_t) is multi
if not defined, assume the system language or English. Although is not recommended, you can use several languages to look for translations.
  140language(Lang) :-
  141    ( 
  142      variable_name(AppVariable),
  143      getenv(AppVariable, X),   % Read from application specific
  144                                % language variable
  145      atom_codes(X, [C1, C2|_]),
  146      atom_codes(Lang, [C1, C2])
  147    ->true
  148    ; Lang = en                 % take English by default
  149    )
  149.
  150
  151% Operator that Allows Run-Time language translation:
  152
  153(Engl =~ M:Lang) :-
  154    i18n_process_term(i18n_entry(language), M, Lang, Engl).
  155
  156% Run-Time language reverse translation:
  157(Engl ~= M:Dict) :-
  158    i18n_process_term(\ X^D^E^i18n_entry(dictionary, X, E, D), M, Dict, Engl).
  159
  160(Term =~~ M:Term1) :-
  161    i18n_process_term(i18n_entry_dl, M, Term1, Term).
  162
  163i18n_entry_dl(M, Dict, Lang) :-
  164    ( Dict = [S|_], nonvar(S) ->
  165      i18n_entry(dictionary, M, Engl, Dict),
  166      i18n_entry(language,   M, Engl, Lang)
  167    ; i18n_entry(language,   M, Engl, Lang),
  168      i18n_entry(dictionary, M, Engl, Dict)
  169    ).
  170
  171/*
  172reference(Term, Ref) :-
  173        '$set_source_module'(M, M),
  174        ( Term = (Head :- _) -> functor(Head, F, A), PI = F/A
  175        ; Term = (:- Decl) -> functor(Decl, F, A), PI = (:- F/A)
  176        ; functor(Term, F, A), PI = F/A
  177        ),
  178        with_output_to(codes(Ref), M:PI).
  179*/
  180
  181reference(M, [Ref]) :- atom_codes(M, Ref).
  182
  183
  184i18n_entry(GLang, M, MsgId, MsgStr) :-
  185    ( i18n_entry_exact(GLang, M, MsgId, MsgStr) -> true
  186    ; i18n_entry_partial(GLang, M, MsgId, MsgStr)
  187    ).
  188
  189i18n_entry_exact_1(Lang, M, X, Y) :-
  190    once(i18n_record_2(M, Lang, [X], [Y])).
  191
  192i18n_entry_exact(GLang, M, MsgId, MsgStr) :-
  193    ( call(GLang, Lang),
  194      i18n_record_2(M, Lang, MsgId, MsgStr) -> true % 1. full translation
  195    ; call(GLang, Lang),        % 2. full list translation
  196      maplist(i18n_entry_exact_1(Lang, M), MsgId, MsgStr) -> true
  197    ).
  198
  199i18n_entry_partial(GLang, M, MsgId, MsgStr) :- % 3. partial translation
  200    maplist(i18n_record_3(M, GLang), MsgId, MsgStr).
  201
  202i18n_record_2(M, Lang, MsgId, MsgStr) :-
  203    (M1 = M ; true),            % Be flexible, module is not strict
  204    i18n_record(M1, Lang, MsgId, MsgStr).
  205
  206i18n_record_3(M, GLang, MsgId, MsgStr) :-
  207    ( call(GLang, Lang),
  208      i18n_record_2(M, Lang, [MsgId], [MsgStr]) -> true
  209    ; MsgStr = MsgId
  210    ).
  211
  212show_i18n_terms(M:Term) :-
  213    expand_i18n_term(show_i18n_term, M, Term, _).
  214
  215show_i18n_term(M, Op, MsgId, _) :-
  216    reference(M, Ref),
  217    maplist([Op]+\S^format(user_error, '~w~s~n', [Op, S]), Ref),
  218    nl(user_error),
  219    writeln(user_error, M),
  220    maplist([Op]+\S^format(user_error, '~w~s~n', [Op, S]), MsgId),
  221    nl(user_error).
  222
  223i18n_entry_expander((~), M, MsgId, MsgStr) :-
  224    i18n_entry(language, M, MsgId, MsgStr).
  225i18n_entry_expander((~~), M, MsgId, MsgStr) :-
  226    i18n_entry_dl(M, MsgId, MsgStr).
  227
  228expand_i18n_term_trans(_, _, Var1, ~Var2) :-
  229    var(Var1),
  230    var(Var2),
  231    Var1 = Var2,
  232    !.
  233expand_i18n_term_trans(Proc, _, M:Term, Translation) :- !,
  234    expand_i18n_term_trans(Proc, M, Term, Translation).
  235expand_i18n_term_trans(Proc, M, Term, Translation) :-
  236    i18n_process_term(call(Proc, (~)), M, Term, Translation).
  237
  238expand_i18n_term_rtrans(_, _, Var1, ~~Var2) :-
  239    var(Var1),
  240    var(Var2),
  241    Var1 = Var2,
  242    !.
  243expand_i18n_term_rtrans(Proc, _, M:Term, Translation) :- !,
  244    expand_i18n_term_rtrans(Proc, M, Term, Translation).
  245expand_i18n_term_rtrans(Proc, M, Term, Translation) :-
  246    i18n_process_term(call(Proc, (~~)), M, Term, Translation).
  247
  248expand_i18n_term(_, _, Var1, Var2) :-
  249    var(Var1),
  250    var(Var2),
  251    Var1=Var2,
  252    !.
  253expand_i18n_term(Proc, _, M:~Term, Translation) :- !,
  254    expand_i18n_term(Proc, M, ~Term, Translation).
  255expand_i18n_term(Proc, _, M:~~Term, Translation) :- !,
  256    expand_i18n_term(Proc, M, ~~Term, Translation).
  257expand_i18n_term(Proc, M, ~(Term), Translation) :- !,
  258    expand_i18n_term_trans(Proc, M, Term, Translation).
  259expand_i18n_term(Proc, M, ~~(Term), Translation) :- !,
  260    expand_i18n_term_rtrans(Proc, M, Term, Translation).
  261expand_i18n_term(Proc, M, Term1, Term) :-
  262    compound(Term1),
  263    functor(Term1, F, A),
  264    functor(Term, F, A), !,
  265    expand_i18n_term_arg(1, Proc, M, Term1, Term).
  266expand_i18n_term(_, _, Term, Term).
  267
  268expand_i18n_term_arg(N1, Proc, M, Term1, Term) :-
  269    arg(N1, Term1, Arg1), !,
  270    arg(N1, Term,  Arg),
  271    expand_i18n_term(Proc, M, Arg1, Arg),
  272    succ(N1, N),
  273    expand_i18n_term_arg(N, Proc, M, Term1, Term).
  274expand_i18n_term_arg(_, _, _, _, _).
  275
  276code(Code) :-
  277    integer(Code),
  278    Code >= 0,
  279    Code =< 0x7FFFFFFF,
  280    code_type(Code, _).
  281
  282i18n_process_term(Proc, M, Term, Tran) :-
  283    translation_keys_values(Term, Tran, Keys, Values),
  284    call(Proc, M, Keys, Values).
  285
  286translation_keys_values(Term, Tran, Keys, Values) :-
  287    ( nonvar(Tran)->NVTran=true ; NVTran=fail ),
  288    ( nonvar(Term)
  289    ->i18n_to_translate(Term, Tran, KeyValues, []),
  290      pairs_keys_values(KeyValues, Keys, Values)
  291    ; true
  292    ),
  293    ( NVTran==true
  294    ->i18n_to_translate(Tran, Term, ValueKeys, []),
  295      pairs_keys_values(ValueKeys, Values, Keys)
  296    ; true
  297    ).
  298
  299i18n_to_translate(Var, Var) -->
  300    {var(Var)},
  301    !.
  302i18n_to_translate([],   [])   --> !, [].
  303i18n_to_translate([C|String1], String) -->
  304    {maplist(code, [C|String1])},
  305    [[C|String1]-String],
  306    !.
  307i18n_to_translate(Term1, Term) -->
  308    { compound(Term1),
  309      functor(Term1, F, A),
  310      functor(Term, F, A)
  311    },
  312    !,
  313    i18n_to_translate_arg(1, Term1, Term).
  314i18n_to_translate(String1, String) -->
  315    { string(String1),
  316      string_codes(String1, Codes1),
  317      ( string(String) -> string_codes(String, Codes)
  318      ; freeze(Codes, string_codes(String, Codes))
  319      )
  320    },
  321    [Codes1-Codes],
  322    !.
  323i18n_to_translate(Atom1, Atom) -->
  324    { atom(Atom1),
  325      atom_codes(Atom1, Codes1),
  326      ( atom(Atom) -> atom_codes(Atom, Codes)
  327      ; freeze(Codes, atom_codes(Atom, Codes))
  328      )
  329    },
  330    [Codes1-Codes],
  331    !.
  332i18n_to_translate(Term, Term) --> [].
  333
  334i18n_to_translate_arg(N1, Term1, Term) -->
  335    { arg(N1, Term1, Arg1),
  336      !,
  337      arg(N1, Term, Arg)
  338    },
  339    i18n_to_translate(Arg1, Arg),
  340    {N is N1 + 1},
  341    i18n_to_translate_arg(N, Term1, Term).
  342i18n_to_translate_arg(_, _, _) --> [].
  343
  344% In prolog, reference would be Module:Pred/Name, Module:(TermScheme), ...
 resourceterm(+Term) is multi
Declaration. Tells the system that a string must be considered as a resource string, even if it don't appears in a ~/1 operator.
  351:- multifile user:prolog_file_type/2.  352:- dynamic   user:prolog_file_type/2.  353
  354user:prolog_file_type(pot, pot).
  355
  356/*
  357% Performance bug: this reads the file every time the predicate is
  358% consulted, tabling would be useful for this case. --EMM
  359
  360:- table i18n_record/4.         % Speed up, decrease complexity
  361i18n_record(M, Lang, MsgId, MsgStr) :-
  362    ( current_module(M) *->true ; true ),
  363    current_i18n_record(M, Lang1, MsgId1, MsgStr1),
  364    Lang = Lang1, MsgId = MsgId1, MsgStr = MsgStr1.
  365
  366:- table current_i18n_record/4.
  367*/
  368
  369current_i18n_record(M, Lang, MsgId, MsgStr) :-
  370    ( language(Lang)
  371    ; dictionary(Lang),
  372      \+ language(Lang)
  373    ),
  374    Lang \= en,
  375    current_pot_file(M, PotFile),
  376    reference(M, Ref),
  377    get_lang_file(PotFile, Lang, PoFile),
  378    access_file(PoFile, read),
  379    read_file_to_codes(PoFile, Codes, []),
  380    parse_po_entries(Entries, Codes, []),
  381    member(Entry, Entries),
  382    valid_entry(Ref, M, Entry),
  383    Entry = entry(_, _, _, _, MsgId, MsgStr).
  384
  385valid_entry(Ref, M, Entry) :-
  386    Entry \= entry(_, _, _, _, _, [""]),
  387    ( M = user -> true
  388    ; Entry = entry(_, _, Ref, _, _, _)
  389    ).
  390
  391get_lang_file(PotFile, PoFile) :-
  392    language(Lang),
  393    Lang \= en,
  394    get_lang_file(PotFile, Lang, PoFile).
  395
  396get_lang_file(PotFile, Lang, PoFile) :-
  397    atom_concat(PotBase, '.pot', PotFile),
  398    atom_concat(PotBase, '_', PotBase_),
  399    atom_concat(PotBase_, Lang, PoBase),
  400    atom_concat(PoBase, '.po', PoFile),
  401    !.
  402
  403% A pot file can contain info for several modules, but a module can
  404% use only one pot file
  405
  406:- multifile current_i18n_module/1. % Module that uses the i18n support
  407:- dynamic current_i18n_module/1.  408
  409current_pot_file(M, PotFile) :-
  410    (var(M) -> current_i18n_module(M) ; true),
  411    ( i18n_resource(M, PotAlias) -> true
  412    ; ( i18n_resource_dir(DirAlias)
  413      ->absolute_file_name(DirAlias, DirName),
  414        PotAlias = DirName/M
  415      ; module_property(M, file(File)),
  416        file_name_extension(PotAlias, _, File)
  417      ; PotAlias = '.'/M
  418      )
  419    ),
  420    absolute_file_name(PotAlias, PotFile, [file_type(pot)])