[Bug 3558535]: Factor out the filtered-sorted globbing code into one procedure

that knows how to avoid nasty problems when non-list filters are used.

2 files changed, 62 insertions, 62 deletions

diff --git a/ChangeLog b/ChangeLog
index e6e153d..71af409 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,15 @@
+2012-08-24  Donal K. Fellows  <dkf@users.sf.net>
+
+	* library/tkfbox.tcl (GlobFiltered): [Bug 3558535]: Factor out the
+	filtered-sorted globbing code into one procedure that knows how to
+	avoid nasty problems when non-list filters are used. This allows the
+	rest of the [tk_getOpenFile] implementation to be ignorant of the
+	considerable complexities of globbing.
+
 2012-08-23  Don Porter  <dgp@users.sourceforge.net>
 
-	* unix/tkUnixWm.c: [Bugs 3554026,3561016] Stop crash with tearoff menus.
+	* unix/tkUnixWm.c: [Bugs 3554026,3561016]: Stop crash with tearoff
+	menus.
 
 2012-08-17  Jan Nijtmans  <nijtmans@users.sf.net>
 
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index bbea5c6..e145805 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -18,7 +18,7 @@
 #
 
 package require Ttk
-
+
 #----------------------------------------------------------------------
 #
 #		      I C O N   L I S T
@@ -786,7 +786,7 @@ proc ::tk::IconList_Reset {w} {
 
     unset -nocomplain Priv(ILAccel,$w)
 }
-
+
 #----------------------------------------------------------------------
 #
 #		      F I L E   D I A L O G
@@ -1326,36 +1326,16 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
 
     set showHidden $::tk::dialog::file::showHiddenVar
 
-    # Make the dir list
-    # Using -directory [pwd] is better in some VFS cases.
-    set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]
-    if {$showHidden} { lappend cmd .* }
-    set dirs [lsort -dictionary -unique [eval $cmd]]
-    set dirList {}
-    foreach d $dirs {
-	if {$d eq "." || $d eq ".."} {
-	    continue
-	}
-	lappend dirList $d
-    }
-    ::tk::IconList_Add $data(icons) $folder $dirList
+    # Make the dir list. Note that using an explicit [pwd] (instead of '.') is
+    # better in some VFS cases.
+    ::tk::IconList_Add $data(icons) $folder [GlobFiltered [pwd] d 1]
 
     if {$class eq "TkFDialog"} {
-	# Make the file list if this is a File Dialog, selecting all
-	# but 'd'irectory type files.
+	# Make the file list if this is a File Dialog, selecting all but
+	# 'd'irectory type files.
 	#
-	set cmd [list glob -tails -directory [pwd] \
-		-type {f b c l p s} -nocomplain]
-	if {$data(filter) eq "*"} {
-	    lappend cmd *
-	    if {$showHidden} {
-		lappend cmd .*
-	    }
-	} else {
-	    eval [list lappend cmd] $data(filter)
-	}
-	set fileList [lsort -dictionary -unique [eval $cmd]]
-	::tk::IconList_Add $data(icons) $file $fileList
+	::tk::IconList_Add $data(icons) $file \
+	    [GlobFiltered [pwd] {f b c l p s}]
     }
 
     ::tk::IconList_Arrange $data(icons)
@@ -1884,49 +1864,60 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
     set Priv(selectFilePath) $selectFilePath
 }
 
+proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} {
+    # $dir == where to search
+    # $type == what to look for ('d' or 'f b c l p s')
+    # $overrideFilter == whether to ignore the filter
+
+    variable showHiddenVar
+    upvar 1 data(filter) filter
+
+    if {$filter eq "*" || $overrideFilter} {
+	set patterns [list *]
+	if {$showHiddenVar} {
+	    lappend patterns .*
+	}
+    } elseif {[string is list $filter]} {
+	set patterns $filter
+    } else {
+	# Invalid list; assume we can use non-whitespace sequences as words
+	set patterns [regexp -inline -all {\S+} $filter]
+    }
+
+    set opts [list -tails -directory $dir -type $type -nocomplain]
+
+    set result {}
+    catch {
+	# We have a catch because we might have a really bad pattern (e.g.,
+	# with an unbalanced brace); even [glob -nocomplain] doesn't like it.
+	# Using a catch ensures that it just means we match nothing instead of
+	# throwing a nasty error at the user...
+	foreach f [glob {*}$opts -- {*}$patterns] {
+	    if {$f eq "." || $f eq ".."} {
+		continue
+	    }
+	    lappend result $f
+	}
+    }
+    return [lsort -dictionary -unique $result]
+}
+
 proc ::tk::dialog::file::CompleteEnt {w} {
     upvar ::tk::dialog::file::[winfo name $w] data
     set f [$data(ent) get]
     if {$data(-multiple)} {
-	if {[catch {llength $f} len] || $len != 1} {
+	if {![string is list $f] || [llength $f] != 1} {
 	    return -code break
 	}
 	set f [lindex $f 0]
     }
 
     # Get list of matching filenames and dirnames
-    set globF [list glob -tails -directory $data(selectPath) \
-		-type {f b c l p s} -nocomplain]
-    set globD [list glob -tails -directory $data(selectPath) -type d \
-		       -nocomplain *]
-    if {$data(filter) eq "*"} {
-	lappend globF *
-	if {$::tk::dialog::file::showHiddenVar} {
-	    lappend globF .*
-	    lappend globD .*
-	}
-	if {[winfo class $w] eq "TkFDialog"} {
-	    set files [lsort -dictionary -unique [{*}$globF]]
-	} else {
-	    set files {}
-	}
-	set dirs [lsort -dictionary -unique [{*}$globD]]
-    } else {
-	if {$::tk::dialog::file::showHiddenVar} {
-	    lappend globD .*
-	}
-	if {[winfo class $w] eq "TkFDialog"} {
-	    set files [lsort -dictionary -unique [{*}$globF {*}$data(filter)]]
-	} else {
-	    set files {}
-	}
-	set dirs [lsort -dictionary -unique [{*}$globD]]
-    }
-    # Filter specials
-    set dirs [lsearch -all -not -exact -inline $dirs .]
-    set dirs [lsearch -all -not -exact -inline $dirs ..]
+    set files [if {[winfo class $w] eq "TkFDialog"} {
+	GlobFiltered $data(selectPath) {f b c l p s}
+    }]
     set dirs2 {}
-    foreach d $dirs {lappend dirs2 $d/}
+    foreach d [GlobFiltered $data(selectPath) d] {lappend dirs2 $d/}
 
     set targets [concat \
 	    [lsearch -glob -all -inline $files $f*] \