diff options
author | dkf <dkf@noemail.net> | 2012-08-24 15:12:34 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2012-08-24 15:12:34 (GMT) |
commit | 485f6ff7671f993f918fbabd163227f73dde3845 (patch) | |
tree | 57431c951c0c9e17ea154a24abdac09391622e44 /library | |
parent | 09548d7463aa4929eb479d1c989fc531c1507f07 (diff) | |
parent | 06ec4158f2baafe6498addcd0ea5ef5401bed622 (diff) | |
download | tk-485f6ff7671f993f918fbabd163227f73dde3845.zip tk-485f6ff7671f993f918fbabd163227f73dde3845.tar.gz tk-485f6ff7671f993f918fbabd163227f73dde3845.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.
FossilOrigin-Name: f3b0b97579c1940979e47720c7de3d89ba4992e6
Diffstat (limited to 'library')
-rw-r--r-- | library/tkfbox.tcl | 117 |
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*] \ |