#----------------------------------------------------------------------
#
# clock.tcl --
#
#	This file implements the portions of the [clock] ensemble that
#	are coded in Tcl.  Refer to the users' manual to see the description
#	of the [clock] command and its subcommands.
#
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: clock.tcl,v 1.4.2.26 2009/06/10 22:10:18 dgp Exp $
#
#----------------------------------------------------------------------

# We must have message catalogs that support the root locale, and
# we need access to the Registry on Windows systems.

uplevel \#0 {
    package require msgcat 1.4
    if { $::tcl_platform(platform) eq {windows} } {
	if { [catch { package require registry 1.1 }] } {
	    namespace eval ::tcl::clock [list variable NoRegistry {}]
	}
    }
}

# Put the library directory into the namespace for the ensemble
# so that the library code can find message catalogs and time zone
# definition files.

namespace eval ::tcl::clock \
    [list variable LibDir [file dirname [info script]]]

#----------------------------------------------------------------------
#
# clock --
#
#	Manipulate times.
#
# The 'clock' command manipulates time.  Refer to the user documentation
# for the available subcommands and what they do.
#
#----------------------------------------------------------------------	

namespace eval ::tcl::clock {

    # Export the subcommands

#
# Results:
#	None.
#
# Side effects:
#	Namespace variable in the 'clock' subsystem are initialized.
#
# The '::tcl::clock::Initialize' procedure initializes the namespace
# variables and root locale message catalog for the 'clock' subsystem.
# It is broken into a procedure rather than simply evaluated as a script
# so that it will be able to use local variables, avoiding the dangers
# of 'creative writing' as in Bug 1185933.
#
#----------------------------------------------------------------------

proc ::tcl::clock::Initialize {} {

    rename ::tcl::clock::Initialize {}

    ::msgcat::mcset pt GREGORIAN_CHANGE_DATE 2299161
    ::msgcat::mcset pl GREGORIAN_CHANGE_DATE 2299161

    # France, Austria

    ::msgcat::mcset fr GREGORIAN_CHANGE_DATE 2299227

    # For Belgium, we follow Southern Netherlands; Liege Diocese
    # changed several weeks later.

    ::msgcat::mcset fr_BE GREGORIAN_CHANGE_DATE 2299238
    ::msgcat::mcset nl_BE GREGORIAN_CHANGE_DATE 2299238

    # Austria

    ::msgcat::mcset de_AT GREGORIAN_CHANGE_DATE 2299527

    # Hungary

    ::msgcat::mcset hu GREGORIAN_CHANGE_DATE 2301004

    # Germany, Norway, Denmark (Catholic Germany changed earlier)

    ::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032    
    ::msgcat::mcset nn GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset no GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset da GREGORIAN_CHANGE_DATE 2342032

    # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed
    # at various times)

    ::msgcat::mcset nl GREGORIAN_CHANGE_DATE 2342165

    # Protestant Switzerland (Catholic cantons changed earlier)

    ::msgcat::mcset fr_CH GREGORIAN_CHANGE_DATE 2361342
    ::msgcat::mcset it_CH GREGORIAN_CHANGE_DATE 2361342

    ::msgcat::mcset sv GREGORIAN_CHANGE_DATE 2361390

    # Russia

    ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639

    # Romania (Transylvania changed earler - perhaps de_RO should show
    # the earlier date?)

    ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063

    # Greece

    ::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480
    
    #------------------------------------------------------------------
    #
    #				CONSTANTS
    #
    #------------------------------------------------------------------

    # Paths at which binary time zone data for the Olson libraries
    # are known to reside on various operating systems

    variable ZoneinfoPaths {}
    foreach path {
	/usr/share/zoneinfo
	/usr/share/lib/zoneinfo
	/usr/lib/zoneinfo
	/usr/local/etc/zoneinfo

    variable MINWIDE -9223372036854775808
    variable MAXWIDE 9223372036854775807

    # Day before Leap Day

    variable FEB_28	       58

    # 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 to specify $::env(TCL_TZ) rather than simply depending
    # on the system time zone.

    # The keys are long lists of values obtained from the time zone
    # information in the Registry.  In order, the list elements are:
    # 	Bias StandardBias DaylightBias
    #   StandardDate.wYear StandardDate.wMonth StandardDate.wDayOfWeek
    #   StandardDate.wDay StandardDate.wHour StandardDate.wMinute
    #   StandardDate.wSecond StandardDate.wMilliseconds
    #   DaylightDate.wYear DaylightDate.wMonth DaylightDate.wDayOfWeek
    #   DaylightDate.wDay DaylightDate.wHour DaylightDate.wMinute
    #   DaylightDate.wSecond DaylightDate.wMilliseconds
    # The values are the names of time zones where those rules apply.
    # There is considerable ambiguity in certain zones; an attempt has
    # been made to make a reasonable guess, but this table needs to be
    # taken with a grain of salt.

    variable WinZoneInfo [dict create {*}{
	{-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Kwajalein
	{-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}	 :Pacific/Midway
	{-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Honolulu
        {-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
        {-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles

	{36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0}  :Australia/Sydney
	{39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Pacific/Noumea
	{43200 0 3600 0 3 0 3 3 0 0 0 0 10 0 1 2 0 0 0}  :Pacific/Auckland
	{43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Pacific/Fiji
	{46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Pacific/Tongatapu
    }]

    # Groups of fields that specify the date, priorities, and 
    # code bursts that determine Julian Day Number given those groups.
    # The code in [clock scan] will choose the highest priority
    # (lowest numbered) set of fields that determines the date.

    variable DateParseActions {

	{ seconds } 0 {}

	{ julianDay } 1 {}

	{} 8 {
	    set date [AssignBaseJulianDay $date[set date {}] \
			  $baseTime $timeZone $changeover]
	}
    }

    # Groups of fields that specify time of day, priorities,
    # and code that processes them

    variable TimeParseActions {

	seconds 1 {}

	{ hourAMPM minute second amPmIndicator } 2 {
	    dict set date secondOfDay [InterpretHMSP $date]

}
::tcl::clock::Initialize

#----------------------------------------------------------------------
#
# clock format --
#
#	Formats a count of seconds since the Posix Epoch as a time
#	of day.
#
# The 'clock format' command formats times of day for output.
# Refer to the user documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::format { args } {

    variable FormatProc
    variable TZData

    lassign [ParseFormatArgs {*}$args] format locale timezone
    set locale [string tolower $locale]
    set clockval [lindex $args 0]

    # Get the data for time changes in the given zone
    
    if {$timezone eq ""} {
	set timezone [GetSystemTimeZone]
    }
    if {![info exists TZData($timezone)]} {
	if {[catch {SetupTimeZone $timezone} retval opts]} {
	    dict unset opts -errorinfo
	    return -options $opts $retval
	}
    }
    
    # Build a procedure to format the result. Cache the built procedure's
    # name in the 'FormatProc' array to avoid losing its internal
    # representation, which contains the name resolution.
    
    set procName formatproc'$format'$locale
    set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
    if {[info exists FormatProc($procName)]} {
	set procName $FormatProc($procName)
    } else {
	set FormatProc($procName) \
	    [ParseClockFormatFormat $procName $format $locale]
    }
    
    return [$procName $clockval $timezone]

}

#----------------------------------------------------------------------
#
# ParseClockFormatFormat --
#
#	Builds and caches a procedure that formats a time value.
#
# Parameters:
#	format -- Format string to use
#	locale -- Locale in which the format string is to be interpreted
#
# Results:
#	Returns the name of the newly-built procedure.
#
#----------------------------------------------------------------------

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

    # Change locale if a fresh locale has been given on the command line.

    set status [catch {

	ParseClockFormatFormat2 $format $locale $procName

    } result opts]


    # Restore the locale

    if { [info exists oldLocale] } {
	mclocale $oldLocale
    }

    # Return either the error or the proc name

    if { $status == 1 } {
	if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
	    return -code error $result
	} else {
	    return -options $opts $result
	}
    } else {
	return $result
    }

}

proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {

    set didLocaleEra 0
    set didLocaleNumerals 0
    set preFormatCode \
	[string map [list @GREGORIAN_CHANGE_DATE@ \
				       [mc GREGORIAN_CHANGE_DATE]] \
	     {
		 variable TZData

    return $procName
}

#----------------------------------------------------------------------
#
# clock scan --
#
#	Inputs a count of seconds since the Posix Epoch as a time
#	of day.
#
# The 'clock format' command scans times of day on input.
# Refer to the user documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::scan { args } {

    set format {}

    # Check the count of args

    if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
	set cmdName "clock scan"
	return -code error \

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
	return -code error \
	    -errorcode [list CLOCK gmtWithTimezone] \
	    "cannot use -gmt and -timezone in same call"
    }
    if { [catch { expr { wide($base) } } result] } {
	return -code error \
	    "expected integer but got \"$base\"" 
    }
    if { ![string is boolean $gmt] } {
	return -code error \
	    "expected boolean value but got \"$gmt\""
    } else {
	if { $gmt } {
	    set timezone :GMT
	}
    }

    if { ![info exists saw(-format)] } {
	# Perhaps someday we'll localize the legacy code. Right now,
	# it's not localized.
	if { [info exists saw(-locale)] } {
	    return -code error \
		-errorcode [list CLOCK flagWithLegacyFormat] \
		"legacy \[clock scan\] does not support -locale"

	}
	return [FreeScan $string $base $timezone $locale]
    }

    # Change locale if a fresh locale has been given on the command line.

    EnterLocale $locale oldLocale

    set status [catch {

	# Map away the locale-dependent composite format groups

	set scanner [ParseClockScanFormat $format $locale]
	$scanner $string $base $timezone



    } result opts]


    # Restore the locale

    if { [info exists oldLocale] } {
	mclocale $oldLocale
    }

    if { $status == 1 } {
	if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
	    return -code error $result
	} else {
	    return -options $opts $result
	}
    } else {
	return $result
    }

}

#----------------------------------------------------------------------
#
# FreeScan --
#
#	Scans a time in free format
#
# Parameters:
#	string - String containing the time to scan
#	base - Base time, expressed in seconds from the Epoch
#	timezone - Default time zone in which the time will be expressed
#	locale - (Unused) Name of the locale where the time will be scanned.
#
# Results:
#	Returns the date and time extracted from the string in seconds
#	from the epoch
#
#----------------------------------------------------------------------

proc ::tcl::clock::FreeScan { string base timezone locale } {

    variable TZData

    # Get the data for time changes in the given zone
    

    if {[catch {SetupTimeZone $timezone} retval opts]} {

	dict unset opts -errorinfo
	return -options $opts $retval
    }

    # Extract year, month and day from the base time for the
    # parser to use as defaults

    set date [GetDateFields \
		  $base \
		  $TZData($timezone) \
		  2361222]
    dict set date secondOfDay [expr { [dict get $date localSeconds] 

				      % 86400 }]

    # Parse the date.  The parser will return a list comprising
    # date, time, time zone, relative month/day/seconds, relative
    # weekday, ordinal month.

    set status [catch {

	Oldscan $string \
	    [dict get $date year] \
	    [dict get $date month] \
	    [dict get $date dayOfMonth]
    } result]
    if { $status != 0 } {
	return -code error "unable to convert date-time string \"$string\": $result"
    }

    lassign $result parseDate parseTime parseZone parseRel \
	parseWeekday parseOrdinalMonth





    # If the caller supplied a date in the string, update the 'date' dict
    # with the value. If the caller didn't specify a time with the date,
    # default to midnight.

    if { [llength $parseDate] > 0 } {
	lassign $parseDate y m d
	if { $y < 100 } {
	    if { $y >= 39 } {
		incr y 1900
	    } else {
		incr y 2000
	    }
	}
	dict set date era CE
	dict set date year $y
	dict set date month $m
	dict set date dayOfMonth $d
	if { $parseTime eq {} } {
	    set parseTime 0
	}
    }

    # If the caller supplied a time zone in the string, it comes back
    # as a two-element list; the first element is the number of minutes
    # east of Greenwich, and the second is a Daylight Saving Time
    # indicator ( 1 == yes, 0 == no, -1 == unknown ). We make it into
    # a time zone indicator of +-hhmm.
    
    if { [llength $parseZone] > 0 } {
	lassign $parseZone minEast dstFlag
	set timezone [FormatNumericTimeZone \
			  [expr { 60 * $minEast + 3600 * $dstFlag }]]
	SetupTimeZone $timezone
    }

	       || [llength $parseOrdinalMonth] != 0 
	       || ( [llength $parseRel] != 0 
		    && ( [lindex $parseRel 0] != 0
			 || [lindex $parseRel 1] != 0 ) ) } {
	dict set date secondOfDay 0
    }

    dict set date localSeconds \
	[expr { -210866803200
		+ ( 86400 * wide([dict get $date julianDay]) )
		+ [dict get $date secondOfDay] }]

    dict set date tzName $timezone
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) 2361222]
    set seconds [dict get $date seconds]

    # Do relative times

    if { [llength $parseRel] > 0 } {
	lassign $parseRel relMonth relDay relSecond
	set seconds [add $seconds \
			 $relMonth months $relDay days $relSecond seconds \
			 -timezone $timezone -locale $locale]
    }	

    # Do relative weekday
    
    if { [llength $parseWeekday] > 0 } {

	lassign $parseWeekday dayOrdinal dayOfWeek
	set date2 [GetDateFields $seconds $TZData($timezone) 2361222]
	dict set date2 era CE
	set jdwkday [WeekdayOnOrBefore $dayOfWeek \
			 [expr { [dict get $date2 julianDay] 
				 + 6 }]]
	incr jdwkday [expr { 7 * $dayOrdinal }]
	if { $dayOrdinal > 0 } {
	    incr jdwkday -7
	}
	dict set date2 secondOfDay \
	    [expr { [dict get $date2 localSeconds] % 86400 }]
	dict set date2 julianDay $jdwkday
	dict set date2 localSeconds \
	    [expr { -210866803200
		    + ( 86400 * wide([dict get $date2 julianDay]) )
		    + [dict get $date secondOfDay] }]

	dict set date2 tzName $timezone
	set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
		       2361222]
	set seconds [dict get $date2 seconds]

    }

    # Do relative month

    if { [llength $parseOrdinalMonth] > 0 } {

	lassign $parseOrdinalMonth monthOrdinal monthNumber
	if { $monthOrdinal > 0 } {
	    set monthDiff [expr { $monthNumber - [dict get $date month] }]
	    if { $monthDiff <= 0 } {
		incr monthDiff 12
	    }
	    incr monthOrdinal -1
	} else {
	    set monthDiff [expr { [dict get $date month] - $monthNumber }]
	    if { $monthDiff >= 0 } {
		incr monthDiff -12
	    }
	    incr monthOrdinal
	}
	set seconds [add $seconds $monthOrdinal years $monthDiff months \
			 -timezone $timezone -locale $locale]

    }

    return $seconds
}


#----------------------------------------------------------------------
#
# ParseClockScanFormat --
#
#	Parses a format string given to [clock scan -format]
#
# Parameters:
#	formatString - The format being parsed
#	locale - The current locale
#
# Results:
#	Constructs and returns a procedure that accepts the
#	string being scanned, the base time, and the time zone.  
#	The procedure will either return the scanned time or
#	else throw an error that should be rethrown to the caller
#	of [clock scan]
#
# Side effects:
#	The given procedure is defined in the ::tcl::clock
#	namespace.  Scan procedures are not deleted once installed.
#
# Why do we parse dates by defining a procedure to parse them?
# The reason is that by doing so, we have one convenient place to
# cache all the information: the regular expressions that match the
# patterns (which will be compiled), the code that assembles the
# date information, everything lands in one place.  In this way,
# when a given format is reused at run time, all the information
# of how to apply it is available in a single place.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ParseClockScanFormat {formatString locale} {

    # Check whether the format has been parsed previously, and return
    # the existing recognizer if it has.

    set procName scanproc'$formatString'$locale
    set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
    if { [namespace which $procName] != {} } {
	return $procName
    }

	    {} {
		if { $c eq "%" } {
		    set state %
		} elseif { $c eq " " } {
		    append re {[[:space:]]+}
		} else {
		    if { ! [string is alnum $c] } {
			append re \\
			}
		    append re $c
		}
	    }
	    % {
		set state {}
		switch -exact -- $c {
		    % {

		    J {			# Julian Day Number
			append re \\s*(\\d+)
			dict set fieldSet julianDay [incr fieldCount]
			append postcode "dict set date julianDay \[" \
			    "::scan \$field" [incr captureCount] " %ld" \
			    "\]\n"
		    }
		    m - N {			# Month number
			append re \\s*(\\d\\d?)
			dict set fieldSet month [incr fieldCount]
			append postcode "dict set date month \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    M {			# Minute

			append postcode {dict set date seconds } \[ \
			    {ParseStarDate $field} [incr captureCount] \
			    { $field} [incr captureCount] \
			    { $field} [incr captureCount] \
			    \] \n
		    }
		    s {			# Seconds from Posix Epoch
			# This next case is insanely difficult,
			# because it's problematic to determine
			# whether the field is actually within
			# the range of a wide integer.
			append re {\s*([-+]?\d+)}
			dict set fieldSet seconds [incr fieldCount]
			append postcode {dict set date seconds } \[ \
			    {ScanWide $field} [incr captureCount] \] \n
		    }
		    S {			# Second
			append re \\s*(\\d\\d?)

				    return -code error \
					-errorcode [list CLOCK badDayOfWeek] \
					"day of week is greater than 7"
				}
				dict set date dayOfWeek $dow
			    }
		    }
		    U {			# Week of year. The
					# first Sunday of the year is the
					# first day of week 01. No scan rule
					# uses this group.
			append re \\s*\\d\\d?
		    }
		    V {			# Week of ISO8601 year
			
			append re \\s*(\\d\\d?)
			dict set fieldSet iso8601Week [incr fieldCount]
			append postcode "dict set date iso8601Week \[" \

    if { ![dict exists $fieldSet seconds] 
         && ![dict exists $fieldSet starDate] } {
	append procBody {
	    if { [dict get $date julianDay] > 5373484 } {
		return -code error -errorcode [list CLOCK dateTooLarge] \
		    "requested date too large to represent"
	    }
	    dict set date localSeconds \
		[expr { -210866803200
			+ ( 86400 * wide([dict get $date julianDay]) )
			+ [dict get $date secondOfDay] }]

	}
    }

    if { ![dict exists $fieldSet seconds] 
	 && ![dict exists $fieldSet starDate] } {
	if { [dict exists $fieldSet tzName] } {
	    append procBody {
		set timeZone [dict get $date tzName]
	    }
	}
	append procBody {
	    ::tcl::clock::SetupTimeZone $timeZone
	    set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
			  $TZData($timeZone) \
			  $changeover]
	}
    }

    # Return result

    append procBody {return [dict get $date seconds]} \n

    proc $procName { string baseTime timeZone } $procBody

    # puts [list proc $procName [list string baseTime timeZone] $procBody]

    return $procName
}
	
#----------------------------------------------------------------------
#
# LocaleNumeralMatcher --
#
#	Composes a regexp that captures the numerals in the given
#	locale, and a dictionary to map them to conventional numerals.
#
# Parameters:
#	locale - Name of the current locale
#
# Results:
#	Returns a two-element list comprising the regexp and the
#	dictionary.
#
# Side effects:
#	Caches the result.
#
#----------------------------------------------------------------------

proc ::tcl::clock::LocaleNumeralMatcher {l} {

    variable LocaleNumeralCache

    if { ![dict exists $LocaleNumeralCache $l] } {
	set d {}
	set i 0
	set sep \(
	foreach n [mc LOCALE_NUMERALS] {

	


#----------------------------------------------------------------------
#
# UniquePrefixRegexp --
#
#	Composes a regexp that performs unique-prefix matching.  The
#	RE matches one of a supplied set of strings, or any unique
#	prefix thereof.
#
# Parameters:
#	data - List of alternating match-strings and values.
#	       Match-strings with distinct values are considered
#	       distinct.
#
# Results:
#	Returns a two-element list.  The first is a regexp that
#	matches any unique prefix of any of the strings.  The second
#	is a dictionary whose keys are match values from the regexp
#	and whose values are the corresponding values from 'data'.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::UniquePrefixRegexp { data } {

    # The 'successors' dictionary will contain, for each string that
    # is a prefix of any key, all characters that may follow that
    # prefix.  The 'prefixMapping' dictionary will have keys that
    # are prefixes of keys and values that correspond to the keys.

    set prefixMapping [dict create]
    set successors [dict create {} {}]

    # Walk the key-value pairs

    foreach { key value } $data {

	# Construct all prefixes of the key; 

	set prefix {}
	foreach char [split $key {}] {
	    set oldPrefix $prefix
	    dict set successors $oldPrefix $char {}
	    append prefix $char

	    # Put the prefixes in the 'prefixMapping' and 'successors'
	    # dictionaries

	    dict lappend prefixMapping $prefix $value
	    if { ![dict exists $successors $prefix] } {
		dict set successors $prefix {}
	    }
	}
    }

    # Identify those prefixes that designate unique values, and
    # those that are the full keys

    set uniquePrefixMapping {}
    dict for { key valueList } $prefixMapping {
	if { [llength $valueList] == 1 } {
	    dict set uniquePrefixMapping $key [lindex $valueList 0]
	}
    }

		$uniquePrefixMapping]
}

#----------------------------------------------------------------------
#
# MakeUniquePrefixRegexp --
#
#	Service procedure for 'UniquePrefixRegexp' that constructs
#	a regular expresison that matches the unique prefixes.
#
# Parameters:
#	successors - Dictionary whose keys are all prefixes
#		     of keys passed to 'UniquePrefixRegexp' and whose
#		     values are dictionaries whose keys are the characters
#		     that may follow those prefixes.
#	uniquePrefixMapping - Dictionary whose keys are the unique
#			      prefixes and whose values are not examined.
#	prefixString - Current prefix being processed.
#
# Results:
#	Returns a constructed regular expression that matches the set
#	of unique prefixes beginning with the 'prefixString'.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

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]]]
    if { [llength $schars] == 0 } {
	return {}
    }

    # If there is more than one successor character, or if the current
    # prefix is a unique prefix, surround the generated re with non-capturing
    # parentheses.

    set re {}

    if { [dict exists $uniquePrefixMapping $prefixString]
	 || [llength $schars] > 1 } {

	append re "(?:"
    }

    # Generate a regexp that matches the successors.

    set sep ""
    foreach { c } $schars {

    # If the current prefix is a unique prefix, make all following text
    # optional. Otherwise, if there is more than one successor character,
    # close the non-capturing parentheses.

    if { [dict exists $uniquePrefixMapping $prefixString] } {
	append re ")?"
    }  elseif { [llength $schars] > 1 } {
	append re ")"
    }

    return $re
}

#----------------------------------------------------------------------
#
# MakeParseCodeFromFields --
#
#	Composes Tcl code to extract the Julian Day Number from a
#	dictionary containing date fields.
#
# Parameters:
#	dateFields -- Dictionary whose keys are fields of the date,
#	              and whose values are the rightmost positions
#		      at which those fields appear.
#	parseActions -- List of triples: field set, priority, and
#			code to emit.  Smaller priorities are better, and
#			the list must be in ascending order by priority
#
# Results:
#	Returns a burst of code that extracts the day number from the
#	given date.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {

    set currPrio 999
    set currFieldPos [list]
    set currCodeBurst {
	error "in ::tcl::clock::MakeParseCodeFromFields: can't happen"
    }

    foreach { fieldSet prio parseAction } $parseActions {

	# If we've found an answer that's better than any that follow,
	# quit now.

	if { $prio > $currPrio } {
	    break
	}

	# Accumulate the field positions that are used in the current
	# field grouping.

	set fieldPos [list]
	set ok true
	foreach field $fieldSet {
	    if { ! [dict exists $dateFields $field] } {
		set ok 0
		break

	# Determine whether the current answer is better than the last.

	set fPos [lsort -integer -decreasing $fieldPos]

	if { $prio ==  $currPrio } {
	    foreach currPos $currFieldPos newPos $fPos {

		if { ![string is integer $newPos]
		     || ![string is integer $currPos]
		     || $newPos > $currPos } {

		    break
		}
		if { $newPos < $currPos } {
		    set ok 0
		    break
		}
	    }
	}
	if { !$ok } {
	    continue
	}

	# Remember the best possibility for extracting date information

	set currPrio $prio
	set currFieldPos $fPos
	set currCodeBurst $parseAction
	    
    }

    return $currCodeBurst

}

#----------------------------------------------------------------------
#
# EnterLocale --
#
#	Switch [mclocale] to a given locale if necessary
#
# 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.
#
#----------------------------------------------------------------------

proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {

    upvar 1 $oldLocaleVar oldLocale

    variable MsgDir
    variable McLoaded

    set oldLocale [mclocale]
    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


	    if {![dict exists $McLoaded $oldLocale] } {
		mcload $MsgDir
		dict set McLoaded $oldLocale {}
	    }

	    # Make a new locale string for the system locale, and
	    # get the Control Panel information

	    set locale ${oldLocale}_windows
	    if { ![dict exists $McLoaded $locale] } {
		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 {}
    }

}    

#----------------------------------------------------------------------
#
# LoadWindowsDateTimeFormats --
#
#	Load the date/time formats from the Control Panel in Windows
#	and convert them so that they're usable by Tcl.
#
# Parameters:
#	locale - Name of the locale in whose message catalog
#	         the converted formats are to be stored.
#
# Results:
#	None.
#
# Side effects:
#	Updates the given message catalog with the locale strings.
#
# Presumes that on entry, [mclocale] is set to the current locale,
# so that default strings can be obtained if the Registry query
# fails.
#
#----------------------------------------------------------------------

proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {

    # Bail out if we can't find the Registry

    variable NoRegistry
    if { [info exists NoRegistry] } return

    if { ![catch {
	registry get "HKEY_CURRENT_USER\\Control Panel\\International" \

	::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt"
    }
    catch {
	::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt"
    }

    return

}

#----------------------------------------------------------------------
#
# LocalizeFormat --
#
#	Map away locale-dependent format groups in a clock format.
#
# Parameters:
#	locale -- Current [mclocale] locale, supplied to avoid
#		  an extra call
#	format -- Format supplied to [clock scan] or [clock format]
#
# Results:
#	Returns the string with locale-dependent composite format
#	groups substituted out.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

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

    # Handle locale-dependent format groups by mapping them out of
    # the input string.  Note that the order of the [string map]
    # operations is significant because earlier formats can refer
    # to later ones; for example %c can refer to %X, which in turn
    # can refer to %T.
    
    set format [string map [list %c [mc DATE_TIME_FORMAT] \
				%Ec [mc LOCALE_DATE_TIME_FORMAT]] $format]
    set format [string map [list %x [mc DATE_FORMAT] \
				%Ex [mc LOCALE_DATE_FORMAT] \
				%X [mc TIME_FORMAT] \
				%EX [mc LOCALE_TIME_FORMAT]] $format]

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::FormatNumericTimeZone { z } {

    if { $z < 0 } {
	set z [expr { - $z }]
	set retval -
    } else {
	set retval +
    }
    append retval [::format %02d [expr { $z / 3600 }]]
    set z [expr { $z % 3600 }]
    append retval [::format %02d [expr { $z / 60 }]]
    set z [expr { $z % 60 }]
    if { $z != 0 } {
	append retval [::format %02d $z]
    }
    return $retval

}

#----------------------------------------------------------------------
#
# FormatStarDate --
#
#	Formats a date as a StarDate.

#
# Jeff Hobbs put this in to support an atrocious pun about Tcl being
# "Enterprise ready."  Now we're stuck with it.
#
#----------------------------------------------------------------------

proc ::tcl::clock::FormatStarDate { date } {

    variable Roddenberry

    # Get day of year, zero based

    set doy [expr { [dict get $date dayOfYear] - 1 }]

    # Determine whether the year is a leap year

#
# Jeff Hobbs put this in to support an atrocious pun about Tcl being
# "Enterprise ready."  Now we're stuck with it.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {

    variable Roddenberry

    # Build a tentative date from year and fraction.

    set date [dict create \
		  gregorian 1 \
		  era CE \
		  year [expr { $year + $Roddenberry }] \
		  dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]]
    set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]

    # Determine whether the given year is a leap year

    set lp [IsGregorianLeapYear $date]

    # Reconvert the fractional year according to whether the given
    # year is a leap year

    if { $lp } {
	dict set date dayOfYear \
	    [expr { $fractYear * 366 / 1000 + 1 }]
    } else {
	dict set date dayOfYear \
	    [expr { $fractYear * 365 / 1000 + 1 }]
    }
    dict unset date julianDay
    dict unset date gregorian
    set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]


    return [expr { 86400 * [dict get $date julianDay]
		   - 210866803200
		   + ( 86400 / 10 ) * $fractDay }]

}

#----------------------------------------------------------------------
#
# ScanWide --
#
#	Scans a wide integer from an input
#
# Parameters:
#	str - String containing a decimal wide integer
#
# Results:
#	Returns the string as a pure wide integer.  Throws an error if
#	the string is misformatted or out of range.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ScanWide { str } {
    set count [::scan $str {%ld %c} result junk]
    if { $count != 1 } {
	return -code error -errorcode [list CLOCK notAnInteger $str] \
	    "\"$str\" is not an integer"
    }
    if { [incr result 0] != $str } {
	return -code error -errorcode [list CLOCK integervalueTooLarge] \
	    "integer value too large to represent"
    }
    return $result
}

#----------------------------------------------------------------------
#
# InterpretTwoDigitYear --
#
#	Given a date that contains only the year of the century,
#	determines the target value of a two-digit year.
#
# Parameters:
#	date - Dictionary containing fields of the date.
#	baseTime - Base time relative to which the date is expressed.
#	twoDigitField - Name of the field that stores the two-digit year.
#			Default is 'yearOfCentury'
#	fourDigitField - Name of the field that will receive the four-digit
#	                 year.  Default is 'year'
#
# Results:
#	Returns the dictionary augmented with the four-digit year, stored in
#	the given key.
#
# Side effects:
#	None.
#
# The current rule for interpreting a two-digit year is that the year
# shall be between 1937 and 2037, thus staying within the range of a
# 32-bit signed value for time.  This rule may change to a sliding
# window in future versions, so the 'baseTime' parameter (which is
# currently ignored) is provided in the procedure signature.
#
#----------------------------------------------------------------------

proc ::tcl::clock::InterpretTwoDigitYear { date baseTime 
					   { twoDigitField yearOfCentury }
					   { fourDigitField year } } {

    set yr [dict get $date $twoDigitField]
    if { $yr <= 37 } {
	dict set date $fourDigitField [expr { $yr + 2000 }]
    } else {
	dict set date $fourDigitField [expr { $yr + 1900 }]
    }
    return $date

}

#----------------------------------------------------------------------
#
# AssignBaseYear --
#
#	Places the number of the current year into a dictionary.

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } {

    variable TZData

    # Find the Julian Day Number corresponding to the base time, and
    # find the Gregorian year corresponding to that Julian Day.

    set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]

    # Store the converted year

    dict set date era [dict get $date2 era]
    dict set date year [dict get $date2 year]

    return $date

}

