timeentry
Docs can be found at http://incrtcl.sourceforge.net/iwidgets/iwidgets/timeentry.html and http://purl.org/tcl/home/man/iwidgets3.0/timeentry.n.html
This is a spinbox widget that only allows valid times to be entered. I tried to make this as much like the spinbox in the Windows "Date and Time" dialog. This is only for a 24 hour clock, but it wouldn't take too much modification to support a 12 hour format. There's probably an easier way to do this, so please edit this page if you know of one. -Paul Walton
proc validateTime {spinbox originalString newString index adjust} {
# Check if the colons are present.
if { [string match {*:*:*} $newString] == 0 } {
return 0
}
# Split up each field into its own variable.
set time [split $newString :]
set hour [lindex $time 0]
set minutes [lindex $time 1]
set seconds [lindex $time 2]
# Check if valid digits were entered in each field.
if { $hour != "" && ![string match {[0-9]} $hour] && ![string match {[0-1][0-9]} $hour] && ![string match {2[0-3]} $hour] } {
#invalid hour
return 0
}
if { $minutes != "" && ![string match {[0-9]} $minutes] && ![string match {[0-5][0-9]} $minutes] } {
#invalid minutes
return 0
}
if { $seconds != "" && ![string match {[0-9]} $seconds] && ![string match {[0-5][0-9]} $seconds] } {
#invalid seconds
return 0
}
# Adjust the index position of the cursor appropiately.
set diff [expr { [string length $hour:$minutes:$seconds] - [string length $originalString] }]
set newIndex $index
if { $diff > 0 } {
incr newIndex $diff
}
switch -- $adjust {
up {set adjust 1}
down {set adjust -1}
default {set adjust 0}
}
set indexColon1 [string first {:} $newString]
set indexColon2 [string last {:} $newString]
if { $index <= $indexColon1 } {
set field hour
if { $adjust != 0 } {
if { $hour == "" } {
set hour 0
}
scan $hour %d hour
incr hour $adjust
if { $hour == 24 } {
set hour 0
}
if { $hour == -1 } {
set hour 23
}
}
}
if { $index > $indexColon1 && $index <= $indexColon2 } {
set field minutes
if { $adjust != 0 } {
if { $minutes == "" } {
set minutes 0
}
scan $minutes %d minutes
incr minutes $adjust
if { $minutes == 60 } {
set minutes 0
}
if { $minutes == -1 } {
set minutes 59
}
}
}
if { $index > $indexColon2 } {
set field seconds
if { $adjust != 0 } {
if { $seconds == "" } {
set seconds 0
}
scan $seconds %d seconds
incr seconds $adjust
if { $seconds == 60 } {
set seconds 0
}
if { $seconds == -1 } {
set seconds 59
}
}
}
if { $index == -1 } {
set field none
}
if { $field != "hour" || $adjust != 0 } {
set increaseBy [expr {abs([string length $hour]-2)}]
set hour [string repeat 0 $increaseBy]$hour
incr newIndex $increaseBy
}
if { $field != "minutes" || $adjust != 0 } {
set increaseBy [expr {abs([string length $minutes]-2)}]
set minutes [string repeat 0 $increaseBy]$minutes
if { $indexColon2 < $index } {
incr newIndex $increaseBy
}
}
if { $field != "seconds" || $adjust != 0 } {
set increaseBy [expr {abs([string length $seconds]-2)}]
set seconds [string repeat 0 $increaseBy]$seconds
}
# Write the validated data with possible corrections to the spinbox.
$spinbox configure -validate none
$spinbox delete 0 end
$spinbox insert 0 $hour:$minutes:$seconds
if { $adjust != 0 } {
switch -- $field {
hour {
set newIndex 2
$spinbox selection from 0
$spinbox selection to 2
}
minutes {
set newIndex [string last {:} $hour:$minutes:$seconds]
$spinbox selection from 3
$spinbox selection to 5
}
seconds {
set newIndex end
$spinbox selection from 6
$spinbox selection to end
}
default {
$spinbox selection from 6
$spinbox selection to end
}
}
}
$spinbox icursor $newIndex
after idle [list $spinbox configure -validate all]
return 0
}
spinbox .spin -width 8 -validatecommand {validateTime %W %s %P %i ""} -validate all -command {validateTime %W %s %s [%W index insert] %d}
.spin insert 0 00:00:00
bind .spin <FocusIn> [list .spin icursor 0]
pack .spinMG Nov 10th 2005 - I found a few problems with the code above, most notably that the spinner only effects the seconds. (Paul Walton: The spin buttons (and keyboard arrows) do effect the hours, minutes, and seconds, depending on where the insertion cursor is. This is also how the Windows "Date and Time" spinbox works. What other problems did you have with it?)
MG Ahh, I see. I was assuming that spinning "up" one from 00:00:59 would take it to 00:01:00, and so on. The only other "problem" I had with it was the way in which it automatically pads numbers with 0's, to get them up to two characters. In the Windows clock, you can't move beyond the separating ':' with the cursor keys, you have to tab to the next one (and that's when the padding occurs). I was just suprised with this one when it suddenly padded my previous change with 0's while I was still just editing the time (as it's just one field, from the way the key bindings for movement work, whereas the Windows one is more clearly three fields). I guess that largely just comes down to user preference, the same as the confusion on how the spin buttons worked, though :)
MG The simplest way for doing a basic version of this seems to be using a constructed list of valid values:
for {set h 0} {$h <= 23} {incr h} {
set hour [format "%02d" $h]
for {set m 0} {$m <= 59} {incr m} {
set minute [format "%02d" $m]
for {set s 0} {$s <= 59} {incr s} {
set second [format "%02d" $s]
lappend values "$hour:$minute:$second"
}
}
}Though that doesn't do validation if you type text into the box.
MG The code below now seems to work fully, including the spinbox buttons. It's a little different from the code above - inserting a character overwrites the character currently there, and moves the cursor on (past a colon, if necessary). The spinbox buttons increment (or decrement) whichever part of the time you're in, hours, minutes or seconds, but when the seconds go over 59, the minutes go up on, and ditto with the minutes, and with going down one. To use it, just use:
timebox $widget $varname ?$args?
where $widget is the widget path name, $varname is the name of a variable to store the value in (ala -textvariable), and $args are any other args accepted by a spinbox widget. (This could be improved so it doesn't have to use a textvariable, without a whole lot of trouble, but I don't have the time right now.)
proc validateTimeMG {w validate edit current index type} {
if { $type == "-1"} {
return 1;
} elseif { (![string match {[0-9]} $edit] || [string range $current $index $index] == ":") && ($type != "up" && $type != "down") } {
return 0;
}
if { $type == "0" } {
set new [string replace $current $index $index 0]
} elseif { $type == "1" } {
set new [string replace $current $index $index $edit]
} elseif { $type == "up" || $type == "down" } {
set new $current
} else {
return 0; # something broke
}
set parts [split $new :]
foreach {hours minutes seconds} $parts {break}
foreach x {hours minutes seconds} {
scan [set $x] %d $x
}
if { $type == "up" || $type == "down" } {
set incrby [expr {$type == "up" ? 1 : -1}]
# find out where we are, and go up/down one
if { $index > 5 } {
# we're in seconds
incr seconds $incrby
if { $seconds < 0 } {
set seconds 59
incr minutes -1
} elseif { $seconds > 59 } {
set seconds 0
incr minutes 1
}
}
if { $index > 2 } {
if { $index < 6 } {
incr minutes $incrby ;# we're in minutes, not seconds
}
if { $minutes < 0 } {
set minutes 59
incr hours -1
} elseif { $minutes > 59 } {
set minutes 0
incr hours 1
}
}
if { $index < 3 } {
incr hours $incrby ;# we're in hours, not minutes/seconds
}
if { $hours < 0 } {
set hours 23
} elseif { $hours > 23 } {
set hours 0
}
set new [format %02d:%02d:%02d $hours $minutes $seconds]
}
set num [format %02d%02d%02d $hours $minutes $seconds]
if { $num > 235959 || $hours > 23 || $minutes > 59 || $seconds > 59} {
return 0;
}
upvar 1 [$w cget -textvariable] textvar
if { $type != "1" } {
set textvar $new
$w config -validate $validate
} elseif { $type == "1" } {
if { [string range $current $index $index] == ":" } {
return 0;
} else {
set textvar $new
$w config -validate $validate
set cursor [expr {$index + 1}]
if { [string range $current $cursor $cursor] == ":" } {
incr cursor
}
$w icursor $cursor
}
}
return 0;
}
proc timebox {w var args} {
upvar 1 $var textvar
set textvar "00:00:00"
uplevel 1 spinbox $w $args [list -textvariable $var -command "validateTimeMG %W \[%W cget -validate\] {} %s \[%W index insert\] %d" -validate key -validatecommand [list validateTimeMG %W %v %S %s %i %d]]
$w icursor end
set w
}
# demo
pack [timebox .t myTime -foreground red]Paul W: Very nice, it works well. I like the feel of it. It's nice to be able to type in the time without having to manually move the insertion cursor.
AMG: I present yet another time entry widget. It's derived from the above two, but it supports a variety of formats, including AM/PM, optional seconds, and optional hours. It's also fairly heavily commented.
package require Tcl 8.5
package require Tk
proc validate_time {win format validate edit current index action} {
# Make the action string a little bit more palatable.
if {$action in {-1 0 1}} {
set action [dict get {-1 forced 0 delete 1 insert} $action]
}
# Forced validation always succeeds.
if {$action eq "forced"} {
return true
}
# Make the cursor retreat past separator characters.
if {$index % 3 == 2} {
incr index -1
}
# Determine how many characters are being edited.
set len [string length $edit]
set end [expr {$index + $len - 1}]
set tot [string length $current]
# Create the format definition lookup table.
set fmtdef {
p {place 43200 radix 2} H {place 3600 radix 24} h {place 3600 radix 12}
m {place 60 radix 60} s {place 1 radix 60}
}
# If the entire text is selected, and if using the spinners, advance to the
# least significant field.
if {$action in {up down} && [$win selection present]
&& [$win index sel.first] == 0 && [$win index sel.last] == $tot} {
# Round the index down to a multiple of three.
set index [expr {$tot / 3 * 3}]
# If the last field is AM/PM, retreat one field.
if {[string index $format end] eq "p"} {
incr index -3
}
}
# Determine the format code of the sub-field being edited.
set field [string index $format [expr {$index / 3}]]
# Before doing anything complex, do simple character-based validation.
if {$action eq "insert" && ($field eq "p"
? ($edit ni {a A p P} || $index % 3 != 0)
: ($edit ni {0 1 2 3 4 5 6 7 8 9}))} {
return false
}
# Figure out the new text after the edit.
switch -- $action {
delete {
set new [string replace $current $index $end [string repeat 0 $len]]
$win icursor $index
} insert {
set new [string replace $current $index $end $edit]
} default {
set new $current
}}
# Split the data into fields. It's not safe to use [split] because the
# colon and space may have just been overwritten.
set split [list]
for {set i 0} {$i < [string length $format]} {incr i} {
lappend split [string range $new [expr {$i * 3}] [expr {$i * 3 + 1}]]
}
# Convert to time in seconds since midnight.
set time 0
foreach fmt [split $format ""] val $split {
# Convert the time component to an integer.
if {$fmt eq "p"} {
set val [expr {[string index $val 0] in {p P} ? 1 : 0}]
} elseif {$fmt eq "h" && $val == 12} {
set val 0
} else {
scan $val %d val
}
# Forbid out-of-range values.
if {$val >= [dict get $fmtdef $fmt radix]} {
return false
}
# Add the time component to the seconds accumulator.
incr time [expr {$val * [dict get $fmtdef $fmt place]}]
}
# Handle incrementing and decrementing via the spinner buttons.
if {$action in {up down}} {
# Adjust the time according to which field is currently selected.
incr time [expr {
($action eq "down" ? -1 : 1) * [dict get $fmtdef $field place]
}]
# Highlight (select) the current field.
focus $win
$win selection range [expr {$index / 3 * 3}] [expr {$index / 3 * 3 + 2}]
$win icursor [expr {$index / 3 * 3 + 2}]
}
# Reassemble the time string to include the above changes.
set new ""
foreach fmt [split $format ""] {
# Get the numeric value of this field.
set val [expr {$time / [dict get $fmtdef $fmt place]
% [dict get $fmtdef $fmt radix]}]
# Add the string-formatted version of this field to the result.
if {$fmt eq "p"} {
append new " [lindex {AM PM} $val]"
} elseif {$fmt eq "h" && $val == 0} {
append new :12
} else {
append new :[format %02d $val]
}
}
set new [string range $new 1 end]
# Write the new time string to the widget.
upvar 1 [$win cget -textvariable] textvar
set textvar $new
# When using insert mode, advance the cursor past the separator character.
if {$action eq "insert"} {
set cursor [expr {$index + 1}]
if {$field eq "p" && $cursor % 3 == 1} {
incr cursor 2
} elseif {$cursor % 3 == 2} {
incr cursor
}
$win selection clear
$win icursor $cursor
}
# Reinstall the validator.
$win config -validate $validate
# Don't allow Tk to set the widget value; it's already done.
return false
}
proc timebox {win var format args} {
# Only allow a limited range of format specifiers.
set valid {ms hm hmp hms hmsp Hm Hms}
if {$format ni $valid} {
error "unsupported format \"$format\": must be [join $valid ", "]"
}
# Set an initial time value.
upvar 1 $var textvar
set textvar ""
foreach fmt [split $format ""] {
if {$fmt eq "p"} {
append textvar " AM"
} elseif {$fmt eq "h"} {
append textvar ":12"
} else {
append textvar ":00"
}
}
set textvar [string range $textvar 1 end]
# Create the spinbox widget.
set cmd "validate_time %W [list $format] \[%W cget -validate\] {} %s\
\[%W index insert\] %d"
spinbox $win {*}$args -textvariable $var -command $cmd -validate key\
-validatecommand [list validate_time %W $format %v %S %s %i %d]
# Position the insertion cursor to the least significant field.
if {[string index $format end] eq "p"} {
$win icursor [expr {[string length $textvar] - 4}]
} else {
$win icursor end
}
# Return the widget path to the caller.
return $win
}
# Demo.
foreach fmt {ms hm hmp hms hmsp Hm Hms} {
grid [label .l$fmt -text $fmt] [timebox .t$fmt t$fmt $fmt]
}
wm resizable . false falseI tried very hard to make backspace work without surprise, but 12-hour clocks are inherently surprising! Type "01:23" into hm then backspace several times, and it goes from "01:00" to "12:00", then as backspace is pressed one final time, it goes to "02:00". Any suggestions for improvement?
Update: I added a feature present in Paul's original but not in MG's variant: when incrementing or decrementing a field, that field is highlighted (selected). I find this to be a useful visual cue.
MG highly recommends this version above his, if you have 8.5 available. One possible bug, though (which could be a feature, not sure) - when you're using the spinners, if you have no selection and the cursor isn't in the spinbox(/you haven't clicked on the spinbox), it doesn't highlight the seconds, though it does edit them.
Incidentally, when I downloaded an 8.5 Tclkit to test this, it threw an error - apparently {*} isn't available in it yet (8.5a4), so had to use {expand} instead. (Not that this is a bug, just a FYI.)
The backspace behaviour is indeed a little strange, but personally I can't think of any better way to handle it than what you're doing now.
Thanks for sharing this, it's much more powerful than the previous ones without a huge increase in code size, and very nifty indeed.
AMG: Thank you very much for the, uhm, feedbaccolade. :^)
With Tcl/Tk built from this morning's CVS running on Slackware, I don't see the "possible bug" you describe, but I do see it when using JCW's 8.5a4 Tclkit binary in Windows XP. My guess is that Windows Tk won't draw the selection for a widget that isn't focused. I added a call to [focus] to correct for this. Frankly I'm surprised that clicking a spin button doesn't already give the spinbox focus.
Regarding the backspace behavior, I suppose I could hold off on the 00→12 conversion until the focus leaves the widget, but this also might look strange.
MG Would seem your guess was right; now works as I'd expected. Thanks :)
AMG: I made a new, much more powerful [timebox] widget. The primary new feature is it supports date fields as well as time-of-day fields. It also supports both numeric and textual linked variables.
Oh, and MG, I figured out how to fix the weird backspace behavior in 12-hour fields. I simply made backspace behave like left arrow. Such an easy solution! It only took me six months to think of it.
DF 07/01/2010: I've changed the example to use TK themed widgets. The ttk::spinbox changed the entry text before it gets validated so the binding had to be changed. A new class is created for each time format.
package require Tcl 8.5
package require Tk
namespace eval ttk::timebox { }
proc ttk::timebox::Spin {win format action} {
ttk::timebox::validate_time $win $format {} [$win get] [$win index insert] $action
}
proc ttk::timebox::validate_time {win format edit current index action} {
# Make the action string a little bit more palatable.
if {$action in {-1 0 1}} {
set action [dict get {-1 forced 0 delete 1 insert} $action]
}
# Forced validation always succeeds.
if {$action eq "forced"} {
return true
}
# Make the cursor retreat past separator characters.
if {$index % 3 == 2} {
incr index -1
}
# Determine how many characters are being edited.
set len [string length $edit]
set end [expr {$index + $len - 1}]
set tot [string length $current]
# Create the format definition lookup table.
set fmtdef {
p {place 43200 radix 2} H {place 3600 radix 24} h {place 3600 radix 12}
m {place 60 radix 60} s {place 1 radix 60}
}
# If the entire text is selected, and if using the spinners, advance to the
# least significant field.
if {$action in {up down} && [$win selection present]
&& [$win index sel.first] == 0 && [$win index sel.last] == $tot} {
# Round the index down to a multiple of three.
set index [expr {$tot / 3 * 3}]
# If the last field is AM/PM, retreat one field.
if {[string index $format end] eq "p"} {
incr index -3
}
}
# Determine the format code of the sub-field being edited.
set field [string index $format [expr {$index / 3}]]
# Before doing anything complex, do simple character-based validation.
if {$action eq "insert" && ($field eq "p"
? ($edit ni {a A p P} || $index % 3 != 0)
: ($edit ni {0 1 2 3 4 5 6 7 8 9}))} {
return false
}
# Figure out the new text after the edit.
switch -- $action {
delete {
set new [string replace $current $index $end [string repeat 0 $len]]
$win icursor $index
} insert {
set new [string replace $current $index $end $edit]
} default {
set new $current
}}
# Split the data into fields. It's not safe to use [split] because the
# colon and space may have just been overwritten.
set split [list]
for {set i 0} {$i < [string length $format]} {incr i} {
lappend split [string range $new [expr {$i * 3}] [expr {$i * 3 + 1}]]
}
# Convert to time in seconds since midnight.
set time 0
foreach fmt [split $format ""] val $split {
# Convert the time component to an integer.
if {$fmt eq "p"} {
set val [expr {[string index $val 0] in {p P} ? 1 : 0}]
} elseif {$fmt eq "h" && $val == 12} {
set val 0
} else {
scan $val %d val
}
# Forbid out-of-range values.
if {$val >= [dict get $fmtdef $fmt radix]} {
return false
}
# Add the time component to the seconds accumulator.
incr time [expr {$val * [dict get $fmtdef $fmt place]}]
}
# Handle incrementing and decrementing via the spinner buttons.
if {$action in {up down}} {
# Adjust the time according to which field is currently selected.
incr time [expr {
($action eq "down" ? -1 : 1) * [dict get $fmtdef $field place]
}]
# Highlight (select) the current field.
focus $win
$win selection range [expr {$index / 3 * 3}] [expr {$index / 3 * 3 + 2}]
$win icursor [expr {$index / 3 * 3 + 2}]
}
# Reassemble the time string to include the above changes.
set new ""
foreach fmt [split $format ""] {
# Get the numeric value of this field.
set val [expr {$time / [dict get $fmtdef $fmt place]
% [dict get $fmtdef $fmt radix]}]
# Add the string-formatted version of this field to the result.
if {$fmt eq "p"} {
append new " [lindex {AM PM} $val]"
} elseif {$fmt eq "h" && $val == 0} {
append new :12
} else {
append new :[format %02d $val]
}
}
set new [string range $new 1 end]
# Write the new time string to the widget.
$win set $new
# When using insert mode, advance the cursor past the separator character.
if {$action eq "insert"} {
set cursor [expr {$index + 1}]
if {$field eq "p" && $cursor % 3 == 1} {
incr cursor 2
} elseif {$cursor % 3 == 2} {
incr cursor
}
$win selection clear
$win icursor $cursor
}
# Don't allow Tk to set the widget value; it's already done.
return false
}
proc ttk::timebox {win var format args} {
# Only allow a limited range of format specifiers.
set valid {ms hm hmp hms hmsp Hm Hms}
if {$format ni $valid} {
error "unsupported format \"$format\": must be [join $valid ", "]"
}
# Set an initial time value.
upvar 1 $var textvar
set textvar ""
foreach fmt [split $format ""] {
if {$fmt eq "p"} {
append textvar " AM"
} elseif {$fmt eq "h"} {
append textvar ":12"
} else {
append textvar ":00"
}
}
set textvar [string range $textvar 1 end]
# Create the spinbox widget.
ttk::copyBindings TSpinbox TTimebox_$format
bind TTimebox_$format <<Increment>> [list ttk::timebox::Spin %W $format up]
bind TTimebox_$format <<Decrement>> [list ttk::timebox::Spin %W $format down]
ttk::spinbox $win {*}$args -class TTimebox_$format -textvariable $var -validate key\
-validatecommand [list ttk::timebox::validate_time %W $format %S %s %i %d]
# Position the insertion cursor to the least significant field.
if {[string index $format end] eq "p"} {
$win icursor [expr {[string length $textvar] - 4}]
} else {
$win icursor end
}
# Return the widget path to the caller.
return $win
}
# Demo.
foreach fmt {ms hm hmp hms hmsp Hm Hms} {
grid [label .l$fmt -text $fmt] [ttk::timebox .t$fmt t$fmt $fmt]
}
wm resizable . false false