From cb028bc2763e8b11a687f4d7ce2a4f663df20eae Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 14 Dec 2001 14:56:46 +0000
Subject: 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.

---
 ChangeLog          |  8 ++++++++
 doc/getOpenFile.n  |  8 ++++++--
 library/tkfbox.tcl | 33 +++++++++++++++++++++++++++------
 3 files changed, 41 insertions(+), 8 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index d320954..e45a570 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
-- 
cgit v0.12