summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-08-25 08:09:17 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-08-25 08:09:17 (GMT)
commit0363772b05a3395a9e79e21c2bb81121bcec0575 (patch)
tree2c3d609fa62541f7e8035c801be9275f746d48b5
parent34619c3877d67d2c96785efe775096802ef77937 (diff)
downloadtk-0363772b05a3395a9e79e21c2bb81121bcec0575.zip
tk-0363772b05a3395a9e79e21c2bb81121bcec0575.tar.gz
tk-0363772b05a3395a9e79e21c2bb81121bcec0575.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.
-rw-r--r--ChangeLog11
-rw-r--r--library/tkfbox.tcl74
2 files changed, 57 insertions, 28 deletions
diff --git a/ChangeLog b/ChangeLog
index d540456..18e1c73 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 bf6cf87..b848371 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -16,7 +16,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-
+
#----------------------------------------------------------------------
#
# I C O N L I S T
@@ -759,7 +759,7 @@ proc ::tk::IconList_Reset {w} {
unset -nocomplain Priv(ILAccel,$w)
}
-
+
#----------------------------------------------------------------------
#
# F I L E D I A L O G
@@ -1260,34 +1260,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)
@@ -1812,3 +1794,41 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
bind $data(okBtn) <Destroy> {}
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 {[catch {
+ set patterns [lreplace $filter 0 -1]
+ }]} then {
+ # Invalid list; assume we can use non-whitespace sequences as words
+ set patterns [regexp -inline -all {\S+} $filter]
+ }
+
+ set cmd [list glob -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 [eval $cmd $patterns] {
+ if {$f eq "." || $f eq ".."} {
+ continue
+ }
+ lappend result $f
+ }
+ }
+ return [lsort -dictionary -unique $result]
+}