1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: entrychk.tcl,v 2.13 2005/02/07 21:47:05 jfontain Exp $
proc setupEntryValidation {path scripts {mode key}} {
if {[llength $scripts] == 0} return
$path configure -validate $mode -invalidcommand bell
foreach script $scripts {
if {[info exists command]} {
append command &&
} else {
set command "expr \{"
}
append command "\[$script\]"
}
append command \}
$path configure -validatecommand $command
}
proc check31BitUnsignedInteger {string} {
if {![regexp {^[0-9]*$} $string] || [regexp {^0[0-9]} $string]} {return 0}
return [string is integer $string] ;# disallow leading 0s not accepted by string integer command and accept empty string
}
proc check32BitSignedInteger {string} {
if {[string equal $string -]} {return 1} ;# starting typing...
if {![regexp {^-?[0-9]*$} $string] || [regexp {^-?0[0-9]} $string] || [string equal $string -0]} {return 0}
return [string is integer $string] ;# disallow leading 0s not accepted by string integer command and accept empty string
}
proc checkFloatingPoint {string} {
if {[string equal $string -]} {return 1} ;# starting typing...
if {![regexp {^-?[0-9]*\.?[0-9]*$} $string] || [regexp {^-?0[0-9]} $string]} {return 0} ;# disallow leading 0s
return [string is double $string] ;# accept empty string, disallow numbers starting with . (use 0. instead)
}
proc checkMaximumLength {length string} {
return [expr {[string length $string] <= $length}]
}
|
