Remark: old sourcecodes moved to the end of the page. Newest code at the top.
pkgIndex.tcl
# 04.07.2014 package ifneeded Globx 0.1 [list source [file join $dir globx.tcl]] package ifneeded globx 0.1 [list source [file join $dir globx.tcl]]
globx.tcl
#****h* Library/globx.tcl # # NAME # # globx.tcl - list files or folders of a folder tree # v0.10, 07.07.2014 # # AUTHOR # # M.Hoffmann, © 2004-2014 # # PORTABILITY # # Tcl. Tested by the author on Windows only. # # USAGE # # -- package require globx # To get all matching files in the given folder and subfolders: # -- set files [globx startDir patterns] # or # proc callback fileName {...} # -- set numFiles [globx startDir patterns callback] # To get all subfolders of given folder (including the folder itself): # -- set dirs [globx2 startDir] # or # proc callback dirName {...} # -- set numDirs [globx2 startDir callback] # # NOTES # # -- works non-recursiv # -- if using a callback, the order in which the cb is called is undetermined # -- proc looks in *all* subfolders - only files are matched against pattern # -- hidden files or folders are included # -- use * instead of *.* to get the same results as with Windows commands (dir /s) # # TODO # # -- Namespace # -- maybe using 8.6`s lmap, and coroutine to avoid blocking a gui while reading large dirs # # HISTORY # # v0.01 06.02.2004 - first documented, usable version # v0.02 21.10.2004 - wiki fix (suppress . and ..) # v0.03 09.12.2004 - new globx2 to only list folders # v0.04 21.07.2006 - multiple patterns made possible # v0.05 14.06.2009 - globx2 returns the given folder itself, too # v0.06 26.08.2011 - catch{} to prevent some dubios runtime errors # v0.10 07.07.2014 - optimizations - approx. 10% better performance. # - bugfix: globx2 with callback did not return given folder. # - removed update; a GUI program could use the callback method # and, if required, call update from within the cb. Or switch # back to the old behaviour and call 'globxSetUpdate update' once. # - configurable update command (see above). # - additional package name all lowercase. # - callback could break the loop by returning a break. # # SOURCE package require Tcl 8.5 package provide Globx 0.1 package provide globx 0.1 proc globxUpdate {} { } # Sets a command, which is then called repeatedly during processing via globxUpdate. # By default, globxUpdate does nothing. To achieve same behaviour as with versions # prior to 0.1, call 'globxSetUpdate update' once before anything else. # proc globxSetUpdate {script} { proc globxUpdate {} $script } # Returns all files wich match given search-mask(s) in the given directory and below, # hidden or not hidden. ALL subdirectories (*) are visited, hidden or not, without # a recursive proc call. # proc globx {startDir {search *} {cb ""}} { set dirStack [list [file normalize $startDir]] set files [list] set fc 0 while {[llength $dirStack]} { set newStack [list] foreach dir $dirStack { set filesHere [list] set dirsHere [list] # temporary var's only because eventually using CallBack catch { lappend filesHere {*}[glob -noc -typ f -dir $dir -- {*}$search] lappend filesHere {*}[glob -noc -typ {f hidden} -dir $dir -- {*}$search] } if {[string equal $cb ""]} { lappend files {*}$filesHere; # cumulation } else { # call back early, not at the end foreach f $filesHere { incr fc set rc [catch {uplevel [list $cb $f]} errMsg opts] if {$rc == 3} { return $fc; # TCL_BREAK means: stop here, but don't propagate } elseif {$rc != 0} { # propagate the error return -options $opts $errMsg } } } catch { lappend dirsHere {*}[glob -noc -typ d -dir $dir -- *] lappend dirsHere {*}[glob -noc -typ {d hidden} -dir $dir -- *] } # note: lmap possible in 8.6 # start Wikipatch v0.02 --- foreach newDir $dirsHere { 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 } } # end Wikipatch --- } set dirStack $newStack globxUpdate } if {[string equal $cb ""]} { return [lsort $files] } else { return $fc } } # Returns the name of the given dir and all of it's subdirectories (direct or # indirect). No wildcard selection possible - proc is for reading the # whole folder names of the tree starting at the given point. # proc globx2 {startDir {cb ""}} { set startDir [file normalize $startDir] set dirStack [list $startDir] set dirs [list] set dc 0 # bugfix. Up until v0.06, startDir still not returned if using a callback if {[file isdirectory $startDir]} { incr dc if {[string equal $cb ""]} { set dirs $dirStack; # until v0.04, startDir wasn't returned at all... } else { uplevel [list $cb $startDir] } while {[llength $dirStack]} { set newStack [list] foreach dir $dirStack { set dirsHere [list] catch { lappend dirsHere {*}[glob -noc -typ d -dir $dir -- *] lappend dirsHere {*}[glob -noc -typ {d hidden} -dir $dir -- *] } foreach newDir $dirsHere { 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) # v0.1: don't process . and .. at all } else { lappend newStack $newDir if {[string equal $cb ""]} { lappend dirs $newDir; # cumulation } else { # call back early, not at the end incr dc set rc [catch {uplevel [list $cb $newDir]} errMsg opts] if {$rc == 3} { return $dc; # TCL_BREAK means: stop here, but don't propagate } elseif {$rc != 0} { # propagate the error return -options $opts $errMsg } } } } } set dirStack $newStack globxUpdate } } if {[string equal $cb ""]} { return [lsort $dirs] } else { return $dc } } #*******************************************************************************
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 read
This 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 :-)
MHo Version 0.6:
package provide Globx 0.06 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 catch { 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] } } } catch { 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 { catch { 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 } } #*******************************************************************************