diff options
Diffstat (limited to 'library/tkfbox.tcl')
| -rw-r--r-- | library/tkfbox.tcl | 133 |
1 files changed, 68 insertions, 65 deletions
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 0e091ab..ae16939 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -10,8 +10,6 @@ # "Directory" option menu. The user can select files by clicking on the # file icons or by entering a filename in the "Filename:" entry. # -# RCS: @(#) $Id: tkfbox.tcl,v 1.76 2010/01/19 01:27:41 patthoyts Exp $ -# # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution @@ -198,9 +196,9 @@ proc ::tk::dialog::file:: {type args} { } UpdateWhenIdle $w - # Withdraw the window, then update all the geometry information so we know - # how big it wants to be, then center the window in the display and - # de-iconify it. + # Withdraw the window, then update all the geometry information + # so we know how big it wants to be, then center the window in the + # display (Motif style) and de-iconify it. ::tk::PlaceWindow $w widget $data(-parent) wm title $w $data(-title) @@ -268,6 +266,12 @@ proc ::tk::dialog::file::Config {dataName type argList} { lappend specs {-multiple "" "" "0"} } + # The "-confirmoverwrite" option is only for the "save" file dialog. + # + if {$type eq "save"} { + lappend specs {-confirmoverwrite "" "" "1"} + } + # 2: default values depending on the type of the dialog # if {![info exists data(selectPath)]} { @@ -584,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 @@ -1123,7 +1104,7 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { set Priv(selectFile) $data(selectFile) set Priv(selectPath) $data(selectPath) - if {($data(type) eq "save") && [file exists $selectFilePath]} { + if {($data(type) eq "save") && $data(-confirmoverwrite) && [file exists $selectFilePath]} { set reply [tk_messageBox -icon warning -type yesno -parent $w \ -message [mc "File \"%1\$s\" already exists.\nDo you want\ to overwrite it?" $selectFilePath]] @@ -1144,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*] \ |