From 74c0382ad182c608bc1418a8da6bbc6a368cf801 Mon Sep 17 00:00:00 2001 From: hobbs Date: Thu, 25 Oct 2007 21:44:21 +0000 Subject: * 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: --- ChangeLog | 10 ++++ doc/getOpenFile.n | 12 ++++- library/tkfbox.tcl | 31 +++++++++++-- library/xmfbox.tcl | 29 ++++++++++-- macosx/tkMacOSXDialog.c | 97 +++++++++++++++++++++++++++++---------- tests/filebox.test | 27 +++++++++-- tests/winDialog.test | 6 +-- win/tkWinDialog.c | 118 ++++++++++++++++++++++++++++++++++++------------ 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 + + * 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 * 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) {} 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. */ -- cgit v0.12