Hopefully someone who needs to use maps for ttk::entry widgets might find this useful. With any luck I'll have transposed it correctly, and it should just work.
#
# A Tcl/Tk Data Entry poor man's template package.
# Written by Control-Q Research 2008
#
# Usage terms as with the same BSD license as Tcl/Tk.
# eg: use it for whatever you'd like ... but don't
# call me when something breaks ;-)
#
# data entry package, adds template input ...
# eg: {(999) 999-9999}
# {9999/99/99}
# {99:99:99}
# note, a <SPACE> will delete the entry ...
# sample code at bottom.
#
namespace eval de {
# map: 9 digit
# A alpha
# X Alpha numeric
# . sep character (Literal)
proc fmtChar chr {
if [string equal "9" $chr] {
return digit
}
if [string equal "A" $chr] {
return alpha
}
if [string equal "X" $chr] {
return alnum
}
return literal
}
proc Mapper { map wdg key } {
if [string equal " " $key] {
if [$wdg selection present] {
$wdg delete sel.first sel.last
return 1
}
$wdg delete 0 end
return 1
}
set val [$wdg get]
set ix [string length $val]
set mx [string length $map]
if { $ix >= $mx } {
return 0
}
set fm [string index $map $ix]
set tst [fmtChar $fm]
switch $tst {
digit -
alpha -
alnum {
if [string is $tst $key] {
return 1
}
return 0
}
literal {
while { [string equal literal $tst] == 1 } {
$wdg insert end $fm
incr ix
set fm [string index $map $ix]
set tst [fmtChar $fm]
}
if [string is $tst $key] {
$wdg insert end $key
return 1
}
return 0
}
}
return 1
}
}
# sample usage ...
package require Tk
package require Ttk
ttk::entry .e0 -width 14 -invalid bell \
-validate key -validatecom [list de::Mapper {(999) 999-9999} %W %S]
ttk::entry .e1 -width 14 -invalid bell \
-validate key -validatecom [list de::Mapper {9999/99/99} %W %S]
ttk::entry .e2 -width 14 -invalid bell \
-validate key -validatecom [list de::Mapper {99:99:99} %W %S]
pack .e0
pack .e1
pack .e2| data+entry map |
|---|