#----------------------------------------------------------------------
#
# AssignBaseIso8601Year --
#
#	Determines the base year in the ISO8601 fiscal calendar.

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} {

    variable TZData

    # Find the Julian Day Number corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]

    # Calculate the ISO8601 date and transfer the year

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} {

    variable TZData

    # Find the year and month corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]
    dict set date era [dict get $date2 era]
    dict set date year [dict get $date2 year]
    dict set date month [dict get $date2 month]
    return $date

}

#----------------------------------------------------------------------
#
# AssignBaseWeek --
#
#	Determines the base year and week in the ISO8601 fiscal calendar.

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} {

    variable TZData

    # Find the Julian Day Number corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]

    # Calculate the ISO8601 date and transfer the year

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } {

    variable TZData

    # Find the Julian Day Number corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
    dict set date julianDay [dict get $date2 julianDay]

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::InterpretHMSP { date } {

    set hr [dict get $date hourAMPM]
    if { $hr == 12 } {
	set hr 0
    }
    if { [dict get $date amPmIndicator] } {
	incr hr 12
    }
    dict set date hour $hr
    return [InterpretHMS $date[set date {}]]

}

#----------------------------------------------------------------------
#
# InterpretHMS --
#
#	Interprets a 24-hour time "hh:mm:ss"

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::InterpretHMS { date } {

    return [expr { ( [dict get $date hour] * 60
		     + [dict get $date minute] ) * 60
		   + [dict get $date second] }]

}

#----------------------------------------------------------------------
#
# GetSystemTimeZone --
#
#	Determines the system time zone, which is the default for the

# Side effects:
#	Stores the sustem time zone in the 'CachedSystemTimeZone'
#	variable, since determining it may be an expensive process.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetSystemTimeZone {} {

    variable CachedSystemTimeZone
    variable TimeZoneBad

    if {[set result [getenv TCL_TZ]] ne {}} {
	set timezone $result
    } elseif {[set result [getenv TZ]] ne {}} {
	set timezone $result

	dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
    }
    if { [dict get $TimeZoneBad $timezone] } {
	return :localtime
    } else {
	return $timezone
    }

}

