diff options
Diffstat (limited to 'library/clock.tcl')
| -rw-r--r-- | library/clock.tcl | 162 |
1 files changed, 51 insertions, 111 deletions
diff --git a/library/clock.tcl b/library/clock.tcl index e5c831b..79ffc3e 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: clock.tcl,v 1.45 2007/12/13 15:26:03 dgp Exp $ +# RCS: @(#) $Id: clock.tcl,v 1.46 2008/02/06 01:13:07 kennykb Exp $ # #---------------------------------------------------------------------- @@ -644,6 +644,9 @@ proc ::tcl::clock::Initialize {} { # comprising start time, UTC offset, # Daylight Saving Time indicator, and # time zone abbreviation. + variable FormatProc; # Array mapping format group + # and locale to the name of a procedure + # that renders the given format } ::tcl::clock::Initialize @@ -661,74 +664,11 @@ proc ::tcl::clock::Initialize {} { proc ::tcl::clock::format { args } { + variable FormatProc variable TZData - set format {} - - # Check the count of args - - if { [llength $args] < 1 || [llength $args] % 2 != 1 } { - set cmdName "clock format" - return -code error \ - -errorcode [list CLOCK wrongNumArgs] \ - "wrong \# args: should be\ - \"$cmdName clockval\ - ?-format string? ?-gmt boolean?\ - ?-locale LOCALE? ?-timezone ZONE?\"" - } - - # Set defaults + lassign [ParseFormatArgs {*}$args] format locale timezone set clockval [lindex $args 0] - set format {%a %b %d %H:%M:%S %Z %Y} - set gmt 0 - set locale C - set timezone {} - - # Pick up command line options. - - foreach { flag value } [lreplace $args 0 0] { - set saw($flag) {} - switch -exact -- $flag { - -f - -fo - -for - -form - -forma - -format { - set format $value - } - -g - -gm - -gmt { - set gmt $value - } - -l - -lo - -loc - -loca - -local - -locale { - set locale $value - } - -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone { - set timezone $value - } - default { - return -code error \ - -errorcode [list CLOCK badSwitch $flag] \ - "bad switch \"$flag\",\ - must be -format, -gmt, -locale or -timezone" - } - } - } - - # Check options for validity - - if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } { - return -code error \ - -errorcode [list CLOCK gmtWithTimezone] \ - "cannot use -gmt and -timezone in same call" - } - if { ![string is wide -strict $clockval] } { - return -code error \ - "expected integer but got \"$clockval\"" - } - if { ![string is boolean -strict $gmt] } { - return -code error \ - "expected boolean value but got \"$gmt\"" - } else { - if { $gmt } { - set timezone :GMT - } - } # Get the data for time changes in the given zone @@ -742,10 +682,19 @@ proc ::tcl::clock::format { args } { } } - # Format the result + # 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 ::tcl::clock::formatproc'$format'$locale + if {[info exists FormatProc($procName)]} { + set procName $FormatProc($procName) + } else { + set FormatProc($procName) \ + [ParseClockFormatFormat $procName $format $locale] + } - set formatter [ParseClockFormatFormat $format $locale] - return [$formatter $clockval $timezone] + return [$procName $clockval $timezone] } @@ -764,10 +713,9 @@ proc ::tcl::clock::format { args } { # #---------------------------------------------------------------------- -proc ::tcl::clock::ParseClockFormatFormat {format locale} { +proc ::tcl::clock::ParseClockFormatFormat {procName format locale} { - set procName [namespace current]::formatproc'$format'$locale - if {[namespace which $procName] != {}} { + if {[namespace which $procName] ne {}} { return $procName } @@ -1422,15 +1370,15 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { return -code error "unable to convert date-time string \"$string\"" } - foreach { parseDate parseTime parseZone parseRel - parseWeekday parseOrdinalMonth } $result break + 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 } { - foreach { y m d } $parseDate break + lassign $parseDate y m d if { $y < 100 } { if { $y >= 39 } { incr y 1900 @@ -1454,7 +1402,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { # a time zone indicator of +-hhmm. if { [llength $parseZone] > 0 } { - foreach { minEast dstFlag } $parseZone break + lassign $parseZone minEast dstFlag set timezone [FormatNumericTimeZone \ [expr { 60 * $minEast + 3600 * $dstFlag }]] SetupTimeZone $timezone @@ -1485,7 +1433,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { # Do relative times if { [llength $parseRel] > 0 } { - foreach { relMonth relDay relSecond } $parseRel break + lassign $parseRel relMonth relDay relSecond set seconds [add $seconds \ $relMonth months $relDay days $relSecond seconds \ -timezone $timezone -locale $locale] @@ -1495,7 +1443,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { if { [llength $parseWeekday] > 0 } { - foreach {dayOrdinal dayOfWeek} $parseWeekday break + lassign $parseWeekday dayOrdinal dayOfWeek set date2 [GetDateFields $seconds $TZData($timezone) 2361222] dict set date2 era CE set jdwkday [WeekdayOnOrBefore $dayOfWeek \ @@ -1523,7 +1471,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { if { [llength $parseOrdinalMonth] > 0 } { - foreach {monthOrdinal monthNumber} $parseOrdinalMonth break + lassign $parseOrdinalMonth monthOrdinal monthNumber if { $monthOrdinal > 0 } { set monthDiff [expr { $monthNumber - [dict get $date month] }] if { $monthDiff <= 0 } { @@ -1647,7 +1595,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { dict set l [string tolower $full] $i incr i } - foreach { regex lookup } [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet dayOfWeek [incr fieldCount] append postcode "dict set date dayOfWeek \[" \ @@ -1665,7 +1613,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { dict set l [string tolower $abr] $i dict set l [string tolower $full] $i } - foreach { regex lookup } [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet month [incr fieldCount] append postcode "dict set date month \[" \ @@ -1764,7 +1712,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { p - P { # AM/PM indicator set l [list [string tolower [mc AM]] 0 \ [string tolower [mc PM]] 1] - foreach { regex lookup } [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet amPmIndicator [incr fieldCount] append postcode "dict set date amPmIndicator \[" \ @@ -1890,10 +1838,10 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { C { # Locale-dependent era set d {} foreach triple [mc LOCALE_ERAS] { - foreach {t symbol year} $triple break + lassign $triple t symbol year dict set d [string tolower $symbol] $year } - foreach { regex lookup } [UniquePrefixRegexp $d] break + lassign [UniquePrefixRegexp $d] regex lookup append re (?: $regex ) } E { @@ -1904,7 +1852,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { dict set l c.e. CE dict set l b.c. BCE dict set l a.d. CE - foreach {regex lookup} [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet era [incr fieldCount] append postcode "dict set date era \["\ @@ -1914,8 +1862,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } y { # Locale-dependent year of the era - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex incr captureCount } @@ -1932,8 +1879,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { %O { switch -exact -- $c { d - e { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet dayOfMonth [incr fieldCount] append postcode "dict set date dayOfMonth \[" \ @@ -1942,8 +1888,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } H - k { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet hour [incr fieldCount] append postcode "dict set date hour \[" \ @@ -1952,8 +1897,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } I - l { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet hourAMPM [incr fieldCount] append postcode "dict set date hourAMPM \[" \ @@ -1962,8 +1906,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } m { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet month [incr fieldCount] append postcode "dict set date month \[" \ @@ -1972,8 +1915,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } M { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet minute [incr fieldCount] append postcode "dict set date minute \[" \ @@ -1982,8 +1924,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } S { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet second [incr fieldCount] append postcode "dict set date second \[" \ @@ -1992,8 +1933,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } u - w { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet dayOfWeek [incr fieldCount] append postcode "set dow \[dict get " [list $lookup] \ @@ -2010,8 +1950,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { } } y { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet yearOfCentury [incr fieldCount] append postcode {dict set date yearOfCentury } \[ \ @@ -3364,13 +3303,12 @@ proc ::tcl::clock::GuessWindowsTimeZone {} { set tzname {} } if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } { - foreach { - bias stdBias dstBias - stdYear stdMonth stdDayOfWeek stdDayOfMonth - stdHour stdMinute stdSecond stdMillisec - dstYear dstMonth dstDayOfWeek dstDayOfMonth + lassign $data \ + bias stdBias dstBias \ + stdYear stdMonth stdDayOfWeek stdDayOfMonth \ + stdHour stdMinute stdSecond stdMillisec \ + dstYear dstMonth dstDayOfWeek dstDayOfMonth \ dstHour dstMinute dstSecond dstMillisec - } $data break set stdDelta [expr { $bias + $stdBias }] set dstDelta [expr { $bias + $dstBias }] if { $stdDelta <= 0 } { @@ -3647,7 +3585,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} { return -code error "$fileName has times out of order" } set lastTime $t - foreach { gmtoff isDst abbrInd } [lindex $types $c] break + lassign [lindex $types $c] gmtoff isDst abbrInd set abbrev [dict get $abbrevs $abbrInd] lappend r [list $t $gmtoff $isDst $abbrev] } @@ -3664,7 +3602,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} { if {[llength $posix] > 0} { set posixFields [ParsePosixTimeZone $posix] foreach tuple [ProcessPosixTimeZone $posixFields] { - foreach {t gmtoff isDst abbrev} $tuple break + lassign $tuple t gmtoff isDst abbrev if {$t > $lastTime} { lappend r $tuple } @@ -4692,6 +4630,7 @@ proc ::tcl::clock::mc { name } { proc ::tcl::clock::ClearCaches {} { + variable FormatProc variable LocaleNumeralCache variable McLoaded variable CachedSystemTimeZone @@ -4704,6 +4643,7 @@ proc ::tcl::clock::ClearCaches {} { rename $p {} } + catch {unset FormatProc} set LocaleNumeralCache {} set McLoaded {} catch {unset CachedSystemTimeZone} |