summaryrefslogtreecommitdiffstats
path: root/win/tkWinDialog.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tkWinDialog.c')
-rw-r--r--win/tkWinDialog.c2238
1 files changed, 1929 insertions, 309 deletions
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index e03862c..d7f63fb 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -8,24 +8,25 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#define WINVER 0x0500 /* Requires Windows 2K definitions */
-#define _WIN32_WINNT 0x0500
+
#include "tkWinInt.h"
#include "tkFileFilter.h"
+#include "tkFont.h"
#include <commdlg.h> /* includes common dialog functionality */
-#ifdef _MSC_VER
-# pragma comment (lib, "comdlg32.lib")
-#endif
#include <dlgs.h> /* includes common dialog template defines */
#include <cderr.h> /* includes the common dialog error codes */
#include <shlobj.h> /* includes SHBrowseForFolder */
+
#ifdef _MSC_VER
# pragma comment (lib, "shell32.lib")
+# pragma comment (lib, "comdlg32.lib")
+# pragma comment (lib, "uuid.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 +35,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
@@ -46,10 +48,6 @@
#endif
#endif /* BFFM_VALIDATEFAILED */
-#ifndef OPENFILENAME_SIZE_VERSION_400
-#define OPENFILENAME_SIZE_VERSION_400 76
-#endif
-
typedef struct ThreadSpecificData {
int debugFlag; /* Flags whether we should output debugging
* information while displaying a builtin
@@ -61,6 +59,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;
@@ -118,11 +120,11 @@ static const struct {int type; int btnIds[3];} allowedTypes[] = {
*/
#define TkWinGetHInstance(from) \
- ((HINSTANCE) GetWindowLongPtrW((from), GWLP_HINSTANCE))
+ ((HINSTANCE) GetWindowLongPtr((from), GWLP_HINSTANCE))
#define TkWinGetUserData(from) \
- GetWindowLongPtrW((from), GWLP_USERDATA)
+ GetWindowLongPtr((from), GWLP_USERDATA)
#define TkWinSetUserData(to,what) \
- SetWindowLongPtrW((to), GWLP_USERDATA, (LPARAM)(what))
+ SetWindowLongPtr((to), GWLP_USERDATA, (LPARAM)(what))
/*
* The value of TK_MULTI_MAX_PATH dictates how many files can be retrieved
@@ -141,8 +143,8 @@ static const struct {int type; int btnIds[3];} allowedTypes[] = {
*/
typedef struct {
- WCHAR initDir[MAX_PATH]; /* Initial folder to use */
- WCHAR retDir[MAX_PATH]; /* Returned folder to use */
+ TCHAR initDir[MAX_PATH]; /* Initial folder to use */
+ TCHAR retDir[MAX_PATH]; /* Returned folder to use */
Tcl_Interp *interp;
int mustExist; /* True if file must exist to return from
* callback */
@@ -159,10 +161,412 @@ typedef struct OFNData {
int dynFileBufferSize; /* Dynamic filename buffer size, stored to
* avoid shrinking and expanding the buffer
* when selection changes */
- WCHAR *dynFileBuffer; /* Dynamic filename buffer */
+ TCHAR *dynFileBuffer; /* Dynamic filename buffer */
} 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 __IShellItem_INTERFACE_DEFINED__
+# define __IShellItem_INTERFACE_DEFINED__
+#ifdef __MSVCRT__
+typedef struct IShellItem IShellItem;
+
+typedef enum __MIDL_IShellItem_0001 {
+ SIGDN_NORMALDISPLAY = 0,SIGDN_PARENTRELATIVEPARSING = 0x80018001,SIGDN_PARENTRELATIVEFORADDRESSBAR = 0x8001c001,
+ SIGDN_DESKTOPABSOLUTEPARSING = 0x80028000,SIGDN_PARENTRELATIVEEDITING = 0x80031001,SIGDN_DESKTOPABSOLUTEEDITING = 0x8004c000,
+ SIGDN_FILESYSPATH = 0x80058000,SIGDN_URL = 0x80068000
+} SIGDN;
+
+typedef DWORD SICHINTF;
+
+typedef struct IShellItemVtbl
+{
+ BEGIN_INTERFACE
+
+ HRESULT (STDMETHODCALLTYPE *QueryInterface)(IShellItem *, REFIID, void **);
+ ULONG (STDMETHODCALLTYPE *AddRef)(IShellItem *);
+ ULONG (STDMETHODCALLTYPE *Release)(IShellItem *);
+ HRESULT (STDMETHODCALLTYPE *BindToHandler)(IShellItem *, IBindCtx *, REFGUID, REFIID, void **);
+ HRESULT (STDMETHODCALLTYPE *GetParent)(IShellItem *, IShellItem **);
+ HRESULT (STDMETHODCALLTYPE *GetDisplayName)(IShellItem *, SIGDN, LPOLESTR *);
+ HRESULT (STDMETHODCALLTYPE *GetAttributes)(IShellItem *, SFGAOF, SFGAOF *);
+ HRESULT (STDMETHODCALLTYPE *Compare)(IShellItem *, IShellItem *, SICHINTF, int *);
+
+ END_INTERFACE
+} IShellItemVtbl;
+struct IShellItem {
+ CONST_VTBL struct IShellItemVtbl *lpVtbl;
+};
+#endif
+#endif
+
+#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;
+#ifdef __MSVCRT__
+typedef ULONG SFGAOF;
+#endif /* __MSVCRT__ */
+typedef struct IShellItemArray IShellItemArray;
+typedef struct IShellItemArrayVtbl
+{
+ BEGIN_INTERFACE
+
+ HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
+ IShellItemArray *, REFIID riid,void **ppvObject);
+ ULONG ( STDMETHODCALLTYPE *AddRef )(IShellItemArray *);
+ ULONG ( STDMETHODCALLTYPE *Release )(IShellItemArray *);
+ HRESULT ( STDMETHODCALLTYPE *BindToHandler )(IShellItemArray *,
+ IBindCtx *, REFGUID, REFIID, void **);
+ /* flags is actually is enum GETPROPERTYSTOREFLAGS */
+ HRESULT ( STDMETHODCALLTYPE *GetPropertyStore )(
+ IShellItemArray *, int, REFIID, void **);
+ /* keyType actually REFPROPERTYKEY */
+ HRESULT ( STDMETHODCALLTYPE *GetPropertyDescriptionList )(
+ IShellItemArray *, void *, REFIID, void **);
+ HRESULT ( STDMETHODCALLTYPE *GetAttributes )(IShellItemArray *,
+ SIATTRIBFLAGS, SFGAOF, SFGAOF *);
+ HRESULT ( STDMETHODCALLTYPE *GetCount )(
+ IShellItemArray *, DWORD *);
+ HRESULT ( STDMETHODCALLTYPE *GetItemAt )(
+ IShellItemArray *, DWORD, IShellItem **);
+ /* ppenumShellItems actually (IEnumShellItems **) */
+ HRESULT ( STDMETHODCALLTYPE *EnumItems )(
+ IShellItemArray *, void **);
+
+ 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}
+};
+static const IID IIDIShellItem = {
+ 0x43826D1E, 0xE718, 0x42EE, {0xBC, 0x55, 0xA1, 0xE2, 0x61, 0xC3, 0x7B, 0xFE}
+};
+
+#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 *, REFIID, void **);
+ ULONG ( STDMETHODCALLTYPE *AddRef )( IFileDialog *);
+ ULONG ( STDMETHODCALLTYPE *Release )( IFileDialog *);
+ HRESULT ( STDMETHODCALLTYPE *Show )( IFileDialog *, HWND);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileDialog *,
+ UINT, const TCLCOMDLG_FILTERSPEC *);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(IFileDialog *, UINT);
+ HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(IFileDialog *, 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 *, void *, DWORD *);
+ HRESULT ( STDMETHODCALLTYPE *Unadvise )(IFileDialog *, DWORD);
+ HRESULT ( STDMETHODCALLTYPE *SetOptions )(
+ IFileDialog *, FILEOPENDIALOGOPTIONS);
+ HRESULT ( STDMETHODCALLTYPE *GetOptions )(
+ IFileDialog *, FILEOPENDIALOGOPTIONS *);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
+ IFileDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *SetFolder )(
+ IFileDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *GetFolder )(
+ IFileDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )(
+ IFileDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *SetFileName )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetFileName )(
+ IFileDialog *, LPWSTR *);
+ HRESULT ( STDMETHODCALLTYPE *SetTitle )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetResult )(
+ IFileDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *AddPlace )(
+ IFileDialog *, IShellItem *, FDAP);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )(
+ IFileDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *Close )( IFileDialog *, HRESULT);
+ HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
+ IFileDialog *, REFGUID);
+ HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileDialog *);
+ /* pFilter actually IShellItemFilter. But deprecated in Win7 AND we do
+ not use it anyways. So define as void* */
+ HRESULT ( STDMETHODCALLTYPE *SetFilter )(
+ IFileDialog *, void *);
+
+ END_INTERFACE
+} IFileDialogVtbl;
+
+struct IFileDialog {
+ CONST_VTBL struct IFileDialogVtbl *lpVtbl;
+};
+
+
+typedef struct IFileSaveDialog IFileSaveDialog;
+typedef struct IFileSaveDialogVtbl {
+ BEGIN_INTERFACE
+
+ HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
+ IFileSaveDialog *, REFIID, void **);
+ ULONG ( STDMETHODCALLTYPE *AddRef )( IFileSaveDialog *);
+ ULONG ( STDMETHODCALLTYPE *Release )( IFileSaveDialog *);
+ HRESULT ( STDMETHODCALLTYPE *Show )(
+ IFileSaveDialog *, HWND);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileSaveDialog * this,
+ UINT, const TCLCOMDLG_FILTERSPEC *);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(
+ IFileSaveDialog *, UINT);
+ HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(
+ IFileSaveDialog *, UINT *);
+ /* Actually pfde is IFileSaveDialogEvents* */
+ HRESULT ( STDMETHODCALLTYPE *Advise )(
+ IFileSaveDialog *, void *, DWORD *);
+ HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileSaveDialog *, DWORD);
+ HRESULT ( STDMETHODCALLTYPE *SetOptions )(
+ IFileSaveDialog *, FILEOPENDIALOGOPTIONS);
+ HRESULT ( STDMETHODCALLTYPE *GetOptions )(
+ IFileSaveDialog *, FILEOPENDIALOGOPTIONS *);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
+ IFileSaveDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *SetFolder )(
+ IFileSaveDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *GetFolder )(
+ IFileSaveDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )(
+ IFileSaveDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *SetFileName )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetFileName )(
+ IFileSaveDialog *, LPWSTR *);
+ HRESULT ( STDMETHODCALLTYPE *SetTitle )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetResult )(
+ IFileSaveDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *AddPlace )(
+ IFileSaveDialog *, IShellItem *, FDAP);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )(
+ IFileSaveDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *Close )( IFileSaveDialog *, HRESULT);
+ HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
+ IFileSaveDialog *, REFGUID);
+ HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileSaveDialog *);
+ /* pFilter Actually IShellItemFilter* */
+ HRESULT ( STDMETHODCALLTYPE *SetFilter )(
+ IFileSaveDialog *, void *);
+ HRESULT ( STDMETHODCALLTYPE *SetSaveAsItem )(
+ IFileSaveDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *SetProperties )(
+ IFileSaveDialog *, IPropertyStore *);
+ HRESULT ( STDMETHODCALLTYPE *SetCollectedProperties )(
+ IFileSaveDialog *, IPropertyDescriptionList *, BOOL);
+ HRESULT ( STDMETHODCALLTYPE *GetProperties )(
+ IFileSaveDialog *, IPropertyStore **);
+ HRESULT ( STDMETHODCALLTYPE *ApplyProperties )(
+ IFileSaveDialog *, IShellItem *, IPropertyStore *,
+ HWND, IFileOperationProgressSink *);
+
+ END_INTERFACE
+
+} IFileSaveDialogVtbl;
+
+struct IFileSaveDialog {
+ CONST_VTBL struct IFileSaveDialogVtbl *lpVtbl;
+};
+
+typedef struct IFileOpenDialog IFileOpenDialog;
+typedef struct IFileOpenDialogVtbl {
+ BEGIN_INTERFACE
+
+ HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
+ IFileOpenDialog *, REFIID, void **);
+ ULONG ( STDMETHODCALLTYPE *AddRef )( IFileOpenDialog *);
+ ULONG ( STDMETHODCALLTYPE *Release )( IFileOpenDialog *);
+ HRESULT ( STDMETHODCALLTYPE *Show )( IFileOpenDialog *, HWND);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileOpenDialog *,
+ UINT, const TCLCOMDLG_FILTERSPEC *);
+ HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(
+ IFileOpenDialog *, UINT);
+ HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(
+ IFileOpenDialog *, UINT *);
+ /* Actually pfde is IFileDialogEvents* */
+ HRESULT ( STDMETHODCALLTYPE *Advise )(
+ IFileOpenDialog *, void *, DWORD *);
+ HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileOpenDialog *, DWORD);
+ HRESULT ( STDMETHODCALLTYPE *SetOptions )(
+ IFileOpenDialog *, FILEOPENDIALOGOPTIONS);
+ HRESULT ( STDMETHODCALLTYPE *GetOptions )(
+ IFileOpenDialog *, FILEOPENDIALOGOPTIONS *);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
+ IFileOpenDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *SetFolder )(
+ IFileOpenDialog *, IShellItem *);
+ HRESULT ( STDMETHODCALLTYPE *GetFolder )(
+ IFileOpenDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )(
+ IFileOpenDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *SetFileName )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetFileName )(
+ IFileOpenDialog *, LPWSTR *);
+ HRESULT ( STDMETHODCALLTYPE *SetTitle )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *GetResult )(
+ IFileOpenDialog *, IShellItem **);
+ HRESULT ( STDMETHODCALLTYPE *AddPlace )(
+ IFileOpenDialog *, IShellItem *, FDAP);
+ HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )(
+ IFileOpenDialog *, LPCWSTR);
+ HRESULT ( STDMETHODCALLTYPE *Close )( IFileOpenDialog *, HRESULT);
+ HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
+ IFileOpenDialog *, REFGUID);
+ HRESULT ( STDMETHODCALLTYPE *ClearClientData )(
+ IFileOpenDialog *);
+ HRESULT ( STDMETHODCALLTYPE *SetFilter )(
+ IFileOpenDialog *,
+ /* pFilter is actually IShellItemFilter */
+ void *);
+ HRESULT ( STDMETHODCALLTYPE *GetResults )(
+ IFileOpenDialog *, IShellItemArray **);
+ HRESULT ( STDMETHODCALLTYPE *GetSelectedItems )(
+ IFileOpenDialog *, IShellItemArray **);
+
+ END_INTERFACE
+} IFileOpenDialogVtbl;
+
+struct IFileOpenDialog
+{
+ CONST_VTBL struct IFileOpenDialogVtbl *lpVtbl;
+};
+
+#endif /* __IFileDialog_INTERFACE_DEFINED__ */
+
+/*
* Definitions of functions used only in this file.
*/
@@ -170,9 +574,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);
@@ -180,8 +596,68 @@ static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
LPARAM lParam);
static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam);
static void SetTkDialog(ClientData clientData);
-static const char *ConvertExternalFilename(WCHAR *filename,
+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");
+}
+
/*
*-------------------------------------------------------------------------
@@ -252,7 +728,7 @@ void
TkWinDialogDebug(
int debug)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
tsdPtr->debugFlag = debug;
@@ -284,14 +760,14 @@ Tk_ChooseColorObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData, parent;
+ Tk_Window tkwin = clientData, parent;
HWND hWnd;
int i, oldMode, winCode, result;
- CHOOSECOLORW chooseColor;
+ CHOOSECOLOR chooseColor;
static int inited = 0;
static COLORREF dwCustColors[16];
static long oldColor; /* the color selected last time */
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"-initialcolor", "-parent", "-title", NULL
};
enum options {
@@ -315,7 +791,7 @@ Tk_ChooseColorObjCmd(
}
parent = tkwin;
- chooseColor.lStructSize = sizeof(CHOOSECOLORW);
+ chooseColor.lStructSize = sizeof(CHOOSECOLOR);
chooseColor.hwndOwner = NULL;
chooseColor.hInstance = NULL;
chooseColor.rgbResult = oldColor;
@@ -323,7 +799,7 @@ Tk_ChooseColorObjCmd(
chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
chooseColor.lCustData = (LPARAM) NULL;
chooseColor.lpfnHook = (LPOFNHOOKPROC) ColorDlgHookProc;
- chooseColor.lpTemplateName = (LPWSTR) interp;
+ chooseColor.lpTemplateName = (LPTSTR) interp;
for (i = 1; i < objc; i += 2) {
int index;
@@ -333,14 +809,14 @@ Tk_ChooseColorObjCmd(
optionPtr = objv[i];
valuePtr = objv[i + 1];
- if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", NULL);
return TCL_ERROR;
}
@@ -375,7 +851,7 @@ Tk_ChooseColorObjCmd(
chooseColor.hwndOwner = hWnd;
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- winCode = ChooseColorW(&chooseColor);
+ winCode = ChooseColor(&chooseColor);
(void) Tcl_SetServiceMode(oldMode);
/*
@@ -401,13 +877,11 @@ Tk_ChooseColorObjCmd(
/*
* User has selected a color
*/
- char color[100];
- sprintf(color, "#%02x%02x%02x",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%02x%02x%02x",
GetRValue(chooseColor.rgbResult),
GetGValue(chooseColor.rgbResult),
- GetBValue(chooseColor.rgbResult));
- Tcl_AppendResult(interp, color, NULL);
+ GetBValue(chooseColor.rgbResult)));
oldColor = chooseColor.rgbResult;
result = TCL_OK;
}
@@ -440,10 +914,10 @@ ColorDlgHookProc(
WPARAM wParam, /* First message parameter. */
LPARAM lParam) /* Second message parameter. */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
const char *title;
- CHOOSECOLORW *ccPtr;
+ CHOOSECOLOR *ccPtr;
if (WM_INITDIALOG == uMsg) {
@@ -451,18 +925,18 @@ ColorDlgHookProc(
* Set the title string of the dialog.
*/
- ccPtr = (CHOOSECOLORW *) lParam;
+ ccPtr = (CHOOSECOLOR *) lParam;
title = (const char *) ccPtr->lCustData;
if ((title != NULL) && (title[0] != '\0')) {
Tcl_DString ds;
- SetWindowTextW(hDlg, (WCHAR *)Tcl_WinUtfToTChar(title,-1,&ds));
+ SetWindowText(hDlg, Tcl_WinUtfToTChar(title,-1,&ds));
Tcl_DStringFree(&ds);
}
if (tsdPtr->debugFlag) {
tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
+ Tcl_DoWhenIdle(SetTkDialog, hDlg);
}
return TRUE;
}
@@ -493,7 +967,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);
}
/*
@@ -520,51 +994,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 */
{
- OPENFILENAMEW ofn;
- WCHAR 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 = (Tk_Window) clientData;
- HWND hWnd;
- Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
- Tcl_DString utfFilterString, utfDirString, ds;
- Tcl_DString extString, filterString, dirString, titleString;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- 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;
@@ -592,118 +1076,528 @@ GetFileName(
{"-typevariable", FILE_TYPEVARIABLE},
{NULL, FILE_DEFAULT/*ignored*/ }
};
- const struct Options *options = open ? openOptions : saveOptions;
+ static const struct Options dirOptions[] = {
+ {"-initialdir", FILE_INITDIR},
+ {"-mustexist", FILE_MUSTEXIST},
+ {"-parent", FILE_PARENT},
+ {"-title", FILE_TITLE},
+ {NULL, FILE_DEFAULT/*ignored*/ }
+ };
- file[0] = '\0';
- ZeroMemory(&ofnData, sizeof(OFNData));
- Tcl_DStringInit(&utfFilterString);
- Tcl_DStringInit(&utfDirString);
+ const struct Options *options = NULL;
- /*
- * Parse the arguments.
- */
+ 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;
const char *string;
- Tcl_Obj *valuePtr = objv[i + 1];
+ Tcl_Obj *valuePtr;
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 (i + 1 == objc) {
+ Tcl_SetResult(interp, "value for \"-xpstyle\" missing", TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
+ goto error_return;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[i+1],
+ &optsPtr->forceXPStyle) != TCL_OK)
+ goto error_return;
+
+ continue;
+
} else if (i + 1 == objc) {
- Tcl_AppendResult(interp, "value for \"", options[index].name,
- "\" missing", NULL);
- goto end;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", options[index].name));
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
+ goto error_return;
}
+ valuePtr = objv[i + 1];
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) {
- goto end;
+ 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;
+ }
+ }
+ }
+ }
}
- Tk_MakeWindowExist(tkwin);
- hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+ 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) {
+ /*
+ * Causes -filetypes {{All *}} -defaultextension ext to return
+ * foo.ext.ext when foo is typed into the entry box
+ * 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_Obj *normPath, *iniDirPath;
+ iniDirPath = Tcl_NewStringObj(Tcl_DStringValue(&optsPtr->utfDirString), -1);
+ Tcl_IncrRefCount(iniDirPath);
+ normPath = Tcl_FSGetNormalizedPath(interp, iniDirPath);
+ /* XXX - Note on failures do not raise error, simply ignore ini dir */
+ if (normPath) {
+ const WCHAR *nativePath;
+ Tcl_IncrRefCount(normPath);
+ nativePath = Tcl_FSGetNativePath(normPath); /* Points INTO normPath*/
+ if (nativePath) {
+ hr = ShellProcs.SHCreateItemFromParsingName(
+ nativePath, NULL,
+ &IIDIShellItem, (void **) &dirIf);
+ if (SUCCEEDED(hr)) {
+ /* Note we use SetFolder, not SetDefaultFolder - see MSDN */
+ fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */
+ }
+ }
+ Tcl_DecrRefCount(normPath); /* ALSO INVALIDATES nativePath !! */
+ }
+ Tcl_DecrRefCount(iniDirPath);
+ }
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ hr = fdlgIf->lpVtbl->Show(fdlgIf, hWnd);
+ Tcl_SetServiceMode(oldMode);
+
+ /*
+ * Ensure that hWnd is enabled, because it can happen that we have updated
+ * the wrapper of the parent, which causes us to leave this child disabled
+ * (Windows loses sync).
+ */
+
+ if (hWnd)
+ EnableWindow(hWnd, 1);
+
+ /*
+ * Clear interp result since it might have been set during the modal loop.
+ * http://core.tcl.tk/tk/tktview/4a0451f5291b3c9168cc560747dae9264e1d2ef6
+ */
+ Tcl_ResetResult(interp);
- ZeroMemory(&ofn, sizeof(OPENFILENAMEW));
- if (LOBYTE(LOWORD(GetVersion())) < 5) {
- ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400;
+ 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 {
- ofn.lStructSize = sizeof(OPENFILENAMEW);
+ 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(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;
/*
@@ -712,22 +1606,25 @@ GetFileName(
*/
ofnData.dynFileBufferSize = 512;
- ofnData.dynFileBuffer = (WCHAR *)ckalloc(512 * sizeof(WCHAR));
+ ofnData.dynFileBuffer = ckalloc(512 * sizeof(TCHAR));
}
- if (extension != NULL) {
- Tcl_WinUtfToTChar(extension, -1, &extString);
- ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&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);
}
Tcl_WinUtfToTChar(Tcl_DStringValue(&utfFilterString),
Tcl_DStringLength(&utfFilterString), &filterString);
- ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);
+ 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
@@ -736,10 +1633,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),
@@ -747,11 +1644,11 @@ GetFileName(
}
Tcl_DStringFree(&cwd);
}
- ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);
+ ofn.lpstrInitialDir = (TCHAR *) Tcl_DStringValue(&dirString);
- if (title != NULL) {
- Tcl_WinUtfToTChar(title, -1, &titleString);
- ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);
+ if (optsPtr->titleObj != NULL) {
+ Tcl_WinUtfToTChar(Tcl_GetString(optsPtr->titleObj), -1, &titleString);
+ ofn.lpstrTitle = (TCHAR *) Tcl_DStringValue(&titleString);
}
/*
@@ -759,10 +1656,10 @@ GetFileName(
*/
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- if (open != 0) {
- winCode = GetOpenFileNameW(&ofn);
+ if (oper != OFN_FILE_SAVE) {
+ winCode = GetOpenFileName(&ofn);
} else {
- winCode = GetSaveFileNameW(&ofn);
+ winCode = GetSaveFileName(&ofn);
}
Tcl_SetServiceMode(oldMode);
EatSpuriousMessageBugFix();
@@ -816,7 +1713,7 @@ GetFileName(
* first element is the directory path.
*/
- WCHAR *files = ofnData.dynFileBuffer;
+ TCHAR *files = ofnData.dynFileBuffer;
Tcl_Obj *returnList = Tcl_NewObj();
int count = 0;
@@ -862,34 +1759,51 @@ GetFileName(
Tcl_SetObjResult(interp, returnList);
Tcl_DStringFree(&ds);
} else {
- Tcl_AppendResult(interp, ConvertExternalFilename(
- ofn.lpstrFile, &ds), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ ConvertExternalFilename(ofn.lpstrFile, &ds), -1));
gotFilename = (Tcl_DStringLength(&ds) > 0);
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) {
- result = TCL_ERROR;
+ } else {
+ /*
+ * BUGFIX for d43a10ce2fed950e00890049f3c273f2cdd12583
+ * The original code was broken because it passed typeinfo[0]
+ * directly into Tcl_ObjSetVar2. In the case of typeInfo[0]
+ * pointing into a list which is also referenced by
+ * typeVariableObj, TOSV2 shimmers the object into
+ * variable intrep which loses the list representation.
+ * This invalidates typeInfo[0] which is freed but
+ * nevertheless stored as the value of the variable.
+ */
+ Tcl_Obj *selFilterObj = typeInfo[0];
+ Tcl_IncrRefCount(selFilterObj);
+ if (Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL,
+ selFilterObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(selFilterObj);
}
}
} else if (cdlgerr == FNERR_INVALIDFILENAME) {
- Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
- Tcl_AppendResult(interp, ConvertExternalFilename(
- ofn.lpstrFile, &ds), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid filename \"%s\"",
+ ConvertExternalFilename(ofn.lpstrFile, &ds)));
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "INVALID_FILENAME",
+ NULL);
Tcl_DStringFree(&ds);
} else {
result = TCL_OK;
@@ -899,6 +1813,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);
@@ -906,16 +1822,58 @@ GetFileName(
Tcl_DStringFree(&extString);
}
- end:
- Tcl_DStringFree(&utfDirString);
+end:
Tcl_DStringFree(&utfFilterString);
if (ofnData.dynFileBuffer != NULL) {
- ckfree((char *)ofnData.dynFileBuffer);
+ ckfree(ofnData.dynFileBuffer);
ofnData.dynFileBuffer = NULL;
}
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;
+}
+
/*
*-------------------------------------------------------------------------
@@ -943,15 +1901,15 @@ OFNHookProc(
WPARAM wParam, /* Message parameter */
LPARAM lParam) /* Message parameter */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- OPENFILENAMEW *ofnPtr;
+ OPENFILENAME *ofnPtr;
OFNData *ofnData;
if (uMsg == WM_INITDIALOG) {
TkWinSetUserData(hdlg, lParam);
} else if (uMsg == WM_NOTIFY) {
- OFNOTIFYW *notifyPtr = (OFNOTIFYW *) lParam;
+ OFNOTIFY *notifyPtr = (OFNOTIFY *) lParam;
/*
* This is weird... or not. The CDN_FILEOK is NOT sent when the
@@ -967,7 +1925,7 @@ OFNHookProc(
if (notifyPtr->hdr.code == CDN_FILEOK ||
notifyPtr->hdr.code == CDN_SELCHANGE) {
int dirsize, selsize;
- WCHAR *buffer;
+ TCHAR *buffer;
int buffersize;
/*
@@ -980,8 +1938,8 @@ OFNHookProc(
buffer = ofnData->dynFileBuffer;
hdlg = GetParent(hdlg);
- selsize = SendMessageW(hdlg, CDM_GETSPEC, 0, 0);
- dirsize = SendMessageW(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);
/*
@@ -991,15 +1949,15 @@ OFNHookProc(
if ((selsize > 1) && (dirsize > 0)) {
if (ofnData->dynFileBufferSize < buffersize) {
- buffer = (WCHAR *) ckrealloc((char *) buffer, buffersize * sizeof(WCHAR));
+ buffer = ckrealloc(buffer, buffersize * sizeof(TCHAR));
ofnData->dynFileBufferSize = buffersize;
ofnData->dynFileBuffer = buffer;
}
- SendMessageW(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer);
+ SendMessage(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer);
buffer += dirsize;
- SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
+ SendMessage(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
/*
* If there are multiple files, delete the quotes and change
@@ -1008,7 +1966,7 @@ OFNHookProc(
if (buffer[0] == '"') {
BOOL findquote = TRUE;
- WCHAR *tmp = buffer;
+ TCHAR *tmp = buffer;
while (*buffer != '\0') {
if (findquote) {
@@ -1037,8 +1995,8 @@ OFNHookProc(
if (TCL_PATH_ABSOLUTE ==
Tcl_GetPathType(Tcl_DStringValue(&tmpfile))) {
/* re-get the full path to the start of the buffer */
- buffer = (WCHAR *) ofnData->dynFileBuffer;
- SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
+ buffer = (TCHAR *) ofnData->dynFileBuffer;
+ SendMessage(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
} else {
*(buffer-1) = '\\';
}
@@ -1062,7 +2020,7 @@ OFNHookProc(
* information every time it gets a WM_WINDOWPOSCHANGED message.
*/
- ofnPtr = (OPENFILENAMEW *) TkWinGetUserData(hdlg);
+ ofnPtr = (OPENFILENAME *) TkWinGetUserData(hdlg);
if (ofnPtr != NULL) {
ofnData = (OFNData *) ofnPtr->lCustData;
if (ofnData->interp != NULL) {
@@ -1137,12 +2095,13 @@ MakeFilter(
*p = '\0';
} else {
- int len;
+ size_t len;
if (valuePtr == NULL) {
len = 0;
} else {
- (void) Tcl_GetStringFromObj(valuePtr, &len);
+ (void) Tcl_GetString(valuePtr);
+ len = valuePtr->length;
}
/*
@@ -1159,7 +2118,7 @@ MakeFilter(
* twice the size of the string to format the filter
*/
- filterStr = ckalloc((unsigned int) len * 3);
+ filterStr = ckalloc(len * 3);
for (filterPtr = flist.filters, p = filterStr; filterPtr;
filterPtr = filterPtr->next) {
@@ -1229,7 +2188,7 @@ MakeFilter(
}
Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr));
- ckfree((char *) filterStr);
+ ckfree(filterStr);
TkFreeFileFilters(&flist);
return TCL_OK;
@@ -1238,6 +2197,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
@@ -1312,103 +2410,61 @@ Tk_ChooseDirectoryObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- WCHAR path[MAX_PATH];
- int oldMode, result = TCL_ERROR, i;
+ TCHAR path[MAX_PATH];
+ int oldMode, result;
LPCITEMIDLIST pidl; /* Returned by browser */
- BROWSEINFOW bInfo; /* Used by browser */
+ BROWSEINFO bInfo; /* Used by browser */
ChooseDir cdCBData; /* Structure to pass back and forth */
LPMALLOC pMalloc; /* Used by shell */
- Tk_Window tkwin = (Tk_Window) clientData;
HWND hWnd;
- const char *utfTitle = NULL;/* Title for window */
- WCHAR saveDir[MAX_PATH];
+ TCHAR saveDir[MAX_PATH];
Tcl_DString titleString; /* Title */
- Tcl_DString initDirString; /* Initial directory */
Tcl_DString tempString; /* temporary */
Tcl_Obj *objPtr;
- static const char *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;
- const WCHAR *uniStr;
- Tcl_Obj *optionPtr, *valuePtr;
-
- optionPtr = objv[i];
- valuePtr = objv[i + 1];
-
- if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 0,
- &index) != TCL_OK) {
- goto cleanup;
- }
- if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
- goto cleanup;
- }
+ utfDir = Tcl_DStringValue(&ofnOpts.utfDirString);
+ if (utfDir[0] != '\0') {
+ const TCHAR *uniStr;
- 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 = (WCHAR *) Tcl_DStringValue(&tempString);
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&ofnOpts.utfDirString), -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. */
- GetFullPathNameW(uniStr, MAX_PATH, saveDir, NULL);
- wcsncpy(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
@@ -1417,16 +2473,16 @@ Tk_ChooseDirectoryObjCmd(
bInfo.hwndOwner = hWnd;
bInfo.pszDisplayName = path;
bInfo.pidlRoot = NULL;
- if (wcslen(cdCBData.initDir) == 0) {
- GetCurrentDirectoryW(MAX_PATH, cdCBData.initDir);
+ if (_tcslen(cdCBData.initDir) == 0) {
+ GetCurrentDirectory(MAX_PATH, cdCBData.initDir);
}
bInfo.lParam = (LPARAM) &cdCBData;
- if (utfTitle != NULL) {
- Tcl_WinUtfToTChar(utfTitle, -1, &titleString);
- bInfo.lpszTitle = (LPWSTR) Tcl_DStringValue(&titleString);
+ if (ofnOpts.titleObj != NULL) {
+ Tcl_WinUtfToTChar(Tcl_GetString(ofnOpts.titleObj), -1, &titleString);
+ bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString);
} else {
- bInfo.lpszTitle = L"Please choose a directory, then select OK.";
+ bInfo.lpszTitle = TEXT("Please choose a directory, then select OK.");
}
/*
@@ -1459,9 +2515,13 @@ Tk_ChooseDirectoryObjCmd(
*/
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- GetCurrentDirectoryW(MAX_PATH, saveDir);
+ GetCurrentDirectory(MAX_PATH, saveDir);
if (SHGetMalloc(&pMalloc) == NOERROR) {
- pidl = SHBrowseForFolderW(&bInfo);
+ /*
+ * XXX - MSDN says CoInitialize must have been called before
+ * SHBrowseForFolder can be used but don't see that called anywhere.
+ */
+ pidl = SHBrowseForFolder(&bInfo);
/*
* This is a fix for Windows 2000, which seems to modify the folder
@@ -1476,17 +2536,18 @@ Tk_ChooseDirectoryObjCmd(
*/
if (pidl != NULL) {
- if (!SHGetPathFromIDListW(pidl, path)) {
- Tcl_SetResult(interp, "Error: Not a file system folder\n",
- TCL_VOLATILE);
+ if (!SHGetPathFromIDList(pidl, path)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error: not a file system folder", -1));
+ Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "PSEUDO", NULL);
}
pMalloc->lpVtbl->Free(pMalloc, (void *) pidl);
- } else if (wcslen(cdCBData.retDir) > 0) {
- wcscpy(path, cdCBData.retDir);
+ } else if (_tcslen(cdCBData.retDir) > 0) {
+ _tcscpy(path, cdCBData.retDir);
}
pMalloc->lpVtbl->Release(pMalloc);
}
- SetCurrentDirectoryW(saveDir);
+ SetCurrentDirectory(saveDir);
Tcl_SetServiceMode(oldMode);
/*
@@ -1506,19 +2567,13 @@ Tk_ChooseDirectoryObjCmd(
if (*path) {
Tcl_DString ds;
- Tcl_AppendResult(interp, ConvertExternalFilename(path,
- &ds), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ ConvertExternalFilename(path, &ds), -1));
Tcl_DStringFree(&ds);
}
- result = TCL_OK;
-
- if (utfTitle != NULL) {
- Tcl_DStringFree(&titleString);
- }
-
- cleanup:
- return result;
+ CleanupOFNOptions(&ofnOpts);
+ return TCL_OK;
}
/*
@@ -1544,17 +2599,17 @@ ChooseDirectoryValidateProc(
LPARAM lParam,
LPARAM lpData)
{
- WCHAR selDir[MAX_PATH];
+ TCHAR selDir[MAX_PATH];
ChooseDir *chooseDirSharedData = (ChooseDir *) lpData;
Tcl_DString tempString;
Tcl_DString initDirString;
- WCHAR string[MAX_PATH];
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TCHAR string[MAX_PATH];
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (tsdPtr->debugFlag) {
tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
+ Tcl_DoWhenIdle(SetTkDialog, hwnd);
}
chooseDirSharedData->retDir[0] = '\0';
switch (message) {
@@ -1582,11 +2637,11 @@ ChooseDirectoryValidateProc(
Tcl_DStringFree(&initDirString);
Tcl_WinUtfToTChar(Tcl_DStringValue(&tempString), -1, &initDirString);
Tcl_DStringFree(&tempString);
- wcsncpy(string, (WCHAR *) Tcl_DStringValue(&initDirString),
+ _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString),
MAX_PATH);
Tcl_DStringFree(&initDirString);
- if (SetCurrentDirectoryW(string) == 0) {
+ if (SetCurrentDirectory(string) == 0) {
/*
* Get the full path name to the user entry, at this point it does
@@ -1594,16 +2649,17 @@ ChooseDirectoryValidateProc(
* it.
*/
- GetFullPathNameW(string, MAX_PATH,
+ GetFullPathName(string, MAX_PATH,
chooseDirSharedData->retDir, NULL);
if (chooseDirSharedData->mustExist) {
/*
* User HAS to select a valid directory.
*/
- wsprintfW(selDir, L"Directory '%.200s' does not exist,\nplease select or enter an existing directory.",
+ wsprintf(selDir, TEXT("Directory '%s' does not exist,\n")
+ TEXT("please select or enter an existing directory."),
chooseDirSharedData->retDir);
- MessageBoxW(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
+ MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
chooseDirSharedData->retDir[0] = '\0';
return 1;
}
@@ -1613,7 +2669,7 @@ ChooseDirectoryValidateProc(
* directory in utfRetDir.
*/
- GetCurrentDirectoryW(MAX_PATH, chooseDirSharedData->retDir);
+ GetCurrentDirectory(MAX_PATH, chooseDirSharedData->retDir);
return 0;
}
return 0;
@@ -1628,13 +2684,13 @@ ChooseDirectoryValidateProc(
* Not called when user changes edit box directly.
*/
- if (SHGetPathFromIDListW((LPITEMIDLIST) lParam, selDir)) {
- SendMessageW(hwnd, BFFM_SETSTATUSTEXTW, 0, (LPARAM) selDir);
+ if (SHGetPathFromIDList((LPITEMIDLIST) lParam, selDir)) {
+ SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir);
// enable the OK button
- SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
} else {
// disable the OK button
- SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0);
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0);
}
UpdateWindow(hwnd);
return 1;
@@ -1645,9 +2701,9 @@ ChooseDirectoryValidateProc(
* specified parameter.
*/
- WCHAR *initDir = chooseDirSharedData->initDir;
+ TCHAR *initDir = chooseDirSharedData->initDir;
- SetCurrentDirectoryW(initDir);
+ SetCurrentDirectory(initDir);
if (*initDir == '\\') {
/*
@@ -1664,10 +2720,10 @@ ChooseDirectoryValidateProc(
ULONG ulCount, ulAttr;
if (SUCCEEDED(psfFolder->lpVtbl->ParseDisplayName(
- psfFolder, hwnd, NULL, (WCHAR *)
+ psfFolder, hwnd, NULL, (TCHAR *)
initDir, &ulCount,&pidlMain,&ulAttr))
&& (pidlMain != NULL)) {
- SendMessageW(hwnd, BFFM_SETSELECTIONW, FALSE,
+ SendMessage(hwnd, BFFM_SETSELECTION, FALSE,
(LPARAM) pidlMain);
pMalloc->lpVtbl->Free(pMalloc, pidlMain);
}
@@ -1676,9 +2732,9 @@ ChooseDirectoryValidateProc(
pMalloc->lpVtbl->Release(pMalloc);
}
} else {
- SendMessageW(hwnd, BFFM_SETSELECTIONW, TRUE, (LPARAM) initDir);
+ SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM) initDir);
}
- SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
break;
}
@@ -1711,13 +2767,13 @@ Tk_MessageBoxObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData, parent;
+ Tk_Window tkwin = clientData, parent;
HWND hWnd;
Tcl_Obj *messageObj, *titleObj, *detailObj, *tmpObj;
int defaultBtn, icon, type;
int i, oldMode, winCode;
UINT flags;
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"-default", "-detail", "-icon", "-message",
"-parent", "-title", "-type", NULL
};
@@ -1725,7 +2781,7 @@ Tk_MessageBoxObjCmd(
MSG_DEFAULT, MSG_DETAIL, MSG_ICON, MSG_MESSAGE,
MSG_PARENT, MSG_TITLE, MSG_TYPE
};
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
defaultBtn = -1;
@@ -1743,14 +2799,14 @@ Tk_MessageBoxObjCmd(
optionPtr = objv[i];
valuePtr = objv[i + 1];
- if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (i + 1 == objc) {
- const char *string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL);
return TCL_ERROR;
}
@@ -1819,9 +2875,10 @@ Tk_MessageBoxObjCmd(
}
}
if (defaultBtnIdx < 0) {
- Tcl_AppendResult(interp, "invalid default button \"",
- TkFindStateString(buttonMap, defaultBtn),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid default button \"%s\"",
+ TkFindStateString(buttonMap, defaultBtn)));
+ Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL);
return TCL_ERROR;
}
break;
@@ -1853,9 +2910,9 @@ Tk_MessageBoxObjCmd(
tsdPtr->hSmallIcon = TkWinGetIcon(parent, ICON_SMALL);
tsdPtr->hBigIcon = TkWinGetIcon(parent, ICON_BIG);
- tsdPtr->hMsgBoxHook = SetWindowsHookExW(WH_CBT, MsgBoxCBTProc, NULL,
+ tsdPtr->hMsgBoxHook = SetWindowsHookEx(WH_CBT, MsgBoxCBTProc, NULL,
GetCurrentThreadId());
- winCode = MessageBoxW(hWnd, Tcl_GetUnicode(tmpObj),
+ winCode = MessageBox(hWnd, Tcl_GetUnicode(tmpObj),
titleObj ? Tcl_GetUnicode(titleObj) : L"", flags);
UnhookWindowsHookEx(tsdPtr->hMsgBoxHook);
(void) Tcl_SetServiceMode(oldMode);
@@ -1869,8 +2926,8 @@ Tk_MessageBoxObjCmd(
EnableWindow(hWnd, 1);
Tcl_DecrRefCount(tmpObj);
-
- Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TkFindStateString(buttonMap, winCode), -1));
return TCL_OK;
}
@@ -1880,7 +2937,7 @@ MsgBoxCBTProc(
WPARAM wParam,
LPARAM lParam)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (nCode == HCBT_CREATEWND) {
@@ -1897,9 +2954,9 @@ MsgBoxCBTProc(
if (WC_DIALOG == lpcbtcreate->lpcs->lpszClass) {
HWND hwnd = (HWND) wParam;
- SendMessageW(hwnd, WM_SETICON, ICON_SMALL,
+ SendMessage(hwnd, WM_SETICON, ICON_SMALL,
(LPARAM) tsdPtr->hSmallIcon);
- SendMessageW(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon);
+ SendMessage(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon);
}
}
@@ -1927,12 +2984,12 @@ static void
SetTkDialog(
ClientData clientData)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
char buf[32];
sprintf(buf, "0x%p", (HWND) clientData);
- Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(tsdPtr->debugInterp, "tk_dialog", NULL, buf, TCL_GLOBAL_ONLY);
}
/*
@@ -1941,12 +2998,12 @@ SetTkDialog(
static const char *
ConvertExternalFilename(
- WCHAR *filename,
+ TCHAR *filename,
Tcl_DString *dsPtr)
{
char *p;
- Tcl_WinTCharToUtf((TCHAR *) filename, -1, dsPtr);
+ Tcl_WinTCharToUtf(filename, -1, dsPtr);
for (p = Tcl_DStringValue(dsPtr); *p != '\0'; p++) {
/*
* Change the pathname to the Tcl "normalized" pathname, where back
@@ -1961,6 +3018,569 @@ ConvertExternalFilename(
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * GetFontObj --
+ *
+ * Convert a windows LOGFONT into a Tk font description.
+ *
+ * Result:
+ * A list containing a Tk font description.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetFontObj(
+ HDC hdc,
+ LOGFONT *plf)
+{
+ Tcl_DString ds;
+ Tcl_Obj *resObj;
+ int pt = 0;
+
+ resObj = Tcl_NewListObj(0, NULL);
+ Tcl_WinTCharToUtf(plf->lfFaceName, -1, &ds);
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj(Tcl_DStringValue(&ds), -1));
+ Tcl_DStringFree(&ds);
+ pt = -MulDiv(plf->lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY));
+ Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewIntObj(pt));
+ if (plf->lfWeight >= 700) {
+ Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewStringObj("bold", -1));
+ }
+ if (plf->lfItalic) {
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj("italic", -1));
+ }
+ if (plf->lfUnderline) {
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj("underline", -1));
+ }
+ if (plf->lfStrikeOut) {
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj("overstrike", -1));
+ }
+ return resObj;
+}
+
+static void
+ApplyLogfont(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdObj,
+ HDC hdc,
+ LOGFONT *logfontPtr)
+{
+ int objc;
+ Tcl_Obj **objv, **tmpv;
+
+ Tcl_ListObjGetElements(NULL, cmdObj, &objc, &objv);
+ tmpv = ckalloc(sizeof(Tcl_Obj *) * (objc + 2));
+ memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
+ tmpv[objc] = GetFontObj(hdc, logfontPtr);
+ TkBackgroundEvalObjv(interp, objc+1, tmpv, TCL_EVAL_GLOBAL);
+ ckfree(tmpv);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * HookProc --
+ *
+ * Font selection hook. If the user selects Apply on the dialog, we call
+ * the applyProc script with the currently selected font as arguments.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+typedef struct HookData {
+ Tcl_Interp *interp;
+ Tcl_Obj *titleObj;
+ Tcl_Obj *cmdObj;
+ Tcl_Obj *parentObj;
+ Tcl_Obj *fontObj;
+ HWND hwnd;
+ Tk_Window parent;
+} HookData;
+
+static UINT_PTR CALLBACK
+HookProc(
+ HWND hwndDlg,
+ UINT msg,
+ WPARAM wParam,
+ LPARAM lParam)
+{
+ CHOOSEFONT *pcf = (CHOOSEFONT *) lParam;
+ HWND hwndCtrl;
+ static HookData *phd = NULL;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (WM_INITDIALOG == msg && lParam != 0) {
+ phd = (HookData *) pcf->lCustData;
+ phd->hwnd = hwndDlg;
+ if (tsdPtr->debugFlag) {
+ tsdPtr->debugInterp = phd->interp;
+ Tcl_DoWhenIdle(SetTkDialog, hwndDlg);
+ }
+ if (phd->titleObj != NULL) {
+ Tcl_DString title;
+
+ Tcl_WinUtfToTChar(Tcl_GetString(phd->titleObj), -1, &title);
+ if (Tcl_DStringLength(&title) > 0) {
+ SetWindowText(hwndDlg, (LPCTSTR) Tcl_DStringValue(&title));
+ }
+ Tcl_DStringFree(&title);
+ }
+
+ /*
+ * Disable the colour combobox (0x473) and its label (0x443).
+ */
+
+ hwndCtrl = GetDlgItem(hwndDlg, 0x443);
+ if (IsWindow(hwndCtrl)) {
+ EnableWindow(hwndCtrl, FALSE);
+ }
+ hwndCtrl = GetDlgItem(hwndDlg, 0x473);
+ if (IsWindow(hwndCtrl)) {
+ EnableWindow(hwndCtrl, FALSE);
+ }
+ TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+ return 1; /* we handled the message */
+ }
+
+ if (WM_DESTROY == msg) {
+ phd->hwnd = NULL;
+ TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+ return 0;
+ }
+
+ /*
+ * Handle apply button by calling the provided command script as a
+ * background evaluation (ie: errors dont come back here).
+ */
+
+ if (WM_COMMAND == msg && LOWORD(wParam) == 1026) {
+ LOGFONT lf = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {0, 0}};
+ HDC hdc = GetDC(hwndDlg);
+
+ SendMessage(hwndDlg, WM_CHOOSEFONT_GETLOGFONT, 0, (LPARAM) &lf);
+ if (phd && phd->cmdObj) {
+ ApplyLogfont(phd->interp, phd->cmdObj, hdc, &lf);
+ }
+ if (phd && phd->parent) {
+ TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged");
+ }
+ return 1;
+ }
+ return 0; /* pass on for default processing */
+}
+
+/*
+ * Helper for the FontchooserConfigure command to return the current value of
+ * any of the options (which may be NULL in the structure)
+ */
+
+enum FontchooserOption {
+ FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd,
+ FontchooserVisible
+};
+
+static Tcl_Obj *
+FontchooserCget(
+ HookData *hdPtr,
+ int optionIndex)
+{
+ Tcl_Obj *resObj = NULL;
+
+ switch(optionIndex) {
+ case FontchooserParent:
+ if (hdPtr->parentObj) {
+ resObj = hdPtr->parentObj;
+ } else {
+ resObj = Tcl_NewStringObj(".", 1);
+ }
+ break;
+ case FontchooserTitle:
+ if (hdPtr->titleObj) {
+ resObj = hdPtr->titleObj;
+ } else {
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ break;
+ case FontchooserFont:
+ if (hdPtr->fontObj) {
+ resObj = hdPtr->fontObj;
+ } else {
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ break;
+ case FontchooserCmd:
+ if (hdPtr->cmdObj) {
+ resObj = hdPtr->cmdObj;
+ } else {
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ break;
+ case FontchooserVisible:
+ resObj = Tcl_NewBooleanObj(hdPtr->hwnd && IsWindow(hdPtr->hwnd));
+ break;
+ default:
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ return resObj;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserConfigureCmd --
+ *
+ * Implementation of the 'tk fontchooser configure' ensemble command. See
+ * the user documentation for what it does.
+ *
+ * Results:
+ * See the user documentation.
+ *
+ * Side effects:
+ * Per-interp data structure may be modified
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserConfigureCmd(
+ ClientData clientData, /* Main window */
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tk_Window tkwin = clientData;
+ HookData *hdPtr = NULL;
+ int i, r = TCL_OK;
+ static const char *const optionStrings[] = {
+ "-parent", "-title", "-font", "-command", "-visible", NULL
+ };
+
+ hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+ /*
+ * With no arguments we return all the options in a dict.
+ */
+
+ if (objc == 1) {
+ Tcl_Obj *keyObj, *valueObj;
+ Tcl_Obj *dictObj = Tcl_NewDictObj();
+
+ for (i = 0; r == TCL_OK && optionStrings[i] != NULL; ++i) {
+ keyObj = Tcl_NewStringObj(optionStrings[i], -1);
+ valueObj = FontchooserCget(hdPtr, i);
+ r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj);
+ }
+ if (r == TCL_OK) {
+ Tcl_SetObjResult(interp, dictObj);
+ }
+ return r;
+ }
+
+ for (i = 1; i < objc; i += 2) {
+ int optionIndex;
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ /*
+ * If one option and no arg - return the current value.
+ */
+
+ Tcl_SetObjResult(interp, FontchooserCget(hdPtr, optionIndex));
+ return TCL_OK;
+ }
+ if (i + 1 == objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+ switch (optionIndex) {
+ case FontchooserVisible: {
+ static const char *msg = "cannot change read-only option "
+ "\"-visible\": use the show or hide command";
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+ Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL);
+ return TCL_ERROR;
+ }
+ case FontchooserParent: {
+ Tk_Window parent = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[i+1]), tkwin);
+
+ if (parent == None) {
+ return TCL_ERROR;
+ }
+ if (hdPtr->parentObj) {
+ Tcl_DecrRefCount(hdPtr->parentObj);
+ }
+ hdPtr->parentObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->parentObj)) {
+ hdPtr->parentObj = Tcl_DuplicateObj(hdPtr->parentObj);
+ }
+ Tcl_IncrRefCount(hdPtr->parentObj);
+ break;
+ }
+ case FontchooserTitle:
+ if (hdPtr->titleObj) {
+ Tcl_DecrRefCount(hdPtr->titleObj);
+ }
+ hdPtr->titleObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->titleObj)) {
+ hdPtr->titleObj = Tcl_DuplicateObj(hdPtr->titleObj);
+ }
+ Tcl_IncrRefCount(hdPtr->titleObj);
+ break;
+ case FontchooserFont:
+ if (hdPtr->fontObj) {
+ Tcl_DecrRefCount(hdPtr->fontObj);
+ }
+ (void)Tcl_GetString(objv[i+1]);
+ if (objv[i+1]->length) {
+ hdPtr->fontObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->fontObj)) {
+ hdPtr->fontObj = Tcl_DuplicateObj(hdPtr->fontObj);
+ }
+ Tcl_IncrRefCount(hdPtr->fontObj);
+ } else {
+ hdPtr->fontObj = NULL;
+ }
+ break;
+ case FontchooserCmd:
+ if (hdPtr->cmdObj) {
+ Tcl_DecrRefCount(hdPtr->cmdObj);
+ }
+ (void)Tcl_GetString(objv[i+1]);
+ if (objv[i+1]->length) {
+ hdPtr->cmdObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->cmdObj)) {
+ hdPtr->cmdObj = Tcl_DuplicateObj(hdPtr->cmdObj);
+ }
+ Tcl_IncrRefCount(hdPtr->cmdObj);
+ } else {
+ hdPtr->cmdObj = NULL;
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserShowCmd --
+ *
+ * Implements the 'tk fontchooser show' ensemble command. The per-interp
+ * configuration data for the dialog is held in an interp associated
+ * structure.
+ *
+ * Calls the Win32 FontChooser API which provides a modal dialog. See
+ * HookProc where we make a few changes to the dialog and set some
+ * additional state.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserShowCmd(
+ ClientData clientData, /* Main window */
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_DString ds;
+ Tk_Window tkwin = clientData, parent;
+ CHOOSEFONT cf;
+ LOGFONT lf;
+ HDC hdc;
+ HookData *hdPtr;
+ int r = TCL_OK, oldMode = 0;
+
+ hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+ parent = tkwin;
+ if (hdPtr->parentObj) {
+ parent = Tk_NameToWindow(interp, Tcl_GetString(hdPtr->parentObj),
+ tkwin);
+ if (parent == None) {
+ return TCL_ERROR;
+ }
+ }
+
+ Tk_MakeWindowExist(parent);
+
+ ZeroMemory(&cf, sizeof(CHOOSEFONT));
+ ZeroMemory(&lf, sizeof(LOGFONT));
+ lf.lfCharSet = DEFAULT_CHARSET;
+ cf.lStructSize = sizeof(CHOOSEFONT);
+ cf.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
+ cf.lpLogFont = &lf;
+ cf.nFontType = SCREEN_FONTTYPE;
+ cf.Flags = CF_SCREENFONTS | CF_EFFECTS | CF_ENABLEHOOK;
+ cf.rgbColors = RGB(0,0,0);
+ cf.lpfnHook = HookProc;
+ cf.lCustData = (INT_PTR) hdPtr;
+ hdPtr->interp = interp;
+ hdPtr->parent = parent;
+ hdc = GetDC(cf.hwndOwner);
+
+ if (hdPtr->fontObj != NULL) {
+ TkFont *fontPtr;
+ Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, hdPtr->fontObj);
+
+ if (f == NULL) {
+ return TCL_ERROR;
+ }
+ fontPtr = (TkFont *) f;
+ cf.Flags |= CF_INITTOLOGFONTSTRUCT;
+ Tcl_WinUtfToTChar(fontPtr->fa.family, -1, &ds);
+ _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds),
+ LF_FACESIZE-1);
+ Tcl_DStringFree(&ds);
+ lf.lfFaceName[LF_FACESIZE-1] = 0;
+ lf.lfHeight = -MulDiv(TkFontGetPoints(tkwin, fontPtr->fa.size),
+ GetDeviceCaps(hdc, LOGPIXELSY), 72);
+ if (fontPtr->fa.weight == TK_FW_BOLD) {
+ lf.lfWeight = FW_BOLD;
+ }
+ if (fontPtr->fa.slant != TK_FS_ROMAN) {
+ lf.lfItalic = TRUE;
+ }
+ if (fontPtr->fa.underline) {
+ lf.lfUnderline = TRUE;
+ }
+ if (fontPtr->fa.overstrike) {
+ lf.lfStrikeOut = TRUE;
+ }
+ Tk_FreeFont(f);
+ }
+
+ if (TCL_OK == r && hdPtr->cmdObj != NULL) {
+ int len = 0;
+
+ r = Tcl_ListObjLength(interp, hdPtr->cmdObj, &len);
+ if (len > 0) {
+ cf.Flags |= CF_APPLY;
+ }
+ }
+
+ if (TCL_OK == r) {
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ if (ChooseFont(&cf)) {
+ if (hdPtr->cmdObj) {
+ ApplyLogfont(hdPtr->interp, hdPtr->cmdObj, hdc, &lf);
+ }
+ if (hdPtr->parent) {
+ TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged");
+ }
+ }
+ Tcl_SetServiceMode(oldMode);
+ EnableWindow(cf.hwndOwner, 1);
+ }
+
+ ReleaseDC(cf.hwndOwner, hdc);
+ return r;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserHideCmd --
+ *
+ * Implementation of the 'tk fontchooser hide' ensemble. See the user
+ * documentation for details.
+ * As the Win32 FontChooser function is always modal all we do here is
+ * destroy the dialog
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserHideCmd(
+ ClientData clientData, /* Main window */
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ HookData *hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+ if (hdPtr->hwnd && IsWindow(hdPtr->hwnd)) {
+ EndDialog(hdPtr->hwnd, 0);
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeleteHookData --
+ *
+ * Clean up the font chooser configuration data when the interp is
+ * destroyed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeleteHookData(ClientData clientData, Tcl_Interp *interp)
+{
+ HookData *hdPtr = clientData;
+
+ if (hdPtr->parentObj) {
+ Tcl_DecrRefCount(hdPtr->parentObj);
+ }
+ if (hdPtr->fontObj) {
+ Tcl_DecrRefCount(hdPtr->fontObj);
+ }
+ if (hdPtr->titleObj) {
+ Tcl_DecrRefCount(hdPtr->titleObj);
+ }
+ if (hdPtr->cmdObj) {
+ Tcl_DecrRefCount(hdPtr->cmdObj);
+ }
+ ckfree(hdPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TkInitFontchooser --
+ *
+ * Associate the font chooser configuration data with the Tcl
+ * interpreter. There is one font chooser per interp.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[];
+const TkEnsemble tkFontchooserEnsemble[] = {
+ { "configure", FontchooserConfigureCmd, NULL },
+ { "show", FontchooserShowCmd, NULL },
+ { "hide", FontchooserHideCmd, NULL },
+ { NULL, NULL, NULL }
+};
+
+int
+TkInitFontchooser(Tcl_Interp *interp, ClientData clientData)
+{
+ HookData *hdPtr = ckalloc(sizeof(HookData));
+
+ memset(hdPtr, 0, sizeof(HookData));
+ Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteHookData, hdPtr);
+ return TCL_OK;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4