#----------------------------------------------------------------------
#
# ConvertLegacyTimeZone --
#
#	Given an alphanumeric time zone identifier and the system
#	time zone, convert the alphanumeric identifier to an
#	unambiguous time zone.
#
# Parameters:
#	tzname - Name of the time zone to convert
#
# Results:
#	Returns a time zone name corresponding to tzname, but
#	in an unambiguous form, generally +hhmm.
#
# This procedure is implemented primarily to allow the parsing of
# RFC822 date/time strings.  Processing a time zone name on input
# is not recommended practice, because there is considerable room
# for ambiguity; for instance, is BST Brazilian Standard Time, or
# British Summer Time?
#
#----------------------------------------------------------------------

proc ::tcl::clock::ConvertLegacyTimeZone { tzname } {

    variable LegacyTimeZone

    set tzname [string tolower $tzname]
    if { ![dict exists $LegacyTimeZone $tzname] } {
	return -code error -errorcode [list CLOCK badTZName $tzname] \
	    "time zone \"$tzname\" not found"
    } else {
	return [dict get $LegacyTimeZone $tzname]
    }

}

#----------------------------------------------------------------------
#
# SetupTimeZone --
#
#	Given the name or specification of a time zone, sets up
#	its in-memory data.
#
# Parameters:
#	tzname - Name of a time zone
#
# Results:
#	Unless the time zone is ':localtime', sets the TZData array
#	to contain the lookup table for local<->UTC conversion.
#	Returns an error if the time zone cannot be parsed.
#
#----------------------------------------------------------------------

