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
|
###
##
## lmatch ?-exact|-glob|-regexp? <list> <pattern>
##
## Look for elements in <list> that match <pattern>. This command emulates
## the TclX lmatch command, but if TclX isn't available, it's a decent
## substitute.
##
## Note: Native Tcl's "lsearch" has been greatly enhanced since lmatch was
## written -- programmers should consider using lmatch instead.
##
## $Id: lmatch.tcl 1212149 2011-12-08 21:57:35Z mxmanghi $
##
###
namespace eval ::rivet {
proc lmatch {args} {
set modes(-exact) 0
set modes(-glob) 1
set modes(-regexp) 2
if {[llength $args] == 3} {
lassign $args mode list pattern
} elseif {[llength $args] == 2} {
set mode -glob
lassign $args list pattern
} else {
return -code error \
{wrong # args: should be "lmatch ?mode? list pattern"}
}
if {![info exists modes($mode)]} {
return -code error \
"bad search mode \"$mode\": must be -exact, -glob, or -regexp"
}
set mode $modes($mode)
set return {}
foreach elem $list {
if {$mode == 0} {
if {[string compare $elem $pattern] == 0} { lappend return $elem }
}
if {$mode == 1} {
if {[string match $pattern $elem]} { lappend return $elem }
}
if {$mode == 2} {
if {[regexp $pattern $elem]} { lappend return $elem }
}
}
return $return
}
}
|
