Version 1 of Matthias Hoffmann - Tcl-Code-Snippets - misc - globx

Updated 2006-04-12 09:36:09

package provide Globx 0.03

 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 fn [glob -noc -typ f          -dir $dir -- $search]
                    set fh [glob -noc -typ {f hidden} -dir $dir -- $search]
                    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
      }
 }

 # Enumerating only directories

 proc globx2 {startDir {cb ""}} {
      set dirStack [list [file normalize $startDir]]
      set dirs {}
      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!


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 :-)