diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | doc/getOpenFile.n | 8 | ||||
| -rw-r--r-- | library/tkfbox.tcl | 33 |
3 files changed, 41 insertions, 8 deletions
@@ -1,3 +1,11 @@ +2001-12-14 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * doc/getOpenFile.n: Documented change. + * library/tkfbox.tcl (SetFilter): Added code to guess the correct + default extension from whatever value was selected in the + filetypes option menu. Adapted from code by Chris Nelson + submitted in Patch #492220. + 2001-12-05 Jeff Hobbs <jeffh@ActiveState.com> * generic/tkText.c: diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n index 26625d2..f2a57bd 100644 --- a/doc/getOpenFile.n +++ b/doc/getOpenFile.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: getOpenFile.n,v 1.8 2000/07/25 21:14:35 jenglish Exp $ +'\" RCS: @(#) $Id: getOpenFile.n,v 1.9 2001/12/14 14:56:46 dkf Exp $ '\" .so man.macros .TH tk_getOpenFile n 4.2 Tk "Tk Built-In Commands" @@ -42,7 +42,11 @@ Specifies a string that will be appended to the filename if the user enters a filename without an extension. The defaut value is the empty string, which means no extension will be appended to the filename in any case. This option is ignored on the Macintosh platform, which -does not require extensions to filenames. +does not require extensions to filenames, +.VS 8.4 +and the UNIX implementation guesses reasonable values for this from +the \fB\-filetypes\fR option when this is not supplied. +.VE 8.4 .TP \fB\-filetypes\fR \fIfilePatternList\fR If a \fBFile types\fR listbox exists in the file dialog on the particular diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 7fce44e..62b5b6b 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -11,7 +11,7 @@ # files by clicking on the file icons or by entering a filename # in the "Filename:" entry. # -# RCS: @(#) $Id: tkfbox.tcl,v 1.31 2001/09/17 14:12:18 dkf Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.32 2001/12/14 14:56:46 dkf Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -959,12 +959,10 @@ proc ::tk::dialog::file::Config {dataName type argList} { # like "yes") so we can use it in tests more easily. if {![string compare $type save]} { set data(-multiple) 0 + } elseif {$data(-multiple)} { + set data(-multiple) 1 } else { - if {$data(-multiple)} { - set data(-multiple) 1 - } else { - set data(-multiple) 0 - } + set data(-multiple) 0 } } @@ -1365,6 +1363,29 @@ proc ::tk::dialog::file::SetFilter {w type} { set data(filter) [lindex $type 1] $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1 + # If we aren't using a default extension, use the one suppled + # by the filter. + if {![info exists data(extUsed)]} { + if {[string length $data(-defaultextension)]} { + set data(extUsed) 1 + } else { + set data(extUsed) 0 + } + } + + if {!$data(extUsed)} { + # Get the first extension in the list that matches {^\*\.\w+$} + # and remove all * from the filter. + set index [lsearch -regexp $data(filter) {^\*\.\w+$}] + if {$index >= 0} { + set data(-defaultextension) \ + [string trimleft [lindex $data(filter) $index] "*"] + } else { + # Couldn't find anything! Reset to a safe default... + set data(-defaultextension) "" + } + } + $icons(sbar) set 0.0 0.0 ::tk::dialog::file::UpdateWhenIdle $w |