#!/usr/local/bin/tclsh
#
# Copyright (c): Uwe Schmidt, FH Wedel
#
# You may study, modify and distribute this source code
# FOR NON-COMMERCIAL PURPOSES ONLY.
# This copyright message has to remain unchanged.
#
# Note that this document is provided 'as is',
# WITHOUT WARRANTY of any kind either expressed or implied.


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