#!/usr/bin/env wish

# gpsclock : pops up a digital clock showing GPS time (according to the
#   computer on which it is being run).  Also has a time converter like guild's
# Written by Peter Shawhan, January 2002
# Modified October 2005 to synchronize with USNO rather than with LIGO CDS

# Copyright 2002, 2005, 2012 Peter Shawhan

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

#-- Set appearance parameters
set bgColor "#ddd"
set gpsfg black
set gpsbg "#fd6"
set utcfg black
set utcbg "#ffc"
set btnfg "#00f"
set btnbg "#bfa"
set initsize 24


##=========================================================================
namespace eval tconvert {

    #-- Initialize namespace variables
    variable gotLeapSeconds 0
    variable gpsEpoch 0
    variable gpsLeaps {}
    variable sysLeaps {}

    #-- Commands to be imported with "namespace import tconvert::*"
    namespace export tconvert SysToGPS GPSToSys
}


##=========================================================================
## Name: tconvert
##

proc tconvert::tconvert { args } {
    variable gotLeapSeconds
    variable gpsLeaps
    variable sysLeaps

    ;##- Set defaults
    set gmtflag 1
    set format "%b %d %Y %T %Z"
    set timespec ""
    set debug 0

    ;##- Parse arguments
    set option ""
    foreach arg $args {
	if { [regexp {^-[A-Za-z]} $arg] } {
	    set option $arg
	    set val ""
	} else {
	    set val $arg
	}

	if { $option == "" } {
	    ;##- Append this to the time specification string
	    if { $timespec == "" } {
		set timespec $arg
	    } else {
		append timespec " " $arg
	    }

	} else {
	    ;##- Handle this option
	    switch -- $option {

		-local -
		-l {
		    set gmtflag 0
		    set option ""   ;##- The '-l' flag takes no argument
		}

		-gmt {
		    if { $val != "" } {
			set gmtflag $val
			set option ""  ;##- This flag takes a one-word argument
		    }
		}

		-debug -
		-d {
		    set debug 1
		    set option ""   ;##- The '-d' takes no argument
		}

		-format -
		-f {
		    if { $val != "" } {
			set format $val
			set option ""  ;##- This flag takes a one-word argument
		    }
		}

		default {
		    return -code error "tconvert ERROR: Invalid option $option"
		}

	    }
	}
    }
    

    ;##- If we haven't yet gotten leap-second information, do it now
    if { $gotLeapSeconds == 0 } {
	if { [catch {GetLeapSeconds $debug} msg] } {
	    return -code error "Error getting leap-second information. \
		    Message: $msg"
	}
	set gotLeapSeconds 1
	if {$debug} DumpLeapSeconds
    }

    ;##- Figure out whether we should interpret the timespec as GPS seconds
    ;##- or as a date-time string
    set timespec [string trim $timespec]
    if { [string is space $timespec] } { return "" }
    if { [regexp {[^0-9\.+\-*/()\s]} $timespec] } {
	;##- Contains a chararacter which is not a digit, decimal,
	;##- arithmetic symbol, parenthesis, or space
	set type "datetime"
    } elseif { [regexp {^-?[\d\.]+$} $timespec] } {
	;##- Consists entirely of digits and/or decimal points
	set gpstime $timespec
	set type "GPS"
    } elseif { [regexp {^\d{9,10}} $timespec] \
	    && ! [catch {expr $timespec} gpstime] \
	    && [string is double $gpstime] } {
	;##- Begins with 9 or 10 digits, and is an arithmetic expression
	set type "GPS"
    } else {
	set type "datetime"
    }

    if {$debug} { puts "Interpreting timespec ($timespec) as $type" }

    ;##- If the input was a GPS time, translate it now
    if { $type == "GPS" } {

	;##- Check for fractional seconds
	if { [regexp {^(-?\d+)(\.\d*)} $gpstime match intsec fracsec] } {
	    if {$debug} { puts "Found fractional GPS seconds: $fracsec" }
	    set gpstime $intsec
	    ;##- Modify output format to display the fractional part at the
	    ;##- appropriate place
	    regsub -all "%r" $format "%I:%M:%S %p" format
	    regsub -all "%T" $format "%H:%M:%S" format
	    regsub -all "%S" $format "%S$fracsec" format
	}

	if { ! [string is integer $gpstime] \
		|| $gpstime < 0 || $gpstime > 2147483647 } {
	    return -code error "Invalid GPS time"
	}
	if { $gpstime > 0 && $gpstime < 200000000 } {
	    return -code error "Unreasonable GPS time (prior to 1986)"
	}
	if { $gpstime > 1830000000 } {
	    return -code error "Unreasonable GPS time (after 2037)"
	}
	set systime [GPSToSys $gpstime $debug]

	;##- If this is an exact leap second, then the output should be a time
	;##- like "23:59:60".  Modify the format string to accomplish this.
	if { [lsearch -exact $gpsLeaps $gpstime] != -1 } {
	    if {$debug} { puts "This is an exact leap second" }
	    regsub -all "%r" $format "%I:%M:%S %p" format
	    regsub -all "%T" $format "%H:%M:%S" format
	    regsub -all "%S" $format "60" format
	}

	set outstring [clock format $systime -format $format -gmt $gmtflag]

	;##- Replace "GMT" with "UTC"
	regsub -all "GMT" $outstring "UTC" outstring

	return $outstring
    }

    ;##- If we get to this point, the input is a date/time string
    set leapcorr 0
    set fracsec ""
    set delsign 1

    ;##- Modify string to avoid a counterintuitive case: Tcl considers
    ;##- "jan 23 2003" to be "jan 23 20:03", but I want it to be
    ;##- interpreted as "jan 23, 2003".
    regsub -nocase {([a-z]{3,}\s+\d{1,2})\s+((?:19|20)\d\d)} $timespec \
	    {\1, \2} timespec

    ;##- Another special case: allow the form "jan 23, 20:03"
    regsub -nocase {([a-z]{3,}\s+\d{1,2})\s*,\s+(\d{1,2}:\d{1,2})} $timespec \
	    {\1 \2} timespec

##    ;##- If input string begins with a date/time and ends with a relative
##    ;##- number, assume it is a number of seconds
##    if { [regexp {[^\d\s\+\-\*/].*[+-]\s*[\d\*]+$} $timespec] } {
##	append timespec "sec"
##    }

    ;##- If input string begins with "now" and ends with a relative
    ;##- number, assume it is a number of seconds
    if { [regexp -nocase {now\s*[+-]\s*[\d\*]+$} $timespec] } {
	append timespec "sec"
    }

    ;##- If it just ends with "s", also assume this is seconds
    if { [regexp {[^\d\s\+\-\*/].*[+-]\s*[\d\*]+\s*s\s*$} $timespec] } {
	set timespec [string trim $timespec]
	append timespec "ec"
    }

    ;##- See if the user specified a U.S. time zone without specifying whether
    ;##- it is standard time or daylight savings time
    if { [regexp -nocase {[^c]([ecmp])(t)} $timespec - inz1 inz2] } {
	;##- Standard vs. daylight time is up to us to decide!
	;##- First try standard time
	set inzone [string toupper "${inz1}S${inz2}"]
	set ambigDST 1
	set origtimespec $timespec
	regsub -nocase {[ecmp]t} $origtimespec $inzone timespec
	if {$debug} {
	    puts "Modified timespec with definite time zone is $timespec"
	}
    } else {
	set ambigDST 0
    }


    if { [catch {clock scan $timespec -gmt $gmtflag} systime] } {
	;##- 'clock scan' fails!  There are two special cases to check.

	if {$debug} { 
	    puts "Initial 'clock scan' fails.  Checking special cases ..."
	}

	;##- First, see if this seems to be a leap second, during which
	;##- a UTC clock should properly read "23:59:60"
	if {$debug} {
	    puts -nonewline "  Checking if this is has the format of an\
		    exact leap second ..."
	}
	if { [regsub {:59:60} $timespec {:59:59} timespec2] \
	   } {
	    if {$debug} { puts " yes" }
	    set leapcorr -1
	} else {
	    if {$debug} { puts " no" }
	    set timespec2 $timespec
	}

	;##- If 'clock scan' still fails, check for fractional seconds
	;##- and remove if present
	if {$debug} { puts -nonewline "  Checking for fractional seconds ..." }
	if { [catch {clock scan $timespec2 -gmt $gmtflag} systime] } {
	    if { ! [regexp {^([^.]*)(\d)(\.\d*)([^.]*)$} $timespec2 \
		    match part1 digit fracsec part2] } {
		if {$debug} { puts " no decimal point found" }
		return -code error "Unable to parse date/time string"
	    }
	    ;##- See if removing the fractional part makes the string parsable
	    if { [catch {clock scan "${part1}${digit}${part2}" -gmt $gmtflag} \
		    systime] } {
		if {$debug} { 
		    puts " found a decimal fraction, but removing it doesn't\
			    make string parsable"
		}
		return -code error "Unable to parse date/time string"
	    }

	    ;##- The string is parsable!
	    ;##- Make sure the fractional part was really on the seconds, by
	    ;##- modifying the least-significant-digit on the seconds and
	    ;##- verifying that the parsed time changes appropriately
	    if { $digit != 9 } {
		set newdigit [expr {$digit+1}]
		set delexpect 1
	    } else {
		set newdigit 8
		set delexpect -1
	    }
	    set systime2 \
		    [clock scan "${part1}${newdigit}${part2}" -gmt $gmtflag]
	    if { [expr {abs($systime2-$systime)}] != 1 } {
		if {$debug} { 
		    puts " found a decimal fraction, but it is not on the\
			    number of seconds"
		}
		return -code error "Unable to parse date/time string"
	    }
	    set delsign [expr {($systime2-$systime)*$delexpect}]

	    ;##- The fractional part really WAS on the seconds!
	    ;##- Now we can go on.
	    if {$debug} { 
		puts " successfully stripped out the fractional part\
			($fracsec)"
	    }

	}

	;##- If we get to this point, 'clock scan' has succeeded
	if {$debug} {puts "clock scan has succeeded"}

	;##- If this looks like a leap second, make sure it corresponds to an
	;##- actual leap second
	if { $leapcorr == -1 } {
	    incr systime
	    if { [lsearch -exact $sysLeaps $systime] != -1 } {
		;##- This is an actual leap second!  We'll need to correct the
		;##- GPS time we come up with
		if {$debug} { 
		    puts "Verified that this is an actual leap second"
		}
		set leapcorr -1
	    } else {
		if {$debug} { puts "This is NOT an actual leap second" }
		return -code error "That is not an actual leap second"
	    }
	}
    }

    ;##- If a U.S. time zone was specified, check daylight vs. standard time
    ;##- (only on Unix)
    if { ! [regexp -nocase {(windows|macos|darwin)} $::tcl_platform(os)] } {
	if { [regexp -nocase {(?:\A|[^yc])([ecmp][sd]t)} $timespec - inz] } {
	    set inzone [string toupper $inz]
	    set inzone1 [string index $inzone 0]
	    if {$debug} { 
		puts -nonewline "Checking whether specified time zone\
		    ($inzone) is valid for this time ..."
	    }

	    switch -exact -- $inzone1 {
		"E" { set checkTZ "EST5EDT" }
		"C" { set checkTZ "CST6CDT" }
		"M" { set checkTZ "MST7MDT" }
		"P" { set checkTZ "PST8PDT" }
	    }

	    if { [info exists ::env(TZ)] } {
		set saveZone $::env(TZ)
	    } else {
		set saveZone ""
	    }

	    set tzChanged 0
	    if { ! [string equal $saveZone $checkTZ] } {
		set ::env(TZ) $checkTZ
		set tzChanged 1
	    }

	    set outzone [string toupper [clock format $systime -format %Z]]

	    if { $tzChanged } {
		;##- Restore the original time zone
		if { $saveZone != "" } {
		    set ::env(TZ) $saveZone
		} else {
		    unset ::env(TZ)
		}
	    }

	    if { ! [string equal $inzone $outzone] } {
		if {$debug} { puts " no" }
		if { $ambigDST } {
		    #-- We assumed standard time but that wasn't right, so
		    #-- evidently it is really daylight savings time.
		    #-- That means our time was one hour too late
		    if {$debug} { puts "So interpret it as daylight savings" }
		    incr systime -3600
		} else {
		   return -code error "That time does not occur during $inzone"
		}
	    } else {
		if {$debug} { puts " yes" }
	    }

	}
    }

    ;##- OK, convert to GPS time and print it out
    set gpstime [expr {[SysToGPS $systime $debug]+$leapcorr}]
    if { $gpstime < 0 } {
	return -code error "Time is prior to GPS 0 (Jan 6, 1980)"
    }
    if { $fracsec != "" } {
	if { $delsign == 1 || $fracsec == "." } {
	    set gpstime "$gpstime$fracsec"
	} else {
	    set length [expr {[string length $fracsec]-1}]
	    set modfrac [format %.${length}f [expr {1.0-$fracsec}]]
	    regsub {^0+\.} $modfrac {.} modfrac
	    incr gpstime -1
	    set gpstime "$gpstime$modfrac"
	}
    }

    return $gpstime
}