proc ::tcl::clock::SetupTimeZone { timezone } {

    variable TZData

    if {! [info exists TZData($timezone)] } {
	variable MINWIDE
	if { $timezone eq {:localtime} } {

	    # Nothing to do, we'll convert using the localtime function


	} elseif { [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
		    -> s hh mm ss] } {

	    # Make a fixed offset

	    ::scan $hh %d hh
	    if { $mm eq {} } {
		set mm 0
	    } else {
		::scan $mm %d mm
	    }
	    if { $ss eq {} } {
		set ss 0
	    } else {
		::scan $ss %d ss
	    }
	    set offset [expr { ( $hh * 60 + $mm ) * 60 + $ss }]
	    if { $s eq {-} } {
		set offset [expr { - $offset }]
	    }
	    set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]]

	} elseif { [string index $timezone 0] eq {:} } {
	    
	    # Convert using a time zone file

	    if { 
		[catch {
		    LoadTimeZoneFile [string range $timezone 1 end]
		}]
		&& [catch {
		    LoadZoneinfoFile [string range $timezone 1 end]
		}]
	    } {
		return -code error \
		    -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

	    if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
		if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
		    dict unset opts -errorinfo
		}
		return -options $opts $data
	    } else {
		set TZData($timezone) $data
	    }

	} else {

	    # We couldn't parse this as a POSIX time zone.  Try
	    # again with a time zone file - this time without a colon

	    if { [catch { LoadTimeZoneFile $timezone }]
		 && [catch { LoadZoneinfoFile $timezone } - opts] } {
		dict unset opts -errorinfo
		return -options $opts "time zone $timezone not found"
	    }
	    set TZData($timezone) $TZData(:$timezone)

#
#	Determines the system time zone on windows.
#
# Parameters:
#	None.
#
# Results:
#	Returns a time zone specifier that corresponds to the system
#	time zone information found in the Registry.
#
# Bugs:
#	Fixed dates for DST change are unimplemented at present, because
#	no time zone information supplied with Windows actually uses
#	them!
#
# On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is 
# specified, GuessWindowsTimeZone looks in the Registry for the
# system time zone information.  It then attempts to find an entry
# in WinZoneInfo for a time zone that uses the same rules.  If
# it finds one, it returns it; otherwise, it constructs a Posix-style
# time zone string and returns that.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GuessWindowsTimeZone {} {

    variable WinZoneInfo
    variable NoRegistry
    variable TimeZoneBad

    if { [info exists NoRegistry] } {
	return :localtime
    }

	}
	set daytzi [registry get $rpath DaylightStart]
	foreach ind {0 2 14 4 6 8 10 12} {
	    binary scan $daytzi @${ind}s val
	    lappend data $val
	}
    }] } {

	# Missing values in the Registry - bail out

	return :localtime
    }

    # Make up a Posix time zone specifier if we can't find one.
    # Check here that the tzdata file exists, in case we're running
    # in an environment (e.g. starpack) where tzdata is incomplete.
    # (Bug 1237907)

    if { [dict exists $WinZoneInfo $data] } {
	set tzname [dict get $WinZoneInfo $data]
	if { ! [dict exists $TimeZoneBad $tzname] } {
	    dict set TimeZoneBad $tzname [catch {SetupTimeZone $tzname}]
	}
    } else {

	    set hh [::format %02d [expr { $dstDelta / 3600 }]]
	    set mm [::format %02d [expr { ($dstDelta / 60 ) % 60 }]]
	    set ss [::format %02d [expr { $dstDelta % 60 }]]
	    append tzname < $dispDstSignum $hh $mm > $dstSignum $hh : $mm : $ss
	    if { $dstYear == 0 } {
		append tzname ,M $dstMonth . $dstDayOfMonth . $dstDayOfWeek
	    } else {
		# I have not been able to find any locale on which
		# Windows converts time zone on a fixed day of the year,
		# hence don't know how to interpret the fields.
		# If someone can inform me, I'd be glad to code it up.
		# For right now, we bail out in such a case.
		return :localtime
	    }
	    append tzname / [::format %02d $dstHour] \
		: [::format %02d $dstMinute] \
		: [::format %02d $dstSecond]
	    if { $stdYear == 0 } {
		append tzname ,M $stdMonth . $stdDayOfMonth . $stdDayOfWeek
	    } else {
		# I have not been able to find any locale on which
		# Windows converts time zone on a fixed day of the year,
		# hence don't know how to interpret the fields.
		# If someone can inform me, I'd be glad to code it up.
		# For right now, we bail out in such a case.
		return :localtime
	    }
	    append tzname / [::format %02d $stdHour] \
		: [::format %02d $stdMinute] \
		: [::format %02d $stdSecond]
	}
	dict set WinZoneInfo $data $tzname
    } 

    return [dict get $WinZoneInfo $data]

}

