# copyright (C) 1997-2006 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.15 2006/01/28 19:16:59 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 {strict 0}} {
    # disallow leading 0s not accepted by string integer command
    if {![regexp {^[0-9]*$} $string] || [regexp {^0[0-9]} $string]} {return 0}
    if {$strict} {
        return [string is integer -strict $string]
    } else {
        return [string is integer $string]                                                                    ;# accept empty string
    }
}

proc check32BitSignedInteger {string {strict 0}} {
    if {[string equal $string -]} {return 1}                                                                  ;# starting typing...
    # disallow leading 0s not accepted by string integer command
    if {![regexp {^-?[0-9]*$} $string] || [regexp {^-?0[0-9]} $string] || [string equal $string -0]} {return 0}
    if {$strict} {
        return [string is integer -strict $string]
    } else {
        return [string is integer $string]                                                                    ;# accept empty string
    }
}

proc checkFloatingPoint {string {strict 0}} {
    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
    # disallow numbers starting with . (use 0. instead)
    if {$strict} {
        return [string is double -strict $string]
    } else {
        return [string is double $string]                                                                     ;# accept empty string
    }
}

proc checkMaximumLength {length string} {
    return [expr {[string length $string] <= $length}]
}
