l10n (with caching) implemented, msgcat package optimized, code review, etc.

2 files changed, 136 insertions, 56 deletions

diff --git a/library/clock.tcl b/library/clock.tcl
index ebbecb9..b4632b1 100755
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -289,8 +289,9 @@ proc ::tcl::clock::Initialize {} {
 
     # Default configuration
 
-    # configure -year-century    2000 \
-    #           -century-switch  38
+    configure -default-locale  [mclocale]
+    #configure -year-century    2000 \
+    #          -century-switch  38
 
     # Translation table to map Windows TZI onto cities, so that the Olson
     # rules can apply.  In some cases the mapping is ambiguous, so it's wise
@@ -2105,6 +2106,51 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
 
 #----------------------------------------------------------------------
 #
+# GetSystemTimeZone --
+#
+#	Determines the system time zone, which is the default for the
+#	'clock' command if no other zone is supplied.
+#
+# Parameters:
+#	None.
+#
+# Results:
+#	Returns the system time zone.
+#
+# Side effects:
+#	Stores the sustem time zone in engine configuration, since
+#	determining it may be an expensive process.
+#
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::GetSystemLocale {} {
+    if { $::tcl_platform(platform) ne {windows} } {
+	# On a non-windows platform, the 'system' locale is the same as
+	# the 'current' locale
+
+	return [mclocale]
+    }
+
+    # On a windows platform, the 'system' locale is adapted from the
+    # 'current' locale by applying the date and time formats from the
+    # Control Panel.  First, load the 'current' locale if it's not yet
+    # loaded
+
+    mcpackagelocale set [mclocale]
+
+    # Make a new locale string for the system locale, and get the
+    # Control Panel information
+
+    set locale [mclocale]_windows
+    if { ! [mcpackagelocale present $locale] } {
+	LoadWindowsDateTimeFormats $locale
+    }
+
+    return $locale
+}
+
+#----------------------------------------------------------------------
+#
 # EnterLocale --
 #
 #	Switch [mclocale] to a given locale if necessary
@@ -2121,33 +2167,12 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
 #----------------------------------------------------------------------
 
 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
-	    # the 'current' locale
-
-	    set locale current
-	} else {
-	    # On a windows platform, the 'system' locale is adapted from the
-	    # 'current' locale by applying the date and time formats from the
-	    # Control Panel.  First, load the 'current' locale if it's not yet
-	    # loaded
-
-	    mcpackagelocale set [mclocale]
-
-	    # Make a new locale string for the system locale, and get the
-	    # Control Panel information
-
-	    set locale [mclocale]_windows
-	    if { ! [mcpackagelocale present $locale] } {
-		LoadWindowsDateTimeFormats $locale
-	    }
-	}
-    }
-    if { $locale eq {current}} {
+    switch -- $locale system {
+    	set locale [GetSystemLocale]
+    } current {
 	set locale [mclocale]
     }
-    # Eventually load the locale
+    # Select the locale, eventually load it
     mcpackagelocale set $locale
 }
 
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 7f23568..3fd2cdb 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -227,52 +227,61 @@ proc msgcat::mc {src args} {
 
 # msgcat::mcget --
 #
-#	Find the translation for the given string based on the given
-#	locale setting. Check the given namespace first, then look in each
-#	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.
+#	Return the translation for the given string based on the given
+#	locale setting or the whole dictionary object of the package/locale.
+#	Searching of catalog is similar to "msgcat::mc".
+#
+#	Contrary to "msgcat::mc" may additionally load a package catalog 
+#	on demand.
 #
 # Arguments:
-#	src	The string to translate.
-#	args	Args to pass to the format command
+#	ns	The package namespace (as catalog selector).
+#	loc	The locale used for translation.
+#	{src}	The string to translate.
+#	{args}	Args to pass to the format command
 #
 # Results:
 #	Returns the translated string.  Propagates errors thrown by the
 #	format command.
 
-proc msgcat::mcget {ns loc src args} {
+proc msgcat::mcget {ns loc args} {
     variable Msgs
 
     if {$loc eq {C}} {
 	set loclist [PackagePreferences $ns]
+	set loc [lindex $loclist 0]
     } else {
+    	set loc [string tolower $loc]
 	variable PackageConfig
-	# if {![dict exists $PackageConfig $ns $loc]} {
-	#     set loc [mclocale]
-	# }
-	set loclist [dict get $PackageConfig locales $ns $loc]
+	# get locales list for given locale (de_de -> {de_de de {}})
+	if {[catch {
+	    set loclist [dict get $PackageConfig locales $ns $loc]
+	}]} {
+	    # lazy load catalog on demand
+	    mcpackagelocale load $loc $ns
+	    set loclist [dict get $PackageConfig locales $ns $loc]
+	}
     }
+    if {![llength $args]} {
+	# get whole catalog:
+	return [msgcat::Merge $ns $loclist]
+    }
+    set src [lindex $args 0]
+    # search translation for each locale (regarding parent namespaces)
     for {set nscur $ns} {$nscur != ""} {set nscur [namespace parent $nscur]} {
 	foreach loc $loclist {
 	    if {[dict exists $Msgs $nscur $loc $src]} {
-		if {[llength $args]} {
-		    return [format [dict get $Msgs $nscur $loc $src] {*}$args]
+		if {[llength $args] > 1} {
+		    return [format [dict get $Msgs $nscur $loc $src] \
+				{*}[lrange $args 1 end]]
 		} else {
 		    return [dict get $Msgs $nscur $loc $src]
 		}
 	    }
 	}
     }
-    # call package local or default unknown command
-    set args [linsert $args 0 $loclist $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 }
-    }
+    # get with package default locale
+    mcget $ns [lindex $loclist 0] {*}$args
 }
 
 # msgcat::mcexists --
@@ -465,6 +474,10 @@ proc msgcat::mcloadedlocales {subcommand} {
 #	    items, if the former locale was the default locale.
 #	    Returns the normalized set locale.
 #	    The default locale is taken, if locale is not given.
+#	load
+#	    Load a package locale without set it (lazy loading from mcget).
+#	    Returns the normalized set locale.
+#	    The default locale is taken, if locale is not given.
 #	get
 #	    Get the locale valid for this package.
 #	isset
@@ -492,7 +505,7 @@ proc msgcat::mcloadedlocales {subcommand} {
 # Results:
 #	Empty string, if not stated differently for the subcommand
 
-proc msgcat::mcpackagelocale {subcommand {locale ""}} {
+proc msgcat::mcpackagelocale {subcommand {locale ""} {ns ""}} {
     # todo: implement using an ensemble
     variable Loclist
     variable LoadedLocales
@@ -512,7 +525,9 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
 	}
         set locale [string tolower $locale]
     }
-    set ns [uplevel 1 {::namespace current}]
+    if {$ns eq ""} {
+	set ns [uplevel 1 {::namespace current}]
+    }
 
     switch -exact -- $subcommand {
 	get { return [lindex [PackagePreferences $ns] 0] }
@@ -520,7 +535,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
 	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
+	set - load { # 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]} {
@@ -530,18 +545,21 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
 
 	    # Check if changed
 	    set loclist [dict get $PackageConfig loclist $ns]
-	    if {! [info exists locale] || $locale eq [lindex $loclist 0] } {
+	    if {[llength [info level 0]] == 2 || $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
-	    dict set PackageConfig locales $ns $locale $loclist
+	    if {$subcommand eq {set}} {
+		# set loclist
+		dict set PackageConfig loclist $ns $loclist
+	    }
 
 	    # load eventual missing locales
 	    set loadedLocales [dict get $PackageConfig loadedlocales $ns]
+	    dict set PackageConfig locales $ns $locale $loclist
 	    if {$locale in $loadedLocales} { return $locale }
 	    set loadLocales [ListComplement $loadedLocales $loclist]
 	    dict set PackageConfig loadedlocales $ns\
@@ -899,6 +917,39 @@ proc msgcat::Load {ns locales {callbackonly 0}} {
     return $x
 }
 
+# msgcat::Merge --
+#
+#	Merge message catalog dictionaries to one dictionary.
+#
+# Arguments:
+#	ns		Namespace (equal package) to load the message catalog.
+#	locales		List of locales to merge.
+#
+# Results:
+#	Returns the merged dictionary of message catalogs.
+proc msgcat::Merge {ns locales} {
+    variable Merged
+    if {![catch {
+    	set mrgcat [dict get $Merged $ns [set loc [lindex $locales 0]]]
+    }]} {
+    	return $mrgcat
+    }
+    variable Msgs
+    # Merge sequential locales (in reverse order, e. g. {} -> en -> en_en):
+    if {[llength $locales] > 1} {
+	set mrgcat [msgcat::Merge $ns [lrange $locales 1 end]]
+	catch {
+	    set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]]
+	}
+    } else {
+	catch {
+	    set mrgcat [dict get $Msgs $ns $loc]
+	}
+    }
+    dict set Merged $ns $loc $mrgcat
+    return $mrgcat
+}
+
 # msgcat::Invoke --
 #
 #	Invoke a set of registered callbacks.
@@ -971,6 +1022,7 @@ proc msgcat::Invoke {index arglist {ns ""} {resultname ""} {failerror 0}} {
 
 proc msgcat::mcset {locale src {dest ""}} {
     variable Msgs
+    variable Merged
     if {[llength [info level 0]] == 3} { ;# dest not specified
 	set dest $src
     }
@@ -980,6 +1032,7 @@ proc msgcat::mcset {locale src {dest ""}} {
     set locale [string tolower $locale]
 
     dict set Msgs $ns $locale $src $dest
+    dict unset Merged $ns
     return $dest
 }
 
@@ -1019,6 +1072,7 @@ proc msgcat::mcflset {src {dest ""}} {
 
 proc msgcat::mcmset {locale pairs} {
     variable Msgs
+    variable Merged
 
     set length [llength $pairs]
     if {$length % 2} {
@@ -1032,6 +1086,7 @@ proc msgcat::mcmset {locale pairs} {
     foreach {src dest} $pairs {
 	dict set Msgs $ns $locale $src $dest
     }
+    dict unset Merged $ns
 
     return [expr {$length / 2}]
 }