##=========================================================================
## Name: GPSToSys
##
## Convert a GPS time to system time

proc tconvert::GPSToSys { gpstime {debug 0} } {
    variable gpsEpoch
    variable gotLeapSeconds
    variable gpsLeaps

    ;##- If we haven't yet gotten leap-second information, do it now
    if { $gotLeapSeconds == 0 } {
	if { [catch {GetLeapSeconds $debug} msg] } {
	    return -code error "tconvert: Error getting leap-second\
		    information.  Message: $msg"
	}
	set gotLeapSeconds 1
	if {$debug} DumpLeapSeconds
    }

    set nleaps 0
    foreach gpsleap $gpsLeaps {
	if { $gpstime >= $gpsleap } { incr nleaps }
    }

    set systime [expr {$gpstime+$gpsEpoch-$nleaps}]

    return $systime
}


##=========================================================================
## Name: SysToGPS
##
## Convert system time to GPS time

proc tconvert::SysToGPS { systime {debug 0} } {
    variable gpsEpoch
    variable gotLeapSeconds
    variable sysLeaps

    ;##- If we haven't yet gotten leap-second information, do it now
    if { $gotLeapSeconds == 0 } {
	if { [catch {GetLeapSeconds $debug} msg] } {
	    return -code error "tconvert: Error getting leap-second\
		    information.  Message: $msg"
	}
	set gotLeapSeconds 1
	if {$debug} DumpLeapSeconds
    }

    set nleaps 0
    foreach sysleap $sysLeaps {
	if { $systime >= $sysleap } { incr nleaps }
    }

    set gpstime [expr {$systime-$gpsEpoch+$nleaps}]

    return $gpstime
}


##=========================================================================
## Name: GetLeapSeconds
##

