Purpose: provide examples of how to apply edits to an entry widget.
For a really good example of entry field processing, look at Jeff Hobbs' Entry Widget Validation Demo at https://www.tcl-lang.org/community/hobbs/tcl/ .
Follow the link to Tcl Plugins, then to the validation demo.
Todd M. Helfter writes:
Larry
Here is one that I use to limit the length of an entry.
I am not sure if this is what you want. As this just removes any character typed past the length specified, this could be modified to apply any business rule you want. (handles both variables and arrays)
Todd
I use it like this
entry $win.e$ix \
-width $c_len \
-textvariable ::app($win,$c_name)
trace add variable ::app($win,$c_name) write "limitEntry $c_len"
# .-------------.------------------------------------------------------.
# | procedure | limitEntry |
# | purpose | Limit the maximum size of an entry. |
# | date | (10/11/96) |
# `-------------^------------------------------------------------------'
proc limitEntry {args} {
if {[llength $args] == 4} {
set wid [lindex $args 0]
set var [lindex $args 1]
set idx [lindex $args 2]
global [set var]
if {[string length $idx] > 0} {
set str [lindex [array get [set var] $idx] 1]
if {[string length $str] > $wid} {
set str [string range $str 0 end-1]
array set [set var] [list $idx $str]
}
} else {
set str [set [set var]]
if {[string length $str] > $wid} {
set str [string range $str 0 end-1]
set [set var] $str
}
}
}
}MG offers another way to do it, using entry's -validate and -validatecommand options:
entry $win -width $c_len \
-textvariable varName \
-validate key -validatecommand {expr [string length %P]<$c_len}JH writes:
# tkFormat --
# This procedure attempts to format a value into a particular format string.
#
# Arguments:
# format - The format to fit
# val - The value to be validated
#
# Returns: 0 or 1 (whether it fits the format or not)
#
# Switches:
# -fill ?var? - Default values will be placed to fill format to spec
# and the resulting value will be placed in variable 'var'.
# It will equal {} if the match invalid
# (doesn't work all that great currently)
# -best ?var? - 'Fixes' value to fit format, placing best correct value
# in variable 'var'. If current value is ok, the 'var'
# will equal it, otherwise it removes chars from the end
# until it fits the format, then adds any fixed format
# chars to value. Can be slow (recursive tkFormat op).
# -strict - Value must be an exact match for format (format && length)
# -- - End of switches
proc tkFormat {args} {
set fill {}; set strict 0; set best {}; set result 1;
set name [lindex [info level 0] 0]
while {[string match {-*} [lindex $args 0]]} {
switch -- [string index [lindex $args 0] 1] {
b {
set best [lindex $args 1]
set args [lreplace $args 0 1]
}
f {
set fill [lindex $args 1]
set args [lreplace $args 0 1]
}
s {
set strict 1
set args [lreplace $args 0 0]
}
- {
set args [lreplace $args 0 0]
break
}
default {
return -code error "bad $name option \"[lindex $args 0]\",\
must be: -best, -fill, -strict, or --"
}
}
}
if {[llength $args] != 2} {
return -code error "wrong \# args: should be \"$name ?-best varname?\
?-fill varname? ?-strict? ?--? format value\""
}
set format [lindex $args 0]
set val [lindex $args 1]
set flen [string length $format]
set slen [string length $val]
if {$slen > $flen} {set result 0}
if {$strict && ($slen != $flen)} { set result 0 }
if {$result} {
set regform {}
for {set i 0} {$i < $slen} {incr i} {
set c [string index $format $i]
if {$c == "\\"} {
set c [string index $format [incr i]]
} else {
switch -- $c {
0 { set c {[[:digit:]]} }
A { set c {[[:upper:]]} }
a { set c {[[:lower:]]} }
W { set c {[[:space:]]} }
z { set c {[[:alpha:]]} }
Z { set c {[[:alnum:]]} }
+ - * - - - ? - \[ - \] - \( - \) - \{ - \} - \^ - \$ - . -
\\ { set c "\\$c" }
default {}
}
}
lappend regform $c
}
#puts [list $regform $format $val]
set result [regexp -- [join $regform {}] $val]
}
if {[string compare $fill {}]} {
upvar $fill fvar
if {$result} {
set fvar $val[string range $format $i end]
} else {
set fvar {}
}
}
if {[string compare $best {}]} {
upvar $best bvar
set bvar $val
set len [string length $bvar]
if {!$result} {
incr len -2
set bvar [string range $bvar 0 $len]
# Remove characters until it's in valid format
while {$len > 0 && ![tkFormat $format $bvar]} {
set bvar [string range $bvar 0 [incr len -1]]
}
# Add back characters that are fixed
while {($len<$flen) && ![string match \
{[0AaWzZ]} [string index $format [incr len]]]} {
append bvar [string index $format $len]
}
} else {
# If it's already valid, at least we can add fixed characters
while {($len<$flen) && ![string match \
{[0AaWzZ]} [string index $format $len]]} {
append bvar [string index $format $len]
incr len
}
}
}
return $result
}Then do something like:
label .l4 -text "A phone number formatted widget:\
\n(###) ###-####"
pack .l4
entry .e4 -vcmd {tkFormat -best tmp {(000) 000-0000} %P} -validate key\
-invcmd {
bell
%W delete 0 end
%W insert 0 $tmp
after idle %W configure -validate key
}
pack .e4Synic Just an addition to the switch statement of the above tkFormat proc to allow matching on all characters. Sometimes you want to limit field length but not character type.
. { set c {.} }Mentry [L1 ] is hard to beat for these purposes. It's pure Tcl.
See also: timeentry