/usr/share/xcrysden/Tcl/number.tcl is in xcrysden-data 1.5.53-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 | #############################################################################
# Author: #
# ------ #
# Anton Kokalj Email: Tone.Kokalj@ijs.si #
# Department of Physical and Organic Chemistry Phone: x 386 1 477 3523 #
# Jozef Stefan Institute Fax: x 386 1 477 3811 #
# Jamova 39, SI-1000 Ljubljana #
# SLOVENIA #
# #
# Source: $XCRYSDEN_TOPDIR/Tcl/number.tcl
# ------ #
# Copyright (c) 1996-2003 by Anton Kokalj #
#############################################################################
proc check_var { varlist foclist } {
global err ok
# $varlist - list of elements, which are lists themselfs
# element = {varname vartype}
# ^^^^^^^^^^^^^^^^^^^^^^^^^^^
# if $vartype is not specefied, than default is REAL
# (look the: "proc number { varname {type real} }")
#
# $foclist - list of widgets to focus (if an error occur)
set n 0
foreach elem $varlist {
set err 0
set varname [lindex $elem 0]
set vartype [lindex $elem 1]
if { $vartype == "text" } {
DummyProc
} else {
number $varname $vartype
if { $err } {
focus [lindex $foclist $n]
break
}
incr n
}
}
if { $err == 0 } {
set ok 1
return 1
} else {
return 0
}
}
proc number { varname {type real} } {
global err
upvar #0 $varname var
# $varname - name of variable
# $var - value of variable
# $err - boolean pointer for error determining
# $type - type of number (default is REAL)
# type of number: int - integer
# intlist - list of integers
# posint - positive integer
# fract - fractional number [-1,1]
# real - real number; (all numbers are real
# (excluded imaginary))
# posreal - positive real number;
# nat - atomic number (0-300; lokk in C95 manual
# 0 is ghost atom)
# intrange a b - integer interval [a,b]
set err 0
#puts stdout "VAR:: \"$var\""
if { ! [info exists var] } { return }
# may be $var is not specified at all
if { $type == "intlist" } {
foreach int $var {
if { [catch {expr abs($var)}] || \
$var != int($var) || [string match *.* $var] } {
dialog .number2 ERROR "ERROR !\nYou have specified \
a non-integer number instead of integer number \
for \"$varname\" variable.\n\
TRY AGAIN !" error 0 OK
set err 1
return [expr 1 - $err]
}
}
}
if { $var == "" } {
dialog .number1 ERROR "ERROR !\nYou forget to specify \
\"$varname\" variable. PLEASE DO IT \!" error 0 OK
set err 1
} elseif { [catch {expr abs($var)}] } {
# this CATCH specify if $var is a number;
# if we get 1 --> not number, else number
# string is not a number
dialog .number1 ERROR "ERROR !\nYou have specified a character \
instead of number for \"$varname\" variable.\
TRY AGAIN \!" error 0 OK
set err 1
} else {
# string is a number
# varify if number is a right one
switch -glob -- $type {
int {
if { $var != int($var) || [string match *.* $var] } {
dialog .number2 ERROR "ERROR !\nYou have specified \
a non-integer number instead of integer number \
for \"$varname\" variable.\n\
TRY AGAIN !" error 0 OK
set err 1
}
}
posint {
if { $var != int($var) || $var < 0 || \
[string match *.* $var] } {
dialog .number2 ERROR "ERROR !\nYou have specified \
a non-positive integer instead of positive \
integer for \"$varname\" variable.\n\
TRY AGAIN !" error 0 OK
set err 1
}
}
fra* {
if { $var < -1 || $var > 1 } {
dialog .number2 ERROR "ERROR !\nYou should specify \
a number between \[-1,1\] for \"$varname\" \
variable. TRY AGAIN !" error 0 OK
set err 1
}
}
nat* {
if { $var != int($var) || $var < 0 || $var > 399 || \
[string match *.* $var] } {
dialog .number2 ERROR "ERROR !\nYou specify wrong Atomic \
Number; Atomic Number should be between [0-99],\
[100-199] and [200-299], [300-399].\n\
TRY AGAIN !" error 0 OK
set err 1
}
}
posreal {
if { $var < 0.0 } {
dialog .number2 ERROR \
"ERROR !\nYou specify a negative real number \
instead of positive one.\n TRY AGAIN !" error 0 OK
set err 1
}
}
intrange* {
set a [lindex $type 1]
set b [lindex $type 2]
if { $var != int($var) || $var < $a || $var > $b } {
dialog .number2 ERROR \
"ERROR !\nYou specify a number that is either \
non-integer or out of range.\n TRY AGAIN !" \
error 0 OK
set err 1
}
}
}
}
return [expr 1 - $err]
}
##############################################################################
# similar as previous, but it return 1 if "varname" is the right type
# else it return 0
proc xcNumber { varname {type real} } {
global err
upvar #0 $varname var
# $varname - name of variable
# $var - value of variable
# $err - boolean pointer for error determining
# $type - type of number (default is REAL)
# type of number: int - integer
# posint - positive integer
# fract - fractional number [-1,1]
# real - real number; (all numbers are real
# (excluded imaginary))
# nat - atomic number (0-98; 98 is a program limitaition;
# 0 is ghost atom)
set err 0
puts stdout "VAR:: \"$var\""
# may be $var is not specified at all
if { $var == "" } {
return 0
} elseif { [catch {expr abs($var)}] } {
return 0
} else {
# string is a number
# varify if number is a right one
switch -glob -- $type {
int* {
if { $var != int($var) || [string match *.* $var] } {
return 0
}
}
pos* {
if { $var != int($var) || $var < 0 || \
[string match *.* $var] } { return 0 }
}
fra* {
if { $var < -1 || $var > 1 } { return 0 }
}
nat* {
if { $var != int($var) || $var < 0 || $var > 399 || \
[string match *.* $var] } { return 0 }
}
}
}
return 1
}
|