
#@package: getargs getargs

#
# Copyright (C) 1992-1997 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.

# $Id: getargs.tcl,v 1.1.1.1 1999/03/31 20:34:40 damon Exp $

#
# parses an arglist of key-value pairs where the key starts with a
# dash and the value must always be present.
#
# we want to use it in this manner 
#
# dialog_box -bitmap @/bitmap -text "hi there" -suppress 1
#
# in dialog_box,
#
# proc dialog_box {blah blah blah args} {
#     getargs $args parms
# }
#
# and have the parms array set as follows:
#
# bitmap=@/bitmap
# text="hi there"
# suppress="1"
#
#

proc getargs {arrayName argList} {
    upvar $arrayName array

    set length [llength $argList]
    if {$length % 2 != 0} {
        error "list of key-value pairs is missing a value"
    }
    for {set i 0} {$i < $length} {incr i 2} {
        set key [lindex $argList $i]
        if {[cindex $key 0] != "-"} {
            error "key '$key' of key-value pairs doesn't start with '-'"
        }
        set array([crange $key 1 end]) [lindex $argList [expr $i + 1]]
    }
}