proc tconvert::GetLeapSeconds { {debug 0} } {
    variable gpsEpoch
    variable gpsLeaps
    variable sysLeaps

    set gpsEpoch [clock scan "jan 6, 1980" -gmt 1]
    set timenow [clock seconds]

    set configdir ""
    set sysLeaps {}

    ;##- Figure out where the leap-seconds file lives.
    ;##- First, see if the TCLEAPSDIR environment variable is set
    if { [info exists ::env(TCLEAPSDIR)] } {
	if {$debug} { 
	    puts "Using TCLEAPSDIR environment variable for location\
		    of config dir"
	}
	set configdir $::env(TCLEAPSDIR)
    } elseif { [info exists ::env(LIGOTOOLS)] } {
	;##- Use the LIGOTOOLS environment variable to locate the config dir;
	;##- then tcleaps.txt is in $LIGOTOOLS/config/public
	if {$debug} { 
	    puts "Using LIGOTOOLS environment variable to determine location\
		    of config dir"
	}
	set configdir $::env(LIGOTOOLS)/config/public

	#-- If tcleaps.txt exists here but it's not writable, use home
	#-- directory instead
	if { [file exists $configdir/tcleaps.txt] && \
		 ! [file writable $configdir/tcleaps.txt] && \
		 [info exists ::env(HOME)] } {
	    if {$debug} { puts "$configdir/tcleaps.txt is\
                    not writable, so using home directory" }
	    set configdir $::env(HOME)
	}
	
    } elseif { [info exists ::env(HOME)] } {
	;##- As a last resort, use the user's home directory
	set configdir $::env(HOME)
	if {$debug} { puts "Using home directory as config dir" }
    }

    #-- Check for failure
    if [string is space $configdir] {
	return -code error "tconvert ERROR: Unable to find usable config dir"
    }

    if {$debug} { 
	if { $configdir != "" } {
	    puts "config dir is $configdir"
	    if { [file isdirectory $configdir] } {
		puts "config dir exists"
	    } else {
		puts "config dir does not exist"
	    }
	    puts "leap-seconds file is $configdir/tcleaps.txt"
	} else {
	    puts "Cannot determine location of config dir"
	}
    }

    ;##- Check whether the leap-seconds file exists and is readable
    if { $configdir != "" } {
	set leapfile $configdir/tcleaps.txt
    } else {
	set leapfile ""
    }
    if { $leapfile != "" && [file readable $leapfile] } {
	if {$debug} { puts "tcleaps.txt exists and is readable" }
	set expiration [ReadLeapSecFile $leapfile $debug]
	
	;##- Check whether the leap-second info has expired
	if { $timenow > $expiration } {
	    ;##- The leap-seconds file has expired, so we will have to try to
	    ;##- update it using information from the web.  But first save what
	    ;##- we have, in case we're unable to get any updated information.
	    if {$debug} {puts "  ... has EXPIRED"}

	    set sysLeapsExpired $sysLeaps
	    set gpsLeapsExpired $gpsLeaps
	    set sysLeaps {}
	    set gpsLeaps {}
	} else {
	    if {$debug} {puts "  ... is still valid"}
	    return
	}

    } else {
	if {$debug} { puts "tcleaps.txt does not exist or is not readable" }
    }

    ;##- If we get to this point, then the leap-seconds file either does not
    ;##- exist, is unreadable for some reason, or has expired.
    ;##- So read leap-second data from the web.

    if { [catch {package require http} msg] } {
	;##- We can't read from the web.  If we were able to read from the disk
	;##- file but that info had "expired", then print a warning message
	;##- and use it anyway.
	if { [info exists sysLeapsExpired] } {
	    puts stderr "tconvert WARNING: Leap-second info in $leapfile is no\
		    longer certain to be valid, and there was an error loading\
		    the Tcl http package to get updated info from the web. \
		    Continuing with possibly-outdated info."
	    set sysLeaps $sysLeapsExpired
	    set gpsLeaps $gpsLeapsExpired
	    return
	} else {
	    return -code error "tconvert ERROR: There is no leap-second info\
		    cached on disk, and there was an error loading the Tcl\
		    http package to get info from the web."
	}
    }

    set contents ""

    ;##- Try to get the leapseconds file from various LDAS web servers
    foreach host [list www.ldas.ligo-wa.caltech.edu \
	    www.ldas.ligo-la.caltech.edu \
	    www.ldas-dev.ligo.caltech.edu \
	    www.ldas.ligo.caltech.edu ] {
	if {$debug} { 
	    puts -nonewline "Trying to get leapseconds file from $host ..."
	    flush stdout
	}

	set url "http://$host/ldas_outgoing/jobs/leapseconds"
	if { [catch {GetUrlContents $url 5000} contents] } {
	    if {$debug} {puts " FAILED"}
	    set contents ""
	    continue
	} else {
	    if {$debug} { puts " success"}
	    break
	}

    }

    if { $contents == "" } {
	;##- We can't read from the web.  If we were able to read from the disk
	;##- file but that info had "expired", then print a warning message
	;##- and use it anyway.
	if { [info exists sysLeapsExpired] } {
	    puts stderr "tconvert WARNING: Leap-second info in $leapfile is no\
		    longer certain to be valid, and we were unable to get\
		    updated info from any LDAS web server. \
		    Continuing with possibly-outdated info."
	    set sysLeaps $sysLeapsExpired
	    set gpsLeaps $gpsLeapsExpired
	    return
	} else {
	    return -code error "tconvert ERROR: There is no leap-second info\
		    cached on disk, and we were unable to get updated info\
		    from any LDAS web server."
	}
    }

    ;##- Parse the contents to construct a list of leap seconds since 1980

    set pat {^ *((?:19|20)\d\d) +([A-Za-z]{3}) +(\d{1,2})}
    foreach {match year month mdate} \
	    [regexp -all -inline -line $pat $contents] { 
	set time [clock scan "$month $mdate, $year" -gmt 1]
	if { $time > $gpsEpoch } {
	    lappend gpsLeaps [expr {$time-$gpsEpoch+[llength $sysLeaps]}]
	    lappend sysLeaps $time
	}
    }
    if {$debug} { 
	puts "Found [llength $gpsLeaps] leap seconds since 6 Jan 1980"
    }

    ;##- Set a default expiration time just one day from now.  Hopefully this
    ;##- will be updated below; otherwise, we'll just check again tomorrow.
    set expiration [expr {$timenow+24*3600}]

    ;##- Finally, check the latest "Bulletin C" from the IERS to see how far
    ;##- in the future we can be sure that this list is valid.

    if {$debug} { 
	puts -nonewline "Retrieving latest Bulletin C ..."
	flush stdout
    }
    set url "http://hpiers.obspm.fr/eoppc/bul/bulc/bulletinc.dat"
    if { [catch {GetUrlContents $url 5000} contents] } {
	if {$debug} {puts " FAILED"}
	;##- Failed to get Bulletin C.  But we know that leap seconds are
	;##- always at least 6 months apart, so set the expiration date to be
	;##- 5 months after the last known leap-second, if this is later than
	;##- the default we set above.
	set expir1 [expr {[lindex $sysLeaps end]+5*30*24*3600}]
	if { $expir1 > $expiration } { set expiration $expir1 }

    } else {
	if {$debug} {puts " success"}
	;##- Parse the bulletin.  ParseBulletinC returns an expiration date
	set expir1 [ParseBulletinC $contents $debug]
	if { $expir1 > $expiration } { set expiration $expir1 }
    }

    if {$debug} {
	puts "New expiration date is [clock format $expiration -gmt 1]"
    }

    ;##- If possible, update the leap-seconds file on local disk
    if { $leapfile != "" } {

	if { [catch \
		{WriteLeapSecFile $configdir $leapfile $expiration $debug} \
		msg] } {
	    ;##- We were unable to write the updated disk file.  If the
	    ;##- current disk file has expired, print a warning message. 
	    if { [info exists sysLeapsExpired] } {
		puts stderr "tconvert NOTICE: Leap-second info in $leapfile\
			is no longer certain to be valid; We got valid\
			information from the web, but were unable to update\
			the local cache file: $msg"
	    }
	}

    }

    return
}


##=========================================================================
## Name: DumpLeapSeconds
##

proc tconvert::DumpLeapSeconds {} {
    variable gpsLeaps
    variable sysLeaps

    puts "Leap seconds:"
    foreach sys $sysLeaps gps $gpsLeaps {
	puts "[format %12d $sys]  \
		[clock format $sys -format "%d %b %Y" -gmt 1]  \
		GPS=[format %10d $gps]"
    }

    return
}


##=========================================================================
## Name: ReadLeapSecFile
##
## Sets tconvert::sysLeaps and tconvert::gpsLeaps
## Returns expiration time if file was read successfully, or 0 if there
## was some problem reading it.

