You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
188 lines
6.0 KiB
Tcl
188 lines
6.0 KiB
Tcl
# 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
|