* doc/getOpenFile.n: TIP#242 implementation of -typevariable to

	* library/tkfbox.tcl: return type of selected file in file dialogs.
	* library/xmfbox.tcl: [Bug #1156388]
	* macosx/tkMacOSXDialog.c:
	* tests/filebox.test:
	* tests/winDialog.test:
	* win/tkWinDialog.c:

8 files changed, 264 insertions, 66 deletions

diff --git a/ChangeLog b/ChangeLog
index fdefa3f..0bcb683 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2007-10-25  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* doc/getOpenFile.n:  TIP#242 implementation of -typevariable to
+	* library/tkfbox.tcl: return type of selected file in file dialogs.
+	* library/xmfbox.tcl: [Bug #1156388]
+	* macosx/tkMacOSXDialog.c:
+	* tests/filebox.test:
+	* tests/winDialog.test:
+	* win/tkWinDialog.c:
+
 2007-10-25  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tkPlace.c:    Prevent segfault in place geometry manager.
diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n
index 0c07e5f..f28fbb1 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.16 2007/10/23 15:44:35 dkf Exp $
+'\" RCS: @(#) $Id: getOpenFile.n,v 1.17 2007/10/25 21:44:22 hobbs Exp $
 '\" 
 .so man.macros
 .TH tk_getOpenFile n 4.2 Tk "Tk Built-In Commands"
@@ -88,6 +88,16 @@ dialog is displayed on top of its parent window.
 \fB\-title\fR \fItitleString\fR
 Specifies a string to display as the title of the dialog box. If this
 option is not specified, then a default title is displayed. 
+.TP
+\fB\-typevariable\fR \fIvariableName\fR
+The variable \fIvariableName\fR is used to preselect which filter is
+used from \fIfilterList\fR when the dialog box is opened and is
+updated when the dialog box is closed, to the last selected
+filter. The variable is read once at the beginning to select the
+appropriate filter. If the variable does not exist, or it's value does
+not match any filter typename, or is empty (\fB{}\fR), the dialog box
+will revert to the default behavior of selecting the first filter in
+the list. If the dialog is canceled, the variable is not modified.
 .PP
 If the user selects a file, both \fBtk_getOpenFile\fR and
 \fBtk_getSaveFile\fR return the full pathname of this file. If the
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index a9228e1..fe6eccd 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.59 2007/02/19 23:52:19 hobbs Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.60 2007/10/25 21:44:22 hobbs Exp $
 #
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
 #
@@ -867,17 +867,32 @@ proc ::tk::dialog::file:: {type args} {
     $data(dirMenuBtn) configure \
 	    -textvariable ::tk::dialog::file::${dataName}(selectPath)
 
+    # Cleanup previous menu
+    #
+    $data(typeMenu) delete 0 end
+    $data(typeMenuBtn) configure -state normal -text ""
+
     # Initialize the file types menu
     #
     if {[llength $data(-filetypes)]} {
-	$data(typeMenu) delete 0 end
+	# Default type and name to first entry
+	set initialtype     [lindex $data(-filetypes) 0]
+	set initialTypeName [lindex $initialtype 0]
+	if {($data(-typevariable) ne "")
+	    && [uplevel 2 [list info exists $data(-typevariable)]]} {
+	    set initialTypeName [uplevel 2 [list set $data(-typevariable)]]
+	}
 	foreach type $data(-filetypes) {
 	    set title  [lindex $type 0]
 	    set filter [lindex $type 1]
 	    $data(typeMenu) add command -label $title \
-		    -command [list ::tk::dialog::file::SetFilter $w $type]
+		-command [list ::tk::dialog::file::SetFilter $w $type]
+	    # string first avoids glob-pattern char issues
+	    if {[string first ${initialTypeName} $title] == 0} {
+		set initialtype $type
+	    }
 	}
-	SetFilter $w [lindex $data(-filetypes) 0]
+	SetFilter $w $initialtype
 	$data(typeMenuBtn) configure -state normal
 	$data(typeMenuLab) configure -state normal
     } else {
@@ -949,6 +964,7 @@ proc ::tk::dialog::file::Config {dataName type argList} {
 	{-initialfile "" "" ""}
 	{-parent "" "" "."}
 	{-title "" "" ""}
+	{-typevariable "" "" ""}
     }
 
     # The "-multiple" option is only available for the "open" file dialog.
@@ -1383,6 +1399,7 @@ proc ::tk::dialog::file::SetFilter {w type} {
     upvar ::tk::dialog::file::[winfo name $w] data
     upvar ::tk::$data(icons) icons
 
+    set data(filterType) $type
     set data(filter) [lindex $type 1]
     $data(typeMenuBtn) configure -text [lindex $type 0] -indicatoron 1
 
@@ -1838,6 +1855,12 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
 		return
 	    }
 	}
+	if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
+	    && [info exists data(-filetypes)] && [llength $data(-filetypes)]
+	    && [info exists data(filterType)] && $data(filterType) ne ""} {
+	    upvar 4 $data(-typevariable) initialTypeName
+	    set initialTypeName [lindex $data(filterType) 0]
+	}
     }
     bind $data(okBtn) <Destroy> {}
     set Priv(selectFilePath) $selectFilePath
diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl
index 2e68a15..5036cd3 100644
--- a/library/xmfbox.tcl
+++ b/library/xmfbox.tcl
@@ -4,7 +4,7 @@
 #	Unix platform. This implementation is used only if the
 #	"::tk_strictMotif" flag is set.
 #
-# RCS: @(#) $Id: xmfbox.tcl,v 1.29 2006/03/17 11:13:15 patthoyts Exp $
+# RCS: @(#) $Id: xmfbox.tcl,v 1.30 2007/10/25 21:44:22 hobbs Exp $
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-2000 Scriptics Corporation
@@ -157,7 +157,22 @@ proc ::tk::MotifFDialog_FileTypes {w} {
 
     # The filetypes radiobuttons
     # set data(fileType) $data(-defaulttype)
+    # Default type to first entry
+    set initialTypeName [lindex $data(-filetypes) 0 0]
+    if {($data(-typevariable) ne "")
+	&& [uplevel 4 [list info exists $data(-typevariable)]]} {
+	set initialTypeName [uplevel 4 [list set $data(-typevariable)]]
+    }
+    set ix 0
     set data(fileType) 0
+    foreach fltr $data(-filetypes) {
+	set fname [lindex $fltr 0]
+	if {[string first $initialTypeName $fname] == 0} {
+	    set data(fileType) $ix
+	    break
+	}
+	incr ix
+    }
 
     MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)]
 
