Login
getopt.tcl at [0ab8c75c49]
Login

File autosetup/lib/getopt.tcl artifact 978dbe9dc4 part of check-in 0ab8c75c49


# Copyright (c) 2006 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Simple getopt module

# Parse everything out of the argv list which looks like an option
# Knows about --enable-thing and --disable-thing as alternatives for --thing=0 or --thing=1
# Everything which doesn't look like an option, or is after --, is left unchanged
proc getopt {argvname} {
	upvar $argvname argv
	set nargv {}

	for {set i 0} {$i < [llength $argv]} {incr i} {
		set arg [lindex $argv $i]

		#dputs arg=$arg

		if {$arg eq "--"} {
			# End of options
			incr i
			lappend nargv {*}[lrange $argv $i end]
			break
		}

		if {[regexp {^--([^=][^=]+)=(.*)$} $arg -> name value]} {
			lappend opts($name) $value
		} elseif {[regexp {^--(enable-|disable-)?([^=]*)$} $arg -> prefix name]} {
			if {$prefix eq "disable-"} {
				set value 0
			} else {
				set value 1
			}
			lappend opts($name) $value
		} else {
			lappend nargv $arg
		}
	}

	#puts "getopt: argv=[join $argv] => [join $nargv]"
	#parray opts

	set argv $nargv

	return [array get opts]
}

proc opt_val {optarrayname options {default {}}} {
	upvar $optarrayname opts

	set result {}

	foreach o $options {
		if {[info exists opts($o)]} {
			lappend result {*}$opts($o)
		}
	}
	if {[llength $result] == 0} {
		return $default
	}
	return $result
}

proc opt_bool {optarrayname args} {
	upvar $optarrayname opts

	# Support the args being passed as a list
	if {[llength $args] == 1} {
		set args [lindex $args 0]
	}

	foreach o $args {
		if {[info exists opts($o)]} {
			if {"1" in $opts($o) || "yes" in $opts($o)} {
				return 1
			}
		}
	}
	return 0
}