proc tconvert::ReadLeapSecFile { leapfile {debug 0} } {
    variable gpsEpoch
    variable gpsLeaps
    variable sysLeaps

    if { [catch {open $leapfile r} fid] } {
	;##- Error opening file
	if {$debug} {puts "Error opening tcleaps.txt"}
	return 0
    }

    if { [catch {read $fid} contents] } {
	;##- Error reading file
	if {$debug} {puts "Error reading tcleaps.txt"}
	catch { close $fid }
	return 0
    }

    ;##- If we get here, file was read successfully
    if {$debug} {puts "Success reading tcleaps.txt"}
    close $fid

    ;##- Do some sanity checks on the file contents.  The first
    ;##- line should indicate the format, the second
    ;##- line should indicate the time through which this file is
    ;##- known to be valid, and one of the lines should be the
    ;##- system time corresponding to Jan 1, 1999

    set t1jan99 [clock scan "jan 1, 1999" -gmt 1]

    if { ! ( [regexp -nocase {^format (\d+)} $contents match format] \
	    && [regexp -nocase -lineanchor {^valid through +(-?\d+)} \
	    $contents match expiration] \
	    && [regexp -nocase -lineanchor {^gps epoch +(-?\d+)} \
	    $contents match epoch] \
	    && $epoch == $gpsEpoch
	    && [regexp -lineanchor "^$t1jan99" $contents] ) } {
	;##- File seems corrupted!
	if {$debug} {puts "  ... FAILS sanity checks"}
	return 0
    }

    ;##- If we get here, then the file looks good
    if {$debug} {
	puts "  ... passes sanity checks"
	puts "  ... has format $format"
	puts "  ... expires at [clock format $expiration -gmt 1]"
    }

    ;##- Get leap-second times
    foreach time [regexp -all -inline -lineanchor {^-?\d+} $contents] {
	if { $time > $gpsEpoch } {
	    lappend gpsLeaps [expr {$time-$gpsEpoch+[llength $sysLeaps]}]
	    lappend sysLeaps $time
	}
    }
    if {$debug} { puts "  ... contains [llength $gpsLeaps] leap seconds" }

    return $expiration
}


##=========================================================================
## Name: WriteLeapSecFile
##

proc tconvert::WriteLeapSecFile { configdir leapfile expiration {debug 0} } {
    variable gpsEpoch
    variable sysLeaps

    ;##- If the config directory does not exist, try to create it
    if { ! [file isdirectory $configdir] \
	    && [file writable [file dirname $configdir]] \
	    && ( ! [info exists $::env(HOME)] || $configdir != $::env(HOME) ) \
	} {
	if {$debug} {
	    puts -nonewline "Attempting to create config directory ..."
	    flush stdout
	}
	if { [catch {file mkdir $configdir}] } {
	    if {$debug} {puts " FAILED to make config dir"}
	    return -code error "Failed to create directory $configdir"
	}
	if { [catch {file attributes $configdir -permissions 0777}] } {
	    if {$debug} {
		puts " made config dir, but failed to set permissions"
	    }
	    ;##- Continue despite this error
	} else {
	    if {$debug} {puts " success"}
	}
    }

    ;##- Make sure directory exists and is writable now
    if { ! [file writable $configdir] } {
	if {$debug} { puts "config directory is not writable" }
	return -code error "No permission to write in directory $configdir"
    }
    if {$debug} { puts "config directory is writable" }

    ;##- If file already exists but we do not have write permission for it,
    ;##- then delete it first before rewriting it
    if { [file exists $leapfile] && ! [file writable $leapfile] } {
	if { [catch {file delete $leapfile}] } {
	    if {$debug} { puts "No permission to rewrite tcleaps.txt" }
	    return -code error "No permission to rewrite $leapfile"
	}
    }

    ;##- Open the file for writing
    if { [catch {open $leapfile w} fid] } {
	if {$debug} { puts "Error opening tcleaps.txt for writing" }
	return -code error "Error writing $leapfile"
    }

    ;##- Write the info to the file, then close it
    puts $fid "format 1"
    puts $fid "valid through $expiration"
    puts $fid "GPS epoch $gpsEpoch"
    foreach time $sysLeaps {
	puts $fid $time
    }
    close $fid
    if {$debug} { puts "Successfully wrote tcleaps.txt" }

    ;##- Try to make the file writable by all
    if { [ catch {file attributes $leapfile -permissions 0666} ] } {
	if {$debug} { puts "Error making tcleaps.txt writable by all" }
	;##- Continue despite this error
    }

    return
}


##=========================================================================
## Name: ScriptLocation
##
## Description:
##   Returns the full path to this script, following symbolic links if needed.

proc tconvert::ScriptLocation {} {

    set script $::argv0

    while { [file type $script] == "link" \
	    || [file pathtype $script] == "relative" } {
	if { [file type $script] == "link" } {
	    set linkto [file readlink $script]
	    if { [file pathtype $linkto] == "absolute" } {
		set script $linkto
	    } else {
		set script [file dirname $script]/$linkto
	    }
	} else {
	    set script "[pwd]/$script"
	}
    }

    ;##- Now rationalize the full path

    ;##- Condense adjacent slashes
    regsub -all {/{2,}} $script {/} script

    ;##- Remove redundant directories
    while { [regexp {/\./} $script] } {
	regsub {/\./} $script {/} script
    }

## This is incorrect in some obscure cases
##    ;##- Un-nest parent-directory references
##    while { [regexp {./\.\./} $script] } {
##	regsub {/[^/]+/\.\./} $script {/} script
##    }

    return $script
}


##=========================================================================
## Name: GetUrlContents
##

proc tconvert::GetUrlContents { url {timeout 0} } {

    if { [catch {http::geturl $url -timeout $timeout} httpvar] } {
	return -code error "GetUrlContents: http::geturl failed"
    }

    ;##- Parse the http response string to see if transfer succeeded
    upvar #0 $httpvar httpstate
    if { [info exists httpstate(http)] } {
	regexp -- {^([^\s]+)\s([^\s]+)\s(.*)$} $httpstate(http) \
		match httpversion httpcode status
	if { [info exists httpcode] && $httpcode == "200" } {
	    ;##- Success!
	    set contents $httpstate(body)
	    http::cleanup $httpvar
	    return $contents
	}
    }
    http::cleanup $httpvar

    return -code error "GetUrlContents: http::geturl failed"
}


##=========================================================================
## Name: ParseBulletinC
##
## This isn't very robust, so I hope they keep the same general formatting
## in the future!  Why can't some authority provide a nice, reliable,
## machine-readable URL which indicates how long the current set of leap
## seconds is guaranteed to be valid?

