# 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 . { 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 "+after \$balloon::delay [list balloon::show %W [list $help]]; set balloon::delay $balloon::short_delay; set balloon::family \[balloon::getwfamily %W\]" bind $w "+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]