diff options
| -rw-r--r-- | ChangeLog | 3 | ||||
| -rw-r--r-- | generic/tclClock.c | 194 | ||||
| -rw-r--r-- | library/clock.tcl | 202 |
3 files changed, 221 insertions, 178 deletions
@@ -26,6 +26,9 @@ JULIAN_SEC_POSIX_EPOCH. Also fixed a bug where [clock format] would fail in the :localtime zone for times before the Posix Epoch. Thanks to Miguel Sofer for pointing out all of these. + Also rationalized the code a little bit by moving parts of + [clock scan] into C, eliminating some code that was duplicated + in the C and Tcl layers. 2005-11-29 Kevin Kenny <kennykb@acm.org> diff --git a/generic/tclClock.c b/generic/tclClock.c index 340a06c..a29de78 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.46 2005/11/30 15:39:37 kennykb Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.47 2005/11/30 19:34:13 kennykb Exp $ */ #include "tclInt.h" @@ -112,6 +112,7 @@ typedef struct TclDateFields { int dayOfWeek; /* Day of the week */ } TclDateFields; +static CONST char* eras[] = { "CE", "BCE", NULL }; /* * Thread specific data block holding a 'struct tm' for the 'gmtime' and @@ -161,6 +162,12 @@ static int ClockConvertlocaltoutcObjCmd( static int ClockGetdatefieldsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int ClockGetjuliandayfromerayearmonthdayObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int ClockGetjuliandayfromerayearweekdayObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); static int ClockGetenvObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -240,6 +247,16 @@ TclClockInit( ClockGetdatefieldsObjCmd,(ClientData) data, ClockDeleteCmdProc); ++data->refCount; + Tcl_CreateObjCommand(interp, + "::tcl::clock::GetJulianDayFromEraYearMonthDay", + ClockGetjuliandayfromerayearmonthdayObjCmd,(ClientData) data, + ClockDeleteCmdProc); + ++data->refCount; + Tcl_CreateObjCommand(interp, + "::tcl::clock::GetJulianDayFromEraYearWeekDay", + ClockGetjuliandayfromerayearweekdayObjCmd,(ClientData) data, + ClockDeleteCmdProc); + ++data->refCount; } @@ -432,6 +449,170 @@ ClockGetdatefieldsObjCmd( /* *---------------------------------------------------------------------- * + * ClockGetjuliandayfromerayearmonthdayObjCmd -- + * + * Tcl command that converts a time from era-year-month-day to + * a Julian Day Number. + * + * Parameters: + * dict - Dictionary that contains 'era', 'year', 'month' and + * 'dayOfMonth' keys. + * changeover - Julian Day of changeover to the Gregorian calendar + * + * Results: + * Result is either TCL_OK, with the interpreter result being the + * dictionary augmented with a 'julianDay' key, or TCL_ERROR, + * with the result being an error message. + * + *---------------------------------------------------------------------- + */ + +static int +ClockGetjuliandayfromerayearmonthdayObjCmd ( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *CONST *objv /* Parameter vector */ +) { + TclDateFields fields; + Tcl_Obj* dict; + ClockClientData* data = (ClockClientData*) clientData; + Tcl_Obj* CONST * literals = data->literals; + Tcl_Obj* fieldPtr; + int changeover; + int copied = 0; + int status; + + /* Check params */ + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); + return TCL_ERROR; + } + dict = objv[1]; + if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK + || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, + &(fields.era)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.dayOfMonth)) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { + return TCL_ERROR; + } + + /* Get Julian day */ + + GetJulianDayFromEraYearMonthDay(&fields, changeover); + + /* Store Julian day in the dictionary - copy on write */ + + if (Tcl_IsShared(dict)) { + dict = Tcl_DuplicateObj(dict); + Tcl_IncrRefCount(dict); + copied = 1; + } + status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY], + Tcl_NewIntObj(fields.julianDay)); + if (status == TCL_OK) { + Tcl_SetObjResult(interp, dict); + } + if (copied) { + Tcl_DecrRefCount(dict); + } + return status; +} + +/* + *---------------------------------------------------------------------- + * + * ClockGetjuliandayfromerayearweekdayObjCmd -- + * + * Tcl command that converts a time from the ISO calendar to + * a Julian Day Number. + * + * Parameters: + * dict - Dictionary that contains 'era', 'iso8601Year', 'iso8601Week' + * and 'dayOfWeek' keys. + * changeover - Julian Day of changeover to the Gregorian calendar + * + * Results: + * Result is either TCL_OK, with the interpreter result being the + * dictionary augmented with a 'julianDay' key, or TCL_ERROR, + * with the result being an error message. + * + *---------------------------------------------------------------------- + */ + +static int +ClockGetjuliandayfromerayearweekdayObjCmd ( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *CONST *objv /* Parameter vector */ +) { + TclDateFields fields; + Tcl_Obj* dict; + ClockClientData* data = (ClockClientData*) clientData; + Tcl_Obj* CONST * literals = data->literals; + Tcl_Obj* fieldPtr; + int changeover; + int copied = 0; + int status; + + /* Check params */ + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); + return TCL_ERROR; + } + dict = objv[1]; + if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK + || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, + &(fields.era)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { + return TCL_ERROR; + } + + /* Get Julian day */ + + GetJulianDayFromEraYearWeekDay(&fields, changeover); + + /* Store Julian day in the dictionary - copy on write */ + + if (Tcl_IsShared(dict)) { + dict = Tcl_DuplicateObj(dict); + Tcl_IncrRefCount(dict); + copied = 1; + } + status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY], + Tcl_NewIntObj(fields.julianDay)); + if (status == TCL_OK) { + Tcl_SetObjResult(interp, dict); + } + if (copied) { + Tcl_DecrRefCount(dict); + } + return status; +} + +/* + *---------------------------------------------------------------------- + * * ConvertLocalToUTC -- * * Converts a time (in a TclDateFields structure) from the @@ -1137,6 +1318,7 @@ GetJulianDayFromEraYearMonthDay( ) { int year; int ym1; int month; int mm1; + int q; int r; if (fields->era == BCE) { year = 1 - fields->year; @@ -1148,8 +1330,14 @@ GetJulianDayFromEraYearMonthDay( month = fields->month; mm1 = month - 1; - year += mm1 / 12; - month = (mm1 % 12) + 1; + q = mm1 / 12; + r = (mm1 % 12); + if (r < 0) { + r += 12; + q -= 1; + } + year += q; + month = r + 1; ym1 = year - 1; /* Adjust the year after reducing the month */ diff --git a/library/clock.tcl b/library/clock.tcl index 6f6b1ed..279a3db 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.21 2005/11/29 22:50:58 kennykb Exp $ +# RCS: @(#) $Id: clock.tcl,v 1.22 2005/11/30 19:34:13 kennykb Exp $ # #---------------------------------------------------------------------- @@ -399,7 +399,8 @@ proc ::tcl::clock::Initialize {} { dict set date era CE dict set date year [expr { 100 * [dict get $date century] + [dict get $date yearOfCentury] }] - set date [GetJulianDayFromEraYearMonthDay $date[set date {}]] + set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ + $changeover] } { century yearOfCentury dayOfYear } 2 { dict set date era CE @@ -412,13 +413,15 @@ proc ::tcl::clock::Initialize {} { dict set date iso8601Year \ [expr { 100 * [dict get $date iso8601Century] + [dict get $date iso8601YearOfCentury] }] - set date [GetJulianDayFromEraYearWeekDay $date[set date {}]] + set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ + $changeover] } { yearOfCentury month dayOfMonth } 3 { set date [InterpretTwoDigitYear $date[set date {}] $baseTime] dict set date era CE - set date [GetJulianDayFromEraYearMonthDay $date[set date {}]] + set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ + $changeover] } { yearOfCentury dayOfYear } 3 { set date [InterpretTwoDigitYear $date[set date {}] $baseTime] @@ -430,13 +433,15 @@ proc ::tcl::clock::Initialize {} { $date[set date {}] $baseTime \ iso8601YearOfCentury iso8601Year] dict set date era CE - set date [GetJulianDayFromEraYearWeekDay $date[set date {}]] + set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ + $changeover] } { month dayOfMonth } 4 { set date [AssignBaseYear $date[set date {}] \ $baseTime $timeZone] - set date [GetJulianDayFromEraYearMonthDay $date[set date {}]] + set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ + $changeover] } { dayOfYear } 4 { set date [AssignBaseYear $date[set date {}] \ @@ -446,19 +451,22 @@ proc ::tcl::clock::Initialize {} { { iso8601Week dayOfWeek } 4 { set date [AssignBaseIso8601Year $date[set date {}] \ $baseTime $timeZone] - set date [GetJulianDayFromEraYearWeekDay $date[set date {}]] + set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ + $changeover] } { dayOfMonth } 5 { set date [AssignBaseMonth $date[set date {}] \ $baseTime $timeZone] - set date [GetJulianDayFromEraYearMonthDay $date[set date {}]] + set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ + $changeover] } { dayOfWeek } 6 { set date [AssignBaseWeek $date[set date {}] \ $baseTime $timeZone] - set date [GetJulianDayFromEraYearWeekDay $date[set date {}]] + set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ + $changeover] } {} 7 { @@ -1313,7 +1321,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { # Assemble date, time, zone into seconds-from-epoch - set date [GetJulianDayFromEraYearMonthDay $date[set date {}]] + set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2299161] if { $parseTime ne {} } { dict set date secondOfDay $parseTime } elseif { [llength $parseWeekday] != 0 @@ -1870,6 +1878,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } { append procBody "set date \[dict create\]" \n append procBody {dict set date tzName $timeZone} \n append procBody $postcode + append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n # Add code that gets Julian Day Number from the fields. @@ -1906,7 +1915,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } { ::tcl::clock::SetupTimeZone $timeZone set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \ $TZData($timeZone) \ - [mc GREGORIAN_CHANGE_DATE]] + $changeover] } } @@ -2525,11 +2534,7 @@ proc ::tcl::clock::FormatStarDate { date } { # Determine whether the year is a leap year - if { [dict get $date gregorian] } { - set lp [IsGregorianLeapYear $date] - } else { - set lp [expr { [dict get $date year] % 4 == 0 }] - } + set lp [IsGregorianLeapYear $date] # Convert day of year to a fractional year @@ -2577,6 +2582,7 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } { # Build a tentative date from year and fraction. set date [dict create \ + gregorian 1 \ era CE \ year [expr { $year + $Roddenberry }] \ dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]] @@ -2584,11 +2590,7 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } { # Determine whether the given year is a leap year - if { [dict get $date gregorian] } { - set lp [IsGregorianLeapYear $date] - } else { - set lp [expr { [dict get $date year] % 4 == 0 }] - } + set lp [IsGregorianLeapYear $date] # Reconvert the fractional year according to whether the given # year is a leap year @@ -3878,158 +3880,6 @@ proc ::tcl::clock::GetLocaleEra { date } { #---------------------------------------------------------------------- # -# GetJulianDayFromEraYearWeekDay -- -# -# Finds the Julian Day Number corresponding to the given era, -# year, week and day. -# -# Parameters: -# date -- A dictionary populated with fields whose keys are given -# by the 'keys' parameter below, plus the 'era' field. -# daysInFirstWeek -- (Optional) The minimum number of days in -# the first week of the year. Default is 4. -# firstDayOfWeek -- (Optional) The ordinal number of the first -# day of the week. Default is 1 (Monday); -# 0 (Sunday) is an alternative. -# keys -- (Optional) Keys in the dictionary for looking up the -# fiscal year, fiscal week, and day of week. The -# default is { iso8601Year iso8601Week dayOfWeek }. -# -# Results: -# Returns the dictionary augmented with a 'julianDay' field -# that gives the Julian Day Number corresponding to the given -# date. -# -# Bugs: -# This code needs to be moved to the C layer. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::GetJulianDayFromEraYearWeekDay { - date - { daysInFirstWeek 4 } - { firstDayOfWeek 1 } - { keys { iso8601Year iso8601Week dayOfWeek } } -} { - - foreach var { fiscalYear fiscalWeek dayOfWeek } key $keys { - set $var [dict get $date $key] - } - - # Find a day of the first week of the year. - - set date2 [dict create \ - era [dict get $date era] \ - year $fiscalYear \ - month 1 \ - dayOfMonth $daysInFirstWeek] - set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}]] - - # Find the Julian Day Number of the start of that week. - - set jd [WeekdayOnOrBefore $firstDayOfWeek [dict get $date2 julianDay]] - - # Add the required number of weeks and days - - dict set date julianDay \ - [expr { $jd - + ( 7 * ( $fiscalWeek - 1 ) ) - + $dayOfWeek - $firstDayOfWeek }] - - return $date - -} - -#---------------------------------------------------------------------- -# -# GetJulianDayFromEraYearMonthDay -- -# -# Given a year, month and day on the Gregorian calendar, determines -# the Julian Day Number beginning at noon on that date. -# -# Parameters: -# date -- A dictionary in which the 'era', 'year', 'month', and -# 'dayOfMonth' slots are populated. The calendar in use -# is determined by the date itself relative to -# [mc GREGORIAN_CHANGE_DATE] in the current locale. -# -# Results: -# Returns the given dictionary augmented with a 'julianDay' key -# whose value is the desired Julian Day Number, and a 'gregorian' -# key that specifies whether the calendar is Gregorian (1) or -# Julian (0). -# -# Side effects: -# None. -# -# Bugs: -# This code needs to be moved to the C layer. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::GetJulianDayFromEraYearMonthDay { date } { - - variable DaysInPriorMonthsInCommonYear - variable DaysInPriorMonthsInLeapYear - - # Get absolute year number from the civil year - - switch -exact -- [dict get $date era] { - BCE { - set year [expr { 1 - [dict get $date year] }] - } - CE { - set year [dict get $date year] - } - } - - # If month is out of range, reduce modulo 12 and adjust year accordingly. - - set month [expr { [dict get $date month] - 1 }] - incr year [expr { $month / 12 }] - set month [expr { ( $month % 12 ) + 1 }] - dict set date era CE; dict set date year $year; dict set date month $month - - set ym1 [expr { $year - 1 }] - - # Try the Gregorian calendar first. - - dict set date gregorian 1 - set jd [expr { 1721425 - + [dict get $date dayOfMonth] - + ( [IsGregorianLeapYear $date] ? - [lindex $DaysInPriorMonthsInLeapYear \ - [expr { $month - 1}]] - : [lindex $DaysInPriorMonthsInCommonYear \ - [expr { $month - 1}]] ) - + ( 365 * $ym1 ) - + ( $ym1 / 4 ) - - ( $ym1 / 100 ) - + ( $ym1 / 400 ) }] - - # If the date is before the Gregorian change, use the Julian calendar. - - if { $jd < [mc GREGORIAN_CHANGE_DATE] } { - - dict set date gregorian 0 - set jd [expr { 1721423 - + [dict get $date dayOfMonth] - + ( ( $year % 4 == 0 ) ? - [lindex $DaysInPriorMonthsInLeapYear \ - [expr { $month - 1}]] - : [lindex $DaysInPriorMonthsInCommonYear \ - [expr { $month - 1}]] ) - + ( 365 * $ym1 ) - + ( $ym1 / 4 ) }] - } - - dict set date julianDay $jd - return $date - -} - -#---------------------------------------------------------------------- -# # GetJulianDayFromEraYearDay -- # # Given a year, month and day on the Gregorian calendar, determines @@ -4129,7 +3979,8 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay { date } { dict incr date2 month dict set date2 dayOfMonth 7 } - set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}]] + set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \ + [mc GREGORIAN_CHANGE_DATE]] set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \ [dict get $date2 julianDay]] dict set date julianDay [expr { $wd0 + 7 * $week }] @@ -4490,7 +4341,8 @@ proc ::tcl::clock::AddMonths { months clockval timezone } { # Reconvert to a number of seconds set date [GetJulianDayFromEraYearMonthDay \ - $date[set date {}]] + $date[set date {}]\ + $changeover] dict set date localSeconds \ [expr { -210866803200 + ( 86400 * wide([dict get $date julianDay]) ) |