TIP #173 and #209 implementation - see ChangeLog for details

1 files changed, 1440 insertions, 0 deletions

diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl
new file mode 100755
index 0000000..e6bbb5a
--- /dev/null
+++ b/tools/tclZIC.tcl
@@ -0,0 +1,1440 @@
+#----------------------------------------------------------------------
+#
+# tclZIC.tcl --
+#
+#	Take the time zone data source files from Arthur Olson's
+#	repository at elsie.nci.nih.gov, and prepare time zone
+#	information files for Tcl.
+#
+# Usage:
+#	tclsh tclZIC.tcl inputDir outputDir
+#
+# Parameters:
+#	inputDir - Directory (e.g., tzdata2003e) where Olson's source
+#		   files are to be found.
+#	outputDir - Directory (e.g., ../library/clock/tzdata) where
+#		    the time zone information files are to be placed.
+#
+# Results:
+#	May produce error messages on the standard error.  An exit
+#	code of zero denotes success; any other exit code is failure.
+#
+# This program parses the timezone data in a means analogous to the
+# 'zic' command, and produces Tcl time zone information files suitable
+# for loading into the 'clock' namespace.
+#
+#----------------------------------------------------------------------
+#
+# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: tclZIC.tcl,v 1.1 2004/08/18 19:59:09 kennykb Exp $
+#
+#----------------------------------------------------------------------
+
+# Define the names of the Olson files that we need to load.
+# We avoid the solar time files and the leap seconds.
+
+set olsonFiles {
+    africa antarctica asia australasia
+    backward etcetera europe northamerica
+    pacificnew southamerica systemv
+}
+
+# Temporary scaffolding - load up the new 'clock' package.
+
+source [file join [file dirname [info script]] .. library clock.tcl]
+
+# Define the year at which the DST information will stop.
+
+set maxyear 2100
+
+# Determine how big a wide integer is.
+
+set MAXWIDE [expr { wide(1) }]
+while 1 {
+    set next [expr { $MAXWIDE + $MAXWIDE + 1}]
+    if { $next < 0 } {
+	break
+    }
+    set MAXWIDE $next
+}
+set MINWIDE [expr { - $MAXWIDE - 1 }]
+
+#----------------------------------------------------------------------
+#
+# K --
+#
+#	The K combinator returns its first argument.  It's used for
+#	reference count management.
+#
+# Parameters:
+#	x - Argument to be unreferenced.
+#	y - Unused.
+#
+# Results:
+#	Returns the first argument.
+#
+# Side effects:
+#	None.
+#
+# The K combinator is used for its effect that [K $x [set x {}]]
+# reads out the value of x destructively, giving an unshared Tcl
+# object and avoiding 'copy on write'
+#
+#----------------------------------------------------------------------
+
+proc K {x y} {return $x}
+
+#----------------------------------------------------------------------
+#
+# loadFiles --
+#
+#	Loads the time zone files for each continent into memory
+#
+# Parameters:
+#	dir - Directory where the time zone source files are found
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	Calls 'loadZIC' for each continent's data file in turn.
+#	Reports progress on stdout.
+#
+#----------------------------------------------------------------------
+
+proc loadFiles { dir } {
+    variable olsonFiles
+    foreach file $olsonFiles {
+	puts "loading: [file join $dir $file]"
+	loadZIC [file join $dir $file]
+    }
+    return
+}
+
+#----------------------------------------------------------------------
+#
+# checkForwardRuleRefs --
+#
+#	Checks to make sure that all references to Daylight Saving
+#	Time rules designate defined rules.
+#
+# Parameters:
+#	None.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	Produces an error message and increases the error count if
+#	any undefined rules are present.
+#
+#----------------------------------------------------------------------
+
+proc checkForwardRuleRefs {} {
+    variable forwardRuleRefs
+    variable rules
+    foreach { rule where } [array get forwardRuleRefs] {
+	if { ![info exists rules($rule)] } {
+	    foreach { fileName lno } $where {
+		puts stderr "$fileName:$lno:can't locate rule \"$rule\""
+		incr errorCount
+	    }
+	}
+    }
+}
+
+#----------------------------------------------------------------------
+#
+# loadZIC --
+#
+#	Load one continent's data into memory.
+#
+# Parameters:
+#	fileName -- Name of the time zone source file.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	The global variable, 'errorCount' counts the number of errors.
+#	The global array, 'links', contains a distillation of the
+#	'Link' directives in the file. The keys are 'links to' and
+#	the values are 'links from'.  The 'parseRule' and 'parseZone'
+#	procedures are called to handle 'Rule' and 'Zone' directives.
+#
+#----------------------------------------------------------------------
+
+proc loadZIC { fileName } {
+
+    variable errorCount
+    variable links
+
+    # Suck the text into memory.
+
+    set f [open $fileName r]
+    set data [read $f]
+    close $f
+
+    # Break the input into lines, and count line numbers.
+
+    set lno 0
+    foreach line [split $data \n] {
+	incr lno
+
+	# Break a line of input into words.
+
+	regsub {[[:space:]]*(\#.*)?$} $line {} line
+	if { $line eq {} } {
+	    continue
+	}
+	set words {}
+	if { [regexp {^[[:space:]]+(.*)} $line -> l] } {
+	    lappend words {}
+	    set line $l
+	}
+	while {[regexp {^([^[:space:]]+)[[:space:]]*(.*)} $line -> \
+		    word line]} {
+	    lappend words $word
+	}
+
+	# Switch on the directive
+
+	switch -exact -- [lindex $words 0] {
+	    Rule {
+		parseRule $fileName $lno $words
+	    }
+	    Link {
+		set links([lindex $words 2]) [lindex $words 1]
+	    }
+	    Zone {
+		set lastZone [lindex $words 1]
+		set until [parseZone $fileName $lno \
+			       $lastZone [lrange $words 2 end] minimum]
+	    }
+	    {} {			# Continuation of a Zone
+		set i 0
+		foreach word $words {
+		    if { [lindex $words $i] ne {} } break
+		    incr i
+		}
+		set words [lrange $words $i end]
+		set until [parseZone $fileName $lno $lastZone $words $until]
+	    }
+	    default {
+		incr errorCount
+		puts stderr "$fileName:$lno:unknown line type \"[lindex $words 0]\""
+	    }
+	}
+    }
+
+    return
+
+}
+
+#----------------------------------------------------------------------
+#
+# parseRule --
+#
+#	Parses a Rule directive in an Olson file.
+#
+# Parameters:
+#	fileName -- Name of the file being parsed.
+#	lno - Line number within the file
+#	words - The line itself, broken into words.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	The rule is analyzed and added to the 'rules' array.
+#	Errors are reported and counted.
+#
+#----------------------------------------------------------------------
+
+proc parseRule { fileName lno words } {
+
+    variable rules
+    variable errorCount
+
+    # Break out the columns
+
+    foreach { Rule name from to type in on at save letter } $words {}
+
+    # Handle the 'only' keyword
+
+    if { $to eq {only} } {
+	set to $from
+    }
+
+    # Process the start year
+
+    set l [string length $from]
+    if { ![string is integer $from] } {
+	if { $from ne [string range {minumum} 0 [expr { $l - 1 }]] } {
+	    puts stderr "$fileName:$lno:FROM field \"$from\" not an integer."
+	    incr errorCount
+	    return
+	} else {
+	    set from minimum
+	}
+    }
+
+    # Process the end year
+
+    set l [string length $to]
+    if { ![string is integer $to] } {
+	if { $to ne [string range {maximum} 0 [expr { $l - 1 }]] } {
+	    puts stderr "$fileName:$lno:TO field \"$to\" not an integer."
+	    incr errorCount
+	    return
+	} else {
+	    set to maximum
+	}
+    }
+
+    # Process the type of year in which the rule applies
+
+    if { $type ne {-} } {
+	puts stderr "$fileName:$lno:year types are not yet supported."
+	incr errorCount
+	return
+    }
+
+    # Process the month in which the rule starts
+
+    if { [catch {lookupMonth $in} in] } {
+	puts stderr "$fileName:$lno:$in"
+	incr errorCount
+	return
+    }
+
+    # Process the day of the month on which the rule starts
+
+    if { [catch {parseON $on} on] } {
+	puts stderr "$fileName:$lno:$on"
+	incr errorCount
+	return
+    }
+
+    # Process the time of day on which the rule starts
+
+    if { [catch {parseTOD $at} at] } {
+	puts stderr "$fileName:$lno:$at"
+	incr errorCount
+	return
+    }
+
+    # Process the DST adder
+
+    if { [catch {parseOffsetTime $save} save] } {
+	puts stderr "$fileName:$lno:$save"
+	incr errorCount
+	return
+    }
+	
+    # Process the letter to use for summer time
+
+    if { $letter eq {-} } {
+	set letter {}
+    }
+
+    # Accumulate all the data.
+
+    lappend rules($name) $from $to $type $in $on $at $save $letter
+    return
+
+}
+
+#----------------------------------------------------------------------
+#
+# parseON --
+#
+#	Parse a specification for a day of the month
+#
+# Parameters:
+#	on - the ON field from a line in an Olson file.
+#
+# Results:
+#	Returns a partial Tcl command.  When the year and number of the
+#	month are appended, the command will return the Julian Day Number
+#	of the desired date.
+#
+# Side effects:
+#	None.
+#
+# The specification can be:
+#	- a simple number, which designates a constant date.
+#	- The name of a weekday, followed by >= or <=, followed by a number.
+#	    This designates the nearest occurrence of the given weekday on
+#	    or before (on or after) the given day of the month.
+#	- The word 'last' followed by a weekday name with no intervening
+#	  space.  This designates the last occurrence of the given weekday
+#	  in the month.
+#
+#----------------------------------------------------------------------	
+
+proc parseON { on } {
+    if { ! [regexp -expanded {
+	^(?:
+	  # first possibility - simple number - field 1
+	  ([[:digit:]]+)
+	  |
+	  # second possibility - weekday >= (or <=) number
+	  # field 2 - weekday
+	  ([[:alpha:]]+)
+	  # field 3 - direction
+	  ([<>]=)
+	  # field 4 - number
+	  ([[:digit:]]+)
+	  |
+	  # third possibility - lastWeekday - field 5
+	  last([[:alpha:]]+)
+	  )$
+    } $on -> dom1 wday2 dir2 num2 wday3] } {
+	error "can't parse ON field \"$on\""
+    }
+    if { $dom1 ne {} } {
+	return [list onDayOfMonth $dom1]
+    } elseif { $wday2 ne {} } {
+	set wday2 [lookupDayOfWeek $wday2]
+	return [list onWeekdayInMonth $wday2 $dir2 $num2]
+    } elseif { $wday3 ne {} } {
+	set wday3 [lookupDayOfWeek $wday3]
+	return [list onLastWeekdayInMonth $wday3]
+    } else {
+	error "in parseOn \"$on\": can't happen"
+    }
+}
+      
+#----------------------------------------------------------------------
+#
+# onDayOfMonth --
+#
+#	Find a given day of a given month
+#
+# Parameters:
+#	day - Day of the month
+#	year - Gregorian year
+#	month - Number of the month (1-12)
+#
+# Results:
+#	Returns the Julian Day Number of the desired day.
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc onDayOfMonth { day year month } {
+    set date [dict create era CE year $year month $month dayOfMonth $day]
+    set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
+		  [K $date [set date {}]]]
+    return [dict get $date julianDay]
+}
+
+#----------------------------------------------------------------------
+#
+# onWeekdayInMonth --
+#
+#	Find the weekday falling on or after (on or before) a
+#	given day of the month
+#
+# Parameters:
+#	dayOfWeek - Day of the week (Monday=1, Sunday=7)
+#	relation - <= for the weekday on or before a given date, >= for
+#		   the weekday on or after the given date.
+#	dayOfMonth - Day of the month
+#	year - Gregorian year
+#	month - Number of the month (1-12)
+#
+# Results:
+#	Returns the Juloan Day Number of the desired day.
+#
+# Side effects:
+#	None.
+#
+# onWeekdayInMonth is used to compute Daylight Saving Time rules
+# like 'Sun>=1' (for the nearest Sunday on or after the first of the month)
+# or "Mon<=4' (for the Monday on or before the fourth of the month).
+#
+#----------------------------------------------------------------------
+
+proc onWeekdayInMonth { dayOfWeek relation dayOfMonth year month } {
+    set date [dict create \
+		  era CE year $year month $month dayOfMonth $dayOfMonth]
+    set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
+		  [K $date [set date {}]]]
+    switch -exact -- $relation {
+	<= {
+	    return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \
+			[dict get $date julianDay]]
+	}
+	>= {
+	    return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \
+			[expr { [dict get $date julianDay] + 6 }]]
+	}
+    }
+}
+
+#----------------------------------------------------------------------
+#
+# onLastWeekdayInMonth --
+#
+#	Find the last instance of a given weekday in a month.
+#
+# Parameters:
+#	dayOfWeek - Weekday to find (Monday=1, Sunday=7)
+#	year - Gregorian year
+#	month - Month (1-12)
+#
+# Results:
+#	Returns the Julian Day number of the last instance of
+#	the given weekday in the given month
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc onLastWeekdayInMonth { dayOfWeek year month } {
+    incr month
+    # Find day 0 of the following month, which is the last day of
+    # the current month.  Yes, it works to ask for day 0 of month 13!
+    set date [dict create \
+		  era CE year $year month $month dayOfMonth 0]
+    set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
+		  [K $date [set date {}]]]
+    return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \
+		[dict get $date julianDay]]
+}
+		  
+#----------------------------------------------------------------------
+#
+# parseTOD --
+#
+#	Parses the specification of a time of day in an Olson file.
+#
+# Parameters:
+#	tod - Time of day, which may be followed by 'w', 's', 'u', 'g'
+#	      or 'z'.  'w' (or no letter) designates a wall clock time,
+#	      's' designates Standard Time in the given zone, and
+#	      'u', 'g', and 'z' all designate UTC.
+#
+# Results:
+#	Returns a two element list containing a count of seconds from
+#	midnight and the letter that followed the time.
+#
+# Side effects:
+#	Reports and counts an error if the time cannot be parsed.
+#
+#----------------------------------------------------------------------
+
+proc parseTOD { tod } {
+    if { ![regexp -expanded {
+	^
+	# field 1 - hour
+	([[:digit:]]{1,2})
+	(?:
+	 # field 2 - minute
+	 :([[:digit:]]{2})
+	 (?:
+	  # field 3 - second
+	  :([[:digit:]]{2})
+	  )?
+	)?
+	(?:
+	 # field 4 - type indicator
+	 ([wsugz])
+	 )?
+    } $tod -> hour minute second ind] } {
+	puts stderr "$fileName:$lno:can't parse time field \"$tod\""
+	incr errorCount
+    }
+    scan $hour %d hour
+    if { $minute ne {} } {
+	scan $minute %d minute
+    } else {
+	set minute 0
+    }
+    if { $second ne {} } {
+	scan $second %d second
+    } else {
+	set second 0
+    }
+    if { $ind eq {} } {
+	set ind w
+    }
+    return [list [expr { ( $hour * 60 + $minute ) * 60 + $second }] $ind]
+}
+
+#----------------------------------------------------------------------
+#
+# parseOffsetTime --
+#
+#	Parses the specification of an offset time in an Olson file.
+#
+# Parameters:
+#	offset - Offset time as [+-]hh:mm:ss
+#
+# Results:
+#	Returns the offset time as a count of seconds.
+#
+# Side effects:
+#	Reports and counts an error if the time cannot be parsed.
+#
+#----------------------------------------------------------------------
+
+proc parseOffsetTime { offset } {
+    if { ![regexp -expanded {
+	^
+	# field 1 - signum
+	([-+])?
+	# field 2 - hour
+	([[:digit:]]{1,2})
+	(?:
+	 # field 3 - minute
+	 :([[:digit:]]{2})
+	 (?:
+	  # field 4 - second
+	  :([[:digit:]]{2})
+	  )?
+	)?
+    } $offset -> signum hour minute second] } {
+	puts stderr "$fileName:$lno:can't parse offset time \"$offset\""
+	incr errorCount
+    }
+    append signum 1
+    scan $hour %d hour
+    if { $minute ne {} } {
+	scan $minute %d minute
+    } else {
+	set minute 0
+    }
+    if { $second ne {} } {
+	scan $second %d second
+    } else {
+	set second 0
+    }
+    return [expr { ( ( $hour * 60 + $minute ) * 60 + $second ) * $signum }]
+
+}
+
+#----------------------------------------------------------------------
+#
+# lookupMonth -
+#	Looks up a month by name
+#
+# Parameters:
+#	month - Name of a month.
+#
+# Results:
+#	Returns the number of the month.
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc lookupMonth { month } {
+
+    set indx [lsearch -regexp {
+	{} January February March April May June
+	July August September October November December
+    } ${month}.*]
+    if { $indx < 1 } {
+	error "unknown month name \"$month\""
+    }
+    return $indx
+}
+
+#----------------------------------------------------------------------
+#
+# lookupDayOfWeek --
+#
+#	Looks up the name of a weekday.
+#
+# Parameters:
+#	wday - Weekday name (or a unique prefix).
+#
+# Results:
+#	Returns the weekday number (Monday=1, Sunday=7)
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc lookupDayOfWeek { wday } {
+    set indx [lsearch -regexp {
+	{} Monday Tuesday Wednesday Thursday Friday Saturday Sunday
+    } ${wday}.*]
+    if { $indx < 1 } {
+	error "unknown weekday name \"$wday\""
+    }
+    return $indx
+}
+
+#----------------------------------------------------------------------
+#
+# parseZone --
+#
+#	Parses a Zone directive in an Olson file
+#
+# Parameters:
+#	fileName -- Name of the file being parsed.
+#	lno -- Line number within the file.
+#	zone -- Name of the time zone
+#	words -- Remaining words on the line.
+#	start -- 'Until' time from the previous line if this is a
+#	         continuation line, or 'minimum' if this is the first line.
+#
+# Results:
+#	Returns the 'until' field of the current line
+#
+# Side effects:
+#	Stores a row in the 'zones' array describing the current zone.
+#	The row consists of a start time (year month day tod), a Standard
+#	Time offset from Greenwich, a Daylight Saving Time offset from
+#	Standard Time, and a format for printing the time zone.
+#
+#	The start time is the result of an earlier call to 'parseUntil'
+#	or else the keyword 'minimum'.  The GMT offset is the
+#	result of a call to 'parseOffsetTime'.  The Daylight Saving
+#	Time offset is represented as a partial Tcl command. To the
+#	command will be appended a start time (seconds from epoch)
+#	the current offset of Standard Time from Greenwich, the current
+#	offset of Daylight Saving Time from Greenwich, the default
+#	offset from this line, the name pattern from this line,
+#	the 'until' field from this line, and a variable name where points
+#	are to be stored.  This command is implemented by the 'applyNoRule',
+#	'applyDSTOffset' and 'applyRules' procedures.
+#
+#----------------------------------------------------------------------
+
+proc parseZone { fileName lno zone words start } {
+    variable zones
+    variable rules
+    variable errorCount
+    variable forwardRuleRefs
+    foreach { gmtoff save format } $words break
+    if { [catch {parseOffsetTime $gmtoff} gmtoff] } {
+	puts stderr "$fileName:$lno:$gmtoff"
+	incr errorCount
+	return
+    } 
+    if { [info exists rules($save)] } {
+	set save [list applyRules $save]
+    } elseif { $save eq {-} } {
+	set save [list applyNoRule]
+    } else {
+	if { [catch { parseOffsetTime $save } save2] } {
+	    lappend forwardRuleRefs($save) $fileName $lno
+	    set save [list applyRules $save]
+	} else {
+	    set save [list applyDSTOffset $save2]
+	}
+    }
+    lappend zones($zone) $start $gmtoff $save $format
+    if { [llength $words] >= 4 } {
+	return [parseUntil [lrange $words 3 end]]
+    } else {
+	return {}
+    }
+}
+
+#----------------------------------------------------------------------
+#
+# parseUntil --
+#	
+#	Parses the 'UNTIL' part of a 'Zone' directive.
+#
+# Parameters:
+#	words - The 'UNTIL' part of the directie.
+#
+# Results:
+#	Returns a list comprising the year, the month, the day, and
+#	the time of day. Time of day is represented as the result of
+#	'parseTOD'.
+#
+#----------------------------------------------------------------------
+
+proc parseUntil { words } {
+    variable firstYear
+    if { [llength $words] >= 1 } {
+	set year [lindex $words 0]
+	if { ![string is integer $year] } {
+	    error "can't parse UNTIL field \"$words\""
+	}
+	if { ![info exists firstYear] || $year < $firstYear } {
+	    set firstYear $year
+	}
+    } else {
+	set year maximum
+    }
+    if { [llength $words] >= 2 } {
+	set month [lookupMonth [lindex $words 1]]
+    } else {
+	set month 1
+    }
+    if { [llength $words] >= 3 } {
+	set day [parseON [lindex $words 2]]
+    } else {
+	set day {onDayOfMonth 1}
+    }
+    if { [llength $words] >= 4 } {
+	set tod [parseTOD [lindex $words 3]]
+    } else {
+	set tod {0 w}
+    }
+    return [list $year $month $day $tod]
+}
+
+#----------------------------------------------------------------------
+#
+# applyNoRule --
+#
+#	Generates time zone data for a zone without Daylight Saving
+#	Time.
+#
+# Parameters:
+#	year - Year in which the rule applies
+#	startSecs - Time at which the rule starts.
+#	stdGMTOffset - Offset from Greenwich prior to the start of the
+#		       rule
+#	DSTOffset - Offset of Daylight from Standard prior to the
+#		    start of the rule.
+#	nextGMTOffset - Offset from Greenwich when the rule is in effect.
+#	namePattern - Name of the timezone.
+#	until - Time at which the rule expires.
+#	pointsVar - Name of a variable in callers scope that receives
+#		    transition times
+#
+# Results:
+#	Returns a two element list comprising 'nextGMTOffset' and
+#	0 - the zero indicates that Daylight Saving Time is not
+#	in effect.
+#
+# Side effects:
+#	Appends a row to the 'points' variable comprising the start time,
+#	the offset from GMT, a zero (indicating that DST is not in effect),
+#	and the name of the time zone.
+#
+#----------------------------------------------------------------------
+
+proc applyNoRule { year startSecs stdGMTOffset DSTOffset nextGMTOffset
+		   namePattern until pointsVar } {
+    upvar 1 $pointsVar points
+    lappend points $startSecs $nextGMTOffset 0 \
+	[convertNamePattern $namePattern -]
+    return [list $nextGMTOffset 0]
+
+}
+
+#----------------------------------------------------------------------
+#
+# applyNoRule --
+#
+#	Generates time zone data for a zone with permanent Daylight
+#	Saving Time.
+#
+# Parameters:
+#	nextDSTOffset - Offset of Daylight from Standard while the
+#	                rule is in effect.
+#	year - Year in which the rule applies
+#	startSecs - Time at which the rule starts.
+#	stdGMTOffset - Offset from Greenwich prior to the start of the
+#		       rule
+#	DSTOffset - Offset of Daylight from Standard prior to the
+#		    start of the rule.
+#	nextGMTOffset - Offset from Greenwich when the rule is in effect.
+#	namePattern - Name of the timezone.
+#	until - Time at which the rule expires.
+#	pointsVar - Name of a variable in callers scope that receives
+#		    transition times
+#
+# Results:
+#	Returns a two element list comprising 'nextGMTOffset' and
+#	'nextDSTOffset'.
+#
+# Side effects:
+#	Appends a row to the 'points' variable comprising the start time,
+#	the offset from GMT, a one (indicating that DST is in effect),
+#	and the name of the time zone.
+#
+#----------------------------------------------------------------------
+
+proc applyDSTOffset { nextDSTOffset year startSecs
+		      stdGMTOffset DSTOffset nextGMTOffset 
+		      namePattern until pointsVar } {
+    upvar 1 $pointsVar points
+    lappend points \
+	$startSecs \
+	[expr { $nextGMTOffset + $nextDSTOffset }] \
+	1 \
+	[convertNamePattern $namePattern S]
+    return [list $nextGMTOffset $nextDSTOffset]
+}
+
+#----------------------------------------------------------------------
+#
+# applyRules --
+#
+#	Applies a rule set to a time zone for a given range of time
+#
+# Parameters:
+#	ruleSet - Name of the rule set to apply
+#	year - Starting year for the rules
+#	startSecs - Time at which the rules begin to apply
+#	stdGMTOffset - Offset from Greenwich prior to the start of the
+#		       rules.
+#	DSTOffset - Offset of Daylight from Standard prior to the
+#		    start of the rules.
+#	nextGMTOffset - Offset from Greenwich when the rules are in effect.
+#	namePattern - Name pattern for the time zone.
+#	until - Time at which the rule set expires.
+#	pointsVar - Name of a variable in callers scope that receives
+#		    transition times
+#
+# Results:
+#	Returns a two element list comprising the offset from GMT
+#	to Standard and the offset from Standard to Daylight (if DST
+#	is in effect) at the end of the period in which the rules apply
+#
+# Side effects:
+#	Appends one or more rows to the 'points' variable, each of which
+#	comprises a transition time, the offset from GMT that is
+#	in effect after the transition, a flag for whether DST is in
+#	effect, and the name of the time zone.
+#
+#----------------------------------------------------------------------
+
+proc applyRules { ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset \
+		      namePattern until pointsVar } {
+    variable done
+    variable rules
+    variable maxyear
+
+    upvar 1 $pointsVar points
+
+    # Extract the rules that apply to the current year, and the number
+    # of rules (now or in future) that will end at a specific year.
+    # Ignore rules entirely in the past.
+
+    foreach { 
+	currentRules nSunsetRules
+    } [divideRules $ruleSet $year] break
+
+    # If the first transition is later than $startSecs, and $stdGMTOffset is
+    # different from $nextGMTOffset, we will need an initial record like:
+    #    lappend points $startSecs $stdGMTOffset 0 \
+    #                   [convertNamePattern $namePattern -]
+
+    set didTransitionIn false
+
+    # Determine the letter to use in Standard Time
+
+    set prevLetter {}
+    foreach { 
+	fromYear toYear yearType monthIn daySpecOn timeAt save letter
+    }  $rules($ruleSet) {
+	if { $save == 0 } {
+	    set prevLetter $letter
+	    break
+	} 
+    }
+
+    # Walk through each year in turn. This loop will break when
+    #    (a) the 'until' time is passed
+    # or (b) the 'until' time is empty and all remaining rules extend to
+    #        the end of time
+
+    set stdGMTOffset $nextGMTOffset
+
+    # convert "until" to seconds from epoch in current time zone
+
+    if { $until ne {} } {
+	foreach { 
+	    untilYear untilMonth untilDaySpec untilTimeOfDay 
+	} $until break
+	lappend untilDaySpec $untilYear $untilMonth
+	set untilJCD [eval $untilDaySpec]
+	set untilBaseSecs [expr {
+				 wide(86400) * wide($untilJCD)
+				 - $::tcl::clock::PosixEpochAsJulianSeconds }]
+	set untilSecs [eval [linsert $untilTimeOfDay 0 convertTimeOfDay \
+				 $untilBaseSecs $stdGMTOffset $DSTOffset]]
+    }
+
+    set origStartSecs $startSecs
+
+    while { ( $until ne {} && 
+	      $startSecs < $untilSecs )
+	    || ( $until eq {} && 
+		 ( $nSunsetRules > 0 || $year < $maxyear ) ) } {
+
+	set remainingRules $currentRules
+	while { [llength $remainingRules] > 0 } {
+
+
+	    # Find the rule with the earliest start time from among the
+	    # active rules that haven't yet been processed.
+
+	    foreach { 
+		earliestSecs earliestIndex 
+	    } [findEarliestRule $remainingRules $year \
+		   $stdGMTOffset $DSTOffset] break
+	       
+	    set endi [expr {$earliestIndex + 7}]
+	    set rule [lrange $remainingRules $earliestIndex $endi]
+	    foreach { 
+		fromYear toYear yearType monthIn daySpecOn timeAt save letter
+	    } $rule break
+
+	    # Test if the rule is in effect.
+
+	    if { $earliestSecs > $startSecs && 
+		 ( $until eq {} || $earliestSecs < $untilSecs ) } {
+
+		# Test if the initial transition has been done.
+		# If not, do it now.
+
+		if { !$didTransitionIn && $earliestSecs > $origStartSecs } {
+		    set nm [convertNamePattern $namePattern $prevLetter]
+		    lappend points \
+			$origStartSecs \
+			[expr { $stdGMTOffset + $DSTOffset }] \
+			0 \
+			$nm
+		    set didTransitionIn true
+		}
+
+		# Add a row to 'points' for the rule
+
+		set nm [convertNamePattern $namePattern $letter]
+		lappend points \
+		    $earliestSecs \
+		    [expr { $stdGMTOffset + $save }] \
+		    [expr { $save != 0 }] \
+		    $nm
+	    }
+
+	    # Remove the rule just applied from the queue
+
+	    set remainingRules [lreplace \
+				    [K $remainingRules \
+					 [set remainingRules {}]] \
+				    $earliestIndex $endi]
+
+	    # Update current DST offset and time zone letter
+
+	    set DSTOffset $save
+	    set prevLetter $letter
+
+	    # Reconvert the 'until' time in the current zone.
+	    
+	    if { $until ne {} } {
+		set untilSecs [eval [linsert $untilTimeOfDay 0 \
+					 convertTimeOfDay $untilBaseSecs \
+					 $stdGMTOffset $DSTOffset]]
+	    }
+	}
+
+	# Advance to the next year
+
+	incr year
+	set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
+		      [dict create era CE year $year month 1 dayOfMonth 1]]
+	set startSecs [expr { [dict get $date julianDay] * wide(86400) \
+			     - $::tcl::clock::PosixEpochAsJulianSeconds }]
+	set startSecs [expr { $startSecs - $stdGMTOffset - $DSTOffset }]
+
+
+	# Get rules in effect in the new year.
+
+	foreach { 
+	    currentRules nSunsetRules 
+	}  [divideRules $ruleSet $year] break
+	
+    }
+
+    return [list $stdGMTOffset $DSTOffset]
+}
+
+#----------------------------------------------------------------------
+#
+# divideRules --
+#	Determine what Daylight Saving Time rules may be in effect in
+#	a given year.
+#
+# Parameters:
+#	ruleSet - Set of rules from 'parseRule'
+#	year - Year to test
+#
+# Results:
+#	Returns a two element list comprising the subset of 'ruleSet'
+#	that is in effect in the given year, and the count of rules
+#	that expire in the future (as opposed to those that expire in
+#	the past or not at all). If this count is zero, the rules do
+#	not change in future years.
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc divideRules { ruleSet year } {
+
+    variable rules
+
+    set currentRules {}
+    set nSunsetRules 0
+
+    foreach { 
+	fromYear toYear yearType monthIn daySpecOn timeAt save letter
+    }  $rules($ruleSet) {
+	if { $toYear ne {maximum} && $year > $toYear } {
+	    # ignore - rule is in the past
+	} else {
+	    if { $fromYear eq {minimum} || $fromYear <= $year } {
+		lappend currentRules $fromYear $toYear $yearType $monthIn \
+		    $daySpecOn $timeAt $save $letter
+	    }
+	    if { $toYear ne {maximum} } {
+		incr nSunsetRules
+	    }
+	}
+    }
+
+    return [list $currentRules $nSunsetRules]
+
+}
+
+#----------------------------------------------------------------------
+#
+# findEarliestRule --
+#
+#	Find the rule in a rule set that has the earliest start time.
+#
+# Parameters:
+#	remainingRules -- Rules to search
+#	year - Year being processed.
+#	stdGMTOffset - Current offset of standard time from GMT
+#	DSTOffset - Current offset of daylight time from standard,
+#	            if daylight time is in effect.
+#
+# Results:
+#	Returns the index in remainingRules of the next rule to
+#	go into effect.
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc findEarliestRule { remainingRules year stdGMTOffset DSTOffset } {
+
+    set earliest $::MAXWIDE
+    set i 0
+    foreach {
+	fromYear toYear yearType monthIn daySpecOn timeAt save letter
+    } $remainingRules {
+	lappend daySpecOn $year $monthIn
+	set dayIn [eval $daySpecOn]
+	set secs [expr {
+			wide(86400) * wide($dayIn)
+			- $::tcl::clock::PosixEpochAsJulianSeconds }]
+	set secs [eval [linsert $timeAt 0 convertTimeOfDay \
+			    $secs $stdGMTOffset $DSTOffset]]
+	if { $secs < $earliest } {
+	    set earliest $secs
+	    set earliestIdx $i
+	}
+	incr i 8
+    }
+
+    return [list $earliest $earliestIdx]
+
+}
+
+#----------------------------------------------------------------------
+#
+# convertNamePattern --
+#
+#	Converts a name pattern to the name of the time zone.
+#
+# Parameters:
+#	pattern - Patthern to convert
+#	flag - Daylight Time flag. An empty string denotes Standard
+#	       Time, anything else is Daylight Time.
+#
+# Results;
+#	Returns the name of the time zone.
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc convertNamePattern { pattern flag } {
+    if { [regexp {(.*)/(.*)} $pattern -> standard daylight] } {
+	if { $flag ne {} } {
+	    set pattern $daylight
+	} else {
+	    set pattern $standard
+	}
+    }
+    return [string map [list %s $flag] $pattern]
+}
+
+#----------------------------------------------------------------------
+#
+# convertTimeOfDay --
+#
+#	Takes a time of day specifier from 'parseAt' and converts
+#	to seconds from the Epoch,
+#
+# Parameters:
+#	seconds -- Time at which the GMT day starts, in seconds
+#		   from the Posix epoch
+#	stdGMTOffset - Offset of Standard Time from Greenwich
+#	DSTOffset - Offset of Daylight Time from standard.
+#	timeOfDay - Time of day to convert, in seconds from midnight
+#	flag - Flag indicating whether the time is Greenwich, Standard
+#	       or wall-clock. (g, s, or w)
+#      
+# Results:
+#	Returns the time of day in seconds from the Posix epoch.
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc convertTimeOfDay { seconds stdGMTOffset DSTOffset timeOfDay flag } {
+    incr seconds $timeOfDay
+    switch -exact $flag {
+	g - u - z {
+	}
+	w {
+	    incr seconds [expr { -$stdGMTOffset }]
+	    incr seconds [expr { -$DSTOffset }]
+	}
+	z {
+	    incr seconds [expr { -$stdGMTOffset }]
+	}
+    }
+    return $seconds
+}
+
+#----------------------------------------------------------------------
+#
+# processTimeZone --
+#
+#	Generate the information about all time transitions in a
+#	time zone.
+#
+# Parameters:
+#	zoneName - Name of the time zone
+#	zoneData - List containing the rows describing the time zone,
+#		   obtained from 'parseZone.
+#
+# Results:
+#	Returns a list of rows.  Each row consists of a time in
+#	seconds from the Posix epoch, an offset from GMT to local
+#	that begins at that time, a flag indicating whether DST
+#	is in effect after that time, and the printable name of the
+#	timezone that goes into effect at that time.
+#
+# Side effects:
+#	None.
+#
+#----------------------------------------------------------------------
+
+proc processTimeZone { zoneName zoneData } {
+
+    set points {}
+    set i 0
+    foreach { startTime nextGMTOffset dstRule namePattern } $zoneData {
+	incr i 4
+	set until [lindex $zoneData $i]
+	if {! [info exists stdGMTOffset] } {
+	    set stdGMTOffset $nextGMTOffset
+	}
+	if {! [info exists DSTOffset] } {
+	    set DSTOffset 0
+	}
+	if { $startTime eq {minimum} } {
+	    set secs $::MINWIDE
+	    set year 0
+	} else {
+	    foreach { year month dayRule timeOfDay } $startTime break
+	    lappend dayRule $year $month
+	    set startDay [eval $dayRule]
+	    set secs [expr {
+			    wide(86400) * wide($startDay)
+			    - $::tcl::clock::PosixEpochAsJulianSeconds}]
+	    set secs [eval [linsert $timeOfDay 0 convertTimeOfDay \
+				$secs $stdGMTOffset $DSTOffset]]
+	}
+	lappend dstRule \
+	    $year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \
+	    $namePattern $until points
+	foreach {stdGMTOffset DSTOffset} [eval $dstRule] break
+    }
+    return $points
+}
+
+#----------------------------------------------------------------------
+#
+# writeZones --
+#
+#	Writes all the time zone information files.
+#
+# Parameters:
+#	outDir - Directory in which to store the files.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	Writes the time zone information files; traces what's happening
+#	on the standard output.
+#
+#----------------------------------------------------------------------
+
+proc writeZones { outDir } {
+ 
+    variable zones
+
+    # Walk the zones
+
+    foreach zoneName [lsort -dictionary [array names zones]] {
+	puts "calculating: $zoneName"
+	set fileName [eval [list file join $outDir] [file split $zoneName]]
+
+	# Create directories as needed
+
+	set dirName [file dirname $fileName]
+	if { ![file exists $dirName] } {
+	    puts "creating directory: $dirName"
+	    file mkdir $dirName
+	}
+
+	# Generate data for a zone
+
+	set data {}
+	foreach { 
+	    time offset dst name 
+	} [processTimeZone $zoneName $zones($zoneName)] {
+	    append data \n {    } [list [list $time $offset $dst $name]]
+	}
+	append data \n
+
+	# Write the data to the information file
+
+	set f [open $fileName w]
+	puts $f "\# created by $::argv0 - do not edit"
+	puts $f {}
+	puts $f [list set TZData(:$zoneName) $data]
+	close $f
+
+    }
+
+    return
+}
+
+#----------------------------------------------------------------------
+#
+# writeLinks --
+#
+#	Write files describing time zone synonyms (the Link directives
+#	from the Olson files)
+#
+# Parameters:
+#	outDir - Name of the directory where the output files go.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	Creates a file for each link.
+
+proc writeLinks { outDir } {
+
+    variable links
+
+    # Walk the links
+
+    foreach zoneName [lsort -dictionary [array names links]] {
+	puts "creating link: $zoneName"
+	set fileName [eval [list file join $outDir] [file split $zoneName]]
+
+	# Create directories as needed
+
+	set dirName [file dirname $fileName]
+	if { ![file exists $dirName] } {
+	    puts "creating directory: $dirName"
+	    file mkdir $dirName
+	}
+
+	# Create code for the synonym
+
+	set linkTo $links($zoneName)
+	set sourceCmd "\n    [list loadTimeZoneFile $linkTo]\n"
+	set ifCmd [list if "!\[info exists TZData($linkTo)\]" $sourceCmd]
+	set setCmd "set tzdata(:$zoneName) \$TZData(:$linkTo)"
+
+	# Write the file
+
+	set f [open $fileName w]
+	puts $f "\# created by $::argv0 - do not edit"
+	puts $f $ifCmd
+	puts $f $setCmd
+	close $f
+    }
+
+    return
+}
+
+#----------------------------------------------------------------------
+#
+# MAIN PROGRAM
+#
+#----------------------------------------------------------------------
+
+# Determine directories
+
+foreach { inDir outDir } $argv break
+
+# Initialize count of errors
+
+set errorCount 0
+
+# Parse the Olson files
+
+loadFiles $inDir
+if { $errorCount > 0 } {
+    exit 1
+}
+
+# Check that all riles appearing in Zone and Link lines actually exist
+
+checkForwardRuleRefs
+if { $errorCount > 0 } {
+    exit 1
+}
+
+# Write the time zone information files
+
+writeZones $outDir
+writeLinks $outDir
+if { $errorCount > 0 } {
+    exit 1
+}
+
+# All done!
+
+exit
\ No newline at end of file