From 0e16d1cc7dd629f7bb9a3d1af174b072e9c8ae6c Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Thu, 21 Oct 2004 03:53:03 +0000 Subject: doubled speed of clock format --- ChangeLog | 7 + generic/tclBasic.c | 5 +- generic/tclClock.c | 49 +++++- generic/tclInt.h | 4 +- library/clock.tcl | 482 +++++++++++++++++++++++------------------------------ 5 files changed, 270 insertions(+), 277 deletions(-) diff --git a/ChangeLog b/ChangeLog index 806e611..6328979 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2004-10-21 Kevin B. Kenny + + * generic/tclBasic.c: Various changes to [clock format] that, + * generic/tclClock.c: together, make it roughly twice as fast + * generic/tclInt.h: while all tests in the test suite + * library/clock.tcl: continue to pass. + 2004-10-20 Andreas Kupries * win/Makefile.in (install-msgs): Fixed a problem with the diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c568e30..1a370bc 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -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: tclBasic.c,v 1.129 2004/10/19 21:54:06 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.130 2004/10/21 03:53:04 kennykb Exp $ */ #include "tclInt.h" @@ -382,6 +382,9 @@ Tcl_CreateInterp() Tcl_CreateObjCommand( interp, "::tcl::clock::clicks", TclClockClicksObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL ); + Tcl_CreateObjCommand( interp, "::tcl::clock::getenv", + TclClockGetenvObjCmd, (ClientData) NULL, + (Tcl_CmdDeleteProc*) NULL ); Tcl_CreateObjCommand( interp, "::tcl::clock::microseconds", TclClockMicrosecondsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL ); diff --git a/generic/tclClock.c b/generic/tclClock.c index e30760b..68b7142 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclClock.c,v 1.34 2004/09/27 14:31:17 kennykb Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.35 2004/10/21 03:53:04 kennykb Exp $ */ #include "tclInt.h" @@ -47,6 +47,53 @@ static struct tm* ThreadSafeLocalTime _ANSI_ARGS_(( CONST time_t* )); static void TzsetIfNecessary _ANSI_ARGS_(( void )); /* + *---------------------------------------------------------------------- + * + * TclClockGetenvObjCmd -- + * + * Tcl command that reads an environment variable from the system + * + * Usage: + * ::tcl::clock::getEnv NAME + * + * Parameters: + * NAME - Name of the environment variable desired + * + * Results: + * Returns a standard Tcl result. Returns an error if the + * variable does not exist, with a message left in the interpreter. + * Returns TCL_OK and the value of the variable if the variable + * does exist, + * + *---------------------------------------------------------------------- + */ + +int +TclClockGetenvObjCmd( ClientData clientData, + Tcl_Interp* interp, + int objc, + Tcl_Obj *CONST objv[] ) +{ + + CONST char* varName; + CONST char* varValue; + if ( objc != 2 ) { + Tcl_WrongNumArgs( interp, 1, objv, "name" ); + return TCL_ERROR; + } + varName = Tcl_GetStringFromObj( objv[1], NULL ); + varValue = getenv( varName ); + if ( varValue == NULL ) { + Tcl_SetObjResult( interp, + Tcl_NewStringObj( "variable not found", -1 ) ); + return TCL_ERROR; + } else { + Tcl_SetObjResult( interp, Tcl_NewStringObj( varValue, -1 ) ); + return TCL_OK; + } +} + +/* *------------------------------------------------------------------------- * * TclClockLocaltimeObjCmd -- diff --git a/generic/tclInt.h b/generic/tclInt.h index 260e8dc..f2dc36e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.183 2004/10/19 21:54:07 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.184 2004/10/21 03:53:04 kennykb Exp $ */ #ifndef _TCLINT @@ -1956,6 +1956,8 @@ EXTERN int Tcl_CdObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TclClockClicksObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +EXTERN int TclClockGetenvObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TclClockMicrosecondsObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TclClockMillisecondsObjCmd _ANSI_ARGS_((ClientData clientData, diff --git a/library/clock.tcl b/library/clock.tcl index dce89e6..95f7582 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.6 2004/09/27 14:31:20 kennykb Exp $ +# RCS: @(#) $Id: clock.tcl,v 1.7 2004/10/21 03:53:10 kennykb Exp $ # #---------------------------------------------------------------------- @@ -79,7 +79,6 @@ namespace eval ::tcl::clock { # Import the message catalog commands that we use. - namespace import ::msgcat::mc namespace import ::msgcat::mcload namespace import ::msgcat::mclocale @@ -267,17 +266,6 @@ namespace eval ::tcl::clock { } unset i j - # Julian day number of 0 January, 1 CE, in the proleptic Julian and - # Gregorian calendars. - - variable JD0Jan1CEJul 1721423 - variable JD0Jan1CEGreg 1721425 - variable JD31Dec9999 5373484 - - # Posix epoch, expressed as seconds from the Julian epoch - - variable PosixEpochAsJulianSeconds 210866803200 - # Another epoch (Hi, Jeff!) variable Roddenberry 1946 @@ -291,19 +279,6 @@ namespace eval ::tcl::clock { variable FEB_28 58 - # Conversion factors - - variable DaysPer400Yr 146097; # Days per 400 year Gregorian cycle - variable DaysPerCentury 36524; # Days per common Gregorian century - variable DaysPer4Yr 1461; # Days per 4 year cycle - variable DaysPerYear 365; # Days per common year - variable DaysPerWeek 7; - variable SecondsPerDay 86400; # Seconds per day - variable SecondsPerHour 3600; # Seconds per hour - variable SecondsPerMinute 60; # Seconds per minute - variable MinutesPerHour 60; # Minutes per hour - variable HoursPerDay 24; # Hours per day - # 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 @@ -606,11 +581,17 @@ namespace eval ::tcl::clock { # values. variable McLoaded {}; # Dictionary whose keys are locales # in which [mcload] has been executed - # and whose values are immaterial + # 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 # the environment. + variable TimeZoneBad {}; # Dictionary whose keys are time zone + # names and whose values are 1 if + # the time zone is unknown and 0 + # if it is known. variable TZData; # Array whose keys are time zone names # and whose values are lists of quads # comprising start time, UTC offset, @@ -632,14 +613,6 @@ namespace eval ::tcl::clock { proc ::tcl::clock::format { args } { - variable SecondsPerDay - variable SecondsPerHour - variable SecondsPerMinute - variable MinutesPerHour - variable HoursPerDay - variable DaysPerYear - variable DaysPerWeek - set format {} # Check the count of args @@ -715,7 +688,7 @@ proc ::tcl::clock::format { args } { # Map away the locale-dependent composite format groups - set format [LocalizeFormat $format] + set format [LocalizeFormat $locale $format] # Convert the given time to local time. @@ -749,14 +722,12 @@ proc ::tcl::clock::format { args } { append retval % } a { # Day of week, abbreviated - set dow [expr { [dict get $date dayOfWeek] - % $DaysPerWeek }] + set dow [expr { [dict get $date dayOfWeek] % 7 }] append retval \ [lindex [mc DAYS_OF_WEEK_ABBREV] $dow] } A { # Day of week, spelt out. - set dow [expr { [dict get $date dayOfWeek] - % $DaysPerWeek }] + set dow [expr { [dict get $date dayOfWeek] % 7 }] append retval [lindex [mc DAYS_OF_WEEK_FULL] $dow] } b - h { # Name of month, abbreviated. @@ -801,16 +772,16 @@ proc ::tcl::clock::format { args } { append retval \ [::format %02d \ [expr { [dict get $date localSeconds] - / $SecondsPerHour - % $HoursPerDay }]] + / 3600 + % 24 }]] } I { # Hour AM/PM, with leading zero set hour12 \ [expr { ( ( ( [dict get $date localSeconds] - % $SecondsPerDay ) - + $SecondsPerDay - - $SecondsPerHour ) - / $SecondsPerHour ) + % 86400 ) + + 86400 + - 3600 ) + / 3600 ) % 12 + 1 }] append retval [::format %02d $hour12] } @@ -826,16 +797,16 @@ proc ::tcl::clock::format { args } { append retval \ [::format %2d \ [expr { [dict get $date localSeconds] - / $SecondsPerHour - % $HoursPerDay }]] + / 3600 + % 24 }]] } l { # Hour (12-11), no leading zero set hour12 \ [expr { ( ( ( [dict get $date localSeconds] - % $SecondsPerDay ) - + $SecondsPerDay - - $SecondsPerHour ) - / $SecondsPerHour ) + % 86400 ) + + 86400 + - 3600 ) + / 3600 ) % 12 + 1 }] append retval [::format %2d $hour12] } @@ -847,8 +818,8 @@ proc ::tcl::clock::format { args } { append retval \ [::format %02d \ [expr { [dict get $date localSeconds] - / $SecondsPerMinute - % $MinutesPerHour }]] + / 60 + % 60 }]] } n { # A literal newline append retval \n @@ -864,8 +835,8 @@ proc ::tcl::clock::format { args } { p { # Localized 'AM' or 'PM' indicator # converted to uppercase set tod [expr { [dict get $date localSeconds] - % $SecondsPerDay }] - if { $tod >= ( $SecondsPerDay / 2 ) } { + % 86400 }] + if { $tod >= ( 86400 / 2 ) } { append retval [string toupper [mc PM]] } else { append retval [string toupper [mc AM]] @@ -873,8 +844,8 @@ proc ::tcl::clock::format { args } { } P { # Localized 'AM' or 'PM' indicator set tod [expr { [dict get $date localSeconds] - % $SecondsPerDay }] - if { $tod >= ( $SecondsPerDay / 2 ) } { + % 86400 }] + if { $tod >= ( 86400 / 2 ) } { append retval [mc PM] } else { append retval [mc AM] @@ -891,7 +862,7 @@ proc ::tcl::clock::format { args } { append retval \ [::format %02d \ [expr { [dict get $date localSeconds] - % $SecondsPerMinute }]] + % 60 }]] } t { # A literal tab character append retval \t @@ -903,15 +874,14 @@ proc ::tcl::clock::format { args } { # first Sunday of the year is the # first day of week 01 set dow [dict get $date dayOfWeek] - if { $dow == $DaysPerWeek } { + if { $dow == 7 } { set dow 0 } incr dow set weekNumber \ - [expr { ( [dict get $date dayOfYear] - - $dow - + $DaysPerWeek ) - / $DaysPerWeek }] + [expr { ( [dict get $date dayOfYear] + - $dow + 7 ) + / 7 }] append retval [::format %02d $weekNumber] } V { # The ISO8601 week number @@ -921,8 +891,7 @@ proc ::tcl::clock::format { args } { w { # Day of the week (0-Sunday, # 6-Saturday) append retval \ - [expr { [dict get $date dayOfWeek] - % $DaysPerWeek }] + [expr { [dict get $date dayOfWeek] % 7 }] } W { # Week of the year (00-53). The first # Monday of the year is the first day @@ -930,8 +899,8 @@ proc ::tcl::clock::format { args } { set weekNumber \ [expr { ( [dict get $date dayOfYear] - [dict get $date dayOfWeek] - + $DaysPerWeek ) - / $DaysPerWeek }] + + 7 ) + / 7 }] append retval [::format %02d $weekNumber] } y { # The two-digit year of the century @@ -990,18 +959,18 @@ proc ::tcl::clock::format { args } { H - k { # Hour of the day in alternative # numerals set hour [expr { [dict get $date localSeconds] - / $SecondsPerHour - % $HoursPerDay }] + / 3600 + % 24 }] append retval [lindex [mc LOCALE_NUMERALS] $hour] } I - l { # Hour (12-11) AM/PM in alternative # numerals set hour12 \ [expr { ( ( ( [dict get $date localSeconds] - % $SecondsPerDay ) - + $SecondsPerDay - - $SecondsPerHour ) - / $SecondsPerHour ) + % 86400 ) + + 86400 + - 3600 ) + / 3600 ) % 12 + 1 }] append retval [lindex [mc LOCALE_NUMERALS] $hour12] } @@ -1013,14 +982,14 @@ proc ::tcl::clock::format { args } { M { # Minute of the hour in alternative # numerals set minute [expr { [dict get $date localSeconds] - / $SecondsPerMinute - % $MinutesPerHour }] + / 60 + % 60 }] append retval [lindex [mc LOCALE_NUMERALS] $minute] } S { # Second of the minute in alternative # numerals set second [expr { [dict get $date localSeconds] - % $SecondsPerMinute }] + % 60 }] append retval [lindex [mc LOCALE_NUMERALS] $second] } u { # Day of the week (Monday=1,Sunday=7) @@ -1034,8 +1003,7 @@ proc ::tcl::clock::format { args } { append retval \ [lindex \ [mc LOCALE_NUMERALS] \ - [expr { [dict get $date dayOfWeek] - % $DaysPerWeek }]] + [expr { [dict get $date dayOfWeek] % 7 }]] } y { # Year of the century in alternative # numerals @@ -1204,7 +1172,7 @@ proc ::tcl::clock::scan { args } { # Map away the locale-dependent composite format groups - set format [LocalizeFormat $format] + set format [LocalizeFormat $locale $format] set scanner [ParseClockScanFormat $format] $scanner $string $base $timezone @@ -1250,10 +1218,6 @@ proc ::tcl::clock::scan { args } { proc ::tcl::clock::FreeScan { string base timezone locale } { - variable SecondsPerDay - variable DaysPerWeek - variable PosixEpochAsJulianSeconds - # Extract year, month and day from the base time for the # parser to use as defaults @@ -1264,7 +1228,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { [dict create seconds $base] \ $timezone]]]] dict set date secondOfDay [expr { [dict get $date localSeconds] - % $SecondsPerDay }] + % 86400 }] # Parse the date. The parser will return a list comprising # date, time, time zone, relative month/day/seconds, relative @@ -1325,9 +1289,8 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { dict set date secondOfDay $parseTime } dict set date localSeconds \ - [expr { -$::tcl::clock::PosixEpochAsJulianSeconds - + ( $::tcl::clock::SecondsPerDay - * wide([dict get $date julianDay]) ) + [expr { -210866803200 + + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] set date [ConvertLocalToUTC $date[set date {}]] set seconds [dict get $date seconds] @@ -1357,17 +1320,17 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { dict set date2 era CE set jdwkday [WeekdayOnOrBefore $dayOfWeek \ [expr { [dict get $date2 julianDay] - + $DaysPerWeek - 1}]] - incr jdwkday [expr { $DaysPerWeek * $dayOrdinal }] + + 6 }]] + incr jdwkday [expr { 7 * $dayOrdinal }] if { $dayOrdinal > 0 } { - incr jdwkday [expr {- $DaysPerWeek }] + incr jdwkday -7 } dict set date2 secondOfDay \ - [expr { [dict get $date2 localSeconds] % $SecondsPerDay }] + [expr { [dict get $date2 localSeconds] % 86400 }] dict set date2 julianDay $jdwkday dict set date2 localSeconds \ - [expr { -$PosixEpochAsJulianSeconds - + ( $SecondsPerDay * wide([dict get $date2 julianDay]) ) + [expr { -210866803200 + + ( 86400 * wide([dict get $date2 julianDay]) ) + [dict get $date secondOfDay] }] dict set date2 tzname $timezone set date2 [ConvertLocalToUTC $date2[set date2 {}]] @@ -1660,8 +1623,8 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } { { %d dow} \n \ { if { $dow == 0 } { - set dow $DaysPerWeek - } elseif { $dow > $DaysPerWeek } { + set dow 7 + } elseif { $dow > 7 } { return -code error \ -errorcode [list CLOCK badDayOfWeek] \ "day of week is greater than 7" @@ -1825,8 +1788,8 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } { { $field} [incr captureCount] \] \n \ { if { $dow == 0 } { - set dow $DaysPerWeek - } elseif { $dow > $DaysPerWeek } { + set dow 7 + } elseif { $dow > 7 } { return -code error \ -errorcode [list CLOCK badDayOfWeek] \ "day of week is greater than 7" @@ -1861,9 +1824,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } { # Build the procedure - set procBody { - variable ::tcl::clock::DaysPerWeek - } + set procBody {} append procBody "if \{ !\[ regexp -nocase [list $re] \$string ->" for { set i 1 } { $i <= $captureCount } { incr i } { append procBody " " field $i @@ -1891,14 +1852,13 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } { if { ![dict exists $fieldSet seconds] && ![dict exists $fieldSet starDate] } { append procBody { - if { [dict get $date julianDay] > $::tcl::clock::JD31Dec9999 } { + if { [dict get $date julianDay] > 5373484 } { return -code error -errorcode [list CLOCK dateTooLarge] \ "requested date too large to represent" } dict set date localSeconds \ - [expr { -$::tcl::clock::PosixEpochAsJulianSeconds - + ( $::tcl::clock::SecondsPerDay - * wide([dict get $date julianDay]) ) + [expr { -210866803200 + + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] } } @@ -2413,6 +2373,8 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } { # Map away locale-dependent format groups in a clock format. # # Parameters: +# locale -- Current [mclocale] locale, supplied to avoid +# an extra call # format -- Format supplied to [clock scan] or [clock format] # # Results: @@ -2424,7 +2386,14 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } { # #---------------------------------------------------------------------- -proc ::tcl::clock::LocalizeFormat { format } { +proc ::tcl::clock::LocalizeFormat { locale format } { + + variable McLoaded + + if { [dict exists $McLoaded $locale FORMAT $format] } { + return [dict get $McLoaded $locale FORMAT $format] + } + set inFormat $format # Handle locale-dependent format groups by mapping them out of # the input string. Note that the order of the [string map] @@ -2444,6 +2413,8 @@ proc ::tcl::clock::LocalizeFormat { format } { set format [string map [list %D %m/%d/%Y \ %EY [mc LOCALE_YEAR_FORMAT]\ %+ {%a %b %e %H:%M:%S %Z %Y}] $format] + + dict set McLoaded $locale FORMAT $format $inFormat return $format } @@ -2466,19 +2437,16 @@ proc ::tcl::clock::LocalizeFormat { format } { proc ::tcl::clock::FormatNumericTimeZone { z } { - variable SecondsPerHour - variable SecondsPerMinute - if { $z < 0 } { set z [expr { - $z }] set retval - } else { set retval + } - append retval [::format %02d [expr { $z / $SecondsPerHour }]] - set z [expr { $z % $SecondsPerHour }] - append retval [::format %02d [expr { $z / $SecondsPerMinute }]] - set z [expr { $z % $SecondsPerMinute }] + append retval [::format %02d [expr { $z / 3600 }]] + set z [expr { $z % 3600 }] + append retval [::format %02d [expr { $z / 60 }]] + set z [expr { $z % 60 }] if { $z != 0 } { append retval [::format %02d $z] } @@ -2510,8 +2478,6 @@ proc ::tcl::clock::FormatNumericTimeZone { z } { proc ::tcl::clock::FormatStarDate { date } { - variable DaysPerYear - variable SecondsPerDay variable Roddenberry # Get day of year, zero based @@ -2529,9 +2495,9 @@ proc ::tcl::clock::FormatStarDate { date } { # Convert day of year to a fractional year if { $lp } { - set fractYear [expr { 1000 * $doy / ( $DaysPerYear + 1 ) }] + set fractYear [expr { 1000 * $doy / 366 }] } else { - set fractYear [expr { 1000 * $doy / $DaysPerYear }] + set fractYear [expr { 1000 * $doy / 365 }] } # Put together the StarDate @@ -2539,8 +2505,8 @@ proc ::tcl::clock::FormatStarDate { date } { return [::format "Stardate %02d%03d.%1d" \ [expr { [dict get $date year] - $Roddenberry }] \ $fractYear \ - [expr { [dict get $date localSeconds] % $SecondsPerDay - / ( $SecondsPerDay / 10 ) }]] + [expr { [dict get $date localSeconds] % 86400 + / ( 86400 / 10 ) }]] } #---------------------------------------------------------------------- @@ -2568,16 +2534,13 @@ proc ::tcl::clock::FormatStarDate { date } { proc ::tcl::clock::ParseStarDate { year fractYear fractDay } { variable Roddenberry - variable DaysPerYear - variable SecondsPerDay - variable PosixEpochAsJulianSeconds # Build a tentative date from year and fraction. set date [dict create \ era CE \ year [expr { $year + $Roddenberry }] \ - dayOfYear [expr { $fractYear * $DaysPerYear / 1000 + 1 }]] + dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]] set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]] # Determine whether the given year is a leap year @@ -2593,18 +2556,18 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } { if { $lp } { dict set date dayOfYear \ - [expr { $fractYear * ( $DaysPerYear + 1 ) / 1000 + 1 }] + [expr { $fractYear * 366 / 1000 + 1 }] } else { dict set date dayOfYear \ - [expr { $fractYear * $DaysPerYear / 1000 + 1 }] + [expr { $fractYear * 365 / 1000 + 1 }] } dict unset date julianDay dict unset date gregorian set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]] - return [expr { $SecondsPerDay * [dict get $date julianDay] - - $PosixEpochAsJulianSeconds - + ( $SecondsPerDay / 10 ) * $fractDay }] + return [expr { 86400 * [dict get $date julianDay] + - 210866803200 + + ( 86400 / 10 ) * $fractDay }] } @@ -2701,9 +2664,6 @@ proc ::tcl::clock::InterpretTwoDigitYear { date baseTime proc ::tcl::clock::AssignBaseYear { date baseTime timeZone } { - variable PosixEpochAsJulianSeconds - variable SecondsPerDay - # Find the Julian Day Number corresponding to the base time, and # find the Gregorian year corresponding to that Julian Day. @@ -2742,8 +2702,6 @@ proc ::tcl::clock::AssignBaseYear { date baseTime timeZone } { #---------------------------------------------------------------------- proc ::tcl::clock::AssignBaseIso8601Year { date baseTime timeZone } { - variable PosixEpochAsJulianSeconds - variable SecondsPerDay # Find the Julian Day Number corresponding to the base time @@ -2781,9 +2739,6 @@ proc ::tcl::clock::AssignBaseIso8601Year { date baseTime timeZone } { proc ::tcl::clock::AssignBaseMonth { date baseTime timeZone } { - variable PosixEpochAsJulianSeconds - variable SecondsPerDay - # Find the Julian Day Number corresponding to the base time set date2 [dict create seconds $baseTime] @@ -2822,8 +2777,6 @@ proc ::tcl::clock::AssignBaseMonth { date baseTime timeZone } { #---------------------------------------------------------------------- proc ::tcl::clock::AssignBaseWeek { date baseTime timeZone } { - variable PosixEpochAsJulianSeconds - variable SecondsPerDay # Find the Julian Day Number corresponding to the base time @@ -2861,9 +2814,6 @@ proc ::tcl::clock::AssignBaseWeek { date baseTime timeZone } { proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone } { - variable PosixEpochAsJulianSeconds - variable SecondsPerDay - # Find the Julian Day Number corresponding to the base time set date2 [dict create seconds $baseTime] @@ -2927,11 +2877,8 @@ proc ::tcl::clock::InterpretHMSP { date } { proc ::tcl::clock::InterpretHMS { date } { - variable SecondsPerMinute - variable MinutesPerHour - - return [expr { ( [dict get $date hour] * $MinutesPerHour - + [dict get $date minute] ) * $SecondsPerMinute + return [expr { ( [dict get $date hour] * 60 + + [dict get $date minute] ) * 60 + [dict get $date second] }] } @@ -2958,25 +2905,32 @@ proc ::tcl::clock::InterpretHMS { date } { proc ::tcl::clock::GetSystemTimeZone {} { variable CachedSystemTimeZone + variable TimeZoneBad - if { [info exists ::env(TCL_TZ)] } { - set timezone $::env(TCL_TZ) - } elseif { [info exists ::env(TZ)] } { - set timezone $::env(TZ) - } elseif { $::tcl_platform(platform) eq {windows} } { + if { ![catch {getenv TCL_TZ} result] } { + set timezone $result + } elseif { ![catch {getenv TZ} result] } { + set timezone $result + } else { if { [info exists CachedSystemTimeZone] } { set timezone $CachedSystemTimeZone } else { - set timezone [GuessWindowsTimeZone] + if { $::tcl_platform(platform) eq {windows} } { + set timezone [GuessWindowsTimeZone] + } else { + set timezone :localtime + } set CachedSystemTimeZone $timezone } - } else { - set timezone :localtime } - if { [catch {SetupTimeZone $timezone}] } { - set timezone :localtime + if { ![dict exists $TimeZoneBad $timezone] } { + dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}] + } + if { [dict get $TimeZoneBad $timezone] } { + return ::localtime + } else { + return $timezone } - return $timezone } @@ -3112,11 +3066,6 @@ proc ::tcl::clock::ConvertLocalToUTC { date } { proc ::tcl::clock::ConvertLocalToUTCViaC { localSeconds } { - variable SecondsPerHour - variable SecondsPerMinute - variable MinutesPerHour - variable HoursPerDay - set date [dict create localSeconds $localSeconds] set date [GetJulianDay $date[set date {}]] set date [GetGregorianEraYearDay $date[set date {}]] @@ -3126,9 +3075,9 @@ proc ::tcl::clock::ConvertLocalToUTCViaC { localSeconds } { [dict get $date year] \ [dict get $date month] \ [dict get $date dayOfMonth] \ - [expr { $localSeconds / $SecondsPerHour % $HoursPerDay }] \ - [expr { $localSeconds / $SecondsPerMinute % $MinutesPerHour }] \ - [expr { $localSeconds % $SecondsPerMinute }]] + [expr { $localSeconds / 3600 % 24 }] \ + [expr { $localSeconds / 60 % 60 }] \ + [expr { $localSeconds % 60 }]] return $retval } @@ -3205,12 +3154,6 @@ proc ::tcl::clock::ConvertUTCToLocal { date timezone } { proc ::tcl::clock::ConvertUTCToLocalViaC { date } { - variable PosixEpochAsJulianSeconds - variable SecondsPerMinute - variable SecondsPerHour - variable MinutesPerHour - variable HoursPerDay - # Get y-m-d-h-m-s from the C library set gmtSeconds [dict get $date seconds] @@ -3230,13 +3173,13 @@ proc ::tcl::clock::ConvertUTCToLocalViaC { date } { # Reconvert to seconds from the epoch in local time. set localSeconds [expr { ( ( ( wide([dict get $date2 julianDay]) - * $HoursPerDay + * 24 + wide([dict get $date2 hour]) ) - * $MinutesPerHour + * 60 + wide([dict get $date2 minute]) ) - * $SecondsPerMinute + * 60 + wide([dict get $date2 second]) ) - - $PosixEpochAsJulianSeconds }] + - 210866803200 }] # Determine the name and offset of the timezone @@ -3248,10 +3191,10 @@ proc ::tcl::clock::ConvertUTCToLocalViaC { date } { set signum + set delta $diff } - set hh [::format %02d [expr { $delta / $SecondsPerHour }]] - set mm [::format %02d [expr { ($delta / $SecondsPerMinute ) - % $MinutesPerHour }]] - set ss [::format %02d [expr { $delta % $SecondsPerMinute }]] + set hh [::format %02d [expr { $delta / 3600 }]] + set mm [::format %02d [expr { ($delta / 60 ) + % 60 }]] + set ss [::format %02d [expr { $delta % 60 }]] set zoneName $signum$hh$mm if { $ss ne {00} } { @@ -3287,11 +3230,9 @@ proc ::tcl::clock::ConvertUTCToLocalViaC { date } { proc ::tcl::clock::SetupTimeZone { timezone } { variable TZData - variable MinutesPerHour - variable SecondsPerMinute - variable MINWIDE if {! [info exists TZData($timezone)] } { + variable MINWIDE if { $timezone eq {:localtime} } { # Nothing to do, we'll convert using the localtime function @@ -3308,8 +3249,8 @@ proc ::tcl::clock::SetupTimeZone { timezone } { } else { ::scan $ss %d ss } - set offset [expr { ( $hh * $MinutesPerHour - + $mm ) * $SecondsPerMinute + set offset [expr { ( $hh * 60 + + $mm ) * 60 + $ss }] if { $s eq {-} } { set offset [expr { - $offset }] @@ -3394,9 +3335,6 @@ proc ::tcl::clock::SetupTimeZone { timezone } { proc ::tcl::clock::GuessWindowsTimeZone {} { variable WinZoneInfo - variable SecondsPerHour - variable SecondsPerMinute - variable MinutesPerHour variable NoRegistry if { [info exists NoRegistry] } { @@ -3408,11 +3346,11 @@ proc ::tcl::clock::GuessWindowsTimeZone {} { if { [catch { set rpath HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation set data [list \ - [expr { -$SecondsPerMinute + [expr { -60 * [registry get $rpath Bias] }] \ - [expr { -$SecondsPerMinute \ + [expr { -60 * [registry get $rpath StandardBias] }] \ - [expr { -$SecondsPerMinute \ + [expr { -60 \ * [registry get $rpath DaylightBias] }]] set stdtzi [registry get $rpath StandardStart] foreach ind {0 2 14 4 6 8 10 12} { @@ -3449,10 +3387,9 @@ proc ::tcl::clock::GuessWindowsTimeZone {} { } else { set stdSignum - } - set hh [::format %02d [expr { $stdDelta / $SecondsPerHour }]] - set mm [::format %02d [expr { ($stdDelta / $SecondsPerMinute ) - % $MinutesPerHour }]] - set ss [::format %02d [expr { $stdDelta % $SecondsPerMinute }]] + set hh [::format %02d [expr { $stdDelta / 3600 }]] + set mm [::format %02d [expr { ($stdDelta / 60 ) % 60 }]] + set ss [::format %02d [expr { $stdDelta % 60 }]] append tzname < $stdSignum $hh $mm > $stdSignum $hh : $mm : $ss if { $stdMonth >= 0 } { if { $dstDelta <= 0 } { @@ -3461,10 +3398,9 @@ proc ::tcl::clock::GuessWindowsTimeZone {} { } else { set dstSignum - } - set hh [::format %02d [expr { $dstDelta / $SecondsPerHour }]] - set mm [::format %02d [expr { ($dstDelta / $SecondsPerMinute ) - % $MinutesPerHour }]] - set ss [::format %02d [expr { $dstDelta % $SecondsPerMinute }]] + set hh [::format %02d [expr { $dstDelta / 3600 }]] + set mm [::format %02d [expr { ($dstDelta / 60 ) % 60 }]] + set ss [::format %02d [expr { $dstDelta % 60 }]] append tzname < $dstSignum $hh $mm > $dstSignum $hh : $mm : $ss if { $dstYear == 0 } { append tzname ,M $dstMonth . $dstDayOfMonth . $dstDayOfWeek @@ -3875,8 +3811,6 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } { proc ::tcl::clock::ProcessPosixTimeZone { z } { variable MINWIDE - variable SecondsPerMinute - variable MinutesPerHour variable TZData # Determine the standard time zone name and seconds east of Greenwich @@ -3901,8 +3835,8 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } { } else { set stdSeconds 0 } - set stdOffset [expr { ( ( $stdHours * $MinutesPerHour + $stdMinutes ) - * $SecondsPerMinute + $stdSeconds ) + set stdOffset [expr { ( ( $stdHours * 60 + $stdMinutes ) + * 60 + $stdSeconds ) * $stdSignum }] set data [list [list $MINWIDE $stdOffset 0 $stdName]] @@ -3937,8 +3871,8 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } { } else { set dstSeconds 0 } - set dstOffset [expr { ( ( $dstHours * $MinutesPerHour + $dstMinutes ) - * $SecondsPerMinute + $dstSeconds ) + set dstOffset [expr { ( ( $dstHours * 60 + $dstMinutes ) + * 60 + $dstSeconds ) * $dstSignum }] } @@ -4008,10 +3942,6 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } { proc ::tcl::clock::DeterminePosixDSTTime { z bound y } { variable FEB_28 - variable PosixEpochAsJulianSeconds - variable SecondsPerDay - variable SecondsPerMinute - variable MinutesPerHour # Determine the start or end day of DST @@ -4044,8 +3974,8 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } { } set jd [dict get $date julianDay] - set seconds [expr { wide($jd) * wide($SecondsPerDay) - - wide($PosixEpochAsJulianSeconds) }] + set seconds [expr { wide($jd) * wide(86400) + - wide(210866803200) }] set h [dict get $z ${bound}Hours] if { $h eq {} } { @@ -4065,7 +3995,7 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } { } else { set s [lindex [::scan $s %d] 0] } - set tod [expr { ( $h * $MinutesPerHour + $m ) * $SecondsPerMinute + $s }] + set tod [expr { ( $h * 60 + $m ) * 60 + $s }] return [expr { $seconds + $tod }] } @@ -4127,14 +4057,11 @@ proc ::tcl::clock::GetLocaleEra { date } { proc ::tcl::clock::GetJulianDay { date } { - variable PosixEpochAsJulianSeconds - variable SecondsPerDay - set secs [dict get $date localSeconds] return [dict set date julianDay \ - [expr { ( $secs + $PosixEpochAsJulianSeconds ) - / $SecondsPerDay }]] + [expr { ( $secs + 210866803200 ) + / 86400 }]] } @@ -4160,13 +4087,6 @@ proc ::tcl::clock::GetJulianDay { date } { proc ::tcl::clock::GetGregorianEraYearDay { date } { - variable JD0Jan1CEGreg - variable JD0Jan1CEJul - variable DaysPer400Yr - variable DaysPerCentury - variable DaysPer4Yr - variable DaysPerYear - set jday [dict get $date julianDay] set changeover [mc GREGORIAN_CHANGE_DATE] @@ -4179,22 +4099,22 @@ proc ::tcl::clock::GetGregorianEraYearDay { date } { # Calculate number of days since 1 January, 1 CE - set day [expr { $jday - $JD0Jan1CEGreg - 1 }] + set day [expr { $jday - 1721425 - 1 }] # Calculate number of 400 year cycles set year 1 - set n [expr { $day / $DaysPer400Yr }] + set n [expr { $day / 146097 }] incr year [expr { 400 * $n }] - set day [expr { $day % $DaysPer400Yr }] + set day [expr { $day % 146097 }] # Calculate number of centuries in the current cycle - set n [expr { $day / $DaysPerCentury }] - set day [expr { $day % $DaysPerCentury }] + set n [expr { $day / 36524 }] + set day [expr { $day % 36524 }] if { $n > 3 } { - set n 3 ;# 31 December 2000, for instance - incr day $DaysPerCentury ;# is last day of 400 year cycle + set n 3 ; # 31 December 2000, for instance + incr day 36524 ; # is last day of 400 year cycle } incr year [expr { 100 * $n }] @@ -4206,7 +4126,7 @@ proc ::tcl::clock::GetGregorianEraYearDay { date } { # Calculate days since 0 January, 1 CE Julian - set day [expr { $jday - $JD0Jan1CEJul - 1 }] + set day [expr { $jday - 1721423 - 1 }] set year 1 } @@ -4214,17 +4134,17 @@ proc ::tcl::clock::GetGregorianEraYearDay { date } { # Calculate number of 4-year cycles in current century (or in # the Common Era, if the calendar is Julian) - set n [expr { $day / $DaysPer4Yr }] - set day [expr { $day % $DaysPer4Yr }] + set n [expr { $day / 1461 }] + set day [expr { $day % 1461 }] incr year [expr { 4 * $n }] # Calculate number of years in current 4-year cycle - set n [expr { $day / $DaysPerYear }] - set day [expr { $day % $DaysPerYear }] + set n [expr { $day / 365 }] + set day [expr { $day % 365 }] if { $n > 3 } { set n 3 ;# 31 December in a leap year - incr day $DaysPerYear + incr day 365 } incr year $n @@ -4327,8 +4247,6 @@ proc ::tcl::clock::GetMonthDay { date } { proc ::tcl::clock::GetYearWeekDay { date { keys { iso8601Year iso8601Week dayOfWeek } } } { - variable DaysPerWeek - set daysInFirstWeek 4 set firstDayOfWeek 1 @@ -4383,10 +4301,10 @@ proc ::tcl::clock::GetYearWeekDay { date set fiscalYear [dict get $date1 fiscalYear] set dayOfFiscalYear [expr { $j - $startOfFiscalYear }] - set weekOfFiscalYear [expr { ( $dayOfFiscalYear / $DaysPerWeek ) + 1 }] - set dayOfWeek [expr { ( $dayOfFiscalYear + 1 ) % $DaysPerWeek }] + set weekOfFiscalYear [expr { ( $dayOfFiscalYear / 7 ) + 1 }] + set dayOfWeek [expr { ( $dayOfFiscalYear + 1 ) % 7 }] if { $dayOfWeek < $firstDayOfWeek } { - incr dayOfWeek $DaysPerWeek + incr dayOfWeek 7 } # Store the fiscal year, week, and day in the given slots in the @@ -4433,8 +4351,6 @@ proc ::tcl::clock::GetJulianDayFromEraYearWeekDay { { keys { iso8601Year iso8601Week dayOfWeek } } } { - variable DaysPerWeek - foreach var { fiscalYear fiscalWeek dayOfWeek } key $keys { set $var [dict get $date $key] } @@ -4456,7 +4372,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearWeekDay { dict set date julianDay \ [expr { $jd - + ( $DaysPerWeek * ( $fiscalWeek - 1 ) ) + + ( 7 * ( $fiscalWeek - 1 ) ) + $dayOfWeek - $firstDayOfWeek }] return $date @@ -4489,8 +4405,6 @@ proc ::tcl::clock::GetJulianDayFromEraYearWeekDay { proc ::tcl::clock::GetJulianDayFromEraYearMonthDay { date } { - variable JD0Jan1CEJul - variable JD0Jan1CEGreg variable DaysInPriorMonthsInCommonYear variable DaysInPriorMonthsInLeapYear @@ -4509,7 +4423,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthDay { date } { # Try the Gregorian calendar first. dict set date gregorian 1 - set jd [expr { $JD0Jan1CEGreg + set jd [expr { 1721425 + [dict get $date dayOfMonth] + ( [IsGregorianLeapYear $date] ? [lindex $DaysInPriorMonthsInLeapYear \ @@ -4526,7 +4440,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthDay { date } { if { $jd < [mc GREGORIAN_CHANGE_DATE] } { dict set date gregorian 0 - set jd [expr { $JD0Jan1CEJul + set jd [expr { 1721423 + [dict get $date dayOfMonth] + ( ( $year % 4 == 0 ) ? [lindex $DaysInPriorMonthsInLeapYear \ @@ -4568,8 +4482,6 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthDay { date } { proc ::tcl::clock::GetJulianDayFromEraYearDay { date } { - variable JD0Jan1CEJul - variable JD0Jan1CEGreg variable DaysInPriorMonthsInCommonYear variable DaysInPriorMonthsInLeapYear @@ -4588,7 +4500,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay { date } { # Try the Gregorian calendar first. dict set date gregorian 1 - set jd [expr { $JD0Jan1CEGreg + set jd [expr { 1721425 + [dict get $date dayOfYear] + ( 365 * $ym1 ) + ( $ym1 / 4 ) @@ -4599,7 +4511,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay { date } { if { $jd < [mc GREGORIAN_CHANGE_DATE] } { dict set date gregorian 0 - set jd [expr { $JD0Jan1CEJul + set jd [expr { 1721423 + [dict get $date dayOfYear] + ( 365 * $ym1 ) + ( $ym1 / 4 ) }] @@ -4630,8 +4542,6 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay { date } { proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay { date } { - variable DaysPerWeek - # 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) @@ -4642,12 +4552,12 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay { date } { dict set date2 dayOfMonth 0 } else { dict incr date2 month - dict set date2 dayOfMonth $DaysPerWeek + dict set date2 dayOfMonth 7 } set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}]] set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \ [dict get $date2 julianDay]] - dict set date julianDay [expr { $wd0 + $DaysPerWeek * $week }] + dict set date julianDay [expr { $wd0 + 7 * $week }] return $date } @@ -4716,10 +4626,8 @@ proc ::tcl::clock::IsGregorianLeapYear { date } { proc ::tcl::clock::WeekdayOnOrBefore { weekday j } { - variable DaysPerWeek - - set k [expr { ( $weekday + 6 ) % $DaysPerWeek }] - return [expr { $j - ( $j - $k ) % $DaysPerWeek }] + set k [expr { ( $weekday + 6 ) % 7 }] + return [expr { $j - ( $j - $k ) % 7 }] } @@ -4813,8 +4721,6 @@ proc ::tcl::clock::BSearch { list key } { proc ::tcl::clock::add { clockval args } { - variable DaysPerWeek - if { [llength $args] % 2 != 0 } { return -code error \ -errorcode [list CLOCK wrongNumArgs] \ @@ -4899,7 +4805,7 @@ proc ::tcl::clock::add { clockval args } { } weeks - week { - set clockval [AddDays [expr { $DaysPerWeek * $quantity }] \ + set clockval [AddDays [expr { 7 * $quantity }] \ $clockval $timezone] } days - day { @@ -4970,8 +4876,6 @@ proc ::tcl::clock::AddMonths { months clockval timezone } { variable DaysInRomanMonthInCommonYear variable DaysInRomanMonthInLeapYear - variable PosixEpochAsJulianSeconds - variable SecondsPerDay # Convert the time to year, month, day, and fraction of day. @@ -4982,7 +4886,7 @@ proc ::tcl::clock::AddMonths { months clockval timezone } { [dict create seconds $clockval] \ $timezone]]]] dict set date secondOfDay [expr { [dict get $date localSeconds] - % $SecondsPerDay }] + % 86400 }] dict set date tzName $timezone # Add the requisite number of months @@ -5011,8 +4915,8 @@ proc ::tcl::clock::AddMonths { months clockval timezone } { set date [GetJulianDayFromEraYearMonthDay \ $date[set date {}]] dict set date localSeconds \ - [expr { -$PosixEpochAsJulianSeconds - + ( $SecondsPerDay * wide([dict get $date julianDay]) ) + [expr { -210866803200 + + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] set date [ConvertLocalToUTC $date[set date {}]] @@ -5043,9 +4947,6 @@ proc ::tcl::clock::AddMonths { months clockval timezone } { proc ::tcl::clock::AddDays { days clockval timezone } { - variable PosixEpochAsJulianSeconds - variable SecondsPerDay - # Convert the time to Julian Day set date [GetJulianDay \ @@ -5053,7 +4954,7 @@ proc ::tcl::clock::AddDays { days clockval timezone } { [dict create seconds $clockval] \ $timezone]] dict set date secondOfDay [expr { [dict get $date localSeconds] - % $SecondsPerDay }] + % 86400 }] dict set date tzName $timezone # Add the requisite number of days @@ -5063,8 +4964,8 @@ proc ::tcl::clock::AddDays { days clockval timezone } { # Reconvert to a number of seconds dict set date localSeconds \ - [expr { -$PosixEpochAsJulianSeconds - + ( $SecondsPerDay * wide([dict get $date julianDay]) ) + [expr { -210866803200 + + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] set date [ConvertLocalToUTC $date[set date {}]] @@ -5074,6 +4975,39 @@ proc ::tcl::clock::AddDays { days clockval timezone } { #---------------------------------------------------------------------- # +# mc -- +# +# Wrapper around ::msgcat::mc that caches the result according +# to the locale. +# +# Parameters: +# Accepts the name of the message to retrieve. +# +# Results: +# Returns the message text. +# +# Side effects: +# Caches the message text. +# +# Notes: +# Only the single-argument version of [mc] is supported. +# +#---------------------------------------------------------------------- + +proc ::tcl::clock::mc { name } { + variable McLoaded + set Locale [mclocale] + if { [dict exists $McLoaded $Locale $name] } { + return [dict get $McLoaded $Locale $name] + } else { + set val [::msgcat::mc $name] + dict set McLoaded $Locale $name $val + return $val + } +} + +#---------------------------------------------------------------------- +# # ClearCaches -- # # Clears all caches to reclaim the memory used in [clock] -- cgit v0.12