REBOL [
    Title: "Automatic script localization"
    Purpose: {
        Defines functions to preprocess REBOL scripts to extract
        values to be localized, and to localize them at runtime.
    }
    Author: "Gabriele Santilli"
    EMail: giesse@rebol.it
    File: %locale.r
    License: {
Copyright (c) 2003, Gabriele Santilli
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

* Redistributions of source code must retain the above copyright
  notice, this list of conditions and the following disclaimer. 
  
* Redistributions in binary form must reproduce the above
  copyright notice, this list of conditions and the following
  disclaimer in the documentation and/or other materials provided
  with the distribution. 

* The name of Gabriele Santilli may not be used to endorse or
  promote products derived from this software without specific
  prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
    }
    Date: 6-Sep-2004
    Version: 1.6.0 ; majorv.minorv.status
                   ; status: 0: unfinished; 1: testing; 2: stable
    History: [
         2-Jan-2004 1.1.0 "History start"
        26-Feb-2004 1.2.0 "Added documentation"
        26-Feb-2004 1.3.0 "Fixed no-autodoc definition of DOCUMENT"
        23-Apr-2004 1.4.0 "Added LIST-CATALOGS function"
        23-Apr-2004 1.5.0 "LIST-CATALOGS no more errors out if the catalogs dir does not exist"
         6-Sep-2004 1.6.0 "LIST-CATALOGS no more errors out if there's an invalid catalog in the dir"
    ]
]

; comment following line if you are using autodoc.r
;#do [document: func [text] [none]]

#do [document {
===Automatic script localization (locale.r)

The purpose of the functions defined in locale.r is to make it very easy
to localize existing scripts that were designed without localization in 
mind; this also means that when developing new scripts, very little effort
has to be devoted to localization considerations.

Our functions are able to "translate" any value, not just strings.

Note: do not use APPLY-CATALOG on this script.

---CREATE-CATALOG

The CREATE-CATALOG function scans a block for values that need to be
localized, and creates a catalog block. This catalog block can then be 
saved and used as a base for translations. (The result of this function
is basically the "built-in" catalog, so it is never needed as a real
catalog, since the values it contains are already present in the script
source.)

The function determines which values need to be translated by looking
for the #localize issue (can be abbreviated by just #l). If you want a
value in your scripts to be localized, you just need to prepend #l to it.
The grammar for the #l command is:
    [#l | #localize] opt word! skip
The optional word argument is used to determine the "context" of the value.
(Note that with this term we don't refer to REBOL contexts, but to a very
similar concept.) This is necessary because the same value may need to
be translated differently depending on its context. The default context
(if no context word is given) is 'COMMON. This means that:
    #l <some-value>
is equivalent to:
    #l common <some-value>

Note that because of the grammar, if you need to localize a WORD! value,
you always have to specify the context word. This means that you can't write:
    #l word ; wrong!
but you have to write:
    #l common word
Since the need for localizing words is quite rare, this should not be
considered a limitation.

Note also that this function uses a recursive PARSE rule to scan into
embedded blocks.
}]

create-catalog:
    func [
        "Create a catalog (to be translated) by scanning a block"
        block [block!]

        /local out rule emit val ctx
    ] [
        out: make block! 256
        emit: does [
            ctx: reduce [ctx :val]
            if not find/only/skip out ctx 2 [
                insert/only insert/only tail out ctx :val
            ]
        ]
        parse block rule: [
            any [
                [#l | #localize] [set ctx word! | (ctx: 'common)] set val skip (emit)
              | into rule
              | skip
            ]
        ]
        out
    ]

#do [document {
---APPLY-CATALOG

The APPLY-CATALOG function translates the values in the given block using
the translations provided with the catalog passed as first argument.
The catalog block must be in the same format as returned by CREATE-CATALOG.
This function will create a new block that is equal to the given block, except
for any occurrence of the #l command (see above), that is replaced with the
translation from the catalog block. For example,
    #l <some-value>
would be replaced by:
    <translation-of-some-value>

Note that this function calls itself recursively to process embedded blocks.
}]

apply-catalog:
    func [
        "Localize values in the block by applying the translations from the catalog (creates a new block)"
        catalog [block!] "Locale catalog"
        block [any-block!]

        /local out emit val ctx
    ] [
        out: make :block 2 + length? :block
        emit: func [value] [insert/only tail :out :value]
        parse :block [
            any [
                [#l | #localize] [set ctx word! | (ctx: 'common)] set val skip (emit translate catalog ctx :val)
              | set val any-block! (emit apply-catalog catalog :val)
              | set val skip (emit :val)
            ]
        ]
        :out
    ]

#do [document {
---TRANSLATE

The TRANSLATE function returns the translation of a value from a 
locale catalog. (This function is used by APPLY-CATALOG to translate
values.) If a translation for the value is not present in the catalog,
it is returned untranslated.
}]

translate:
    func [
        "Translate a value using locale catalog"
        catalog [block!]
        context [word!] "Value context (to allow different translations for the same value)"
        value
    ] [
        ; security measure: only allow to translate to a value of the same datatype
        either all [
            catalog: find/only/skip catalog reduce [context :value] 2
            equal? type? :value type? pick catalog 2
        ] [pick catalog 2] [:value]
    ]

#do [document {
---LIST-CATALOGS

The LIST-CATALOGS function returns a block of pairs; the first value
of each pair is a string!, with the language of the catalog; the
second value is a file! with the filename of the catalog. The first
pair is always the builtin language (the second value is NONE).
It is possible to specify the name for the builtin language using
the /builtin refinement (default to "English (builtin)"); the
/dir refinement can be used to specify the directory where
catalogs are present (default to %catalogs/).
}]

list-catalogs:
    func [
        "List available catalogs"
        /builtin bilanguage [string!] {Built in language (defaults to "English (builtin)")}
        /dir catdir [file!] "Catalogs dir (defaults to %catalogs/)"

        /local result header
    ] [
        result: make block! 32
        bilanguage: any [bilanguage "English (builtin)"]
        catdir: any [catdir %catalogs/]
        insert insert tail result bilanguage none
        foreach file any [attempt [read catdir] [ ]] [
            if all [
                script? catdir/:file
                object? header: attempt [pick load/next/header catdir/:file 1]
                header/type = 'catalog
            ] [
                insert insert tail result any [header/language header/title "Unknown language"] file
            ]
        ]
        result
    ]