Attachment "clock.tcl.patch" to
ticket [3475995fff]
added by
sebres
2012-02-02 16:25:38.
Index: clock.tcl
===================================================================
--- clock.tcl (revision 78)
+++ clock.tcl (working copy)
@@ -14,6 +14,8 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#----------------------------------------------------------------------
+# Modified and optimized 2012 by Serg G. Brester (sebres)
+#----------------------------------------------------------------------
# We must have message catalogs that support the root locale, and
# we need access to the Registry on Windows systems.
@@ -301,7 +303,7 @@
# been made to make a reasonable guess, but this table needs to be
# taken with a grain of salt.
- variable WinZoneInfo [dict create {*}{
+ variable WinZoneInfo [::tcl::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
@@ -390,37 +392,37 @@
{ julianDay } 1 {}
{ era century yearOfCentury month dayOfMonth } 2 {
- dict set date year [expr { 100 * [dict get $date century]
- + [dict get $date yearOfCentury] }]
+ dict set date year [expr { 100 * [::tcl::dict::get $date century]
+ + [::tcl::dict::get $date yearOfCentury] }]
set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
$changeover]
}
{ era century yearOfCentury dayOfYear } 2 {
- dict set date year [expr { 100 * [dict get $date century]
- + [dict get $date yearOfCentury] }]
+ dict set date year [expr { 100 * [::tcl::dict::get $date century]
+ + [::tcl::dict::get $date yearOfCentury] }]
set date [GetJulianDayFromEraYearDay $date[set date {}] \
$changeover]
}
{ century yearOfCentury month dayOfMonth } 3 {
dict set date era CE
- dict set date year [expr { 100 * [dict get $date century]
- + [dict get $date yearOfCentury] }]
+ dict set date year [expr { 100 * [::tcl::dict::get $date century]
+ + [::tcl::dict::get $date yearOfCentury] }]
set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
$changeover]
}
{ century yearOfCentury dayOfYear } 3 {
dict set date era CE
- dict set date year [expr { 100 * [dict get $date century]
- + [dict get $date yearOfCentury] }]
+ dict set date year [expr { 100 * [::tcl::dict::get $date century]
+ + [::tcl::dict::get $date yearOfCentury] }]
set date [GetJulianDayFromEraYearDay $date[set date {}] \
$changeover]
}
{ iso8601Century iso8601YearOfCentury iso8601Week dayOfWeek } 3 {
dict set date era CE
dict set date iso8601Year \
- [expr { 100 * [dict get $date iso8601Century]
- + [dict get $date iso8601YearOfCentury] }]
+ [expr { 100 * [::tcl::dict::get $date iso8601Century]
+ + [::tcl::dict::get $date iso8601YearOfCentury] }]
set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
$changeover]
}
@@ -526,7 +528,7 @@
# Legacy time zones, used primarily for parsing RFC822 dates.
- variable LegacyTimeZone [dict create \
+ variable LegacyTimeZone [::tcl::dict::create \
gmt +0000 \
ut +0000 \
utc +0000 \
@@ -667,7 +669,6 @@
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
@@ -685,17 +686,14 @@
# 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 procName formatproc'
+ set procName '$format'$locale
+ if {![info exists FormatProc($procName)]} {
set FormatProc($procName) \
- [ParseClockFormatFormat $procName $format $locale]
+ [ParseClockFormatFormat formatproc[string map {: {\:} \\ {\\}} $procName] $format $locale]
}
- return [$procName $clockval $timezone]
-
+ $FormatProc($procName) [lindex $args 0] $timezone
}
#----------------------------------------------------------------------
@@ -721,7 +719,9 @@
# Map away the locale-dependent composite format groups
- EnterLocale $locale oldLocale
+ if { $locale ne {c} && $locale ne [mclocale] } {
+ EnterLocale $locale oldLocale
+ }
# Change locale if a fresh locale has been given on the command line.
@@ -740,7 +740,7 @@
# Return either the error or the proc name
if { $status == 1 } {
- if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
+ if { [lindex [::tcl::dict::get $opts -errorcode] 0] eq {CLOCK} } {
return -code error $result
} else {
return -options $opts $result
@@ -792,7 +792,7 @@
[list @DAYS_OF_WEEK_ABBREV@ \
[list [mc DAYS_OF_WEEK_ABBREV]]] \
{ [lindex @DAYS_OF_WEEK_ABBREV@ \
- [expr {[dict get $date dayOfWeek] \
+ [expr {[::tcl::dict::get $date dayOfWeek] \
% 7}]]}]
}
A { # Day of week, spelt out.
@@ -802,7 +802,7 @@
[list @DAYS_OF_WEEK_FULL@ \
[list [mc DAYS_OF_WEEK_FULL]]] \
{ [lindex @DAYS_OF_WEEK_FULL@ \
- [expr {[dict get $date dayOfWeek] \
+ [expr {[::tcl::dict::get $date dayOfWeek] \
% 7}]]}]
}
b - h { # Name of month, abbreviated.
@@ -812,7 +812,7 @@
[list @MONTHS_ABBREV@ \
[list [mc MONTHS_ABBREV]]] \
{ [lindex @MONTHS_ABBREV@ \
- [expr {[dict get $date month]-1}]]}]
+ [expr {[::tcl::dict::get $date month]-1}]]}]
}
B { # Name of month, spelt out
append formatString %s
@@ -821,20 +821,20 @@
[list @MONTHS_FULL@ \
[list [mc MONTHS_FULL]]] \
{ [lindex @MONTHS_FULL@ \
- [expr {[dict get $date month]-1}]]}]
+ [expr {[::tcl::dict::get $date month]-1}]]}]
}
C { # Century number
append formatString %02d
append substituents \
- { [expr {[dict get $date year] / 100}]}
+ { [expr {[::tcl::dict::get $date year] / 100}]}
}
d { # Day of month, with leading zero
append formatString %02d
- append substituents { [dict get $date dayOfMonth]}
+ append substituents { [::tcl::dict::get $date dayOfMonth]}
}
e { # Day of month, without leading zero
append formatString %2d
- append substituents { [dict get $date dayOfMonth]}
+ append substituents { [::tcl::dict::get $date dayOfMonth]}
}
E { # Format group in a locale-dependent
# alternative era
@@ -861,23 +861,23 @@
# week number
append formatString %02d
append substituents \
- { [expr { [dict get $date iso8601Year] % 100 }]}
+ { [expr { [::tcl::dict::get $date iso8601Year] % 100 }]}
}
G { # Four-digit year relative to ISO8601
# week number
append formatString %02d
- append substituents { [dict get $date iso8601Year]}
+ append substituents { [::tcl::dict::get $date iso8601Year]}
}
H { # Hour in the 24-hour day, leading zero
append formatString %02d
append substituents \
- { [expr { [dict get $date localSeconds] \
+ { [expr { [::tcl::dict::get $date localSeconds] \
/ 3600 % 24}]}
}
I { # Hour AM/PM, with leading zero
append formatString %02d
append substituents \
- { [expr { ( ( ( [dict get $date localSeconds] \
+ { [expr { ( ( ( [::tcl::dict::get $date localSeconds] \
% 86400 ) \
+ 86400 \
- 3600 ) \
@@ -886,23 +886,23 @@
}
j { # Day of year (001-366)
append formatString %03d
- append substituents { [dict get $date dayOfYear]}
+ append substituents { [::tcl::dict::get $date dayOfYear]}
}
J { # Julian Day Number
append formatString %07ld
- append substituents { [dict get $date julianDay]}
+ append substituents { [::tcl::dict::get $date julianDay]}
}
k { # Hour (0-23), no leading zero
append formatString %2d
append substituents \
- { [expr { [dict get $date localSeconds]
+ { [expr { [::tcl::dict::get $date localSeconds]
/ 3600
% 24 }]}
}
l { # Hour (12-11), no leading zero
append formatString %2d
append substituents \
- { [expr { ( ( ( [dict get $date localSeconds]
+ { [expr { ( ( ( [::tcl::dict::get $date localSeconds]
% 86400 )
+ 86400
- 3600 )
@@ -911,12 +911,12 @@
}
m { # Month number, leading zero
append formatString %02d
- append substituents { [dict get $date month]}
+ append substituents { [::tcl::dict::get $date month]}
}
M { # Minute of the hour, leading zero
append formatString %02d
append substituents \
- { [expr { [dict get $date localSeconds]
+ { [expr { [::tcl::dict::get $date localSeconds]
/ 60
% 60 }]}
}
@@ -925,7 +925,7 @@
}
N { # Month number, no leading zero
append formatString %2d
- append substituents { [dict get $date month]}
+ append substituents { [::tcl::dict::get $date month]}
}
O { # A format group in the locale's
# alternative numerals
@@ -944,7 +944,7 @@
[list set AM [string toupper [mc AM]]] \n \
[list set PM [string toupper [mc PM]]] \n
append substituents \
- { [expr {(([dict get $date localSeconds]
+ { [expr {(([::tcl::dict::get $date localSeconds]
% 86400) < 43200) ?
$AM : $PM}]}
}
@@ -954,7 +954,7 @@
[list set am [mc AM]] \n \
[list set pm [mc PM]] \n
append substituents \
- { [expr {(([dict get $date localSeconds]
+ { [expr {(([::tcl::dict::get $date localSeconds]
% 86400) < 43200) ?
$am : $pm}]}
@@ -965,13 +965,13 @@
}
s { # Seconds from the Posix Epoch
append formatString %s
- append substituents { [dict get $date seconds]}
+ append substituents { [::tcl::dict::get $date seconds]}
}
S { # Second of the minute, with
# leading zero
append formatString %02d
append substituents \
- { [expr { [dict get $date localSeconds]
+ { [expr { [::tcl::dict::get $date localSeconds]
% 60 }]}
}
t { # A literal tab character
@@ -979,20 +979,20 @@
}
u { # Day of the week (1-Monday, 7-Sunday)
append formatString %1d
- append substituents { [dict get $date dayOfWeek]}
+ append substituents { [::tcl::dict::get $date dayOfWeek]}
}
U { # Week of the year (00-53). The
# first Sunday of the year is the
# first day of week 01
append formatString %02d
append preFormatCode {
- set dow [dict get $date dayOfWeek]
+ set dow [::tcl::dict::get $date dayOfWeek]
if { $dow == 7 } {
set dow 0
}
incr dow
set UweekNumber \
- [expr { ( [dict get $date dayOfYear]
+ [expr { ( [::tcl::dict::get $date dayOfYear]
- $dow + 7 )
/ 7 }]
}
@@ -1000,21 +1000,21 @@
}
V { # The ISO8601 week number
append formatString %02d
- append substituents { [dict get $date iso8601Week]}
+ append substituents { [::tcl::dict::get $date iso8601Week]}
}
w { # Day of the week (0-Sunday,
# 6-Saturday)
append formatString %1d
append substituents \
- { [expr { [dict get $date dayOfWeek] % 7 }]}
+ { [expr { [::tcl::dict::get $date dayOfWeek] % 7 }]}
}
W { # Week of the year (00-53). The first
# Monday of the year is the first day
# of week 01.
append preFormatCode {
set WweekNumber \
- [expr { ( [dict get $date dayOfYear]
- - [dict get $date dayOfWeek]
+ [expr { ( [::tcl::dict::get $date dayOfYear]
+ - [::tcl::dict::get $date dayOfWeek]
+ 7 )
/ 7 }]
}
@@ -1024,21 +1024,21 @@
y { # The two-digit year of the century
append formatString %02d
append substituents \
- { [expr { [dict get $date year] % 100 }]}
+ { [expr { [::tcl::dict::get $date year] % 100 }]}
}
Y { # The four-digit year
append formatString %04d
- append substituents { [dict get $date year]}
+ append substituents { [::tcl::dict::get $date year]}
}
z { # The time zone as hours and minutes
# east (+) or west (-) of Greenwich
append formatString %s
append substituents { [FormatNumericTimeZone \
- [dict get $date tzOffset]]}
+ [::tcl::dict::get $date tzOffset]]}
}
Z { # The name of the time zone
append formatString %s
- append substituents { [dict get $date tzName]}
+ append substituents { [::tcl::dict::get $date tzName]}
}
% { # A literal percent character
append formatString %%
@@ -1057,16 +1057,16 @@
[string map \
[list @BCE@ [list [mc BCE]] \
@CE@ [list [mc CE]]] \
- {[dict get {BCE @BCE@ CE @CE@} \
- [dict get $date era]]}]
+ {[::tcl::dict::get {BCE @BCE@ CE @CE@} \
+ [::tcl::dict::get $date era]]}]
}
C { # Locale-dependent era
append formatString %s
- append substituents { [dict get $date localeEra]}
+ append substituents { [::tcl::dict::get $date localeEra]}
}
y { # Locale-dependent year of the era
append preFormatCode {
- set y [dict get $date localeYear]
+ set y [::tcl::dict::get $date localeYear]
if { $y >= 0 && $y < 100 } {
set Eyear [lindex $localeNumerals $y]
} else {
@@ -1089,14 +1089,14 @@
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [dict get $date dayOfMonth]]}
+ [::tcl::dict::get $date dayOfMonth]]}
}
H - k { # Hour of the day in alternative
# numerals
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [expr { [dict get $date localSeconds]
+ [expr { [::tcl::dict::get $date localSeconds]
/ 3600
% 24 }]]}
}
@@ -1105,7 +1105,7 @@
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [expr { ( ( ( [dict get $date localSeconds]
+ [expr { ( ( ( [::tcl::dict::get $date localSeconds]
% 86400 )
+ 86400
- 3600 )
@@ -1115,14 +1115,14 @@
m { # Month number in alternative numerals
append formatString %s
append substituents \
- { [lindex $localeNumerals [dict get $date month]]}
+ { [lindex $localeNumerals [::tcl::dict::get $date month]]}
}
M { # Minute of the hour in alternative
# numerals
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [expr { [dict get $date localSeconds]
+ [expr { [::tcl::dict::get $date localSeconds]
/ 60
% 60 }]]}
}
@@ -1131,7 +1131,7 @@
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [expr { [dict get $date localSeconds]
+ [expr { [::tcl::dict::get $date localSeconds]
% 60 }]]}
}
u { # Day of the week (Monday=1,Sunday=7)
@@ -1139,21 +1139,21 @@
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [dict get $date dayOfWeek]]}
+ [::tcl::dict::get $date dayOfWeek]]}
}
w { # Day of the week (Sunday=0,Saturday=6)
# in alternative numerals
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [expr { [dict get $date dayOfWeek] % 7 }]]}
+ [expr { [::tcl::dict::get $date dayOfWeek] % 7 }]]}
}
y { # Year of the century in alternative
# numerals
append formatString %s
append substituents \
{ [lindex $localeNumerals \
- [expr { [dict get $date year] % 100 }]]}
+ [expr { [::tcl::dict::get $date year] % 100 }]]}
}
default { # Unknown format group
append formatString %%O $char
@@ -1213,7 +1213,7 @@
\"$cmdName string\
?-base seconds?\
?-format string? ?-gmt boolean?\
- ?-locale LOCALE? ?-timezone ZONE?\""
+ ?-locale LOCALE? ?-timezone ZONE? ?-valid 1|0?\""
}
# Set defaults
@@ -1224,6 +1224,7 @@
set gmt 0
set locale c
set timezone [GetSystemTimeZone]
+ set validate 1
# Pick up command line options.
@@ -1245,11 +1246,14 @@
-t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
set timezone $value
}
+ -v - -valid {
+ set validate $value
+ }
default {
return -code error \
-errorcode [list CLOCK badSwitch $flag] \
"bad switch \"$flag\",\
- must be -base, -format, -gmt, -locale or -timezone"
+ must be -base, -format, -gmt, -locale, -timezone or -valid"
}
}
}
@@ -1283,38 +1287,18 @@
"legacy \[clock scan\] does not support -locale"
}
- return [FreeScan $string $base $timezone $locale]
+ return [FreeScan $string $base $timezone $locale $validate]
}
- # 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
+ # Map away the locale-dependent composite format groups
+
+ set procName '$format'$locale
+ variable ScanProc
+ if {![info exists ScanProc($procName)]} {
+ set ScanProc($procName) \
+ [ParseClockScanFormat $format $locale scanproc[string map {: {\:} \\ {\\}} $procName]]
}
-
- if { $status == 1 } {
- if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
- return -code error $result
- } else {
- return -options $opts $result
- }
- } else {
- return $result
- }
-
+ $ScanProc($procName) $string $base $timezone $validate
}
#----------------------------------------------------------------------
@@ -1335,7 +1319,7 @@
#
#----------------------------------------------------------------------
-proc ::tcl::clock::FreeScan { string base timezone locale } {
+proc ::tcl::clock::FreeScan { string base timezone locale {validate 1} } {
variable TZData
@@ -1353,7 +1337,7 @@
$base \
$TZData($timezone) \
2361222]
- dict set date secondOfDay [expr { [dict get $date localSeconds]
+ dict set date secondOfDay [expr { [::tcl::dict::get $date localSeconds]
% 86400 }]
# Parse the date. The parser will return a list comprising
@@ -1362,9 +1346,9 @@
set status [catch {
Oldscan $string \
- [dict get $date year] \
- [dict get $date month] \
- [dict get $date dayOfMonth]
+ [::tcl::dict::get $date year] \
+ [::tcl::dict::get $date month] \
+ [::tcl::dict::get $date dayOfMonth]
} result]
if { $status != 0 } {
return -code error "unable to convert date-time string \"$string\": $result"
@@ -1422,13 +1406,23 @@
dict set date secondOfDay 0
}
+ if {$validate} {
+ if {[catch {
+ ValidDate $date $string
+ } result opts]} {
+ if { [lindex [::tcl::dict::get $opts -errorcode] 0] eq {CLOCK} } {
+ dict unset opts -errorinfo
+ }
+ return -options $opts -code error -level 2 $result
+ }
+ }
dict set date localSeconds \
[expr { -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay] }]
+ + ( 86400 * wide([::tcl::dict::get $date julianDay]) )
+ + [::tcl::dict::get $date secondOfDay] }]
dict set date tzName $timezone
set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) 2361222]
- set seconds [dict get $date seconds]
+ set seconds [::tcl::dict::get $date seconds]
# Do relative times
@@ -1447,23 +1441,23 @@
set date2 [GetDateFields $seconds $TZData($timezone) 2361222]
dict set date2 era CE
set jdwkday [WeekdayOnOrBefore $dayOfWeek \
- [expr { [dict get $date2 julianDay]
+ [expr { [::tcl::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 }]
+ [expr { [::tcl::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] }]
+ + ( 86400 * wide([::tcl::dict::get $date2 julianDay]) )
+ + [::tcl::dict::get $date secondOfDay] }]
dict set date2 tzName $timezone
set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
2361222]
- set seconds [dict get $date2 seconds]
+ set seconds [::tcl::dict::get $date2 seconds]
}
@@ -1473,13 +1467,13 @@
lassign $parseOrdinalMonth monthOrdinal monthNumber
if { $monthOrdinal > 0 } {
- set monthDiff [expr { $monthNumber - [dict get $date month] }]
+ set monthDiff [expr { $monthNumber - [::tcl::dict::get $date month] }]
if { $monthDiff <= 0 } {
incr monthDiff 12
}
incr monthOrdinal -1
} else {
- set monthDiff [expr { [dict get $date month] - $monthNumber }]
+ set monthDiff [expr { [::tcl::dict::get $date month] - $monthNumber }]
if { $monthDiff >= 0 } {
incr monthDiff -12
}
@@ -1525,17 +1519,50 @@
#
#----------------------------------------------------------------------
-proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
+proc ::tcl::clock::ParseClockScanFormat {formatString locale procName} {
# 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] != {} } {
+ if {[namespace which $procName] ne {}} {
return $procName
}
+ # Map away the locale-dependent composite format groups
+
+ if { $locale ne {c} && $locale ne [mclocale] } {
+ EnterLocale $locale oldLocale
+ }
+
+ # Change locale if a fresh locale has been given on the command line.
+
+ set status [catch {
+
+ ParseClockScanFormat2 $formatString $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 [::tcl::dict::get $opts -errorcode] 0] eq {CLOCK} } {
+ return -code error $result
+ } else {
+ return -options $opts $result
+ }
+ } else {
+ return $result
+ }
+
+}
+
+proc ::tcl::clock::ParseClockScanFormat2 {formatString locale procName} {
+
variable DateParseActions
variable TimeParseActions
@@ -1558,7 +1585,7 @@
set re {^[[:space:]]*}
set captureCount 0
set postcode {}
- set fieldSet [dict create]
+ set fieldSet [::tcl::dict::create]
set fieldCount 0
set postSep {}
set state {}
@@ -1937,7 +1964,7 @@
lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet dayOfWeek [incr fieldCount]
- append postcode "set dow \[dict get " [list $lookup] \
+ append postcode "set dow \[::tcl::dict::get " [list $lookup] \
{ $field} [incr captureCount] \] \n \
{
if { $dow == 0 } {
@@ -1989,18 +2016,18 @@
{input string does not match supplied format}
}
append procBody \}\n
- append procBody "set date \[dict create\]" \n
+ append procBody "set date \[::tcl::dict::create\]" \n
append procBody {dict set date tzName $timeZone} \n
append procBody $postcode
append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n
# Get time zone if needed
- if { ![dict exists $fieldSet seconds]
- && ![dict exists $fieldSet starDate] } {
- if { [dict exists $fieldSet tzName] } {
+ if { ![::tcl::dict::exists $fieldSet seconds]
+ && ![::tcl::dict::exists $fieldSet starDate] } {
+ if { [::tcl::dict::exists $fieldSet tzName] } {
append procBody {
- set timeZone [dict get $date tzName]
+ set timeZone [::tcl::dict::get $date tzName]
}
}
append procBody {
@@ -2018,30 +2045,34 @@
# Assemble seconds, and convert local nominal time to UTC.
- if { ![dict exists $fieldSet seconds]
- && ![dict exists $fieldSet starDate] } {
+ if { ![::tcl::dict::exists $fieldSet seconds]
+ && ![::tcl::dict::exists $fieldSet starDate] } {
append procBody {
- if { [dict get $date julianDay] > 5373484 } {
+ if { [::tcl::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] }]
+ + ( 86400 * wide([::tcl::dict::get $date julianDay]) )
+ + [::tcl::dict::get $date secondOfDay] }]
}
append procBody {
set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
$TZData($timeZone) \
$changeover]
+
+ if {$validate} {
+ ValidDate $date $string
+ }
}
}
# Return result
- append procBody {return [dict get $date seconds]} \n
+ append procBody {return [::tcl::dict::get $date seconds]} \n
- proc $procName { string baseTime timeZone } $procBody
+ proc $procName { string baseTime timeZone {validate 1} } $procBody
# puts [list proc $procName [list string baseTime timeZone] $procBody]
@@ -2071,7 +2102,7 @@
variable LocaleNumeralCache
- if { ![dict exists $LocaleNumeralCache $l] } {
+ if { ![::tcl::dict::exists $LocaleNumeralCache $l] } {
set d {}
set i 0
set sep \(
@@ -2085,7 +2116,7 @@
append re \)
dict set LocaleNumeralCache $l [list $re $d]
}
- return [dict get $LocaleNumeralCache $l]
+ return [::tcl::dict::get $LocaleNumeralCache $l]
}
@@ -2121,8 +2152,8 @@
# 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 {} {}]
+ set prefixMapping [::tcl::dict::create]
+ set successors [::tcl::dict::create {} {}]
# Walk the key-value pairs
@@ -2140,7 +2171,7 @@
# dictionaries
dict lappend prefixMapping $prefix $value
- if { ![dict exists $successors $prefix] } {
+ if { ![::tcl::dict::exists $successors $prefix] } {
dict set successors $prefix {}
}
}
@@ -2197,7 +2228,7 @@
# Get the characters that may follow the current prefix string
- set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]]
+ set schars [lsort -ascii [::tcl::dict::keys [::tcl::dict::get $successors $prefixString]]]
if { [llength $schars] == 0 } {
return {}
}
@@ -2207,7 +2238,7 @@
# parentheses.
set re {}
- if { [dict exists $uniquePrefixMapping $prefixString]
+ if { [::tcl::dict::exists $uniquePrefixMapping $prefixString]
|| [llength $schars] > 1 } {
append re "(?:"
}
@@ -2228,7 +2259,7 @@
# optional. Otherwise, if there is more than one successor character,
# close the non-capturing parentheses.
- if { [dict exists $uniquePrefixMapping $prefixString] } {
+ if { [::tcl::dict::exists $uniquePrefixMapping $prefixString] } {
append re ")?"
} elseif { [llength $schars] > 1 } {
append re ")"
@@ -2284,11 +2315,11 @@
set fieldPos [list]
set ok true
foreach field $fieldSet {
- if { ! [dict exists $dateFields $field] } {
+ if { ! [::tcl::dict::exists $dateFields $field] } {
set ok 0
break
}
- lappend fieldPos [dict get $dateFields $field]
+ lappend fieldPos [::tcl::dict::get $dateFields $field]
}
# Quit if we don't have a complete set of fields
@@ -2351,7 +2382,9 @@
#----------------------------------------------------------------------
proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
-
+ if { $locale eq {c} } {
+ return
+ }
upvar 1 $oldLocaleVar oldLocale
variable MsgDir
@@ -2373,7 +2406,7 @@
# date and time formats from the Control Panel.
# First, load the 'current' locale if it's not yet loaded
- if {![dict exists $McLoaded $oldLocale] } {
+ if {![::tcl::dict::exists $McLoaded $oldLocale] } {
mcload $MsgDir
dict set McLoaded $oldLocale {}
}
@@ -2382,7 +2415,7 @@
# get the Control Panel information
set locale ${oldLocale}_windows
- if { ![dict exists $McLoaded $locale] } {
+ if { ![::tcl::dict::exists $McLoaded $locale] } {
LoadWindowsDateTimeFormats $locale
dict set McLoaded $locale {}
}
@@ -2396,7 +2429,7 @@
} else {
mclocale $locale
}
- if { ![dict exists $McLoaded $locale] } {
+ if { ![::tcl::dict::exists $McLoaded $locale] } {
mcload $MsgDir
dict set McLoaded $locale {}
}
@@ -2556,8 +2589,8 @@
variable McLoaded
- if { [dict exists $McLoaded $locale FORMAT $format] } {
- return [dict get $McLoaded $locale FORMAT $format]
+ if { [::tcl::dict::exists $McLoaded $locale FORMAT $format] } {
+ return [::tcl::dict::get $McLoaded $locale FORMAT $format]
}
set inFormat $format
@@ -2650,7 +2683,7 @@
# Get day of year, zero based
- set doy [expr { [dict get $date dayOfYear] - 1 }]
+ set doy [expr { [::tcl::dict::get $date dayOfYear] - 1 }]
# Determine whether the year is a leap year
@@ -2667,9 +2700,9 @@
# Put together the StarDate
return [::format "Stardate %02d%03d.%1d" \
- [expr { [dict get $date year] - $Roddenberry }] \
+ [expr { [::tcl::dict::get $date year] - $Roddenberry }] \
$fractYear \
- [expr { [dict get $date localSeconds] % 86400
+ [expr { [::tcl::dict::get $date localSeconds] % 86400
/ ( 86400 / 10 ) }]]
}
@@ -2701,7 +2734,7 @@
# Build a tentative date from year and fraction.
- set date [dict create \
+ set date [::tcl::dict::create \
gregorian 1 \
era CE \
year [expr { $year + $Roddenberry }] \
@@ -2726,7 +2759,7 @@
dict unset date gregorian
set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]
- return [expr { 86400 * [dict get $date julianDay]
+ return [expr { 86400 * [::tcl::dict::get $date julianDay]
- 210866803200
+ ( 86400 / 10 ) * $fractDay }]
@@ -2794,7 +2827,7 @@
{ twoDigitField yearOfCentury }
{ fourDigitField year } } {
- set yr [dict get $date $twoDigitField]
+ set yr [::tcl::dict::get $date $twoDigitField]
if { $yr <= 37 } {
dict set date $fourDigitField [expr { $yr + 2000 }]
} else {
@@ -2837,8 +2870,8 @@
# Store the converted year
- dict set date era [dict get $date2 era]
- dict set date year [dict get $date2 year]
+ dict set date era [::tcl::dict::get $date2 era]
+ dict set date year [::tcl::dict::get $date2 year]
return $date
@@ -2878,7 +2911,7 @@
# Calculate the ISO8601 date and transfer the year
dict set date era CE
- dict set date iso8601Year [dict get $date2 iso8601Year]
+ dict set date iso8601Year [::tcl::dict::get $date2 iso8601Year]
return $date
}
@@ -2911,9 +2944,9 @@
# 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]
+ dict set date era [::tcl::dict::get $date2 era]
+ dict set date year [::tcl::dict::get $date2 year]
+ dict set date month [::tcl::dict::get $date2 month]
return $date
}
@@ -2951,8 +2984,8 @@
# Calculate the ISO8601 date and transfer the year
dict set date era CE
- dict set date iso8601Year [dict get $date2 iso8601Year]
- dict set date iso8601Week [dict get $date2 iso8601Week]
+ dict set date iso8601Year [::tcl::dict::get $date2 iso8601Year]
+ dict set date iso8601Week [::tcl::dict::get $date2 iso8601Week]
return $date
}
@@ -2984,7 +3017,7 @@
# 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]
+ dict set date julianDay [::tcl::dict::get $date2 julianDay]
return $date
}
@@ -3009,11 +3042,11 @@
proc ::tcl::clock::InterpretHMSP { date } {
- set hr [dict get $date hourAMPM]
+ set hr [::tcl::dict::get $date hourAMPM]
if { $hr == 12 } {
set hr 0
}
- if { [dict get $date amPmIndicator] } {
+ if { [::tcl::dict::get $date amPmIndicator] } {
incr hr 12
}
dict set date hour $hr
@@ -3042,9 +3075,9 @@
proc ::tcl::clock::InterpretHMS { date } {
- return [expr { ( [dict get $date hour] * 60
- + [dict get $date minute] ) * 60
- + [dict get $date second] }]
+ return [expr { ( [::tcl::dict::get $date hour] * 60
+ + [::tcl::dict::get $date minute] ) * 60
+ + [::tcl::dict::get $date second] }]
}
@@ -3068,8 +3101,13 @@
#----------------------------------------------------------------------
proc ::tcl::clock::GetSystemTimeZone {} {
-
variable CachedSystemTimeZone
+ if { [info exists CachedSystemTimeZone] } {
+ ## if not switched to another time zone (simply check cached every 10 minutes) :
+ if {abs([seconds] - [lindex $CachedSystemTimeZone 1]) < 600} {
+ return [lindex $CachedSystemTimeZone 0]
+ }
+ }
variable TimeZoneBad
if {[set result [getenv TCL_TZ]] ne {}} {
@@ -3080,28 +3118,25 @@
if {![info exists timezone]} {
# Cache the time zone only if it was detected by one of the
# expensive methods.
- if { [info exists CachedSystemTimeZone] } {
- set timezone $CachedSystemTimeZone
- } elseif { $::tcl_platform(platform) eq {windows} } {
- set timezone [GuessWindowsTimeZone]
- } elseif { [file exists /etc/localtime]
- && ![catch {ReadZoneinfoFile \
- Tcl/Localtime /etc/localtime}] } {
- set timezone :Tcl/Localtime
- } else {
- set timezone :localtime
- }
- set CachedSystemTimeZone $timezone
+ if { $::tcl_platform(platform) eq {windows} } {
+ set timezone [GuessWindowsTimeZone]
+ } elseif { [file exists /etc/localtime]
+ && ![catch {ReadZoneinfoFile \
+ Tcl/Localtime /etc/localtime}] } {
+ set timezone :Tcl/Localtime
+ } else {
+ set timezone :localtime
+ }
}
- if { ![dict exists $TimeZoneBad $timezone] } {
+ if { ![::tcl::dict::exists $TimeZoneBad $timezone] } {
dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
}
- if { [dict get $TimeZoneBad $timezone] } {
- return :localtime
- } else {
- return $timezone
+ if { [::tcl::dict::get $TimeZoneBad $timezone] } {
+ set timezone :localtime
}
-
+ ## cache (simply check cached every 10 minutes (rounded to 00:10:00)):
+ set CachedSystemTimeZone [list $timezone [expr {[set switchtime [seconds]] - ($switchtime % 600)}]]
+ return $timezone
}
#----------------------------------------------------------------------
@@ -3132,11 +3167,11 @@
variable LegacyTimeZone
set tzname [string tolower $tzname]
- if { ![dict exists $LegacyTimeZone $tzname] } {
+ if { ![::tcl::dict::exists $LegacyTimeZone $tzname] } {
return -code error -errorcode [list CLOCK badTZName $tzname] \
"time zone \"$tzname\" not found"
} else {
- return [dict get $LegacyTimeZone $tzname]
+ return [::tcl::dict::get $LegacyTimeZone $tzname]
}
}
@@ -3212,7 +3247,7 @@
# 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} } {
+ if { [lindex [::tcl::dict::get $opts -errorcode] 0] eq {CLOCK} } {
dict unset opts -errorinfo
}
return -options $opts $data
@@ -3307,15 +3342,15 @@
# 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] } {
+ if { [::tcl::dict::exists $WinZoneInfo $data] } {
+ set tzname [::tcl::dict::get $WinZoneInfo $data]
+ if { ! [::tcl::dict::exists $TimeZoneBad $tzname] } {
dict set TimeZoneBad $tzname [catch {SetupTimeZone $tzname}]
}
} else {
set tzname {}
}
- if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } {
+ if { $tzname eq {} || [::tcl::dict::get $TimeZoneBad $tzname] } {
lassign $data \
bias stdBias dstBias \
stdYear stdMonth stdDayOfWeek stdDayOfMonth \
@@ -3380,7 +3415,7 @@
dict set WinZoneInfo $data $tzname
}
- return [dict get $WinZoneInfo $data]
+ return [::tcl::dict::get $WinZoneInfo $data]
}
@@ -3599,7 +3634,7 @@
}
set lastTime $t
lassign [lindex $types $c] gmtoff isDst abbrInd
- set abbrev [dict get $abbrevs $abbrInd]
+ set abbrev [::tcl::dict::get $abbrevs $abbrInd]
lappend r [list $t $gmtoff $isDst $abbrev]
}
@@ -3834,23 +3869,23 @@
# Determine the standard time zone name and seconds east of Greenwich
- set stdName [dict get $z stdName]
+ set stdName [::tcl::dict::get $z stdName]
if { [string index $stdName 0] eq {<} } {
set stdName [string range $stdName 1 end-1]
}
- if { [dict get $z stdSignum] eq {-} } {
+ if { [::tcl::dict::get $z stdSignum] eq {-} } {
set stdSignum +1
} else {
set stdSignum -1
}
- 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 stdHours [lindex [::scan [::tcl::dict::get $z stdHours] %d] 0]
+ if { [::tcl::dict::get $z stdMinutes] ne {} } {
+ set stdMinutes [lindex [::scan [::tcl::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]
+ if { [::tcl::dict::get $z stdSeconds] ne {} } {
+ set stdSeconds [lindex [::scan [::tcl::dict::get $z stdSeconds] %d] 0]
} else {
set stdSeconds 0
}
@@ -3861,7 +3896,7 @@
# If there's no daylight zone, we're done
- set dstName [dict get $z dstName]
+ set dstName [::tcl::dict::get $z dstName]
if { $dstName eq {} } {
return $data
}
@@ -3871,22 +3906,22 @@
# Determine the daylight name
- if { [dict get $z dstSignum] eq {-} } {
+ if { [::tcl::dict::get $z dstSignum] eq {-} } {
set dstSignum +1
} else {
set dstSignum -1
}
- if { [dict get $z dstHours] eq {} } {
+ if { [::tcl::dict::get $z dstHours] eq {} } {
set dstOffset [expr { 3600 + $stdOffset }]
} else {
- 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 dstHours [lindex [::scan [::tcl::dict::get $z dstHours] %d] 0]
+ if { [::tcl::dict::get $z dstMinutes] ne {} } {
+ set dstMinutes [lindex [::scan [::tcl::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]
+ if { [::tcl::dict::get $z dstSeconds] ne {} } {
+ set dstSeconds [lindex [::scan [::tcl::dict::get $z dstSeconds] %d] 0]
} else {
set dstSeconds 0
}
@@ -3901,8 +3936,8 @@
# 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 {} } {
+ if { [::tcl::dict::get $z startDayOfYear] eq {}
+ && [::tcl::dict::get $z startMonth] eq {} } {
if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
# EU
dict set z startWeekOfMonth 5
@@ -3921,8 +3956,8 @@
dict set z startMinutes 0
dict set z startSeconds 0
}
- if { [dict get $z endDayOfYear] eq {}
- && [dict get $z endMonth] eq {} } {
+ if { [::tcl::dict::get $z endDayOfYear] eq {}
+ && [::tcl::dict::get $z endMonth] eq {} } {
if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
# EU
dict set z endMonth 10
@@ -3991,13 +4026,13 @@
# Determine the start or end day of DST
- set date [dict create era CE year $y]
- set doy [dict get $z ${bound}DayOfYear]
+ set date [::tcl::dict::create era CE year $y]
+ set doy [::tcl::dict::get $z ${bound}DayOfYear]
if { $doy ne {} } {
# Time was specified as a day of the year
- if { [dict get $z ${bound}J] ne {}
+ if { [::tcl::dict::get $z ${bound}J] ne {}
&& [IsGregorianLeapYear $y]
&& ( $doy > $FEB_28 ) } {
incr doy
@@ -4008,9 +4043,9 @@
# 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]
+ dict set date month [::tcl::dict::get $z ${bound}Month]
+ dict set date dayOfWeek [::tcl::dict::get $z ${bound}DayOfWeek]
+ set dowim [::tcl::dict::get $z ${bound}WeekOfMonth]
if { $dowim >= 5 } {
set dowim -1
}
@@ -4019,23 +4054,23 @@
}
- set jd [dict get $date julianDay]
+ set jd [::tcl::dict::get $date julianDay]
set seconds [expr { wide($jd) * wide(86400)
- wide(210866803200) }]
- set h [dict get $z ${bound}Hours]
+ set h [::tcl::dict::get $z ${bound}Hours]
if { $h eq {} } {
set h 2
} else {
set h [lindex [::scan $h %d] 0]
}
- set m [dict get $z ${bound}Minutes]
+ set m [::tcl::dict::get $z ${bound}Minutes]
if { $m eq {} } {
set m 0
} else {
set m [lindex [::scan $m %d] 0]
}
- set s [dict get $z ${bound}Seconds]
+ set s [::tcl::dict::get $z ${bound}Seconds]
if { $s eq {} } {
set s 0
} else {
@@ -4068,15 +4103,15 @@
proc ::tcl::clock::GetLocaleEra { date etable } {
- set index [BSearch $etable [dict get $date localSeconds]]
+ set index [BSearch $etable [::tcl::dict::get $date localSeconds]]
if { $index < 0} {
dict set date localeEra \
- [::format %02d [expr { [dict get $date year] / 100 }]]
+ [::format %02d [expr { [::tcl::dict::get $date year] / 100 }]]
dict set date localeYear \
- [expr { [dict get $date year] % 100 }]
+ [expr { [::tcl::dict::get $date year] % 100 }]
} else {
dict set date localeEra [lindex $etable $index 1]
- dict set date localeYear [expr { [dict get $date year]
+ dict set date localeYear [expr { [::tcl::dict::get $date year]
- [lindex $etable $index 2] }]
}
return $date
@@ -4115,12 +4150,12 @@
# Get absolute year number from the civil year
- switch -exact -- [dict get $date era] {
+ switch -exact -- [::tcl::dict::get $date era] {
BCE {
- set year [expr { 1 - [dict get $date year] }]
+ set year [expr { 1 - [::tcl::dict::get $date year] }]
}
CE {
- set year [dict get $date year]
+ set year [::tcl::dict::get $date year]
}
}
set ym1 [expr { $year - 1 }]
@@ -4129,7 +4164,7 @@
dict set date gregorian 1
set jd [expr { 1721425
- + [dict get $date dayOfYear]
+ + [::tcl::dict::get $date dayOfYear]
+ ( 365 * $ym1 )
+ ( $ym1 / 4 )
- ( $ym1 / 100 )
@@ -4140,7 +4175,7 @@
if { $jd < $changeover } {
dict set date gregorian 0
set jd [expr { 1721423
- + [dict get $date dayOfYear]
+ + [::tcl::dict::get $date dayOfYear]
+ ( 365 * $ym1 )
+ ( $ym1 / 4 ) }]
}
@@ -4179,7 +4214,7 @@
# following month (dayOfWeekInMonth < 0)
set date2 $date
- set week [dict get $date dayOfWeekInMonth]
+ set week [::tcl::dict::get $date dayOfWeekInMonth]
if { $week >= 0 } {
dict set date2 dayOfMonth 0
} else {
@@ -4188,8 +4223,8 @@
}
set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \
$changeover]
- set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \
- [dict get $date2 julianDay]]
+ set wd0 [WeekdayOnOrBefore [::tcl::dict::get $date dayOfWeek] \
+ [::tcl::dict::get $date2 julianDay]]
dict set date julianDay [expr { $wd0 + 7 * $week }]
return $date
@@ -4216,17 +4251,17 @@
proc ::tcl::clock::IsGregorianLeapYear { date } {
- switch -exact -- [dict get $date era] {
+ switch -exact -- [::tcl::dict::get $date era] {
BCE {
- set year [expr { 1 - [dict get $date year]}]
+ set year [expr { 1 - [::tcl::dict::get $date year]}]
}
CE {
- set year [dict get $date year]
+ set year [::tcl::dict::get $date year]
}
}
if { $year % 4 != 0 } {
return 0
- } elseif { ![dict get $date gregorian] } {
+ } elseif { ![::tcl::dict::get $date gregorian] } {
return 1
} elseif { $year % 400 == 0 } {
return 1
@@ -4424,7 +4459,9 @@
}
}
- EnterLocale $locale oldLocale
+ if { $locale ne {c} && $locale ne [mclocale] } {
+ EnterLocale $locale oldLocale
+ }
set changeover [mc GREGORIAN_CHANGE_DATE]
@@ -4486,7 +4523,7 @@
}
if { $status == 1 } {
- if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
+ if { [lindex [::tcl::dict::get $opts -errorcode] 0] eq {CLOCK} } {
dict unset opts -errorinfo
}
return -options $opts $result
@@ -4526,13 +4563,13 @@
# 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]
+ dict set date secondOfDay [expr { [::tcl::dict::get $date localSeconds]
% 86400 }]
dict set date tzName $timezone
# Add the requisite number of months
- set m [dict get $date month]
+ set m [::tcl::dict::get $date month]
incr m $months
incr m -1
set delta [expr { $m / 12 }]
@@ -4547,7 +4584,7 @@
} else {
set hath [lindex $DaysInRomanMonthInCommonYear $mm]
}
- if { [dict get $date dayOfMonth] > $hath } {
+ if { [::tcl::dict::get $date dayOfMonth] > $hath } {
dict set date dayOfMonth $hath
}
@@ -4558,12 +4595,12 @@
$changeover]
dict set date localSeconds \
[expr { -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay] }]
+ + ( 86400 * wide([::tcl::dict::get $date julianDay]) )
+ + [::tcl::dict::get $date secondOfDay] }]
set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
$changeover]
- return [dict get $date seconds]
+ return [::tcl::dict::get $date seconds]
}
@@ -4597,7 +4634,7 @@
# Convert the time to Julian Day
set date [GetDateFields $clockval $TZData($timezone) $changeover]
- dict set date secondOfDay [expr { [dict get $date localSeconds]
+ dict set date secondOfDay [expr { [::tcl::dict::get $date localSeconds]
% 86400 }]
dict set date tzName $timezone
@@ -4609,12 +4646,12 @@
dict set date localSeconds \
[expr { -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay] }]
+ + ( 86400 * wide([::tcl::dict::get $date julianDay]) )
+ + [::tcl::dict::get $date secondOfDay] }]
set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
$changeover]
- return [dict get $date seconds]
+ return [::tcl::dict::get $date seconds]
}
@@ -4642,8 +4679,8 @@
proc ::tcl::clock::mc { name } {
variable McLoaded
set Locale [mclocale]
- if { [dict exists $McLoaded $Locale $name] } {
- return [dict get $McLoaded $Locale $name]
+ if { [::tcl::dict::exists $McLoaded $Locale $name] } {
+ return [::tcl::dict::get $McLoaded $Locale $name]
} else {
set val [::msgcat::mc $name]
dict set McLoaded $Locale $name $val
@@ -4671,6 +4708,7 @@
proc ::tcl::clock::ClearCaches {} {
variable FormatProc
+ variable ScanProc
variable LocaleNumeralCache
variable McLoaded
variable CachedSystemTimeZone
@@ -4684,6 +4722,7 @@
}
catch {unset FormatProc}
+ catch {unset ScanProc}
set LocaleNumeralCache {}
set McLoaded {}
catch {unset CachedSystemTimeZone}
@@ -4691,3 +4730,209 @@
InitTZData
}
+
+
+#----------------------------------------------------------------------
+# [SB] extension:
+# - validate :
+# - create date direct from args (without parsing string) :
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::ValidDate {date string} {
+ ## check date :
+ if {[::tcl::dict::exists $date month] && [::tcl::dict::exists $date dayOfMonth]} {
+ ## first - month :
+ if { [set month [::tcl::dict::get $date month]] > 12 || $month < 1 } {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid month"
+ }
+ ## by february check leap year :
+ if {[set day [::tcl::dict::get $date dayOfMonth]] < 1} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid day"
+ }
+ if {$day > 28} {
+ if {$month == 2} {
+ if {[::tcl::dict::exists $date gregorian]} {
+ if { [IsGregorianLeapYear $date] } {
+ variable DaysInRomanMonthInLeapYear
+ set hath [lindex $DaysInRomanMonthInLeapYear [expr {$month - 1}]]
+ } else {
+ variable DaysInRomanMonthInCommonYear
+ set hath [lindex $DaysInRomanMonthInCommonYear [expr {$month - 1}]]
+ }
+ }
+ } else {
+ variable DaysInRomanMonthInCommonYear
+ set hath [lindex $DaysInRomanMonthInCommonYear [expr {$month - 1}]]
+ }
+ ## check day in month :
+ if { $day > $hath } {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid day"
+ }
+ }
+ }
+ ## Oldscan could returns secondOfDay (parsedTime) -1 by invalid time (ex.: 25:00:00) :
+ if {[::tcl::dict::exists $date secondOfDay] && [::tcl::dict::get $date secondOfDay] == -1} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time"
+ }
+ ## check time (00:00:00 - 23:59:59 or 00:00:00[ap]m - 12:00:00[ap]m) :
+ if {[::tcl::dict::exists $date hour]} {
+ if {[set v [::tcl::dict::get $date hour]] < 0 || $v > 23} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time (hour)"
+ }
+ if {[::tcl::dict::exists $date amPmIndicator] && $v > 12} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time (hour/am:pm)"
+ }
+ }
+ if {[::tcl::dict::exists $date minute] && ([set v [::tcl::dict::get $date minute]] < 0 || $v > 59)} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time (minute)"
+ }
+ if {[::tcl::dict::exists $date second] && ([set v [::tcl::dict::get $date second]] < 0 || $v > 59)} {
+ return -code error -errorcode [list CLOCK invalidArgs] "unable to convert date-time string \"$string\": invalid time (second)"
+ }
+}
+
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::MakeDate {args} {
+ set date $args[set args {}]
+
+ if {![::tcl::dict::exists $date baseTime]} {
+ set baseTime [clock seconds]
+ } else {
+ set baseTime [::tcl::dict::get $date baseTime]
+ }
+
+ set changeover 2361222; #[tcl::clock::mc GREGORIAN_CHANGE_DATE]
+ set tz {}
+ if {[::tcl::dict::exists $date tzName]} {
+ set tz [::tcl::dict::get $date tzName]
+ if {$tz == {}} {
+ set tz [::tcl::clock::GetSystemTimeZone]
+ } elseif {$tz in {:UTC :GMT}} {
+ set tz {}
+ }
+ if {$tz != {}} {
+ variable TZData
+ if {![info exists TZData($tz)]} {
+ ::tcl::clock::SetupTimeZone $tz
+ }
+ }
+ }
+
+ dict set date era CE
+ # Julian Day Number from the fields.
+ if {![::tcl::dict::exists $date year]} {
+ if {![::tcl::dict::exists $date yearOfCentury]} {
+ set date [AssignBaseYear $date[set date {}] \
+ $baseTime $tz $changeover]
+ } else {
+ set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
+ }
+ }
+ if {![::tcl::dict::exists $date month]} {
+ set date [AssignBaseMonth $date[set date {}] \
+ $baseTime $tz $changeover]
+ }
+ if {![::tcl::dict::exists $date dayOfMonth]} {
+ variable TZData
+ set date2 [GetDateFields $baseTime $TZData($tz) $changeover]
+ dict set date dayOfMonth [::tcl::dict::get $date2 dayOfMonth]
+ }
+ if {[catch {
+ set date [::tcl::clock::GetJulianDayFromEraYearMonthDay $date[set date {}] $changeover]
+ } msg]} {
+ return -code error -errorcode [list CLOCK invalidArgs] $msg
+ }
+ # Get time of day
+ dict set date secondOfDay [::tcl::clock::InterpretHMS $date]
+ # Assemble seconds, and convert local nominal time to UTC.
+ if { [::tcl::dict::get $date julianDay] > 5373484 } {
+ return -code error -errorcode [list CLOCK dateTooLarge] "requested date too large to represent"
+ }
+ dict set date localSeconds [set secs [expr { -210866803200
+ + ( 86400 * wide([::tcl::dict::get $date julianDay]) )
+ + [::tcl::dict::get $date secondOfDay] }]]
+ if {$tz != {}} {
+ set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] $TZData($tz) $changeover]
+ return $date
+ }
+ # set seconds to localSeconds
+ dict set date seconds $secs
+ return $date
+}
+
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::ConvertToSeconds {Y m d H M S {tz {}}} {
+ set date [list \
+ year $Y \
+ month $m \
+ dayOfMonth $d \
+ hour $H \
+ minute $M \
+ second $S \
+ ]
+
+ set changeover 2361222; #[tcl::clock::mc GREGORIAN_CHANGE_DATE]
+ if {$tz == {}} {
+ set tz [GetSystemTimeZone]
+ } elseif {$tz ni {:UTC :GMT}} {
+ variable TZData
+ if {![info exists TZData($tz)]} {
+ SetupTimeZone $tz
+ }
+ } else {
+ ## don't convert in local :
+ set tz {}
+ }
+
+ dict set date era CE
+ # Julian Day Number from the fields.
+ if {[catch {
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] $changeover]
+ } msg]} {
+ return -code error -errorcode [list CLOCK invalidArgs] $msg
+ }
+ # Get time of day
+ dict set date secondOfDay [InterpretHMS $date]
+ # Assemble seconds, and convert local nominal time to UTC.
+ if { [::tcl::dict::get $date julianDay] > 5373484 } {
+ return -code error -errorcode [list CLOCK dateTooLarge] "requested date too large to represent"
+ }
+ set secs [expr { -210866803200
+ + ( 86400 * wide([::tcl::dict::get $date julianDay]) )
+ + [::tcl::dict::get $date secondOfDay] }]
+ if {$tz != {}} {
+ variable TZData
+ dict set date localSeconds $secs
+ set date [ConvertLocalToUTC $date[set date {}] $TZData($tz) $changeover]
+ # return utc :
+ return [::tcl::dict::get $date seconds]
+ }
+ # return localSeconds (already utc)
+ return $secs
+}
+
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::ConvertFromSeconds {clock {tz {}}} {
+ variable TZData
+
+ set changeover 2361222; #[tcl::clock::mc GREGORIAN_CHANGE_DATE]
+ if {$tz == {}} {
+ set tz [GetSystemTimeZone]
+ } elseif {$tz ni {:UTC :GMT}} {
+ if {![info exists TZData($tz)]} {
+ SetupTimeZone $tz
+ }
+ }
+ ## get date var :
+ set date [GetDateFields $clock $TZData($tz) $changeover]
+ set time [::tcl::dict::get $date localSeconds]
+ ## return list Y m d H M S
+ list \
+ [::tcl::dict::get $date year] [::tcl::dict::get $date month] [::tcl::dict::get $date dayOfMonth] \
+ [expr {$time / 3600 % 24}] [expr {$time / 60 % 60}] [expr {$time % 60}]
+}
+
+#----------------------------------------------------------------------