proc tconvert::ParseBulletinC { contents {debug 0} } {
    variable gpsEpoch
    variable gpsLeaps
    variable sysLeaps

    set expiration 0

    ;##- Get the date of the bulletin
    set bultime 0
    if { [regexp -nocase {paris, +(\d{1,2} +\w+ +20\d\d)} $contents \
	    match date] \
	    || [regexp -nocase {paris, (20\d\d +\w+ +\d{1,2})} $contents \
	    match date] } {

	if {$debug} {puts "Bulletin C date string is $date"}
	if { [catch {ScanEnglishOrFrenchDate $date} bultime] } {
	    if {$debug} {puts "  Error parsing date string"}
	    ;##- Error parsing date of bulletin.  We won't be able to set
	    ;##- the expiration date any farther into the future.
	} else {
	    if {$debug} {
		puts "Bulletin C date is [clock format $bultime -gmt 1]"
	    }
	}

    } else {
	if {$debug} {puts "Unable to identify Bulletin C date"}
    }

    ;##- Now, check the last UTC-TAI difference indicated in the Bulletin.
    ;##- This could be more up-to-date than the LDAS file we got.
    if { [regexp -nocase -linestop \
	    {from ([^,]+).* until further notice.*utc *- *tai *= *-} \
	    $contents match date] } {

	if {$debug} {puts "Bulletin C leap date is $date"}
	if { [catch {ScanEnglishOrFrenchDate $date} time] } {
	    if {$debug} {puts "  Error parsing leap date"}
	    ;##- We were unable to determine the time of the leap second
	    ;##- from Bulletin C, but we know that if a new leap second is
	    ;##- being announced, it will be ~6 months after the date of
	    ;##- the bulletin.  And it should show up in the LDAS
	    ;##- leapseconds file before that.  So set the expiration
	    ;##- time for our leap-second info to be 4 months after the
	    ;##- date of the bulletin, OR 5 months after the latest leap
	    ;##- second we know about, if either of these is later than
	    ;##- our default expiration time.
	    if { $bultime > 0 } {
		set expir1 [expr {$bultime+4*30*24*3600}]
		if { $expir1 > $expiration } { set expiration $expir1 }
	    }
	    set expir1 [expr {[lindex $sysLeaps end]+5*30*24*3600}]
	    if { $expir1 > $expiration } { set expiration $expir1 }

	} else {
	    ;##- See whether this leap second is already in our list.
	    ;##- If not, append it.
	    if { $time > [lindex $sysLeaps end] } {
		if {$debug} { puts "  Appending this leap date to our list" }
		lappend gpsLeaps [expr {$time-$gpsEpoch+[llength $sysLeaps]}]
		lappend sysLeaps $time
	    } else {
		if {$debug} { puts "  This leap date is already in our list" }
	    }

	    ;##- We were able to parse Bulletin C, so set the expiration
	    ;##- time for our leap-second info to be just after the next
	    ;##- Bulletin C is scheduled to come out (~6 months from now),
	    ;##- OR just after the final leap second takes effect, OR one
	    ;##- week from now, whichever is latest.
	    if { $bultime > 0 } {
		set expir1 [expr {$bultime+7*30*24*3600}]
		if { $expir1 > $expiration } { set expiration $expir1 }
	    }
	    set expir1 [expr {$time+7*30*24*3600}]
	    if { $expir1 > $expiration } { set expiration $expir1 }
	    set expir1 [expr {[clock seconds]+7*24*3600}]
	    if { $expir1 > $expiration } { set expiration $expir1 }

	}
	    
    } else {
	if {$debug} {puts "Unable to find leap date"}
    }

    return $expiration
}


##=========================================================================
## Name: ScanEnglishOrFrenchDate
##

proc tconvert::ScanEnglishOrFrenchDate { date } {

    if { ! ( [regexp {(\d{1,2})\s+(\w+)\s+((?:19|20)\d\d)} $date \
	    match mdate month year] \
	    || [regexp {((?:19|20)\d\d)\s+(\w+)\s+(\d{1,2})} $date \
	    match year month mdate] ) } {
	return -code error "Cannot parse components of date"
    }

    ;##- Handle either English or French month names
    switch -glob [string tolower $month] {
	jan* { set month jan }
	fe* {set month feb}
	mar* {set month mar}
	ap* - av* {set month apr}
	may - mai {set month may}
	jun* - juin {set month jun}
	jul* - juil* {set month jul}
	aug* - ao* {set month aug}
	sep* {set month sep}
	oct* {set month oct}
	nov* {set month nov}
	d* {set month d}
	default {
	    return -code error \
		    "Cannot understand month as either English or French"
	}
    }

    if { [catch {clock scan "$month $mdate, $year" -gmt 1} systime] } {
	return -code error "Error while scanning modified date string"
    }

    return $systime
}


#==============================================================================
# The following commands are executed immediately when this file is sourced

namespace import tconvert::*


##=========================================================================
proc Main {} {

    ;##- Set some version-dependent flags
    set version [info tclversion]
    if { [regexp {^[34567]} $version] || [regexp {^8\.[0123]} $version] } {
	set ::entrydis disabled
    } else {
	set ::entrydis readonly
    }

    ;##- Check command-line arguments
    foreach {option value} $::argv {
	if { ! [regexp {^-(.+)$} $option - var] || ! [info exists ::$var] } {
	    puts stderr {
Usual usage: 'gpsclock' without any arguments

Pops up a window to display the current GPS and UTC times, according to the
computer on which it is executed.  You can click on the GPS or UTC time to
select it, then paste it into another window.  You can also open a
"Converter" window to perform an arbitrary conversion between GPS, UTC,
and local time (including times like "now-3days").

If desired, you may set the initial size and colors from the command line
using the flags:
  -initsize, -gpsfg, -gpsbg, -utcfg, -utcbg, -btnfg, -btnbg, -bgColor
For example:  "gpsclock -initsize 12 -gpsfg red"
}
	    exit 1
	}
	set ::$var $value
    }

    ;##- Put up a temporary message for two seconds
    message .msg -text "Attempting to synchronize\n(precision ~1 second)\
	    with\nthe U.S. Naval Observatory" -aspect 1000 -bg $::utcbg
    pack .msg
    update
    set ::msgvar ""
    set ::msgevt [after 2000 "set ::msgvar ok"]

    SyncTime

    ;##- Impose a minimum delay, then remove the message
    if { $::msgvar == "" } { vwait ::msgvar }
    destroy .msg

    SetupDisplay

    #-- Start the GPS/UTC clock
    UpdateClocks

    return
}


##=========================================================================
proc SyncTime {} {

    global syncOff syncText

    ;##- Try to synchronize with the U.S. Naval Observatory's
    ;##- "What time is it?" web page
    set url "http://tycho.usno.navy.mil/cgi-bin/timer.pl"

    package require http
    if [catch {
	set httpToken [http::geturl $url]
    } errmsg ] {
	set syncText "(local system clock)"
	set syncOff ""
	return
    }

    #-- Get the time on the local computer
    set sysnow [clock seconds]
    set yearnow [clock format $sysnow -format %Y -gmt 1]
    set locgps [SysToGPS $sysnow]

    #-- Get the body of the document
    upvar #0 $httpToken httpstate
    set body $httpstate(body)
    http::cleanup $httpToken

    #-- Parse the file contents.  Note that the USNO web page does not tell
    #-- us the year!
    if { ! [regexp {[^\n]+ UTC} $body utcstring] } {
	set syncText "(local system clock)"
	set syncOff ""
	return
    }
    regsub -all {<.*?>} $utcstring {} utcstring
    regsub -all {\.} $utcstring {} utcstring
    if { ! [regexp {(\S[^,]+), *(\d+:\d+:\d+ *UTC)} $utcstring \
		- utcdate utctime] } {
	set syncText "(local system clock)"
	set syncOff ""
	return
    }

    #-- Convert the UTC time to GPS time
    if [catch {
	set remgps [tconvert "$utcdate $yearnow $utctime"]
    } ] {
	set syncText "(local system clock)"
	set syncOff ""
	return
    }

    set diff [expr {$remgps-$locgps}]

    #-- If difference is anomalously large, we probably have the wrong year
    while { $diff < -185*86400 } {
	incr yearnow
	set remgps [tconvert "$utcdate $yearnow $utctime"]
	set diff [expr {$remgps-$locgps}]
    }
    while { $diff > 185*86400 } {
	incr yearnow -1
	set remgps [tconvert "$utcdate $yearnow $utctime"]
	set diff [expr {$remgps-$locgps}]
    }

    if { $diff >= 0 } {
	set offdays [expr {$diff/86400}]
	if { $offdays > 0 } {
	    set offsecs [expr {$diff%86400}]
	    set syncOff "+${offdays}day+${offsecs}sec"
	} else {
	    set syncOff "+${diff}sec"
	}
    } else {
	set offdays [expr {-$diff/86400}]
	if { $offdays > 0 } {
	    set offsecs [expr {-$diff%86400}]
	    set syncOff "-${offdays}day-${offsecs}sec"
	} else {
	    set syncOff "${diff}sec"
	}
    }
    set syncText "(synced to USNO)"

    return
}


