42 lines
1.5 KiB
Tcl
42 lines
1.5 KiB
Tcl
# parse_args.tcl -- procedure for pulling in arguments
|
|
|
|
# parse_args takes in a set of arguments with defaults and examines
|
|
# the 'args' in the calling procedure to see what the arguments should
|
|
# be set to. Sets variables in the calling frame to the right values.
|
|
|
|
proc parse_args { argset } {
|
|
upvar args args
|
|
|
|
foreach argument $argset {
|
|
if {[llength $argument] == 1} {
|
|
# No default specified, so we assume that we should set
|
|
# the value to 1 if the arg is present and 0 if it's not.
|
|
# It is assumed that no value is given with the argument.
|
|
set result [lsearch -exact $args "-$argument"]
|
|
if {$result != -1} then {
|
|
uplevel 1 [list set $argument 1]
|
|
set args [lreplace $args $result $result]
|
|
} else {
|
|
uplevel 1 [list set $argument 0]
|
|
}
|
|
} elseif {[llength $argument] == 2} {
|
|
# There are two items in the argument. The second is a
|
|
# default value to use if the item is not present.
|
|
# Otherwise, the variable is set to whatever is provided
|
|
# after the item in the args.
|
|
set arg [lindex $argument 0]
|
|
set result [lsearch -exact $args "-[lindex $arg 0]"]
|
|
if {$result != -1} then {
|
|
uplevel 1 [list set $arg [lindex $args [expr $result+1]]]
|
|
set args [lreplace $args $result [expr $result+1]]
|
|
} else {
|
|
uplevel 1 [list set $arg [lindex $argument 1]]
|
|
}
|
|
} else {
|
|
error "Badly formatted argument \"$argument\" in argument set"
|
|
}
|
|
}
|
|
|
|
# The remaining args should be checked to see that they match the
|
|
# number of items expected to be passed into the procedure...
|
|
}
|