# 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
		}

		# If the pattern isn't actually a pattern...
		if {[string match {*[*?]*} $pattern]} {
			# Use -nocomplain here to return nothing if $dir is not a directory
			set files [readdir -nocomplain $dir]
		} elseif {[file isdir $dir] && [file exists $dir/$pattern]} {
			set files [list $pattern]
		} else {
			set files ""
		}

		foreach name $files {
			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
	}

	# If the pattern contains a braced expression, return a list of
	# patterns with the braces expanded. {c,b}* => c* b*
	# Otherwise just return the pattern
	# Note: Only supports one braced expression. i.e. not {a,b}*{c,d}*
	proc glob.expandbraces {pattern} {
		# Avoid regexp for dependency reasons.
		# XXX: Doesn't handle backslashed braces
		if {[set fb [string first "\{" $pattern]] < 0} {
			return $pattern
		}
		if {[set nb [string first "\}" $pattern $fb]] < 0} {
			return $pattern
		}
		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]

		lmap part [split $braced ,] {
			set pat $before$part$after
		}
	}

	# Core glob implementation. Returns a list of files/directories matching the pattern
	proc glob.glob {pattern} {
		set dir [file dirname $pattern]
		if {$dir eq $pattern} {
			# At the top level
			return [list $dir]
		}

		# Recursively expand the parent directory
		set dirlist [glob.glob $dir]
		set pattern [file tail $pattern]

		# Now collect the fiels/directories
		set result {}
		foreach dir $dirlist {
			set globdir $dir
			if {[string match "*/" $dir]} {
				set sep ""
			} elseif {$dir eq "."} {
				set globdir ""
				set sep ""
			} else {
				set sep /
			}
			foreach pat [glob.expandbraces $pattern] {
				foreach name [glob.readdir_pattern $dir $pat] {
					lappend result $globdir$sep$name
				}
			}
		}
		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 {
		lappend result {*}[glob.glob $pattern]
	}

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

	return $result
}