#----------------------------------------------------------------------
#
# LoadTimeZoneFile --
#
#	Load the data file that specifies the conversion between a

    variable DataDir
    variable TZData

    if { [info exists TZData($fileName)] } {
	return
    }

    # Since an unsafe interp uses the [clock] command in the master,
    # this code is security sensitive.  Make sure that the path name
    # cannot escape the given directory.

    if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
	return -code error \
	    -errorcode [list CLOCK badTimeZone $:fileName] \
	    "time zone \":$fileName\" not valid"
    }
    if { [catch {
	source -encoding utf-8 [file join $DataDir $fileName]
    }] } {
	return -code error \
	    -errorcode [list CLOCK badTimeZone :$fileName] \
	    "time zone \":$fileName\" not found"
    }
    return
}

#----------------------------------------------------------------------
#
# LoadZoneinfoFile --
#
#	Loads a binary time zone information file in Olson format.
#
# Parameters:
#	fileName - Relative path name of the file to load.
#
# Results:
#	Returns an empty result normally; returns an error if no
#	Olson file was found or the file was malformed in some way.
#
# Side effects:
#	TZData(:fileName) contains the time zone data
#
#----------------------------------------------------------------------

proc ::tcl::clock::LoadZoneinfoFile { fileName } {

    variable ZoneinfoPaths

    # Since an unsafe interp uses the [clock] command in the master,
    # this code is security sensitive.  Make sure that the path name
    # cannot escape the given directory.

    if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
	return -code error \
	    -errorcode [list CLOCK badTimeZone $:fileName] \
	    "time zone \":$fileName\" not valid"
    }
    foreach d $ZoneinfoPaths {

#
# Parameters:
#	fileName - Name of the time zone (relative path name of the
#		   file).
#	fname - Absolute path name of the file.
#
# Results:
#	Returns an empty result normally; returns an error if no
#	Olson file was found or the file was malformed in some way.
#
# Side effects:
#	TZData(:fileName) contains the time zone data
#
#----------------------------------------------------------------------


proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
    variable MINWIDE
    variable TZData
    if { ![info exists fname] } {
	return -code error "$fileName not found"
    }

    if { [file size $fname] > 262144 } {
	return -code error "$fileName too big"
    }

    # Suck in all the data from the file

    set f [open $fname r]
    fconfigure $f -translation binary
    set d [read $f]
    close $f

    # The file begins with a magic number, sixteen reserved bytes,
    # and then six 4-byte integers giving counts of fileds in the file.

    binary scan $d a4a1x15IIIIII \
	magic version nIsGMT nIsStd nLeap nTime nType nChar
    set seek 44
    set ilen 4
    set iformat I
    if { $magic != {TZif} } {
	return -code error "$fileName not a time zone information file"
    }
    if { $nType > 255 } {
	return -code error "$fileName contains too many time types"
    }
    # Accept only Posix-style zoneinfo.  Sorry, 'leaps' bigots.
    if { $nLeap != 0 } {
	return -code error "$fileName contains leap seconds"
    }

    # In a version 2 file, we use the second part of the file, which
    # contains 64-bit transition times.

    if {$version eq "2"} {
	set seek [expr {44

			+ 5 * $nTime 
			+ 6 * $nType 
			+ 4 * $nLeap
			+ $nIsStd 
			+ $nIsGMT
			+ $nChar
		    }]
	binary scan $d @${seek}a4a1x15IIIIII \
	    magic version nIsGMT nIsStd nLeap nTime nType nChar
	if {$magic ne {TZif}} {
	    return -code error "seek address $seek miscomputed, magic = $magic"
	}
	set iformat W
	set ilen 8

    set times [linsert $times 0 $MINWIDE]
    set codes {}
    foreach c $tempCodes {
	lappend codes [expr { $c & 0xff }]
    }
    set codes [linsert $codes 0 0]

    # Next come ${nType} time type descriptions, each of which has an
    # offset (seconds east of GMT), a DST indicator, and an index into
    # the abbreviation text.

    for { set i 0 } { $i < $nType } { incr i } {
	binary scan $d @${seek}Icc gmtOff isDst abbrInd
	lappend types [list $gmtOff $isDst $abbrInd]
	incr seek 6
    }

    # Next come $nChar characters of time zone name abbreviations,
    # which are null-terminated.
    # We build them up into a dictionary indexed by character index,
    # because that's what's in the indices above.

    binary scan $d @${seek}a${nChar} abbrs
    incr seek ${nChar}
    set abbrList [split $abbrs \0]
    set i 0
    set abbrevs {}
    foreach a $abbrList {

	set lastTime $t
	lassign [lindex $types $c] gmtoff isDst abbrInd
	set abbrev [dict get $abbrevs $abbrInd]
	lappend r [list $t $gmtoff $isDst $abbrev]
    }

    # In a version 2 file, there is also a POSIX-style time zone description
    # at the very end of the file.  To get to it, skip over
    # nLeap leap second values (8 bytes each),
    # nIsStd standard/DST indicators and nIsGMT UTC/local indicators.

    if {$version eq {2}} {
	set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}]
	set last [string first \n $d $seek]
	set posix [string range $d $seek [expr {$last-1}]]
	if {[llength $posix] > 0} {

#
#	Parses the TZ environment variable in Posix form
#
# Parameters:
#	tz	Time zone specifier to be interpreted
#
# Results:
#	Returns a dictionary whose values contain the various pieces of
#	the time zone specification.
#
# Side effects:
#	None.
#
# Errors:
#	Throws an error if the syntax of the time zone is incorrect.
#

#	startSeconds - The seconds part of the time of day at which DST begins.
#		       An empty string is presumed zero.
#	endDayOfYear, endJ, endMonth, endWeekOfMonth, endDayOfWeek,
#	endHours, endMinutes, endSeconds -
#		Specify the end of DST in the same way that the start* fields
#		specify the beginning of DST.
#		
# This procedure serves only to break the time specifier into fields.
# No attempt is made to canonicalize the fields or supply default values.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ParsePosixTimeZone { tz } {

    if {[regexp -expanded -nocase -- {
	^
	# 1 - Standard time zone name
	([[:alpha:]]+ | <[-+[:alnum:]]+>)
	# 2 - Standard time zone offset, signum
	([-+]?)
	# 3 - Standard time zone offset, hours

	     x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \
	     x(startJ) x(startDayOfYear) \
	     x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \
	     x(startHours) x(startMinutes) x(startSeconds) \
	     x(endJ) x(endDayOfYear) \
	     x(endMonth) x(endWeekOfMonth) x(endDayOfWeek) \
	     x(endHours) x(endMinutes) x(endSeconds)] } {

	# it's a good timezone

	return [array get x]

    } else {

	return -code error\
	    -errorcode [list CLOCK badTimeZone $tz] \
	    "unable to parse time zone specification \"$tz\""

    }

}

#----------------------------------------------------------------------
#
# ProcessPosixTimeZone --
#
#	Handle a Posix time zone after it's been broken out into
#	fields.
#
# Parameters:
#	z - Dictionary returned from 'ParsePosixTimeZone'
#
# Results:
#	Returns time zone information for the 'TZData' array.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ProcessPosixTimeZone { z } {

    variable MINWIDE
    variable TZData

    # Determine the standard time zone name and seconds east of Greenwich

    set stdName [dict get $z stdName]
    if { [string index $stdName 0] eq {<} } {

	set stdMinutes 0
    }
    if { [dict get $z stdSeconds] ne {} } {
	set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0] 
    } else {
	set stdSeconds 0
    }
    set stdOffset [expr { ( ( $stdHours * 60 + $stdMinutes )
			    * 60 + $stdSeconds )
			  * $stdSignum }]
    set data [list [list $MINWIDE $stdOffset 0 $stdName]]

    # If there's no daylight zone, we're done

    set dstName [dict get $z dstName]
    if { $dstName eq {} } {
	return $data

	    set dstMinutes 0
	}
	if { [dict get $z dstSeconds] ne {} } {
	    set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0] 
	} else {
	    set dstSeconds 0
	}
	set dstOffset [expr { ( ( $dstHours * 60 + $dstMinutes )
				* 60 + $dstSeconds )
			      * $dstSignum }]
    }

    # Fill in defaults for European or US DST rules

    if { [dict get $z startDayOfYear] eq {} 
	 && [dict get $z startMonth] eq {} } {

	if {($stdHours>=0) && ($stdHours<=12)} {
	    dict set z startWeekOfMonth 5
	    if {$stdHours>2} {
		dict set z startHours 2
	    } else {
		dict set z startHours [expr {$stdHours+1}]
	    }
	} else {
	    dict set z startWeekOfMonth 2
	    dict set z startHours 2
	}
	dict set z startMonth 3
	dict set z startDayOfWeek 0
	dict set z startMinutes 0
	dict set z startSeconds 0
    }
    if { [dict get $z endDayOfYear] eq {} 
	 && [dict get $z endMonth] eq {} } {

	if {($stdHours>=0) && ($stdHours<=12)} {
	    dict set z endMonth 10
	    dict set z endWeekOfMonth 5
	    if {$stdHours>2} {
		dict set z endHours 3
	    } else {
		dict set z endHours [expr {$stdHours+2}]

	    lappend data \
		[list $endTime $stdOffset 0 $stdName] \
		[list $startTime $dstOffset 1 $dstName]
	}
    }

    return $data
    
}    

