[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.

1 files changed, 58 insertions, 59 deletions

diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index ff79df8..ae16939 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -588,38 +588,15 @@ proc ::tk::dialog::file::Update {w} {
 
     set showHidden $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 [{*}$cmd]]
-    set dirList {}
-    foreach d $dirs {
-	if {$d eq "." || $d eq ".."} {
-	    continue
-	}
-	lappend dirList $d
-    }
-    $data(icons) add $folder $dirList
+    # Make the dir list. Note that using an explicit [pwd] (instead of '.') is
+    # better in some VFS cases.
+    $data(icons) add $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.
 	#
-	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 {
-	    lappend cmd {*}$data(filter)
-	}
-	set fileList [lsort -dictionary -unique [{*}$cmd]]
-	$data(icons) add $file $fileList
+	$data(icons) add $file [GlobFiltered [pwd] {f b c l p s}]
     }
 
     # Update the Directory: option menu
@@ -1148,50 +1125,72 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
     set Priv(selectFilePath) $selectFilePath
 }
 
+# ::tk::dialog::file::GlobFiltered --
+#
+#	Gets called to do globbing, returning the results and filtering them
+#	according to the current filter (and removing the entries for '.' and
+#	'..' which are never shown). Deals with evil cases such as where the
+#	user is supplying a filter which is an invalid list or where it has an
+#	unbalanced brace. The resulting list will be dictionary sorted.
+#
+#	Arguments:
+#	  dir		 Which directory to search
+#	  type		 List of filetypes to look for ('d' or 'f b c l p s')
+#	  overrideFilter Whether to ignore the filter for this search.
+#
+#	NB: Assumes that the caller has mapped the state variable to 'data'.
+#
+proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} {
+    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} {
     variable showHiddenVar
     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 {$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 {$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*] \