summaryrefslogtreecommitdiffstats
path: root/library/clock.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/clock.tcl')
-rw-r--r--library/clock.tcl1203
1 files changed, 628 insertions, 575 deletions
diff --git a/library/clock.tcl b/library/clock.tcl
index 0696c47..38394d2 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -2,9 +2,9 @@
#
# 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.
+# 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.
#
#
#----------------------------------------------------------------------
@@ -15,11 +15,11 @@
#
#----------------------------------------------------------------------
-# We must have message catalogs that support the root locale, and we need
-# access to the Registry on Windows systems.
+# 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
+ package require msgcat 1.6
if { $::tcl_platform(platform) eq {windows} } {
if { [catch { package require registry 1.1 }] } {
namespace eval ::tcl::clock [list variable NoRegistry {}]
@@ -27,8 +27,9 @@ uplevel \#0 {
}
}
-# Put the library directory into the namespace for the ensemble so that the
-# library code can find message catalogs and time zone definition files.
+# 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]]]
@@ -39,10 +40,10 @@ namespace eval ::tcl::clock \
#
# Manipulate times.
#
-# The 'clock' command manipulates time. Refer to the user documentation for
-# the available subcommands and what they do.
+# The 'clock' command manipulates time. Refer to the user documentation
+# for the available subcommands and what they do.
#
-#----------------------------------------------------------------------
+#----------------------------------------------------------------------
namespace eval ::tcl::clock {
@@ -58,8 +59,8 @@ namespace eval ::tcl::clock {
# Import the message catalog commands that we use.
- namespace import ::msgcat::mcload
- namespace import ::msgcat::mclocale
+ namespace import ::msgcat::mc
+ namespace import ::msgcat::mcpackagelocale
}
@@ -75,11 +76,11 @@ namespace eval ::tcl::clock {
# 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.
+# 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.
#
#----------------------------------------------------------------------
@@ -106,6 +107,10 @@ proc ::tcl::clock::Initialize {} {
}
InitTZData
+ mcpackagelocale set {}
+ ::msgcat::mcpackageconfig set mcfolder [file join $LibDir msgs]
+ ::msgcat::mcpackageconfig set unknowncmd ""
+
# Define the message catalog for the root locale.
::msgcat::mcmset {} {
@@ -171,8 +176,8 @@ proc ::tcl::clock::Initialize {} {
::msgcat::mcset fr GREGORIAN_CHANGE_DATE 2299227
- # For Belgium, we follow Southern Netherlands; Liege Diocese changed
- # several weeks later.
+ # 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
@@ -188,13 +193,13 @@ proc ::tcl::clock::Initialize {} {
# Germany, Norway, Denmark (Catholic Germany changed earlier)
::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032
- ::msgcat::mcset nb 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)
+ # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed
+ # at various times)
::msgcat::mcset nl GREGORIAN_CHANGE_DATE 2342165
@@ -216,23 +221,23 @@ proc ::tcl::clock::Initialize {} {
::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639
- # Romania (Transylvania changed earler - perhaps de_RO should show the
- # earlier date?)
+ # 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
+ # Paths at which binary time zone data for the Olson libraries
+ # are known to reside on various operating systems
variable ZoneinfoPaths {}
foreach path {
@@ -249,7 +254,6 @@ proc ::tcl::clock::Initialize {} {
# Define the directories for time zone data and message catalogs.
variable DataDir [file join $LibDir tzdata]
- variable MsgDir [file join $LibDir msgs]
# Number of days in the months, in common years and leap years.
@@ -281,10 +285,10 @@ proc ::tcl::clock::Initialize {} {
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.
+ # 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:
@@ -295,10 +299,10 @@ proc ::tcl::clock::Initialize {} {
# 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.
+ # 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
@@ -377,10 +381,10 @@ proc ::tcl::clock::Initialize {} {
{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.
+ # 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 {
@@ -484,8 +488,8 @@ proc ::tcl::clock::Initialize {} {
}
}
- # Groups of fields that specify time of day, priorities, and code that
- # processes them
+ # Groups of fields that specify time of day, priorities,
+ # and code that processes them
variable TimeParseActions {
@@ -623,11 +627,6 @@ proc ::tcl::clock::Initialize {} {
# in the given locales and dictionaries
# mapping the numerals to their numeric
# values.
- variable McLoaded {}; # Dictionary whose keys are locales
- # in which [mcload] has been executed
- # and whose values are second-level
- # dictionaries indexed by message
- # name and giving message text.
# variable CachedSystemTimeZone; # If 'CachedSystemTimeZone' exists,
# it contains the value of the
# system time zone, as determined from
@@ -651,14 +650,16 @@ proc ::tcl::clock::Initialize {} {
#
# clock format --
#
-# Formats a count of seconds since the Posix Epoch as a time of day.
+# 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.
+# 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
@@ -667,7 +668,7 @@ proc ::tcl::clock::format { args } {
set clockval [lindex $args 0]
# Get the data for time changes in the given zone
-
+
if {$timezone eq ""} {
set timezone [GetSystemTimeZone]
}
@@ -677,11 +678,11 @@ proc ::tcl::clock::format { args } {
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.
-
+
+ # 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)]} {
@@ -690,8 +691,9 @@ proc ::tcl::clock::format { args } {
set FormatProc($procName) \
[ParseClockFormatFormat $procName $format $locale]
}
-
+
return [$procName $clockval $timezone]
+
}
#----------------------------------------------------------------------
@@ -710,31 +712,39 @@ proc ::tcl::clock::format { args } {
#----------------------------------------------------------------------
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
+
+ EnterLocale $locale
# Change locale if a fresh locale has been given on the command line.
- try {
- return [ParseClockFormatFormat2 $format $locale $procName]
- } trap CLOCK {result opts} {
- dict unset opts -errorinfo
- return -options $opts $result
- } finally {
- # Restore the locale
+ set status [catch {
+
+ ParseClockFormatFormat2 $format $locale $procName
- if { [info exists oldLocale] } {
- mclocale $oldLocale
+ } result opts]
+
+ # 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 \
@@ -749,7 +759,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
set formatString {}
set substituents {}
set state {}
-
+
set format [LocalizeFormat $locale $format]
foreach char [split $format {}] {
@@ -776,7 +786,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
{ [lindex @DAYS_OF_WEEK_ABBREV@ \
[expr {[dict get $date dayOfWeek] \
% 7}]]}]
- }
+ }
A { # Day of week, spelt out.
append formatString %s
append substituents \
@@ -877,7 +887,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
k { # Hour (0-23), no leading zero
append formatString %2d
append substituents \
- { [expr { [dict get $date localSeconds]
+ { [expr { [dict get $date localSeconds]
/ 3600
% 24 }]}
}
@@ -898,7 +908,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
M { # Minute of the hour, leading zero
append formatString %02d
append substituents \
- { [expr { [dict get $date localSeconds]
+ { [expr { [dict get $date localSeconds]
/ 60
% 60 }]}
}
@@ -939,7 +949,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
{ [expr {(([dict get $date localSeconds]
% 86400) < 43200) ?
$am : $pm}]}
-
+
}
Q { # Hi, Jeff!
append formatString %s
@@ -949,11 +959,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
append formatString %s
append substituents { [dict get $date seconds]}
}
- S { # Second of the minute, with
+ S { # Second of the minute, with
# leading zero
append formatString %02d
append substituents \
- { [expr { [dict get $date localSeconds]
+ { [expr { [dict get $date localSeconds]
% 60 }]}
}
t { # A literal tab character
@@ -974,7 +984,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
}
incr dow
set UweekNumber \
- [expr { ( [dict get $date dayOfYear]
+ [expr { ( [dict get $date dayOfYear]
- $dow + 7 )
/ 7 }]
}
@@ -997,7 +1007,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
set WweekNumber \
[expr { ( [dict get $date dayOfYear]
- [dict get $date dayOfWeek]
- + 7 )
+ + 7 )
/ 7 }]
}
append formatString %02d
@@ -1066,7 +1076,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
percentO { # Character following %O
set state {}
switch -exact -- $char {
- d - e { # Day of the month in alternative
+ d - e { # Day of the month in alternative
# numerals
append formatString %s
append substituents \
@@ -1078,7 +1088,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [expr { [dict get $date localSeconds]
+ [expr { [dict get $date localSeconds]
/ 3600
% 24 }]]}
}
@@ -1104,7 +1114,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [expr { [dict get $date localSeconds]
+ [expr { [dict get $date localSeconds]
/ 60
% 60 }]]}
}
@@ -1113,7 +1123,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [expr { [dict get $date localSeconds]
+ [expr { [dict get $date localSeconds]
% 60 }]]}
}
u { # Day of the week (Monday=1,Sunday=7)
@@ -1144,9 +1154,9 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
}
}
}
-
+
# Clean up any improperly terminated groups
-
+
switch -exact -- $state {
percent {
append formatString %%
@@ -1173,14 +1183,16 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
#
# clock scan --
#
-# Inputs a count of seconds since the Posix Epoch as a time of day.
+# 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.
+# 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
@@ -1242,17 +1254,21 @@ proc ::tcl::clock::scan { args } {
"cannot use -gmt and -timezone in same call"
}
if { [catch { expr { wide($base) } } result] } {
- return -code error "expected integer but got \"$base\""
+ return -code error \
+ "expected integer but got \"$base\""
}
- if { ![string is boolean -strict $gmt] } {
- return -code error "expected boolean value but got \"$gmt\""
- } elseif { $gmt } {
- set timezone :GMT
+ 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.
+ # 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] \
@@ -1264,25 +1280,27 @@ proc ::tcl::clock::scan { args } {
# Change locale if a fresh locale has been given on the command line.
- EnterLocale $locale oldLocale
+ EnterLocale $locale
+
+ set status [catch {
- try {
# Map away the locale-dependent composite format groups
set scanner [ParseClockScanFormat $format $locale]
- return [$scanner $string $base $timezone]
- } trap CLOCK {result opts} {
- # Conceal location of generation of expected errors
+ $scanner $string $base $timezone
- dict unset opts -errorinfo
- return -options $opts $result
- } finally {
- # Restore the locale
+ } result opts]
- 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
}
+
}
#----------------------------------------------------------------------
@@ -1298,50 +1316,52 @@ proc ::tcl::clock::scan { args } {
# 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
+# 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
-
- try {
- SetupTimeZone $timezone
- } on error {retval opts} {
+
+ 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
+ # 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
- }]
+ 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.
-
- try {
- set scanned [Oldscan $string \
- [dict get $date year] \
- [dict get $date month] \
- [dict get $date dayOfMonth]]
- lassign $scanned \
- parseDate parseTime parseZone parseRel \
- parseWeekday parseOrdinalMonth
- } on error message {
- return -code error \
- "unable to convert date-time string \"$string\": $message"
+ # 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"
}
- # 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.
+ 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
@@ -1361,12 +1381,12 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
}
}
- # 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 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 \
@@ -1380,19 +1400,18 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2361222]
if { $parseTime ne {} } {
dict set date secondOfDay $parseTime
- } elseif { [llength $parseWeekday] != 0
- || [llength $parseOrdinalMonth] != 0
- || ( [llength $parseRel] != 0
+ } elseif { [llength $parseWeekday] != 0
+ || [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 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]
@@ -1404,17 +1423,18 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
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
- }]]
+ set jdwkday [WeekdayOnOrBefore $dayOfWeek \
+ [expr { [dict get $date2 julianDay]
+ + 6 }]]
incr jdwkday [expr { 7 * $dayOrdinal }]
if { $dayOrdinal > 0 } {
incr jdwkday -7
@@ -1422,20 +1442,21 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
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 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] }]
@@ -1452,6 +1473,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
}
set seconds [add $seconds $monthOrdinal years $monthDiff months \
-timezone $timezone -locale $locale]
+
}
return $seconds
@@ -1469,27 +1491,30 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
# 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]
+# 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
+# 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.
+
+ # 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]
@@ -1533,8 +1558,8 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
append re {[[:space:]]+}
} else {
if { ! [string is alnum $c] } {
- append re "\\"
- }
+ append re \\
+ }
append re $c
}
}
@@ -1651,7 +1676,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"::scan \$field" [incr captureCount] " %ld" \
"\]\n"
}
- m - N { # Month number
+ m - N { # Month number
append re \\s*(\\d\\d?)
dict set fieldSet month [incr fieldCount]
append postcode "dict set date month \[" \
@@ -1694,9 +1719,10 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
\] \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.
+ # 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 } \[ \
@@ -1729,13 +1755,14 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
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.
+ 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 \[" \
@@ -1907,7 +1934,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"day of week is greater than 7"
}
dict set date dayOfWeek $dow
- }
+ }
}
y {
lassign [LocaleNumeralMatcher $locale] regex lookup
@@ -1953,11 +1980,10 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
append procBody $postcode
append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n
- # Set up the time zone before doing anything with a default base date
- # that might need a timezone to interpret it.
+ # Get time zone if needed
- if { ![dict exists $fieldSet seconds]
- && ![dict exists $fieldSet starDate] } {
+ if { ![dict exists $fieldSet seconds]
+ && ![dict exists $fieldSet starDate] } {
if { [dict exists $fieldSet tzName] } {
append procBody {
set timeZone [dict get $date tzName]
@@ -1976,29 +2002,24 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions]
- # Assemble seconds from the Julian day and second of the day.
- # Convert to local time unless epoch seconds or stardate are
- # being processed - they're always absolute
+ # Assemble seconds, and convert local nominal time to UTC.
- if { ![dict exists $fieldSet seconds]
+ 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]
- }]
+ dict set date localSeconds \
+ [expr { -210866803200
+ + ( 86400 * wide([dict get $date julianDay]) )
+ + [dict get $date secondOfDay] }]
}
-
- # Finally, convert the date to local time
-
append procBody {
set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
- $TZData($timeZone) $changeover]
+ $TZData($timeZone) \
+ $changeover]
}
}
@@ -2012,29 +2033,31 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
return $procName
}
-
+
#----------------------------------------------------------------------
#
# LocaleNumeralMatcher --
#
-# Composes a regexp that captures the numerals in the given locale, and
-# a dictionary to map them to conventional numerals.
+# 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.
+# Returns a two-element list comprising the regexp and the
+# dictionary.
#
# Side effects:
# Caches the result.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::LocaleNumeralMatcher {l} {
+proc ::tcl::clock::LocaleNumeralMatcher {locale} {
+
variable LocaleNumeralCache
- if { ![dict exists $LocaleNumeralCache $l] } {
+ if { ![dict exists $LocaleNumeralCache $locale] } {
set d {}
set i 0
set sep \(
@@ -2046,20 +2069,20 @@ proc ::tcl::clock::LocaleNumeralMatcher {l} {
incr i
}
append re \)
- dict set LocaleNumeralCache $l [list $re $d]
+ dict set LocaleNumeralCache $locale [list $re $d]
}
- return [dict get $LocaleNumeralCache $l]
+ return [dict get $LocaleNumeralCache $locale]
}
-
+
#----------------------------------------------------------------------
#
# UniquePrefixRegexp --
#
-# Composes a regexp that performs unique-prefix matching. The RE
-# matches one of a supplied set of strings, or any unique prefix
-# thereof.
+# 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.
@@ -2067,10 +2090,10 @@ proc ::tcl::clock::LocaleNumeralMatcher {l} {
# 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'.
+# 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.
@@ -2078,10 +2101,11 @@ proc ::tcl::clock::LocaleNumeralMatcher {l} {
#----------------------------------------------------------------------
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.
+
+ # 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 {} {}]
@@ -2089,7 +2113,8 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
# Walk the key-value pairs
foreach { key value } $data {
- # Construct all prefixes of the key;
+
+ # Construct all prefixes of the key;
set prefix {}
foreach char [split $key {}] {
@@ -2107,8 +2132,8 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
}
}
- # Identify those prefixes that designate unique values, and those that are
- # the full keys
+ # Identify those prefixes that designate unique values, and
+ # those that are the full keys
set uniquePrefixMapping {}
dict for { key valueList } $prefixMapping {
@@ -2131,8 +2156,8 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
#
# MakeUniquePrefixRegexp --
#
-# Service procedure for 'UniquePrefixRegexp' that constructs a regular
-# expresison that matches the unique prefixes.
+# Service procedure for 'UniquePrefixRegexp' that constructs
+# a regular expresison that matches the unique prefixes.
#
# Parameters:
# successors - Dictionary whose keys are all prefixes
@@ -2144,17 +2169,18 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
# prefixString - Current prefix being processed.
#
# Results:
-# Returns a constructed regular expression that matches the set of
-# unique prefixes beginning with the 'prefixString'.
+# Returns a constructed regular expression that matches the set
+# of unique prefixes beginning with the 'prefixString'.
#
# Side effects:
# None.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::MakeUniquePrefixRegexp { successors
+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]]]
@@ -2162,15 +2188,13 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
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
+ # 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
- } then {
+ if { [dict exists $uniquePrefixMapping $prefixString]
+ || [llength $schars] > 1 } {
append re "(?:"
}
@@ -2192,7 +2216,7 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
if { [dict exists $uniquePrefixMapping $prefixString] } {
append re ")?"
- } elseif { [llength $schars] > 1 } {
+ } elseif { [llength $schars] > 1 } {
append re ")"
}
@@ -2203,8 +2227,8 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
#
# MakeParseCodeFromFields --
#
-# Composes Tcl code to extract the Julian Day Number from a dictionary
-# containing date fields.
+# 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,
@@ -2215,8 +2239,8 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
# the list must be in ascending order by priority
#
# Results:
-# Returns a burst of code that extracts the day number from the given
-# date.
+# Returns a burst of code that extracts the day number from the
+# given date.
#
# Side effects:
# None.
@@ -2224,6 +2248,7 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
#----------------------------------------------------------------------
proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
+
set currPrio 999
set currFieldPos [list]
set currCodeBurst {
@@ -2231,15 +2256,16 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
}
foreach { fieldSet prio parseAction } $parseActions {
- # If we've found an answer that's better than any that follow, quit
- # now.
+
+ # 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.
+ # Accumulate the field positions that are used in the current
+ # field grouping.
set fieldPos [list]
set ok true
@@ -2262,11 +2288,9 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
if { $prio == $currPrio } {
foreach currPos $currFieldPos newPos $fPos {
- if {
- ![string is integer $newPos]
- || ![string is integer $currPos]
- || $newPos > $currPos
- } then {
+ if { ![string is integer $newPos]
+ || ![string is integer $currPos]
+ || $newPos > $currPos } {
break
}
if { $newPos < $currPos } {
@@ -2284,86 +2308,75 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
set currPrio $prio
set currFieldPos $fPos
set currCodeBurst $parseAction
+
}
return $currCodeBurst
+
}
#----------------------------------------------------------------------
#
# EnterLocale --
#
-# Switch [mclocale] to a given locale if necessary
+# By shure given locale is loaded and set variable Locale
#
# 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.
+# If necessary, uses [mcloadedlocales packageadd] to load the
+# designated locale's files.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
- upvar 1 $oldLocaleVar oldLocale
-
- variable MsgDir
- variable McLoaded
+proc ::tcl::clock::EnterLocale { locale } {
- 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
+
+ # 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
+ # 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
- set locale ${oldLocale}_windows
- if { ![dict exists $McLoaded $locale] } {
+ mcpackagelocale [mclocale]
+
+ # Make a new locale string for the system locale, and
+ # get the Control Panel information
+
+ # This will only load the current locale below, as it is a
+ # descent from <locale>_windows.
+ # The <locale>_windows will be remembered as current and as loaded.
+ set locale [mclocale]_windows
+ if { $locale ni [::msgcat::mcpackagelocale loaded] } {
LoadWindowsDateTimeFormats $locale
- dict set McLoaded $locale {}
}
}
}
if { $locale eq {current}} {
- set locale $oldLocale
- unset oldLocale
- } elseif { $locale eq $oldLocale } {
- unset oldLocale
- } else {
- mclocale $locale
+ set locale [mclocale]
}
- if { ![dict exists $McLoaded $locale] } {
- mcload $MsgDir
- dict set McLoaded $locale {}
- }
-}
+ # Eventually load the locale
+ mcpackagelocale set $locale
+}
#----------------------------------------------------------------------
#
# LoadWindowsDateTimeFormats --
#
-# Load the date/time formats from the Control Panel in Windows and
-# convert them so that they're usable by Tcl.
+# 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
@@ -2375,12 +2388,14 @@ proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
# 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.
+# 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
@@ -2482,6 +2497,7 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
}
return
+
}
#----------------------------------------------------------------------
@@ -2496,8 +2512,8 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
# format -- Format supplied to [clock scan] or [clock format]
#
# Results:
-# Returns the string with locale-dependent composite format groups
-# substituted out.
+# Returns the string with locale-dependent composite format
+# groups substituted out.
#
# Side effects:
# None.
@@ -2505,18 +2521,18 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
#----------------------------------------------------------------------
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
+ # message catalog key to cache this format
+ set key FORMAT_$format
+ if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
+ return [mc $key]
+ }
# Handle locale-dependent format groups by mapping them out of the format
# string. Note that the order of the [string map] operations is
# significant because later formats can refer to later ones; for example
# %c can refer to %X, which in turn can refer to %T.
-
+
set list {
%% %%
%D %m/%d/%Y
@@ -2533,8 +2549,8 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
lappend list %c [string map $list [mc DATE_TIME_FORMAT]]
lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
set format [string map $list $format]
-
- dict set McLoaded $locale FORMAT $inFormat $format
+
+ mcset $locale $key $format
return $format
}
@@ -2556,6 +2572,7 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
#----------------------------------------------------------------------
proc ::tcl::clock::FormatNumericTimeZone { z } {
+
if { $z < 0 } {
set z [expr { - $z }]
set retval -
@@ -2570,6 +2587,7 @@ proc ::tcl::clock::FormatNumericTimeZone { z } {
append retval [::format %02d $z]
}
return $retval
+
}
#----------------------------------------------------------------------
@@ -2594,6 +2612,7 @@ proc ::tcl::clock::FormatNumericTimeZone { z } {
#----------------------------------------------------------------------
proc ::tcl::clock::FormatStarDate { date } {
+
variable Roddenberry
# Get day of year, zero based
@@ -2644,6 +2663,7 @@ proc ::tcl::clock::FormatStarDate { date } {
#----------------------------------------------------------------------
proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
+
variable Roddenberry
# Build a tentative date from year and fraction.
@@ -2659,8 +2679,8 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
set lp [IsGregorianLeapYear $date]
- # Reconvert the fractional year according to whether the given year is a
- # leap year
+ # Reconvert the fractional year according to whether the given
+ # year is a leap year
if { $lp } {
dict set date dayOfYear \
@@ -2673,11 +2693,10 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
dict unset date gregorian
set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]
- return [expr {
- 86400 * [dict get $date julianDay]
- - 210866803200
- + ( 86400 / 10 ) * $fractDay
- }]
+ return [expr { 86400 * [dict get $date julianDay]
+ - 210866803200
+ + ( 86400 / 10 ) * $fractDay }]
+
}
#----------------------------------------------------------------------
@@ -2690,8 +2709,8 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
# 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.
+# Returns the string as a pure wide integer. Throws an error if
+# the string is misformatted or out of range.
#
#----------------------------------------------------------------------
@@ -2712,8 +2731,8 @@ proc ::tcl::clock::ScanWide { str } {
#
# InterpretTwoDigitYear --
#
-# Given a date that contains only the year of the century, determines
-# the target value of a two-digit year.
+# 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.
@@ -2730,17 +2749,18 @@ proc ::tcl::clock::ScanWide { str } {
# 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.
+# 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
+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 }]
@@ -2748,6 +2768,7 @@ proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
dict set date $fourDigitField [expr { $yr + 1900 }]
}
return $date
+
}
#----------------------------------------------------------------------
@@ -2773,6 +2794,7 @@ proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
#----------------------------------------------------------------------
proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } {
+
variable TZData
# Find the Julian Day Number corresponding to the base time, and
@@ -2786,6 +2808,7 @@ proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } {
dict set date year [dict get $date2 year]
return $date
+
}
#----------------------------------------------------------------------
@@ -2812,6 +2835,7 @@ proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } {
#----------------------------------------------------------------------
proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} {
+
variable TZData
# Find the Julian Day Number corresponding to the base time
@@ -2829,7 +2853,7 @@ proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} {
#
# AssignBaseMonth --
#
-# Places the number of the current year and month into a
+# Places the number of the current year and month into a
# dictionary.
#
# Parameters:
@@ -2848,6 +2872,7 @@ proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} {
#----------------------------------------------------------------------
proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} {
+
variable TZData
# Find the year and month corresponding to the base time
@@ -2857,6 +2882,7 @@ proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} {
dict set date year [dict get $date2 year]
dict set date month [dict get $date2 month]
return $date
+
}
#----------------------------------------------------------------------
@@ -2882,6 +2908,7 @@ proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} {
#----------------------------------------------------------------------
proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} {
+
variable TZData
# Find the Julian Day Number corresponding to the base time
@@ -2918,6 +2945,7 @@ proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} {
#----------------------------------------------------------------------
proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } {
+
variable TZData
# Find the Julian Day Number corresponding to the base time
@@ -2947,6 +2975,7 @@ proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } {
#----------------------------------------------------------------------
proc ::tcl::clock::InterpretHMSP { date } {
+
set hr [dict get $date hourAMPM]
if { $hr == 12 } {
set hr 0
@@ -2956,6 +2985,7 @@ proc ::tcl::clock::InterpretHMSP { date } {
}
dict set date hour $hr
return [InterpretHMS $date[set date {}]]
+
}
#----------------------------------------------------------------------
@@ -2978,11 +3008,11 @@ proc ::tcl::clock::InterpretHMSP { date } {
#----------------------------------------------------------------------
proc ::tcl::clock::InterpretHMS { date } {
- return [expr {
- ( [dict get $date hour] * 60
- + [dict get $date minute] ) * 60
- + [dict get $date second]
- }]
+
+ return [expr { ( [dict get $date hour] * 60
+ + [dict get $date minute] ) * 60
+ + [dict get $date second] }]
+
}
#----------------------------------------------------------------------
@@ -3005,6 +3035,7 @@ proc ::tcl::clock::InterpretHMS { date } {
#----------------------------------------------------------------------
proc ::tcl::clock::GetSystemTimeZone {} {
+
variable CachedSystemTimeZone
variable TimeZoneBad
@@ -3037,69 +3068,76 @@ proc ::tcl::clock::GetSystemTimeZone {} {
} else {
return $timezone
}
+
}
#----------------------------------------------------------------------
#
# ConvertLegacyTimeZone --
#
-# Given an alphanumeric time zone identifier and the system time zone,
-# convert the alphanumeric identifier to an unambiguous time zone.
+# 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.
+# 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?
+# 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]
}
- return [dict get $LegacyTimeZone $tzname]
+
}
#----------------------------------------------------------------------
#
# SetupTimeZone --
#
-# Given the name or specification of a time zone, sets up its in-memory
-# data.
+# 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.
+# 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]
- } then {
+ } elseif { [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
+ -> s hh mm ss] } {
+
# Make a fixed offset
::scan $hh %d hh
@@ -3120,21 +3158,24 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]]
} elseif { [string index $timezone 0] eq {:} } {
+
# Convert using a time zone file
- if {
+ if {
[catch {
LoadTimeZoneFile [string range $timezone 1 end]
- }] && [catch {
+ }]
+ && [catch {
LoadZoneinfoFile [string range $timezone 1 end]
}]
- } then {
+ } {
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] } {
@@ -3147,8 +3188,9 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
}
} else {
- # We couldn't parse this as a POSIX time zone. Try again with a
- # time zone file - this time without a colon
+
+ # 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] } {
@@ -3172,22 +3214,25 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
# None.
#
# Results:
-# Returns a time zone specifier that corresponds to the system time zone
-# information found in the Registry.
+# 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!
+# 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.
+# 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
@@ -3218,14 +3263,16 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
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)
+ # 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]
@@ -3273,11 +3320,11 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
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.
+ # 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] \
@@ -3286,11 +3333,11 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
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.
+ # 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] \
@@ -3298,9 +3345,10 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
: [::format %02d $stdSecond]
}
dict set WinZoneInfo $data $tzname
- }
+ }
return [dict get $WinZoneInfo $data]
+
}
#----------------------------------------------------------------------
@@ -3329,18 +3377,18 @@ proc ::tcl::clock::LoadTimeZoneFile { 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.
+ # 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"
}
- try {
+ if { [catch {
source -encoding utf-8 [file join $DataDir $fileName]
- } on error {} {
+ }] } {
return -code error \
-errorcode [list CLOCK badTimeZone :$fileName] \
"time zone \":$fileName\" not found"
@@ -3358,8 +3406,8 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
# 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.
+# 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
@@ -3367,11 +3415,12 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
#----------------------------------------------------------------------
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.
+ # 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 \
@@ -3400,14 +3449,15 @@ proc ::tcl::clock::LoadZoneinfoFile { fileName } {
# 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.
+# 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
@@ -3426,8 +3476,8 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
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.
+ # 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
@@ -3445,19 +3495,18 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
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.
+ # 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
- }]
+ 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}} {
@@ -3481,9 +3530,9 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
}
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.
+ # 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
@@ -3491,10 +3540,10 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
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.
+ # 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}
@@ -3524,8 +3573,8 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
}
# 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),
+ # 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}} {
@@ -3558,8 +3607,8 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
# tz Time zone specifier to be interpreted
#
# Results:
-# Returns a dictionary whose values contain the various pieces of the
-# time zone specification.
+# Returns a dictionary whose values contain the various pieces of
+# the time zone specification.
#
# Side effects:
# None.
@@ -3570,7 +3619,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
# The following keys are present in the dictionary:
# stdName - Name of the time zone when Daylight Saving Time
# is not in effect.
-# stdSignum - Sign (+, -, or empty) of the offset from Greenwich
+# stdSignum - Sign (+, -, or empty) of the offset from Greenwich
# to the given (non-DST) time zone. + and the empty
# string denote zones west of Greenwich, - denotes east
# of Greenwich; this is contrary to the ISO convention
@@ -3615,13 +3664,14 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
# 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.
+#
+# 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
@@ -3632,8 +3682,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
([[:digit:]]{1,2})
(?:
# 4 - Standard time zone offset, minutes
- : ([[:digit:]]{1,2})
- (?:
+ : ([[:digit:]]{1,2})
+ (?:
# 5 - Standard time zone offset, seconds
: ([[:digit:]]{1,2} )
)?
@@ -3649,8 +3699,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
([[:digit:]]{1,2})
(?:
# 9 - DST time zone offset, minutes
- : ([[:digit:]]{1,2})
- (?:
+ : ([[:digit:]]{1,2})
+ (?:
# 10 - DST time zone offset, seconds
: ([[:digit:]]{1,2})
)?
@@ -3663,8 +3713,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
( J ? ) ( [[:digit:]]+ )
| M
# 13 - Month number 14 - Week of month 15 - Day of week
- ( [[:digit:]] + )
- [.] ( [[:digit:]] + )
+ ( [[:digit:]] + )
+ [.] ( [[:digit:]] + )
[.] ( [[:digit:]] + )
)
(?:
@@ -3685,8 +3735,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
( J ? ) ( [[:digit:]]+ )
| M
# 21 - Month number 22 - Week of month 23 - Day of week
- ( [[:digit:]] + )
- [.] ( [[:digit:]] + )
+ ( [[:digit:]] + )
+ [.] ( [[:digit:]] + )
[.] ( [[:digit:]] + )
)
(?:
@@ -3713,21 +3763,27 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
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\""
+
}
- 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.
+# Handle a Posix time zone after it's been broken out into
+# fields.
#
# Parameters:
# z - Dictionary returned from 'ParsePosixTimeZone'
@@ -3741,6 +3797,7 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
#----------------------------------------------------------------------
proc ::tcl::clock::ProcessPosixTimeZone { z } {
+
variable MINWIDE
variable TZData
@@ -3755,20 +3812,20 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
} else {
set stdSignum -1
}
- set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
+ set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
if { [dict get $z stdMinutes] ne {} } {
- set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
+ set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
} else {
set stdMinutes 0
}
if { [dict get $z stdSeconds] ne {} } {
- set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
+ set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
} else {
set stdSeconds 0
}
- set stdOffset [expr {
- (($stdHours * 60 + $stdMinutes) * 60 + $stdSeconds) * $stdSignum
- }]
+ 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
@@ -3791,20 +3848,20 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
if { [dict get $z dstHours] eq {} } {
set dstOffset [expr { 3600 + $stdOffset }]
} else {
- set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
+ set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
if { [dict get $z dstMinutes] ne {} } {
- set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
+ set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
} else {
set dstMinutes 0
}
if { [dict get $z dstSeconds] ne {} } {
- set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
+ set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
} else {
set dstSeconds 0
}
- set dstOffset [expr {
- (($dstHours*60 + $dstMinutes) * 60 + $dstSeconds) * $dstSignum
- }]
+ set dstOffset [expr { ( ( $dstHours * 60 + $dstMinutes )
+ * 60 + $dstSeconds )
+ * $dstSignum }]
}
# Fill in defaults for European or US DST rules
@@ -3813,10 +3870,8 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
# US end time is the first Sunday in November.
# EU end time is the last Sunday in October
- if {
- [dict get $z startDayOfYear] eq {}
- && [dict get $z startMonth] eq {}
- } then {
+ if { [dict get $z startDayOfYear] eq {}
+ && [dict get $z startMonth] eq {} } {
if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
# EU
dict set z startWeekOfMonth 5
@@ -3835,10 +3890,8 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
dict set z startMinutes 0
dict set z startSeconds 0
}
- if {
- [dict get $z endDayOfYear] eq {}
- && [dict get $z endMonth] eq {}
- } then {
+ if { [dict get $z endDayOfYear] eq {}
+ && [dict get $z endMonth] eq {} } {
if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
# EU
dict set z endMonth 10
@@ -3878,14 +3931,15 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
}
return $data
-}
+
+}
#----------------------------------------------------------------------
#
# DeterminePosixDSTTime --
#
-# Determines the time that Daylight Saving Time starts or ends from a
-# Posix time zone specification.
+# Determines the time that Daylight Saving Time starts or ends
+# from a Posix time zone specification.
#
# Parameters:
# z - Time zone data returned from ParsePosixTimeZone.
@@ -3895,12 +3949,13 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
# 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.
+# 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
@@ -3908,16 +3963,18 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
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]
+ && [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]
@@ -3932,9 +3989,8 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
}
set jd [dict get $date julianDay]
- set seconds [expr {
- wide($jd) * wide(86400) - wide(210866803200)
- }]
+ set seconds [expr { wide($jd) * wide(86400)
+ - wide(210866803200) }]
set h [dict get $z ${bound}Hours]
if { $h eq {} } {
@@ -3956,6 +4012,7 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
}
set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
return [expr { $seconds + $tod }]
+
}
#----------------------------------------------------------------------
@@ -3973,26 +4030,26 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
# for the target locale.
#
# Results:
-# Returns the dictionary, augmented with the keys, 'localeEra' and
-# 'localeYear'.
+# 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
- }]
+ 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]
- }]
+ dict set date localeYear [expr { [dict get $date year]
+ - [lindex $etable $index 2] }]
}
return $date
+
}
#----------------------------------------------------------------------
@@ -4010,9 +4067,10 @@ proc ::tcl::clock::GetLocaleEra { date etable } {
# 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).
+# 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.
@@ -4023,6 +4081,7 @@ proc ::tcl::clock::GetLocaleEra { date etable } {
#----------------------------------------------------------------------
proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {
+
# Get absolute year number from the civil year
switch -exact -- [dict get $date era] {
@@ -4038,25 +4097,21 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {
# 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 )
- }]
-
+ 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 )
- }]
+ set jd [expr { 1721423
+ + [dict get $date dayOfYear]
+ + ( 365 * $ym1 )
+ + ( $ym1 / 4 ) }]
}
dict set date julianDay $jd
@@ -4067,8 +4122,8 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {
#
# GetJulianDayFromEraYearMonthWeekDay --
#
-# Determines the Julian Day number corresponding to the nth given
-# day-of-the-week in a given month.
+# 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'
@@ -4087,9 +4142,10 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {
#----------------------------------------------------------------------
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)
+
+ # 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]
@@ -4105,6 +4161,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} {
[dict get $date2 julianDay]]
dict set date julianDay [expr { $wd0 + 7 * $week }]
return $date
+
}
#----------------------------------------------------------------------
@@ -4127,8 +4184,9 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} {
#----------------------------------------------------------------------
proc ::tcl::clock::IsGregorianLeapYear { date } {
+
switch -exact -- [dict get $date era] {
- BCE {
+ BCE {
set year [expr { 1 - [dict get $date year]}]
}
CE {
@@ -4146,14 +4204,15 @@ proc ::tcl::clock::IsGregorianLeapYear { date } {
} else {
return 1
}
+
}
#----------------------------------------------------------------------
#
# WeekdayOnOrBefore --
#
-# Determine the nearest day of week (given by the 'weekday' parameter,
-# Sunday==0) on or before a given Julian Day.
+# 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
@@ -4168,16 +4227,18 @@ proc ::tcl::clock::IsGregorianLeapYear { date } {
#----------------------------------------------------------------------
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.
+# Service procedure that does binary search in several places
+# inside the 'clock' command.
#
# Parameters:
# list - List of lists, sorted in ascending order by the
@@ -4185,8 +4246,8 @@ proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
# key - Value to search for
#
# Results:
-# Returns the index of the greatest element in $list that is less than
-# or equal to $key.
+# Returns the index of the greatest element in $list that is less
+# than or equal to $key.
#
# Side effects:
# None.
@@ -4194,6 +4255,7 @@ proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
#----------------------------------------------------------------------
proc ::tcl::clock::BSearch { list key } {
+
if {[llength $list] == 0} {
return -1
}
@@ -4205,12 +4267,13 @@ proc ::tcl::clock::BSearch { list key } {
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.
+ # 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] } {
@@ -4254,14 +4317,15 @@ proc ::tcl::clock::BSearch { list key } {
# 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.
+# 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 \
@@ -4280,10 +4344,15 @@ proc ::tcl::clock::add { clockval args } {
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
}
@@ -4295,7 +4364,8 @@ proc ::tcl::clock::add { clockval args } {
set timezone $b
}
default {
- throw [list CLOCK badSwitch $a] \
+ return -code error \
+ -errorcode [list CLOCK badSwitch $a] \
"bad switch \"$a\",\
must be -gmt, -locale or -timezone"
}
@@ -4311,16 +4381,20 @@ proc ::tcl::clock::add { clockval args } {
"cannot use -gmt and -timezone in same call"
}
if { [catch { expr { wide($clockval) } } result] } {
- return -code error "expected integer but got \"$clockval\""
+ return -code error \
+ "expected integer but got \"$clockval\""
}
- if { ![string is boolean -strict $gmt] } {
- return -code error "expected boolean value but got \"$gmt\""
- } elseif { $gmt } {
- set timezone :GMT
+ if { ![string is boolean $gmt] } {
+ return -code error \
+ "expected boolean value but got \"$gmt\""
+ } else {
+ if { $gmt } {
+ set timezone :GMT
+ }
}
- EnterLocale $locale oldLocale
-
+ EnterLocale $locale
+
set changeover [mc GREGORIAN_CHANGE_DATE]
if {[catch {SetupTimeZone $timezone} retval opts]} {
@@ -4328,25 +4402,29 @@ proc ::tcl::clock::add { clockval args } {
return -options $opts $retval
}
- try {
+ set status [catch {
+
foreach { quantity unit } $offsets {
+
switch -exact -- $unit {
+
years - year {
- set clockval [AddMonths [expr { 12 * $quantity }] \
- $clockval $timezone $changeover]
+ set clockval \
+ [AddMonths [expr { 12 * $quantity }] \
+ $clockval $timezone $changeover]
}
months - month {
set clockval [AddMonths $quantity $clockval $timezone \
- $changeover]
+ $changeover]
}
weeks - week {
set clockval [AddDays [expr { 7 * $quantity }] \
- $clockval $timezone $changeover]
+ $clockval $timezone $changeover]
}
days - day {
set clockval [AddDays $quantity $clockval $timezone \
- $changeover]
+ $changeover]
}
hours - hour {
@@ -4360,24 +4438,27 @@ proc ::tcl::clock::add { clockval args } {
}
default {
- throw [list CLOCK badUnit $unit] \
- "unknown unit \"$unit\", must be \
- years, months, weeks, days, hours, minutes or seconds"
+ 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]
}
}
}
- return $clockval
- } trap CLOCK {result opts} {
- # Conceal the innards of [clock] when it's an expected error
- dict unset opts -errorinfo
- return -options $opts $result
- } finally {
- # Restore the locale
+ } 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
}
+
}
#----------------------------------------------------------------------
@@ -4402,6 +4483,7 @@ proc ::tcl::clock::add { clockval args } {
#----------------------------------------------------------------------
proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
+
variable DaysInRomanMonthInCommonYear
variable DaysInRomanMonthInLeapYear
variable TZData
@@ -4409,9 +4491,8 @@ proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
# 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 secondOfDay [expr { [dict get $date localSeconds]
+ % 86400 }]
dict set date tzName $timezone
# Add the requisite number of months
@@ -4440,23 +4521,23 @@ proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
set date [GetJulianDayFromEraYearMonthDay \
$date[set date {}]\
$changeover]
- dict set date localSeconds [expr {
- -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay]
- }]
+ 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.
+# 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)
@@ -4466,7 +4547,8 @@ proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
# in the target locale.
#
# Results:
-# Returns the new clock value as a number of seconds since the epoch.
+# Returns the new clock value as a number of seconds since
+# the epoch.
#
# Side effects:
# None.
@@ -4474,14 +4556,14 @@ proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
#----------------------------------------------------------------------
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 secondOfDay [expr { [dict get $date localSeconds]
+ % 86400 }]
dict set date tzName $timezone
# Add the requisite number of days
@@ -4490,47 +4572,15 @@ proc ::tcl::clock::AddDays { days clockval timezone changeover } {
# Reconvert to a number of seconds
- dict set date localSeconds [expr {
- -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay]
- }]
+ 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]
- }
- set val [::msgcat::mc $name]
- dict set McLoaded $Locale $name $val
- return $val
}
#----------------------------------------------------------------------
@@ -4551,9 +4601,9 @@ proc ::tcl::clock::mc { name } {
#----------------------------------------------------------------------
proc ::tcl::clock::ClearCaches {} {
+
variable FormatProc
variable LocaleNumeralCache
- variable McLoaded
variable CachedSystemTimeZone
variable TimeZoneBad
@@ -4566,8 +4616,11 @@ proc ::tcl::clock::ClearCaches {} {
catch {unset FormatProc}
set LocaleNumeralCache {}
- set McLoaded {}
+ # this removes many required keys and makes the module unusable
+ mcpackagelocale set ""
+ mcpackagelocale clear
catch {unset CachedSystemTimeZone}
set TimeZoneBad {}
InitTZData
+
}