Basic getopts processing which I couldn't find anywhere else, so I had to write myself. ====== # Parse the options from argvret into the array optsret. Optstr is a string # of valid option letters, with a colon following each non-boolean option # letter (each option which takes an option argument). # # Options start with "-", except for the non-options "--", which is skipped # over, and "-". Option processing terminates upon encountering the first # non-option. Multiple options can be bundled into a single argument. The # value of non-boolean options is taken from the remainder of the argument # or the next argument if the remainder is empty. # # On error, argvret is not modified, optsret(error) contains an error # message, optsret(opt) contains the offending option, and -1 is returned. # # On success, the parsed options are removed from argvret and 0 is # returned. For each boolean option, the corresponding element of optsret # is set to 0 (false) or 1 (true). For non-boolean options, the # corresponding element of optsret contains whatever value was specified. # For non-boolean options which are not specified, the corresponding element # of optsret is not created and/or modified. proc getopts { optstr argvret optsret } { upvar $argvret argv upvar $optsret opts # initialize opts array with all boolean options set to 0 (false) catch { unset opts(error) opts(opt) } set opts_list [ split $optstr "" ] for { set idx 0 } { $idx < [ llength $opts_list ] } { incr idx } { if {[ lindex $opts_list [ expr $idx+1 ]] eq ":" } { incr idx } else { set opts([ lindex $opts_list $idx ]) 0 } } set arg_idx 0 while { $arg_idx < [ llength $argv ]} { set curr_arg [ lindex $argv $arg_idx ] if {[ string index $curr_arg 0 ] ne "-" } { break } if { $curr_arg eq "-" } { break } if { $curr_arg eq "--" } { incr arg_idx; break } incr arg_idx set ch_idx 1 while {1} { set opt_ch [ string index $curr_arg $ch_idx ] if { $opt_ch eq "" } { break } incr ch_idx set pos [ string first $opt_ch $optstr ] if { $pos < 0 || ( $opt_ch eq ":" && $pos > 0 )} { set opts(error) "invalid option -$opt_ch" set opts(opt) $opt_ch return -1 } if {[ string index $optstr [ incr pos ]] ne ":" } { set opts($opt_ch) 1 continue } set optarg [ string range $curr_arg $ch_idx end ] if { $optarg eq "" } { if { $arg_idx >= [ llength $argv ]} { set opts(error) "missing argument for option -$opt_ch" set opts(opt) $opt_ch return -1 } set optarg [ lindex $argv $arg_idx ] incr arg_idx } set opts($opt_ch) $optarg break } } set argv [ lrange $argv $arg_idx end ] return 0 } # testing proc usage {{ msg "" }} { set prog $::argv0 regsub {.*/} $prog "" prog if { $msg ne "" } { puts stderr "$prog: $msg" } puts stderr "usage: $prog \[-ab] \[-o STRING] \[ARG]..." exit 1 } if {[ getopts "?abco:" argv opts ]} { usage $opts(error) } if { $opts(?) } { usage } parray opts puts "value of opts(b) is $opts(b)" if {[ info exists opts(o) ]} { puts "value of opts(o) is '$opts(o)'" } foreach elem $argv { puts "elem:<$elem>" } ====== <> Example | Argument Processing | getopt | getopts