# getparams.tcl
# Copyright 2001 by Larry Smith
# Wild Open Source, Inc
# license terms: GPL
# Takes a list of variable-value pairs and creates and
# initializes the former with the latter in the calling
# context. Then parses the $argv in the calling context
# for "-var value" pairs and updates any vars mentioned
# there. It will not create vars not mentioned in the
# initializing list.
proc getparams { args } {
upvar args arglist
if { [ llength $arglist ] == 0 } return
if { [ llength $arglist ] == 1 } {
# braced set of args
eval set arglist $arglist
}
set varlist {}
foreach { var val } $args {
uplevel 1 set $var \{$val\}
lappend varlist $var
}
foreach { var val } $arglist {
set var [ string range $var 1 end ]
if { [ lsearch $varlist $var ] != -1 } {
uplevel 1 set $var \{$val\}
}
}
}Test:
proc foo { args } {
set d 4
getparams a 1 b 2 c 3
puts "a is $a, b is $b, c is $c, d is $d"
}
foo -a 100 -b 200
foo -b 200 -a 100
foo -c 300 -d 400result:
a is 100, b is 200, c is 3, d is 4 a is 100, b is 200, c is 3, d is 4 a is 1, b is 2, c is 300, d is 4
Notice it refused to allow setting "d" - d was not specified as a parameter.