summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-08-24 14:59:46 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-08-24 14:59:46 (GMT)
commit63131158ec6f20712214c1233541e694443b149d (patch)
tree4d1ee73014c04492a2795cef4471e155cf12a403
parentc0a9fce973031291671d7ad72ec9a6e766125d6d (diff)
downloadtk-63131158ec6f20712214c1233541e694443b149d.zip
tk-63131158ec6f20712214c1233541e694443b149d.tar.gz
tk-63131158ec6f20712214c1233541e694443b149d.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.tcl113
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*] \