1# 2# $RCSfile: validate.itcl,v $ -- 3# 4# This file contains ... 5# 6# Copyright (c) 2003--2004 Anton Kokalj Email: tone.kokalj@ijs.si 7# 8# 9# This file is distributed under the terms of the GNU General Public 10# License. See the file `COPYING' in the root directory of the present 11# distribution, or http://www.gnu.org/copyleft/gpl.txt . 12# 13# 14# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 15# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 17# ANTON KOKALJ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN 18# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 19# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 20# 21# 22# $Id: validate.itcl,v 1.5 2008-02-15 16:54:19 kokalj Exp $ 23# 24 25# ------------------------------------------------------------------ 26# PROCEDURE: validate_functions 27# 28# The nonnegint string procedure is meant for mapping the -validate option 29# value to appropriate validation functions and is used inside guib-widgets. 30# ------------------------------------------------------------------ 31 32# ------------------------------------------------------------------------ 33#****f* widgets/validate_functions 34# NAME 35# ::guib::widgets::validate_functions -- driver routine for validation mechanism connected with entry widget 36# USAGE 37# validate_functions 38# DESCRIPTION 39# This is the driver routine for the validation widget mechanism 40# (i.e. -validate option). The following validations are supported: 41# 42# whatever -- 43# string -- 44# binary -- 45# int -- 46# posint -- 47# nonposint -- 48# negint -- 49# nonnegint -- 50# real -- 51# posreal -- 52# nonposreal -- 53# negreal -- 54# nonnegreal -- 55# fortranreal -- 56# fortranposreal -- 57# fortrannonposreal -- 58# fortrannegreal -- 59# fortrannonnegreal -- 60#******** 61# ------------------------------------------------------------------------ 62 63proc ::guib::widgets::validate_functions {} { 64 uplevel 1 { 65 switch -glob -- $itk_option(-validate) { 66 whatever { 67 set itk_option(-validate) "::guib::widgets::whatever %P" 68 } 69 string { 70 set itk_option(-validate) "::guib::widgets::whatever %P" 71 } 72 binary { 73 set itk_option(-validate) "::guib::widgets::binary %P" 74 } 75 int* { 76 set itk_option(-validate) "::guib::widgets::int %P" 77 } 78 posint* { 79 set itk_option(-validate) "::guib::widgets::posint %P" 80 } 81 nonposint* { 82 set itk_option(-validate) "::guib::widgets::nonposint %P" 83 } 84 negint* { 85 set itk_option(-validate) "::guib::widgets::negint %P" 86 } 87 nonnegint* { 88 set itk_option(-validate) "::guib::widgets::nonnegint %P" 89 } 90 real { 91 set itk_option(-validate) "::guib::widgets::real %P" 92 } 93 posreal { 94 set itk_option(-validate) "::guib::widgets::posreal %P" 95 } 96 nonposreal { 97 set itk_option(-validate) "::guib::widgets::nonposreal %P" 98 } 99 negreal { 100 set itk_option(-validate) "::guib::widgets::negreal %P" 101 } 102 nonnegreal { 103 set itk_option(-validate) "::guib::widgets::nonnegreal %P" 104 } 105 fortranreal { 106 set itk_option(-validate) "::guib::widgets::fortranreal %P" 107 } 108 fortranposreal { 109 set itk_option(-validate) "::guib::widgets::fortranposreal %P" 110 } 111 fortrannonposreal { 112 set itk_option(-validate) "::guib::widgets::fortrannonposreal %P" 113 } 114 fortrannegreal { 115 set itk_option(-validate) "::guib::widgets::fortrannegreal %P" 116 } 117 fortrannonnegreal { 118 set itk_option(-validate) "::guib::widgets::fortrannonnegreal %P" 119 } 120 } 121 #default { 122 # if { $itk_option(-validate) != "" } { 123 # error "wrong validation option, $itk_option(-validate)" 124 # } 125 #} 126 } 127} 128 129 130# ------------------------------------------------------------------ 131# PROCEDURE: whatever string 132# 133# The whatever procedure validates character input for a given 134# Entryfield to be whatever and is always accepted. 135# ------------------------------------------------------------------ 136proc ::guib::widgets::whatever {string} { 137 return 1 138} 139 140 141# ------------------------------------------------------------------ 142# PROCEDURE: binary string 143# 144# The binary procedure validates character input for a given 145# Entryfield to be a binary, i.e. 0 or 1, and returns the result. 146# ------------------------------------------------------------------ 147proc ::guib::widgets::binary {string} { 148 return [regexp {^[01]$} $string] 149} 150 151 152# ------------------------------------------------------------------ 153# PROCEDURE: int string 154# 155# The integer procedure validates character input for a given 156# Entryfield to be nteger and returns the result. 157# ------------------------------------------------------------------ 158proc ::guib::widgets::int {string} { 159 return [regexp {^[+\-]?[0-9]*$} $string] 160} 161 162 163# ------------------------------------------------------------------ 164# PROCEDURE: posint string 165# 166# The positive-integer procedure validates character input for a given 167# Entryfield to be positive-integer and returns the result. 168# ------------------------------------------------------------------ 169proc ::guib::widgets::posint {string} { 170 if { $string == "" } { return 1 } 171 set result [regexp {^[+]?[0-9]*$} $string] 172 if { $result == 1 } { 173 if { $string == "+" } { 174 return 1 175 } else { 176 return [expr $string > 0] 177 } 178 } else { 179 return $result 180 } 181} 182 183 184# ------------------------------------------------------------------ 185# PROCEDURE: nonposint string 186# 187# The non-positive-integer procedure validates character input for a given 188# Entryfield to be non-positive-integer and returns the result. 189# ------------------------------------------------------------------ 190proc ::guib::widgets::nonposint {string} { 191 set result [regexp {^[-]?[0-9]*$} $string] 192 if { $result == 1 } { 193 return [expr ${string}0 <= 0] 194 } else { 195 return $result 196 } 197} 198 199 200# ------------------------------------------------------------------ 201# PROCEDURE: negint string 202# 203# The negative-integer procedure validates character input for a given 204# Entryfield to be negative-integer and returns the result. 205# ------------------------------------------------------------------ 206proc ::guib::widgets::negint {string} { 207 if { $string == "" } { return 1 } 208 set result [regexp {^-[0-9]*$} $string] 209 if { $result == 1 } { 210 if { $string == "-" } { 211 return 1 212 } else { 213 return [expr ${string}0 < 0] 214 } 215 } else { 216 return $result 217 } 218} 219 220 221# ------------------------------------------------------------------ 222# PROCEDURE: nonnegint string 223# 224# The non-negative-integer procedure validates character input for a given 225# Entryfield to be non-negative-integer and returns the result. 226# ------------------------------------------------------------------ 227proc ::guib::widgets::nonnegint {string} { 228 return [regexp {^[+]?[0-9]*$} $string] 229} 230 231 232# ------------------------------------------------------------------ 233# PROCEDURE: real string 234# 235# The real procedure validates character input for a given 236# Entryfield to be real and returns the result. 237# ------------------------------------------------------------------ 238proc ::guib::widgets::real {string} { 239 return [regexp {^[+\-]?[0-9]*\.?[0-9]*([0-9]\.?[eE][-+]?[0-9]*)?$} $string] 240} 241 242# ------------------------------------------------------------------ 243# PROCEDURE: posreal string 244# 245# The posreal procedure validates character input for a given Entryfield 246# to be positive-real and returns the result. 247# ------------------------------------------------------------------ 248proc ::guib::widgets::posreal {string} { 249 set result [nonnegreal $string] 250 return $result 251 # BEWARE: see fortranposreal !!! 252 #if { $result == 1 } { 253 # return [expr ${string}0 > 0.0] 254 #} else { 255 # return $result 256 #} 257} 258 259 260# ------------------------------------------------------------------ 261# PROCEDURE: nonposreal string 262# 263# The nonposreal procedure validates character input for a given Entryfield 264# to be non-positive-real and returns the result. 265# ------------------------------------------------------------------ 266proc ::guib::widgets::nonposreal {string} { 267 if { $string == "" } { return 1 } 268 set result [regexp {^[-]?[0-9]*\.?[0-9]*([0-9]\.?[eE][-+]?[0-9]*)?$} $string] 269 if { $result == 1 } { 270 if { $string == "-" } { 271 return 1 272 } else { 273 return [expr ${string} <= 0.0] 274 } 275 } else { 276 return $result 277 } 278} 279 280 281# ------------------------------------------------------------------ 282# PROCEDURE: negreal string 283# 284# The negreal procedure validates character input for a given Entryfield 285# to be negative-real and returns the result. 286# ------------------------------------------------------------------ 287proc ::guib::widgets::negreal {string} { 288 set result [regexp {^-[0-9]*\.?[0-9]*([0-9]\.?[eE][-+]?[0-9]*)?$} $string] 289 return $result 290 # BEWARE: see fortranposreal !!! 291 #if { $result == 1 } { 292 # return [expr ${string}0 < 0.0] 293 #} else { 294 # return $result 295 #} 296} 297 298 299# ------------------------------------------------------------------ 300# PROCEDURE: nonnegreal string 301# 302# The nonnegreal procedure validates character input for a given Entryfield 303# to be non-negative-real and returns the result. 304# ------------------------------------------------------------------ 305proc ::guib::widgets::nonnegreal {string} { 306 return [regexp {^[+]?[0-9]*\.?[0-9]*([0-9]\.?[eE][-+]?[0-9]*)?$} $string] 307} 308 309 310# ------------------------------------------------------------------ 311# PROCEDURE: fortranreal string 312# 313# The fortran-real procedure validates character input for a given 314# Entryfield to be real (i.e. allows the numbers of type 1.2d+01) and 315# returns the result. 316# ------------------------------------------------------------------ 317proc ::guib::widgets::fortranreal {string} { 318 return [regexp {^[-+]?[0-9]*\.?[0-9]*([0-9]\.?[eEdD][-+]?[0-9]*)?$} $string] 319} 320 321 322# ------------------------------------------------------------------ 323# PROCEDURE: fortranposreal string 324# 325# The fortranposreal procedure validates character input for a given 326# Entryfield to be positive-real (i.e. allows the "d" exponent) and 327# returns the result. 328# ------------------------------------------------------------------ 329proc ::guib::widgets::fortranposreal {string} { 330 set result [fortrannonnegreal $string] 331 return $result 332 #if { $result == 1 } { 333 # regsub -nocase d $string e string 334 # # BEWARE: 335 # # allow the folowing strings: 336 # # + or . or 0 337 # # +0 or +. or +0.0001 --> must be the same as NONNEG .... 338 # #...if { [regexp {^[+.0]} $string] ... } fix this 339 # return [expr ${string}0 > 0.0] 340 #} else { 341 # return $result 342 #} 343} 344 345 346# ------------------------------------------------------------------ 347# PROCEDURE: fortrannonposreal string 348# 349# The fortrannonposreal procedure validates character input for a 350# given Entryfield to be non-positive-real (i.e. allows the "d" 351# exponent) and returns the result. 352# ------------------------------------------------------------------ 353proc ::guib::widgets::fortrannonposreal {string} { 354 set result [regexp {^[-]?[0-9]*\.?[0-9]*([0-9]\.?[eEdD][-+]?[0-9]*)?$} $string] 355 if { $result == 1 } { 356 regsub -nocase d $string e string 357 return [expr ${string}0 <= 0.0] 358 } else { 359 return $result 360 } 361} 362 363 364# ------------------------------------------------------------------ 365# PROCEDURE: fortrannegreal string 366# 367# The fortrannegreal procedure validates character input for a given 368# Entryfield to be negative-real (i.e. allows the "d" exponent) and 369# returns the result. 370# ------------------------------------------------------------------ 371proc ::guib::widgets::fortrannegreal {string} { 372 set result [regexp {^-[0-9]*\.?[0-9]*([0-9]\.?[eEdD][-+]?[0-9]*)?$} $string] 373 return $result 374} 375 376 377# ------------------------------------------------------------------ 378# PROCEDURE: fortrannonnegreal string 379# 380# The fortrannonnegreal procedure validates character input for a 381# given Entryfield to be non-negative-real (i.e. allows the "d" 382# exponent) and returns the result. 383# ------------------------------------------------------------------ 384proc ::guib::widgets::fortrannonnegreal {string} { 385 return [regexp {^[+]?[0-9]*\.?[0-9]*([0-9]\.?[eEdD][-+]?[0-9]*)?$} $string] 386} 387