## Regexp Integer Validation

Problem Statement:

CJB : To validate a string as a variety of integer types (binary, octal, decimal, hexadecimal) excluding 0nnn octals.

``` Also uses upvar to return the valid types for the given string, and strips left padded 0's for strings without a type modifier (0x|0b|0o).
```

Code:

```# Figures out if a string could be a variety of integers, and then compares a given type to the list of types.
# Ignores 0nnn octal numbers.
# Will upvar a non-0nnn octal number to 'num_var' (strips extra 0's for decimal numbers)
# Will upvar the valid types for this string into 'types_var'
# Empty string or sign only is interpreted as 0, includes type 'none' in list
# Returns 1 if the given type is a valid type for this string, else returns 0
proc regex_validate {string {type hexadecimal} {num_var ""} {types_var ""}} {
if {\$types_var ne ""} {
upvar 1 \$types_var types
}
if {\$num_var ne ""} {
upvar 1 \$num_var num
set num ""
}
set types [list hexadecimal decimal octal binary none]
regexp -nocase -all -line -- {^([-+])?(0x|0b|0o)?(0*)([01]*)([0-7]*)([0-9]*)([0-9a-f]*)(\w*)\$} \$string match sgn mod pad0 bin oct dec hex str
#Eliminate invalid types
if {![info exists str]} {
set types [list]
return 0
} elseif {\$str ne ""} {
set types [list]
} elseif {\$hex ne ""} {
set types [lrange \$types 0 0]
} elseif {\$dec ne ""} {
set types [lrange \$types 0 1]
} elseif {\$oct ne ""} {
set types [lrange \$types 0 2]
} elseif {\$bin ne ""} {
set types [lrange \$types 0 3]
} elseif {\$pad0 ne ""} {
set types [lrange \$types 0 3]
lassign {"" "" 0} sgn mod bin
} else {
lassign {"" "" 0} sgn mod bin
}
#Modifier check and elimination
#Adds modifier for the given type if omitted.
switch -nocase -- \$mod {
0x  {set types [lsearch -inline \$types h*]}
0o  {set types [lsearch -inline \$types o*]}
0b  {set types [lsearch -inline \$types b*]}
default {
switch -nocase -glob -- \$type {
h* {set mod 0x}
o* {set mod 0o}
b* {set mod 0b}
}
}
}
#Return number via upvar if needed.  Removes left padded 0's for numbers without a modifier.
return [expr {[lsearch -nocase \$types \$type*] >= 0}]
}

Example:
% after 0 {puts \$n:\$t}; regex_validate "01234" hexadecimal n t
1

Demo:

``` package require Tk
label .number -textvariable ::n -bg lightgray
label .types  -textvariable ::t -bg gray -width [string length " Hexadecimal Decimal Octal Binary None "]
ttk::combobox .combo -justify center -textvariable ::selection -state readonly -values [list Hex Decimal Octal Binary]
entry .entry         -justify center -textvariable ::e -validate all -vcmd [list apply {{w value validation combobox} {
variable ::n
variable ::t
catch {
if {[regex_validate \$value [\$combobox get] ::n ::t]} {
\$w configure -bg #c0ffc0
} else {
if {\$validation eq "key"} {
\$w configure -bg #ffffc0
} else {
\$w configure -bg #ffc0c0
}
}
}
return 1
}} %W %P %V .combo]
bind .entry <Return> [list .entry validate]
trace add variable ::selection {write} ".entry validate;#"
.combo current 0
grid .combo  .entry  -sticky news
grid .number -       -sticky news
grid .types  -       -sticky news```

Alternate Solutions:

``` #Alternate prototype using [scan] instead of [regexp]
proc scan_validate {string} {
scan \$string %x%s hex s
if {![info exists s]} {
scan \$string %d%s dec s
if {![info exists s]} {
scan \$string %o%s oct s
if {![info exists s]} {
#binary check?
return hex|dec|oct
} else {
return hex|dec
}
} else {
return hex
}
} else {
return NaN
}
}```

Discussion:

CJB : I put this here instead of in Advanced Regular Expression Examples due to being more than a few lines like the examples found there.