#----------------------------------------------------------------------
#
# DeterminePosixDSTTime --
#
#	Determines the time that Daylight Saving Time starts or ends
#	from a Posix time zone specification.
#
# Parameters:
#	z - Time zone data returned from ParsePosixTimeZone.
#	    Missing fields are expected to be filled in with
#	    default values.
#	bound - The word 'start' or 'end'
#	y - The year for which the transition time is to be determined.
#
# Results:
#	Returns the transition time as a count of seconds from
#	the epoch.  The time is relative to the wall clock, not UTC.
#
#----------------------------------------------------------------------

proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {

    variable FEB_28

    # Determine the start or end day of DST

    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 {}
	     && [IsGregorianLeapYear $y] 
	     && ( $doy > $FEB_28 ) } {
	    incr doy
	}
	dict set date dayOfYear $doy
	set date [GetJulianDayFromEraYearDay $date[set date {}] 2361222]
    } else {

	# Time was specified as a day of the week within a month

	dict set date month [dict get $z ${bound}Month]
	dict set date dayOfWeek [dict get $z ${bound}DayOfWeek]
	set dowim [dict get $z ${bound}WeekOfMonth]
	if { $dowim >= 5 } {
	    set dowim -1
	}
	dict set date dayOfWeekInMonth $dowim
	set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}] 2361222]

    }

    set jd [dict get $date julianDay]
    set seconds [expr { wide($jd) * wide(86400)
			- wide(210866803200) }]


    set h [dict get $z ${bound}Hours]
    if { $h eq {} } {
	set h 2
    } else {
	set h [lindex [::scan $h %d] 0]
    }

    if { $s eq {} } {
	set s 0
    } else {
	set s [lindex [::scan $s %d] 0]
    }
    set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
    return [expr { $seconds + $tod }]

}

