#
#  Copyright (c) 1994-1998 A & A Custom Software.
#  All rights reserved.
# 
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#  3. All advertising materials mentioning features or use of this software
#     must display the following acknowledgement:
#       This product includes software developed by A & A Custom Software 
#       and its contributors.
#  4. Neither the name of A & A Custom Software nor the names of its 
#     contributors may be used to endorse or promote products derived from this 
#     software without specific prior written permission.
# 
#  THIS SOFTWARE IS PROVIDED BY A & A CUSTOM SOFTWARE AND CONTRIBUTORS ``AS IS''
#  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL A & A CUSTOM SOFTWARE OR CONTRIBUTORS BE 
#  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
#  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
#  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
#  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 
#  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
#  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
#  POSSIBILITY OF SUCH DAMAGE.
# 
# $Id: trace.t,v 1.1.1.1 1998/01/04 22:47:29 abm Exp $
#

proc setTrace { var func {oper {w}} } {

    if {[regexp {(.+)\((.+)\)} $var junk arrayname index]} {	;# array
        global $arrayname
    } else {						;# scalar
        global $var
    }
    trace variable $var $oper $func 
}

proc entryInputLenChk { length var idx op } {

    global $var
    global ${var}_prevLenChk

    # Construct variable name. Depends whether its
    # an array or scalar.
    if {$idx == ""} {	;# scalar
        set current $var
        set prev ${var}_prevLenChk
    } else {		;# array
        set current ${var}($idx)
        set prev ${var}_prevLenChk($idx)
    }

    # If previous value did not exist, set it to empty
    if {![info exists $prev]} {
        set $prev {}
    }

    # Check current value against allowed length 
    if {[string length [set $current]] > $length} {
        set $current [set $prev]
        bell
        return
    }
    set $prev [set $current] 
}

proc isPhoneNumber { var idx op } {

    global $var
    global ${var}_prevPhoneChk

    # Construct variable name. Depends whether its
    # an array or scalar.
    if {$idx == ""} {	;# scalar
        set current $var
        set prev ${var}_prevPhoneChk
    } else {		;# array
        set current ${var}($idx)
        set prev ${var}_prevPhoneChk($idx)
    }

    # If previous value did not exist, set it to empty
    if {![info exists $prev]} {
        set $prev {}
    }

    # Check current value against regular expression
    if {![regexp {^[-+#*0-9\.,]*$} [set $current]]} {
        set $current [set $prev]
        bell
        return
    }
    set $prev [set $current] 
}
