Version 20 of clock.tcl

Updated 2005-09-13 21:40:18

# clock.tcl

 proc every {ms body} {
    eval $body
    after $ms [list every $ms $body]
 }
 pack [label .l -textvar time -font {Tahoma 24}]
 pack [button .b -text X -command exit]
 every 1000 {set ::time [clock format [clock sec] -format %H:%M:%S]}

LV It probably would be best for whoever added the above to add a name and a EULA type statement indicating the code is allowed to be reused. - RS: I put it here in order to test whether pages with .tcl titles are still delivered as plain text (they aren't), and trying to have my XDA execute it somehow - but it didn't work :( And re licensing: doesn't Who owns the content of this Wiki tell it clearly enough?

Well, it certainly sets a general expectation. However, applications having the licensing spelled out explicitly ensures there is no confusion when the application is reaped from the wiki into a distribution.


EKB Here's a version that has a task timer as well as a clock. It lacks the elegant simplicity of the code above, but it adds some functionality that I was looking for. It's also set to be always on top, at least on Windows.

I've updated this with a new and improved version (July 25, 2005). I've actually ended up using it a lot for keeping track of my billed time. Here's what it looks like:

http://www.kb-creative.net/screenshots/Timer.gif

 ######################################################
 ##
 ## Always on top, no resize
 ##
 ######################################################
 wm attributes . -topmost 1
 wm resizable . 0 0

 ######################################################
 ##
 ## Buttons
 ##
 ######################################################
 image create photo resetclock16 -data {
   R0lGODlhEAAQAIYAAPwCBDzSdDzGdGTWlETOfEzSfGTKjFzOhFTOhFzSjEzS
   hJz2vCyqXHTWlPT+/NT65MT23Lz21KzyxKTuvIzmrDS+bCSiVHzapITytHzy
   rFzulEzmjETafDTCbDSyZCyuXBR+PHTWnMz65HTupGTunFTmjDzafETOdBSC
   RARCHHzipLz61CSaVByOTAx2PCSmVAQ6HJTyvKz6zDyGXAQKBAQeDAxmLCx2
   TEzGfBSGRAQqFARWLByGPBxuNMTu1HzGlITipFS6fGzWlByWTAxSJFy6hFTW
   hDzKdCSeVByKRBx6PBx2PAxeNAReLARKJARGHAQiDAAAAAAAAAAAAAAAAAAA
   AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
   AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
   AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA
   LAAAAAAQABAAAAe1gACCg4MBhIeIAgOHBAUGBwcICQUICgsMhA0ODw8QERIT
   FBQNFRaDFw8YGRkaGxwBHR4eHyCCISIjJCUbJicVHgwMKCmCKiskHSwtKCgu
   Li8oMIMxMiYGMzSCNc42LjeDFDgUOTWCOjs2PCg9gj4/QCZBQgUFpRZDNkSC
   RUABAkYFcPzyYIGHDWIAUjA4UgrJkCQolLhYwgRhQgs5bNhownGHxyZOCD1x
   UQ6RyRRQTKpcOchPIAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJz
   aW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVz
   ZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
 }



 image create photo appclock16 -data {
   R0lGODlhEAAQAIUAAPwCBHy+/HS6/Gy2/ITC/Pz+/Fyu/FSm/Pz6/ESW7Pzm
   hPzqnPzurOz2/OTu/PzmjPzqpAR2/PzyxPz2xPz2zEye9NTm/ARy/Pz21Mzi
   /Lza/DyK3PzutPzyvPzyzPz63Pz67DyO5KzS/Pz23KTO/DSC1DSC3JzK/CR6
   zPz+9Iy+/FSq/IS6/BxyxPT2/Hy2/HSy/MTe/Gyu/CRyxJTG/IS+/DSG1AAA
   AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaz
   QIBQGAgIBIPBcAkgBArQqOHAJESRA0MBgUgMrYWjYrFgHA4NhxfwFCgeC0hE
   MqFULN5nGF6+SDAYCRkaG21wEBwdER4fICAhIhsCBQNkDBwRFxgjjhskJZMD
   iBeZF44gBSYnKAMFBpd/m44pKSUqrFArE4yNqKkqLC0ABi4HHhinBSkFLS/C
   ACtpFQmOUCYlLDDPABUOGTEhJeIvLzIzTAkJIiInNDXO20wbNiYoKOdLfkEA
   If5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2
   ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDov
   L3d3dy5kZXZlbGNvci5jb20AOw==
 }

 image create photo record16 -data {
   R0lGODlhEAAQAIYAAPwCBHSSxJyu1DxOdPS6RPTSjPTOdPzSfKyijMza9PT2
   /Nzm/ISChNyeLOSmLIxiHPzCZPTy5Pz2xKSqtFx6xHSOzFyG1FRWZPyODPRq
   DEQaBOy+XPzmvMS2pIx6bIxyVIRqRKxmLOxaBDQSBPTq1PzqrPzupPzijPzS
   ZOyuPOSWLNR2HNRuJMRmJEQuLPzq1PTirPzObPyuLLSabKzK/LTO/KTO/BxK
   hPTCbPzalPzWfPy+TPSeDLSSXNTq/Mzi/LTS/FSm/AQ6fOy+ZPTalPzKXPSq
   HLyabMzm/LzW/IzC/DyS/ByO/PS2PNTi/MTa/Mze/Jy+/Fyu/PS+ZPzmxPzO
   dPTCXLyedKzO/JzC/Iyy/JS2/GSy/MTe/HS6/PS6TPy6RLyebKTG/PzqtPzS
   bPzCRLyqhHy+/JRSLIROJIxKHIRCHHRmbLzq/Lzi/LTa/Lze/GS6/AQWNARS
   pARKlARKnAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA
   LAAAAAAQABAAAAfagACCggECA4OIAAQFBgcICQoLDA0OD4gQERITFAEVARYX
   GBkagxsRHB0MDB4fICEZIiODECQcJSYnKCkqKywtLqUvMDAFMTIzNAk1NTY3
   gjgcOQU6Ozw9Pj9ANTRBQgBDHERERUY8R0gLSUlKS0wA0DkxBE1GRz5OT0lQ
   UVIAU1RVrMwzcgUJFCxZtGzh8o4DhB0Dr/joQiNLlCxeAGyA8QVME3phkHQR
   U5FGxipjdJBBUaSMGR9JaIiZeUYQmjRq1uRk0wabmzdw4iQaJGcOnaN16MwZ
   yhSRn0AAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUN
   CqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0K
   aHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==
 }

 ######################################################
 ##
 ## "Minimalist" balloon help from Tcler's Wiki
 ##
 ## With modest change so that there isn't much delay
 ## while browsing over buttons.
 ##
 ######################################################

 namespace eval balloon {
    variable long_delay 750
    variable short_delay 50
    variable delay $long_delay
    variable family {}
 }

 bind . <Enter> {
    if {$balloon::family != ""} {
        if {[lsearch -exact $balloon::family %W] == -1} {
            set balloon::family {}    
            set balloon::delay $balloon::long_delay
        }
    }
 }

 proc set_balloon {w help} {
    bind $w <Enter> "+after \$balloon::delay [list balloon::show %W [list $help]]; set balloon::delay $balloon::short_delay; set balloon::family \[balloon::getwfamily %W\]"
    bind $w <Leave> "+destroy %W.balloon"
 }

 # Add these to the namespace
 proc balloon::getwfamily {w} {
    return [winfo children [winfo parent $w]]
 }

 proc balloon::show {w arg} {
    if {[eval winfo containing  [winfo pointerxy .]]!=$w} {return}
    set top $w.balloon
    catch {destroy $top}
    toplevel $top -bd 1 -bg black
    wm attributes $top -topmost 1
    wm overrideredirect $top 1
    if {$::tcl_platform(platform) == "macintosh"} {
        unsupported1 style $top floating sideTitlebar
    }
    pack [message $top.txt -aspect 10000 -bg lightyellow -padx 1 -pady 0 \
            -text $arg]
    set wmx [expr [winfo rootx $w]+5]
    set wmy [expr [winfo rooty $w]+[winfo height $w]+7]
    wm geometry $top \
      [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy
    raise $top
 }


 ######################################################
 ##
 ## Timer procs
 ##
 ######################################################
 proc every {ms body} {
    eval $body
    after $ms [list every $ms $body]
 }

 proc timeElapsed {sec} {
    set hours [expr {$sec / 3600}]
    set mins [expr {($sec / 60) % 60}]
    return [format "%02d:%02d" $hours $mins]
 }

 # Are we timing, or not?
 set timer(state) 0
 # Has the timer been reset?
 set timer(reset) 1
 # Store previous time elapsed
 set timer(prev) 0
 proc toggleTimer {b} {
    if {$::timer(state)} {
        $b config -relief flat
        set ::timer(state) 0
        set ::timer(prev) [expr {$::timer(prev) + [clock sec] - $::timer(init)}]
    } else {
        $b config -relief sunken
        if {$::timer(reset)} {
            set ::timer(reset) 0
        }
        set ::timer(init) [clock sec]
        set ::timer(state) 1
    }
 }
 proc resetTimer {b} {
    set ::timer(reset) 1
    set ::timer(elapsed) "00:00"
    set ::timer(init) [clock sec]
    set ::timer(prev) 0
 }
 proc recordTime {b} {
    # If not timing, return
    if {!$::timer(state)} {return}
    # Stop timing
    toggleTimer $b
    # Save info
    set date [clock format [clock sec] -format "%a, %d %b %Y"]
    set start [fmtTime $::timer(init)]
    set elapsed $::timer(elapsed)
    # Reset the timer
    resetTimer $b

    clipboard clear
    clipboard append -type STRING "$date\t$start\t$elapsed"
 }
 proc fmtTime {sec} {
    return [clock format $sec -format %H:%M]
 }
 proc updateTimer {} {
    set ::timer(now) [fmtTime [clock sec]]
    if {$::timer(state)} {
        set elapsed_sec [expr {$::timer(prev) + [clock sec] - $::timer(init)}]
        set ::timer(elapsed) [timeElapsed $elapsed_sec]
    }
 }

 ## -- Top frame
 pack [frame .top] -side top
 pack [label .top.l -textvar timer(now) -font {Tahoma 18}] -side left

 # Buttons
 pack [frame .top.buttons] -side right
 set clockbutton [button .top.buttons.t -image appclock16 -relief flat]
 pack $clockbutton -side left
 set recordbutton [button .top.buttons.rec -image record16 -relief flat]
 pack $recordbutton -side left
 set resetbutton [button .top.buttons.close -image resetclock16 -relief flat]
 pack $resetbutton -side left

 ## -- Bottom frame
 pack [frame .bottom] -side bottom
 pack [label .bottom.l -textvar timer(elapsed) -font {Tahoma 10}]

 $clockbutton config -command "toggleTimer $clockbutton"
 set_balloon $clockbutton "Start/stop timer"
 $recordbutton config -command "recordTime $clockbutton"
 set_balloon $recordbutton "Save to clipboard"
 $resetbutton config -command "resetTimer $clockbutton"
 set_balloon $resetbutton "Reset timer"

 ######################################################
 ##
 ## Start program!
 ##
 ######################################################
 set timer(elapsed) "00:00"
 every 1000 updateTimer

escargo 19 Jul 2005 - Here is a variation that I created so that the time would show even if the application was reduced to the Windows Taskbar. However, there is some behavior that I found quite curious. So, here is a slight change from the original code, primarily to set the time into the applications title and the iconname.

 proc every {ms body} {
    eval $body
    after $ms [list every $ms $body]
 }

 proc update {} {
     set ::time [clock format [clock sec] -format %H:%M:%S]
     wm title . $::time
     wm iconname . $::time
 }


 pack [label .l -textvar time -font {Tahoma 24}]
 pack [button .b -text Exit -command exit]
 every 1000 {update}

Now, here is the curious behavior. If this app is run (on Windows XP Pro with ActiveTcl 8.4.9), if the app is minimized so that it's on the task bar, the timer updates. (It's only advantage over the taskbar clock is that it counts the seconds.) But if there are two Tcl apps running at the same time, the taskbar shows "2 Wish Application" (because of stacking of the two apps because the taskbar is full). If you click on the taskbar icon for the two apps the iconnames show but the iconnames don't update! Even more amusing is that the iconnames appear in tooltips when you roll over the iconnames with the updated values that are not shown in the iconnames. It's not clear what the expected behavior ought to be; I thought that the iconnames should update just as well when the iconnames are stacked as when they are sitting on the taskbar, but apparently some graphical update threads are not being called when they are stacked.


Category Application | Category GUI | Category Date and Time