@@ -176,7 +191,7 @@ proc ::tk::MotifFDialog_FileTypes {w} {
 		-text $title \
 		-variable ::tk::dialog::file::[winfo name $w](fileType) \
 		-value $cnt \
-		-command "[list tk::MotifFDialog_SetFilter $w $type]"
+		-command [list tk::MotifFDialog_SetFilter $w $type]
 	    pack $f.b$cnt -side left
 	    incr cnt
 	}
@@ -226,6 +241,7 @@ proc ::tk::MotifFDialog_Config {dataName type argList} {
 	{-initialfile "" "" ""}
 	{-parent "" "" "."}
 	{-title "" "" ""}
+	{-typevariable "" "" ""}
     }
     if {$type eq "open"} {
 	lappend specs {-multiple "" "" "0"}
@@ -841,10 +857,17 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} {
 		return
 	    }
 	}
-	
+
 	lappend newFileList $item
     }
 
+    # Return selected filter
+    if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
+	&& [info exists data(-filetypes)] && $data(-filetypes) ne ""} {
+	upvar 2 $data(-typevariable) initialTypeName
+	set initialTypeName [lindex $data(-filetypes) $data(fileType) 0]
+    }
+
     if {$data(-multiple) != 0} {
 	set Priv(selectFilePath) $newFileList
     } else {
diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c
index 958ae7c..a8767c3 100644
--- a/macosx/tkMacOSXDialog.c
+++ b/macosx/tkMacOSXDialog.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkMacOSXDialog.c,v 1.30 2007/09/11 05:24:13 das Exp $
+ * RCS: @(#) $Id: tkMacOSXDialog.c,v 1.31 2007/10/25 21:44:22 hobbs Exp $
  */
 
 #include "tkMacOSXPrivate.h"
@@ -38,14 +38,14 @@
  * The following structures are used in the GetFileName() function. They store
  * information about the file dialog and the file filters.
  */
-
-typedef struct OpenFileData {
-    FileFilterList fl;		/* List of file filters. */
-    SInt16 curType;		/* The filetype currently being listed. */
-    short popupItem;		/* Item number of the popup in the dialog. */
-    int usePopup;		/* True if we show the popup menu (this is
-				 * an open operation and the -filetypes
-				 * option is set). */
+typedef struct _OpenFileData {
+    FileFilterList fl;          /* List of file filters.                   */
+    SInt16 curType;             /* The filetype currently being listed.    */
+    short initialType;          /* Type to use initially                   */
+    short popupItem;            /* Item number of the popup in the dialog. */
+    short usePopup;             /* True if we show the popup menu (this    */
+                                /* is an open operation and the            */
+                                /* -filetypes option is set).              */
 } OpenFileData;
 
 typedef struct NavHandlerUserData {
@@ -85,7 +85,8 @@ static int		NavServicesGetFile(Tcl_Interp *interp,
 			    OpenFileData *ofd, AEDesc *initialDescPtr,
 			    char *initialFile, AEDescList *selectDescPtr,
 			    CFStringRef title, CFStringRef message,
-			    int multiple, int isOpen, Tk_Window parent);
+			    const char *initialType, int multiple, int isOpen, 
+			    Tk_Window parent);
 static int		HandleInitialDirectory(Tcl_Interp *interp,
 			    char *initialFile, char *initialDir, FSRef *dirRef,
 			    AEDescList *selectDescPtr, AEDesc *dirDescPtr);
@@ -261,22 +262,25 @@ Tk_GetOpenFileObjCmd(
     AEDesc *initialPtr = NULL;
     AEDescList selectDesc = {typeNull, NULL};
     char *initialFile = NULL, *initialDir = NULL;
+    Tcl_Obj *typeVariablePtr = NULL;
+    const char *initialtype = NULL;
     static const char *openOptionStrings[] = {
 	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
-	"-message", "-multiple", "-parent", "-title", NULL
+	"-message", "-multiple", "-parent", "-title", "-typevariable", NULL
     };
     enum openOptions {
 	OPEN_DEFAULT, OPEN_FILETYPES, OPEN_INITDIR, OPEN_INITFILE,
-	OPEN_MESSAGE, OPEN_MULTIPLE, OPEN_PARENT, OPEN_TITLE
+	OPEN_MESSAGE, OPEN_MULTIPLE, OPEN_PARENT, OPEN_TITLE, OPEN_TYPEVARIABLE
     };
 
     if (!fileDlgInited) {
 	InitFileDialogs();
     }
     TkInitFileFilters(&ofd.fl);
-    ofd.curType = 0;
-    ofd.popupItem = OPEN_POPUP_ITEM;
-    ofd.usePopup = 1;
+    ofd.curType          = 0;
+    ofd.initialType      = -1;
+    ofd.popupItem        = OPEN_POPUP_ITEM;
+    ofd.usePopup         = 1;
 
     for (i = 1; i < objc; i += 2) {
 	char *choice;
@@ -338,6 +342,9 @@ Tk_GetOpenFileObjCmd(
 		title = CFStringCreateWithBytes(NULL, (unsigned char*)
 			choice, choiceLen, kCFStringEncodingUTF8, false);
 		break;
+	    case OPEN_TYPEVARIABLE:
+	        typeVariablePtr = objv[i + 1];
+	        break;
 	}
     }
 
@@ -349,8 +356,23 @@ Tk_GetOpenFileObjCmd(
     if (initialDesc.descriptorType == typeFSRef) {
 	initialPtr = &initialDesc;
     }
-    result = NavServicesGetFile(interp, &ofd, initialPtr, NULL, &selectDesc,
-	    title, message, multiple, OPEN_FILE, parent);
+
+    if (typeVariablePtr) {
+	initialtype = Tcl_GetVar(interp, Tcl_GetString(typeVariablePtr), 0);
+    }
+    result = NavServicesGetFile(interp, &ofd, initialPtr, NULL, &selectDesc, 
+	    title, message, initialtype, multiple, OPEN_FILE, parent);
+
+    if (typeVariablePtr) {
+	int i = ofd.curType;
+	FileFilter *filterPtr;
+	for (filterPtr = ofd.fl.filters; 
+	     filterPtr && i > 0; i--) {
+	    filterPtr = filterPtr->next;
+	}
+	Tcl_SetVar(interp, Tcl_GetString(typeVariablePtr), filterPtr->name, 0);
+    }
+
 end:
     TkFreeFileFilters(&ofd.fl);
     if (initialDesc.dataHandle) {
@@ -401,11 +423,11 @@ Tk_GetSaveFileObjCmd(
     OpenFileData ofd;
     static const char *saveOptionStrings[] = {
 	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
-	"-message", "-parent", "-title", NULL
+	"-message", "-parent", "-title", "-typevariable", NULL
     };
     enum saveOptions {
 	SAVE_DEFAULT, SAVE_FILETYPES, SAVE_INITDIR, SAVE_INITFILE,
-	SAVE_MESSAGE, SAVE_PARENT, SAVE_TITLE
+	SAVE_MESSAGE, SAVE_PARENT, SAVE_TITLE, SAVE_TYPEVARIABLE
     };
 
     if (!fileDlgInited) {
@@ -480,7 +502,7 @@ Tk_GetSaveFileObjCmd(
 	initialPtr = &initialDesc;
     }
     result = NavServicesGetFile(interp, &ofd, initialPtr, initialFile, NULL,
-	    title, message, false, SAVE_FILE, parent);
+	    title, message, NULL, false, SAVE_FILE, parent);
     TkFreeFileFilters(&ofd.fl);
 end:
     if (initialDesc.dataHandle) {
@@ -588,7 +610,7 @@ Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
 	initialPtr = &initialDesc;
     }
     result = NavServicesGetFile(interp, &ofd, initialPtr, NULL, NULL, title,
-	    message, false, CHOOSE_FOLDER, parent);
+	    message, NULL, false, CHOOSE_FOLDER, parent);
     TkFreeFileFilters(&ofd.fl);
 end:
     if (initialDesc.dataHandle) {
@@ -737,6 +759,7 @@ NavServicesGetFile(
     AEDescList *selectDescPtr,
     CFStringRef title,
     CFStringRef message,
+    const char *initialtype,
     int multiple,
     int isOpen,
     Tk_Window parent)
@@ -800,6 +823,9 @@ NavServicesGetFile(
 		filterPtr = filterPtr->next, index++) {
 	    menuItemNames[index] = CFStringCreateWithCString(NULL,
 		    filterPtr->name, kCFStringEncodingUTF8);
+	    if (initialtype && strcmp(filterPtr->name, initialtype) == 0) {
+		ofdPtr->initialType = index;
+	    }
 	}
 	options.popupExtension = CFArrayCreate(NULL,
 		(const void **) menuItemNames, ofdPtr->fl.numFilters, NULL);
@@ -988,8 +1014,33 @@ OpenEventProc(
     NavCallBackUserData callBackUD)
 {
     NavHandlerUserData *data = (NavHandlerUserData*) callBackUD;
-
+    OpenFileData *ofd = data->ofdPtr;
     switch (callBackSelector) {
+	case kNavCBStart:
+	  if (ofd && ofd->initialType >= 0) {
+		  /* Select initial filter */
+		  int i = ofd->initialType;
+		  FileFilter *filterPtr;
+
+		  for (filterPtr = ofd->fl.filters; 
+			   filterPtr && i > 0; i--) {
+			  filterPtr = filterPtr->next;
+		  }
+		  if (filterPtr) {
+			  NavMenuItemSpec selectItem;
+			  OSStatus err;
+			  selectItem.version = kNavMenuItemSpecVersion;
+			  selectItem.menuCreator = 0;
+			  selectItem.menuType = ofd->initialType;
+			  selectItem.menuItemName[0] = strlen(filterPtr->name);
+			  strncpy(&selectItem.menuItemName[1], filterPtr->name, 255);
+			  err = NavCustomControl(callBackParams->context, kNavCtlSelectCustomType, &selectItem);
+			  if (err != noErr) {
+				  fprintf(stderr,"NavCustomControl kNavCtlSelectCustomType Failed, %d\n", (int)err );
+			  }
+		  }
+	  }
+	  break;
 	case kNavCBPopupMenuSelect:
 	    data->ofdPtr->curType = ((NavMenuItemSpec *)
 		    callBackParams->eventData.eventDataParms.param)->menuType;
@@ -1077,7 +1128,7 @@ OpenFileFilterProc(
 			fileName[len] = '\0';
 			fileNamePtr = (unsigned char*) fileName;
 
-		    } else if ((theItem->descriptorType = typeFSRef)) {
+		    } else if ((theItem->descriptorType == typeFSRef)) {
 			OSStatus err;
 			FSRef *theRef = (FSRef *) *theItem->dataHandle;
 			HFSUniStr255 uniFileName;
diff --git a/tests/filebox.test b/tests/filebox.test
index 432323d..9e9fe11 100644
--- a/tests/filebox.test
+++ b/tests/filebox.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: filebox.test,v 1.18 2004/12/20 10:34:20 vincentdarley Exp $
+# RCS: @(#) $Id: filebox.test,v 1.19 2007/10/25 21:44:23 hobbs Exp $
 #
 
 package require tcltest 2.1
@@ -113,8 +113,8 @@ if {$tcl_platform(platform) == "unix"} {
     set modes 1
 }
 
-set unknownOptionsMsg(tk_getOpenFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}
-set unknownOptionsMsg(tk_getSaveFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}
+set unknownOptionsMsg(tk_getOpenFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
+set unknownOptionsMsg(tk_getSaveFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, -title, or -typevariable}
 
 set tmpFile "filebox.tmp"
 makeFile {
@@ -269,6 +269,27 @@ foreach mode $modes {
 		    -initialfile $fileName -initialdir $fileDir]
         } $pathName
     }
+    foreach {x res} [list 1 "-unset-" 2 "Text files"] {
+	set t [expr {$x + [llength [array names filters]]}]
+        test filebox-3.$t-$mode "tk_getOpenFile command" nonUnixUserInteraction {
+	    catch {unset tv}
+	    catch {unset typeName}
+	    ToPressButton $parent ok
+	    if {[info exists tv]} {
+	    } else {
+	    }
+	    set choice [tk_getOpenFile -title "Press Ok" \
+		    -filetypes $filters($x) -parent $parent \
+		    -initialfile $fileName -initialdir $fileDir \
+		    -typevariable tv]
+	    if {[info exists tv]} {
+		regexp {^(.*) \(.*\)$} $tv dummy typeName
+	    } else {
+		set typeName "-unset-"
+	    }
+	    set typeName
+        } $res
+    }
 
     test filebox-4.1-$mode "tk_getSaveFile command" -body {
 	tk_getSaveFile -foo
diff --git a/tests/winDialog.test b/tests/winDialog.test
index 38f125b..ded3cac 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 1998-1999 ActiveState Corporation.
 #
-# RCS: @(#) $Id: winDialog.test,v 1.13 2006/10/17 10:21:50 patthoyts Exp $
+# RCS: @(#) $Id: winDialog.test,v 1.14 2007/10/25 21:44:23 hobbs Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -89,7 +89,7 @@ test winDialog-5.1 {GetFileName: no arguments} {nt testwinevent} {
 } {0}
 test winDialog-5.2 {GetFileName: one argument} {nt} {
     list [catch {tk_getOpenFile -foo} msg] $msg
-} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}}
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}}
 test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} {
     start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
     then {
@@ -98,7 +98,7 @@ test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} {
 } {0}
 test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} {
     list [catch {tk_getOpenFile -foo bar -abc} msg] $msg
-} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}}
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}}
 test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} {
     start {tk_getOpenFile -title bar}
     then {
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 2e85cb6..b3203fd 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWinDialog.c,v 1.46 2007/09/08 16:13:45 dkf Exp $
+ * RCS: @(#) $Id: tkWinDialog.c,v 1.47 2007/10/25 21:44:23 hobbs Exp $
  *
  */
 
@@ -189,7 +189,8 @@ static int 		GetFileNameW(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[], int isOpen);
 static int 		MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr,
-			    Tcl_DString *dsPtr);
+			    Tcl_DString *dsPtr, Tcl_Obj *initialPtr,
+			    int *index);
 static UINT APIENTRY	OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
 			    LPARAM lParam);
 static UINT APIENTRY	OFNHookProcW(HWND hdlg, UINT uMsg, WPARAM wParam,
@@ -575,10 +576,11 @@ GetFileNameW(
 {
     OPENFILENAMEW ofn;
     WCHAR file[TK_MULTI_MAX_PATH];
-    int result, winCode, oldMode, i, multi = 0;
+    int filterIndex, result, winCode, oldMode, i, multi = 0;
     char *extension, *filter, *title;
     Tk_Window tkwin;
     HWND hWnd;
+    Tcl_Obj *filterObj, *initialTypeObj, *typeVariableObj;
     Tcl_DString utfFilterString, utfDirString;
     Tcl_DString extString, filterString, dirString, titleString;
     Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
@@ -586,17 +588,17 @@ GetFileNameW(
 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
     static CONST char *saveOptionStrings[] = {
 	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
-	"-parent", "-title", NULL
+	"-parent", "-title", "-typevariable", NULL
     };
     static CONST char *openOptionStrings[] = {
 	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
-	"-multiple", "-parent", "-title", NULL
+	"-multiple", "-parent", "-title", "-typevariable", NULL
     };
     CONST char **optionStrings;
 
     enum options {
 	FILE_DEFAULT,	FILE_TYPES,	FILE_INITDIR,	FILE_INITFILE,
-	FILE_MULTIPLE,	FILE_PARENT,	FILE_TITLE
+	FILE_MULTIPLE,	FILE_PARENT,	FILE_TITLE,     FILE_TYPEVARIABLE
     };
 
     result = TCL_ERROR;
@@ -612,6 +614,9 @@ GetFileNameW(
     Tcl_DStringInit(&utfDirString);
     tkwin = (Tk_Window) clientData;
     title = NULL;
+    filterObj = NULL;
+    typeVariableObj = NULL;
+    initialTypeObj = NULL;
 
     if (open) {
 	optionStrings = openOptionStrings;
@@ -663,11 +668,7 @@ GetFileNameW(
 	    extension = string;
 	    break;
 	case FILE_TYPES:
-	    Tcl_DStringFree(&utfFilterString);
-	    if (MakeFilter(interp, valuePtr, &utfFilterString) != TCL_OK) {
-		goto end;
-	    }
-	    filter = Tcl_DStringValue(&utfFilterString);
+	    filterObj = valuePtr;
 	    break;
 	case FILE_INITDIR:
 	    Tcl_DStringFree(&utfDirString);
@@ -702,14 +703,18 @@ GetFileNameW(
 	case FILE_TITLE:
 	    title = string;
 	    break;
+	case FILE_TYPEVARIABLE:
+	    typeVariableObj = valuePtr;
+	    initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL, 0);
+	    break;
 	}
     }
 
-    if (filter == NULL) {
-	if (MakeFilter(interp, NULL, &utfFilterString) != TCL_OK) {
-	    goto end;
-	}
+    if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj,
+		    &filterIndex) != TCL_OK) {
+	goto end;
     }
+    filter = Tcl_DStringValue(&utfFilterString);
 
     Tk_MakeWindowExist(tkwin);
     hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
@@ -748,6 +753,7 @@ GetFileNameW(
 	    Tcl_DStringValue(&utfFilterString),
 	    Tcl_DStringLength(&utfFilterString), &filterString);
     ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);
+    ofn.nFilterIndex = filterIndex;
 
     if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
 	Tcl_UtfToExternalDString(unicodeEncoding,
@@ -878,6 +884,23 @@ GetFileNameW(
 		    (char *) ofn.lpstrFile, &ds), NULL);
 	    Tcl_DStringFree(&ds);
 	}
+	if ((ofn.nFilterIndex > 0) &&
+		Tcl_GetCharLength(Tcl_GetObjResult(interp)) > 0 &&
+		typeVariableObj && filterObj) {
+	    int listObjc, count;
+	    Tcl_Obj **listObjv = NULL;
+	    Tcl_Obj **typeInfo = NULL;
+	    if (Tcl_ListObjGetElements(interp, filterObj,
+			    &listObjc, &listObjv) != TCL_OK) {
+		result = TCL_ERROR;
+	    } else if (Tcl_ListObjGetElements(interp,
+			    listObjv[ofn.nFilterIndex - 1],
+			    &count, &typeInfo) != TCL_OK) {
+		result = TCL_ERROR;
+	    } else {
+		Tcl_ObjSetVar2(interp, typeVariableObj, NULL, typeInfo[0], 0);
+	    }
+	}
 	result = TCL_OK;
     } else {
 	/*
@@ -997,27 +1020,28 @@ GetFileNameA(
 {
     OPENFILENAME ofn;
     TCHAR file[TK_MULTI_MAX_PATH], savePath[MAX_PATH];
-    int result, winCode, oldMode, i, multi = 0;
+    int filterIndex, result, winCode, oldMode, i, multi = 0;
     char *extension, *filter, *title;
     Tk_Window tkwin;
     HWND hWnd;
+    Tcl_Obj *filterObj, *initialTypeObj, *typeVariableObj;
     Tcl_DString utfFilterString, utfDirString;
     Tcl_DString extString, filterString, dirString, titleString;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
     static CONST char *saveOptionStrings[] = {
 	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
-	"-parent", "-title", NULL
+	"-parent", "-title", "-typevariable", NULL
     };
     static CONST char *openOptionStrings[] = {
 	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
-	"-multiple", "-parent", "-title", NULL
+	"-multiple", "-parent", "-title", "-typevariable", NULL
     };
     CONST char **optionStrings;
 
     enum options {
 	FILE_DEFAULT,	FILE_TYPES,	FILE_INITDIR,	FILE_INITFILE,
-	FILE_MULTIPLE,	FILE_PARENT,	FILE_TITLE
+	FILE_MULTIPLE,	FILE_PARENT,	FILE_TITLE, FILE_TYPEVARIABLE
     };
 
     result = TCL_ERROR;
@@ -1033,6 +1057,9 @@ GetFileNameA(
     Tcl_DStringInit(&utfDirString);
     tkwin = (Tk_Window) clientData;
     title = NULL;
+    filterObj = NULL;
+    typeVariableObj = NULL;
+    initialTypeObj = NULL;
 
     if (open) {
 	optionStrings = openOptionStrings;
@@ -1084,11 +1111,7 @@ GetFileNameA(
 	    extension = string;
 	    break;
 	case FILE_TYPES:
-	    Tcl_DStringFree(&utfFilterString);
-	    if (MakeFilter(interp, valuePtr, &utfFilterString) != TCL_OK) {
-		goto end;
-	    }
-	    filter = Tcl_DStringValue(&utfFilterString);
+	    filterObj = valuePtr;
 	    break;
 	case FILE_INITDIR:
 	    Tcl_DStringFree(&utfDirString);
@@ -1122,14 +1145,18 @@ GetFileNameA(
 	case FILE_TITLE:
 	    title = string;
 	    break;
+	case FILE_TYPEVARIABLE:
+	    typeVariableObj = valuePtr;
+	    initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL, 0);
+	    break;
 	}
     }
 
-    if (filter == NULL) {
-	if (MakeFilter(interp, NULL, &utfFilterString) != TCL_OK) {
-	    goto end;
-	}
+    if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj,
+		    &filterIndex) != TCL_OK) {
+	goto end;
     }
+    filter = Tcl_DStringValue(&utfFilterString);
 
     Tk_MakeWindowExist(tkwin);
     hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
@@ -1306,6 +1333,23 @@ GetFileNameA(
 		    (char *) ofn.lpstrFile, &ds), NULL);
 	    Tcl_DStringFree(&ds);
 	}
+	if ((ofn.nFilterIndex > 0) &&
+		(Tcl_GetCharLength(Tcl_GetObjResult(interp)) > 0) &&
+		typeVariableObj && filterObj) {
+	    int listObjc, count;
+	    Tcl_Obj **listObjv = NULL;
+	    Tcl_Obj **typeInfo = NULL;
+	    if (Tcl_ListObjGetElements(interp, filterObj,
+			    &listObjc, &listObjv) != TCL_OK) {
+		result = TCL_ERROR;
+	    } else if (Tcl_ListObjGetElements(interp,
+			    listObjv[ofn.nFilterIndex - 1],
+			    &count, &typeInfo) != TCL_OK) {
+		result = TCL_ERROR;
+	    } else {
+		Tcl_ObjSetVar2(interp, typeVariableObj, NULL, typeInfo[0], 0);
+	    }
+	}
 	result = TCL_OK;
     } else {
 	/*
@@ -1422,14 +1466,21 @@ static int
 MakeFilter(
     Tcl_Interp *interp,		/* Current interpreter. */
     Tcl_Obj *valuePtr,		/* Value of the -filetypes option */
-    Tcl_DString *dsPtr)		/* Filled with windows filter string. */
+    Tcl_DString *dsPtr,		/* Filled with windows filter string. */
+    Tcl_Obj *initialPtr,	/* Initial type name  */
+    int *index)			/* Index of initial type in filter string */
 {
     char *filterStr;
     char *p;
+    char *initial = NULL;
     int pass;
+    int ix = 0; /* index counter */
     FileFilterList flist;
     FileFilter *filterPtr;
 
+    if (initialPtr) {
+	initial = Tcl_GetStringFromObj(initialPtr, NULL);
+    }
     TkInitFileFilters(&flist);
     if (TkGetFileFilters(interp, &flist, valuePtr, 1) != TCL_OK) {
 	return TCL_ERROR;
@@ -1485,6 +1536,15 @@ MakeFilter(
 	    FileFilterClause *clausePtr;
 
 	    /*
+	     * Check initial index for match, set index.
+	     * Filter index is 1 based so increment first
+	     */
+	    ix++;
+	    if (index && initial && (strcmp(initial, filterPtr->name) == 0)) {
+		*index = ix;
+	    }
+
+	    /*
 	     * First, put in the name of the file type.
 	     */