##=========================================================================
proc SetupDisplay {} {

    . config -bg $::utcbg

    #-- Create named fonts
    font create normfont -family courier -size -[expr int(($::initsize+1)/2)]
    font create normhelv -family helvetica -size -[expr int(($::initsize+1)/2)]
    font create bighelv -family helvetica -size -$::initsize -weight bold

    #-- GPS time display
    text .gps -font bighelv -height 1 -width 12 \
	-fg $::gpsfg -bg $::gpsbg -relief flat \
	-borderwidth 0 -highlightthickness 0 -state disabled
    .gps tag configure centered -justify center
    pack .gps -side top -fill x
    # Disable all the usual text widget bindings
    bindtags .gps .gps
    bind .gps <Button> ".gps tag add sel 0.0 end"
    # Set up a selection handler to remove internal spaces
    selection handle .gps [list GetGPSSelection .gps]

    #-- UTC time display
    text .utc -font normfont -height 1 -width 20 \
	-fg $::utcfg -bg $::utcbg -relief flat \
	-borderwidth 0 -highlightthickness 0 -state disabled
    .utc tag configure centered -justify center
    pack .utc -side top -fill x
    # Disable all the usual text widget bindings
    bindtags .utc .utc
    bind .utc <Button> ".utc tag add sel 1.8 1.16"

    #-- Synchronization notice
    text .sync -font normfont -height 1 -width 20 \
	-fg $::utcfg -bg $::utcbg -relief flat \
	-borderwidth 0 -highlightthickness 0
    .sync tag configure centered -justify center
    pack .sync -side top -fill x
    # Disable all the usual text widget bindings
    bindtags .sync .sync

    .sync insert end $::syncText centered
    .sync config -state disabled

    #-- Button area
    frame .btn -bg $::utcbg

    #-- Menubutton to change font sizes, etc.
    menubutton .btn.size -text "Size..." -font normhelv \
	-padx [expr int($::initsize/6)+1] -pady 1 -relief raised \
	-borderwidth 1 -bg $::btnbg -fg $::btnfg \
	-menu .btn.size.menu -direction right
    set m [menu .btn.size.menu -font normhelv -tearoff 0]
    foreach size {12 15 18 24 36 48} {
	$m add command -label $size \
	    -command "font configure normfont -size -[expr int(($size+1)/2)];\
	    font configure normhelv -size -[expr int(($size+1)/2)];
	    font configure bighelv -size -$size;
	    .btn.pad1 config -width [expr int($size/2)];
	    .btn.pad2 config -width [expr int($size/2)];
	    .btn.size config -padx [expr int($size/6)];
	    .btn.conv config -padx [expr int($size/6)];
	    .btn.quit config -padx [expr int($size/6)]"
    }

    frame .btn.pad1 -height 2 -width [expr int($::initsize/2)] -bg $::utcbg

    #-- Button to pop up a Time Converter window
    button .btn.conv -text "Converter" -font normhelv \
	-padx [expr int($::initsize/6)] -pady 0 \
	-borderwidth 1 -highlightthickness 0 -bg $::btnbg -fg $::btnfg \
	-command TimeConverter

    frame .btn.pad2 -height 2 -width [expr int($::initsize/2)] -bg $::utcbg

    #-- Quit button
    button .btn.quit -text "Quit" -font normhelv \
	-padx [expr int($::initsize/6)] -pady 0 \
	-borderwidth 1 -bg $::btnbg -fg $::btnfg \
	-command {destroy .}

    pack .btn.size .btn.pad1 .btn.conv -side left
## Leave out the "Quit" button
#    pack .btn.pad2 .btn.quit -side left
    pack .btn -side top

    if 0 {
	;##----- Output area for debugging purposes
	text .out -width 10 -height 5
	pack .out -side bottom -fill x -expand true
	;##----- Eval entry for debugging purposes
	entry .eval -width 10
	bind .eval <Return> "eval \[.eval get\]"
	pack .eval -side bottom -fill x -expand true
    }

    return
}


##=========================================================================
proc UpdateClocks {} {

    ;##- Update all of the Time Converter windows
    foreach w [winfo children .] {
	if { [winfo class $w] == "Toplevel" } {
	    UpdateTimeConverter $w
	}
    }

    #-- Schedule another call to this routine
    set ::updateEvent [after 200 UpdateClocks]

    ;##- If the time is the same as before, we don't need to update the widgets
    if { ! [info exists ::lasttime] } { set ::lasttime 0 }
    if { [clock seconds] == $::lasttime } { return }
    set ::lasttime [clock seconds]

    ;##- Get the current GPS and UTC times
    set gpstime [HandleTimeString "now"]
    set utctime [clock format [GPSToSys $gpstime] \
		     -format {%b %d  %H:%M:%S UTC} -gmt 1]

    ;##- Insert spaces into GPS time for readability
    if { [string length $gpstime] == 10 } {
	set gpstime "[string range $gpstime 0 3] [string range $gpstime 4 6]\
		[string range $gpstime 7 9]"
    } else {
	set gpstime "[string range $gpstime 0 2] [string range $gpstime 3 5]\
		[string range $gpstime 6 8]"
    }

    ;##- Insert the times into the text widgets (preserving any selection)
    set curins [.gps index insert]
    set cursel [.gps tag ranges sel]
    .gps config -state normal
    .gps delete 0.0 end
    .gps insert end $gpstime centered
    .gps config -state disabled
    .gps mark set insert $curins
    if { [llength $cursel] > 0 } { eval .gps tag add sel $cursel }

    set curins [.utc index insert]
    set cursel [.utc tag ranges sel]
    .utc config -state normal
    .utc delete 0.0 end
    .utc insert end $utctime centered
    .utc config -state disabled
    .utc mark set insert $curins
    if { [llength $cursel] > 0 } { eval .utc tag add sel $cursel }

    return
}

##=========================================================================
## Name: TimeConverter
##
## Description:
##   Pops up a GUI window to convert to/from GPS time.
## 
## Usage:
##   TimeConverter
##
## Comments:

