1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: getopt.tcl,v 2.10 2005/01/02 00:45:07 jfontain Exp $
# switches is a list of switch / flag value where switch is the actual expected string (which must start by either - or +) and flag
# is a boolean that tell whether an argument is required.
# array name is the name of the switch indexed array that will hold the value for each switch.
# the remaining arguments list (with the switches and their arguments removed) is returned.
# if the end of switches maker (--) is found in the arguments, parsing is terminated and the remaining arguments are returned.
# if a switch that takes no argument (flag is 0) is found in the arguments, then its value in the returned array is set to the
# empty string. the caller then can use "info exists" to detect whether the corresponding option was set.
# example: % parseCommandLineArguments {-a 0 -b 1 +c 1} $argv options
proc parseCommandLineArguments {switches arguments arrayName} {
upvar 1 $arrayName data
if {[llength $switches] == 0} {
return $arguments
}
foreach {value flag} $switches { ;# check switches validity
if {![string match {[-+]*} $value] || ![string match {[01]} $flag]} {
error "invalid switches: $switches"
}
}
unset flag
array set flag $switches
set index 0
foreach value $arguments {
set argument($index) $value
incr index
}
set maximum $index
for {set index 0} {$index < $maximum} {incr index} {
set switch $argument($index)
if {![info exists flag($switch)]} break ;# end of switches
if {[string equal $switch --]} { ;# end of switches
incr index ;# skip end of switches marker
break
}
if {$flag($switch)} { ;# value is required
if {[catch {set value $argument([incr index])}] || [string match {[-+]*} $value]} {
error "no value for switch $switch" ;# no value or value is a switch therefore value is missing
}
set data($switch) $value
} else {
set data($switch) {}
}
}
return [lrange $arguments $index end] ;# return what remains of arguments
}
|
