diff options
Diffstat (limited to 'library/msgcat/msgcat.tcl')
| -rw-r--r-- | library/msgcat/msgcat.tcl | 108 |
1 files changed, 61 insertions, 47 deletions
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 7e663cf..369ed52 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.4 +package provide msgcat 1.4.4 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 { [string equal $::tcl_platform(platform) windows] } { - array set WinRegToISO639 { + if { $::tcl_platform(platform) eq "windows" } { + 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 @@ -157,7 +158,7 @@ namespace eval msgcat { 77 so 0477 so_SO 78 sit 0478 sit_CN 79 pap 0479 pap_AN - } + }] } } @@ -174,7 +175,7 @@ namespace eval msgcat { # args Args to pass to the format command # # Results: -# Returns the translatd string. Propagates errors thrown by the +# Returns the translated string. Propagates errors thrown by the # format command. proc msgcat::mc {src args} { @@ -186,23 +187,22 @@ proc msgcat::mc {src args} { variable Locale set ns [uplevel 1 [list ::namespace current]] - + 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 -- @@ -223,7 +223,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} { @@ -236,9 +237,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 } @@ -273,13 +278,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 @@ -301,12 +306,14 @@ proc msgcat::mcload {langdir} { proc msgcat::mcset {locale src {dest ""}} { variable Msgs if {[llength [info level 0]] == 3} { ;# dest not specified - set dest $src + set dest $src } 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 } @@ -326,16 +333,17 @@ 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 } @@ -344,7 +352,7 @@ proc msgcat::mcmset {locale pairs } { # This routine is called by msgcat::mc if a translation cannot # be found for a string. This routine is intended to be replaced # by an application specific routine for error reporting -# purposes. The default behavior is to return the source string. +# purposes. The default behavior is to return the source string. # If additional args are specified, the format command will be used # to work them into the traslated string. # @@ -358,7 +366,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 } @@ -366,7 +374,7 @@ proc msgcat::mcunknown {locale src args} { # msgcat::mcmax -- # -# Calculates the maximun length of the translated strings of the given +# Calculates the maximum length of the translated strings of the given # list. # # Arguments: @@ -381,7 +389,7 @@ proc msgcat::mcmax {args} { set translated [uplevel 1 [list [namespace origin mc] $string]] set len [string length $translated] if {$len>$max} { - set max $len + set max $len } } return $max @@ -418,13 +426,16 @@ proc msgcat::ConvertLocale {value} { # Initialize the default locale proc msgcat::Init {} { + global env tcl_platform + # # 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 } } @@ -432,11 +443,10 @@ 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 } } @@ -444,17 +454,19 @@ proc msgcat::Init {} { # The rest of this routine is special processing for Windows; # all other platforms, get out now. # - if { ![string equal $::tcl_platform(platform) windows] } { + if {$tcl_platform(platform) ne "windows"} { mclocale C return } # # On Windows, try to set locale depending on registry settings, - # or fall back on locale of "C". + # or fall back on locale of "C". # - set key {HKEY_CURRENT_USER\Control Panel\International} - if {[catch {package require registry}] \ - || [catch {registry get $key "locale"} locale]} { + if {[catch { + package require registry + set key {HKEY_CURRENT_USER\Control Panel\International} + set locale [registry get $key "locale"] + }]} { mclocale C return } @@ -470,7 +482,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] |