#----------------------------------------------------------------------
#
# GetLocaleEra --
#
#	Given local time expressed in seconds from the Posix epoch,
#	determine localized era and year within the era.
#
# Parameters:
#	date - Dictionary that must contain the keys, 'localSeconds',
#	       whose value is expressed as the appropriate local time;
#	       and 'year', whose value is the Gregorian year.
#	etable - Value of the LOCALE_ERAS key in the message catalogue
#	         for the target locale.
#
# Results:
#	Returns the dictionary, augmented with the keys, 'localeEra'
#	and 'localeYear'.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetLocaleEra { date etable } {

    set index [BSearch $etable [dict get $date localSeconds]]
    if { $index < 0} {
	dict set date localeEra \
	    [::format %02d [expr { [dict get $date year] / 100 }]]
	dict set date localeYear \
	    [expr { [dict get $date year] % 100 }]

    } else {
	dict set date localeEra [lindex $etable $index 1]
	dict set date localeYear [expr { [dict get $date year] 
					 - [lindex $etable $index 2] }]

    }
    return $date

}

#----------------------------------------------------------------------
#
# GetJulianDayFromEraYearDay --
#
#	Given a year, month and day on the Gregorian calendar, determines
#	the Julian Day Number beginning at noon on that date.
#
# Parameters:
#	date -- A dictionary in which the 'era', 'year', and
#		'dayOfYear' slots are populated. The calendar in use
#		is determined by the date itself relative to:
#       changeover -- Julian day on which the Gregorian calendar was
#		adopted in the current locale.
#
# Results:
#	Returns the given dictionary augmented with a 'julianDay' key
#	whose value is the desired Julian Day Number, and a 'gregorian'
#	key that specifies whether the calendar is Gregorian (1) or
#	Julian (0).
#
# Side effects:
#	None.
#
# Bugs:
#	This code needs to be moved to the C layer.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {

    # Get absolute year number from the civil year

    switch -exact -- [dict get $date era] {
	BCE {
	    set year [expr { 1 - [dict get $date year] }]
	}
	CE {
	    set year [dict get $date year]
	}
    }
    set ym1 [expr { $year - 1 }]

    # Try the Gregorian calendar first.

    dict set date gregorian 1
    set jd [expr { 1721425

		   + [dict get $date dayOfYear]
		   + ( 365 * $ym1 )
		   + ( $ym1 / 4 )
		   - ( $ym1 / 100 )
		   + ( $ym1 / 400 ) }]

    
    # If the date is before the Gregorian change, use the Julian calendar.

    if { $jd < $changeover } {
	dict set date gregorian 0
	set jd [expr { 1721423

		       + [dict get $date dayOfYear]
		       + ( 365 * $ym1 )
		       + ( $ym1 / 4 ) }]

    }

    dict set date julianDay $jd
    return $date
}

#----------------------------------------------------------------------
#
# GetJulianDayFromEraYearMonthWeekDay --
#
#	Determines the Julian Day number corresponding to the nth
#	given day-of-the-week in a given month.
#
# Parameters:
#	date - Dictionary containing the keys, 'era', 'year', 'month'
#	       'weekOfMonth', 'dayOfWeek', and 'dayOfWeekInMonth'.
#	changeover - Julian Day of adoption of the Gregorian calendar
#
# Results:
#	Returns the given dictionary, augmented with a 'julianDay' key.
#
# Side effects:
#	None.
#
# Bugs:
#	This code needs to be moved to the C layer.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} {

    # Come up with a reference day; either the zeroeth day of the
    # given month (dayOfWeekInMonth >= 0) or the seventh day of the
    # following month (dayOfWeekInMonth < 0)

    set date2 $date
    set week [dict get $date dayOfWeekInMonth]
    if { $week >= 0 } {
	dict set date2 dayOfMonth 0
    } else {
	dict incr date2 month
	dict set date2 dayOfMonth 7
    }
    set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \
		   $changeover]
    set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \
		 [dict get $date2 julianDay]]
    dict set date julianDay [expr { $wd0 + 7 * $week }]
    return $date

}

#----------------------------------------------------------------------
#
# IsGregorianLeapYear --
#
#	Determines whether a given date represents a leap year in the

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::IsGregorianLeapYear { date } {

    switch -exact -- [dict get $date era] {
	BCE { 
	    set year [expr { 1 - [dict get $date year]}]
	}
	CE {
	    set year [dict get $date year]
	}
    }
    if { $year % 4 != 0 } {
	return 0
    } elseif { ![dict get $date gregorian] } {
	return 1
    } elseif { $year % 400 == 0 } {
	return 1
    } elseif { $year % 100 == 0 } {
	return 0
    } else {
	return 1
    }

}

