if {[package vcompare [package provide Tcl] 8] < 0} {
# There is a bug in [clock format] (fixed in Tcl 7.6p2) which causes it
# to fail if the value of the -format option does not contain a '%'.
rename clock Tcl7.6_clock
;proc clock {option args} {
switch -glob -- $option {
f* {
if {[string first $option format] != 0} {
return [uplevel [list Tcl7.6_clock $option] $args]
}
array set tmp [lrange $args 1 end]
if {[catch {regexp % $tmp(-format)} hasPercent] || $hasPercent} {
return [uplevel [list Tcl7.6_clock $option] $args]
} else {
return $tmp(-format)
}
}
default {
uplevel [list Tcl7.6_clock $option] $args
}
}
}
}Is there a Tcl-only implementation of 'clock' (or at least 'clock scan') which could be used in an old Tcl 7.x interpreter which doesn't have it?Tcl 7.5 does have clock. Can you upgrade to at least that?Before that, I believe there was a command in TclX from which clock was derived. You could look around for an old version of TclX to match your old version of Tcl and try your luck, I guess.Unfortunately this is for the editor Alpha which is stuck with Tcl 7.4 (more or less) and no 'load' command. We are working on a newer 8.3.x release for Alpha, but that's not stable enough to unleash yet, BUT I'd like to write code which uses 'clock' and will work in that old version of Alpha as well --- the ideal demand for something like forwards compatibility! Anyway, I took the plunge and:
proc clock {cmd args} {
switch -- $cmd {
"clicks" {
# clock clicks ?-milliseconds?
if {[llength $args] > 0} {
return -code error "milliseconds granularity not\
possible in Alpha 7"
}
return [ticks]
}
"format" {
# clock format clockValue ?-format string? ?-gmt boolean?
if {[llength $args] == 0} { error "Not enough args" }
if {[llength $args] > 1} {
return -code error "Other arguments to clock\
format not supported"
}
set val [lindex $args 0]
#aclock_debug $val
# internal Alpha command...
return [mtime $val]
}
"scan" {
# clock scan dateString ?-base clockVal? ?-gmt boolean?
if {[llength $args] == 0} { error "Not enough args" }
if {[llength $args] > 1} {
return -code error "Other arguments to clock\
scan not supported"
}
set dateString [lindex $args 0]
# make things easy on ourselves!
regsub -all "\[ \t]+" [string trim $dateString] " " dateString
set timeRegexp {([0-9][0-9]?):([0-9][0-9]?)(:([0-9][0-9]))?}
if {[regexp $timeRegexp $dateString time]} {
regsub $timeRegexp $dateString "" dateString
}
set ampmRegexp {(am|pm|AM|PM)}
if {[regexp $ampmRegexp $dateString ampm]} {
regsub $ampmRegexp $dateString "" dateString
}
set dateRegexp1 {([0-9][0-9]?)/([0-9][0-9]?)/([0-9][0-9][0-9]?[0-9]?)}
set dateVars1 [list month day year]
set dateRegexp2 {(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[a-z]+ ([0-3][0-9]),? ([0-9]+)}
set dateVars2 [list month day year]
set dateRegexp3 {([0-3][0-9]) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[a-z]+ ([0-9]+)}
set dateVars3 [list day month year]
foreach try {1 2 3} {
set dReg [set dateRegexp$try]
set dVars [set dateVars$try]
if {[regexp -nocase [set dReg] $dateString date]} {
regsub [set dReg] $dateString "" dateString
eval [list regexp [set dReg] $date ""] $dVars
break
}
}
# STEP 1: Find number of seconds since beginning of day
regexp $timeRegexp $time "" t1 t2 "" t3
# If no seconds are given, assume 0, trim leading
# zeros to avoid errors with octal number interpretations.
foreach var {t1 t2 t3} {
set $var [string trimleft [set $var] "0"]
if {![string length [set $var]]} {
set $var 0
}
}
if {[info exists ampm]} {
# Add 12 hours if its a pm time
if {[string tolower [string index $ampm 0]] == "p"} {
if {$t1 < 12} {
incr t1 12
}
}
}
set secondsSinceBeginningOfDay [expr {$t3 + 60 * ($t2 + 60 * $t1)}]
# STEP 2: Find number of days since beginning of computer-time.
# Computer time starts at 01/01/1970 (on Windows anyway), is
# this the correct value for MacOS?
# Convert month to integer if required
if {[regexp {[A-Z]+} $month]} {
set month [string tolower $month]
set month [lindex {xxx jan feb mar apr may jun jul aug sep oct nov dec} $month]
}
# Fix leading zeros
foreach var {day month year} {
set $var [string trimleft [set $var] "0"]
if {![string length [set $var]]} {
set $var 0
}
}
# Deal with two digit years
if {$year < 100} {
if {$year < 69} { incr year 2000 } else { incr year 1900 }
}
set years [expr {$year - 1970}]
# Number of leapyears up to Jan 1st of the given year
set leapyears [expr {($years + 1)/4}]
set nonleapyears [expr {$years - $leapyears}]
set daysSinceBot [expr {$leapyears * 366 + $nonleapyears * 365}]
incr daysSinceBot [lindex {0 0 31 59 90 120 151 181 212 243 273 304 334 365} $month]
# If leap year and after Feb, add a day
if {($year % 4) == 0} {
if {$month > 2} {
incr daysSinceBot
#puts "extra day"
}
}
set offset 0
puts "$month $day $year $t1 $t2 $t3, leapyears: $leapyears"
# Daylight Saving Time begins in the US at 2 a.m.
# on the first Sunday of April (see chart below). Time
# reverts to standard time at 2 a.m. on the last Sunday of
# October.
#
# Other parts of the world observe Daylight Saving Time as
# well. While European nations have been taking advantage
# of the time change for decades, in 1996 the European
# Union (EU) standardized a EU-wide "summertime period."
# The EU version of Daylight Saving Time runs from the last
# Sunday in March through the last Sunday in October.
# During the summer, Russia's clocks are two hours ahead of
# standard time. During the winter, all 11 of the Russian
# time zones are an hour ahead of standard time. During
# the summer months, Russian clocks are advanced another
# hour ahead. With their high latitude, the two hours of
# Daylight Saving Time really helps to save daylight. In
# the southern hemisphere where summer comes in December,
# Daylight Saving Time is observed from October to March.
# Equatorial and tropical countries (lower latitudes) don't
# observe Daylight Saving Time since the daylight hours are
# similar during every season, so there's no advantage to
# moving clocks forward during the summer.
#
# Daylight savings: THIS IS WRONG BUT IT WORKS FOR MOST DATES!
#
# In the USA it fails between the April 1 and the first sunday, and
# between the last Sunday in October and the end of October.
if {$month >= 4 && $month < 11} {
set offset -3600
}
incr daysSinceBot [expr {$day -1}]
if {$secondsSinceBeginningOfDay > 86400} {
return -code error "Internal error $secondsSinceBeginningOfDay is too big!"
}
set totalSeconds [expr {$daysSinceBot * 24 * 60 * 60 + $secondsSinceBeginningOfDay + $offset}]
#puts [list [lindex $args 0] $date $time $ampm]
#puts [list $secondsSinceBeginningOfDay $daysSinceBot $totalSeconds]
#aclock_debug $totalSeconds
return $totalSeconds
}
"seconds" {
if {[llength $args] > 0} {
return -code error "Too many args"
}
return [now]
}
default {
return -code error "bad option \"cmd\" to clock"
}
}
}