1 # Implements a mostly Tcl-compatible glob command based on readdir
3 # (c) 2008 Steve Bennett <steveb@workware.net.au>
4 # (c) 2012 Alexander Shpilkin <ashpilkin@gmail.com>
6 # See LICENCE in this directory for licensing.
8 package require readdir
10 # Return a list of all entries in $dir that match the pattern.
11 proc glob.globdir
{dir pattern
} {
12 if {[file exists
$dir/$pattern]} {
14 return [list $pattern]
18 set files
[readdir
$dir]
22 if {[string match
$pattern $name]} {
23 # Starting dots match only explicitly
24 if {[string index
$name 0] eq
"." && [string index
$pattern 0] ne
"."} {
34 # Return the list of patterns resulting from expanding any braced
35 # alternatives inside the given pattern, prepending the unprocessed
36 # part of the pattern. Does _not_ handle escaped braces or commas.
37 proc glob.explode
{pattern
} {
44 set ob
[string first
\{ $pattern]
45 set cb
[string first
\} $pattern]
47 if {$ob < $cb && $ob != -1} {
48 set mid
[string range
$pattern 0 $ob-1]
49 set subexp
[lassign
[glob.explode
[string range
$pattern $ob+1 end
]] pattern
]
51 error "unmatched open brace in glob pattern"
53 set pattern
[string range
$pattern 1 end
]
55 foreach subs
$subexp {
56 foreach sub
[split $subs ,] {
58 lappend newexp
$old$mid$sub
62 } elseif
{$cb != -1} {
63 set suf
[string range
$pattern 0 $cb-1]
64 set rest
[string range
$pattern $cb end
]
74 lappend newexp
$old$suf
79 # Core glob implementation. Returns a list of files/directories inside
80 # base matching pattern, in {realname name} pairs.
81 proc glob.
glob {base pattern
} {
82 set dir
[file dirname
$pattern]
83 if {$pattern eq
$dir ||
$pattern eq
""} {
84 return [list [file join $base $dir] $pattern]
85 } elseif
{$pattern eq
[file tail
$pattern]} {
89 # Recursively expand the parent directory
90 set dirlist
[glob.
glob $base $dir]
91 set pattern
[file tail
$pattern]
93 # Collect the files/directories
95 foreach {realdir dir
} $dirlist {
96 if {![file isdir
$realdir]} {
99 if {[string index
$dir end
] ne
"/" && $dir ne
""} {
102 foreach name
[glob.globdir
$realdir $pattern] {
103 lappend result
[file join $realdir $name] $dir$name
109 # Implements the Tcl glob command
111 # Usage: glob ?-nocomplain? ?-directory dir? ?--? pattern ...
113 # Patterns use 'string match' (glob) pattern matching for each
114 # directory level, plus support for braced alternations.
116 # e.g. glob {te[a-e]*/*.{c,tcl}}
118 # Note: files starting with . will only be returned if matching component
119 # of the pattern starts with .
127 if {[info exists param
]} {
133 switch -glob -- $arg {
149 return -code error "bad option \"$arg\": must be -directory, -nocomplain, -tails, or --"
157 if {[info exists param
]} {
158 return -code error "missing argument to \"$switch\""
160 if {[llength $args] <= $n} {
161 return -code error "wrong # args: should be \"glob ?options? pattern ?pattern ...?\""
164 set args
[lrange $args $n end
]
167 foreach pattern
$args {
168 set escpattern
[string map
{
169 \\\\ \x01 \\\{ \x02 \\\} \x03 \\, \x04
171 set patexps
[lassign
[glob.explode
$escpattern] rest
]
173 return -code error "unmatched close brace in glob pattern"
175 foreach patexp
$patexps {
176 set patexp
[string map
{
177 \x01 \\\\ \x02 \{ \x03 \} \x04 ,
179 foreach {realname name
} [glob.
glob $base $patexp] {
184 lappend result
[file join $base $name]
190 if {!$nocomplain && [llength $result] == 0} {
191 set s
$(([llength $args] > 1) ?
"s" : "")
192 return -code error "no files matched glob pattern$s \"[join $args]\""