Version 3 of GetOpt-ish

Updated 2008-04-25 11:42:05 by FF

FF 2008-04-21 - Here's my GetOpt-like library

it works as follows:

 getopt::init {
        {verbose  v  {::verbose}}
        {input    i  {::input ::input_file}}
        {output   o  {::output ::output_file}}
        {range    r  {::range ::range_min ::range_max}}
 }
 set argv2 [getopt::getopt $argv]

you can call yourScript.tcl -vio input.txt output.txt, which is equivalent to yourScript.tcl --verbose --input input.txt --output output.txt (proc getopt::expandOptNames does the translation from short option names to long option names).

DESCRIPTION

getopt::init wants a list of items. each item is a list like: {longName shortName varList}

• longName is the long option name (without the initial --)
• shortName is the short (one character) option name, without the initial -
• varList is a list of variable names which will hold the value of their arguments. the first variable name will be set to 1 (one) whenever the switch appears on the command line, the second variable name will hold the first switch argument, and so on. you can have switches taking multiple arguments. in the above example range takes two arguments in the form: --range <min> <max>

RETURN VALUE

the return value of getopt::getopt (argv2 in the example above) will contain the additional arguments that do not belong to any switch.

---

 namespace eval getopt {
        # list of option vars (keys are long option names)
        variable optlist

        # map short option names to long option names
        variable stl_map
 }

 proc getopt::init {optdata} {
        variable optlist
        variable stl_map
        array set optlist {}
        array set stl_map {}
        foreach item $optdata {
                foreach {longname shortname varlist} $item {
                        set optlist($longname) $varlist
                        set stl_map($shortname) $longname
                }
        }
 }

 proc getopt::expandOptNames {argv} {
        variable optlist
        variable stl_map
        set argv2 {}
        set argc [llength $argv]
        for {set i 0} {$i < $argc} {} {
                set argv_i [lindex $argv $i]
                incr i

                if [isShortOpt $argv_i] {
                        set argv_i_opts [split [regsub {^-} $argv_i {}] {}]
                        foreach shortOpt $argv_i_opts {
                                if [info exists stl_map($shortOpt)] {
                                        set longOpt $stl_map($shortOpt)
                                        lappend argv2 --$longOpt
                                        set n_required_opt_args [expr {-1+[llength $optlist($longOpt)]}]
                                        while {$n_required_opt_args > 0} {
                                                incr n_required_opt_args -1
                                                if {$i >= $argc} {
                                                        puts "error: not enough arguments for option -$shortOpt"
                                                        exit 3
                                                }
                                                lappend argv2 [lindex $argv $i]
                                                incr i
                                        }
                                } else {
                                        puts "error: unknown option: -$shortOpt"
                                        exit 2
                                }
                        }
                        continue
                }

                lappend argv2 $argv_i
        }
        return $argv2
 }

 proc getopt::isShortOpt {o} {
        return [regexp {^-[a-zA-Z0-9]+} $o]
 }

 proc getopt::isLongOpt {o} {
        return [regexp {^--[a-zA-Z0-9][a-zA-Z0-9]*} $o]
 }

 proc getopt::getopt {argv} {
        variable optlist
        set argv [expandOptNames $argv]
        set argc [llength $argv]

        set residualArgs {}

        for {set i 0} {$i < $argc} {} {
                set argv_i [lindex $argv $i]
                incr i

                if [isLongOpt $argv_i] {
                        set optName [regsub {^--} $argv_i {}]
                        if [info exists optlist($optName)] {
                                set varlist $optlist($optName)
                                uplevel [list set [lindex $optlist($optName) 0] 1]
                                set n_required_opt_args [expr {-1+[llength $varlist]}]
                                set j 1
                                while {$n_required_opt_args > 0} {
                                        incr n_required_opt_args -1
                                        if {$i >= $argc} {
                                                puts "error: not enough arguments for option --$optName"
                                                exit 5
                                        }
                                        uplevel [list set [lindex $varlist $j] [lindex $argv $i]]
                                        incr j
                                        incr i
                                }
                        } else {
                                puts "error: unknown option: --$optName"
                                exit 4
                        }
                        continue
                }

                lappend residualArgs $argv_i
        }
        return $residualArgs
 }

---