summaryrefslogtreecommitdiffstats
path: root/library/tkfbox.tcl
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-08-24 15:12:34 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-08-24 15:12:34 (GMT)
commit665c6838d8bd2124a075412fcca609233d6bc27a (patch)
tree57431c951c0c9e17ea154a24abdac09391622e44 /library/tkfbox.tcl
parent0a14aa5c2942393da63f2ff7cab77aa818e84011 (diff)
parent63131158ec6f20712214c1233541e694443b149d (diff)
downloadtk-665c6838d8bd2124a075412fcca609233d6bc27a.zip
tk-665c6838d8bd2124a075412fcca609233d6bc27a.tar.gz
tk-665c6838d8bd2124a075412fcca609233d6bc27a.tar.bz2
[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.
Diffstat (limited to 'library/tkfbox.tcl')
-rw-r--r--library/tkfbox.tcl117
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*] \