Tk Dual Zone Clock

Tk Dual Zone Clock is a minimal dual zone clock written for practice by a novice. Improvements are welcome!

Change Log

PYK 2013-09-30: significant rewrite. Code now uses knowledge of clock.tcl internals to derive a list of timezone names. dualclock is now a widget that can be instantiated multiple times

Description

Anyone who wants to use this code in any manner whatsoever, is welcome to it. Most of the code for the clocks was found doing a search on comp.lang.tcl. I just changed the format a little.

It is easily possible to use other time zones, but I wish I could figure out a way to do this using time zone mnemonics and/or military time zones. Any suggestions? so

DKF 2000-06-12: Up to (and including) 8.3 at least, you'd need to perform the timezone adjustment yourself. However, you can use [clock scan] (on most platforms at least) to help you get the offset:

proc getClockOffset {timezone} {
    # Do it this way to avoid UNIXism assumption...
    set epoch [clock format 0 -format "%b %d %Z %H:%M:%S %Y" -timezone :UTC]
    regsub GMT $epoch $timezone datestring
    return [expr {-[clock scan $datestring]}]
}

This should help you convert timezones (including the military designations, IIRC) into offsets so you can format the date correctly. The only awkward bit is getting a list of timezones that the code supports, and I'm afraid that you might need to delve into the source code for that (there are some interesting clashes in there!)

(Note that I specify the format because on some platforms the usual output of [clock format] can't be understood by [clock scan], and the format is needed to avoid hard-coding in the assumption that the epoch begins with 1970, as this might not hold on all platforms...)

Your task, should you choose to accept it, is to combine this code into the preceding code to create a more internationally-aware application...

Code

#! /bin/env tclsh

package require Tk 8.6

namespace eval dualclock {
    namespace export create
    namespace ensemble create

    proc create {{w {}}} {
        variable state
        variable timezones
        if {$w == {.}} {
            set parent {}
        }
        namespace eval [set id [info cmdcount]] {}
        foreach varname {local_tz other_tz local_time other_date updaterunning} {
            variable ${id}::$varname
        }
        set updaterunning 0
        set ${id}::w $w

        set now [clock scan now]
        #synchronize with the system clock so that the [after] fires task approximately on the second
        while {[clock scan now] eq $now} {}
        after idle [list after 0 [list [namespace current]::update_time $id]]

        set column -1
        foreach clock {local other} {
            entry $w.${clock}_date -state readonly \
                -textvariable [namespace current]::${id}::${clock}_date
            entry $w.${clock}_time -state readonly \
                -textvariable [namespace current]::${id}::${clock}_time
            ::ttk::combobox $w.${clock}_tz -state readonly -values [dict keys $timezones] \
                -textvariable [namespace current]::${id}::${clock}_tz
            set ${clock}_tz [clock format 0 -format %Z]
            bind $w.${clock}_tz <<ComboboxSelected>> [list [namespace current]::update_time $id]

            $w.${clock}_date configure -width -1 -justify center
            $w.${clock}_time configure -width -1 -justify center

            incr column
            grid $w.${clock}_date -row 1 -column $column -columnspan 1
            grid $w.${clock}_time -row 2 -column $column -columnspan 1
            grid $w.${clock}_tz -row 0 -column $column -columnspan 1
        }
    }

    proc update_time {id args} {
        variable tzoffsets
        foreach varname {local_date local_time local_tz other_date other_time other_tz w updaterunning} {
            variable ${id}::$varname
        }
        if {$updaterunning} return
        set updaterunning 1
        set now [clock scan now]
        foreach clock {local other} {
            set ${clock}_date [clock format $now -timezone [set ${clock}_tz] -format {%A %B %d, %Y}]
            set ${clock}_time [clock format $now -timezone [set ${clock}_tz] -format {%I:%M:%S %p}]
        }
        set updaterunning 0
        after 1000 [list after idle [list [namespace current]::update_time $id]]
    }

    proc tzoffsets {varname} {
        upvar $varname var
        #this is only here to initialize the ::tcl::clock subsystem
        clock format 0 -timezone :UTC
        foreach searchdir [list {*}$::tcl::clock::ZoneinfoPaths $::tcl::clock::DataDir] {
            set dirpaths [glob -nocomplain -type d -directory $searchdir *]
            while {[llength $dirpaths]} {
                set dirpaths [lassign $dirpaths dirpath]
                lappend dirpaths {*}[glob -nocomplain -type d -directory $dirpath *]
                foreach tzpath [glob -nocomplain -type f -directory $dirpath *] {
                    set tzpath [string range $tzpath [string length $searchdir]+1 end]
                    expr {[catch {
                        ::tcl::clock::LoadTimeZoneFile $tzpath
                    }] && [catch {
                        ::tcl::clock::LoadZoneinfoFile $tzpath
                    }]}
                }
            }
        }
        set var [lsort [array names ::tcl::clock::TZData]]
        set var [lmap zonename $var {string range $zonename 1 end}]
        foreach tz $var[set var {}] {
            if {[catch {set offset [clock format 0 -timezone :$tz -format %z]} eres eopts]} {
            } else {
                dict set var $tz $offset 
            }
        }
        return $var
    }

    variable timezones
    tzoffsets timezones
}


proc main {} {
    tk appname {Dual Clock}
    #wm withdraw .
    set w .[info cmdcount]

    frame $w
    grid $w
    dualclock create $w
}

main

Category Tutorial

Category TK

clock