REBOL [
    Title:   "Dynamic Script Localization"
    Date:    06-Sep-2004
    Author:  ["Marco"]
    Version: 1.0.1
    Email:   [marco@ladyreb.org]
    File:    %locale.r
    Category: [tool]
    Library: [
        level: 'beginner
        platform: 'all
        type: [function tool]
        domain: [gui]
        tested-under: [win]
        support: marco@ladyreb.org
        license: PD
        see-also: none
    ]
    Purpose: {
        Locale.r extends the system/locale objet in order to supply a
        dynamique localization of applications
    }
    Modified: [
        [1.0.0 5-May-2004 marco@ladyreb.org {Création du programme}]
        [1.0.1 06-Aug-2004 marco@ladyreb.org {Add windows title automatic update}]
    ]
    Usage: {
    	do %locale.r
    	view/title layout [
 			rotary "English" "Français" [
 				set-locale/show  pick [french english] index? find face/texts face/text system/view/screen-face
			]
			text add-locale my-text [english "English text" french "Texte français"]
		]
    }
]

; ****************************
; Declare the public interface
; ****************************

set-locale: add-locale: load-locale: save-locale: none
slt: sla: none

; ***********************
; system/locale extension
; ***********************
system/locale: make system/locale [
    language: [english french] ; default translation languages, other language can be added
    default: 'english ; default is english
    current: none ; current is none. This value is set by the set-locale function
    text: []
    set 'slt :text

; *****************
; Translation table
; *****************

    translation: [
    
; General translation
		days [
	    	english ["Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"]
	    	french ["Lundi" "Mardi" "Mercredi" "Jeudi" "Vendredi" "Samedi" "Dimanche"]
    	]
    	months [
    		english ["January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"]
    		french ["Janvier" "Février" "Mars" "Avril" "Mai" "Juin" "Juillet" "Août" "Septembre" "Octobre" "Novembre" "Décembre"]
    	]
    	
; Translation for Rebol functions

        dialog [english "Dialog" french "Dialogue"] 
        yes [english "Yes" french "Oui"] 
        no [english "No" french "Non"] 
        cancel [english "Cancel" french "Annuler"]
        what-is-your-choice [english "What is your choice?" french "Quel est votre choix ?"]
        ok [english "OK" french "OK"]
        downloading-file [english "Downloading File:" french "Téléchargemnt de fichier :"]
		bytes [english "bytes" french "octets"]
		select-a-file [english "Select a File:"	french "Choisissez un fichier :"]
		select [english "Select" french "Selection"]
		custom [english "Custom" french "Custom"]
		enter-password [english "Enter password:" french "Entrez votre mot de passe :"]
		enter-username-and-password [english "Enter username and password:" french "Entrez votre nom et votre mot de passe:"]
		enter-user [english "User:" french "Utilisateur :"]
		enter-text-below [english "Enter text below:" french "Entrez du texte ci-dessous :"]

; Translation for standard window menu        

        file [english "File" french "Fichier"] 
            new [english "New" french "Nouveau"] 
            open [english "Open" french "Ouvrir"] 
            close [english "Close" french "Close"] 
            save [english "Save" french "Enregistrer"] 
            save-as [english "Save as" french "Enregistrer sous"] 
            print [english "Print" french "Imprimer"] 
            print-preview [english "Print preview" french "Apperçu avant impression"]
            print-setup [enplish "Print setup" french "Mise en page"]
        edit [english "Edit" french "Edition"]
            view [english "View" french "Vue"]
            cut [english "Cut" french "Couper"]
            copy [english "Copy" french "Copier"]
            paste [english "Paste" french "Coller"]
            find [english "Find" french "Rechercher"]
            replace [english "Replace" french "Remplacer"]
        insert [english "Insert" french "Insertion"]
        format [english "Format" french "Format"]
            font [english "Font" french "Police"]
            paragraph [english "Paragraph" french "Paragraphe"]
        tools [english "Tools" french "Outils"]
	    	options [english "Options" french "Options"]
	    windows [english "Windows" french "Fenêtre"]
	    	cascade [english "Cascade" french "Cascade"]
	    	tile-horizontal [english "Tile horizontal" french "Horizonzal"]
	    	tile-vertical [english "Tile vertical" french "Vertical"]
	    	mozaic [english "Mozaic" french "Mosaique"]
	]

; *******************************************************************************
; Add a localization for a word to the base and return the current language value
; *******************************************************************************

	set 'add-locale func [
		"Add a word localization"
		'word [word!] "A localized word"
		value [block!] "Block of Translation pair [language value ...]"
	][
		if not find translation word [
			insert tail translation reduce [word copy []]
		]
		change/only next find translation word value: union/skip value translation/:word 2
		set-text word value
		select text word
	]
	set 'sla :add-locale

