Datei: setopt.tcl

# $Id: setopt.tcl,v 1.1 1996/08/26 15:24:57 uwe Exp $

# setopt evaluates optional arguments of a proc

# assumptions: proc has variable parameter list args as last parameter

# if proc is called with option -<opt> <value>

# setopt <opt> <default> searches args for -<opt> and defines variable <opt>

# if option is given with <value> else

# if option is given in a global variable globaloptions with that value

# else with the default value <val>

# example:

# proc p args {

# setopt o 42

# return $o

# }

# p -o 43 -> 43

# p -> 42

proc setopt {opt val} {

upvar $opt var

upvar args args

set pos [lsearch -exact $args "-$opt"]

if [expr $pos >= 0] {

set pos1 [expr $pos + 1]

set var [lindex $args $pos1]

set args [lreplace $args $pos $pos1]

return

}

global globaloptions

if [info exists globaloptions] {

set pos [lsearch -exact $globaloptions "-$opt"]

if [expr $pos >= 0] {

set pos1 [expr $pos + 1]

set var [lindex $globaloptions $pos1]

return

}

set var $val

}

Die Datei: setopt.tcl