diff options
author | dkf <dkf@noemail.net> | 2009-10-22 10:27:58 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2009-10-22 10:27:58 (GMT) |
commit | 890270442057d87e8e5ac3e687507d36e81c1ea0 (patch) | |
tree | fe5c722a73092bba1b18f4ddcc412eaf45298fd1 | |
parent | 3ab8cd4fc58f1ace0659a1e7f33db98e6bd96e19 (diff) | |
download | tk-890270442057d87e8e5ac3e687507d36e81c1ea0.zip tk-890270442057d87e8e5ac3e687507d36e81c1ea0.tar.gz tk-890270442057d87e8e5ac3e687507d36e81c1ea0.tar.bz2 |
Deal with [Patch 2168768], so making the -typevariable option work consistently
with global variables (the only way it *can* work...)
FossilOrigin-Name: 669609728a5d47ebcf0acda32820219f32616241
-rw-r--r-- | ChangeLog | 11 | ||||
-rw-r--r-- | doc/getOpenFile.n | 4 | ||||
-rw-r--r-- | library/tkfbox.tcl | 18 | ||||
-rw-r--r-- | library/xmfbox.tcl | 16 | ||||
-rw-r--r-- | macosx/tkMacOSXDialog.c | 12 | ||||
-rw-r--r-- | win/tkWinDialog.c | 36 |
6 files changed, 61 insertions, 36 deletions
@@ -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. |