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]


[LV] What would be appropriate for improvements - add them in place, 
or create a new page? 

[MNO] In place would be best - there is plenty of scope for improvement!


----
======
 #!/bin/sh
 # the next line restarts with wish \
        exec tclsh $0 ${1+"$@"}

 # Original Author: [MNO] at http://wiki.tcl.tk/ 
 # Update Author: [LV]
 # Version 2 - a series of small nits clarified

 package require Tk
 #
 ###############################################################################
 #
 # **************************
 # *** tunable parameters ***
 # **************************

 # It would be nice if these were in the option database and if command line
 # arguments were parsed and processed as well

 #
 # 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. "15 August 2003"
 #
 set endtime "Jan 18, 2038 22:14" ;# anything understood by Tcl's [clock scan] command
 #
 # tickerfont is the font used for the counter (duh!)
 #
 set tickerfont [font create -family Courier -size 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 } {
     set w [winfo toplevel $wd]
     set ::__dragdata($w,x) $x
     set ::__dragdata($w,y) $y
 }
 
 proc do_drag { wd x y } {
     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 } {
     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}
        default { ; }
     }
 }
 #
 ###############################################################################
 # 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] ) * \
                ( 1000 / $interval ) } ]
        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] ) * \
            ( 1000 / $interval ) } ]
     after [expr { $resync * 1000 } ] doResync
 }
======

<<categories>> Application | Date and Time