undo subtree

1 files changed, 0 insertions, 1373 deletions

diff --git a/tcl8.6/tools/tclZIC.tcl b/tcl8.6/tools/tclZIC.tcl
deleted file mode 100755
index 85c9ba9..0000000
--- a/tcl8.6/tools/tclZIC.tcl
+++ /dev/null
@@ -1,1373 +0,0 @@
-#----------------------------------------------------------------------
-#
-# 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/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.
-#----------------------------------------------------------------------
-
-# 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
-}
-
-# 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 {wide($MAXWIDE + $MAXWIDE + 1)}]
-    if {$next < 0} {
-	break
-    }
-    set MAXWIDE $next
-}
-set MINWIDE [expr {-$MAXWIDE-1}]
-
-#----------------------------------------------------------------------
-#
-# 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 {\s*(\#.*)?$} $line {} line
-	if {$line eq ""} {
-	    continue
-	}
-	set words {}
-	if {[regexp {^\s} $line]} {
-	    # Detect continuations of a zone and flag the list appropriately
-	    lappend words ""
-	}
-	lappend words {*}[regexp -all -inline {\S+} $line]
-
-	# 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"]
-	    }
-	    {} {
-		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
-
-    lassign $words  Rule name from to type in on at save letter
-
-    # Handle the 'only' keyword
-
-    if {$to eq "only"} {
-	set to $from
-    }
-
-    # Process the start year
-
-    if {![string is integer $from]} {
-	if {![string equal -length [string length $from] $from "minimum"]} {
-	    puts stderr "$fileName:$lno:FROM field \"$from\" not an integer."
-	    incr errorCount
-	    return
-	} else {
-	    set from "minimum"
-	}
-    }
-
-    # Process the end year
-
-    if {![string is integer $to]} {
-	if {![string equal -length [string length $to] $to "maximum"]} {
-	    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} {
-    scan $day %d day
-    scan $year %d year
-    scan $month %d month
-    set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
-	    [dict create era CE year $year month $month dayOfMonth $day] \
-		 2361222]
-    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 [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \
-	    era CE year $year month $month dayOfMonth $dayOfMonth] 2361222]
-    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 [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \
-	    era CE year $year month $month dayOfMonth 0] 2361222]
-    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 {
-	^
-	([[:digit:]]{1,2})		# field 1 - hour
-	(?:
-	    :([[:digit:]]{2})		# field 2 - minute
-	    (?:
-		:([[:digit:]]{2})	# field 3 - second
-	    )?
-	)?
-	(?:
-	    ([wsugz])			# field 4 - type indicator
-	)?
-    } $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
-	([[:digit:]]{1,2})		# field 2 - hour
-	(?:
-	    :([[:digit:]]{2})		# field 3 - minute
-	    (?:
-		:([[:digit:]]{2})	# field 4 - second
-	    )?
-	)?
-    } $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
-
-    lassign $words gmtoff save format
-    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]
-    } elseif {[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]
-}
-
-#----------------------------------------------------------------------
-#
-# applyDSTOffset --
-#
-#	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.
-
-    lassign [divideRules $ruleSet $year] currentRules nSunsetRules
-
-    # 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 ""} {
-	lassign $until untilYear untilMonth untilDaySpec untilTimeOfDay
-	lappend untilDaySpec $untilYear $untilMonth
-	set untilJCD [eval $untilDaySpec]
-	set untilBaseSecs [expr {
-		wide(86400) * wide($untilJCD) - 210866803200 }]
-	set untilSecs [convertTimeOfDay $untilBaseSecs $stdGMTOffset \
-		$DSTOffset {*}$untilTimeOfDay]
-    }
-
-    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.
-
-	    lassign [findEarliestRule $remainingRules $year \
-		    $stdGMTOffset $DSTOffset] earliestSecs earliestIndex
-
-	    set endi [expr {$earliestIndex + 7}]
-	    set rule [lrange $remainingRules $earliestIndex $endi]
-	    lassign $rule fromYear toYear \
-		    yearType monthIn daySpecOn timeAt save letter
-
-	    # 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 \
-		    $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 [convertTimeOfDay $untilBaseSecs \
-			$stdGMTOffset $DSTOffset {*}$untilTimeOfDay]
-	    }
-	}
-
-	# Advance to the next year
-
-	incr year
-	set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
-		[dict create era CE year $year month 1 dayOfMonth 1] 2361222]
-	set startSecs [expr {
-	    [dict get $date julianDay] * wide(86400) - 210866803200
-		- $stdGMTOffset - $DSTOffset
-	}]
-
-	# Get rules in effect in the new year.
-
-	lassign [divideRules $ruleSet $year] currentRules nSunsetRules
-    }
-
-    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 [convertTimeOfDay $secs \
-		$stdGMTOffset $DSTOffset {*}$timeAt]
-	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}]
-	}
-	s {
-	    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 {
-	    lassign $startTime year month dayRule timeOfDay
-	    lappend dayRule $year $month
-	    set startDay [eval $dayRule]
-	    set secs [expr {wide(86400) * wide($startDay) -210866803200}]
-	    set secs [convertTimeOfDay $secs \
-		    $stdGMTOffset $DSTOffset {*}$timeOfDay]
-	}
-	lappend dstRule \
-		$year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \
-		$namePattern $until points
-	lassign [eval $dstRule] stdGMTOffset DSTOffset
-    }
-    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]
-	fconfigure $f -translation lf
-	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]
-	fconfigure $f -translation lf
-	puts $f "\# created by $::argv0 - do not edit"
-	puts $f $ifCmd
-	puts $f $setCmd
-	close $f
-    }
-
-    return
-}
-
-#----------------------------------------------------------------------
-#
-# MAIN PROGRAM
-#
-#----------------------------------------------------------------------
-
-puts "Compiling time zones -- [clock format [clock seconds] \
-                                   -format {%x %X} -locale system]"
-
-# Determine directories
-
-lassign $argv inDir outDir
-
-puts "Olson files in $inDir"
-puts "Tcl files to be placed in $outDir"
-
-# 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