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
|
# 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...
}
|
