blob: d304e045cb9abdffb096bbb99376906f074abf07 (
plain)
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
package provide opt_parser 0.1
namespace eval opt_parser {
# list of option vars (keys are long option names)
variable optlist
variable optprefix {-}
}
proc opt_parser::init {optdata} {
variable optlist
array unset optlist
array set optlist {}
foreach item $optdata {
foreach {longname varlist} $item {
if {[llength $varlist] < 1} {
return -code error "usage: init { {optname {var1 var2 ...}} ... }"
}
set optlist($longname) $varlist
}
}
}
proc opt_parser::get_options {argv {opts {}}} {
set ignore_unknown_flags 0
foreach {k v} $opts {set $k $v}
variable optlist
variable optprefix
# zero all the options 1st var
foreach optName [array names optlist] {
uplevel [list set [lindex $optlist($optName) 0] 0]
for {set i 1} {$i < [llength $optlist($optName)]} {incr i} {
uplevel [list set [lindex $optlist($optName) $i] [list]]
}
}
# here will be appended non-options arguments
set residualArgs {}
set argc [llength $argv]
for {set i 0} {$i < $argc} {} {
# get i-th arg
set argv_i [lindex $argv $i]
incr i
# if it's not an option, stop here, and add to residualArgs
if {![regexp ^$optprefix $argv_i]} {
lappend residualArgs $argv_i
continue
}
set optName [regsub ^$optprefix $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} {
return -code error "not enough arguments for option $optprefix$optName"
}
uplevel [list lappend [lindex $varlist $j] [lindex $argv $i]]
incr j
incr i
}
} else {
if {$ignore_unknown_flags} {
lappend residualArgs $argv_i
continue
} else {
return -code error "unknown option: $optprefix$optName"
}
}
}
return $residualArgs
}
|