; **********************************
; Set text to current language value
; **********************************

	set-text: func [
		word [word!]
		value [block!]
		/locale v
	][
		if not find text word [
			insert tail text reduce [
				word
				either block? second value [copy []] [copy ""]
			]
		]
		change clear head select text word v: any [
			select value current
			select value default
			either block? select text word [
				["< Undefined >"]
			][
				"< Undefined >"
			]
		]
		if word = 'months [
			repeat i 12 [
				change clear head months/:i v/:i
			]
		]
		if word = 'days [
			repeat i 7 [
				change clear head days/:i v/:i
			]
		]
	]
	
; ************************
; Load a localization file
; ************************

	set 'load-locale func [
		source [file! url! string! any-block! binary!]
	][
		foreach [word value] load source [
			add-locale :word probe value
		]
	]

; *************************
; Save to localization file
; *************************

	set 'save-locale func [
		where [file! url! binary!] "Where to save it."
	][
		save/header where translation compose [Title: "Rebol localization" Date: (now)]
	]

; *************
; Show the face
; *************

	show-face: func [
		face [object! block!]
	][
		if face = system/view/screen-face [
			face: face/pane
		]
		face: to-block face
		foreach item face [
			if item/text [
				item/changes: either item/changes [
					union [text]  to-block item/changes
				][
					[text]
				]
			]
			show item
		]
	]

; ********************
; Set current language
; ********************

	set 'set-locale func [
		language [word!] "Language to set"
		/show face [object! block!] "Face to show"
	][
		current: language
		foreach [word value] translation [
			set-text word value
		]
		if show [
			show-face face
		]
		language
	]
	set-locale default
]

; ***********************
; btn-enter redefinition
; ***********************

	use [tmp] [
		tmp: get-style 'btn-enter
		tmp/text: system/locale/text/ok
		tmp/texts: reduce [system/locale/text/ok]
	]

; ***********************
; btn-cancel redefinition
; ***********************

	use [tmp] [
		tmp: get-style 'btn-cancel
		tmp/text: system/locale/text/cancel
		tmp/texts: reduce [system/locale/text/cancel system/locale/text/cancel]
	]

; ****************************
; inform function redefinition
; ****************************

inform: func [
    {Display an exclusive focus panel for alerts, dialogs, and requestors.}
    panel [object!]
    /offset where [pair!] "Offset of panel"
    /title ttl [string!] "Dialog window title"
    /timeout time][
    panel/text: any [ttl system/locale/text/dialog]
    panel/offset: either offset [where] [system/view/screen-face/size - panel/size / 2]
    panel/feel: system/view/window-feel
    show-popup panel
    either time [wait time] [do-events]]


; *****************************
; request function redefinition
; *****************************

