summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog10
-rw-r--r--doc/getOpenFile.n12
-rw-r--r--library/tkfbox.tcl31
-rw-r--r--library/xmfbox.tcl29
-rw-r--r--macosx/tkMacOSXDialog.c97
-rw-r--r--tests/filebox.test27
-rw-r--r--tests/winDialog.test6
-rw-r--r--win/tkWinDialog.c118
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.
*/
generated by cgit v0.12 at 2024-07-07 22:53:06 (GMT)