diff options
| -rw-r--r-- | changes | 5 | ||||
| -rw-r--r-- | library/msgcat/msgcat.tcl | 174 | ||||
| -rw-r--r-- | tests/msgcat.test | 93 |
3 files changed, 213 insertions, 59 deletions
@@ -8880,4 +8880,7 @@ in this changeset (new minor version) rather than bug fixes: --- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details -2017-12-11 (TIP 490) add oo support for msgcat => msgcat 1.7.0 (oehlmann) +2018-03-12 (TIP 490) add oo support for msgcat => msgcat 1.7.0 (oehlmann) + +2018-03-12 (TIP 499) custom locale preference list (nijtmans) +=> msgcat 1.7.0 diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 203a1bf..96b0110 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -20,7 +20,7 @@ namespace eval msgcat { namespace export mc mcn mcexists mcload mclocale mcmax\ mcmset mcpreferences mcset\ mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\ - mcpackagenamespaceget mcpackageconfig mcpackagelocale + mcpackagenamespaceget mcpackageconfig mcpackagelocale mcutil # Records the list of locales to search variable Loclist {} @@ -42,7 +42,13 @@ namespace eval msgcat { # namespace should be themselves dict values and the value is # the translated string. variable Msgs [dict create] +} +# create ensemble namespace for mcutil command +namespace eval msgcat::mcutil { + namespace export getsystemlocale getpreferences + namespace ensemble create -prefix 0 + # Map of language codes used in Windows registry to those of ISO-639 if {[info sharedlibextension] eq ".dll"} { variable WinRegToISO639 [dict create {*}{ @@ -331,32 +337,27 @@ proc msgcat::mclocale {args} { return -code error "invalid newLocale value \"$newLocale\":\ could be path to unsafe code." } - if {[lindex $Loclist 0] ne $newLocale} { - set Loclist [GetPreferences $newLocale] - - # locale not loaded jet - LoadAll $Loclist - # Invoke callback - Invoke changecmd $Loclist - } + mcpreferences {*}[mcutil getpreferences $newLocale] } return [lindex $Loclist 0] } -# msgcat::GetPreferences -- +# msgcat::mcutil::getpreferences -- # # Get list of locales from a locale. # The first element is always the lowercase locale. # Other elements have one component separated by "_" less. # Multiple "_" are seen as one separator: de__ch_spec de__ch de {} # +# This method is part of the ensemble mcutil +# # Arguments: # Locale. # # Results: # Locale list -proc msgcat::GetPreferences {locale} { +proc msgcat::mcutil::getpreferences {locale} { set locale [string tolower $locale] set loclist [list $locale] while {-1 !=[set pos [string last "_" $locale]]} { @@ -377,16 +378,51 @@ proc msgcat::GetPreferences {locale} { # most preferred to least preferred. # # Arguments: -# None. +# New location list # # Results: # Returns an ordered list of the locales preferred by the user. -proc msgcat::mcpreferences {} { +proc msgcat::mcpreferences {args} { variable Loclist + + if {[llength $args] > 0} { + # args is the new loclist + if {![ListEqualString $args $Loclist]} { + set Loclist $args + + # locale not loaded jet + LoadAll $Loclist + # Invoke callback + Invoke changecmd $Loclist + } + } return $Loclist } +# msgcat::ListStringEqual -- +# +# Compare two strings for equal string contents +# +# Arguments: +# list1 first list +# list2 second list +# +# Results: +# 1 if lists of strings are identical, 0 otherwise + +proc msgcat::ListEqualString {list1 list2} { + if {[llength $list1] != [llength $list2]} { + return 0 + } + foreach item1 $list1 item2 $list2 { + if {$item1 ne $item2} { + return 0 + } + } + return 1 +} + # msgcat::mcloadedlocales -- # # Get or change the list of currently loaded default locales @@ -470,7 +506,7 @@ proc msgcat::mcloadedlocales {subcommand} { # Results: # Empty string, if not stated differently for the subcommand -proc msgcat::mcpackagelocale {subcommand {locale ""}} { +proc msgcat::mcpackagelocale {subcommand args} { # todo: implement using an ensemble variable Loclist variable LoadedLocales @@ -478,27 +514,39 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} { variable PackageConfig # Check option # check if required item is exactly provided - if {[llength [info level 0]] == 2} { - # locale not given - unset locale - } else { - # locale given - if {$subcommand in - {"get" "isset" "unset" "preferences" "loaded" "clear"} } { - return -code error "wrong # args: should be\ - \"[lrange [info level 0] 0 1]\"" - } - set locale [string tolower $locale] + if { [llength $args] > 0 + && $subcommand in {"get" "isset" "unset" "loaded" "clear"} } { + return -code error "wrong # args: should be\ + \"[lrange [info level 0] 0 1]\"" } set ns [PackageNamespaceGet] switch -exact -- $subcommand { get { return [lindex [PackagePreferences $ns] 0] } - preferences { return [PackagePreferences $ns] } loaded { return [PackageLocales $ns] } - present { return [expr {$locale in [PackageLocales $ns]} ]} + present { + if {[llength $args] != 1} { + return -code error "wrong # args: should be\ + \"[lrange [info level 0] 0 1] locale\"" + } + return [expr {[string tolower [lindex $args 0]] + in [PackageLocales $ns]} ] + } isset { return [dict exists $PackageConfig loclist $ns] } - set { # set a package locale or add a package locale + set - preferences { + # set a package locale or add a package locale + set fSet [expr {$subcommand eq "set"}] + + # Check parameter + if {$fSet && 1 < [llength $args] } { + return -code error "wrong # args: should be\ + \"[lrange [info level 0] 0 1] ?locale?\"" + } + + # > Return preferences if no parameter + if {!$fSet && 0 == [llength $args] } { + return [PackagePreferences $ns] + } # Copy the default locale if no package locale set so far if {![dict exists $PackageConfig loclist $ns]} { @@ -506,25 +554,43 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} { dict set PackageConfig loadedlocales $ns $LoadedLocales } - # Check if changed - set loclist [dict get $PackageConfig loclist $ns] - if {! [info exists locale] || $locale eq [lindex $loclist 0] } { - return [lindex $loclist 0] + # No argument for set: return current package locale + # The difference to no argument and subcommand "preferences" is, + # that "preferences" does not set the package locale property. + # This case is processed above, so no check for fSet here + if { 0 == [llength $args] } { + return [lindex [dict get $PackageConfig loclist $ns] 0] + } + + # Get new loclist + if {$fSet} { + set loclist [mcutil getpreferences [lindex $args 0]] + } else { + set loclist $args + } + + # Check if not changed to return imediately + if { [ListEqualString $loclist\ + [dict get $PackageConfig loclist $ns]] } { + if {$fSet} { + return [lindex $loclist 0] + } + return $loclist } # Change loclist - set loclist [GetPreferences $locale] - set locale [lindex $loclist 0] dict set PackageConfig loclist $ns $loclist # load eventual missing locales set loadedLocales [dict get $PackageConfig loadedlocales $ns] - if {$locale in $loadedLocales} { return $locale } set loadLocales [ListComplement $loadedLocales $loclist] dict set PackageConfig loadedlocales $ns\ [concat $loadedLocales $loadLocales] Load $ns $loadLocales - return $locale + if {$fSet} { + return [lindex $loclist 0] + } + return $loclist } clear { # Remove all locales not contained in Loclist if {![dict exists $PackageConfig loclist $ns]} { @@ -1116,7 +1182,7 @@ proc msgcat::mcmax {args} { # Convert the locale values stored in environment variables to a form # suitable for passing to [mclocale] -proc msgcat::ConvertLocale {value} { +proc msgcat::mcutil::ConvertLocale {value} { # Assume $value is of form: $language[_$territory][.$codeset][@modifier] # Convert to form: $language[_$territory][_$modifier] # @@ -1176,7 +1242,7 @@ proc ::msgcat::PackageNamespaceGet {} { } # Initialize the default locale -proc msgcat::Init {} { +proc msgcat::mcutil::getsystemlocale {} { global env # @@ -1184,10 +1250,8 @@ proc msgcat::Init {} { # foreach varName {LC_ALL LC_MESSAGES LANG} { if {[info exists env($varName)] && ("" ne $env($varName))} { - if {![catch { - mclocale [ConvertLocale $env($varName)] - }]} { - return + if {![catch { ConvertLocale $env($varName) } locale]} { + return $locale } } } @@ -1195,10 +1259,8 @@ proc msgcat::Init {} { # On Darwin, fallback to current CFLocale identifier if available. # if {[info exists ::tcl::mac::locale] && $::tcl::mac::locale ne ""} { - if {![catch { - mclocale [ConvertLocale $::tcl::mac::locale] - }]} { - return + if {![catch { ConvertLocale $::tcl::mac::locale] } locale]} { + return $locale } } # @@ -1207,8 +1269,7 @@ proc msgcat::Init {} { # if {([info sharedlibextension] ne ".dll") || [catch {package require registry}]} { - mclocale C - return + return C } # # On Windows or Cygwin, try to set locale depending on registry @@ -1239,8 +1300,8 @@ proc msgcat::Init {} { if {[dict exists $modifierDict $script]} { append locale @ [dict get $modifierDict $script] } - if {![catch {mclocale [ConvertLocale $locale]}]} { - return + if {![catch {ConvertLocale $locale} locale]} { + return $locale } } } @@ -1249,8 +1310,7 @@ proc msgcat::Init {} { if {[catch { set locale [registry get $key "locale"] }]} { - mclocale C - return + return C } # # Keep trying to match against smaller and smaller suffixes @@ -1265,15 +1325,15 @@ proc msgcat::Init {} { set locale [string tolower $locale] while {[string length $locale]} { if {![catch { - mclocale [ConvertLocale [dict get $WinRegToISO639 $locale]] - }]} { - return + ConvertLocale [dict get $WinRegToISO639 $locale] + } localeOut]} { + return $localeOut } set locale [string range $locale 1 end] } # # No translation known. Fall back on "C" locale # - mclocale C + return C } -msgcat::Init +msgcat::mclocale [msgcat::mcutil getsystemlocale] diff --git a/tests/msgcat.test b/tests/msgcat.test index 7f872ed..7ab9bcf 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -194,6 +194,28 @@ namespace eval ::msgcat::test { mclocale looks/ok/../../../../but/is/path/to/evil/code } -returnCodes error -match glob -result {invalid newLocale value *} + test msgcat-1.14 {mcpreferences, custom locale preferences} -setup { + variable locale [mclocale] + mclocale en + mcpreferences fr en {} + } -cleanup { + mclocale $locale + } -body { + mcpreferences + } -result {fr en {}} + + test msgcat-1.15 {mcpreferences, overwrite custom locale preferences}\ + -setup { + variable locale [mclocale] + mcpreferences fr en {} + mclocale en + } -cleanup { + mclocale $locale + } -body { + mcpreferences + } -result {en {}} + + # Tests msgcat-2.*: [mcset], [mcmset], namespace partitioning test msgcat-2.1 {mcset, global scope} { @@ -833,13 +855,18 @@ namespace eval ::msgcat::test { test msgcat-12.1 {mcpackagelocale no subcommand} -body { mcpackagelocale } -returnCodes 1\ - -result {wrong # args: should be "mcpackagelocale subcommand ?locale?"} + -result {wrong # args: should be "mcpackagelocale subcommand ?arg ...?"} test msgcat-12.2 {mclpackagelocale wrong subcommand} -body { mcpackagelocale junk } -returnCodes 1\ -result {unknown subcommand "junk": must be clear, get, isset, loaded, present, set, or unset} + test msgcat-12.2.1 {mclpackagelocale set multiple args} -body { + mcpackagelocale set a b + } -returnCodes 1\ + -result {wrong # args: should be "mcpackagelocale set ?locale?"} + test msgcat-12.3 {mcpackagelocale set} -setup { variable locale [mclocale] } -cleanup { @@ -944,6 +971,30 @@ namespace eval ::msgcat::test { list [mcpackagelocale present foo] [mcpackagelocale present bar] } -result {0 1} + test msgcat-12.11 {mcpackagelocale custom preferences} -setup { + variable locale [mclocale] + } -cleanup { + mclocale $locale + mcforgetpackage + } -body { + mclocale foo + set res [list [mcpackagelocale preferences]] + mcpackagelocale preferences bar {} + lappend res [mcpackagelocale preferences] + } -result {{foo {}} {bar {}}} + + test msgcat-12.12 {mcpackagelocale preferences -> no isset} -setup { + variable locale [mclocale] + } -cleanup { + mclocale $locale + mcforgetpackage + } -body { + mclocale foo + mcpackagelocale preferences + mcpackagelocale isset + } -result {0} + + # Tests msgcat-13.*: [mcpackageconfig subcmds] test msgcat-13.1 {mcpackageconfig no subcommand} -body { @@ -1261,6 +1312,46 @@ namespace eval ::msgcat::test { interp bgerror {} $bgerrorsaved + # Tests msgcat-15.*: [mcutil] + + test msgcat-15.1 {mcutil - no argument} -body { + mcutil + } -returnCodes 1\ + -result {wrong # args: should be "mcutil subcommand ?arg ...?"} + + test msgcat-15.2 {mcutil - wrong argument} -body { + mcutil junk + } -returnCodes 1\ + -result {unknown subcommand "junk": must be getpreferences, or getsystemlocale} + + test msgcat-15.3 {mcutil - partial argument} -body { + mcutil getsystem + } -returnCodes 1\ + -result {unknown subcommand "getsystem": must be getpreferences, or getsystemlocale} + + test msgcat-15.4 {mcutil getpreferences - no argument} -body { + mcutil getpreferences + } -returnCodes 1\ + -result {wrong # args: should be "mcutil getpreferences locale"} + + test msgcat-15.5 {mcutil getpreferences - DE_de} -body { + mcutil getpreferences DE_de + } -result {de_de de {}} + + test msgcat-15.6 {mcutil getsystemlocale - wrong argument} -body { + mcutil getsystemlocale DE_de + } -returnCodes 1\ + -result {wrong # args: should be "mcutil getsystemlocale"} + + # The result is system dependent + # So just test if it runs + # The environment variable version was test with test 0.x + test msgcat-15.7 {mcutil getsystemlocale} -body { + mcutil getsystemlocale + set ok ok + } -result {ok} + + cleanupTests } namespace delete ::msgcat::test |