Artifact
8b49410789c1b533875c6578ae2723a87814f269:
- Executable file
modules/datefield/datefield.tcl
— part of check-in
[5634c2dfd1]
at
2017-04-04 07:26:24
on branch rfe-fa7e485702
— datefield with additional "-format" option to support Dates for German and ISO including MouseWheel-binding. Ticket [fa7e485702]
(user:
oehhar
size: 12481)
[more...]
Also attachment "datefield.tcl" to
ticket [fa7e485702]
added by
AdE@BfzPL
2017-04-03 19:04:33.
##+##########################################################################
#
# datefield.tcl
#
# Implements a datefield entry widget ala Iwidget::datefield
# by Keith Vetter ([email protected])
#
# Datefield creates an entry widget but with a special binding to KeyPress
# (based on Iwidget::datefield) to ensure that the current value is always
# a valid date. All normal entry commands and configurations still work.
#
# Usage:
# ::datefield::datefield .df -background yellow -textvariable myDate \
# -format "%Y-%m-%d"
# pack .df
#
# Bugs:
# o won't work if you programmatically put in an invalid date
# e.g. .df insert end "abc" will cause it to behave erratically
#
# Revisions:
# KPV Feb 07, 2002 - initial revision
# TW Mar 26, 2017 - support more keys and the mouse wheel
# - add option -format to support 3 date-styles:
# "%d.%m.%Y" (for German)
# "%m/%d/%Y" (for English, standard)
# "%Y-%m-%d" (for ISO)
#
##+##########################################################################
#############################################################################
package require Tk 8.0
package provide datefield 0.3
namespace eval ::datefield {
namespace export datefield
# Have the widget use tile/ttk should it be available.
variable entry entry
if {![catch {
package require tile
}]} {
set entry ttk::entry
}
proc datefield {w args} {
variable entry
variable Format
variable Separator
set i [lsearch $args "-form*"]
if {$i == -1} { # Default English
set Format($w) "%m/%d/%Y"
} else {
set Format($w) [lindex [lreplace $args $i $i] $i]
switch -- $Format($w) {
"%d.%m.%Y" { # German
}
"%m/%d/%Y" { # English
}
"%Y-%m-%d" { # ISO
}
default { # Error
error "ERROR: Unknown value for option -format on datefield $w $args"
}
}
set args [lreplace $args $i $i]
set args [lreplace $args $i $i]
}
set Separator($w) [string range $Format($w) 2 2]
eval $entry $w -width 10 -justify center $args
if {([$w get] eq "") \
|| [catch {clock scan [$w get] -format $Format($w)} base]} {
$w delete 0 end
$w insert end [clock format [clock seconds] -format $Format($w)]
}
$w icursor 0
bind $w <KeyPress> [list ::datefield::KeyPress $w %A %K %s]
bind $w <MouseWheel> [list ::datefield::MouseWheel $w %D]
bind $w <Button1-Motion> break
bind $w <Button2-Motion> break
bind $w <Double-Button> break
bind $w <Triple-Button> break
bind $w <2> break
return $w
}
proc Spin {w dir unit code} {
variable Format
set base [clock scan [$w get] -format $Format($w)]
set new [clock add $base $dir $unit]
set date [clock format $new -format $Format($w)]
set icursor [$w index insert]
$w delete 0 end
$w insert end $date
$w icursor $icursor
return $code
}
proc MouseWheel {w dir} {
$w selection clear
set Dir [expr {$dir / 120}]
return -code [Spin $w $Dir "day" continue]
}
# internal routine for all key presses in the datefield entry widget
proc KeyPress {w char sym state} {
variable Format
variable Separator
proc Move {w dir} {
variable Format
set icursor [$w index insert]
set icursor [expr {($icursor + 10 + $dir) % 10}]
if {$Format($w) ne "%Y-%m-%d"} { # English or German
if {($icursor == 2) || ($icursor == 5)} { # Don't land on a / or .
set icursor [expr {($icursor + 10 + $dir) % 10}]
}
} \
elseif {($icursor == 4) || ($icursor == 7)} { # ISO # Don't land on a -
set icursor [expr {($icursor + 10 + $dir) % 10}]
}
$w icursor $icursor
}
set icursor [$w index insert]
$w selection clear
# Handle some non-number characters first
switch -exact -- $sym {
"Down" {return -code [Spin $w -1 "day" continue]}
"End" {$w icursor 9; return -code break}
"minus" {return -code [Spin $w -1 "day" break]}
"Next" {return -code [Spin $w -1 "month" continue]}
"plus" {return -code [Spin $w 1 "day" break]}
"Prior" {return -code [Spin $w 1 "month" continue]}
"Up" {return -code [Spin $w 1 "day" continue]}
"BackSpace" -
"Delete" -
"Left" {Move $w -1; return -code break}
"Right" {Move $w 1; return -code break}
"Tab" {
if {$Format($w) ne "%Y-%m-%d"} { # English or German
if {($state & 5) == 0} { # ->|
if {$icursor < 3} { # from 1st to 2nd
$w icursor 3
} \
elseif {$icursor < 6} { # from 2nd to 10th-year
$w icursor 8
} else { # next widget
return -code continue
}
} \
elseif {$icursor > 4} { # |<-
$w icursor 3 ;# from year to 2nd
} \
elseif {$icursor > 1} { # from 2nd to 1st
$w icursor 0
} else { # previous widget
return -code continue
}
} \
elseif {($state & 5) == 0} { # ->| ISO
if {$icursor < 5} { # from year to month
$w icursor 5
} \
elseif {$icursor < 8} { # from month to day
$w icursor 8
} else { # next widget
return -code continue
}
} \
elseif {$icursor > 6} { # |<-
$w icursor 5 ;# from day to month
} \
elseif {$icursor > 2} { # from month to 10th-year
$w icursor 2
} else { # previous widget
return -code continue
}
return -code break
}
}
if {$char eq ""} { # remaining special keys
return -code continue
}
if {! [regexp -- {[0-9]} $char]} { # Unknown character
bell
return -code break
}
if {$icursor >= 10} { # Can't add beyond end
bell
return -code break
}
switch -- $Separator($w) {
"." { # German
foreach {day month year} [split [$w get] $Separator($w)] break
if {$icursor < 2} { # DAY SECTION
set endday [lastDay $month $year]
foreach {d1 d2} [split $day ""] break
set cursor 3 ;# Where to leave the cursor
if {$icursor == 0} { # 1st digit of day
if {($char < 3) \
|| (($char == 3) && ($month ne "02"))} {
set day "$char$d2"
if {$day eq "00"} {set day "01"}
if {$day > $endday} {set day $endday}
set cursor 1
} else {
set day "0$char"
}
} else { # 2nd digit of day
set day "$d1$char"
if {($day > $endday) || ($day eq "00")} {
bell
return -code break
}
}
$w delete 0 2
$w insert 0 $day
$w icursor $cursor
return -code break
}
if {$icursor < 5} { # MONTH SECTION
foreach {m1 m2} [split $month ""] break
set cursor 6 ;# Where to leave the cursor
if {$icursor == 3} { # 1st digit of month
if {$char < 2} {
set month "$char$m2"
set cursor 4
} else {
set month "0$char"
}
if {$month > 12} {set month "10"}
if {$month eq "00"} {set month "01"}
} else { # 2nd digit of month
set month "$m1$char"
if {$month > 12} {set month "0$char"}
if {$month eq "00"} {
bell
return -code break
}
}
$w delete 3 5
$w insert 3 $month
# Validate the day of the month
if {$day > [set endday [lastDay $month $year]]} {
$w delete 0 2
$w insert 0 $endday
}
$w icursor $cursor
return -code break
}
set y1 [string range $year 0 0]; # YEAR SECTION
if {$icursor < 7} { # 1st digit of year
if {($char ne "1") && ($char ne "2")} {
bell
return -code break
}
if {$char != $y1} { # Different century
set y 1999
if {$char eq "2"} {set y 2000}
$w delete 6 end
$w insert end $y
}
$w icursor 7
return -code break
}
$w delete $icursor
$w insert $icursor $char
if {[catch {clock scan [$w get] -format $Format($w)}] != 0} { # Validate the year
$w delete 6 end
$w insert end $year ;# Put back in the old year
$w icursor $icursor
bell
}
}
"/" { # English
foreach {month day year} [split [$w get] $Separator($w)] break
if {$icursor < 2} { # MONTH SECTION
foreach {m1 m2} [split $month ""] break
set cursor 3 ;# Where to leave the cursor
if {$icursor == 0} { # 1st digit of month
if {$char < 2} {
set month "$char$m2"
set cursor 1
} else {
set month "0$char"
}
if {$month > 12} {set month "10"}
if {$month eq "00"} {set month "01"}
} else { # 2nd digit of month
set month "$m1$char"
if {$month > 12} {set month "0$char"}
if {$month eq "00"} {
bell
return -code break
}
}
$w delete 0 2
$w insert 0 $month
# Validate the day of the month
if {$day > [set endday [lastDay $month $year]]} {
$w delete 3 5
$w insert 3 $endday
}
$w icursor $cursor
return -code break
}
if {$icursor < 5} { # DAY SECTION
set endday [lastDay $month $year]
foreach {d1 d2} [split $day ""] break
set cursor 6 ;# Where to leave the cursor
if {$icursor == 3} { # 1st digit of day
if {($char < 3) \
|| (($char == 3) && ($month ne "02"))} {
set day "$char$d2"
if {$day eq "00"} {set day "01"}
if {$day > $endday} {set day $endday}
set cursor 4
} else {
set day "0$char"
}
} else { # 2nd digit of day
set day "$d1$char"
if {($day > $endday) || ($day eq "00")} {
bell
return -code break
}
}
$w delete 3 5
$w insert 3 $day
$w icursor $cursor
return -code break
}
set y1 [string range $year 0 0]; # YEAR SECTION
if {$icursor < 7} { # 1st digit of year
if {($char ne "1") && ($char ne "2")} {
bell
return -code break
}
if {$char != $y1} { # Different century
set y 1999
if {$char eq "2"} {set y 2000}
$w delete 6 end
$w insert end $y
}
$w icursor 7
return -code break
}
$w delete $icursor
$w insert $icursor $char
if {[catch {clock scan [$w get] -format $Format($w)}] != 0} { # Validate the year
$w delete 6 end
$w insert end $year ;# Put back in the old year
$w icursor $icursor
bell
}
}
default { # ISO
foreach {year month day} [split [$w get] $Separator($w)] break
if {$icursor < 4} { # YEAR SECTION
set y1 [string range $year 0 0];
if {$icursor == 0} { # 1st digit of year
if {($char ne "1") && ($char ne "2")} {
bell
return -code break
}
if {$char != $y1} { # Different century
set y 1999
if {$char eq "2"} {set y 2000}
$w delete 0 4
$w insert 0 $y
}
$w icursor 1
return -code break
}
$w delete $icursor
$w insert $icursor $char
if {[catch {clock scan [$w get] -format $Format($w)}] != 0} { # Validate the year
$w delete 0 4
$w insert 0 $year ;# Put back in the old year
$w icursor $icursor
bell
}
if {$icursor == 3} { # last digit of year
$w icursor 5 ;# Don't land on a -
}
return -code break
}
if {$icursor < 7} { # MONTH SECTION
foreach {m1 m2} [split $month ""] break
set cursor 8 ;# Where to leave the cursor
if {$icursor == 5} { # 1st digit of month
if {$char < 2} {
set month "$char$m2"
set cursor 6
} else {
set month "0$char"
}
if {$month > 12} {set month "10"}
if {$month eq "00"} {set month "01"}
} else { # 2nd digit of month
set month "$m1$char"
if {$month > 12} {set month "0$char"}
if {$month eq "00"} {
bell
return -code break
}
}
$w delete 5 7
$w insert 5 $month
# Validate the day of the month
if {$day > [set endday [lastDay $month $year]]} {
$w delete 8 end
$w insert end $endday
}
$w icursor $cursor
return -code break
}
set endday [lastDay $month $year] ;# DAY SECTION
foreach {d1 d2} [split $day ""] break
set cursor 10 ;# Where to leave the cursor
if {$icursor == 8} { # 1st digit of day
if {($char < 3) \
|| (($char == 3) && ($month ne "02"))} {
set day "$char$d2"
if {$day eq "00"} {set day "01"}
if {$day > $endday} {set day $endday}
set cursor 9
} else {
set day "0$char"
}
} else { # 2nd digit of day
set day "$d1$char"
if {($day > $endday) || ($day eq "00")} {
bell
return -code break
}
}
$w delete 8 end
$w insert end $day
$w icursor $cursor
}
}
return -code break
}
# internal routine that returns the last valid day of a given month and year
proc lastDay {month year} {
return [clock format [clock scan "+1 month -1 day" \
-base [clock scan "$month/01/$year"]] -format %d]
}
}
