[AMG]: Here's my [[timebox]] widget.  It used to live on my web site, but I don't see any reason why it can't just be on the Wiki.  See [[[timeentry]]] for its predecessors.  There's a bit of documentation at [http://andy.junkdrome.org/devel/timebox/], which I will move here when I get a chance.

[timebox screenshot]

======
# timebox.tcl
#
# Andy Goth <unununium@openverse.com>
#
# This code is available under the same license as Tcl/Tk, available online at
# http://www.tcl.tk/software/tcltk/license.html for your review.

package require Tcl 8.5a6

namespace eval timebox {
    namespace export widget
    namespace path {::tcl::mathop ::tcl::mathfunc}

    # Format field code definition table.  Columns: (0) code character, (1)
    # field width, (2) time unit, (3) type, (4) list of valid strings.  Codes
    # are sorted in order of decreasing significance, i.e. years to seconds.
    variable Codes {
        {Y 4 year   int}
        {b 3 month  str {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}}
        {m 2 month  int}
        {a 3 day    other}
        {d 2 day    int}
        {P 2 ampm   str {am pm}}
        {p 2 ampm   str {AM PM}}
        {H 2 hour   int}
        {I 2 hour   int}
        {M 2 minute int}
        {S 2 second int}
    }

    # Do nothing.
    proc Noop {args} {}

    # Scan a time string into an integer.
    proc Scan {win time} {
        variable ${win}::fmt
        variable ${win}::base
        variable ${win}::timezone

        set arguments [list -format $fmt]
        if {$base ne "now"} {
            lappend arguments -base $base
        }
        if {$timezone ne ""} {
            lappend arguments -timezone $timezone
        }
        clock scan $time {*}$arguments
    }

    # Format an integer into a time string.
    proc Format {win time} {
        variable ${win}::fmt
        variable ${win}::timezone
        clock format $time -format $fmt -timezone $timezone
    }

    # Perform clock arithmetic.
    proc Add {win time args} {
        variable ${win}::timezone
        if {$timezone ne ""} {
            lappend args -timezone $timezone
        }
        clock add $time {*}$args
    }

    # Create traces for linked variables.
    proc Create_variable_traces {win} {
        variable ${win}::numvar
        variable ${win}::textvar

        # Create traces for the numeric and textual variables, if they exist.
        foreach {var type} [list $numvar integer $textvar string] {
            if {$var ne ""} {
                trace add variable $var {write unset}\
                        [list [namespace current]::Trace_variable $win $type]
            }
        }
    }

    # Delete traces for linked variables.
    proc Delete_variable_traces {win} {
        variable ${win}::numvar
        variable ${win}::textvar

        # Delete traces for the numeric and textual variables.
        foreach {var type} [list $numvar integer $textvar string] {
            if {$var ne ""} {
                trace remove variable $var {write unset}\
                        [list [namespace current]::Trace_variable $win $type]
            }
        }
    }

    # Variable write/unset handler.
    proc Trace_variable {win type varname _ op} {
        upvar #0 $varname var

        # Handle the variable operation.  Determine if this operation is valid.
        set reject false
        if {$op eq "write"} {
            # Validate on write.  Convert the time to an integer so the time
            # string can be regenerated below.
            if {$type eq "integer"} {
                if {![string is integer -strict $var]} {
                    set reject true
                } else {
                    set time $var
                }
            } elseif {[catch {Scan $win $var} time]} {
                set reject true
            }
        } elseif {$op eq "unset"} {
            # Prevent unsetting the variable.
            set reject true
        }

        # If the variable change is rejected, restore the old value.  If the
        # variable change is accepted, update the widget text to match.
        if {$reject} {
            if {$type eq "integer"} {
                set var [Scan $win [$win get]]
            } else {
                set var [$win get]
            }
        } else {
            # Update the widget, using the correct time format.
            $win set [Format $win $time]

            # Ensure string variables are canonicalized.
            if {$type eq "string"} {
                set var [$win get]
            }
        }
    }

    # Command rename/delete handler.
    proc Trace_command {old_win new_win op} {
        # Strip namespace qualifiers from the old and new command names.
        set old_win [namespace tail $old_win]
        set new_win [namespace tail $new_win]

        # Delete the old variable traces.
        Delete_variable_traces $old_win

        # Create new traces if the widget is being renamed not deleted, and
        # create a new namespace for the state variables.  IMPORTANT: Tk itself
        # doesn't seem to properly support widget renaming, so things are likely
        # to break anyway.
        if {$op eq "rename"} {
            # Copy variables into the new namespace.
            namespace eval $new_win
            foreach var [info vars ${old_win}::*] {
                set [namespace current]::${new_win}::[namespace tail $var]\
                        [set $var]
            }

            # Create variable traces.
            Create_variable_traces $new_win
        }

        # Delete the old namespace.
        namespace delete $old_win
    }

    # Separate internal options from options for the spinbox.
    proc Scan_options {args} {
        # Set some defaults.
        dict set options timebox -base 0
        dict set options timebox -timezone ""
        dict set options timebox -command [namespace current]::Noop
        dict set options spinbox -width 0
        dict set options spinbox -font Courier

        # Separate time-specific options from generic spinbox options.
        foreach {option value} $args {
            if {$option in {-variable -textvariable -format -value
                            -base -timezone -command -help}} {
                dict set options timebox $option $value
            } else {
                dict set options spinbox $option $value
            }
        }

        # If requested, return a help string.
        if {[dict exists $options timebox -help]} {
            error "timebox-specific options:\
                 \n  -variable    : Specify linked integer time variable.\
                 \n  -textvariable: Specify linked string time variable.\
                 \n  -format      : Set format string.\
                 \n  -value       : Set initial value.\
                 \n  -base        : Base time when date fields are not used.\
                 \n  -timezone    : Time zone.\
                 \n  -command     : Script to execute on value change.\
                 \n  -help        : Print this message.\
                 \nAll other options are passed through to spinbox.\
                 \nFormat codes:\
                 \n  %Y: four-digit year    (2007)\
                 \n  %b: month of year      (Jan-Dec)\
                 \n  %m: month of year      (01-12)\
                 \n  %a: day of week        (Sun-Sat)\
                 \n  %d: day of month       (01-31)\
                 \n  %P: half-day indicator (am,pm)\
                 \n  %p: half-day indicator (AM,PM)\
                 \n  %H: military hour      (00-23)\
                 \n  %I: civilian hour      (12-11)\
                 \n  %M: minute of hour     (00-59)\
                 \n  %S: second of minute   (00-59)\
                 \n  %%: literal %"
        }

        # Require -format.
        if {![dict exists $options timebox -format]} {
            error "-format required but not specified"
        }

        # Validate -timezone.
        set timezone [dict get $options timebox -timezone]
        if {[catch {clock format 0 -timezone $timezone} error]} {
            error $error
        }

        # Return the internal and generic spinbox options.
        return $options
    }

    # Expand the format string.
    proc Expand_format {fmt} {
        variable Codes

        # Ensure at least one format code is given.
        if {![regexp {(?:^|[^%])(?:%%)*%([^%])} $fmt]} {
            error "invalid format string \"$fmt\": must contain at least\
                   one format code"
        }

        # Iterate through all format codes in the format string.
        set old_end 0
        set index 0
        set seen_ampm false
        set seen_12hr false
        foreach {beg end} [concat {*}[regexp -inline -indices -all %. $fmt] x] {
            if {$beg ne "x"} {
                # Get the format character.
                set char [string range $fmt [+ $beg 1] $end]

                # Skip %%.
                if {$char eq "%"} {
                    continue
                }

                # Keep track of %p, %P, and %I.
                if {$char in {p P}} {
                    set seen_ampm true
                } elseif {$char eq "I"} {
                    set seen_12hr true
                }
            }

            # If literal text precedes this code or is at the end of the format
            # string, add it to the expanded form.
            if {($beg eq "x" && $old_end < [string length $fmt])
             || ($beg ne "x" && $beg > $old_end)} {
                if {$beg eq "x"} {
                    set str [string range $fmt $old_end end]
                } else {
                    set str [string range $fmt $old_end [- $beg 1]]
                }
                set str [string map {%% %} $str]
                set len [string length $str]
                lappend expfmt [list $index [+ $index $len -1] literal $str]
                incr index $len
            }

            # If not at the end of the string, add this code to the result.
            if {$beg ne "x"} {
                set char [string index $fmt [+ $beg 1]]
                set code [lsearch -exact -index 0 $Codes $char]
                if {$code < 0} {
                    foreach code $Codes {
                        lappend valid %[lindex $code 0]
                    }
                    set valid [join [lsort $valid] ", "]
                    error "unsupported format code \"%$char\": must be one of\
                           $valid, or %%"
                }
                set len [lindex $Codes $code 1]
                lappend expfmt [list $index [+ $index $len -1] field $code]
                incr index $len

                # Track the ending index of this format code in order to detect
                # sequences of literal text.
                set old_end [+ $end 1]
            }
        }

        # It's illegal to have a 12-hour clock without AM/PM.
        if {$seen_12hr && !$seen_ampm} {
            error "invalid format string \"$fmt\": %I cannot be specified\
                   without also using %p or %P"
        }

        # Return the expanded format.
        return $expfmt
    }

    # Return the index of the least significant field within a subrange.
    proc Lsig_field {expfmt {beg 0} {end inf}} {
        variable Codes

        # Search through the specified subrange of the expanded format for the
        # highest-numbered (i.e. least significant) format code.
        set lsig_code -1
        set lsig_index -1
        set index 0
        foreach {field_beg field_end type code} [concat {*}$expfmt] {
            if {$type eq "field" && $code > $lsig_code
             && $beg <= $field_end && $field_beg <= $end} {
                set lsig_code $code
                set lsig_index $index
            }
            incr index
        }

        # Return the index of the least significant format code in the expanded
        # format specification.  Return -1 if no format codes appeared in the
        # specified subrange.
        return $lsig_index
    }

    # timebox validator.  This procedure gives the timebox its clock behavior.
    proc Validate {win validate edit current edit_beg action command} {
        variable Codes
        variable ${win}::fmt
        variable ${win}::expfmt
        variable ${win}::numvar
        variable ${win}::textvar

        # Make the action string a little bit more palatable.
        if {$action in {-1 0 1}} {
            set action [lindex {forced delete insert} [+ $action 1]]
        }

        # Forced validation always succeeds.
        if {$action eq "forced"} {
            return true
        }

        # Handle delete simply by backing up the cursor.
        if {$action eq "delete"} {
            $win icursor $edit_beg
            return false
        }

        # Determine how many characters are being edited.
        set edit_len [string length $edit]
        set edit_end [+ $edit_beg $edit_len -1]

        # Identify the current field.  If a selection is present and using the
        # spinners, use the least significant field within the selection.
        # Otherwise, use the nearest time field, if not already inside one.
        if {$action in {up down} && [$win selection present]} {
            # Use the least significant field in the selection, or if that
            # fails, use the least significant field in the whole widget.
            set field_idx [Lsig_field $expfmt [$win index sel.first]\
                                              [$win index sel.last]]
            if {$field_idx == -1} {
                set field_idx [Lsig_field $expfmt]
            }
            set event seek_lsig_field
        } else {
            # Find the time field nearest the cursor.  Skip over literals.  When
            # doing an insert, also skip over fields of type "other".
            set field_idx 0
            set seek_forward false
            set valid_cond {($type ne "literal" && ($action ne "insert"
                            || [lindex $Codes $code 3] ne "other"))}
            foreach {field_beg field_end type code} [concat {*}$expfmt] {
                # Check to see if this field is valid.
                if $valid_cond {
                    # If seeking the first or next valid field, stop now.
                    # Otherwise remember that this field is valid so that it
                    # later will be possible to rewind to it.
                    if {$seek_forward} {
                        break
                    } else {
                        set valid_idx $field_idx
                    }
                }

                # Check to see if this is the field in which the cursor lies.
                if {$field_beg <= $edit_beg && $edit_beg <= $field_end} {
                    # Also check the validity of this field.
                    if $valid_cond {
                        # The cursor is inside a valid field.  Stop now.
                        set event inside_field
                        break
                    } else {
                        # The cursor is inside an invalid field, so rewind to
                        # the previous valid field, or if this is the first
                        # field, advance to the first valid field.  If
                        # performing an insert, always advance.
                        set event seek_near_field
                        if {$action ne "insert" && [info exists valid_idx]} {
                            set field_idx $valid_idx
                            break
                        } else {
                            set seek_forward true
                        }
                    }
                }
                incr field_idx 1
            }

            # If the cursor is at the end of the string, it won't be inside any
            # time fields, so rewind to the last valid time field.
            if {$field_idx == [llength $expfmt]} {
                for {incr field_idx -1} {$field_idx > 0} {incr field_idx -1} {
                    lassign [lindex $expfmt $field_idx] field_beg\
                                                        field_end type code
                    if $valid_cond {
                        break
                    }
                }
                set event seek_near_field
            }
        }

        # Get information about the current field.
        lassign [lindex $expfmt $field_idx] field_beg field_end _ code
        lassign [lindex $Codes $code] char width unit type valid

        # Adjust the edit beginning and ending positions based on the insertion
        # cursor's relationship to the current field.
        if {$event eq "seek_lsig_field"} {
            # Select entire field.
            set edit_beg $field_beg
            set edit_end $field_end
        } elseif {$event eq "seek_near_field"} {
            # Determine whether it was necessary to seek forward or backward.
            if {$edit_beg < $field_beg} {
                # Advance.
                set edit_beg $field_beg
                set edit_end [+ $field_beg $edit_len -1]
            } else {
                # Don't allow inserting after the end of the field.
                if {$action eq "insert"} {
                    return false
                }

                # Rewind.
                set edit_beg [- $field_end $edit_len -1]
                set edit_end $field_end
            }
        }

        # Figure out the new text after the edit.
        if {$action in {up down}} {
            # Forbid years greater than 9999.  (Y10K bug oh no!)
            if {$action eq "up" && [lindex $Codes $code 0] eq "Y"
             && [string range $current $field_beg $field_end] eq "9999"} {
                return false
            }

            # Determine the step value.
            if {$unit eq "ampm"} {
                # Special-case AM/PM to get less surprising behavior.
                if {[string index $current $field_beg] in {a A}} {
                    set step {12 hour}
                } else {
                    set step {-12 hour}
                }
            } else {
                # Use negative step for down and positive step for up.
                set step [list [dict get {down -1 up 1} $action] $unit]
            }

            # Add the step value to the current time.
            set time [Add $win [Scan $win $current] {*}$step]

            # Generate a new time string with the correct format.
            set new [Format $win $time]
        } else {
            # Possibly try repeatedly.
            set chances 1
            set orig $current
            for {set round 0} {$round < $chances} {incr round} {
                # Perform the change.
                set new [string replace $current $edit_beg $edit_end $edit]

                # For string fields, use the first valid string with this
                # prefix.
                if {$type eq "str"} {
                    # Get the prefix.
                    set pre [string range $new $field_beg $edit_end]
                    set len [- $edit_end $field_beg -1]
                    set found false

                    # Search the valid string list for this prefix.
                    foreach str $valid {
                        if {[string equal -nocase -length $len $pre $str]} {
                            set new [string replace $new\
                                    $field_beg $field_end $str]
                            set found true
                            break
                        }
                    }

                    # If no match was found, and if inserting, fail.
                    if {!$found} {
                        return false
                    }
                }

                # Canonicalize the time string.
                if {[catch {Scan $win $new} time]} {
                    # Abort if the format is bad.
                    return false
                }
                set new [Format $win $time]

                # If this results in the edit itself being mutated, try again
                # but with the other fields zeroed out.
                if {![string equal -nocase\
                        [string range $new $edit_beg $edit_end] $edit]} {
                    # If this is the second failure, abort.
                    if {$chances == 2} {
                        return false
                    }

                    # Zero stuff which may be interfering.
                    if {$type eq "int"} {
                        # Replace subsequent digits of this field with zeroes.
                        set current [string replace $orig\
                                [+ $edit_end 1] $field_end\
                                [string repeat 0 [- $field_end $edit_end]]]
                    } else {
                        # Replace the day-of-month field(s) with 01.
                        set current $orig
                        foreach {day_beg day_end day_type day_code}\
                                [concat {*}$expfmt] {
                            if {$day_type eq "field"
                             && [lindex $Codes $day_code 0] eq "d"} {
                                set current [string replace $current\
                                        $day_beg $day_end 01]
                            }
                        }
                    }

                    # Now try again.
                    incr chances
                }
            }
        }

        # Write the new time string to the widget.
        $win set $new

        # Sync linked variables.  Temporarily disable variable traces while
        # writing to the linked variables.
        if {$numvar ne "" || $textvar ne ""} {
            Delete_variable_traces $win
            foreach {var value} [list $numvar $time $textvar $new] {
                if {$var ne ""} {
                    set $var $value
                }
            }
            Create_variable_traces $win
        }

        # When using insert mode, advance the cursor past the separator.  When
        # using the spinners, highlight the current field.
        if {$action eq "insert"} {
            # Figure out where the cursor should be moved.
            set cursor [+ $edit_end 1]

            # If the cursor moved past the end of the field, move it to the
            # beginning of the next field, skipping literals.
            if {$cursor > $field_end} {
                set found false
                foreach {field_beg field_end type code} [concat {*}$expfmt] {
                    if {$found && $type eq "field"} {
                        set cursor $field_beg
                        break
                    }
                    if {$field_beg <= $cursor && $cursor <= $field_end} {
                        if {$type eq "field"} {
                            break
                        } else {
                            set found true
                        }
                    }
                }
            }
            
            # Move the cursor.
            $win selection clear
            $win icursor $cursor
        } elseif {$action in {up down}} {
            # Highlight (select) the current field.
            focus $win
            $win selection range $field_beg [+ $field_end 1]
            $win icursor [+ $field_end 1]
        }

        # Reinstall the validator.
        $win config -validate $validate

        # Invoke the on-update command.
        uplevel #0 $command $time

        # Don't allow Tk to set the widget value; it's already done.
        return false
    }

    # timebox widget command.
    proc widget {win args} {
        # Get options, divided into timebox and spinbox groups.  Make all
        # spinbox options into local variables.
        set options [Scan_options {*}$args]
        set sbopts [dict get $options spinbox]
        set myopts [dict get $options timebox]

        # Expand the format string.
        set fmt [dict get $myopts -format]
        set expfmt [Expand_format $fmt]

        # Get linked variables.
        foreach {option var} {-variable numvar -textvariable textvar} {
            if {[dict exists $myopts $option]} {
                set $var ::[dict get $myopts $option]
            } else {
                set $var ""
            }
        }

        # Get other options.
        set base [dict get $options timebox -base]
        set timezone [dict get $options timebox -timezone]
        set cmd [dict get $options timebox -command]

        # Create a namespace in which to store widget state.
        namespace eval $win {}
        foreach var {fmt expfmt numvar textvar base timezone} {
            set [namespace current]::${win}::$var [set $var]
        }

        # Prepare to delete the namespace if anything bad happens.
        if {[catch {
            # Determine the initial time value.
            if {[dict exists $myopts -value]} {
                set initval [dict get $myopts -value]
            } elseif {$numvar ne "" && [info exists $numvar]} {
                set initval [set $numvar]
            } elseif {$textvar ne "" && [info exists $textvar]} {
                set initval [set $textvar]
            } else {
                set initval 0
            }
            if {![string is integer -strict $initval]} {
                set initval [Scan $win $initval]
            }
            if {$numvar ne ""} {
                set $numvar $initval
            }
            if {$textvar ne ""} {
                set $textvar [Format $win $initval]
            }

            # Create the spinbox widget.
            set validate [string map {% %%} [namespace current]::Validate]
            set lcmd [list $cmd]
            spinbox $win {*}$sbopts -validate key -command "[list $validate] %W\
                    \[%W cget -validate\] {} %s \[%W index insert\] %d $lcmd"\
                    -validatecommand [list $validate %W %v %S %s %i %d $cmd]

            # Set traces on linked variables.
            Create_variable_traces $win

            # Arrange for the traces to be updated or removed when the widget is
            # renamed or deleted.
            trace add command $win {rename delete}\
                    [namespace current]::Trace_command

            # Set the spinbox's initial text, and position the cursor at the
            # start of the least significant field.
            $win set [Format $win $initval]
            $win icursor [lindex $expfmt [Lsig_field $expfmt] 0]
        } result err_opts]} {
            # On error, delete the namespace and abort.
            namespace delete $win
            return -options $err_opts $result
        }

        # Return the widget path to the caller.
        return $win
    }
}

# Make the timebox widget command available under the name "timebox".
interp alias {} timebox {} timebox::widget

# Example!
proc p {args} {puts $args}
package require Tk
pack [timebox .t -variable foo -format "%a %b %d %I:%M:%S %p %Y" -timezone :UTC]
pack [timebox .t2 -variable foo -format "%Y-%m-%d %H:%M:%S" -command p] -fill x
pack [entry .e -textvariable foo] -fill x
wm resizable . false false

# vim: set ts=4 sts=4 sw=4 tw=80 et ft=tcl:
======

<<categories>> Widget