share/redhat/gui/parse_args.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...
}