request: func [
    "Requests an answer to a simple question." 
    str [string! block! object! none!] 
    /offset xy 
    /ok 
    /only 
    /confirm 
    /type icon [word!] {Valid values are: alert, help (default), info, stop} 
    /timeout time 
    /local lay result msg y n c width f img][
    icon: any [icon all [none? icon any [ok timeout] 'info] 'help] 
    lay: either all [object? str in str 'type str/type = 'face] [str] [
        if none? str [str: system/locale/text/what-is-your-choice] 
        set [y n c] reduce [system/locale/text/yes system/locale/text/no system/locale/text/cancel] 
        if confirm [c: none] 
        if ok [y: system/locale/text/OK n: c: none] 
        if only [y: n: c: none] 
        if block? str [
            str: reduce str 
            set [str y n c] str 
            foreach n [str y n c] [
                if all [found? get n not string? get n] [set n form get n]]] 
        width: any [all [200 >= length? str 280] to-integer (length? str) - 200 / 50 * 20 + 280] 
        layout [f: text bold to-pair reduce [width 1000] str] 
        img: switch/default :icon [
            info [info.gif] 
            alert [exclamation.gif] 
            stop [stop.gif]] [help.gif] 
        result: copy [
            across 
            at 0x0 
            origin 15x10 
            image img 
            pad 0x12 
            guide 
            msg: text bold black str to-pair reduce [width -1] return 
            pad 4x12] 
        if y [append result [btn-enter 60 y first lowercase copy y [result: yes hide-popup]]] 
        if n [append result [btn 60 silver n first lowercase copy n [result: no hide-popup]]] 
        if c [append result [btn-cancel 60 c escape [result: none hide-popup]]] 
        layout result] 
    result: none 
    either offset [inform/offset/timeout lay xy time] [inform/timeout lay time] 
    result
]

; **************************************
; request-download function redefinition
; **************************************

request-download: func [
    {Request a file download from the net. Show progress. Return none on error.} 
    url [url!] 
    /to "Specify local file target." local-file [file! none!] 
    /local prog lo stop data stat event-port event][
    view/new center-face lo: layout [
        space 10x8 
        vh2 300 system/locale/text/downloading-file
        vtext bold center 300 to-string url 
        prog: progress 300 
        across 
        btn 90 system/locale/text/cancel [stop: true] 
        stat: text 160x24 middle] 
    stop: false 
    data: read-thru/to/progress/update url local-file func [total bytes] [
        prog/data: bytes / (max 1 total) 
        stat/text: reform [bytes system/locale/text/bytes] 
        show [prog stat] 
        not stop] 
    unview/only lo 
    if not stop [data]
]

; **********************************
; request-pass function redefinition
; **********************************

request-pass: func [
    "Requests a username and password." 
    /offset xy 
    /user username 
    /only "Password only." 
    /title title-text
][
    if none? user [username: copy ""] 
    pass-lay: layout compose [
        style tx text 40x24 middle right 
        across origin 10x10 space 2x4 
        h3 (either title [title-text] [either only [
        	system/locale/text/enter-password
        ] [
        	system/locale/text/enter-username-and-password
        ]]) 
        return 
        (either only [[]] [[tx system/locale/text/enter-user  userf: field username return]]) 
        tx "Pass:" pass: field hide [ok: yes hide-popup] with [flags: [return tabbed]] return 
        pad 140 
        btn-enter 50 system/locale/text/ok [ok: yes hide-popup] 
        btn-cancel 50 system/locale/text/cancel #"^[" [hide-popup]
    ] 
    ok: no 
    focus either only [pass] [userf] 
    either offset [inform/offset pass-lay xy] [inform pass-lay] 
    all [ok either only [pass/data] [reduce [userf/data pass/data]]]
]

; **********************************
; request-pass function redefinition
; **********************************

request-text: func [
    "Requests a text string be entered." 
    /offset xy 
    /title title-text 
    /default str
][
    if none? str [str: copy ""] 
    text-lay: layout compose [
        across origin 10x10 space 2x4 
        h3 bold (either title [title-text] [system/locale/text/enter-text-below]) 
        return 
        tf: field 300 str [ok: yes hide-popup] with [flags: [return]] return 
        pad 194 
        btn-enter 50 system/locale/text/ok [ok: yes hide-popup] 
        btn-cancel 50 system/locale/text/cancel #"^[" [hide-popup]
    ] 
    ok: no 
    focus tf 
    either offset [inform/offset text-lay xy] [inform text-lay] 
    all [ok tf/text]
]