Version history
package provide Globx 0.05
proc globx {startDir {search *} {cb ""}} {
set dirStack [list [file normalize $startDir]]
set files {}
set fc 0
while {[llength $dirStack]} {
set newStack {}
foreach dir $dirStack {
# temporary var's only because eventually using CallBack
set c [list glob -noc -typ f -dir $dir --]; eval lappend c $search; set fn [eval $c]
set c [list glob -noc -typ {f hidden} -dir $dir --]; eval lappend c $search; set fh [eval $c]
if {[string equal $cb ""]} {
eval lappend files $fn $fh
} else {
foreach f [concat $fn $fh] {
incr fc
uplevel [list $cb $f]
}
}
set dn [glob -noc -typ d -dir $dir *]
set dh [glob -noc -typ {d hidden} -dir $dir *]
# eval lappend newStack $dn $dh; # v0.01
# Wikipatch Start v0.02 ---
foreach newDir [concat $dn $dh] {
set theDir [file tail $newDir]
if {[string equal $theDir "." ] || \
[string equal $theDir ".."]} {
# Don't push this, otherwise entering an endless
# loop (on UNIX, at least)
} else {
lappend newStack $newDir
}
}
# Wikipatch Ende ---
}
set dirStack $newStack
update; # keep Background alive
}
if {[string equal $cb ""]} {
return [lsort $files]
} else {
return $fc
}
}
# Die Anwendung von Wildcards hier wäre zwar möglich, aber erst
# auf UNTERSTER EBENE sinnvoll bzw. wäre ganz am Ende
# eine Filterung des Gesamtpfads mittels string match besser.
proc globx2 {startDir {cb ""}} {
set dirStack [list [file normalize $startDir]]
set dirs $dirStack; # bis v0.04: {} (ACHTUNG: potentielle Inkompatibilität!)
set dc 0
while {[llength $dirStack]} {
set newStack {}
foreach dir $dirStack {
set dn [glob -noc -typ d -dir $dir -- *]
set dh [glob -noc -typ {d hidden} -dir $dir -- *]
if {[string equal $cb ""]} {
eval lappend dirs $dn $dh
} else {
foreach d [concat $dn $dh] {
incr dc
uplevel [list $cb $d]
}
}
foreach newDir [concat $dn $dh] {
set theDir [file tail $newDir]
if {[string equal $theDir "." ] || \
[string equal $theDir ".."]} {
# Don't push this, otherwise entering an endless
# loop (on UNIX, at least)
} else {
lappend newStack $newDir
}
}
}
set dirStack $newStack
update
}
if {[string equal $cb ""]} {
return [lsort $dirs]
} else {
return $dc
}
}
#*******************************************************************************Examples:
Without a callback, directly returning the filenames as a list:
puts [globx c:/winnt] puts [globx c:/winnt *.dll]
Returning the filenames unsorted name-by-name via callback:
proc callback file {
puts $file
}
puts [globx c:/winnt * callback]; # will return the number of files readThis is to save memory!
Specifying search masks (v0.04)
puts [globx c:/winnt {*.dll *.sys *.exe}]ECS: I had to include some lines to test for "." and ".." otherwise the routine loops.
MH: On my platform (W2k, Tcl 8.4.6), the original routine does not loop; the glob command never returns '..' and '.'. Which platform did you test the code on?
ECS: Debian Linux: Linux babylon 2.4.26-ow2 #1 Fri Jul 9 15:19:06 BRT 2004 i686 GNU/Linux TCL is 8.4.7 (samething happens with 8.4.6). In any case it is better to be safe than sorry :-)