proc TimeConverter {} {

    ;##- Create a new window
    set tl [NewToplevel]
    wm title $tl "Time Converter"
    $tl configure -bg $::bgColor

    ;##- Set up widgets
    label $tl.label -text "GPS time, or any date/time string (default UTC):" \
	    -bg $::bgColor

    entry $tl.entry -width 36 -bg $::bgColor -highlightthickness 0

    label $tl.msg -text "" -foreground red -bg $::bgColor

    ;##- Frame to contain all the output stuff
    frame $tl.out -bg $::bgColor

    if { ! [regexp -nocase {(windows|macos)} $::tcl_platform(os)] } {
	set menu [tk_optionMenu $tl.out.zonemenu convertZone$tl \
		Local Central Pacific]
	$tl.out.zonemenu config -pady 0 -bg $::bgColor -highlightthickness 0
    } else {
	label $tl.out.zonemenu -text "   Local:   " -bg $::bgColor
	set ::convertZone$tl "Local"
    }
    entry $tl.out.zonedtext -width 31 -relief flat -highlightthickness 0 \
	    -state $::entrydis -bg $::bgColor
    bind $tl.out.zonedtext <Button> "focus %W"
    grid $tl.out.zonemenu $tl.out.zonedtext -sticky w

    label $tl.out.utclabel -text "     UTC:   " -bg $::bgColor
    entry $tl.out.utctext -width 31 -relief flat -highlightthickness 0 \
	    -state $::entrydis -bg $::bgColor
    bind $tl.out.utctext <Button> "focus %W"
    grid $tl.out.utclabel $tl.out.utctext -sticky w

    label $tl.out.gpslabel -text "     GPS:   " -bg $::bgColor
    entry $tl.out.gpstext -width 31 -relief flat -highlightthickness 0 \
	    -state $::entrydis -bg $::bgColor
    bind $tl.out.gpstext <Button> "focus %W"
    grid $tl.out.gpslabel $tl.out.gpstext -sticky w

    label $tl.caveat -text "" -bg $::bgColor

    frame $tl.buttons -bg $::bgColor

    button $tl.buttons.help -bg $::bgColor -text "Help" \
	    -command ShowTimeConverterHelp

    button $tl.buttons.close -bg $::bgColor -text "Close" \
	    -command "if {\[winfo exists ${tl}Icon\]} {destroy ${tl}Icon};\
	    destroy $tl"

    grid $tl.buttons.help $tl.buttons.close -padx 10 -pady 2

##    ;##- Insert "now" into the entry widget, and update fields
##    $tl.entry insert end "now"
##    $tl.entry select range 0 end
    set ::lastval$tl "INIT"
    UpdateTimeConverter $tl

    ;##- Set up a selection handler for the GPS time, to strip out spaces
    selection handle $tl.out.gpstext [list GetGPSSelection $tl.out.gpstext]

    ;##- Disable all the usual text widget bindings
    bindtags $tl.out.gpstext $tl.out.gpstext
    bind $tl.out.gpstext <Button> "$tl.out.gpstext select range 0 end"

    ;##- Bind any keystroke, or paste, to update the output fields
    bind $tl.entry <KeyRelease> "+ UpdateTimeConverter $tl"
    bind $tl.entry <<PasteSelection>> "UpdateTimeConverter $tl"
    ;##- Have to rearrange the bindtags list so that the paste (which
    ;##- is bound to the Entry class) occurs before UpdateTimeConverter!
    bindtags $tl.entry [list Entry $tl.entry $tl all]

    ;##- Set default timezone
    set ::convertZone$tl Local
    ;##- Set a callback so that the times are updated if user changes zone
    trace variable ::convertZone$tl w "UpdateTimeConverter $tl force"

    ;##- Lay out the widgets
    grid columnconfigure $tl.out 1 -weight 1

    pack $tl.label -anchor w
    pack $tl.entry -fill x -expand true
    pack $tl.msg -fill x -expand true
    pack $tl.out -fill x -expand true
    pack $tl.caveat
    pack $tl.buttons

    ;##- Set focus to the entry widget
    focus $tl.entry

    return
}


##=========================================================================
## Name: UpdateTimeConverter
##
## Description:
##   Updates the output fields in a TimeConverter window
## 
## Usage:
##   UpdateTimeConverter tl [force]
##
## Arguments:
##   tl -- Toplevel Tk widget, containing widgets to be updated
##   mode -- Equal to "looping" if this was called by an after event,
##             or equal to "::convertZone$tl" if from the user selecting
##             a new time zone from the pulldown menu
##   ignore1, ignore2 -- Dummy arguments (present when this routine
##             is called as the result of a variable trace)
##
## Comments:

proc UpdateTimeConverter { tl {mode ""} args } {

    ;##- Delete any pending 'after' event for looping
    if { [info exists ::looping$tl] } {
	after cancel [set ::looping$tl]
	unset ::looping$tl
    }

    ;##- Get the contents of the entry widget
    if {[catch {$tl.entry get} instring]} {
	;##- Widget no longer exists, so just return
	return
    }
    set instring [string trim $instring]

    ;##- If this is a date/time string, convert it to a GPS time
    if { [catch {HandleTimeString $instring} gpsstring] } {
	set newmsg $gpsstring
	set gps ""
    } elseif { [regexp {^[\d\+\-\*]+$} $instring] } {
	;##- This is an integer arithmetic expression, so interpret as GPS
	if { [catch {expr $instring} gps] || ! [string is integer $gps] } {
	    set gps ""
	}
	set newmsg ""
    } else {
	set gps $gpsstring
	set newmsg ""
    }

    ;##- If the GPS time is the same as before, we don't have to update
    ;##- (unless "force" was specified)
    if { ! [string equal $gpsstring [set ::lastval$tl]] || $mode == "force" } {

	set ::lastval$tl $gpsstring

	set zoned ""
	set utc ""
	if { ! [catch {GPSToSys $gps} systime] } {

	    if {[info exists ::env(TZ)]} {
		set saveZone $::env(TZ)
	    } else {
		set saveZone ""
	    }

	    set tzChanged 0
	    switch [set ::convertZone$tl] {
		"Central" { set ::env(TZ) "CST6CDT" ; set tzChanged 1 }
		"Pacific" { set ::env(TZ) "PST8PDT" ; set tzChanged 1 }
	    }

	    if { [ catch {clock format $systime \
		    -format {%b %d, %Y  %H:%M:%S %Z} } zoned ] } {
		set zoned ""
	    }

	    ;##- Abbreviate verbose timezones
	    regsub {([A-Z])[a-z]+ (?:(S)tandard|(D)aylight) Time} $zoned \
		    {\1\2T} zoned

	    if { [ catch {clock format $systime \
		    -format {%b %d, %Y  %H:%M:%S UTC} -gmt 1} utc ] } {
		set utc ""
	    }

	    if { $tzChanged } {
		;##- Restore the original time zone
		if { $saveZone != "" } {
		    set ::env(TZ) $saveZone
		} else {
		    unset ::env(TZ)
		}
	    }

	}

	catch {
	    $tl.msg config -text $newmsg
	    if { [regexp {now} $instring] && ! [string is space $utc] } {
		$tl.caveat config -text "$::syncText"
	    } else {
		$tl.caveat config -text ""
	    }

	    $tl.out.zonedtext config -state normal
	    $tl.out.zonedtext delete 0 end
	    $tl.out.zonedtext insert end $zoned
	    $tl.out.zonedtext config -state $::entrydis

	    $tl.out.utctext config -state normal
	    $tl.out.utctext delete 0 end
	    $tl.out.utctext insert end $utc
	    $tl.out.utctext config -state $::entrydis

	    ;##- Insert spaces into GPS time for readability
	    if { [string length $gps] == 10 } {
		set gps "[string range $gps 0 3] [string range $gps 4 6]\
			[string range $gps 7 9]"
	    } else {
		set gps "[string range $gps 0 2] [string range $gps 3 5]\
			[string range $gps 6 8]"
	    }

	    set selected [$tl.out.gpstext select present]
	    $tl.out.gpstext config -state normal
	    $tl.out.gpstext delete 0 end
	    $tl.out.gpstext insert end $gps
	    $tl.out.gpstext config -state $::entrydis
	    if { $selected } { $tl.out.gpstext select range 0 end }
	}

    }

## Commented out for gpsclock
#    ;##- If instring begins with "now", schedule this to be called again
#    if { [regexp -nocase {now} $instring] } {
#	set ::looping$tl [after 330 "UpdateTimeConverter $tl loop"]
#    }

    return
}


##=========================================================================
## Name: HandleTimeString
##
## Description:
##   Routine to check if the value specified for a numeric variable is really
##   a Tcl date-time string.
##   Returns the converted value (or the original value, if it was already
##   a number).
## 
## Parameters:
##   value -- value to be checked
##
## Usage:
##   HandleTimeString value
##

proc HandleTimeString { value } {

    set value [string trim $value]

    ;##- If input string begins with a date/time and ends with a relative
    ;##- number, assume it is a number of seconds
    if { [regexp {[^\d\s\+\-\*/].*[+-]\s*[\d\*]+$} $value] } {
	append value "sec"
    }

    ;##- If it just ends with "s", also assume this is seconds
    if { [regexp {[^\d\s\+\-\*/].*[+-]\s*[\d\*]+\s*s\s*$} $value] } {
	set value [string trim $value]
	append value "ec"
    }

    ;##- Adjust for "now", using synchronization
    if { [regexp -nocase {now} $value] } {
	append value $::syncOff
    }

    if { [catch {tconvert $value -format "%b %d %Y %T %Z"} result] } {
	return -code error $result
    }

    return $result
}


##=========================================================================
## Name: GetGPSSelection
##

