merge core-8-6-branch (except: the "timerate" command and the clock performance-tests are kept)

4 files changed, 108 insertions, 147 deletions

diff --git a/library/clock.tcl b/library/clock.tcl
index 94d2341..471deff 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -506,18 +506,103 @@ proc ::tcl::clock::Initialize {} {
     variable FormatProc;		# Array mapping format group
 					# and locale to the name of a procedure
 					# that renders the given format
+
+    variable mcLocales	 [dict create];	# Dictionary with loaded locales
+    variable mcMergedCat [dict create];	# Dictionary with merged locale catalogs
 }
 ::tcl::clock::Initialize
 
 #----------------------------------------------------------------------
 
-proc mcget {locale args} {
-    switch -- $locale system {
-    	set locale [GetSystemLocale]
+# mcget --
+#
+#	Return the merged translation catalog for the ::tcl::clock namespace
+#	Searching of catalog is similar to "msgcat::mc".
+#
+#	Contrary to "msgcat::mc" may additionally load a package catalog
+#	on demand.
+#
+# Arguments:
+#	loc	The locale used for translation.
+#
+# Results:
+#	Returns the dictionary object as whole catalog of the package/locale.
+#
+proc mcget {loc} {
+    variable mcMergedCat
+    switch -- $loc system {
+	set loc [GetSystemLocale]
     } current {
-	set locale [mclocale]
+	set loc [mclocale]
+    }
+    if {$loc eq {C}} {
+	set loclist [msgcat::PackagePreferences ::tcl::clock]
+	set loc [lindex $loclist 0]
+    } else {
+    	set loc [string tolower $loc]
+    }
+
+    # try to retrieve now if already available:
+    if {[dict exists $mcMergedCat $loc]} {
+	set mrgcat [dict get $mcMergedCat $loc]
+	return [dict smartref $mrgcat]
     }
-    msgcat::mcget ::tcl::clock $locale {*}$args
+
+    # get locales list for given locale (de_de -> {de_de de {}})
+    variable mcLocales
+    if {[dict exists $mcLocales $loc]} {
+	set loclist [dict get $mcLocales $loc]
+    } else {
+	# save current locale:
+	set prevloc [mclocale]
+	# lazy load catalog on demand (set it will load the catalog)
+	mcpackagelocale set $loc
+	set loclist [msgcat::GetPreferences $loc]
+	dict set $mcLocales $loc $loclist
+	# restore:
+        if {$prevloc ne $loc} {
+	   mcpackagelocale set $prevloc
+	}
+    }
+    # get whole catalog:
+    mcMerge $loclist
+}
+
+# mcMerge --
+#
+#	Merge message catalog dictionaries to one dictionary.
+#
+# Arguments:
+#	locales		List of locales to merge.
+#
+# Results:
+#	Returns the (weak pointer) to merged dictionary of message catalog.
+#
+proc mcMerge {locales} {
+    variable mcMergedCat
+    if {[dict exists $mcMergedCat [set loc [lindex $locales 0]]]} {
+	set mrgcat [dict get $mcMergedCat $loc]
+	return [dict smartref $mrgcat]
+    }
+    # package msgcat currently does not provide possibility to get whole catalog:
+    upvar ::msgcat::Msgs Msgs
+    set ns ::tcl::clock
+    # Merge sequential locales (in reverse order, e. g. {} -> en -> en_en):
+    if {[llength $locales] > 1} {
+	set mrgcat [mcMerge [lrange $locales 1 end]]
+	if {[dict exists $Msgs $ns $loc]} {
+	    set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]]
+	}
+    } else {
+	if {[dict exists $Msgs $ns $loc]} {
+	    set mrgcat [dict get $Msgs $ns $loc]
+	} else {
+	    set mrgcat [dict create]
+	}
+    }
+    dict set mcMergedCat $loc $mrgcat
+    # return smart reference (shared dict as object with exact one ref-counter)
+    return [dict smartref $mrgcat]
 }
 
 #----------------------------------------------------------------------
