An i15d date chooser
Summary
Richard Suchenwirth 2001-06-25: i15d: internationalized. This is the second attempt at a calendar widget (for the first see A little date chooser). Instead of fiddling packer geometry, it now has all controls on a canvas; displays days in neighboring months (grayed out, not selectable); you can configure the weekday sequence to start with Sunday or Monday; but best of all, allows on-the-fly reconfiguration of the language used for month and weekday names. Language data is provided for English, German, French, Greek, Italian, Russian, Swedish, Hebrew and Chinese; feel free to add more. Enjoy!
See Also
Description
Someone added Japanese (ja). MS did Spanish. JCW did Dutch (nl). GP-L added some missing accents in French (fr). [name redacted] added Swedish (sv). ECS added Portuguese (pt). NB added Greek (gr). WJP added Plains Cree (crk), Nak'albun (Stuart Lake) dialect Carrier (crx-nak, and Lheidli dialect Carrier (crx-lhe). I'm afraid these disrupt the alignment of the radiobuttons, but the dialects are different and in any case two-letter language codes are passe.
LV and RS talked (was it chat or email) about the use of embedded data vs. the use of the tcl msgcat catalog functions. The pro of this is that one could, with proper coding, add new languages without change to the software, and could get some reuse out of the data.
RS pointed out the cons - he didn't want to use the msgcat - he wanted an all-in-one tcl script rather than a series of files. Perhaps both could be accomodated by someone providing some tcl scripts that take embedded tcl data and writing it out to the msg cat; that way, the app could create/update one's msgcat if new info were available....
VL 2003-06-07: Perhaps you are looking for msgcatx? Extracts msgcat-catalogues with some comments on where in the code and also the sort of object the string is contained in. Part of my Mimers brunn project [L1 ], not done much work since last spring, but it is definitely usable and I'll be working on a UI to it when I get some spare time.''
CLN: It's not clear to me why msgcat and "all-in-one tcl script" are incompatible? A message catalog is just a Tcl script with one or more mcset or mcmset commands. Can't we have:
mcset en Mon Monday mcset it Mon Lunedi ...
or
mcmset en {
Mon Monday
Tue Tuesday
...
}
mcmset it {
Mon Lunedi
Tue Martedi
...
}
...at the top of the script?
RS: In my mind, this adds complexity without necessity. The day and month names are lists so one can index into them. Making them scalar as proposed would not make the code simpler...
VL 2003-06-07: For small scripts this would be feasible, but it sort of takes the point out of localization, the idea is to make it easy to translate without having to go into the code and do changes.
LV: For that matter - perhaps some kind of conditional command - if this catalog entry does not exist, then create it. However, the user would have to have write permission in the catalog area - something that many of us would be unlikely to want to provide.
VL 2003-06-07: The default if a catalogue is missing is to use the initial message, or en if it is provided. For a good idea of how to work with localizing your applications do take a look at the Free Translation Project
SH 2003-07-08: Fixed bug in which days for 'pt' display instead of english, and 'pt' missing.
When I resize this widget, the numbers and words don't grow - is there a way to code Tk widgets so that one can change the size (so that old people can read the words...).
package require msgcat
package require Tk
namespace eval date {
proc chooser {w args} {
variable $w
variable defaults
array set $w [array get defaults]
upvar 0 $w a
set now [clock scan now]
set a(year) [clock format $now -format "%Y"]
scan [clock format $now -format "%m"] %d a(month)
scan [clock format $now -format "%d"] %d a(day)
array set a {
-font {Helvetica 9} -titlefont {Helvetica 12} -bg white
-highlight orange -mon 1 -language en -textvariable {}
-command {} -clockformat "%m/%d/%Y" -showpast 1
}
# The -mon switch gives the position of Monday (1 or 0)
array set a $args
set a(canvas) [canvas $w -bg $a(-bg) -width 200 -height 180]
$w bind day <1> {
set item [%W find withtag current]
set date::%W(day) [%W itemcget $item -text]
date::display %W
date::HandleCallback %W
}
if { $a(-textvariable) ne {} } {
set tmp [set $a(-textvariable)]
if {$tmp ne {} } {
set date [clock scan $tmp -format $a(-clockformat)]
set a(thisday) [clock format $date -format %d]
set a(thismonth) [clock format $date -format %m]
set a(thisyear) [clock format $date -format %Y]
}
}
cbutton $w 60 10 << {date::adjust %W 0 -1}
cbutton $w 80 10 < {date::adjust %W -1 0}
cbutton $w 120 10 > {date::adjust %W 1 0}
cbutton $w 140 10 >> {date::adjust %W 0 1}
display $w
set w
}
proc adjust {w dmonth dyear} {
variable $w
upvar 0 $w a
incr a(year) $dyear
incr a(month) $dmonth
if {$a(month)>12} {set a(month) 1; incr a(year)}
if {$a(month)<1} {set a(month) 12; incr a(year) -1}
set maxday [numberofdays $a(month) $a(year)]
if {$maxday < $a(day)} {set a(day) $maxday}
display $w
}
proc display {w} {
variable $w
upvar 0 $w a
set c $a(canvas)
foreach tag {title otherday day} {$c delete $tag}
set x0 20; set x $x0; set y 50
set dx 25; set dy 20
set xmax [expr {$x0+$dx*6}]
set a(date) [clock scan $a(month)/$a(day)/$a(year)]
set title [formatMY $w [monthname $w $a(month)] $a(year)]
$c create text [expr ($xmax+$dx)/2] 30 -text $title -fill blue \
-font $a(-titlefont) -tag title
set weekdays $a(weekdays,$a(-language))
if !$a(-mon) {lcycle weekdays}
foreach i $weekdays {
$c create text $x $y -text $i -fill blue \
-font $a(-font) -tag title
incr x $dx
}
set first $a(month)/1/$a(year)
set weekday [clock format [clock scan $first] -format %w]
if !$a(-mon) {set weekday [expr {($weekday+6)%7}]}
set x [expr {$x0+$weekday*$dx}]
set x1 $x; set offset 0
incr y $dy
while {$weekday} {
set t [clock scan "$first [incr offset] days ago"]
scan [clock format $t -format "%d"] %d day
$c create text [incr x1 -$dx] $y -text $day \
-fill grey -font $a(-font) -tag otherday
incr weekday -1
}
set dmax [numberofdays $a(month) $a(year)]
for {set d 1} {$d<=$dmax} {incr d} {
if {($a(-showpast) == 0) && ($d<$a(thisday)) && ($a(month) <= $a(thismonth)) \
&& ($a(year) <= $a(thisyear)) } {
set id [$c create text $x $y -text $d -fill grey -tag otherday -font $a(-font)]
} else {
set id [$c create text $x $y -text $d -tag day -font $a(-font)]
}
if {$d==$a(day)} {
eval $c create rect [$c bbox $id] \
-fill $a(-highlight) -outline $a(-highlight) -tag day
}
$c raise $id
if {[incr x $dx]>$xmax} {set x $x0; incr y $dy}
}
if {$x != $x0} {
for {set d 1} {$x<=$xmax} {incr d; incr x $dx} {
$c create text $x $y -text $d \
-fill grey -font $a(-font) -tag otherday
}
}
if { $a(-textvariable) ne {} } {
# puts "[info level 0]: $a(-clockformat)"
set $a(-textvariable) [clock format $a(date) -format $a(-clockformat)]
}
}
proc HandleCallback {w} {
variable $w
upvar 0 $w a
if { $a(-command) ne {} } {
uplevel \#0 $a(-command)
}
}
proc formatMY {w month year} {
variable $w
upvar 0 $w a
if ![info exists a(format,$a(-language))] {
set format "%m %y" ;# default
} else {set format $a(format,$a(-language))}
foreach {from to} [list %m $month %y $year] {
regsub $from $format $to format
}
subst $format
}
proc monthname {w month {language default}} {
variable $w
upvar 0 $w a
if {$language=="default"} {set language $a(-language)}
if {[info exists a(mn,$language)]} {
set res [lindex $a(mn,$language) $month]
} else {set res $month}
}
variable defaults
array set defaults {
-language en
mn,crk {
. Kis\u01E3p\u012Bsim Mikisiwip\u012Bsim Niskip\u012Bsim Ay\u012Bkip\u012Bsim
S\u0101kipak\u0101wip\u012Bsim
P\u0101sk\u0101wihowip\u012Bsim Paskowip\u012Bsim Ohpahowip\u012Bsim
N\u014Dcihitowip\u012Bsim Pin\u0101skowip\u012Bsim Ihkopiwip\u012Bsim
Paw\u0101cakinas\u012Bsip\u012Bsim
}
weekdays,crk {P\u01E3 N\u01E3s Nis N\u01E3 Niy Nik Ay}
mn,crx-nak {
. {Sacho Ooza'} {Chuzsul Ooza'} {Chuzcho Ooza'} {Shin Ooza'} {Dugoos Ooza'} {Dang Ooza'}\
{Talo Ooza'} {Gesul Ooza'} {Bit Ooza'} {Lhoh Ooza'} {Banghan Nuts'ukih} {Sacho Din'ai}
}
weekdays,crx-nak {Ji Jh WN WT WD Ts Sa}
mn,crx-lhe {
. {'Elhdzichonun} {Yussulnun} {Datsannadulhnun} {Dulats'eknun} {Dugoosnun} {Daingnun}\
{Gesnun} {Nadlehcho} {Nadlehyaz} {Lhewhnandelnun} {Benats'ukuihnun} {'Elhdziyaznun}
}
weekdays,crx-lhe {Ji Jh WN WT WD Ts Sa}
mn,de {
. Januar Februar März April Mai Juni Juli August
September Oktober November Dezember
}
weekdays,de {So Mo Di Mi Do Fr Sa}
mn,en {
. January February March April May June July August
September October November December
}
weekdays,en {Sun Mon Tue Wed Thu Fri Sat}
mn,es {
. Enero Febrero Marzo Abril Mayo Junio Julio Agosto
Septiembre Octubre Noviembre Diciembre
}
weekdays,es {Do Lu Ma Mi Ju Vi Sa}
mn,fr {
. Janvier Février Mars Avril Mai Juin Juillet Août
Septembre Octobre Novembre Décembre
}
weekdays,fr {Di Lu Ma Me Je Ve Sa}
mn,gr {
. Ιανουάριοs Φεβρουάριοs Μάρτιοs Απρίλιοs Μάιοs Ιούνιοs Ιούλιοs Αύγουστοs Σεπτέμβριοs Οκτώβριοs Νοέμβριοs Δεκέμβριοs
}
weekdays,gr {Δε Τρ Τε Πε Πα Σα Κυ}
mn,he {
. ינואר פברואר מרץ אפריל מאי יוני יולי אוגוסט ספטמבר אוקטובר נובמבר דצמבר
}
weekdays,he {ר×ýýש×ýý×ýý ש× ×ýý ש×ýý×ýýש×ýý ר×ýý×ýýע×ýý ×ýý×ýý×ýýש×ýý ש×ýýש×ýý ש×ýýת}
mn,it {
. Gennaio Febraio Marte Aprile Maggio Giugno Luglio Agosto
Settembre Ottobre Novembre Dicembre
}
weekdays,it {Do Lu Ma Me Gi Ve Sa}
format,ja {%y\u5e74 %m\u6708}
weekdays,ja {\u65e5 \u6708 \u706b \u6c34 \u6728 \u91d1 \u571f}
mn,nl {
. januari februari maart april mei juni juli augustus
september oktober november december
}
weekdays,nl {Zo Ma Di Wo Do Vr Za}
mn,ru {
. \u042F\u043D\u0432\u0430\u0440\u044C
\u0424\u0435\u0432\u0440\u0430\u043B\u044C \u041C\u0430\u0440\u0442
\u0410\u043F\u0440\u0435\u043B\u044C \u041C\u0430\u0439
\u0418\u044E\u043D\u044C \u0418\u044E\u043B\u044C
\u0410\u0432\u0433\u0443\u0441\u0442
\u0421\u0435\u043D\u0442\u044F\u0431\u0440\u044C
\u041E\u043A\u0442\u044F\u0431\u0440\u044C \u041D\u043E\u044F\u0431\u0440\u044C
\u0414\u0435\u043A\u0430\u0431\u0440\u044C
}
weekdays,ru {
\u432\u43e\u441 \u43f\u43e\u43d \u432\u442\u43e \u441\u440\u435
\u447\u435\u442 \u43f\u44f\u442 \u441\u443\u431
}
mn,sv {
. januari februari mars april maj juni juli augusti
september oktober november december
}
weekdays,sv {s\u00F6n m\u00E5n tis ons tor fre l\u00F6r}
mn,pt {
. Janeiro Fevereiro Mar\u00E7o Abril Maio Junho
Julho Agosto Setembro Outubro Novembro Dezembro
}
weekdays,pt {Dom Seg Ter Qua Qui Sex Sab}
format,zh {%y\u5e74 %m\u6708}
mn,zh {
. \u4e00 \u4e8c \u4e09 \u56db \u4e94 \u516d \u4e03
\u516b \u4e5d \u5341 \u5341\u4e00 \u5341\u4e8c
}
weekdays,zh {\u65e5 \u4e00 \u4e8c \u4e09 \u56db \u4e94 \u516d}
mn,fi {
. Tammikuu Helmikuu Maaliskuu Huhtikuu Toukokuu Kesäkuu
Heinäkuu Elokuu Syyskuu Lokakuu Marraskuu Joulukuu
}
weekdays,fi {Ma Ti Ke To Pe La Su}
mn,tr {
. Ocak Şubat Mart Nisan Mayıs Haziran Temmuz Ağustos Eylül Ekim Kasım Aralık
}
weekdays,tr {Pt Sa Ça Pe Cu Ct Pa}
}
proc numberofdays {month year} {
if {$month==12} {set month 0; incr year}
clock format [clock scan "[incr month]/1/$year 1 day ago"] \
-format %d
}
} ;# end namespace date
proc lcycle _list {
upvar $_list list
set list [concat [lrange $list 1 end] [list [lindex $list 0]]]
}
proc cbutton {w x y text command} {
set txt [$w create text $x $y -text " $text "]
set btn [eval $w create rect [$w bbox $txt] \
-fill grey -outline grey]
$w raise $txt
foreach i [list $txt $btn] {$w bind $i <1> $command}
}
#------ test and demo code (terminate by closing the main window)
if {$argv0 eq [info script]} {
date::chooser .1
entry .2 -textvar date::.1(date)
regsub -all weekdays, [array names date::.1 weekdays,*] "" languages
foreach i [lsort $languages] {
radiobutton .b$i -text $i -variable date::.1(-language) -value $i -pady 0
}
trace variable date::.1(-language) w {date::display .1;#}
checkbutton .mon -variable date::.1(-mon) -text "Sunday starts week"
trace variable date::.1(-mon) w {date::display .1;#}
eval pack [winfo children .] -fill x -anchor w
# example 2
# requires tcl 8.5
# set german clock format
set clockformat "%d.%m.%Y"
set ::DATE [clock format [clock seconds] -format $clockformat]
set w [toplevel .x]
entry $w.date -textvariable ::DATE
button $w.b -command [list showCalendar %X %Y $clockformat]
pack $w.date $w.b -side left
proc showCalendar { x y clockformat} {
puts "begin $::DATE"
set w [toplevel .d]
wm overrideredirect $w 1
frame $w.f -borderwidth 2 -relief solid -takefocus 0
date::chooser $w.f.d -language de \
-command [list set ::SEMA close] \
-textvariable ::DATE -clockformat $clockformat
pack $w.f.d
pack $w.f
lassign [winfo pointerxy .] x y
# puts "$x $y"
wm geometry $w "+${x}+${y}"
set _w [grab current]
if {$_w ne {} } {
grab release $_w
grab set $w
}
set ::SEMA ""
tkwait variable ::SEMA
if {$_w ne {} } {
grab release $w
grab set $_w
}
destroy $w
puts "end $::DATE"
puts [.x.date get]
}
}I certainly hope that Mozilla doesn't mangle the special characters on this page!
In the above code, everything is stored in static indexes in a single array. This means that if one needs more than one of these widgets in an application, problems occur.
The author writes, in response to my description in an email:
As "a" is in the "date" namespace, it can be easily "personalized" to the widget by changing, in the procedures
variable a
to
variable $w upvar 0 $w a
Then "a" is a proc-local name tied to the real array, named after the widget.
Some more changes are needed, as the language-specific data are also in a, and s hould remain in a single place - so better call it "msg" or so.
Sorry I can't test this right now, as I'm very busy with paywork... Maybe later.
Donald Arseneau: I applied the idea of using the widget name as the array variable name, entered above (hope that is OK). I also made the demo code run whenever you execute datechooser.tcl as the main script (wish datechooser.tcl). I also changed the name of the format proc to formatMY (format month-year) to avoid confusion. The default settings are now in the date::defaults array variable, which gives its values to each new widget created by date::chooser. After creation, the language for an instance can be changed by performing:
set date::.startdate(language) de date::display .startdate
If someone wants to come along and suggest specific code changes, let us know.
The classic Tcl calendar application is ical. Unfortunately, ical doesn't appear to be supported at this time.
hae 2008-06-03: added options: -textvariable, -command and -clockformat demonstrate usage in an example
MHo: Additional keyboard bindings would be fine (but perhaps somewhat difficult to code...) so that one can operate the widget without using a mouse ;-)