From da76bd4e71a3e8d17bd2b649d285e19a41f834b3 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 22 Oct 2009 10:27:58 +0000 Subject: Deal with [Patch 2168768], so making the -typevariable option work consistently with global variables (the only way it *can* work...) --- ChangeLog | 11 +++++++++++ doc/getOpenFile.n | 4 ++-- library/tkfbox.tcl | 18 ++++++++++-------- library/xmfbox.tcl | 16 +++++++++------- macosx/tkMacOSXDialog.c | 12 ++++++++---- win/tkWinDialog.c | 36 +++++++++++++++++++++--------------- 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 + + * 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 * 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) {} 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. -- cgit v0.12