proc GetGPSSelection { w offset maxbytes } {
##    puts "In GetGPSSelection with $w $offset $maxbytes"
    if { [winfo class $w] == "Text" } {
	set text [$w get sel.first sel.last]
    } else {
	set text [$w get]
    }
    regsub -all {\s} $text {} text
    return $text
}


##=========================================================================
## Name: ShowTimeConverterHelp
##
## Description:
##   Pop up the help window related to building database queries.
##
## Usage:
##   ShowTimeConverterHelp
##
## Comments:
##   Called when the user presses the "Help" button at the bottom of a
##   Time Converter window.

proc ShowTimeConverterHelp {} {

    ;##- If window already exists, bring it forward
    if {[winfo exists .timehelp]} {
	switch -- [wm state .timehelp] {
	    normal { raise .timehelp; focus .timehelp }
	    withdrawn -
	    iconic { wm deiconify .timehelp; focus .timehelp }
	}
    } else {
	;##- Create a new window
	set tl [NewToplevel .timehelp]
	wm title $tl "Help on using the Time Converter"
	wm iconname $tl "Metadata queries"

	;##- Create a frame with a text widget and a scrollbar
	frame $tl.msg
	text $tl.msg.text -width 76 -height 16 -wrap word \
		-yscrollcommand "$tl.msg.yscroll set" -setgrid true
	bind $tl.msg.text <Button> "focus %W"
	scrollbar $tl.msg.yscroll -orient vertical \
		-command "$tl.msg.text yview"

	;##- Set up at tag to center the title
	$tl.msg.text tag configure centered -justify center

	;##- Insert the title into the text widget
	$tl.msg.text insert end "\nHow to use the Time Converter\n" centered

	;##- Insert the message into the text widget
	$tl.msg.text insert end {
Simply type a time expression into the entry widget, and see the conversion. \
Times may be specified in GPS seconds, e.g. "674029387", or as an integer arithmetic expression\
giving GPS seconds, such as "630454213-21*60*60". \
Times may also be specified as nearly any unambiguous date-time string,\
such as "jan 1 2001" (midnight at the beginning of January 1 in the year\
2001), "Jan 15 5:04" (5:04 on January 15 of the current year),\
"1/19/01 5:15", "19-jan-2001 18:45 cst", "today 3:24pm pdt",\
"now", "now-1000sec", "NOW -1hour", "now - 3 days", etc. \
Times are assumed to be UTC unless you specify a time zone.
	}

	;##- Disable modifications to the text widget
	$tl.msg.text config -state disabled

	;##- Create a "Close" button
	button $tl.close -text "Close" -command "wm withdraw $tl" \
		-default active

	;##- Bind the Return key to the Close button
	bind $tl <Return> "$tl.close invoke"

	;##- Lay out the widgets
	pack $tl.close -side bottom
	grid $tl.msg.text $tl.msg.yscroll -sticky news
	grid rowconfigure $tl.msg 0 -weight 1
	grid columnconfigure $tl.msg 0 -weight 1
	pack $tl.msg -side top -fill both -expand true
    }

    return
}


##=========================================================================
## Name: NewToplevel
##

proc NewToplevel { {name ""} args } {

    ;##- If the "-icon" switch was specified, strip it out of the argument
    ;##- list (since it's not a valid argument to the Tk toplevel command)
    set iicon [lsearch -exact $args "-icon"]
    if { $iicon > -1 } {
	set args [lreplace $args $iicon $iicon]
    }

    if { $name == "." } {
	set tl "."
    } else {

	if { $name == "" } {
	    ;##- Choose a unique name, using a counter
	    if { ! [info exists ::toplevelCounter] } {
		;##- Initialize counter for constructing toplevel window names
		set ::toplevelCounter 0
	    }
	    incr ::toplevelCounter
	    set name ".tl$::toplevelCounter"
	}

	set tl [eval toplevel $name $args]

    }

    ;##- If we're dealing with an icon, just return now
    if { $iicon > -1 } { return }

    ;##- Add this window name to the stack
    if { ! [info exists ::windowStack] } { set ::windowStack {} }
    lappend ::windowStack $name

    ;##- Set up bindings to keep track of the stacking order
    bind $tl <FocusIn> [ selsub {
	if { "%W" == "$tl" } {
	    set i [lsearch -exact $::windowStack $tl]
	    if { $i > -1 } {
		set ::windowStack [concat [lreplace $::windowStack $i $i] $tl]
	    }

	    if {[info exists ::errorWindow] && [winfo exists $::errorWindow]} {
		switch -- [wm state $::errorWindow] {
		    normal { raise $::errorWindow; focus $::errorWindow }
		    withdrawn -
		    iconic {wm deiconify $::errorWindow; focus $::errorWindow}
		}		
	    }

	}
    } tl ]

    bind $tl <Destroy> [ selsub {
	if { "%W" == "$tl" } {
	    set i [lsearch -exact $::windowStack $tl]
	    if { $i > 0 } {
		set ::windowStack [lreplace $::windowStack $i $i]
	    }

	    if { [info exists ::errorWindow] && "%W" == $::errorWindow } {
		unset ::errorWindow
	    }
	}
    } tl ]

    return $tl
}


##=========================================================================
## Name: bgerror
##
## Description:
##   Customized version of the standard Tk bgerror routine.
##
## Usage:
##   bgerror err
##
## Comments:
##   Requests email.

proc bgerror { err } {
    global errorInfo
    
    ;##- Be sure to release any grabs that might be present on the screen
    if {[string compare [grab current .] ""]} {
        grab release [grab current .]
    }

    ;##- Assemble the message
    if { [string is space $errorInfo] } {
	set msg "An unexpected Tcl/Tk error has occurred.\nPlease send email\
		to shawhan_p@ligo.caltech.edu describing the circumstances,\
		and include the error message below.  Thank you!\n\n$err"
    } else {
	set msg "An unexpected Tcl/Tk error has occurred.\nPlease send email\
		to shawhan_p@ligo.caltech.edu describing the circumstances,\
		and include the stack trace below.  Thank you!\n\n$errorInfo"
    }

    ;##- Put up the dialog box
    BigMessageBox -icon warning -title "Tcl/Tk Error" -message $msg -grab 1
    return
}


##=========================================================================
## Name: selsub
##
## Description:
##   Utility routine to do selective substitution of variables in a string
##   and return the string thus modified.
##
## Parameters:
##   text -- original string
##   args -- variable(s) to be substituted
##
## Usage:
##   selsub text var1 var2 ...
##
## Comments:
##   I wrote this routine to avoid having big chunks of highly backslashed
##   code between double quotes.  These generally arose when I was defining
##   a command associated with a button or a key binding, and I needed one
##   or a few variables to be evaluated when the command was defined, and
##   others to be evaluated when it was run.  (Yes, I know, I could define
##   a separate proc and pass the promptly-evaluated values as arguments,
##   but I generally like to keep the code with the button definition so
##   it's clear what the button does.)  Anyway, this routine lets me put
##   the command in braces (so I don't have to escape stuff inside) and
##   then explicitly specify which variables I want evaluated.  It only
##   does scalars, and does not do any command substitution.
##
## selsub is essentially the same as "subst -nobackslashes -nocommands",
## except that you can specify which variables you want to substitute.
## With "subst", it is all-or-none.
##
## The regular expression below is highly backslashed because we need $sub
## to be evaluated; it becomes:
##   ((\A|[^\\]))\$<subval>(?!\w)
## as seen by regsub.
##
## WARNING: The character sequences & and \n (where n is a number) are
## treated specially by regsub.  Therefore, do not use selsub when the
## variable value being substituted in contains one of these.

proc selsub { text args } {
    foreach sub $args {
	upvar 1 $sub var
	if {[info exists var]} {
	    regsub -all -- "\(\(\\A|\[^\\\\\]\)\)\\$$sub\(?!\\w\)" \
		    $text \\1$var text
	}
    }
    return $text
}


##=========================================================================
## Now call the Main routine

Main
