1# Implements a Tcl-compatible glob command based on readdir 2# 3# (c) 2008 Steve Bennett <steveb@workware.net.au> 4# 5# See LICENCE in this directory for licensing. 6 7package require readdir 8 9# Implements the Tcl glob command 10# 11# Usage: glob ?-nocomplain? pattern ... 12# 13# Patterns use 'string match' (glob) pattern matching for each 14# directory level, plus support for braced alternations. 15# 16# e.g. glob "te[a-e]*/*.{c,tcl}" 17# 18# Note: files starting with . will only be returned if matching component 19# of the pattern starts with . 20proc glob {args} { 21 22 # If $dir is a directory, return a list of all entries 23 # it contains which match $pattern 24 # 25 local proc glob.readdir_pattern {dir pattern} { 26 set result {} 27 28 # readdir doesn't return . or .., so simulate it here 29 if {$pattern in {. ..}} { 30 return $pattern 31 } 32 33 # If the pattern isn't actually a pattern... 34 if {[string match {*[*?]*} $pattern]} { 35 # Use -nocomplain here to return nothing if $dir is not a directory 36 set files [readdir -nocomplain $dir] 37 } elseif {[file isdir $dir] && [file exists $dir/$pattern]} { 38 set files [list $pattern] 39 } else { 40 set files "" 41 } 42 43 foreach name $files { 44 if {[string match $pattern $name]} { 45 # Only include entries starting with . if the pattern starts with . 46 if {[string index $name 0] eq "." && [string index $pattern 0] ne "."} { 47 continue 48 } 49 lappend result $name 50 } 51 } 52 53 return $result 54 } 55 56 # If the pattern contains a braced expression, return a list of 57 # patterns with the braces expanded. {c,b}* => c* b* 58 # Otherwise just return the pattern 59 # Note: Only supports one braced expression. i.e. not {a,b}*{c,d}* 60 proc glob.expandbraces {pattern} { 61 # Avoid regexp for dependency reasons. 62 # XXX: Doesn't handle backslashed braces 63 if {[set fb [string first "\{" $pattern]] < 0} { 64 return $pattern 65 } 66 if {[set nb [string first "\}" $pattern $fb]] < 0} { 67 return $pattern 68 } 69 set before [string range $pattern 0 $fb-1] 70 set braced [string range $pattern $fb+1 $nb-1] 71 set after [string range $pattern $nb+1 end] 72 73 lmap part [split $braced ,] { 74 set pat $before$part$after 75 } 76 } 77 78 # Core glob implementation. Returns a list of files/directories matching the pattern 79 proc glob.glob {pattern} { 80 set dir [file dirname $pattern] 81 if {$dir eq $pattern} { 82 # At the top level 83 return [list $dir] 84 } 85 86 # Recursively expand the parent directory 87 set dirlist [glob.glob $dir] 88 set pattern [file tail $pattern] 89 90 # Now collect the fiels/directories 91 set result {} 92 foreach dir $dirlist { 93 set globdir $dir 94 if {[string match "*/" $dir]} { 95 set sep "" 96 } elseif {$dir eq "."} { 97 set globdir "" 98 set sep "" 99 } else { 100 set sep / 101 } 102 foreach pat [glob.expandbraces $pattern] { 103 foreach name [glob.readdir_pattern $dir $pat] { 104 lappend result $globdir$sep$name 105 } 106 } 107 } 108 return $result 109 } 110 111 # Start of main glob 112 set nocomplain 0 113 114 if {[lindex $args 0] eq "-nocomplain"} { 115 set nocomplain 1 116 set args [lrange $args 1 end] 117 } 118 119 set result {} 120 foreach pattern $args { 121 lappend result {*}[glob.glob $pattern] 122 } 123 124 if {$nocomplain == 0 && [llength $result] == 0} { 125 return -code error "no files matched glob patterns" 126 } 127 128 return $result 129} 130