#----------------------------------------------------------------------
#
# 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.3 2004/11/02 15:16:38 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)
				 - 210866803200 }]
	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) \
			     -210866803200 }]
	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)
			-210866803200 }]
	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)
			    -210866803200}]
	    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