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).
getopt::init wants a list of items. each item is a list like: {longName shortName varList}
the return value of getopt::getopt (argv2 in the example above) will contain the additional arguments that do not belong to any switch.
# Copyright (c) 2008, Federico Ferri # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # * Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # * Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # * Neither the name of Federico Ferri nor the # names of its contributors may be used to endorse or promote products # derived from this software without specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE # DISCLAIMED. IN NO EVENT SHALL FEDERICO FERRI BE LIABLE FOR ANY # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 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 }