TCL Clock script

[Moderator Brian Masinick]

Here is another script; this one is written in TCL, includes the latest Tk library, which uses the “wish” extensions.
I did not write this script; I believe in reusing code where possible, citing the original source.
Without further delay, here is a script I found that provides dual clocks:

#! /bin/env tclsh
# Copied from https://wiki.tcl-lang.org/page/Tk+Dual+Zone+Clock
# by Brian Masinick on June 15, 2022
# This is a dual clock, where you can look at two clocks in different time zones,
# display two visual clocks, or shrink the display to only show a single clock.

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 
::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>> 
::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 
::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 
 {
            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

--
Brian Masinick

[Moderator Brian Masinick]

Helpful

Up

0

::

I decided to make another modified version of clock.tcl, so I took the original code, took out the “other” instance, leaving the “local” instance, and I got the changes right on my first attempt, so I actually was able to understand the code, (at least to some extent) enough to create this version, also citing https://wiki.tcl-lang.org/page/Tk+Dual+Zone+Clock as my source.

#! /bin/env tclsh
# Copied from https://wiki.tcl-lang.org/page/Tk+Dual+Zone+Clock
# by Brian Masinick on June 15, 2022
# This was a dual clock, where you can look at two clocks in different time zones.
# I modified the original script to display a single clock, which can be easily
# set to different timezones around the world.

package require Tk 8.6

namespace eval myclock {
    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 local_time 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 
::update_time $id]]

        set column -1
        foreach clock {local} {
            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>> 
::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 w updaterunning} {
            variable ${id}::$varname
        }
        if {$updaterunning} return
        set updaterunning 1
        set now [clock scan now]
        foreach clock {local} {
            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 
::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 
 {
            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 {Clock}
    #wm withdraw .
    set w .[info cmdcount]

    frame $w
    grid $w
    myclock create $w
}

main

--
Brian Masinick

[Moderator Brian Masinick]

Helpful

Up

0

::

The one thing this script does not EXPLICITLY specify is the color scheme; that is picked up (by default) from the combination of .Xdefault, .Xresources and any other resource files that DO specify color. You CAN override color explicitly by setting it in the program or the command line arguments, either of which will override configuration resource files.

I’ll explore this further too, but I may not get to it today.

How I discovered this (and remembered the order of presidence) is that I ran it on two different systems with different color scheme settings and got a much different visual appearance from the same exact script.

--
Brian Masinick

[Moderator Brian Masinick]

Helpful

Up

0

::

On both of the scripts above, please note the lines that have the ::update_time $id]]

These should all be included in the line that has
after 1000

::update_time $id]]
or similar statements.

--
Brian Masinick

[Moderator Brian Masinick]

Helpful

Up

0

::

Even my updated note formats the string; apparently the two “:” cause formatting here, even with code quotation in place.
If you try out the scripts, make sure to put those lines together with their preceding lines.
To get the original code, visit https://wiki.tcl-lang.org/page/Tk+Dual+Zone+Clock

--
Brian Masinick

[Author]

Posts