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
53
|
# copyright (C) 1997-98 Jean-Luc Fontaine (mailto:jfontain@mygale.org)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
set rcsId {$Id: getopt.tcl,v 1.3 1998/05/24 19:24:43 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 $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 compare $switch --]==0} { ;# 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]} {
# no value or value is a switch therefore value is missing
error "no value for switch $switch"
}
set data($switch) $value
} else {
set data($switch) {}
}
}
return [lrange $arguments $index end] ;# return what remains of arguments
}
|
