code rationalization - eliminate some duplication between Tcl and C

1 files changed, 27 insertions, 175 deletions

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]) )