- speed
- progressVar is not updated if level > 0 (recursive search)
- it has to work with tcl 8.0
########################################################################################################
# proc : GetFileList
# written by : Enrico Herzke
# Datum : 2001
########################################################################################################
# Funktion: Liefert Liste aller Dateien in einem Verzeichnis inkl. Unterverzeichnisse
# Aufruf: GetFileList path ?args?
# Eingabe: [I] path - zu durchsuchendes Verzeichnis
# [I] -ext - Liste von einer oder mehreren Extensions ohne Punkt,
# nach denen gesucht wird
# z.B.: '-ext h' oder '-ext "h cpp"'
# [I] -relPath - 0 -> liefere kompletten Pfad
# 1 -> liefere relativen Pfad (default)
# [I] -recursiv - 0 -> nur den uebergebenen Pfad durchsuchen
# 1 -> alle Unterverzeichnisse durchsuchen (default)
# Ausgabe: keine
# Rückgabe: Fileliste
# Hinweis: - wird keine Extension (Option -ext) angegeben, werden alle Dateien zurueckgeliefert,
# es werden nur relative Pfadangaben der gefundenen Dateien zurueckgegeben
# - gibt man den Pfad mit abschließendem Slash an, wird der komplette Pfad zurueckgeliefert
# Beispiel:
#
proc GetFileList {path args} {
if {[lindex $args 0] != 0 && [lindex $args 0] != 1} {
set level 0
} else {
set level [lindex $args 0]
set args [lrange $args 1 end]
if {$level == 1} {
set searchRecursiv 1
while {[llength $args] > 0} {
set opt [lindex $args 0]
switch -- $opt {
-progressVar {
upvar #0 [lindex $args 1] progressVar
set args [lrange $args 2 end]
}
default {
return -code error "unknown option '$opt'"
}
}
}
}
}
if {$level == 0} {
set extOK 0
set relPath 1
set searchRecursiv 1
set regExp ".*"
#puts stderr "args'$args' -> '[llength $args]'"
while {[llength $args] > 0} {
set opt [lindex $args 0]
switch -- $opt {
-ext {
set ext [lindex $args 1]
set extOK 1
set args [lrange $args 2 end]
}
-relPath {
set relPath [lindex $args 1]
set args [lrange $args 2 end]
}
-recursiv {
set searchRecursiv [lindex $args 1]
set args [lrange $args 2 end]
}
-progressVar {
upvar #0 [lindex $args 1] progressVar
set args [lrange $args 2 end]
}
-regExp {
set regExp [lindex $args 1]
set args [lrange $args 2 end]
}
default {
return -code error "unknown option '$opt'"
}
}
#puts stderr "args'$args' -> '[llength $args]'"
}
}
set fileList ""
set fL ""
set path [Backslash2Slash $path]
set all [glob -nocomplain $path/*]
dputs "all 'glob -nocomplain $path/*' -> '$all'"
foreach f $all {
update idletasks
if {[file isdirectory $f]} {
set progressVar $f;update
if $searchRecursiv {
set temp [GetFileList $f 1 -progressVar progressVar]
foreach t $temp {
lappend fL $t
}
}
} else {
lappend fL $f
}
}
if {$level == 0} {
foreach f $fL {
if {![regexp $regExp $f]} {continue}
if $extOK {
dputs "checke extension '$ext' bei '$f' -> '[file extension $f]'"
set isExt [string range [file extension $f] 1 end]
if {[lsearch [string tolower $ext] [string tolower $isExt]] == -1} {
continue
}
}
if $relPath {
regsub -- "$path/" $f "" f
}
lappend fileList $f
}
} else {
set fileList $fL
}
return $fileList
}MHo: You may also take a look at Matthias Hoffmann - Tcl-Code-Snippets - misc - globx.
globx is ok, but works not on tcl 8.0 which I need!
