summaryrefslogtreecommitdiffstats
path: root/library/msgcat/msgcat.tcl
diff options
context:
space:
mode:
authoroehhar <harald.oehlmann@elmicron.de>2015-06-29 21:44:12 (GMT)
committeroehhar <harald.oehlmann@elmicron.de>2015-06-29 21:44:12 (GMT)
commitcdbe969ea378527a9002c3a5ab21465c7a79fc4b (patch)
tree75dd7a541f1b0cb16d9f5dc034fdd53c9ca52d03 /library/msgcat/msgcat.tcl
parent5ca8732b1e45a8588bb205f11c8a0b1a510de4ea (diff)
parent499e061468e49ed8f794593938749e0ce797405e (diff)
downloadtcl-cdbe969ea378527a9002c3a5ab21465c7a79fc4b.zip
tcl-cdbe969ea378527a9002c3a5ab21465c7a79fc4b.tar.gz
tcl-cdbe969ea378527a9002c3a5ab21465c7a79fc4b.tar.bz2
[TIP 412] msgcat dynamic locale change and package private locale (msgcat 1.6.0)
Diffstat (limited to 'library/msgcat/msgcat.tcl')
-rw-r--r--library/msgcat/msgcat.tcl731
1 files changed, 668 insertions, 63 deletions
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index cf3b9d7..5ed9f3a 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -4,6 +4,7 @@
# message catalog facility for Tcl programs. It should be
# loaded with the command "package require msgcat".
#
+# Copyright (c) 2010-2015 by Harald Oehlmann.
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 1998 by Mark Harrison.
#
@@ -13,23 +14,30 @@
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.5.2
+package provide msgcat 1.6.0
namespace eval msgcat {
- namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
- mcunknown mcflset mcflmset
-
- # Records the current locale as passed to mclocale
- variable Locale ""
+ namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences mcset\
+ mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\
+ mcpackageconfig mcpackagelocale
# Records the list of locales to search
variable Loclist {}
+ # List of currently loaded locales
+ variable LoadedLocales {}
+
# Records the locale of the currently sourced message catalogue file
variable FileLocale
+ # Configuration values per Package (e.g. client namespace).
+ # The dict key is of the form "<option> <namespace>" and the value is the
+ # configuration option. A nonexisting key is an unset option.
+ variable PackageConfig [dict create mcfolder {} loadcmd {} changecmd {}\
+ unknowncmd {} loadedlocales {} loclist {}]
+
# Records the mapping between source strings and translated strings. The
- # dict key is of the form "<locale> <namespace> <src>", where locale and
+ # dict key is of the form "<namespace> <locale> <src>", where locale and
# namespace should be themselves dict values and the value is
# the translated string.
variable Msgs [dict create]
@@ -173,6 +181,8 @@ namespace eval msgcat {
# parent namespace until the source is found. If additional args are
# specified, use the format command to work them into the traslated
# string.
+# If no catalog item is found, mcunknown is called in the caller frame
+# and its result is returned.
#
# Arguments:
# src The string to translate.
@@ -183,30 +193,86 @@ namespace eval msgcat {
# format command.
proc msgcat::mc {src args} {
+ # this may be replaced by:
+ # return [mcget -namespace [uplevel 1 [list ::namespace current]] --\
+ # $src {*}$args]
+
# Check for the src in each namespace starting from the local and
# ending in the global.
variable Msgs
variable Loclist
- variable Locale
set ns [uplevel 1 [list ::namespace current]]
+ set loclist [PackagePreferences $ns]
- while {$ns != ""} {
- foreach loc $Loclist {
- if {[dict exists $Msgs $loc $ns $src]} {
- if {[llength $args] == 0} {
- return [dict get $Msgs $loc $ns $src]
- } else {
- return [format [dict get $Msgs $loc $ns $src] {*}$args]
- }
+ set nscur $ns
+ while {$nscur != ""} {
+ foreach loc $loclist {
+ if {[dict exists $Msgs $nscur $loc $src]} {
+ return [DefaultUnknown "" [dict get $Msgs $nscur $loc $src]\
+ {*}$args]
}
}
+ set nscur [namespace parent $nscur]
+ }
+ # call package local or default unknown command
+ set args [linsert $args 0 [lindex $loclist 0] $src]
+ switch -exact -- [Invoke unknowncmd $args $ns result 1] {
+ 0 { return [uplevel 1 [linsert $args 0 [namespace origin mcunknown]]] }
+ 1 { return [DefaultUnknown {*}$args] }
+ default { return $result }
+ }
+}
+
+# msgcat::mcexists --
+#
+# Check if a catalog item is set or if mc would invoke mcunknown.
+#
+# Arguments:
+# -exactnamespace Only check the exact namespace and no
+# parent namespaces
+# -exactlocale Only check the exact locale and not all members
+# of the preferences list
+# src Message catalog key
+#
+# Results:
+# true if an adequate catalog key was found
+
+proc msgcat::mcexists {args} {
+
+ variable Msgs
+ variable Loclist
+ variable PackageConfig
+
+ set ns [uplevel 1 [list ::namespace current]]
+ set loclist [PackagePreferences $ns]
+
+ while {[llength $args] != 1} {
+ set args [lassign $args option]
+ switch -glob -- $option {
+ -exactnamespace { set exactnamespace 1 }
+ -exactlocale { set loclist [lrange $loclist 0 0] }
+ -* { return -code error "unknown option \"$option\"" }
+ default {
+ return -code error "wrong # args: should be\
+ \"[lindex [info level 0] 0] ?-exactnamespace?\
+ ?-exactlocale? src\""
+ }
+ }
+ }
+ set src [lindex $args 0]
+
+ while {$ns ne ""} {
+ foreach loc $loclist {
+ if {[dict exists $Msgs $ns $loc $src]} {
+ return 1
+ }
+ }
+ if {[info exists exactnamespace]} {return 0}
set ns [namespace parent $ns]
}
- # we have not found the translation
- return [uplevel 1 [list [namespace origin mcunknown] \
- $Locale $src {*}$args]]
+ return 0
}
# msgcat::mclocale --
@@ -219,11 +285,11 @@ proc msgcat::mc {src args} {
# separated by underscores (e.g. en_US).
#
# Results:
-# Returns the current locale.
+# Returns the normalized set locale.
proc msgcat::mclocale {args} {
variable Loclist
- variable Locale
+ variable LoadedLocales
set len [llength $args]
if {$len > 1} {
@@ -232,24 +298,49 @@ proc msgcat::mclocale {args} {
}
if {$len == 1} {
- set newLocale [lindex $args 0]
+ set newLocale [string tolower [lindex $args 0]]
if {$newLocale ne [file tail $newLocale]} {
return -code error "invalid newLocale value \"$newLocale\":\
could be path to unsafe code."
}
- set Locale [string tolower $newLocale]
- set Loclist {}
- set word ""
- foreach part [split $Locale _] {
- set word [string trim "${word}_${part}" _]
- if {$word ne [lindex $Loclist 0]} {
- set Loclist [linsert $Loclist 0 $word]
- }
+ if {[lindex $Loclist 0] ne $newLocale} {
+ set Loclist [GetPreferences $newLocale]
+
+ # locale not loaded jet
+ LoadAll $Loclist
+ # Invoke callback
+ Invoke changecmd $Loclist
+ }
+ }
+ return [lindex $Loclist 0]
+}
+
+# msgcat::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 {}
+#
+# Arguments:
+# Locale.
+#
+# Results:
+# Locale list
+
+proc msgcat::GetPreferences {locale} {
+ set locale [string tolower $locale]
+ set loclist [list $locale]
+ while {-1 !=[set pos [string last "_" $locale]]} {
+ set locale [string range $locale 0 $pos-1]
+ if { "_" ne [string index $locale end] } {
+ lappend loclist $locale
}
- lappend Loclist {}
- set Locale [lindex $Loclist 0]
}
- return $Locale
+ if {"" ne [lindex $loclist end]} {
+ lappend loclist {}
+ }
+ return $loclist
}
# msgcat::mcpreferences --
@@ -268,6 +359,391 @@ proc msgcat::mcpreferences {} {
return $Loclist
}
+# msgcat::mcloadedlocales --
+#
+# Get or change the list of currently loaded default locales
+#
+# The following subcommands are available:
+# loaded
+# Get the current list of loaded locales
+# clear
+# Remove all loaded locales not present in mcpreferences.
+#
+# Arguments:
+# subcommand One of loaded or clear
+#
+# Results:
+# Empty string, if not stated differently for the subcommand
+
+proc msgcat::mcloadedlocales {subcommand} {
+ variable Loclist
+ variable LoadedLocales
+ variable Msgs
+ variable PackageConfig
+ switch -exact -- $subcommand {
+ clear {
+ # Remove all locales not contained in Loclist
+ # skip any packages with package locale
+ set LoadedLocales $Loclist
+ foreach ns [dict keys $Msgs] {
+ if {![dict exists $PackageConfig loclist $ns]} {
+ foreach locale [dict keys [dict get $Msgs $ns]] {
+ if {$locale ni $Loclist} {
+ dict unset Msgs $ns $locale
+ }
+ }
+ }
+ }
+ }
+ loaded { return $LoadedLocales }
+ default {
+ return -code error "unknown subcommand \"$subcommand\": must be\
+ clear, or loaded"
+ }
+ }
+ return
+}
+
+# msgcat::mcpackagelocale --
+#
+# Get or change the package locale of the calling package.
+#
+# The following subcommands are available:
+# set
+# Set a package locale.
+# This may load message catalog files and may clear message catalog
+# items, if the former locale was the default locale.
+# Returns the normalized set locale.
+# The default locale is taken, if locale is not given.
+# get
+# Get the locale valid for this package.
+# isset
+# Returns true, if a package locale is set
+# unset
+# Unset the package locale and activate the default locale.
+# This loads message catalog file which where missing in the package
+# locale.
+# preferences
+# Return locale preference list valid for the package.
+# loaded
+# Return loaded locale list valid for the current package.
+# clear
+# If the current package has a package locale, remove all package
+# locales not containes in package mcpreferences.
+# It is an error to call this without a package locale set.
+#
+# The subcommands get, preferences and loaded return the corresponding
+# default data, if no package locale is set.
+#
+# Arguments:
+# subcommand see list above
+# locale package locale (only set subcommand)
+#
+# Results:
+# Empty string, if not stated differently for the subcommand
+
+proc msgcat::mcpackagelocale {subcommand {locale ""}} {
+ # todo: implement using an ensemble
+ variable Loclist
+ variable LoadedLocales
+ variable Msgs
+ 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]
+ }
+ set ns [uplevel 1 {::namespace current}]
+
+ switch -exact -- $subcommand {
+ get { return [lindex [PackagePreferences $ns] 0] }
+ preferences { return [PackagePreferences $ns] }
+ loaded { return [PackageLocales $ns] }
+ present { return [expr {$locale in [PackageLocales $ns]} ]}
+ isset { return [dict exists $PackageConfig loclist $ns] }
+ set { # set a package locale or add a package locale
+
+ # Copy the default locale if no package locale set so far
+ if {![dict exists $PackageConfig loclist $ns]} {
+ dict set PackageConfig loclist $ns $Loclist
+ 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]
+ }
+
+ # 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
+ }
+ clear { # Remove all locales not contained in Loclist
+ if {![dict exists $PackageConfig loclist $ns]} {
+ return -code error "clear only when package locale set"
+ }
+ set loclist [dict get $PackageConfig loclist $ns]
+ dict set PackageConfig loadedlocales $ns $loclist
+ if {[dict exists $Msgs $ns]} {
+ foreach locale [dict keys [dict get $Msgs $ns]] {
+ if {$locale ni $loclist} {
+ dict unset Msgs $ns $locale
+ }
+ }
+ }
+ }
+ unset { # unset package locale and restore default locales
+
+ if { ![dict exists $PackageConfig loclist $ns] } { return }
+
+ # unset package locale
+ set loadLocales [ListComplement\
+ [dict get $PackageConfig loadedlocales $ns] $LoadedLocales]
+ dict unset PackageConfig loadedlocales $ns
+ dict unset PackageConfig loclist $ns
+
+ # unset keys not in global loaded locales
+ if {[dict exists $Msgs $ns]} {
+ foreach locale [dict keys [dict get $Msgs $ns]] {
+ if {$locale ni $LoadedLocales} {
+ dict unset Msgs $ns $locale
+ }
+ }
+ }
+
+ # Add missing locales
+ Load $ns $loadLocales
+ }
+ default {
+ return -code error "unknown subcommand \"$subcommand\": must be\
+ clear, get, isset, loaded, present, set, or unset"
+ }
+ }
+ return
+}
+
+# msgcat::mcforgetpackage --
+#
+# Remove any data of the calling package from msgcat
+#
+
+proc msgcat::mcforgetpackage {} {
+ # todo: this may be implemented using an ensemble
+ variable PackageConfig
+ variable Msgs
+ set ns [uplevel 1 {::namespace current}]
+ # Remove MC items
+ dict unset Msgs $ns
+ # Remove config items
+ foreach key [dict keys $PackageConfig] {
+ dict unset PackageConfig $key $ns
+ }
+ return
+}
+
+# msgcat::mcpackageconfig --
+#
+# Get or modify the per caller namespace (e.g. packages) config options.
+#
+# Available subcommands are:
+#
+# get get the current value or an error if not set.
+# isset return true, if the option is set
+# set set the value (see also distinct option).
+# Returns the number of loaded message files.
+# unset Clear option. return "".
+#
+# Available options are:
+#
+# mcfolder
+# The message catalog folder of the package.
+# This is automatically set by mcload.
+# If the value is changed using the set subcommand, an evntual
+# loadcmd is invoked and all message files of the package locale are
+# loaded.
+#
+# loadcmd
+# The command gets executed before a message file would be
+# sourced for this module.
+# The command is invoked with the expanded locale list to load.
+# The command is not invoked if the registering package namespace
+# is not present.
+# This callback might also be used as an alternative to message
+# files.
+# If the value is changed using the set subcommand, the callback is
+# directly invoked with the current file locale list. No file load is
+# executed.
+#
+# changecmd
+# The command is invoked, after an executed locale change.
+# Appended argument is expanded mcpreferences.
+#
+# unknowncmd
+# Use a package locale mcunknown procedure instead the global one.
+# The appended arguments are identical to mcunknown.
+# A default unknown handler is used if set to the empty string.
+# This consists in returning the key if no arguments are given.
+# With given arguments, format is used to process the arguments.
+#
+# Arguments:
+# subcommand Operation on the package
+# option The package option to get or set.
+# ?value? Eventual value for the subcommand
+#
+# Results:
+# Depends on the subcommand and option and is described there
+
+proc msgcat::mcpackageconfig {subcommand option {value ""}} {
+ variable PackageConfig
+ # get namespace
+ set ns [uplevel 1 {::namespace current}]
+
+ if {$option ni {"mcfolder" "loadcmd" "changecmd" "unknowncmd"}} {
+ return -code error "bad option \"$option\": must be mcfolder, loadcmd,\
+ changecmd, or unknowncmd"
+ }
+
+ # check if value argument is exactly provided
+ if {[llength [info level 0]] == 4 } {
+ # value provided
+ if {$subcommand in {"get" "isset" "unset"}} {
+ return -code error "wrong # args: should be\
+ \"[lrange [info level 0] 0 2] value\""
+ }
+ } elseif {$subcommand eq "set"} {
+ return -code error\
+ "wrong # args: should be \"[lrange [info level 0] 0 2]\""
+ }
+
+ # Execute subcommands
+ switch -exact -- $subcommand {
+ get { # Operation get return current value
+ if {![dict exists $PackageConfig $option $ns]} {
+ return -code error "package option \"$option\" not set"
+ }
+ return [dict get $PackageConfig $option $ns]
+ }
+ isset { return [dict exists $PackageConfig $option $ns] }
+ unset { dict unset PackageConfig $option $ns }
+ set { # Set option
+
+ if {$option eq "mcfolder"} {
+ set value [file normalize $value]
+ }
+ # Check if changed
+ if { [dict exists $PackageConfig $option $ns]
+ && $value eq [dict get $PackageConfig $option $ns] } {
+ return 0
+ }
+
+ # set new value
+ dict set PackageConfig $option $ns $value
+
+ # Reload pending message catalogs
+ switch -exact -- $option {
+ mcfolder { return [Load $ns [PackageLocales $ns]] }
+ loadcmd { return [Load $ns [PackageLocales $ns] 1] }
+ }
+ return 0
+ }
+ default {
+ return -code error "unknown subcommand \"$subcommand\":\
+ must be get, isset, set, or unset"
+ }
+ }
+ return
+}
+
+# msgcat::PackagePreferences --
+#
+# Return eventual present package preferences or the default list if not
+# present.
+#
+# Arguments:
+# ns Package namespace
+#
+# Results:
+# locale list
+
+proc msgcat::PackagePreferences {ns} {
+ variable PackageConfig
+ if {[dict exists $PackageConfig loclist $ns]} {
+ return [dict get $PackageConfig loclist $ns]
+ }
+ variable Loclist
+ return $Loclist
+}
+
+# msgcat::PackageLocales --
+#
+# Return eventual present package locales or the default list if not
+# present.
+#
+# Arguments:
+# ns Package namespace
+#
+# Results:
+# locale list
+
+proc msgcat::PackageLocales {ns} {
+ variable PackageConfig
+ if {[dict exists $PackageConfig loadedlocales $ns]} {
+ return [dict get $PackageConfig loadedlocales $ns]
+ }
+ variable LoadedLocales
+ return $LoadedLocales
+}
+
+# msgcat::ListComplement --
+#
+# Build the complement of two lists.
+# Return a list with all elements in list2 but not in list1.
+# Optionally return the intersection.
+#
+# Arguments:
+# list1 excluded list
+# list2 included list
+# inlistname If not "", write in this variable the intersection list
+#
+# Results:
+# list with all elements in list2 but not in list1
+
+proc msgcat::ListComplement {list1 list2 {inlistname ""}} {
+ if {"" ne $inlistname} {
+ upvar 1 $inlistname inlist
+ }
+ set inlist {}
+ set outlist {}
+ foreach item $list2 {
+ if {$item in $list1} {
+ lappend inlist $item
+ } else {
+ lappend outlist $item
+ }
+ }
+ return $outlist
+}
+
# msgcat::mcload --
#
# Attempt to load message catalogs for each locale in the
@@ -280,24 +756,88 @@ proc msgcat::mcpreferences {} {
# Returns the number of message catalogs that were loaded.
proc msgcat::mcload {langdir} {
+ return [uplevel 1 [list\
+ [namespace origin mcpackageconfig] set mcfolder $langdir]]
+}
+
+# msgcat::LoadAll --
+#
+# Load a list of locales for all packages not having a package locale
+# list.
+#
+# Arguments:
+# langdir The directory to search.
+#
+# Results:
+# Returns the number of message catalogs that were loaded.
+
+proc msgcat::LoadAll {locales} {
+ variable PackageConfig
+ variable LoadedLocales
+ if {0 == [llength $locales]} { return {} }
+ # filter jet unloaded locales
+ set locales [ListComplement $LoadedLocales $locales]
+ if {0 == [llength $locales]} { return {} }
+ lappend LoadedLocales {*}$locales
+
+ set packages [lsort -unique [concat\
+ [dict keys [dict get $PackageConfig loadcmd]]\
+ [dict keys [dict get $PackageConfig mcfolder]]]]
+ foreach ns $packages {
+ if {! [dict exists $PackageConfig loclist $ns] } {
+ Load $ns $locales
+ }
+ }
+ return $locales
+}
+
+# msgcat::Load --
+#
+# Invoke message load callback and load message catalog files.
+#
+# Arguments:
+# ns Namespace (equal package) to load the message catalog.
+# locales List of locales to load.
+# callbackonly true if only callback should be invoked
+#
+# Results:
+# Returns the number of message catalogs that were loaded.
+
+proc msgcat::Load {ns locales {callbackonly 0}} {
variable FileLocale
+ variable PackageConfig
+ variable LoadedLocals
+
+ if {0 == [llength $locales]} { return 0 }
+
+ # Invoke callback
+ Invoke loadcmd $locales $ns
+
+ if {$callbackonly || ![dict exists $PackageConfig mcfolder $ns]} {
+ return 0
+ }
+
+ # Invoke file load
+ set langdir [dict get $PackageConfig mcfolder $ns]
+
# Save the file locale if we are recursively called
if {[info exists FileLocale]} {
set nestedFileLocale $FileLocale
}
set x 0
- foreach p [mcpreferences] {
+ foreach p $locales {
if {$p eq {}} {
set p ROOT
}
set langfile [file join $langdir $p.msg]
if {[file exists $langfile]} {
incr x
- set FileLocale [string tolower [file tail [file rootname $langfile]]]
+ set FileLocale [string tolower\
+ [file tail [file rootname $langfile]]]
if {"root" eq $FileLocale} {
set FileLocale ""
}
- uplevel 1 [list ::source -encoding utf-8 $langfile]
+ namespace inscope $ns [list ::source -encoding utf-8 $langfile]
unset FileLocale
}
}
@@ -307,6 +847,63 @@ proc msgcat::mcload {langdir} {
return $x
}
+# msgcat::Invoke --
+#
+# Invoke a set of registered callbacks.
+# The callback is only invoked, if its registered namespace exists.
+#
+# Arguments:
+# index Index into PackageConfig to get callback command
+# arglist parameters to the callback invocation
+# ns (Optional) package to call.
+# If not given or empty, check all registered packages.
+# resultname Variable to save the callback result of the last called
+# callback to. May be set to "" to discard the result.
+# failerror (0) Fail on error if true. Otherwise call bgerror.
+#
+# Results:
+# Possible values:
+# - 0: no valid command registered
+# - 1: registered command was the empty string
+# - 2: registered command called, resultname is set
+# - 3: registered command failed
+# If multiple commands are called, the maximum of all results is returned.
+
+proc msgcat::Invoke {index arglist {ns ""} {resultname ""} {failerror 0}} {
+ variable PackageConfig
+ variable Config
+ if {"" ne $resultname} {
+ upvar 1 $resultname result
+ }
+ if {"" eq $ns} {
+ set packageList [dict keys [dict get $PackageConfig $index]]
+ } else {
+ set packageList [list $ns]
+ }
+ set ret 0
+ foreach ns $packageList {
+ if {[dict exists $PackageConfig $index $ns] && [namespace exists $ns]} {
+ set cmd [dict get $PackageConfig $index $ns]
+ if {"" eq $cmd} {
+ if {$ret == 0} {set ret 1}
+ } else {
+ if {$failerror} {
+ set result [namespace inscope $ns $cmd {*}$arglist]
+ set ret 2
+ } elseif {1 == [catch {
+ set result [namespace inscope $ns $cmd {*}$arglist]
+ if {$ret < 2} {set ret 2}
+ } err derr]} {
+ after idle [concat [::interp bgerror ""]\
+ [list $err $derr]]
+ set ret 3
+ }
+ }
+ }
+ }
+ return $ret
+}
+
# msgcat::mcset --
#
# Set the translation for a given string in a specified locale.
@@ -330,7 +927,7 @@ proc msgcat::mcset {locale src {dest ""}} {
set locale [string tolower $locale]
- dict set Msgs $locale $ns $src $dest
+ dict set Msgs $ns $locale $src $dest
return $dest
}
@@ -351,16 +948,10 @@ proc msgcat::mcflset {src {dest ""}} {
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
+ return -code error "must only be used inside a message catalog loaded\
+ with ::msgcat::mcload"
}
-
- set ns [uplevel 1 [list ::namespace current]]
- dict set Msgs $FileLocale $ns $src $dest
- return $dest
+ return [uplevel 1 [list [namespace origin mcset] $FileLocale $src $dest]]
}
# msgcat::mcmset --
@@ -380,14 +971,14 @@ proc msgcat::mcmset {locale pairs} {
set length [llength $pairs]
if {$length % 2} {
return -code error "bad translation list:\
- should be \"[lindex [info level 0] 0] locale {src dest ...}\""
+ 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 {
- dict set Msgs $locale $ns $src $dest
+ dict set Msgs $ns $locale $src $dest
}
return [expr {$length / 2}]
@@ -408,26 +999,17 @@ proc msgcat::mcflmset {pairs} {
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 ...}\""
+ return -code error "must only be used inside a message catalog loaded\
+ with ::msgcat::mcload"
}
-
- set ns [uplevel 1 [list ::namespace current]]
- foreach {src dest} $pairs {
- dict set Msgs $FileLocale $ns $src $dest
- }
- return [expr {$length / 2}]
+ return [uplevel 1 [list [namespace origin mcmset] $FileLocale $pairs]]
}
# msgcat::mcunknown --
#
# This routine is called by msgcat::mc if a translation cannot
-# be found for a string. This routine is intended to be replaced
+# be found for a string and no unknowncmd is set for the current
+# package. 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.
# If additional args are specified, the format command will be used
@@ -441,7 +1023,30 @@ proc msgcat::mcflmset {pairs} {
# Results:
# Returns the translated value.
-proc msgcat::mcunknown {locale src args} {
+proc msgcat::mcunknown {args} {
+ return [uplevel 1 [list [namespace origin DefaultUnknown] {*}$args]]
+}
+
+# msgcat::DefaultUnknown --
+#
+# This routine is called by msgcat::mc if a translation cannot
+# be found for a string in the following circumstances:
+# - Default global handler, if mcunknown is not redefined.
+# - Per package handler, if the package sets unknowncmd to the empty
+# string.
+# It returna the source string if the argument list is empty.
+# If additional args are specified, the format command will be used
+# to work them into the traslated string.
+#
+# Arguments:
+# locale (unused) The current locale.
+# src The string to be translated.
+# args Args to pass to the format command
+#
+# Results:
+# Returns the translated value.
+
+proc msgcat::DefaultUnknown {locale src args} {
if {[llength $args]} {
return [format $src {*}$args]
} else {