| 1 |
578 |
markom |
# parse_args.tcl -- procedure for pulling in arguments
|
| 2 |
|
|
|
| 3 |
|
|
# parse_args takes in a set of arguments with defaults and examines
|
| 4 |
|
|
# the 'args' in the calling procedure to see what the arguments should
|
| 5 |
|
|
# be set to. Sets variables in the calling frame to the right values.
|
| 6 |
|
|
|
| 7 |
|
|
proc parse_args { argset } {
|
| 8 |
|
|
upvar args args
|
| 9 |
|
|
|
| 10 |
|
|
foreach argument $argset {
|
| 11 |
|
|
if {[llength $argument] == 1} {
|
| 12 |
|
|
# No default specified, so we assume that we should set
|
| 13 |
|
|
# the value to 1 if the arg is present and 0 if it's not.
|
| 14 |
|
|
# It is assumed that no value is given with the argument.
|
| 15 |
|
|
set result [lsearch -exact $args "-$argument"]
|
| 16 |
|
|
if {$result != -1} then {
|
| 17 |
|
|
uplevel 1 [list set $argument 1]
|
| 18 |
|
|
set args [lreplace $args $result $result]
|
| 19 |
|
|
} else {
|
| 20 |
|
|
uplevel 1 [list set $argument 0]
|
| 21 |
|
|
}
|
| 22 |
|
|
} elseif {[llength $argument] == 2} {
|
| 23 |
|
|
# There are two items in the argument. The second is a
|
| 24 |
|
|
# default value to use if the item is not present.
|
| 25 |
|
|
# Otherwise, the variable is set to whatever is provided
|
| 26 |
|
|
# after the item in the args.
|
| 27 |
|
|
set arg [lindex $argument 0]
|
| 28 |
|
|
set result [lsearch -exact $args "-[lindex $arg 0]"]
|
| 29 |
|
|
if {$result != -1} then {
|
| 30 |
|
|
uplevel 1 [list set $arg [lindex $args [expr $result+1]]]
|
| 31 |
|
|
set args [lreplace $args $result [expr $result+1]]
|
| 32 |
|
|
} else {
|
| 33 |
|
|
uplevel 1 [list set $arg [lindex $argument 1]]
|
| 34 |
|
|
}
|
| 35 |
|
|
} else {
|
| 36 |
|
|
error "Badly formatted argument \"$argument\" in argument set"
|
| 37 |
|
|
}
|
| 38 |
|
|
}
|
| 39 |
|
|
|
| 40 |
|
|
# The remaining args should be checked to see that they match the
|
| 41 |
|
|
# number of items expected to be passed into the procedure...
|
| 42 |
|
|
}
|
