# 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>" }