diff options
Diffstat (limited to 'library/msgcat')
| -rw-r--r-- | library/msgcat/msgcat.tcl | 117 | ||||
| -rw-r--r-- | library/msgcat/pkgIndex.tcl | 4 |
2 files changed, 79 insertions, 42 deletions
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 3327bc6..f6c62a3 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -10,10 +10,10 @@ # 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.4.5 namespace eval msgcat { namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \ @@ -26,13 +26,14 @@ namespace eval msgcat { variable Loclist {} # 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 +159,7 @@ namespace eval msgcat { 77 so 0477 so_SO 78 sit 0478 sit_CN 79 pap 0479 pap_AN - } + }] } } @@ -190,20 +191,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 +224,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 +238,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 } @@ -274,13 +279,13 @@ proc msgcat::mcpreferences {} { proc msgcat::mcload {langdir} { 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 + uplevel 1 [list ::source -encoding utf-8 $langfile] } } return $x @@ -307,7 +312,9 @@ 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 } @@ -327,14 +334,15 @@ 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 @@ -359,7 +367,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 } @@ -380,10 +388,10 @@ proc msgcat::mcmax {args} { set max 0 foreach string $args { set translated [uplevel 1 [list [namespace origin mc] $string]] - set len [string length $translated] - if {$len>$max} { + set len [string length $translated] + if {$len>$max} { set max $len - } + } } return $max } @@ -425,9 +433,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 +444,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 +464,35 @@ 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, not used) + # -[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, 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\ + territory]} { + if {"" ne $territory} { + append locale _ $territory + } + 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 +508,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..60c2d3c 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.4.5 [list source [file join $dir msgcat.tcl]] |