[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}}
 }
 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'''.
the '''::verbose''' variable will be set to '''1''' in case the '''--verbose''' switch is present, and so on.
the other variables specified in '''getopt::init''' will hold the value of required arguments.

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
 }

----
!!!!!!
%| enter categories here |%
!!!!!!