# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: getopt.tcl,v 2.13 2006/03/19 15:35:24 jfontain Exp $

# switches is a list of switch / flag value where switch is the actual expected string (which must start by either - or +) and flag
# is a boolean that tell whether an argument is required.
# array name is the name of the switch indexed array that will hold the value for each switch.
# the remaining arguments list (with the switches and their arguments removed) is returned.
# if the end of switches maker (--) is found in the arguments, parsing is terminated and the remaining arguments are returned.
# if a switch that takes no argument (flag is 0) is found in the arguments, then its value in the returned array is set to the
# empty string. the caller then can use "info exists" to detect whether the corresponding option was set.
# example: % parseCommandLineArguments {-a 0 -b 1 +c 1} $argv options

proc parseCommandLineArguments {switches arguments arrayName} {
    upvar 1 $arrayName data

    if {[llength $switches] == 0} {
        return $arguments
    }
    foreach {value flag} $switches {                                                                      ;# check switches validity
        if {![string match {[-+]*} $value] || ![string match {[01]} $flag]} {
            error "invalid switches: $switches"
        }
    }
    unset flag
    array set flag $switches

    set index 0
    foreach value $arguments {
        set argument($index) $value
        incr index
    }
    set maximum $index
    for {set index 0} {$index < $maximum} {incr index} {
        set switch $argument($index)
        if {![info exists flag($switch)]} break                                                                   ;# end of switches
        if {$switch eq "--"} {                                                                                    ;# end of switches
            incr index                                                                                ;# skip end of switches marker
            break
        }
        if {$flag($switch)} {                                                                                   ;# value is required
            if {[catch {set value $argument([incr index])}] || ([string match {[-+]*} $value] && ($value ne "-"))} {
                # allow "-" as argument, for example as standard input flag with --file option
                error "no value for switch $switch"                      ;# no value or value is a switch therefore value is missing
            }
            set data($switch) $value
        } else {
            set data($switch) {}
        }
    }
    return [lrange $arguments $index end]                                                        ;# return what remains of arguments
}
