3 # some common procedures to implement fGIS objects
4 # This file is part of fGIS
9 # generates new unique name which starts with prefix.
10 # first name, which is not name of existing Tcl command and
11 # for which test script returns 1 would be returned
13 proc fgisMakeObjectName {prefix {test "info exists"}} {
17 if {![string length [info command $prefix$i]]&&
18 ![uplevel #0 $test $prefix$i]} {
25 # returns 1 if name can be used for creation of new object
27 proc fgisCheckName {name {test "info exists"}} {
28 expr ![string length [info command $name]]&&![uplevel #0 $test $name]
32 # Sets given variable to object value, if passed value is valid command
34 # Second argument specifies, how to deal with empty value.
35 # none - means unset variable
36 # nodefault - raise error
37 # any other value is substituted instead of empty string
38 # This procedure DELETES object, stored in var previously, if it is
39 # not eqial to default
42 proc fgisSetObj {var default value} {
43 # first, check if we need to substitute defaults
44 if [string match {} $value] {
45 switch -exact -- $default {
47 if {[uplevel info exists $var]&&
48 "[uplevel set $var]"!="$default"} {
49 [uplevel set $var] delete
55 return -code error -errorcode [list BADVALUE $var] \
56 "Empty value not allowed"
63 # check if passed value is valid object. Defaults are
64 # not subject to check - programmer knows, but user knows not
65 if [llength [info command $value]]!=1 {
66 return -code error -errorcode [list BADVALUE $var] \
67 "Invalid object \"$value\""
70 if {[uplevel info exists $var]&&"[uplevel set $var]"!="$default"} {
71 [uplevel set $var] delete
73 uplevel set $var [list $value]
78 # fgisSetList - sets given variable to value, if value is
79 # one from given list. Otherwise rises error
81 proc fgisSetList {var list value} {
82 if [checklistopt value $list msg] {
83 return -code error -errorcode [list BADVALUE $var] $msg
85 uplevel set $var [list $value]