@@ -741,7 +826,7 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
 
 proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } {
     variable LocaleFormats
-    
+
     if { $fmtkey eq {} } { set fmtkey FMT_$format }
     if { [catch {
     	set locfmt [dict get $LocaleFormats $locale $fmtkey]
@@ -751,10 +836,10 @@ proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } {
 	if { [catch {
 	    set mlst [dict get $LocaleFormats $locale MLST]
 	}] } {
-	
+
 	    # message catalog dictionary:
 	    set mcd [mcget $locale]
-		
+
 	    # 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
@@ -779,7 +864,7 @@ proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } {
 	    dict set LocaleFormats $locale MLST $mlst
 	}
 
-	# translate copy of format (don't use format object here, because otherwise 
+	# translate copy of format (don't use format object here, because otherwise
 	# it can lose its internal representation (string map - convert to unicode)
 	set locfmt [string map $mlst [string range " $format" 1 end]]
 
@@ -787,10 +872,10 @@ proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } {
 	dict set LocaleFormats $locale $fmtkey $locfmt
     }
 
-    # Save original format as long as possible, because of internal 
+    # Save original format as long as possible, because of internal
     # representation (performance).
     # Note that in this case such format will be never localized (also
-    # using another locales). To prevent this return a duplicate (but 
+    # using another locales). To prevent this return a duplicate (but
     # it may be slower).
     if {$locfmt eq $format} {
         set locfmt $format
@@ -849,7 +934,7 @@ proc ::tcl::clock::GetSystemTimeZone {} {
     if { [dict exists $TimeZoneBad $timezone] } {
 	set timezone :localtime
     }
-    
+
     # tell backend - current system timezone:
     configure -system-tz $timezone
 
@@ -2004,13 +2089,14 @@ proc ::tcl::clock::ClearCaches {} {
     variable FormatProc
     variable LocaleFormats
     variable LocaleNumeralCache
+    variable mcMergedCat
     variable TimeZoneBad
 
     # tell backend - should invalidate:
     configure -clear
 
     # clear msgcat cache:
-    msgcat::ClearCaches ::tcl::clock
+    set mcMergedCat [dict create]
 
     foreach p [info procs [namespace current]::scanproc'*] {
 	rename $p {}
diff --git a/library/init.tcl b/library/init.tcl
index fc88a72..dba73b0 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -159,7 +159,7 @@ if {[interp issafe]} {
     package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
 } else {
     # Default known auto_index (avoid loading auto index implicit after interp create):
-    
+
     array set ::auto_index {
 	::tcl::tm::UnknownHandler {source [info library]/tm.tcl}
 	::tclPkgUnknown {source [info library]/package.tcl}
@@ -433,7 +433,7 @@ proc auto_load {cmd {namespace {}}} {
     # workaround non canonical auto_index entries that might be around
     # from older auto_mkindex versions
     if {$cmd ni $nameList} {lappend nameList $cmd}
-    
+
     # try to load (and create sub-cmd handler "_sub_load_cmd" for further usage):
     foreach name $nameList [set _sub_load_cmd {
     	# via auto_index:
@@ -463,7 +463,7 @@ proc auto_load {cmd {namespace {}}} {
 	    }
 	}
     }]
-    
+
     # load auto_index if possible:
     if {![info exists auto_path]} {
 	return 0
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index f9f57db..928474d 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -225,65 +225,6 @@ proc msgcat::mc {src args} {
     }
 }
 
-# msgcat::mcget --
-#
-#	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:
-#	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 args} {
-    if {$loc eq {C}} {
-	set loclist [PackagePreferences $ns]
-	set loc [lindex $loclist 0]
-    } else {
-    	set loc [string tolower $loc]
-	variable PackageConfig
-	# 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 {
-	    set msgs [mcget $nscur $loc]
-	    if {![catch { set val [dict get $msgs $src] }]} {
-		if {[llength $args] == 1} {
-		    return $val
-		}
-		return [format $val {*}[lrange $args 1 end]]
-	    }
-	}
-    }
-    # no translation :
-    if {[llength $args] == 1} {
-	return $src
-    }
-    return [format $src {*}[lrange $args 1 end]]
-}
-
 # msgcat::mcexists --
 #
 #	Check if a catalog item is set or if mc would invoke mcunknown.
@@ -474,10 +415,6 @@ 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
@@ -505,7 +442,7 @@ proc msgcat::mcloadedlocales {subcommand} {
 # Results:
 #	Empty string, if not stated differently for the subcommand
 
-proc msgcat::mcpackagelocale {subcommand {locale ""} {ns ""}} {
+proc msgcat::mcpackagelocale {subcommand {locale ""}} {
     # todo: implement using an ensemble
     variable Loclist
     variable LoadedLocales
@@ -525,9 +462,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""} {ns ""}} {
 	}
         set locale [string tolower $locale]
     }
-    if {$ns eq ""} {
-	set ns [uplevel 1 {::namespace current}]
-    }
+    set ns [uplevel 1 {::namespace current}]
 
     switch -exact -- $subcommand {
 	get { return [lindex [PackagePreferences $ns] 0] }
@@ -535,7 +470,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""} {ns ""}} {
 	loaded { return [PackageLocales $ns] }
 	present { return [expr {$locale in [PackageLocales $ns]} ]}
 	isset { return [dict exists $PackageConfig loclist $ns] }
-	set - load { # set a package locale or add a package locale
+	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]} {
@@ -545,21 +480,17 @@ proc msgcat::mcpackagelocale {subcommand {locale ""} {ns ""}} {
 
 	    # Check if changed
 	    set loclist [dict get $PackageConfig loclist $ns]
-	    if {[llength [info level 0]] == 2 || $locale eq [lindex $loclist 0] } {
+	    if {! [info exists locale] || $locale eq [lindex $loclist 0] } {
 		return [lindex $loclist 0]
 	    }
 
 	    # Change loclist
 	    set loclist [GetPreferences $locale]
 	    set locale [lindex $loclist 0]
-	    if {$subcommand eq {set}} {
-		# set loclist
-		dict set PackageConfig loclist $ns $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\
@@ -590,7 +521,6 @@ proc msgcat::mcpackagelocale {subcommand {locale ""} {ns ""}} {
 		    [dict get $PackageConfig loadedlocales $ns] $LoadedLocales]
 	    dict unset PackageConfig loadedlocales $ns
 	    dict unset PackageConfig loclist $ns
-	    dict unset PackageConfig locales $ns
 
 	    # unset keys not in global loaded locales
 	    if {[dict exists $Msgs $ns]} {
@@ -917,47 +847,6 @@ 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 {
-	if {[catch {
-	    set mrgcat [dict get $Msgs $ns $loc]
-	}]} {
-	    set mrgcat [dict create]
-	}
-    }
-    dict set Merged $ns $loc $mrgcat
-    # return smart reference (shared dict as object with exact one ref-counter)
-    return [dict smartref $mrgcat]
-}
-
-proc msgcat::ClearCaches {ns} {
-    variable Merged
-    dict unset Merged $ns
-}
-
 # msgcat::Invoke --
 #
 #	Invoke a set of registered callbacks.
@@ -1030,7 +919,6 @@ 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
     }
@@ -1040,7 +928,6 @@ proc msgcat::mcset {locale src {dest ""}} {
     set locale [string tolower $locale]
 
     dict set Msgs $ns $locale $src $dest
-    dict unset Merged $ns
     return $dest
 }
 
@@ -1080,7 +967,6 @@ proc msgcat::mcflset {src {dest ""}} {
 
 proc msgcat::mcmset {locale pairs} {
     variable Msgs
-    variable Merged
 
     set length [llength $pairs]
     if {$length % 2} {
@@ -1094,7 +980,6 @@ proc msgcat::mcmset {locale pairs} {
     foreach {src dest} $pairs {
 	dict set Msgs $ns $locale $src $dest
     }
-    dict unset Merged $ns
 
     return [expr {$length / 2}]
 }
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index ab022ab..b1fe234 100755
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -1,19 +1,9 @@
 if {([info commands ::tcl::pkgconfig] eq "")
-  || ([info sharedlibextension] ne ".dll")} return
+	|| ([info sharedlibextension] ne ".dll")} return
 if {[::tcl::pkgconfig get debug]} {
-  if {[info exists [file join $dir tclreg13g.dll]]} {
     package ifneeded registry 1.3.2 \
             [list load [file join $dir tclreg13g.dll] registry]
-  } else {
-    package ifneeded registry 1.3.2 \
-            [list load tclreg13g registry]
-  }
 } else {
-  if {[info exists [file join $dir tclreg13.dll]]} {
     package ifneeded registry 1.3.2 \
             [list load [file join $dir tclreg13.dll] registry]
-  } else {
-    package ifneeded registry 1.3.2 \
-            [list load tclreg13 registry]
-  }
 }