Tcl Source Code

					# and whose values are lists of quads
					# comprising start time, UTC offset,
					# Daylight Saving Time indicator, and
					# time zone abbreviation.
    variable FormatProc;		# Array mapping format group
					# and locale to the name of a procedure
					# that renders the given format



}
::tcl::clock::Initialize

#----------------------------------------------------------------------















proc mcget {locale args} {

    switch -- $locale system {
    	set locale [GetSystemLocale]
    } current {
	set locale [mclocale]
    }



















































    msgcat::mcget ::tcl::clock $locale {*}$args
















}

#----------------------------------------------------------------------
#
# GetSystemLocale --
#
#	Determines the system locale, which corresponds to "system"

#
#----------------------------------------------------------------------

proc ::tcl::clock::ClearCaches {} {
    variable FormatProc
    variable LocaleFormats
    variable LocaleNumeralCache

    variable TimeZoneBad

    # tell backend - should invalidate:
    configure -clear

    # clear msgcat cache:
    msgcat::ClearCaches ::tcl::clock

    foreach p [info procs [namespace current]::scanproc'*] {
	rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*] {
	rename $p {}
    }

    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::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.
#
# Arguments:
#	-exactnamespace		Only check the exact namespace and no
#				parent namespaces

#	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.
#	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
#	    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

# 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 ""} {ns ""}} {
    # 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 {$ns eq ""} {
	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 - 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]} {
		dict set PackageConfig loclist $ns $Loclist
		dict set PackageConfig loadedlocales $ns $LoadedLocales
	    }

	    # Check if changed
	    set loclist [dict get $PackageConfig loclist $ns]
	    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]
	    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\
		    [concat $loadedLocales $loadLocales]
	    Load $ns $loadLocales
	    return $locale
	}

	    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
	    dict unset PackageConfig locales $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
		    }

    }
    if {[info exists nestedFileLocale]} {
	set FileLocale $nestedFileLocale
    }
    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.
#	The callback is only invoked, if its registered namespace exists.
#
# Arguments:
#	index		Index into PackageConfig to get callback command

#			the source string is used.
#
# Results:
#	Returns the new locale.

proc msgcat::mcset {locale src {dest ""}} {
    variable Msgs
    variable Merged
    if {[llength [info level 0]] == 3} { ;# dest not specified
	set dest $src
    }

    set ns [uplevel 1 [list ::namespace current]]

    set locale [string tolower $locale]

    dict set Msgs $ns $locale $src $dest
    dict unset Merged $ns
    return $dest
}

# msgcat::mcflset --
#
#	Set the translation for a given string in the current file locale.
#

#	pairs		One or more src/dest pairs (must be even length)
#
# Results:
#	Returns the number of pairs processed

proc msgcat::mcmset {locale pairs} {
    variable Msgs
    variable Merged

    set length [llength $pairs]
    if {$length % 2} {
	return -code error "bad translation list:\
		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 $ns $locale $src $dest
    }
    dict unset Merged $ns

    return [expr {$length / 2}]
}

# msgcat::mcflmset --
#
#	Set the translation for multiple strings in the mc file locale.

	} -result {1 0}

    # Tests msgcat-12.*: [mcpackagelocale]

	test msgcat-12.1 {mcpackagelocale no subcommand} -body {
	    mcpackagelocale
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackagelocale subcommand ?locale? ?ns?"}

	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.3 {mcpackagelocale set} -setup {