aboutsummaryrefslogtreecommitdiff
path: root/glob.tcl
blob: 8e55489306b8ae10c9132bc897ab5e3a11f99b1f (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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
# Implements a Tcl-compatible glob command based on readdir
#
# (c) 2008 Steve Bennett <steveb@workware.net.au>
#
# See LICENCE in this directory for licensing.

package require readdir

# Implements the Tcl glob command
#
# Usage: glob ?-nocomplain? pattern ...
#
# Patterns use 'string match' (glob) pattern matching for each
# directory level, plus support for braced alternations.
#
# e.g. glob "te[a-e]*/*.{c,tcl}"
#
# Note: files starting with . will only be returned if matching component
#       of the pattern starts with .
proc glob {args} {

	# If $dir is a directory, return a list of all entries
	# it contains which match $pattern
	#
	local proc glob.readdir_pattern {dir pattern} {
		set result {}

		# readdir doesn't return . or .., so simulate it here
		if {$pattern in {. ..}} {
			return $pattern
		}

		# Use -nocomplain here to return nothing if $dir is not a directory
		foreach name [readdir -nocomplain $dir] {
			if {[string match $pattern $name]} {
				# Only include entries starting with . if the pattern starts with .
				if {[string index $name 0] eq "." && [string index $pattern 0] ne "."} {
					continue
				}
				lappend result $name
			}
		}

		return $result
	}

	# glob entries in directory $dir and pattern $rem
	#
	local proc glob.do {dir rem} {
		# Take one level from rem
		# Avoid regexp here
		set i [string first / $rem]
		if {$i < 0} {
			set pattern $rem
			set rempattern ""
		} else {
			set pattern [string range $rem 0 $i-1]
			set rempattern [string range $rem $i+1 end]
		}

		# Determine the appropriate separator and globbing dir
		set sep /
		set globdir $dir
		if {[string match "*/" $dir]} {
			set sep ""
		} elseif {$dir eq ""} {
			set globdir .
			set sep ""
		}

		set result {}

		# If the pattern contains a braced expression, recursively call glob.do
		# to expand the alternations. Avoid regexp for dependency reasons.
		# XXX: Doesn't handle backslashed braces
		if {[set fb [string first "\{" $pattern]] >= 0} {
			if {[set nb [string first "\}" $pattern $fb]] >= 0} {
				set before [string range $pattern 0 $fb-1]
				set braced [string range $pattern $fb+1 $nb-1]
				set after [string range $pattern $nb+1 end]

				foreach part [split $braced ,] {
					lappend result {*}[glob.do $dir $before$part$after]
				}
				return $result
			}
		}

		# Use readdir and select all files which match the pattern
		foreach f [glob.readdir_pattern $globdir $pattern] {
			if {$rempattern eq ""} {
				# This is a terminal entry, so add it
				lappend result $dir$sep$f
			} else {
				# Expany any entries at this level and add them
				lappend result {*}[glob.do $dir$sep$f $rempattern]
			}
		}
		return $result
	}

	# Start of main glob
	set nocomplain 0

	if {[lindex $args 0] eq "-nocomplain"} {
		set nocomplain 1
		set args [lrange $args 1 end]
	}

	set result {}
	foreach pattern $args {
		if {$pattern eq "/"} {
			lappend result /
		} elseif {[string match "/*" $pattern]} {
			lappend result {*}[glob.do / [string range $pattern 1 end]]
		} else {
			lappend result {*}[glob.do "" $pattern]
		}
	}

	if {$nocomplain == 0 && [llength $result] == 0} {
		return -code error "no files matched glob patterns"
	}

	return $result
}