#----------------------------------------------------------------------
#
# WeekdayOnOrBefore --
#
#	Determine the nearest day of week (given by the 'weekday'
#	parameter, Sunday==0) on or before a given Julian Day.
#
# Parameters:
#	weekday -- Day of the week
#	j -- Julian Day number
#
# Results:
#	Returns the Julian Day Number of the desired date.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {

    set k [expr { ( $weekday + 6 )  % 7 }]
    return [expr { $j - ( $j - $k ) % 7 }]

}

#----------------------------------------------------------------------
#
# BSearch --
#
#	Service procedure that does binary search in several places
#	inside the 'clock' command.
#
# Parameters:
#	list - List of lists, sorted in ascending order by the
#	       first elements
#	key - Value to search for
#
# Results:
#	Returns the index of the greatest element in $list that is less
#	than or equal to $key.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::BSearch { list key } {

    if {[llength $list] == 0} {
	return -1
    }
    if { $key < [lindex $list 0 0] } {
	return -1
    }

    set l 0
    set u [expr { [llength $list] - 1 }]

    while { $l < $u } {

	# At this point, we know that
	#   $k >= [lindex $list $l 0]
	#   Either $u == [llength $list] or else $k < [lindex $list $u+1 0]
	# We find the midpoint of the interval {l,u} rounded UP, compare
	# against it, and set l or u to maintain the invariant.  Note
	# that the interval shrinks at each step, guaranteeing convergence.

	set m [expr { ( $l + $u + 1 ) / 2 }]
	if { $key >= [lindex $list $m 0] } {
	    set l $m
	} else {
	    set u [expr { $m - 1 }]
	}

#		Used to determine the Gregorian change date.
#
# Results:
#	Returns the given time adjusted by the given offset(s) in
#	order.
#
# Notes:
#	It is possible that adding a number of months or years will adjust
#	the day of the month as well.  For instance, the time at
#	one month after 31 January is either 28 or 29 February, because
#	February has fewer than 31 days.
#
#----------------------------------------------------------------------

proc ::tcl::clock::add { clockval args } {

    if { [llength $args] % 2 != 0 } {
	set cmdName "clock add"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
             \"$cmdName clockval ?number units?...\
             ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error $result
    }

    set offsets {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    foreach { a b } $args {

	if { [string is integer -strict $a] } {

	    lappend offsets $a $b

	} else {

	    switch -exact -- $a {

		-g - -gm - -gmt {
		    set gmt $b
		}
		-l - -lo - -loc - -loca - -local - -locale {
		    set locale [string tolower $b]
		}
		-t - -ti - -tim - -time - -timez - -timezo - -timezon -
		-timezone {
		    set timezone $b
		}
		default {
		    return -code error \
			-errorcode [list CLOCK badSwitch $a] \
			"bad switch \"$a\",\
                         must be -gmt, -locale or -timezone"
		}
	    }
	}
    }

    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
	return -code error \
	    -errorcode [list CLOCK gmtWithTimezone] \
	    "cannot use -gmt and -timezone in same call"
    }
    if { [catch { expr { wide($clockval) } } result] } {
	return -code error \
	    "expected integer but got \"$clockval\"" 
    }
    if { ![string is boolean $gmt] } {
	return -code error \
	    "expected boolean value but got \"$gmt\""
    } else {
	if { $gmt } {
	    set timezone :GMT
	}
    }

    EnterLocale $locale oldLocale
    
    set changeover [mc GREGORIAN_CHANGE_DATE]

    if {[catch {SetupTimeZone $timezone} retval opts]} {
	dict unset opts -errorinfo
	return -options $opts $retval
    }

    set status [catch {

	foreach { quantity unit } $offsets {

	    switch -exact -- $unit {

		years - year {
		    set clockval \
			[AddMonths [expr { 12 * $quantity }] \
			     $clockval $timezone $changeover]
		}
		months - month {
		    set clockval [AddMonths $quantity $clockval $timezone \
				     $changeover]
		}

		weeks - week {
		    set clockval [AddDays [expr { 7 * $quantity }] \
				      $clockval $timezone $changeover]
		}
		days - day {
		    set clockval [AddDays $quantity $clockval $timezone \
				      $changeover]
		}

		hours - hour {
		    set clockval [expr { 3600 * $quantity + $clockval }]
		}
		minutes - minute {
		    set clockval [expr { 60 * $quantity + $clockval }]
		}
		seconds - second {
		    set clockval [expr { $quantity + $clockval }]
		}

		default {
		    error "unknown unit \"$unit\", must be \
                        years, months, weeks, days, hours, minutes or seconds" \
			  "unknown unit \"$unit\", must be \
                        years, months, weeks, days, hours, minutes or seconds" \
			[list CLOCK badUnit $unit]
		}
	    }
	}

    } result opts]




    # Restore the locale

    if { [info exists oldLocale] } {
	mclocale $oldLocale
    }

    if { $status == 1 } {
	if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
	    dict unset opts -errorinfo
	}
	return -options $opts $result
    } else {
	return $clockval
    }

}

#----------------------------------------------------------------------
#
# AddMonths --
#
#	Add a given number of months to a given clock value in a given

#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AddMonths { months clockval timezone changeover } {

    variable DaysInRomanMonthInCommonYear
    variable DaysInRomanMonthInLeapYear
    variable TZData

    # Convert the time to year, month, day, and fraction of day.

    set date [GetDateFields $clockval $TZData($timezone) $changeover]
    dict set date secondOfDay [expr { [dict get $date localSeconds]

				      % 86400 }]
    dict set date tzName $timezone

    # Add the requisite number of months

    set m [dict get $date month]
    incr m $months
    incr m -1

    }

    # Reconvert to a number of seconds

    set date [GetJulianDayFromEraYearMonthDay \
		  $date[set date {}]\
		  $changeover]
    dict set date localSeconds \
	[expr { -210866803200
		+ ( 86400 * wide([dict get $date julianDay]) )
		+ [dict get $date secondOfDay] }]

    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		 $changeover]

    return [dict get $date seconds]

}

#----------------------------------------------------------------------
#
# AddDays --
#
#	Add a given number of days to a given clock value in a given
#	time zone.
#
# Parameters:
#	days - Number of days to add (may be negative)
#	clockval - Seconds since the epoch before the operation
#	timezone - Time zone in which the operation is to be performed
#	changeover - Julian Day on which the Gregorian calendar was adopted
#		     in the target locale.
#
# Results:
#	Returns the new clock value as a number of seconds since
#	the epoch.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AddDays { days clockval timezone changeover } {

    variable TZData

    # Convert the time to Julian Day

    set date [GetDateFields $clockval $TZData($timezone) $changeover]
    dict set date secondOfDay [expr { [dict get $date localSeconds]

				      % 86400 }]
    dict set date tzName $timezone

    # Add the requisite number of days

    dict incr date julianDay $days

    # Reconvert to a number of seconds

    dict set date localSeconds \
	[expr { -210866803200
		+ ( 86400 * wide([dict get $date julianDay]) )
		+ [dict get $date secondOfDay] }]

    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		  $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]
    } else {

	set val [::msgcat::mc $name]
	dict set McLoaded $Locale $name $val
	return $val
    }
}

#----------------------------------------------------------------------
#
# ClearCaches --
#
#	Clears all caches to reclaim the memory used in [clock]
#
# Parameters:
#	None.
#
# Results:
#	None.
#
# Side effects:
#	Caches are cleared.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ClearCaches {} {

    variable FormatProc
    variable LocaleNumeralCache
    variable McLoaded
    variable CachedSystemTimeZone
    variable TimeZoneBad

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

    catch {unset FormatProc}
    set LocaleNumeralCache {}
    set McLoaded {}
    catch {unset CachedSystemTimeZone}
    set TimeZoneBad {}
    InitTZData

}