* 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:

2 files changed, 53 insertions, 7 deletions

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 {