Index: changes
==================================================================
--- changes
+++ changes
@@ -8877,5 +8877,8 @@
 2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
 
 2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)
 
 --- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details
+
+2018-02-07 (TIP 499) custom locale preference list (nijtmans)
+=> msgcat 1.7.0

Index: library/msgcat/msgcat.tcl
==================================================================
--- library/msgcat/msgcat.tcl
+++ library/msgcat/msgcat.tcl
@@ -12,16 +12,16 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 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.6.1
+package provide msgcat 1.7.0
 
 namespace eval msgcat {
-    namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences mcset\
-            mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\
-	    mcpackageconfig mcpackagelocale
+    namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences\
+	    mcset mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\
+	    mcpackageconfig mcpackagelocale mcutil
 
     # Records the list of locales to search
     variable Loclist {}
 
     # List of currently loaded locales
@@ -39,11 +39,17 @@
     # Records the mapping between source strings and translated strings.  The
     # 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]
+}
 
+# 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  {*}{
 	    01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ
 		  1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY
@@ -301,36 +307,31 @@
 	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."
 	}
-	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]]} {
 	set locale [string range $locale 0 $pos-1]
 	if { "_" ne [string index $locale end] } {
@@ -347,19 +348,54 @@
 #
 #	Fetch the list of locales used to look up strings, ordered from
 #	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
 #
@@ -440,65 +476,95 @@
 #	locale			package locale (only set 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
     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]
+    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 [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]} ]}
+	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]} {
 		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]
+	    # 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]} {
 		return -code error "clear only when package locale set"
 	    }
@@ -1077,11 +1143,11 @@
     return $max
 }
 
 # 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]
     #
     # Comment out expanded RE version -- bugs alleged
     # regexp -expanded {
@@ -1105,43 +1171,38 @@
     }
     return $ret
 }
 
 # Initialize the default locale
-proc msgcat::Init {} {
+proc msgcat::mcutil::getsystemlocale {} {
     global env
 
     #
     # set default locale, try to get from environment
     #
     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
 	    }
 	}
     }
     #
     # 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
 	}
     }
     #
     # The rest of this routine is special processing for Windows or
     # Cygwin. All other platforms, get out now.
     #
     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
     # settings, or fall back on locale of "C".
     #
@@ -1168,22 +1229,21 @@
 	    }
 	    set modifierDict [dict create latn latin cyrl cyrillic]
 	    if {[dict exists $modifierDict $script]} {
 		append locale @ [dict get $modifierDict $script]
 	    }
-	    if {![catch {mclocale [ConvertLocale $locale]}]} {
-		return
+	    if {![catch {ConvertLocale $locale} locale]} {
+		return $locale
 	    }
 	}
     }
 
     # then check value locale which contains a numerical language ID
     if {[catch {
 	set locale [registry get $key "locale"]
     }]} {
-	mclocale C
-	return
+	return C
     }
     #
     # Keep trying to match against smaller and smaller suffixes
     # of the registry value, since the latter hexadigits appear
     # to determine general language and earlier hexadigits determine
@@ -1194,17 +1254,17 @@
     #
     variable WinRegToISO639
     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]

Index: library/msgcat/pkgIndex.tcl
==================================================================
--- library/msgcat/pkgIndex.tcl
+++ library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
 if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
-package ifneeded msgcat 1.6.1 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.7.0 [list source [file join $dir msgcat.tcl]]

Index: tests/msgcat.test
==================================================================
--- tests/msgcat.test
+++ tests/msgcat.test
@@ -191,10 +191,32 @@
     } -cleanup {
 	mclocale $locale
     } -body {
 	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} {
 	namespace eval :: ::msgcat::mcset  foo_BAR text1 text2
@@ -809,17 +831,22 @@
     # Tests msgcat-12.*: [mcpackagelocale]
 
 	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 {
 	    mclocale $locale
 	    mcforgetpackage
@@ -920,10 +947,34 @@
 	    mcpackagelocale set bar
 	    mcpackagelocale clear
 	    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 {
 	    mcpackageconfig
 	} -returnCodes 1\
@@ -1073,13 +1124,53 @@
 	} -returnCodes 1\
 	-result {fail}
 
     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
 return
 
 # Local Variables:
 # mode: tcl
 # End:

Index: unix/Makefile.in
==================================================================
--- unix/Makefile.in
+++ unix/Makefile.in
@@ -848,12 +848,12 @@
 	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
 	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
 	    do \
 	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
 	    done;
-	@echo "Installing package msgcat 1.6.1 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.1.tm;
+	@echo "Installing package msgcat 1.7.0 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.7.0.tm;
 	@echo "Installing package tcltest 2.4.1 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.1.tm;
 
 	@echo "Installing package platform 1.0.14 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm;

Index: win/Makefile.in
==================================================================
--- win/Makefile.in
+++ win/Makefile.in
@@ -657,12 +657,12 @@
 	@echo "Installing library opt0.4 directory";
 	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
 	    do \
 	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
 	    done;
-	@echo "Installing package msgcat 1.6.1 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm;
+	@echo "Installing package msgcat 1.7.0 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.7.0.tm;
 	@echo "Installing package tcltest 2.4.0 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm;
 	@echo "Installing package platform 1.0.14 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
 	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";