summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/clock.tcl134
-rw-r--r--library/msgcat/msgcat.tcl731
-rw-r--r--library/msgcat/pkgIndex.tcl2
3 files changed, 705 insertions, 162 deletions
diff --git a/library/clock.tcl b/library/clock.tcl
index 67d15b1..e995bd1 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -19,7 +19,7 @@
# access to the Registry on Windows systems.
uplevel \#0 {
- package require msgcat 1.4
+ package require msgcat 1.6
if { $::tcl_platform(platform) eq {windows} } {
if { [catch { package require registry 1.1 }] } {
namespace eval ::tcl::clock [list variable NoRegistry {}]
@@ -60,6 +60,8 @@ namespace eval ::tcl::clock {
namespace import ::msgcat::mcload
namespace import ::msgcat::mclocale
+ namespace import ::msgcat::mc
+ namespace import ::msgcat::mcpackagelocale
}
@@ -106,6 +108,10 @@ proc ::tcl::clock::Initialize {} {
}
InitTZData
+ mcpackagelocale set {}
+ ::msgcat::mcpackageconfig set mcfolder [file join $LibDir msgs]
+ ::msgcat::mcpackageconfig set unknowncmd ""
+
# Define the message catalog for the root locale.
::msgcat::mcmset {} {
@@ -249,7 +255,6 @@ proc ::tcl::clock::Initialize {} {
# Define the directories for time zone data and message catalogs.
variable DataDir [file join $LibDir tzdata]
- variable MsgDir [file join $LibDir msgs]
# Number of days in the months, in common years and leap years.
@@ -623,11 +628,6 @@ proc ::tcl::clock::Initialize {} {
# in the given locales and dictionaries
# mapping the numerals to their numeric
# values.
- variable McLoaded {}; # Dictionary whose keys are locales
- # in which [mcload] has been executed
- # and whose values are second-level
- # dictionaries indexed by message
- # name and giving message text.
# variable CachedSystemTimeZone; # If 'CachedSystemTimeZone' exists,
# it contains the value of the
# system time zone, as determined from
@@ -659,6 +659,7 @@ proc ::tcl::clock::Initialize {} {
#----------------------------------------------------------------------
proc ::tcl::clock::format { args } {
+
variable FormatProc
variable TZData
@@ -692,6 +693,7 @@ proc ::tcl::clock::format { args } {
}
return [$procName $clockval $timezone]
+
}
#----------------------------------------------------------------------
@@ -710,13 +712,14 @@ proc ::tcl::clock::format { args } {
#----------------------------------------------------------------------
proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {
+
if {[namespace which $procName] ne {}} {
return $procName
}
# Map away the locale-dependent composite format groups
- EnterLocale $locale oldLocale
+ EnterLocale $locale
# Change locale if a fresh locale has been given on the command line.
@@ -725,12 +728,6 @@ proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {
} trap CLOCK {result opts} {
dict unset opts -errorinfo
return -options $opts $result
- } finally {
- # Restore the locale
-
- if { [info exists oldLocale] } {
- mclocale $oldLocale
- }
}
}
@@ -1181,6 +1178,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
#----------------------------------------------------------------------
proc ::tcl::clock::scan { args } {
+
set format {}
# Check the count of args
@@ -1264,7 +1262,7 @@ proc ::tcl::clock::scan { args } {
# Change locale if a fresh locale has been given on the command line.
- EnterLocale $locale oldLocale
+ EnterLocale $locale
try {
# Map away the locale-dependent composite format groups
@@ -1273,15 +1271,8 @@ proc ::tcl::clock::scan { args } {
return [$scanner $string $base $timezone]
} trap CLOCK {result opts} {
# Conceal location of generation of expected errors
-
dict unset opts -errorinfo
return -options $opts $result
- } finally {
- # Restore the locale
-
- if { [info exists oldLocale] } {
- mclocale $oldLocale
- }
}
}
@@ -1304,6 +1295,7 @@ proc ::tcl::clock::scan { args } {
#----------------------------------------------------------------------
proc ::tcl::clock::FreeScan { string base timezone locale } {
+
variable TZData
# Get the data for time changes in the given zone
@@ -1431,6 +1423,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
2361222]
set seconds [dict get $date2 seconds]
+
}
# Do relative month
@@ -2155,6 +2148,7 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
proc ::tcl::clock::MakeUniquePrefixRegexp { successors
uniquePrefixMapping
prefixString } {
+
# Get the characters that may follow the current prefix string
set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]]
@@ -2224,6 +2218,7 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
#----------------------------------------------------------------------
proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
+
set currPrio 999
set currFieldPos [list]
set currCodeBurst {
@@ -2297,26 +2292,16 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
#
# Parameters:
# locale -- Desired locale
-# oldLocaleVar -- Name of a variable in caller's scope that
-# tracks the previous locale name.
#
# Results:
# Returns the locale that was previously current.
#
# Side effects:
-# Does [mclocale]. If necessary, uses [mcload] to load the designated
-# locale's files, and tracks that it has done so in the 'McLoaded'
-# variable.
+# Does [mclocale]. If necessary, loades the designated locale's files.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
- upvar 1 $oldLocaleVar oldLocale
-
- variable MsgDir
- variable McLoaded
-
- set oldLocale [mclocale]
+proc ::tcl::clock::EnterLocale { locale } {
if { $locale eq {system} } {
if { $::tcl_platform(platform) ne {windows} } {
# On a non-windows platform, the 'system' locale is the same as
@@ -2329,33 +2314,22 @@ proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
# Control Panel. First, load the 'current' locale if it's not yet
# loaded
- if {![dict exists $McLoaded $oldLocale] } {
- mcload $MsgDir
- dict set McLoaded $oldLocale {}
- }
+ mcpackagelocale set [mclocale]
# Make a new locale string for the system locale, and get the
# Control Panel information
- set locale ${oldLocale}_windows
- if { ![dict exists $McLoaded $locale] } {
+ set locale [mclocale]_windows
+ if { $locale ni [::msgcat::mcpackagelocale loaded] } {
LoadWindowsDateTimeFormats $locale
- dict set McLoaded $locale {}
}
}
}
if { $locale eq {current}} {
- set locale $oldLocale
- unset oldLocale
- } elseif { $locale eq $oldLocale } {
- unset oldLocale
- } else {
- mclocale $locale
- }
- if { ![dict exists $McLoaded $locale] } {
- mcload $MsgDir
- dict set McLoaded $locale {}
+ set locale [mclocale]
}
+ # Eventually load the locale
+ mcpackagelocale set $locale
}
#----------------------------------------------------------------------
@@ -2482,6 +2456,7 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
}
return
+
}
#----------------------------------------------------------------------
@@ -2505,13 +2480,13 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
#----------------------------------------------------------------------
proc ::tcl::clock::LocalizeFormat { locale format } {
- variable McLoaded
- if { [dict exists $McLoaded $locale FORMAT $format] } {
- return [dict get $McLoaded $locale FORMAT $format]
- }
- set inFormat $format
+ # message catalog key to cache this format
+ set key FORMAT_$format
+ if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
+ return [mc $key]
+ }
# Handle locale-dependent format groups by mapping them out of the format
# string. Note that the order of the [string map] operations is
# significant because later formats can refer to later ones; for example
@@ -2534,7 +2509,7 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
set format [string map $list $format]
- dict set McLoaded $locale FORMAT $inFormat $format
+ ::msgcat::mcset $locale $key $format
return $format
}
@@ -3133,7 +3108,6 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
-errorcode [list CLOCK badTimeZone $timezone] \
"time zone \"$timezone\" not found"
}
-
} elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
# This looks like a POSIX time zone - try to process it
@@ -3901,6 +3875,7 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
#----------------------------------------------------------------------
proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
+
variable FEB_28
# Determine the start or end day of DST
@@ -3908,6 +3883,7 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
set date [dict create era CE year $y]
set doy [dict get $z ${bound}DayOfYear]
if { $doy ne {} } {
+
# Time was specified as a day of the year
if { [dict get $z ${bound}J] ne {}
@@ -4319,7 +4295,7 @@ proc ::tcl::clock::add { clockval args } {
set timezone :GMT
}
- EnterLocale $locale oldLocale
+ EnterLocale $locale
set changeover [mc GREGORIAN_CHANGE_DATE]
@@ -4371,12 +4347,6 @@ proc ::tcl::clock::add { clockval args } {
# Conceal the innards of [clock] when it's an expected error
dict unset opts -errorinfo
return -options $opts $result
- } finally {
- # Restore the locale
-
- if { [info exists oldLocale] } {
- mclocale $oldLocale
- }
}
}
@@ -4449,6 +4419,7 @@ proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
$changeover]
return [dict get $date seconds]
+
}
#----------------------------------------------------------------------
@@ -4499,38 +4470,7 @@ proc ::tcl::clock::AddDays { days clockval timezone changeover } {
$changeover]
return [dict get $date seconds]
-}
-
-#----------------------------------------------------------------------
-#
-# mc --
-#
-# Wrapper around ::msgcat::mc that caches the result according to the
-# locale.
-#
-# Parameters:
-# Accepts the name of the message to retrieve.
-#
-# Results:
-# Returns the message text.
-#
-# Side effects:
-# Caches the message text.
-#
-# Notes:
-# Only the single-argument version of [mc] is supported.
-#
-#----------------------------------------------------------------------
-proc ::tcl::clock::mc { name } {
- variable McLoaded
- set Locale [mclocale]
- if { [dict exists $McLoaded $Locale $name] } {
- return [dict get $McLoaded $Locale $name]
- }
- set val [::msgcat::mc $name]
- dict set McLoaded $Locale $name $val
- return $val
}
#----------------------------------------------------------------------
@@ -4553,7 +4493,6 @@ proc ::tcl::clock::mc { name } {
proc ::tcl::clock::ClearCaches {} {
variable FormatProc
variable LocaleNumeralCache
- variable McLoaded
variable CachedSystemTimeZone
variable TimeZoneBad
@@ -4566,7 +4505,6 @@ proc ::tcl::clock::ClearCaches {} {
catch {unset FormatProc}
set LocaleNumeralCache {}
- set McLoaded {}
catch {unset CachedSystemTimeZone}
set TimeZoneBad {}
InitTZData
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 {
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 5fabfe3..7399c92 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded msgcat 1.5.2 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.6.0 [list source [file join $dir msgcat.tcl]]