| # entry2.tcl -- |
| # |
| # This demonstration script creates several entry widgets whose |
| # permitted input is constrained in some way. It also shows off a |
| # password entry. |
| # |
| # RCS: @(#) $Id: entry3.tcl,v 1.3 2003/01/21 20:24:47 hunt Exp $ |
| |
| if {![info exists widgetDemo]} { |
| error "This script should be run from the \"widget\" demo." |
| } |
| |
| set w .entry3 |
| catch {destroy $w} |
| toplevel $w |
| wm title $w "Constrained Entry Demonstration" |
| wm iconname $w "entry3" |
| positionWindow $w |
| |
| |
| label $w.msg -font $font -wraplength 5i -justify left -text "Four different\ |
| entries are displayed below. You can add characters by pointing,\ |
| clicking and typing, though each is constrained in what it will\ |
| accept. The first only accepts integers or the empty string\ |
| (checking when focus leaves it) and will flash to indicate any\ |
| problem. The second only accepts strings with fewer than ten\ |
| characters and sounds the bell when an attempt to go over the limit\ |
| is made. The third accepts US phone numbers, mapping letters to\ |
| their digit equivalent and sounding the bell on encountering an\ |
| illegal character or if trying to type over a character that is not\ |
| a digit. The fourth is a password field that accepts up to eight\ |
| characters (silently ignoring further ones), and displaying them as\ |
| asterisk characters." |
| |
| frame $w.buttons |
| button $w.buttons.dismiss -text Dismiss -command "destroy $w" |
| button $w.buttons.code -text "See Code" -command "showCode $w" |
| pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 |
| |
| |
| # focusAndFlash -- |
| # Error handler for entry widgets that forces the focus onto the |
| # widget and makes the widget flash by exchanging the foreground and |
| # background colours at intervals of 200ms (i.e. at approximately |
| # 2.5Hz). |
| # |
| # Arguments: |
| # W - Name of entry widget to flash |
| # fg - Initial foreground colour |
| # bg - Initial background colour |
| # count - Counter to control the number of times flashed |
| |
| proc focusAndFlash {W fg bg {count 9}} { |
| focus -force $W |
| if {$count<1} { |
| $W configure -foreground $fg -background $bg |
| } else { |
| if {$count%2} { |
| $W configure -foreground $bg -background $fg |
| } else { |
| $W configure -foreground $fg -background $bg |
| } |
| after 200 [list focusAndFlash $W $fg $bg [expr {$count-1}]] |
| } |
| } |
| |
| labelframe $w.l1 -text "Integer Entry" |
| entry $w.l1.e -validate focus -vcmd {string is integer %P} |
| $w.l1.e configure -invalidcommand \ |
| "focusAndFlash %W [$w.l1.e cget -fg] [$w.l1.e cget -bg]" |
| pack $w.l1.e -fill x -expand 1 -padx 1m -pady 1m |
| |
| labelframe $w.l2 -text "Length-Constrained Entry" |
| entry $w.l2.e -validate key -invcmd bell -vcmd {expr {[string length %P]<10}} |
| pack $w.l2.e -fill x -expand 1 -padx 1m -pady 1m |
| |
| ### PHONE NUMBER ENTRY ### |
| # Note that the source to this is quite a bit longer as the behaviour |
| # demonstrated is a lot more ambitious than with the others. |
| |
| # Initial content for the third entry widget |
| set entry3content "1-(000)-000-0000" |
| # Mapping from alphabetic characters to numbers. This is probably |
| # wrong, but it is the only mapping I have; the UK doesn't really go |
| # for associating letters with digits for some reason. |
| set phoneNumberMap {} |
| foreach {chars digit} {abc 2 def 3 ghi 4 jkl 5 mno 6 pqrs 7 tuv 8 wxyz 9} { |
| foreach char [split $chars ""] { |
| lappend phoneNumberMap $char $digit [string toupper $char] $digit |
| } |
| } |
| |
| # validatePhoneChange -- |
| # Checks that the replacement (mapped to a digit) of the given |
| # character in an entry widget at the given position will leave a |
| # valid phone number in the widget. |
| # |
| # W - The entry widget to validate |
| # vmode - The widget's validation mode |
| # idx - The index where replacement is to occur |
| # char - The character (or string, though that will always be |
| # refused) to be overwritten at that point. |
| |
| proc validatePhoneChange {W vmode idx char} { |
| global phoneNumberMap entry3content |
| if {$idx == -1} {return 1} |
| after idle [list $W configure -validate $vmode -invcmd bell] |
| if { |
| !($idx<3 || $idx==6 || $idx==7 || $idx==11 || $idx>15) && |
| [string match {[0-9A-Za-z]} $char] |
| } then { |
| $W delete $idx |
| $W insert $idx [string map $phoneNumberMap $char] |
| after idle [list phoneSkipRight $W -1] |
| return 1 |
| } |
| return 0 |
| } |
| |
| # phoneSkipLeft -- |
| # Skip over fixed characters in a phone-number string when moving left. |
| # |
| # Arguments: |
| # W - The entry widget containing the phone-number. |
| |
| proc phoneSkipLeft {W} { |
| set idx [$W index insert] |
| if {$idx == 8} { |
| # Skip back two extra characters |
| $W icursor [incr idx -2] |
| } elseif {$idx == 7 || $idx == 12} { |
| # Skip back one extra character |
| $W icursor [incr idx -1] |
| } elseif {$idx <= 3} { |
| # Can't move any further |
| bell |
| return -code break |
| } |
| } |
| |
| # phoneSkipRight -- |
| # Skip over fixed characters in a phone-number string when moving right. |
| # |
| # Arguments: |
| # W - The entry widget containing the phone-number. |
| # add - Offset to add to index before calculation (used by validation.) |
| |
| proc phoneSkipRight {W {add 0}} { |
| set idx [$W index insert] |
| if {$idx+$add == 5} { |
| # Skip forward two extra characters |
| $W icursor [incr idx 2] |
| } elseif {$idx+$add == 6 || $idx+$add == 10} { |
| # Skip forward one extra character |
| $W icursor [incr idx] |
| } elseif {$idx+$add == 15 && !$add} { |
| # Can't move any further |
| bell |
| return -code break |
| } |
| } |
| |
| labelframe $w.l3 -text "US Phone-Number Entry" |
| entry $w.l3.e -validate key -invcmd bell -textvariable entry3content \ |
| -vcmd {validatePhoneChange %W %v %i %S} |
| # Click to focus goes to the first editable character... |
| bind $w.l3.e <FocusIn> { |
| if {"%d" ne "NotifyAncestor"} { |
| %W icursor 3 |
| after idle {%W selection clear} |
| } |
| } |
| bind $w.l3.e <Left> {phoneSkipLeft %W} |
| bind $w.l3.e <Right> {phoneSkipRight %W} |
| pack $w.l3.e -fill x -expand 1 -padx 1m -pady 1m |
| |
| labelframe $w.l4 -text "Password Entry" |
| entry $w.l4.e -validate key -show "*" -vcmd {expr {[string length %P]<=8}} |
| pack $w.l4.e -fill x -expand 1 -padx 1m -pady 1m |
| |
| lower [frame $w.mid] |
| grid $w.l1 $w.l2 -in $w.mid -padx 3m -pady 1m -sticky ew |
| grid $w.l3 $w.l4 -in $w.mid -padx 3m -pady 1m -sticky ew |
| grid columnconfigure $w.mid {0 1} -uniform 1 |
| pack $w.msg -side top |
| pack $w.buttons -side bottom -fill x -pady 2m |
| pack $w.mid -fill both -expand 1 |
