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 http://www.tcl.tk/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 variable ::app($win,$c_name) w "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 .e4 ---- [Mentry] [http://www.nemethi.de] is hard to beat for these purposes. It's pure Tcl. ---- See also: [timeentry] ---- [Category Tutorial] | [Category GUI] |