diff options
Diffstat (limited to 'library/msgcat')
-rw-r--r-- | library/msgcat/msgcat.tcl | 195 | ||||
-rw-r--r-- | library/msgcat/pkgIndex.tcl | 4 |
2 files changed, 158 insertions, 41 deletions
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 3327bc6..112507a 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -10,14 +10,14 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.2 +package require Tcl 8.5 # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. -package provide msgcat 1.3.5 +package provide msgcat 1.5.0 namespace eval msgcat { namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \ - mcunknown + mcunknown mcflset mcflmset # Records the current locale as passed to mclocale variable Locale "" @@ -25,14 +25,18 @@ namespace eval msgcat { # Records the list of locales to search variable Loclist {} + # Records the locale of the currently sourced message catalogue file + variable FileLocale + # Records the mapping between source strings and translated strings. The - # array key is of the form "<locale>,<namespace>,<src>" and the value is + # dict key is of the form "<locale> <namespace> <src>", where locale and + # namespace should be themselves dict values and the value is # the translated string. - array set Msgs {} + variable Msgs [dict create] # Map of language codes used in Windows registry to those of ISO-639 if {[info sharedlibextension] eq ".dll"} { - array set WinRegToISO639 { + variable WinRegToISO639 [dict create {*}{ 01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ 1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY 2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH @@ -158,7 +162,7 @@ namespace eval msgcat { 77 so 0477 so_SO 78 sit 0478 sit_CN 79 pap 0479 pap_AN - } + }] } } @@ -190,20 +194,19 @@ proc msgcat::mc {src args} { while {$ns != ""} { foreach loc $Loclist { - if {[info exists Msgs($loc,$ns,$src)]} { + if {[dict exists $Msgs $loc $ns $src]} { if {[llength $args] == 0} { - return $Msgs($loc,$ns,$src) + return [dict get $Msgs $loc $ns $src] } else { - return [uplevel 1 \ - [linsert $args 0 ::format $Msgs($loc,$ns,$src)]] + return [format [dict get $Msgs $loc $ns $src] {*}$args] } } } set ns [namespace parent $ns] } # we have not found the translation - return [uplevel 1 \ - [linsert $args 0 [::namespace origin mcunknown] $Locale $src]] + return [uplevel 1 [list [namespace origin mcunknown] \ + $Locale $src {*}$args]] } # msgcat::mclocale -- @@ -224,7 +227,8 @@ proc msgcat::mclocale {args} { set len [llength $args] if {$len > 1} { - error {wrong # args: should be "mclocale ?newLocale?"} + return -code error "wrong # args: should be\ + \"[lindex [info level 0] 0] ?newLocale?\"" } if {$len == 1} { @@ -237,9 +241,13 @@ proc msgcat::mclocale {args} { set Loclist {} set word "" foreach part [split $Locale _] { - set word [string trimleft "${word}_${part}" _] - set Loclist [linsert $Loclist 0 $word] + set word [string trim "${word}_${part}" _] + if {$word ne [lindex $Loclist 0]} { + set Loclist [linsert $Loclist 0 $word] + } } + lappend Loclist {} + set Locale [lindex $Loclist 0] } return $Locale } @@ -272,17 +280,30 @@ proc msgcat::mcpreferences {} { # Returns the number of message catalogs that were loaded. proc msgcat::mcload {langdir} { + variable FileLocale + # Save the file locale if we are recursively called + if {[info exists FileLocale]} { + set nestedFileLocale $FileLocale + } set x 0 foreach p [mcpreferences] { + if { $p eq {} } { + set p ROOT + } set langfile [file join $langdir $p.msg] if {[file exists $langfile]} { incr x - set fid [open $langfile "r"] - fconfigure $fid -encoding utf-8 - uplevel 1 [read $fid] - close $fid + set FileLocale [string tolower [file tail [file rootname $langfile]]] + if {"root" eq $FileLocale} { + set FileLocale "" + } + uplevel 1 [list ::source -encoding utf-8 $langfile] + unset FileLocale } } + if {[info exists nestedFileLocale]} { + set FileLocale $nestedFileLocale + } return $x } @@ -307,7 +328,38 @@ proc msgcat::mcset {locale src {dest ""}} { set ns [uplevel 1 [list ::namespace current]] - set Msgs([string tolower $locale],$ns,$src) $dest + set locale [string tolower $locale] + + dict set Msgs $locale $ns $src $dest + return $dest +} + +# msgcat::mcflset -- +# +# Set the translation for a given string in the current file locale. +# +# Arguments: +# src The source string. +# dest (Optional) The translated string. If omitted, +# the source string is used. +# +# Results: +# Returns the new locale. + +proc msgcat::mcflset {src {dest ""}} { + variable FileLocale + variable Msgs + + if {![info exists FileLocale]} { + return -code error \ + "must only be used inside a message catalog loaded with ::msgcat::mcload" + } + if {[llength [info level 0]] == 2} { ;# dest not specified + set dest $src + } + + set ns [uplevel 1 [list ::namespace current]] + dict set Msgs $FileLocale $ns $src $dest return $dest } @@ -327,17 +379,49 @@ proc msgcat::mcmset {locale pairs } { set length [llength $pairs] if {$length % 2} { - error {bad translation list: should be "mcmset locale {src dest ...}"} + return -code error "bad translation list:\ + should be \"[lindex [info level 0] 0] locale {src dest ...}\"" } set locale [string tolower $locale] set ns [uplevel 1 [list ::namespace current]] foreach {src dest} $pairs { - set Msgs($locale,$ns,$src) $dest + dict set Msgs $locale $ns $src $dest } - return $length + return [expr {$length / 2}] +} + +# msgcat::mcflmset -- +# +# Set the translation for multiple strings in the mc file locale. +# +# Arguments: +# pairs One or more src/dest pairs (must be even length) +# +# Results: +# Returns the number of pairs processed + +proc msgcat::mcflmset {pairs} { + variable FileLocale + variable Msgs + + if {![info exists FileLocale]} { + return -code error \ + "must only be used inside a message catalog loaded with ::msgcat::mcload" + } + set length [llength $pairs] + if {$length % 2} { + return -code error "bad translation list:\ + should be \"[lindex [info level 0] 0] locale {src dest ...}\"" + } + + set ns [uplevel 1 [list ::namespace current]] + foreach {src dest} $pairs { + dict set Msgs $FileLocale $ns $src $dest + } + return [expr {$length / 2}] } # msgcat::mcunknown -- @@ -359,7 +443,7 @@ proc msgcat::mcmset {locale pairs } { proc msgcat::mcunknown {locale src args} { if {[llength $args]} { - return [uplevel 1 [linsert $args 0 ::format $src]] + return [format $src {*}$args] } else { return $src } @@ -425,9 +509,10 @@ proc msgcat::Init {} { # set default locale, try to get from environment # foreach varName {LC_ALL LC_MESSAGES LANG} { - if {[info exists env($varName)] - && ![string equal "" $env($varName)]} { - if {![catch {mclocale [ConvertLocale $env($varName)]}]} { + if {[info exists env($varName)] && ("" ne $env($varName))} { + if {![catch { + mclocale [ConvertLocale $env($varName)] + }]} { return } } @@ -435,19 +520,19 @@ proc msgcat::Init {} { # # On Darwin, fallback to current CFLocale identifier if available. # - if {[string equal $::tcl_platform(os) Darwin] - && [string equal $::tcl_platform(platform) unix] - && [info exists ::tcl::mac::locale] - && ![string equal $::tcl::mac::locale ""]} { - if {![catch {mclocale [ConvertLocale $::tcl::mac::locale]}]} { + if {[info exists ::tcl::mac::locale] && $::tcl::mac::locale ne ""} { + if {![catch { + mclocale [ConvertLocale $::tcl::mac::locale] + }]} { return } } # - # The rest of this routine is special processing for Windows; - # all other platforms, get out now. + # The rest of this routine is special processing for Windows or + # Cygwin. All other platforms, get out now. # - if {![string equal [info sharedlibextension] .dll]} { + if {([info sharedlibextension] ne ".dll") + || [catch {package require registry}]} { mclocale C return } @@ -455,9 +540,39 @@ proc msgcat::Init {} { # On Windows or Cygwin, try to set locale depending on registry # settings, or fall back on locale of "C". # + + # First check registry value LocalName present from Windows Vista + # which contains the local string as RFC5646, composed of: + # [a-z]{2,3} : language + # -[a-z]{4} : script (optional, translated by table Latn->latin) + # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used) + # (-.*)* : variant, extension, private use (optional, not used) + # Those are translated to local strings. + # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs@latin, es-419 -> es + # set key {HKEY_CURRENT_USER\Control Panel\International} - if {[catch {package require registry}] \ - || [catch {registry get $key "locale"} locale]} { + if {([registry values $key "LocaleName"] ne "") + && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\ + [string tolower [registry get $key "LocaleName"]] match locale\ + script territory]} { + if {"" ne $territory} { + append locale _ $territory + } + set modifierDict [dict create latn latin cyrl cyrillic] + if {[dict exists $modifierDict $script]} { + append locale @ [dict get $modifierDict $script] + } + if {![catch { + mclocale [ConvertLocale $locale] + }]} { + return + } + } + + # then check key locale which contains a numerical language ID + if {[catch { + set locale [registry get $key "locale"] + }]} { mclocale C return } @@ -473,7 +588,9 @@ proc msgcat::Init {} { variable WinRegToISO639 set locale [string tolower $locale] while {[string length $locale]} { - if {![catch {mclocale [ConvertLocale $WinRegToISO639($locale)]}]} { + if {![catch { + mclocale [ConvertLocale [dict get $WinRegToISO639 $locale]] + }]} { return } set locale [string range $locale 1 end] diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 280b8d2..832bf81 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ -if {![package vsatisfies [package provide Tcl] 8.2]} {return} -package ifneeded msgcat 1.3.5 [list source [file join $dir msgcat.tcl]] +if {![package vsatisfies [package provide Tcl] 8.5]} {return} +package ifneeded msgcat 1.5.0 [list source [file join $dir msgcat.tcl]] |