diff options
| -rw-r--r-- | doc/chooseDirectory.n | 7 | ||||
| -rw-r--r-- | doc/getOpenFile.n | 7 | ||||
| -rw-r--r-- | tests/winDialog.test | 159 | ||||
| -rw-r--r-- | win/tkWinDialog.c | 1323 | ||||
| -rw-r--r-- | win/tkWinInit.c | 51 | ||||
| -rw-r--r-- | win/tkWinInt.h | 6 | ||||
| -rw-r--r-- | win/tkWinSend.c | 55 | ||||
| -rw-r--r-- | win/tkWinTest.c | 92 |
8 files changed, 1411 insertions, 289 deletions
diff --git a/doc/chooseDirectory.n b/doc/chooseDirectory.n index 295c75b..86c593d 100644 --- a/doc/chooseDirectory.n +++ b/doc/chooseDirectory.n @@ -19,8 +19,11 @@ possible as command line arguments: .TP \fB\-initialdir\fR \fIdirname\fR Specifies that the directories in \fIdirectory\fR should be displayed -when the dialog pops up. If this parameter is not specified, then -the directories in the current working directory are displayed. If the +when the dialog pops up. If this parameter is not specified, +the initial directory defaults to the current working directory +on non-Windows systems and on Windows systems prior to Vista. +On Vista and later systems, the initial directory defaults to the last +user-selected directory for the application. If the parameter specifies a relative path, the return value will convert the relative path to an absolute path. .TP diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n index 95884bb..f5e92ff 100644 --- a/doc/getOpenFile.n +++ b/doc/getOpenFile.n @@ -65,8 +65,11 @@ discussion on the contents of \fIfilePatternList\fR. \fB\-initialdir\fR \fIdirectory\fR . Specifies that the files in \fIdirectory\fR should be displayed -when the dialog pops up. If this parameter is not specified, then -the files in the current working directory are displayed. If the +when the dialog pops up. If this parameter is not specified, +the initial directory defaults to the current working directory +on non-Windows systems and on Windows systems prior to Vista. +On Vista and later systems, the initial directory defaults to the last +user-selected directory for the application. If the parameter specifies a relative path, the return value will convert the relative path to an absolute path. .TP diff --git a/tests/winDialog.test b/tests/winDialog.test index 8aa9ac3..fc1114a 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -22,9 +22,25 @@ testConstraint english [expr { && (([testwinlocale] & 0xff) == 9) }] +proc vista? {{prevista 0} {postvista 1}} { + lassign [split $::tcl_platform(osVersion) .] major + return [expr {$major >= 6 ? $postvista : $prevista}] +} + +# What directory to use in initialdir tests. Old code used to use +# c:/. However, on Vista/later that is a protected directory if you +# are not running privileged. Moreover, not everyone has a drive c: +# but not having a TEMP would break a lot Windows programs +proc initialdir {} { + # file join to return in Tcl canonical format (/ separator, not \) + return [file join $::env(TEMP)] +} + + proc start {arg} { set ::tk_dialog 0 set ::iter_after 0 + set ::dialogclass "#32770" after 1 $arg } @@ -34,19 +50,35 @@ proc then {cmd} { set ::dialogresult {} set ::testfont {} - afterbody + # Do not make the delay too short. The newer Vista dialogs take + # time to come up. Even if the testforwindow returns true, the + # controls are not ready to accept messages + after 500 afterbody vwait ::dialogresult return $::dialogresult } proc afterbody {} { - if {$::tk_dialog == 0} { - if {[incr ::iter_after] > 30} { - set ::dialogresult ">30 iterations waiting on tk_dialog" + # On Vista and later, using the new file dialogs we have to find + # the window using its title as tk_dialog will not be set at the C level + if {[vista?]} { + if {[catch {testfindwindow "" $::dialogclass} ::tk_dialog]} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } + after 150 {afterbody} + return + } + } else { + if {$::tk_dialog == 0} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } + after 150 {afterbody} return } - after 150 {afterbody} - return } uplevel #0 {set dialogresult [eval $command]} } @@ -205,7 +237,7 @@ test winDialog-5.2 {GetFileName: one argument} -constraints { test winDialog-5.3 {GetFileName: many arguments} -constraints { nt testwinevent } -body { - start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} + start {tk_getOpenFile -initialdir [initialdir] -parent . -title test -initialfile foo} then { Click cancel } @@ -238,7 +270,7 @@ test winDialog-5.7 {GetFileName: extension begins with .} -constraints { start {set x [tk_getSaveFile -defaultextension .foo -title Save]} set msg {} then { - if {[catch {SetText 0x47C bar} msg]} { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { Click cancel } else { Click ok @@ -254,7 +286,7 @@ test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { start {set x [tk_getSaveFile -defaultextension foo -title Save]} set msg {} then { - if {[catch {SetText 0x47C bar} msg]} { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { Click cancel } else { Click ok @@ -264,18 +296,23 @@ test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { } -cleanup { unset msg } -result [string totitle [file join [pwd] bar.foo]] -test winDialog-5.9 {GetFileName: file types} -constraints { - nt testwinevent -} -body { -# case FILE_TYPES: - - start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} - then { - set x [GetText 0x470] - Click cancel - } - return $x -} -result {foo files (*.foo)} +if {![vista?]} { + # XXX - currently disabled for vista style dialogs because the file + # types control has no control ID and we don't have a mechanism to + # locate it. + test winDialog-5.9 {GetFileName: file types} -constraints { + nt testwinevent + } -body { + # case FILE_TYPES: + + start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} + then { + set x [GetText 0x470] + Click cancel + } + return $x + } -result {foo files (*.foo)} +} test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints { nt } -body { @@ -288,7 +325,7 @@ test winDialog-5.11 {GetFileName: initial directory} -constraints { nt testwinevent } -body { # case FILE_INITDIR: - + unset -nocomplain x start {set x [tk_getSaveFile \ -initialdir [file normalize $::env(TEMP)] \ -initialfile "12x 455" -title Foo]} @@ -322,19 +359,23 @@ test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constr # if (Tcl_TranslateFileName(interp, string, &ds) == NULL) tk_getOpenFile -initialfile ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} -test winDialog-5.15 {GetFileName: initial file: long name} -constraints { - nt testwinevent -} -body { - start { - set dialogresult [catch { - tk_getSaveFile -initialfile [string repeat a 1024] -title Long - } x] - } - then { - Click ok - } - list $dialogresult [string match "invalid filename *" $x] -} -result {1 1} +if {![vista?]} { + # XXX - disabled for Vista because the new dialogs allow long file + # names to be specified but force the user to change it. + test winDialog-5.15 {GetFileName: initial file: long name} -constraints { + nt testwinevent + } -body { + start { + set dialogresult [catch { + tk_getSaveFile -initialfile [string repeat a 1024] -title Long + } x] + } + then { + Click ok + } + list $dialogresult [string match "invalid filename *" $x] + } -result {1 1} +} test winDialog-5.16 {GetFileName: parent} -constraints { nt } -body { @@ -358,18 +399,34 @@ test winDialog-5.17 {GetFileName: title} -constraints { Click cancel } } -result {0} -test winDialog-5.18 {GetFileName: no filter specified} -constraints { - nt testwinevent -} -body { -# if (ofn.lpstrFilter == NULL) - - start {tk_getOpenFile -title Filter} - then { - set x [GetText 0x470] - Click cancel - } - return $x -} -result {All Files (*.*)} +if {[vista?]} { + # In the newer file dialogs, the file type widget does not even exist + # if no file types specified + test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent + } -body { + # if (ofn.lpstrFilter == NULL) + start {tk_getOpenFile -title Filter} + then { + catch {set x [GetText 0x470]} y + Click cancel + } + return $y + } -result {Could not find control with id 1136} +} else { + test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent + } -body { + # if (ofn.lpstrFilter == NULL) + + start {tk_getOpenFile -title Filter} + then { + set x [GetText 0x470] + Click cancel + } + return $x + } -result {All Files (*.*)} +} test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints { nt } -setup { @@ -426,7 +483,7 @@ test winDialog-5.23 {GetFileName: convert \ to /} -constraints { set msg {} start {set x [tk_getSaveFile -title Back]} then { - if {[catch {SetText 0x47C [file nativename \ + if {[catch {SetText [vista? 0x47C 0x3e9] [file nativename \ [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} { Click cancel } else { @@ -492,7 +549,7 @@ test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints { nt testwinevent } -body { start { - tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test + tk_chooseDirectory -initialdir [initialdir] -mustexist 1 -parent . -title test } then { Click cancel @@ -521,12 +578,12 @@ test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints { } -body { # case DIR_INITIAL: - start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} + start {set x [tk_chooseDirectory -initialdir [initialdir] -title Foo]} then { Click ok } string tolower [set x] -} -result {c:/} +} -result [initialdir] test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index baebfc9..ee30806 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -21,11 +21,14 @@ #include <cderr.h> /* includes the common dialog error codes */ #include <shlobj.h> /* includes SHBrowseForFolder */ +#include <shobjidl.h> + #ifdef _MSC_VER # pragma comment (lib, "shell32.lib") #endif /* These needed for compilation with VC++ 5.2 */ +/* XXX - remove these since need at least VC 6 */ #ifndef BIF_EDITBOX #define BIF_EDITBOX 0x10 #endif @@ -34,6 +37,7 @@ #define BIF_VALIDATE 0x0020 #endif +/* This "new" dialog style is now actually the "old" dialog style post-Vista */ #ifndef BIF_NEWDIALOGSTYLE #define BIF_NEWDIALOGSTYLE 0x0040 #endif @@ -57,6 +61,10 @@ typedef struct ThreadSpecificData { HHOOK hMsgBoxHook; /* Hook proc for tk_messageBox and the */ HICON hSmallIcon; /* icons used by a parent to be used in */ HICON hBigIcon; /* the message box */ + int newFileDialogsState; +#define FDLG_STATE_INIT 0 /* Uninitialized */ +#define FDLG_STATE_USE_NEW 1 /* Use the new dialogs */ +#define FDLG_STATE_USE_OLD 2 /* Use the old dialogs */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -159,6 +167,369 @@ typedef struct OFNData { } OFNData; /* + * The following structure is used to gather options used by various + * file dialogs + */ +typedef struct OFNOpts { + Tk_Window tkwin; /* Owner window for dialog */ + Tcl_Obj *extObj; /* Default extension */ + Tcl_Obj *titleObj; /* Title for dialog */ + Tcl_Obj *filterObj; /* File type filter list */ + Tcl_Obj *typeVariableObj; /* Variable in which to store type selected */ + Tcl_Obj *initialTypeObj; /* Initial value of above, or NULL */ + Tcl_DString utfDirString; /* Initial dir */ + int multi; /* Multiple selection enabled */ + int confirmOverwrite; /* Confirm before overwriting */ + int mustExist; /* Used only for */ + int forceXPStyle; /* XXX - Force XP style even on newer systems */ + TCHAR file[TK_MULTI_MAX_PATH]; /* File name + XXX - fixed size because it was so + historically. Why not malloc'ed ? + XXX - also, TCHAR should really be WCHAR + because TkWinGetUnicodeEncoding is always + UCS2. + */ +} OFNOpts; + +/* Define the operation for which option parsing is to be done. */ +enum OFNOper { + OFN_FILE_SAVE, /* tk_getOpenFile */ + OFN_FILE_OPEN, /* tk_getSaveFile */ + OFN_DIR_CHOOSE /* tk_chooseDirectory */ +}; + + +/* + * The following definitions are required when using older versions of + * Visual C++ (like 6.0) and possibly MingW. Those headers do not contain + * required definitions for interfaces new to Vista that we need for + * the new file dialogs. Duplicating definitions is OK because they + * should forever remain unchanged. + * + * XXX - is there a better/easier way to use new data definitions with + * older compilers? Should we prefix definitions with Tcl_ instead + * of using the same names as in the SDK? + */ +#ifndef __IShellItemArray_INTERFACE_DEFINED__ +#define __IShellItemArray_INTERFACE_DEFINED__ + +typedef enum SIATTRIBFLAGS { + SIATTRIBFLAGS_AND = 0x1, + SIATTRIBFLAGS_OR = 0x2, + SIATTRIBFLAGS_APPCOMPAT = 0x3, + SIATTRIBFLAGS_MASK = 0x3, + SIATTRIBFLAGS_ALLITEMS = 0x4000 +} SIATTRIBFLAGS; +typedef struct IShellItemArray IShellItemArray; +typedef struct IShellItemArrayVtbl +{ + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IShellItemArray * this, REFIID riid,void **ppvObject); + ULONG ( STDMETHODCALLTYPE *AddRef )(IShellItemArray * this); + ULONG ( STDMETHODCALLTYPE *Release )(IShellItemArray * this); + HRESULT ( STDMETHODCALLTYPE *BindToHandler )(IShellItemArray * this, + IBindCtx *pbc, REFGUID bhid, REFIID riid, void **ppvOut); + /* flags is actually is enum GETPROPERTYSTOREFLAGS */ + HRESULT ( STDMETHODCALLTYPE *GetPropertyStore )( + IShellItemArray * this, int flags, REFIID riid, void **ppv); + /* keyType actually REFPROPERTYKEY */ + HRESULT ( STDMETHODCALLTYPE *GetPropertyDescriptionList )( + IShellItemArray * this, void* keyType, REFIID riid, void **ppv); + HRESULT ( STDMETHODCALLTYPE *GetAttributes )(IShellItemArray * this, + SIATTRIBFLAGS AttribFlags, SFGAOF sfgaoMask, SFGAOF *psfgaoAttribs); + HRESULT ( STDMETHODCALLTYPE *GetCount )( + IShellItemArray * this, DWORD *pdwNumItems); + HRESULT ( STDMETHODCALLTYPE *GetItemAt )( + IShellItemArray * this, DWORD dwIndex, IShellItem **ppsi); + /* ppenumShellItems actually (IEnumShellItems **) */ + HRESULT ( STDMETHODCALLTYPE *EnumItems )( + IShellItemArray * this, void **ppenumShellItems); + + END_INTERFACE +} IShellItemArrayVtbl; + +struct IShellItemArray { + CONST_VTBL struct IShellItemArrayVtbl *lpVtbl; +}; + +#endif /* __IShellItemArray_INTERFACE_DEFINED__ */ + +/* + * Older compilers do not define these CLSIDs so we do so here under + * a slightly different name so as to not clash with the definitions + * in new compilers + */ +static const CLSID ClsidFileOpenDialog = { + 0xDC1C5A9C, 0xE88A, 0X4DDE, {0xA5, 0xA1, 0x60, 0xF8, 0x2A, 0x20, 0xAE, 0xF7} +}; +static const CLSID ClsidFileSaveDialog = { + 0xC0B4E2F3, 0xBA21, 0x4773, {0x8D, 0xBA, 0x33, 0x5E, 0xC9, 0x46, 0xEB, 0x8B} +}; +static const IID IIDIFileOpenDialog = { + 0xD57C7288, 0xD4AD, 0x4768, {0xBE, 0x02, 0x9D, 0x96, 0x95, 0x32, 0xD9, 0x60} +}; +static const IID IIDIFileSaveDialog = { + 0x84BCCD23, 0x5FDE, 0x4CDB, {0xAE, 0xA4, 0xAF, 0x64, 0xB8, 0x3D, 0x78, 0xAB} +}; + +#ifdef __IFileDialog_INTERFACE_DEFINED__ +# define TCLCOMDLG_FILTERSPEC COMDLG_FILTERSPEC +#else + +/* Forward declarations for structs that are referenced but not used */ +typedef struct IPropertyStore IPropertyStore; +typedef struct IPropertyDescriptionList IPropertyDescriptionList; +typedef struct IFileOperationProgressSink IFileOperationProgressSink; +typedef enum FDAP { + FDAP_BOTTOM = 0, + FDAP_TOP = 1 +} FDAP; + +typedef struct { + LPCWSTR pszName; + LPCWSTR pszSpec; +} TCLCOMDLG_FILTERSPEC; + +enum _FILEOPENDIALOGOPTIONS { + FOS_OVERWRITEPROMPT = 0x2, + FOS_STRICTFILETYPES = 0x4, + FOS_NOCHANGEDIR = 0x8, + FOS_PICKFOLDERS = 0x20, + FOS_FORCEFILESYSTEM = 0x40, + FOS_ALLNONSTORAGEITEMS = 0x80, + FOS_NOVALIDATE = 0x100, + FOS_ALLOWMULTISELECT = 0x200, + FOS_PATHMUSTEXIST = 0x800, + FOS_FILEMUSTEXIST = 0x1000, + FOS_CREATEPROMPT = 0x2000, + FOS_SHAREAWARE = 0x4000, + FOS_NOREADONLYRETURN = 0x8000, + FOS_NOTESTFILECREATE = 0x10000, + FOS_HIDEMRUPLACES = 0x20000, + FOS_HIDEPINNEDPLACES = 0x40000, + FOS_NODEREFERENCELINKS = 0x100000, + FOS_DONTADDTORECENT = 0x2000000, + FOS_FORCESHOWHIDDEN = 0x10000000, + FOS_DEFAULTNOMINIMODE = 0x20000000, + FOS_FORCEPREVIEWPANEON = 0x40000000 +} ; +typedef DWORD FILEOPENDIALOGOPTIONS; + +typedef struct IFileDialog IFileDialog; +typedef struct IFileDialogVtbl +{ + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IFileDialog * this, REFIID riid, void **ppvObject); + ULONG ( STDMETHODCALLTYPE *AddRef )( IFileDialog * this); + ULONG ( STDMETHODCALLTYPE *Release )( IFileDialog * this); + HRESULT ( STDMETHODCALLTYPE *Show )( IFileDialog * this, HWND hwndOwner); + HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileDialog * this, + UINT cFileTypes, const TCLCOMDLG_FILTERSPEC *rgFilterSpec); + HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(IFileDialog * this, UINT); + HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(IFileDialog * this, UINT *); + /* XXX - Actually pfde is IFileDialogEvents* but we do not use + this call and do not want to define IFileDialogEvents as that + pulls in a whole bunch of other stuff. */ + HRESULT ( STDMETHODCALLTYPE *Advise )( + IFileDialog * this, void *pfde, DWORD *pdwCookie); + HRESULT ( STDMETHODCALLTYPE *Unadvise )(IFileDialog * this, DWORD dwCookie); + HRESULT ( STDMETHODCALLTYPE *SetOptions )( + IFileDialog * this, FILEOPENDIALOGOPTIONS fos); + HRESULT ( STDMETHODCALLTYPE *GetOptions )( + IFileDialog * this, FILEOPENDIALOGOPTIONS *pfos); + HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( + IFileDialog * this, IShellItem *psi); + HRESULT ( STDMETHODCALLTYPE *SetFolder )( + IFileDialog * this, IShellItem *psi); + HRESULT ( STDMETHODCALLTYPE *GetFolder )( + IFileDialog * this, IShellItem **ppsi); + HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( + IFileDialog * this, IShellItem **ppsi); + HRESULT ( STDMETHODCALLTYPE *SetFileName )( + IFileDialog * this, LPCWSTR pszName); + HRESULT ( STDMETHODCALLTYPE *GetFileName )( + IFileDialog * this, LPWSTR *pszName); + HRESULT ( STDMETHODCALLTYPE *SetTitle )( + IFileDialog * this, LPCWSTR pszTitle); + HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( + IFileDialog * this, LPCWSTR pszText); + HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( + IFileDialog * this, LPCWSTR pszLabel); + HRESULT ( STDMETHODCALLTYPE *GetResult )( + IFileDialog * this, IShellItem **ppsi); + HRESULT ( STDMETHODCALLTYPE *AddPlace )( + IFileDialog * this, IShellItem *psi, FDAP fdap); + HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( + IFileDialog * this, LPCWSTR pszDefaultExtension); + HRESULT ( STDMETHODCALLTYPE *Close )( IFileDialog * this, HRESULT hr); + HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( + IFileDialog * this, REFGUID guid); + HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileDialog * this); + /* pFilter actually IShellItemFilter. But deprecated in Win7 AND we do + not use it anyways. So define as void* */ + HRESULT ( STDMETHODCALLTYPE *SetFilter )( + IFileDialog * this, void *pFilter); + + END_INTERFACE +} IFileDialogVtbl; + +struct IFileDialog { + CONST_VTBL struct IFileDialogVtbl *lpVtbl; +}; + + +typedef struct IFileSaveDialog IFileSaveDialog; +typedef struct IFileSaveDialogVtbl { + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IFileSaveDialog * this, REFIID riid, void **ppvObject); + ULONG ( STDMETHODCALLTYPE *AddRef )( IFileSaveDialog * this); + ULONG ( STDMETHODCALLTYPE *Release )( IFileSaveDialog * this); + HRESULT ( STDMETHODCALLTYPE *Show )( + IFileSaveDialog * this, HWND hwndOwner); + HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileSaveDialog * this, + UINT cFileTypes, const TCLCOMDLG_FILTERSPEC *rgFilterSpec); + HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )( + IFileSaveDialog * this, UINT iFileType); + HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )( + IFileSaveDialog * this, UINT *piFileType); + /* Actually pfde is IFileSaveDialogEvents* */ + HRESULT ( STDMETHODCALLTYPE *Advise )( + IFileSaveDialog * this, void *pfde, DWORD *pdwCookie); + HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileSaveDialog * this, DWORD); + HRESULT ( STDMETHODCALLTYPE *SetOptions )( + IFileSaveDialog * this, FILEOPENDIALOGOPTIONS fos); + HRESULT ( STDMETHODCALLTYPE *GetOptions )( + IFileSaveDialog * this, FILEOPENDIALOGOPTIONS *pfos); + HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( + IFileSaveDialog * this, IShellItem *psi); + HRESULT ( STDMETHODCALLTYPE *SetFolder )( + IFileSaveDialog * this, IShellItem *psi); + HRESULT ( STDMETHODCALLTYPE *GetFolder )( + IFileSaveDialog * this, IShellItem **ppsi); + HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( + IFileSaveDialog * this, IShellItem **ppsi); + HRESULT ( STDMETHODCALLTYPE *SetFileName )( + IFileSaveDialog * this, LPCWSTR pszName); + HRESULT ( STDMETHODCALLTYPE *GetFileName )( + IFileSaveDialog * this, LPWSTR *pszName); + HRESULT ( STDMETHODCALLTYPE *SetTitle )( + IFileSaveDialog * this, LPCWSTR pszTitle); + HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( + IFileSaveDialog * this, LPCWSTR pszText); + HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( + IFileSaveDialog * this, LPCWSTR pszLabel); + HRESULT ( STDMETHODCALLTYPE *GetResult )( + IFileSaveDialog * this, IShellItem **ppsi); + HRESULT ( STDMETHODCALLTYPE *AddPlace )( + IFileSaveDialog * this, IShellItem *psi, FDAP fdap); + HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( + IFileSaveDialog * this, LPCWSTR pszDefaultExtension); + HRESULT ( STDMETHODCALLTYPE *Close )( IFileSaveDialog * this, HRESULT hr); + HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( + IFileSaveDialog * this, REFGUID guid); + HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileSaveDialog * this); + /* pFilter Actually IShellItemFilter* */ + HRESULT ( STDMETHODCALLTYPE *SetFilter )( + IFileSaveDialog * this, void *pFilter); + HRESULT ( STDMETHODCALLTYPE *SetSaveAsItem )( + IFileSaveDialog * this, IShellItem *psi); + HRESULT ( STDMETHODCALLTYPE *SetProperties )( + IFileSaveDialog * this, IPropertyStore *pStore); + HRESULT ( STDMETHODCALLTYPE *SetCollectedProperties )( + IFileSaveDialog * this, IPropertyDescriptionList *pList, + BOOL fAppendDefault); + HRESULT ( STDMETHODCALLTYPE *GetProperties )( + IFileSaveDialog * this, IPropertyStore **ppStore); + HRESULT ( STDMETHODCALLTYPE *ApplyProperties )( + IFileSaveDialog * this, IShellItem *psi, IPropertyStore *pStore, + HWND hwnd, IFileOperationProgressSink *pSink); + + END_INTERFACE + +} IFileSaveDialogVtbl; + +struct IFileSaveDialog { + CONST_VTBL struct IFileSaveDialogVtbl *lpVtbl; +}; + +typedef struct IFileOpenDialog IFileOpenDialog; +typedef struct IFileOpenDialogVtbl { + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IFileOpenDialog * this, REFIID riid, void **ppvObject); + ULONG ( STDMETHODCALLTYPE *AddRef )( IFileOpenDialog * this); + ULONG ( STDMETHODCALLTYPE *Release )( IFileOpenDialog * this); + HRESULT ( STDMETHODCALLTYPE *Show )( IFileOpenDialog * this, HWND); + HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileOpenDialog * this, + UINT cFileTypes, const TCLCOMDLG_FILTERSPEC *rgFilterSpec); + HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )( + IFileOpenDialog * this, UINT iFileType); + HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )( + IFileOpenDialog * this, UINT *piFileType); + /* Actually pfde is IFileDialogEvents* */ + HRESULT ( STDMETHODCALLTYPE *Advise )( + IFileOpenDialog * this, void *pfde, DWORD *pdwCookie); + HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileOpenDialog * this, DWORD); + HRESULT ( STDMETHODCALLTYPE *SetOptions )( + IFileOpenDialog * this, FILEOPENDIALOGOPTIONS fos); + HRESULT ( STDMETHODCALLTYPE *GetOptions )( + IFileOpenDialog * this, FILEOPENDIALOGOPTIONS *pfos); + HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( + IFileOpenDialog * this, IShellItem *psi); + HRESULT ( STDMETHODCALLTYPE *SetFolder )( + IFileOpenDialog * this, IShellItem *psi); + HRESULT ( STDMETHODCALLTYPE *GetFolder )( + IFileOpenDialog * this, IShellItem **ppsi); + HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( + IFileOpenDialog * this, IShellItem **ppsi); + HRESULT ( STDMETHODCALLTYPE *SetFileName )( + IFileOpenDialog * this, LPCWSTR pszName); + HRESULT ( STDMETHODCALLTYPE *GetFileName )( + IFileOpenDialog * this, LPWSTR *pszName); + HRESULT ( STDMETHODCALLTYPE *SetTitle )( + IFileOpenDialog * this, LPCWSTR pszTitle); + HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( + IFileOpenDialog * this, LPCWSTR pszText); + HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( + IFileOpenDialog * this, LPCWSTR pszLabel); + HRESULT ( STDMETHODCALLTYPE *GetResult )( + IFileOpenDialog * this, IShellItem **ppsi); + HRESULT ( STDMETHODCALLTYPE *AddPlace )( + IFileOpenDialog * this, IShellItem *psi, FDAP fdap); + HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( + IFileOpenDialog * this, LPCWSTR pszDefaultExtension); + HRESULT ( STDMETHODCALLTYPE *Close )( IFileOpenDialog * this, HRESULT hr); + HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( + IFileOpenDialog * this, REFGUID guid); + HRESULT ( STDMETHODCALLTYPE *ClearClientData )( + IFileOpenDialog * this); + HRESULT ( STDMETHODCALLTYPE *SetFilter )( + IFileOpenDialog * this, + /* pFilter is actually IShellItemFilter */ + void *pFilter); + HRESULT ( STDMETHODCALLTYPE *GetResults )( + IFileOpenDialog * this, IShellItemArray **ppenum); + HRESULT ( STDMETHODCALLTYPE *GetSelectedItems )( + IFileOpenDialog * this, IShellItemArray **ppsai); + + END_INTERFACE +} IFileOpenDialogVtbl; + +struct IFileOpenDialog +{ + CONST_VTBL struct IFileOpenDialogVtbl *lpVtbl; +}; + +#endif /* __IFileDialog_INTERFACE_DEFINED__ */ + +/* * Definitions of functions used only in this file. */ @@ -166,9 +537,21 @@ static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg, LPARAM wParam, LPARAM lParam); static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam, LPARAM lParam); +static void CleanupOFNOptions(OFNOpts *optsPtr); +static int ParseOFNOptions(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], enum OFNOper oper, OFNOpts *optsPtr); +static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr, + enum OFNOper oper); +static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr, + enum OFNOper oper); static int GetFileName(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[], int isOpen); + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], enum OFNOper oper); +static int MakeFilterVista(Tcl_Interp *interp, OFNOpts *optsPtr, + DWORD *countPtr, TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr, + DWORD *defaultFilterIndexPtr); +static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr); static int MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_DString *dsPtr, Tcl_Obj *initialPtr, int *indexPtr); @@ -178,6 +561,66 @@ static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam); static void SetTkDialog(ClientData clientData); static const char *ConvertExternalFilename(TCHAR *filename, Tcl_DString *dsPtr); +static void LoadShellProcs(void); + + +/* Definitions of dynamically loaded Win32 calls */ +typedef HRESULT (STDAPICALLTYPE SHCreateItemFromParsingNameProc)( + PCWSTR pszPath, IBindCtx *pbc, REFIID riid, void **ppv); +struct ShellProcPointers { + SHCreateItemFromParsingNameProc *SHCreateItemFromParsingName; +} ShellProcs; + + +/* + *------------------------------------------------------------------------- + * + * LoadShellProcs -- + * + * Some shell functions are not available on older versions of + * Windows. This function dynamically loads them and stores pointers + * to them in ShellProcs. Any function that is not available has + * the corresponding pointer set to NULL. + * + * Note this call never fails. Unavailability of a function is not + * a reason for failure. Caller should check whether a particular + * function pointer is NULL or not. Once loaded a function stays + * forever loaded. + * + * XXX - we load the function pointers into global memory. This implies + * there is a potential (however small) for race conditions between + * threads. However, Tk is in any case meant to be loaded in exactly + * one thread so this should not be an issue and saves us from + * unnecessary bookkeeping. + * + * Return value: + * None. + * + * Side effects: + * ShellProcs is populated. + *------------------------------------------------------------------------- + */ +static void LoadShellProcs() +{ + static HMODULE shell32_handle = NULL; + + if (shell32_handle != NULL) + return; /* We have already been through here. */ + + /* + * XXX - Note we never call FreeLibrary. There is no point because + * shell32.dll is loaded at startup anyways and stays for the duration + * of the process so why bother with keeping track of when to unload + */ + shell32_handle = LoadLibrary(TEXT("shell32.dll")); + if (shell32_handle == NULL) /* Should never happen but check anyways. */ + return; + + ShellProcs.SHCreateItemFromParsingName = + (SHCreateItemFromParsingNameProc*) GetProcAddress(shell32_handle, + "SHCreateItemFromParsingName"); +} + /* *------------------------------------------------------------------------- @@ -487,7 +930,7 @@ Tk_GetOpenFileObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return GetFileName(clientData, interp, objc, objv, 1); + return GetFileName(clientData, interp, objc, objv, OFN_FILE_OPEN); } /* @@ -514,51 +957,61 @@ Tk_GetSaveFileObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return GetFileName(clientData, interp, objc, objv, 0); + return GetFileName(clientData, interp, objc, objv, OFN_FILE_SAVE); } /* *---------------------------------------------------------------------- * - * GetFileName -- + * CleanupOFNOptions -- * - * Calls GetOpenFileName() or GetSaveFileName(). + * Cleans up any storage allocated by ParseOFNOptions * * Results: - * See user documentation. + * None. * * Side effects: - * See user documentation. + * Releases resources held by *optsPtr + *---------------------------------------------------------------------- + */ +static void CleanupOFNOptions(OFNOpts *optsPtr) +{ + Tcl_DStringFree(&optsPtr->utfDirString); +} + + + +/* + *---------------------------------------------------------------------- + * + * ParseOFNOptions -- * + * Option parsing for tk_get{Open,Save}File + * + * Results: + * TCL_OK on success, TCL_ERROR otherwise + * + * Side effects: + * Returns option values in *optsPtr. Note these may include string + * pointers into objv[] *---------------------------------------------------------------------- */ static int -GetFileName( +ParseOFNOptions( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ - int open) /* 1 to call GetOpenFileName(), 0 to call - * GetSaveFileName(). */ + enum OFNOper oper, /* 1 for Open, 0 for Save */ + OFNOpts *optsPtr) /* Output, uninitialized on entry */ { - OPENFILENAME ofn; - TCHAR file[TK_MULTI_MAX_PATH]; - OFNData ofnData; - int cdlgerr; - int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0; - int confirmOverwrite = 1; - const char *extension = NULL, *title = NULL; - Tk_Window tkwin = clientData; - HWND hWnd; - Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL; - Tcl_DString utfFilterString, utfDirString, ds; - Tcl_DString extString, filterString, dirString, titleString; - ThreadSpecificData *tsdPtr = - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int i; + Tcl_DString ds; enum options { FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_PARENT, - FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW + FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW, + FILE_MUSTEXIST, }; struct Options { const char *name; @@ -586,16 +1039,28 @@ GetFileName( {"-typevariable", FILE_TYPEVARIABLE}, {NULL, FILE_DEFAULT/*ignored*/ } }; - const struct Options *const options = open ? openOptions : saveOptions; - - file[0] = '\0'; - ZeroMemory(&ofnData, sizeof(OFNData)); - Tcl_DStringInit(&utfFilterString); - Tcl_DStringInit(&utfDirString); + static const struct Options dirOptions[] = { + {"-initialdir", FILE_INITDIR}, + {"-mustexist", FILE_MUSTEXIST}, + {"-parent", FILE_PARENT}, + {"-title", FILE_TITLE}, + {NULL, FILE_DEFAULT/*ignored*/ } + }; - /* - * Parse the arguments. - */ + const struct Options *options = NULL; + + switch (oper) { + case OFN_FILE_SAVE: options = saveOptions; break; + case OFN_DIR_CHOOSE: options = dirOptions; break; + case OFN_FILE_OPEN: options = openOptions; break; + } + + ZeroMemory(optsPtr, sizeof(*optsPtr)); + // optsPtr->forceXPStyle = 1; + optsPtr->tkwin = clientData; + optsPtr->confirmOverwrite = 1; /* By default we ask for confirmation */ + Tcl_DStringInit(&optsPtr->utfDirString); + optsPtr->file[0] = 0; for (i = 1; i < objc; i += 2) { int index; @@ -604,97 +1069,463 @@ GetFileName( if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, sizeof(struct Options), "option", 0, &index) != TCL_OK) { - goto end; + /* + * XXX -xpstyle is explicitly checked for as it is undocumented + * and we do not want it to show in option error messages. + */ + if (strcmp(Tcl_GetString(objv[i]), "-xpstyle")) + goto error_return; + if (Tcl_GetBooleanFromObj(interp, valuePtr, + &optsPtr->forceXPStyle) != TCL_OK) + goto error_return; + + continue; + } else if (i + 1 == objc) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "value for \"%s\" missing", options[index].name)); Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); - goto end; + goto error_return; } string = Tcl_GetString(valuePtr); switch (options[index].value) { case FILE_DEFAULT: - if (string[0] == '.') { - string++; - } - extension = string; + optsPtr->extObj = valuePtr; break; case FILE_TYPES: - filterObj = valuePtr; + optsPtr->filterObj = valuePtr; break; case FILE_INITDIR: - Tcl_DStringFree(&utfDirString); + Tcl_DStringFree(&optsPtr->utfDirString); if (Tcl_TranslateFileName(interp, string, - &utfDirString) == NULL) { - goto end; - } + &optsPtr->utfDirString) == NULL) + goto error_return; break; case FILE_INITFILE: - if (Tcl_TranslateFileName(interp, string, &ds) == NULL) { - goto end; - } + if (Tcl_TranslateFileName(interp, string, &ds) == NULL) + goto error_return; Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(), - Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL, - (char *) file, sizeof(file), NULL, NULL, NULL); + Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL, + (char *) &optsPtr->file[0], sizeof(optsPtr->file), + NULL, NULL, NULL); Tcl_DStringFree(&ds); break; case FILE_PARENT: - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { - goto end; - } + optsPtr->tkwin = Tk_NameToWindow(interp, string, clientData); + if (optsPtr->tkwin == NULL) + goto error_return; break; case FILE_TITLE: - title = string; + optsPtr->titleObj = valuePtr; break; case FILE_TYPEVARIABLE: - typeVariableObj = valuePtr; - initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL, - TCL_GLOBAL_ONLY); + optsPtr->typeVariableObj = valuePtr; + optsPtr->initialTypeObj = Tcl_ObjGetVar2(interp, valuePtr, + NULL, TCL_GLOBAL_ONLY); break; case FILE_MULTIPLE: - if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) { - return TCL_ERROR; - } + if (Tcl_GetBooleanFromObj(interp, valuePtr, + &optsPtr->multi) != TCL_OK) + goto error_return; break; case FILE_CONFIRMOW: if (Tcl_GetBooleanFromObj(interp, valuePtr, - &confirmOverwrite) != TCL_OK) { - return TCL_ERROR; - } + &optsPtr->confirmOverwrite) != TCL_OK) + goto error_return; break; + case FILE_MUSTEXIST: + if (Tcl_GetBooleanFromObj(interp, valuePtr, + &optsPtr->mustExist) != TCL_OK) + goto error_return; + break; } } - if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj, - &filterIndex) != TCL_OK) { + return TCL_OK; + +error_return: /* interp should already hold error */ + /* On error, we need to clean up anything we might have allocated */ + CleanupOFNOptions(optsPtr); + return TCL_ERROR; +} + + +/* + *---------------------------------------------------------------------- + * VistaFileDialogsAvailable + * + * Checks whether the new (Vista) file dialogs can be used on + * the system. + * + * Returns: + * 1 if new dialogs are available, 0 otherwise + * + * Side effects: + * Loads required procedures dynamically if available. + * If new dialogs are available, COM is also initialized. + *---------------------------------------------------------------------- + */ +static int VistaFileDialogsAvailable() +{ + HRESULT hr; + IFileDialog *fdlgPtr = NULL; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (tsdPtr->newFileDialogsState == FDLG_STATE_INIT) { + tsdPtr->newFileDialogsState = FDLG_STATE_USE_OLD; + LoadShellProcs(); + if (ShellProcs.SHCreateItemFromParsingName != NULL) { + hr = CoInitialize(0); + /* XXX - need we schedule CoUninitialize at thread shutdown ? */ + + /* Ensure all COM interfaces we use are available */ + if (SUCCEEDED(hr)) { + hr = CoCreateInstance(&ClsidFileOpenDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgPtr); + if (SUCCEEDED(hr)) { + fdlgPtr->lpVtbl->Release(fdlgPtr); + hr = CoCreateInstance(&ClsidFileSaveDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog, + (void **) &fdlgPtr); + if (SUCCEEDED(hr)) { + fdlgPtr->lpVtbl->Release(fdlgPtr); + + /* Looks like we have all we need */ + tsdPtr->newFileDialogsState = FDLG_STATE_USE_NEW; + } + } + } + } + } + + return (tsdPtr->newFileDialogsState == FDLG_STATE_USE_NEW); +} + +/* + *---------------------------------------------------------------------- + * + * GetFileNameVista -- + * + * Displays the new file dialogs on Vista and later. + * This function must generally not be called unless the + * tsdPtr->newFileDialogsState is FDLG_STATE_USE_NEW but if + * it is, it will just pass the call to the older GetFileNameXP + * + * Results: + * TCL_OK - dialog was successfully displayed, results returned in interp + * TCL_ERROR - error return + * + * Side effects: + * Dialogs is displayed + *---------------------------------------------------------------------- + */ +static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr, + enum OFNOper oper) +{ + HRESULT hr; + HWND hWnd; + DWORD flags, nfilters, defaultFilterIndex; + TCLCOMDLG_FILTERSPEC *filterPtr = NULL; + IFileDialog *fdlgIf = NULL; + IShellItem *dirIf = NULL; + LPWSTR wstr; + Tcl_Obj *resultObj = NULL; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int oldMode; + + if (tsdPtr->newFileDialogsState != FDLG_STATE_USE_NEW) { + /* XXX - should be an assert but Tcl does not seem to have one? */ + Tcl_SetResult(interp, "Internal error: GetFileNameVista: IFileDialog API not available", TCL_STATIC); + return TCL_ERROR; + } + + /* + * At this point new interfaces are supposed to be available. + * fdlgIf is actually a IFileOpenDialog or IFileSaveDialog + * both of which inherit from IFileDialog. We use the common + * IFileDialog interface for the most part, casting only for + * type-specific calls. + */ + Tk_MakeWindowExist(optsPtr->tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin)); + + /* + * The only validation we need to do w.r.t caller supplied data + * is the filter specification so do that before creating + */ + if (MakeFilterVista(interp, optsPtr, &nfilters, &filterPtr, + &defaultFilterIndex) != TCL_OK) + return TCL_ERROR; + + /* + * Beyond this point, do not just return on error as there will be + * resources that need to be released/freed. + */ + + if (oper == OFN_FILE_OPEN || oper == OFN_DIR_CHOOSE) + hr = CoCreateInstance(&ClsidFileOpenDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgIf); + else + hr = CoCreateInstance(&ClsidFileSaveDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog, (void **) &fdlgIf); + + if (FAILED(hr)) + goto vamoose; + + /* + * Get current settings first because we want to preserve existing + * settings like whether to show hidden files etc. based on the + * user's existing preference + */ + hr = fdlgIf->lpVtbl->GetOptions(fdlgIf, &flags); + if (FAILED(hr)) + goto vamoose; + + if (filterPtr) { + flags |= FOS_STRICTFILETYPES; + hr = fdlgIf->lpVtbl->SetFileTypes(fdlgIf, nfilters, filterPtr); + if (FAILED(hr)) + goto vamoose; + hr = fdlgIf->lpVtbl->SetFileTypeIndex(fdlgIf, defaultFilterIndex); + if (FAILED(hr)) + goto vamoose; + } + + /* Flags are equivalent to those we used in the older API */ + + /* + * Following flags must be set irrespective of original setting + * XXX - should FOS_NOVALIDATE be there ? Note FOS_NOVALIDATE has different + * semantics than OFN_NOVALIDATE in the old API. + */ + flags |= + FOS_FORCEFILESYSTEM | /* Only want files, not other shell items */ + FOS_NOVALIDATE | /* Don't check for access denied etc. */ + FOS_PATHMUSTEXIST; /* The *directory* path must exist */ + + + if (oper == OFN_DIR_CHOOSE) { + flags |= FOS_PICKFOLDERS; + if (optsPtr->mustExist) + flags |= FOS_FILEMUSTEXIST; /* XXX - check working */ + } else + flags &= ~ FOS_PICKFOLDERS; + + if (optsPtr->multi) + flags |= FOS_ALLOWMULTISELECT; + else + flags &= ~FOS_ALLOWMULTISELECT; + + if (optsPtr->confirmOverwrite) + flags |= FOS_OVERWRITEPROMPT; + else + flags &= ~FOS_OVERWRITEPROMPT; + + hr = fdlgIf->lpVtbl->SetOptions(fdlgIf, flags); + if (FAILED(hr)) + goto vamoose; + + if (optsPtr->extObj != NULL) { + wstr = Tcl_GetUnicode(optsPtr->extObj); + if (wstr[0] == L'.') + ++wstr; + hr = fdlgIf->lpVtbl->SetDefaultExtension(fdlgIf, wstr); + if (FAILED(hr)) + goto vamoose; + } + + if (optsPtr->titleObj != NULL) { + hr = fdlgIf->lpVtbl->SetTitle(fdlgIf, + Tcl_GetUnicode(optsPtr->titleObj)); + if (FAILED(hr)) + goto vamoose; + } + + if (optsPtr->file[0]) { + hr = fdlgIf->lpVtbl->SetFileName(fdlgIf, optsPtr->file); + if (FAILED(hr)) + goto vamoose; + } + + if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') { + Tcl_DString dirString; + Tcl_WinUtfToTChar(Tcl_DStringValue(&optsPtr->utfDirString), + Tcl_DStringLength(&optsPtr->utfDirString), &dirString); + hr = ShellProcs.SHCreateItemFromParsingName( + (TCHAR *) Tcl_DStringValue(&dirString), NULL, + &IID_IShellItem, (void **) &dirIf); + /* XXX - Note on failure we do not raise error, simply ignore ini dir */ + if (SUCCEEDED(hr)) { + /* Note we use SetFolder, not SetDefaultFolder - see MSDN docs */ + fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */ + } + Tcl_DStringFree(&dirString); + } + + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); + hr = fdlgIf->lpVtbl->Show(fdlgIf, hWnd); + Tcl_SetServiceMode(oldMode); + + if (SUCCEEDED(hr)) { + if ((oper == OFN_FILE_OPEN) && optsPtr->multi) { + IShellItemArray *multiIf; + DWORD dw, count; + IFileOpenDialog *fodIf = (IFileOpenDialog *) fdlgIf; + hr = fodIf->lpVtbl->GetResults(fodIf, &multiIf); + if (SUCCEEDED(hr)) { + Tcl_Obj *multiObj; + hr = multiIf->lpVtbl->GetCount(multiIf, &count); + multiObj = Tcl_NewListObj(count, NULL); + if (SUCCEEDED(hr)) { + IShellItem *itemIf; + for (dw = 0; dw < count; ++dw) { + hr = multiIf->lpVtbl->GetItemAt(multiIf, dw, &itemIf); + if (FAILED(hr)) + break; + hr = itemIf->lpVtbl->GetDisplayName(itemIf, + SIGDN_FILESYSPATH, &wstr); + if (SUCCEEDED(hr)) { + Tcl_DString fnds; + ConvertExternalFilename(wstr, &fnds); + CoTaskMemFree(wstr); + Tcl_ListObjAppendElement( + interp, multiObj, + Tcl_NewStringObj(Tcl_DStringValue(&fnds), + Tcl_DStringLength(&fnds))); + } + itemIf->lpVtbl->Release(itemIf); + if (FAILED(hr)) + break; + } + } + multiIf->lpVtbl->Release(multiIf); + if (SUCCEEDED(hr)) + resultObj = multiObj; + else + Tcl_DecrRefCount(multiObj); + } + } else { + IShellItem *resultIf; + hr = fdlgIf->lpVtbl->GetResult(fdlgIf, &resultIf); + if (SUCCEEDED(hr)) { + hr = resultIf->lpVtbl->GetDisplayName(resultIf, SIGDN_FILESYSPATH, + &wstr); + if (SUCCEEDED(hr)) { + Tcl_DString fnds; + ConvertExternalFilename(wstr, &fnds); + resultObj = Tcl_NewStringObj(Tcl_DStringValue(&fnds), + Tcl_DStringLength(&fnds)); + CoTaskMemFree(wstr); + } + resultIf->lpVtbl->Release(resultIf); + } + } + if (SUCCEEDED(hr)) { + if (filterPtr && optsPtr->typeVariableObj) { + UINT ftix; + hr = fdlgIf->lpVtbl->GetFileTypeIndex(fdlgIf, &ftix); + if (SUCCEEDED(hr)) { + /* Note ftix is a 1-based index */ + if (ftix > 0 && ftix <= nfilters) { + Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL, + Tcl_NewUnicodeObj(filterPtr[ftix-1].pszName, -1), + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + } + } + } + } + } else { + if (hr == HRESULT_FROM_WIN32(ERROR_CANCELLED)) + hr = 0; /* User cancelled, return empty string */ + } + +vamoose: /* (hr != 0) => error */ + if (dirIf) + dirIf->lpVtbl->Release(dirIf); + if (fdlgIf) + fdlgIf->lpVtbl->Release(fdlgIf); + + if (filterPtr) + FreeFilterVista(nfilters, filterPtr); + + if (hr == 0) { + if (resultObj) /* May be NULL if user cancelled */ + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; + } else { + if (resultObj) + Tcl_DecrRefCount(resultObj); + Tcl_SetObjResult(interp, TkWin32ErrorObj(hr)); + return TCL_ERROR; + } +} + + +/* + *---------------------------------------------------------------------- + * + * GetFileNameXP -- + * + * Displays the old pre-Vista file dialogs. + * + * Results: + * TCL_OK - if dialog was successfully displayed + * TCL_ERROR - error return + * + * Side effects: + * See user documentation. + *---------------------------------------------------------------------- + */ +static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr, enum OFNOper oper) +{ + OPENFILENAME ofn; + OFNData ofnData; + int cdlgerr; + int filterIndex = 0, result = TCL_ERROR, winCode, oldMode; + HWND hWnd; + Tcl_DString utfFilterString, ds; + Tcl_DString extString, filterString, dirString, titleString; + const char *str; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + ZeroMemory(&ofnData, sizeof(OFNData)); + Tcl_DStringInit(&utfFilterString); + Tcl_DStringInit(&dirString); /* XXX - original code was missing this + leaving dirString uninitialized for + the unlikely code path where cwd failed */ + + if (MakeFilter(interp, optsPtr->filterObj, &utfFilterString, + optsPtr->initialTypeObj, &filterIndex) != TCL_OK) { goto end; } - Tk_MakeWindowExist(tkwin); - hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); + Tk_MakeWindowExist(optsPtr->tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin)); ZeroMemory(&ofn, sizeof(OPENFILENAME)); ofn.lStructSize = sizeof(OPENFILENAME); ofn.hwndOwner = hWnd; ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner); - ofn.lpstrFile = file; + ofn.lpstrFile = optsPtr->file; ofn.nMaxFile = TK_MULTI_MAX_PATH; ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR - | OFN_EXPLORER | OFN_ENABLEHOOK| OFN_ENABLESIZING; + | OFN_EXPLORER| OFN_ENABLEHOOK| OFN_ENABLESIZING; ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc; ofn.lCustData = (LPARAM) &ofnData; - if (open != 0) { + if (oper != OFN_FILE_SAVE) { ofn.Flags |= OFN_FILEMUSTEXIST; - } else if (confirmOverwrite) { + } else if (optsPtr->confirmOverwrite) { ofn.Flags |= OFN_OVERWRITEPROMPT; } if (tsdPtr->debugFlag != 0) { ofnData.interp = interp; } - if (multi != 0) { + if (optsPtr->multi != 0) { ofn.Flags |= OFN_ALLOWMULTISELECT; /* @@ -706,8 +1537,11 @@ GetFileName( ofnData.dynFileBuffer = ckalloc(512 * sizeof(TCHAR)); } - if (extension != NULL) { - Tcl_WinUtfToTChar(extension, -1, &extString); + if (optsPtr->extObj != NULL) { + str = Tcl_GetString(optsPtr->extObj); + if (str[0] == '.') + ++str; + Tcl_WinUtfToTChar(str, -1, &extString); ofn.lpstrDefExt = (TCHAR *) Tcl_DStringValue(&extString); } @@ -716,9 +1550,9 @@ GetFileName( ofn.lpstrFilter = (TCHAR *) Tcl_DStringValue(&filterString); ofn.nFilterIndex = filterIndex; - if (Tcl_DStringValue(&utfDirString)[0] != '\0') { - Tcl_WinUtfToTChar(Tcl_DStringValue(&utfDirString), - Tcl_DStringLength(&utfDirString), &dirString); + if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') { + Tcl_WinUtfToTChar(Tcl_DStringValue(&optsPtr->utfDirString), + Tcl_DStringLength(&optsPtr->utfDirString), &dirString); } else { /* * NT 5.0 changed the meaning of lpstrInitialDir, so we have to ensure @@ -727,10 +1561,10 @@ GetFileName( Tcl_DString cwd; - Tcl_DStringFree(&utfDirString); - if ((Tcl_GetCwd(interp, &utfDirString) == NULL) || + Tcl_DStringFree(&optsPtr->utfDirString); + if ((Tcl_GetCwd(interp, &optsPtr->utfDirString) == NULL) || (Tcl_TranslateFileName(interp, - Tcl_DStringValue(&utfDirString), &cwd) == NULL)) { + Tcl_DStringValue(&optsPtr->utfDirString), &cwd) == NULL)) { Tcl_ResetResult(interp); } else { Tcl_WinUtfToTChar(Tcl_DStringValue(&cwd), @@ -740,8 +1574,8 @@ GetFileName( } ofn.lpstrInitialDir = (TCHAR *) Tcl_DStringValue(&dirString); - if (title != NULL) { - Tcl_WinUtfToTChar(title, -1, &titleString); + if (optsPtr->titleObj != NULL) { + Tcl_WinUtfToTChar(Tcl_GetString(optsPtr->titleObj), -1, &titleString); ofn.lpstrTitle = (TCHAR *) Tcl_DStringValue(&titleString); } @@ -750,7 +1584,7 @@ GetFileName( */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - if (open != 0) { + if (oper != OFN_FILE_SAVE) { winCode = GetOpenFileName(&ofn); } else { winCode = GetSaveFileName(&ofn); @@ -859,21 +1693,21 @@ GetFileName( Tcl_DStringFree(&ds); } result = TCL_OK; - if ((ofn.nFilterIndex > 0) && gotFilename && typeVariableObj - && filterObj) { + if ((ofn.nFilterIndex > 0) && gotFilename && optsPtr->typeVariableObj + && optsPtr->filterObj) { int listObjc, count; Tcl_Obj **listObjv = NULL; Tcl_Obj **typeInfo = NULL; - if (Tcl_ListObjGetElements(interp, filterObj, + if (Tcl_ListObjGetElements(interp, optsPtr->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 if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL, - typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + } else if (Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL, + typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } @@ -892,6 +1726,8 @@ GetFileName( Tcl_DStringFree(&titleString); } if (ofn.lpstrInitialDir != NULL) { + /* XXX - huh? lpstrInitialDir is set from Tcl_DStringValue which + can never return NULL */ Tcl_DStringFree(&dirString); } Tcl_DStringFree(&filterString); @@ -899,8 +1735,7 @@ GetFileName( Tcl_DStringFree(&extString); } - end: - Tcl_DStringFree(&utfDirString); +end: Tcl_DStringFree(&utfFilterString); if (ofnData.dynFileBuffer != NULL) { ckfree(ofnData.dynFileBuffer); @@ -909,6 +1744,49 @@ GetFileName( return result; } + + +/* + *---------------------------------------------------------------------- + * + * GetFileName -- + * + * Calls GetOpenFileName() or GetSaveFileName(). + * + * Results: + * See user documentation. + * + * Side effects: + * See user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +GetFileName( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[], /* Argument objects. */ + enum OFNOper oper) /* 1 to call GetOpenFileName(), 0 to call + * GetSaveFileName(). */ +{ + OFNOpts ofnOpts; + int result; + + result = ParseOFNOptions(clientData, interp, objc, objv, oper, &ofnOpts); + if (result != TCL_OK) + return result; + + if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle) + result = GetFileNameVista(interp, &ofnOpts, oper); + else + result = GetFileNameXP(interp, &ofnOpts, oper); + + CleanupOFNOptions(&ofnOpts); + return result; +} + /* *------------------------------------------------------------------------- @@ -973,8 +1851,8 @@ OFNHookProc( buffer = ofnData->dynFileBuffer; hdlg = GetParent(hdlg); - selsize = SendMessage(hdlg, CDM_GETSPEC, 0, 0); - dirsize = SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0); + selsize = (int) SendMessage(hdlg, CDM_GETSPEC, 0, 0); + dirsize = (int) SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0); buffersize = (selsize + dirsize + 1); /* @@ -1232,6 +2110,145 @@ MakeFilter( /* *---------------------------------------------------------------------- * + * FreeFilterVista + * + * Frees storage previously allocated by MakeFilterVista. + * count is the number of elements in dlgFilterPtr[] + */ +static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr) +{ + if (dlgFilterPtr != NULL) { + DWORD dw; + for (dw = 0; dw < count; ++dw) { + if (dlgFilterPtr[dw].pszName != NULL) + ckfree(dlgFilterPtr[dw].pszName); + if (dlgFilterPtr[dw].pszSpec != NULL) + ckfree(dlgFilterPtr[dw].pszSpec); + } + ckfree(dlgFilterPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * MakeFilterVista -- + * + * Returns file type filters in a format required + * by the Vista file dialogs. + * + * Results: + * A standard TCL return value. + * + * Side effects: + * Various values are returned through the parameters as + * described in the comments below. + *---------------------------------------------------------------------- + */ +static int MakeFilterVista( + Tcl_Interp *interp, /* Current interpreter. */ + OFNOpts *optsPtr, /* Caller specified options */ + DWORD *countPtr, /* Will hold number of filters */ + TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr, /* Will hold pointer to filter array. + Set to NULL if no filters specified. + Must be freed by calling + FreeFilterVista */ + DWORD *initialIndexPtr) /* Will hold index of default type */ +{ + TCLCOMDLG_FILTERSPEC *dlgFilterPtr; + const char *initial = NULL; + FileFilterList flist; + FileFilter *filterPtr; + DWORD initialIndex = 0; + Tcl_DString ds, patterns; + int i; + + if (optsPtr->filterObj == NULL) { + *dlgFilterPtrPtr = NULL; + *countPtr = 0; + return TCL_OK; + } + + if (optsPtr->initialTypeObj) + initial = Tcl_GetString(optsPtr->initialTypeObj); + + TkInitFileFilters(&flist); + if (TkGetFileFilters(interp, &flist, optsPtr->filterObj, 1) != TCL_OK) + return TCL_ERROR; + + if (flist.filters == NULL) { + *dlgFilterPtrPtr = NULL; + *countPtr = 0; + return TCL_OK; + } + + Tcl_DStringInit(&ds); + Tcl_DStringInit(&patterns); + dlgFilterPtr = ckalloc(flist.numFilters * sizeof(*dlgFilterPtr)); + + for (i = 0, filterPtr = flist.filters; + filterPtr; + filterPtr = filterPtr->next, ++i) { + const char *sep; + FileFilterClause *clausePtr; + int nbytes; + + /* Check if this entry should be shown as the default */ + if (initial && strcmp(initial, filterPtr->name) == 0) + initialIndex = i+1; /* Windows filter indices are 1-based */ + + /* First stash away the text description of the pattern */ + Tcl_WinUtfToTChar(filterPtr->name, -1, &ds); + nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */ + nbytes += sizeof(WCHAR); /* Terminating \0 */ + dlgFilterPtr[i].pszName = ckalloc(nbytes); + memmove((void *) dlgFilterPtr[i].pszName, Tcl_DStringValue(&ds), nbytes); + Tcl_DStringFree(&ds); + + /* + * Loop through and join patterns with a ";" Each "clause" + * corresponds to a single textual description (called typename) + * in the tk_getOpenFile docs. Each such typename may occur + * multiple times and all these form a single filter entry + * with one clause per occurence. Further each clause may specify + * multiple patterns. Hence the nested loop here. + */ + sep = ""; + for (clausePtr=filterPtr->clauses ; clausePtr; + clausePtr=clausePtr->next) { + GlobPattern *globPtr; + for (globPtr = clausePtr->patterns; globPtr; + globPtr = globPtr->next) { + Tcl_DStringAppend(&patterns, sep, -1); + Tcl_DStringAppend(&patterns, globPtr->pattern, -1); + sep = ";"; + } + } + + /* Again we need a Unicode form of the string */ + Tcl_WinUtfToTChar(Tcl_DStringValue(&patterns), -1, &ds); + nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */ + nbytes += sizeof(WCHAR); /* Terminating \0 */ + dlgFilterPtr[i].pszSpec = ckalloc(nbytes); + memmove((void *)dlgFilterPtr[i].pszSpec, Tcl_DStringValue(&ds), nbytes); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&patterns); + } + + if (initialIndex == 0) + initialIndex = 1; /* If no default, show first entry */ + *initialIndexPtr = initialIndex; + *dlgFilterPtrPtr = dlgFilterPtr; + *countPtr = flist.numFilters; + + TkFreeFileFilters(&flist); + return TCL_OK; +} + + +/* + *---------------------------------------------------------------------- + * * Tk_ChooseDirectoryObjCmd -- * * This function implements the "tk_chooseDirectory" dialog box for the @@ -1307,102 +2324,60 @@ Tk_ChooseDirectoryObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { TCHAR path[MAX_PATH]; - int oldMode, result = TCL_ERROR, i; + int oldMode, result; LPCITEMIDLIST pidl; /* Returned by browser */ BROWSEINFO bInfo; /* Used by browser */ ChooseDir cdCBData; /* Structure to pass back and forth */ LPMALLOC pMalloc; /* Used by shell */ - Tk_Window tkwin = clientData; HWND hWnd; - const char *utfTitle = NULL;/* Title for window */ TCHAR saveDir[MAX_PATH]; Tcl_DString titleString; /* Title */ - Tcl_DString initDirString; /* Initial directory */ Tcl_DString tempString; /* temporary */ Tcl_Obj *objPtr; - static const char *const optionStrings[] = { - "-initialdir", "-mustexist", "-parent", "-title", NULL - }; - enum options { - DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE - }; + OFNOpts ofnOpts; + const char *utfDir; + + result = ParseOFNOptions(clientData, interp, objc, objv, + OFN_DIR_CHOOSE, &ofnOpts); + if (result != TCL_OK) + return result; + + /* Use new dialogs if available */ + if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle) { + result = GetFileNameVista(interp, &ofnOpts, OFN_DIR_CHOOSE); + CleanupOFNOptions(&ofnOpts); + return result; + } - /* - * Initialize - */ + /* Older dialogs */ path[0] = '\0'; ZeroMemory(&cdCBData, sizeof(ChooseDir)); cdCBData.interp = interp; + cdCBData.mustExist = ofnOpts.mustExist; - /* - * Process the command line options - */ - - for (i = 1; i < objc; i += 2) { - int index; - const char *string; + utfDir = Tcl_DStringValue(&ofnOpts.utfDirString); + if (utfDir[0] != '\0') { const TCHAR *uniStr; - Tcl_Obj *optionPtr, *valuePtr; - - optionPtr = objv[i]; - valuePtr = objv[i + 1]; - if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings, - sizeof(char *), "option", 0, &index) != TCL_OK) { - goto cleanup; - } - if (i + 1 == objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", Tcl_GetString(optionPtr))); - Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL); - goto cleanup; - } + Tcl_WinUtfToTChar(Tcl_DStringValue(&ofnOpts.utfDirString), -1, + &tempString); + uniStr = (TCHAR *) Tcl_DStringValue(&tempString); - string = Tcl_GetString(valuePtr); - switch ((enum options) index) { - case DIR_INITIAL: - if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) { - goto cleanup; - } - Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1, - &tempString); - uniStr = (TCHAR *) Tcl_DStringValue(&tempString); + /* Convert possible relative path to full path to keep dialog happy. */ - /* - * Convert possible relative path to full path to keep dialog - * happy. - */ - - GetFullPathName(uniStr, MAX_PATH, saveDir, NULL); - _tcsncpy(cdCBData.initDir, saveDir, MAX_PATH); - Tcl_DStringFree(&initDirString); - Tcl_DStringFree(&tempString); - break; - case DIR_EXIST: - if (Tcl_GetBooleanFromObj(interp, valuePtr, - &cdCBData.mustExist) != TCL_OK) { - goto cleanup; - } - break; - case DIR_PARENT: - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { - goto cleanup; - } - break; - case FILE_TITLE: - utfTitle = string; - break; - } + GetFullPathName(uniStr, MAX_PATH, saveDir, NULL); + _tcsncpy(cdCBData.initDir, saveDir, MAX_PATH); } + /* XXX - rest of this (original) code has no error checks at all. */ + /* * Get ready to call the browser */ - Tk_MakeWindowExist(tkwin); - hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); + Tk_MakeWindowExist(ofnOpts.tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(ofnOpts.tkwin)); /* * Setup the parameters used by SHBrowseForFolder @@ -1416,8 +2391,8 @@ Tk_ChooseDirectoryObjCmd( } bInfo.lParam = (LPARAM) &cdCBData; - if (utfTitle != NULL) { - Tcl_WinUtfToTChar(utfTitle, -1, &titleString); + if (ofnOpts.titleObj != NULL) { + Tcl_WinUtfToTChar(Tcl_GetString(ofnOpts.titleObj), -1, &titleString); bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString); } else { bInfo.lpszTitle = TEXT("Please choose a directory, then select OK."); @@ -1455,6 +2430,10 @@ Tk_ChooseDirectoryObjCmd( oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); GetCurrentDirectory(MAX_PATH, saveDir); if (SHGetMalloc(&pMalloc) == NOERROR) { + /* + * XXX - MSDN says CoInitialize must have been called before + * SHBrowseForFolder can be used but don't see that called anywhere. + */ pidl = SHBrowseForFolder(&bInfo); /* @@ -1506,14 +2485,8 @@ Tk_ChooseDirectoryObjCmd( Tcl_DStringFree(&ds); } - result = TCL_OK; - - if (utfTitle != NULL) { - Tcl_DStringFree(&titleString); - } - - cleanup: - return result; + CleanupOFNOptions(&ofnOpts); + return TCL_OK; } /* diff --git a/win/tkWinInit.c b/win/tkWinInit.c index 4a327a2..b1b2d6b 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -159,6 +159,57 @@ TkpDisplayWarning( } /* + * ---------------------------------------------------------------------- + * + * Win32ErrorObj -- + * + * Returns a string object containing text from a COM or Win32 error code + * + * Results: + * A Tcl_Obj containing the Win32 error message. + * + * Side effects: + * Removed the error message from the COM threads error object. + * + * ---------------------------------------------------------------------- + */ + +Tcl_Obj* +TkWin32ErrorObj( + HRESULT hrError) +{ + LPTSTR lpBuffer = NULL, p = NULL; + TCHAR sBuffer[30]; + Tcl_Obj* errPtr = NULL; + + FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError, + LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL); + + if (lpBuffer == NULL) { + lpBuffer = sBuffer; + wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError); + } + + if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) { + *p = TEXT('\0'); + } + +#ifdef _UNICODE + errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); +#else + errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); +#endif /* _UNICODE */ + + if (lpBuffer != sBuffer) { + LocalFree((HLOCAL)lpBuffer); + } + + return errPtr; +} + + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tkWinInt.h b/win/tkWinInt.h index 6a3978f..0e2c844 100644 --- a/win/tkWinInt.h +++ b/win/tkWinInt.h @@ -201,6 +201,12 @@ MODULE_SCOPE void TkpWinToplevelDetachWindow(TkWindow *winPtr); MODULE_SCOPE int TkpWmGetState(TkWindow *winPtr); /* + * Common routines used in Windows implementation + */ +MODULE_SCOPE Tcl_Obj * TkWin32ErrorObj(HRESULT hrError); + + +/* * The following functions are not present in old versions of Windows * API headers but are used in the Tk source to ensure 64bit * compatibility. diff --git a/win/tkWinSend.c b/win/tkWinSend.c index 7fde655..6c4731a 100644 --- a/win/tkWinSend.c +++ b/win/tkWinSend.c @@ -77,7 +77,6 @@ static int FindInterpreterObject(Tcl_Interp *interp, static int Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, int async, ClientData clientData, int objc, Tcl_Obj *const objv[]); -static Tcl_Obj * Win32ErrorObj(HRESULT hrError); static void SendTrace(const char *format, ...); static Tcl_EventProc SendEventProc; @@ -281,7 +280,7 @@ TkGetInterpNames( if (objList != NULL) { Tcl_DecrRefCount(objList); } - Tcl_SetObjResult(interp, Win32ErrorObj(hr)); + Tcl_SetObjResult(interp, TkWin32ErrorObj(hr)); result = TCL_ERROR; } @@ -451,7 +450,7 @@ FindInterpreterObject( pROT->lpVtbl->Release(pROT); } if (FAILED(hr) && result == TCL_OK) { - Tcl_SetObjResult(interp, Win32ErrorObj(hr)); + Tcl_SetObjResult(interp, TkWin32ErrorObj(hr)); result = TCL_ERROR; } return result; @@ -809,56 +808,6 @@ Send( /* * ---------------------------------------------------------------------- * - * Win32ErrorObj -- - * - * Returns a string object containing text from a COM or Win32 error code - * - * Results: - * A Tcl_Obj containing the Win32 error message. - * - * Side effects: - * Removed the error message from the COM threads error object. - * - * ---------------------------------------------------------------------- - */ - -static Tcl_Obj* -Win32ErrorObj( - HRESULT hrError) -{ - LPTSTR lpBuffer = NULL, p = NULL; - TCHAR sBuffer[30]; - Tcl_Obj* errPtr = NULL; - - FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM - | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError, - LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL); - - if (lpBuffer == NULL) { - lpBuffer = sBuffer; - wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError); - } - - if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) { - *p = TEXT('\0'); - } - -#ifdef _UNICODE - errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); -#else - errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); -#endif /* _UNICODE */ - - if (lpBuffer != sBuffer) { - LocalFree((HLOCAL)lpBuffer); - } - - return errPtr; -} - -/* - * ---------------------------------------------------------------------- - * * TkWinSend_SetExcepInfo -- * * Convert the error information from a Tcl interpreter into a COM diff --git a/win/tkWinTest.c b/win/tkWinTest.c index 9fa956c..8a92f5a 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -79,6 +79,42 @@ TkplatformtestInit( return TCL_OK; } +struct TestFindControlState { + int id; + HWND control; +}; + +/* Callback for window enumeration - used for TestFindControl */ +BOOL CALLBACK TestFindControlCallback( + HWND hwnd, + LPARAM lParam +) +{ + struct TestFindControlState *fcsPtr = (struct TestFindControlState *)lParam; + fcsPtr->control = GetDlgItem(hwnd, fcsPtr->id); + /* If we have found the control, return FALSE to stop the enumeration */ + return fcsPtr->control == NULL ? TRUE : FALSE; +} + +/* + * Finds the descendent control window with the specified ID and returns + * its HWND. + */ +HWND TestFindControl(HWND root, int id) +{ + struct TestFindControlState fcs; + + fcs.control = GetDlgItem(root, id); + if (fcs.control == NULL) { + /* Control is not a direct child. Look in descendents */ + fcs.id = id; + fcs.control = NULL; + EnumChildWindows(root, TestFindControlCallback, (LPARAM) &fcs); + } + return fcs.control; +} + + /* *---------------------------------------------------------------------- * @@ -244,11 +280,13 @@ TestwineventObjCmd( { HWND hwnd = 0; HWND child = 0; + HWND control; int id; char *rest; UINT message; WPARAM wParam; LPARAM lParam; + LRESULT result; static const TkStateMap messageMap[] = { {WM_LBUTTONDOWN, "WM_LBUTTONDOWN"}, {WM_LBUTTONUP, "WM_LBUTTONUP"}, @@ -302,6 +340,7 @@ TestwineventObjCmd( return TCL_ERROR; } } + message = TkFindStateNum(NULL, NULL, messageMap, Tcl_GetString(objv[3])); wParam = 0; lParam = 0; @@ -318,7 +357,19 @@ TestwineventObjCmd( Tcl_DString ds; char buf[256]; +#if 0 GetDlgItemTextA(hwnd, id, buf, 256); +#else + control = TestFindControl(hwnd, id); + if (control == NULL) { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Could not find control with id %d", id)); + return TCL_ERROR; + } + buf[0] = 0; + SendMessageA(control, WM_GETTEXT, (WPARAM)sizeof(buf), + (LPARAM) buf); +#endif Tcl_ExternalToUtfDString(NULL, buf, -1, &ds); Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); Tcl_DStringFree(&ds); @@ -326,15 +377,21 @@ TestwineventObjCmd( } case WM_SETTEXT: { Tcl_DString ds; - BOOL result; + control = TestFindControl(hwnd, id); + if (control == NULL) { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Could not find control with id %d", id)); + return TCL_ERROR; + } Tcl_UtfToExternalDString(NULL, Tcl_GetString(objv[4]), -1, &ds); - result = SetDlgItemTextA(hwnd, id, Tcl_DStringValue(&ds)); + result = SendMessageA(control, WM_SETTEXT, 0, + (LPARAM) Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1)); - AppendSystemError(interp, GetLastError()); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1)); + AppendSystemError(interp, GetLastError()); + return TCL_ERROR; } break; } @@ -382,6 +439,7 @@ TestfindwindowObjCmd( Tcl_DString titleString, classString; HWND hwnd = NULL; int r = TCL_OK; + DWORD myPid; Tcl_DStringInit(&classString); Tcl_DStringInit(&titleString); @@ -395,8 +453,30 @@ TestfindwindowObjCmd( if (objc == 3) { class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString); } - + if (title[0] == 0) + title = NULL; +#if 0 hwnd = FindWindow(class, title); +#else + /* We want find a window the belongs to us and not some other process */ + hwnd = NULL; + myPid = GetCurrentProcessId(); + while (1) { + DWORD pid, tid; + hwnd = FindWindowEx(NULL, hwnd, class, title); + if (hwnd == NULL) + break; + tid = GetWindowThreadProcessId(hwnd, &pid); + if (tid == 0) { + /* Window has gone */ + hwnd = NULL; + break; + } + if (pid == myPid) + break; /* Found it */ + } + +#endif if (hwnd == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1)); |