Deal with [Patch 2168768], so making the -typevariable option work consistently

with global variables (the only way it *can* work...)

6 files changed, 61 insertions, 36 deletions

diff --git a/ChangeLog b/ChangeLog
index c66c887..49a9318 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2009-10-22  Donal K. Fellows  <dkf@users.sf.net>
+
+	* library/xmfbox.tcl (MotifFDialog_FileTypes)
+	(MotifFDialog_ActivateSEnt): 
+	* library/tkfbox.tcl (Done, ::tk::dialog::file::): 
+	* macosx/tkMacOSXDialog.c (Tk_GetOpenFileObjCmd): 
+	* win/tkWinDialog.c (GetFileNameW, GetFileNameA): 
+	* doc/getOpenFile.n: [Patch 2168768]: Corrected handling of the
+	-typevariable option to be consistently global; it's the only way it
+	can work even close to the same on all platforms.
+
 2009-10-15  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tkConsole.c:	Relax the runtime version requirements on Tcl
diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n
index fd941cc..44fb508 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.23 2007/12/13 15:23:43 dgp Exp $
+'\" RCS: @(#) $Id: getOpenFile.n,v 1.23.2.1 2009/10/22 10:27:58 dkf Exp $
 '\" 
 .so man.macros
 .TH tk_getOpenFile n 4.2 Tk "Tk Built-In Commands"
@@ -83,7 +83,7 @@ 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
+The global 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
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index c8009da..91acef3 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.68.2.2 2009/10/08 12:42:17 dkf Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.68.2.3 2009/10/22 10:27:58 dkf Exp $
 #
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
 #
@@ -888,9 +888,11 @@ proc ::tk::dialog::file:: {type args} {
 	# 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)]]
+	if {$data(-typevariable) ne ""} {
+	    upvar #0 $data(-typevariable) typeVariable
+	    if {[info exists typeVariable]} {
+		set initialTypeName $typeVariable
+	    }
 	}
 	foreach type $data(-filetypes) {
 	    set title  [lindex $type 0]
@@ -1867,10 +1869,10 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
 	    }
 	}
 	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]
+		&& [info exists data(-filetypes)] && [llength $data(-filetypes)]
+		&& [info exists data(filterType)] && $data(filterType) ne ""} {
+	    upvar #0 $data(-typevariable) typeVariable
+	    set typeVariable [lindex $data(filterType) 0]
 	}
     }
     bind $data(okBtn) <Destroy> {}
diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl
index d79627a..048713e 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.31 2007/12/13 15:26:28 dgp Exp $
+# RCS: @(#) $Id: xmfbox.tcl,v 1.31.2.1 2009/10/22 10:27:58 dkf Exp $
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-2000 Scriptics Corporation
@@ -159,9 +159,11 @@ proc ::tk::MotifFDialog_FileTypes {w} {
     # 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)]]
+    if {$data(-typevariable) ne ""} {
+	upvar #0 $data(-typevariable) typeVariable
+	if {[info exist typeVariable]} {
+	    set initialTypeName $typeVariable
+	}
     }
     set ix 0
     set data(fileType) 0
@@ -863,9 +865,9 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} {
 
     # 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]
+	    && [info exists data(-filetypes)] && $data(-filetypes) ne ""} {
+	upvar #0 $data(-typevariable) typeVariable
+	set typeVariable [lindex $data(-filetypes) $data(fileType) 0]
     }
 
     if {$data(-multiple) != 0} {
diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c
index 35af0de..8a51dc2 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.36.2.5 2008/12/07 16:57:44 das Exp $
+ * RCS: @(#) $Id: tkMacOSXDialog.c,v 1.36.2.6 2009/10/22 10:27:58 dkf Exp $
  */
 
 #include "tkMacOSXPrivate.h"
@@ -364,7 +364,8 @@ Tk_GetOpenFileObjCmd(
 	initialPtr = &initialDesc;
     }
     if (typeVariablePtr) {
-	initialtype = Tcl_GetVar(interp, Tcl_GetString(typeVariablePtr), 0);
+	initialtype = Tcl_GetVar(interp, Tcl_GetString(typeVariablePtr),
+		TCL_GLOBAL_ONLY);
     }
     result = NavServicesGetFile(interp, &ofd, initialPtr, NULL, &selectDesc,
 	    title, message, initialtype, multiple, OPEN_FILE, parent);
@@ -376,8 +377,11 @@ Tk_GetOpenFileObjCmd(
 	while (filterPtr && i-- > 0) {
 	    filterPtr = filterPtr->next;
 	}
-	Tcl_SetVar(interp, Tcl_GetString(typeVariablePtr), filterPtr ?
-		filterPtr->name : "", 0);
+	if (Tcl_SetVar(interp, Tcl_GetString(typeVariablePtr),
+		filterPtr ? filterPtr->name : "",
+		TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+	    result = TCL_ERROR;
+	}
     }
 
   end:
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 5cd1a4d..93d81b6 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.50.2.3 2009/04/24 17:30:33 hobbs Exp $
+ * RCS: @(#) $Id: tkWinDialog.c,v 1.50.2.4 2009/10/22 10:27:58 dkf Exp $
  *
  */
 
@@ -702,7 +702,8 @@ GetFileNameW(
 	    break;
 	case FILE_TYPEVARIABLE:
 	    typeVariableObj = valuePtr;
-	    initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL, 0);
+	    initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL,
+		    TCL_GLOBAL_ONLY);
 	    break;
 	}
     }
@@ -881,24 +882,26 @@ GetFileNameW(
 		    (char *) ofn.lpstrFile, &ds), NULL);
 	    Tcl_DStringFree(&ds);
 	}
+	result = TCL_OK;
 	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) {
+		    &listObjc, &listObjv) != TCL_OK) {
 		result = TCL_ERROR;
 	    } else if (Tcl_ListObjGetElements(interp,
-			    listObjv[ofn.nFilterIndex - 1],
-			    &count, &typeInfo) != TCL_OK) {
+		    listObjv[ofn.nFilterIndex - 1],
+		    &count, &typeInfo) != TCL_OK) {
+		result = TCL_ERROR;
+	    } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL,
+		    typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
 		result = TCL_ERROR;
-	    } else {
-		Tcl_ObjSetVar2(interp, typeVariableObj, NULL, typeInfo[0], 0);
 	    }
 	}
-	result = TCL_OK;
     } else {
 	/*
 	 * Use the CommDlgExtendedError() function to retrieve the error code.
@@ -1144,7 +1147,8 @@ GetFileNameA(
 	    break;
 	case FILE_TYPEVARIABLE:
 	    typeVariableObj = valuePtr;
-	    initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL, 0);
+	    initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL,
+		    TCL_GLOBAL_ONLY);
 	    break;
 	}
     }
@@ -1330,24 +1334,26 @@ GetFileNameA(
 		    (char *) ofn.lpstrFile, &ds), NULL);
 	    Tcl_DStringFree(&ds);
 	}
+	result = TCL_OK;
 	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) {
+		    &listObjc, &listObjv) != TCL_OK) {
 		result = TCL_ERROR;
 	    } else if (Tcl_ListObjGetElements(interp,
-			    listObjv[ofn.nFilterIndex - 1],
-			    &count, &typeInfo) != TCL_OK) {
+		    listObjv[ofn.nFilterIndex - 1],
+		    &count, &typeInfo) != TCL_OK) {
+		result = TCL_ERROR;
+	    } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL,
+		    typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
 		result = TCL_ERROR;
-	    } else {
-		Tcl_ObjSetVar2(interp, typeVariableObj, NULL, typeInfo[0], 0);
 	    }
 	}
-	result = TCL_OK;
     } else {
 	/*
 	 * Use the CommDlgExtendedError() function to retrieve the error code.