diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | library/tkfbox.tcl | 74 |
2 files changed, 57 insertions, 28 deletions
@@ -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] +} |