A small application written for a friend who wanted to see the seconds remaining until his contract finished. Posted here because it (nearly) answers a question on the Date and Time Issues page. MNO
#!/bin/sh
# the next line restarts with wish \
exec wish $0 ${1+"$@"}
#
###############################################################################
#
# **************************
# *** tunable parameters ***
# **************************
#
# interval specifies how often to update the time displayed (i.e. what units
# we are counting down in) units: ms (100 = tenths of second etc.)
#
set interval 10 ;# specified in milliseconds
#
# resync interval is how often we correct the timer back to real clock
# seconds. It is specified in seconds. The default is every 15 seconds...
#
set resync 15 ;# seconds
#
# endtime can also be any date understood by tcl's [clock scan] command
# e.g. "25 December 2001 08:00"
#
set endtime "17:30" ;# anthing understood by Tcl's [clock scan] command
#
# tickerfont is the font used for the counter (duh!)
#
set tickerfont [list Courier 18]
#
# counteronly=1 will cause the start button and entry field to disappear once
# countdown has started
#
set counteronly 1
#
# nodecorations=1 will cause the window manager decorations to disappear once
# countdown has been started, set to 0 to keep the decorations.
#
set nodecorations 1
#
# *********************************
# *** end of tunable parameters ***
# *********************************
#
###############################################################################
#
# drag handle code - allow a window with no decoration to be moved
#
array set __dragdata {}
proc init_drag { wd x y } {
global __dragdata
set w [winfo toplevel $wd]
set __dragdata($w,x) $x
set __dragdata($w,y) $y
}
proc do_drag { wd x y } {
global __dragdata
set w [winfo toplevel $wd]
if { ! [info exists __dragdata($w,x)] } {
init_drag $wd $x $y
}
set dx [expr $x - $__dragdata($w,x)]
set dy [expr $y - $__dragdata($w,y)]
regexp {([0-9]+)x([0-9]+)([-+][0-9]+)([-+][0-9]+)} \
[wm geometry $w] junk ox oy gx gy
set ngx [expr $gx + $dx]
if [string match {[0-9]*} $ngx] {
set ngx "+${ngx}"
}
set ngy [expr $gy + $dy]
if [string match {[0-9]*} $ngy] {
set ngy "+${ngy}"
}
wm geometry $w ${ox}x${oy}${ngx}${ngy}
update idletasks
}
proc end_drag { wd } {
global __dragdata
set w [winfo toplevel $wd]
catch {unset __dragdata($w,x)}
catch {unset __dragdata($w,y)}
}
# make_drag handle makes a given widget w into a drag handle for its toplevel
# i.e. an area that can be used to move the window around if e.g. it doesn't
# have Window Manager Decorations.
#
proc make_drag_handle { w } {
bind $w <ButtonPress-1> +[list init_drag %W %x %y]
bind $w <B1-Motion> +[list do_drag %W %x %y]
bind $w <ButtonRelease-1> +[list end_drag %W]
}
#
###############################################################################
#
#
proc maybeRaise { w state } {
switch -exact $state {
"VisibilityFullyObscured" { raise $w ; update }
"VisibilityPartiallyObscured" { raise $w ; update}
}
}
#
###############################################################################
# 999999999 is j.random.value for initial display (gets reset once
# the start button is pressed)
set tleft 999999999
#
bind . <Visibility> +[list maybeRaise . %s]
frame .t
label .t.x -font $tickerfont -text " " -relief raised -borderwidth 2
label .t.l -font $tickerfont -textvariable tleft -relief groove -borderwidth 2
pack .t.l .t.x -side right
bind .t.l <ButtonRelease-1> +startStop
make_drag_handle .t.x
pack .t
# build the gui
frame .f
entry .f.e -textvariable endtime
set running 0
button .f.s -text "Start" -command startStop
pack .f.e .f.s -side right
#
pack .f
#
# set and start the clock, or stop it
proc startStop {} {
global running endtime interval tleft nodecorations counteronly
set running [expr 1 - $running]
if { $running == 0 } {
.f.s configure -text "Start"
.f.e configure -state normal
if $counteronly {
pack .f
}
if $nodecorations {
wm overrideredirect . 0
wm withdraw .
wm deiconify .
update
}
raise .
update
} else {
.f.s configure -text "Stop"
.f.e configure -state disabled
if $counteronly {
pack forget .f
}
if $nodecorations {
wm overrideredirect . 1
wm withdraw .
wm deiconify .
update
}
raise .
update
}
if { $running } {
set tleft [expr ( [clock scan $endtime] - [clock seconds] ) \ doUpdate
doResync
}
}
# update the clock and register anpother update event...
proc doUpdate {} {
global interval running tleft
incr tleft -1
if { $running == 0 } {
return
}
if { $tleft > 0 } {
after $interval doUpdate
} else {
startStop
return
}
}
# resync the clock and schedule another resync event
proc doResync {} {
global resync interval running tleft endtime
if { $running == 0 } {
return
}
set tleft [expr ( [clock scan $endtime] - [clock seconds] ) \after [expr $resync * 1000] doResync }