summaryrefslogtreecommitdiffstats
path: root/win/tkWinDialog.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tkWinDialog.c')
-rw-r--r--win/tkWinDialog.c2806
1 files changed, 1313 insertions, 1493 deletions
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 382c454..069991b 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -5,69 +5,82 @@
*
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * 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 <commdlg.h> /* includes common dialog functionality */
-#include <dlgs.h> /* includes common dialog template defines */
-#include <cderr.h> /* includes the common dialog error codes */
+#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 */
-/*
- * This controls the use of the new style tk_chooseDirectory dialog.
- */
-#define USE_NEW_CHOOSEDIR 1
-#ifdef USE_NEW_CHOOSEDIR
-#include <shlobj.h> /* includes SHBrowseForFolder */
+#include <shlobj.h> /* includes SHBrowseForFolder */
+#ifdef _MSC_VER
+# pragma comment (lib, "shell32.lib")
+#endif
/* These needed for compilation with VC++ 5.2 */
#ifndef BIF_EDITBOX
#define BIF_EDITBOX 0x10
#endif
+
#ifndef BIF_VALIDATE
#define BIF_VALIDATE 0x0020
#endif
+
+#ifndef BIF_NEWDIALOGSTYLE
+#define BIF_NEWDIALOGSTYLE 0x0040
+#endif
+
#ifndef BFFM_VALIDATEFAILED
#ifdef UNICODE
#define BFFM_VALIDATEFAILED 4
#else
#define BFFM_VALIDATEFAILED 3
#endif
-#endif
+#endif /* BFFM_VALIDATEFAILED */
+
+#ifndef OPENFILENAME_SIZE_VERSION_400
+#define OPENFILENAME_SIZE_VERSION_400 76
+#endif
/*
- * The following structure is used by the new Tk_ChooseDirectoryObjCmd
- * to pass data between it and its callback. Unqiue to Winodws platform.
+ * The following structure is used by the new Tk_ChooseDirectoryObjCmd to pass
+ * data between it and its callback. Unqiue to Winodws platform.
*/
+
typedef struct ChooseDirData {
- TCHAR utfInitDir[MAX_PATH]; /* Initial folder to use */
- TCHAR utfRetDir[MAX_PATH]; /* Returned folder to use */
+ TCHAR utfInitDir[MAX_PATH]; /* Initial folder to use */
+ TCHAR utfRetDir[MAX_PATH]; /* Returned folder to use */
Tcl_Interp *interp;
- int mustExist; /* true if file must exist to return from
- * callback */
+ int mustExist; /* True if file must exist to return from
+ * callback */
} CHOOSEDIRDATA;
-#endif
-typedef struct ThreadSpecificData {
- int debugFlag; /* Flags whether we should output debugging
- * information while displaying a builtin
- * dialog. */
- Tcl_Interp *debugInterp; /* Interpreter to used for debugging. */
- UINT WM_LBSELCHANGED; /* Holds a registered windows event used for
- * communicating between the Directory
- * Chooser dialog and its hook proc. */
- 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 */
+typedef struct ThreadSpecificData {
+ int debugFlag; /* Flags whether we should output debugging
+ * information while displaying a builtin
+ * dialog. */
+ Tcl_Interp *debugInterp; /* Interpreter to used for debugging. */
+ UINT WM_LBSELCHANGED; /* Holds a registered windows event used for
+ * communicating between the Directory Chooser
+ * dialog and its hook proc. */
+ 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 */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
- * The following structures are used by Tk_MessageBoxCmd() to parse
- * arguments and return results.
+ * The following structures are used by Tk_MessageBoxCmd() to parse arguments
+ * and return results.
*/
static const TkStateMap iconMap[] = {
@@ -77,10 +90,10 @@ static const TkStateMap iconMap[] = {
{MB_ICONWARNING, "warning"},
{-1, NULL}
};
-
+
static const TkStateMap typeMap[] = {
{MB_ABORTRETRYIGNORE, "abortretryignore"},
- {MB_OK, "ok"},
+ {MB_OK, "ok"},
{MB_OKCANCEL, "okcancel"},
{MB_RETRYCANCEL, "retrycancel"},
{MB_YESNO, "yesno"},
@@ -105,99 +118,123 @@ static const int buttonFlagMap[] = {
static const struct {int type; int btnIds[3];} allowedTypes[] = {
{MB_ABORTRETRYIGNORE, {IDABORT, IDRETRY, IDIGNORE}},
- {MB_OK, {IDOK, -1, -1 }},
- {MB_OKCANCEL, {IDOK, IDCANCEL, -1 }},
- {MB_RETRYCANCEL, {IDRETRY, IDCANCEL, -1 }},
- {MB_YESNO, {IDYES, IDNO, -1 }},
- {MB_YESNOCANCEL, {IDYES, IDNO, IDCANCEL}}
+ {MB_OK, {IDOK, -1, -1 }},
+ {MB_OKCANCEL, {IDOK, IDCANCEL, -1 }},
+ {MB_RETRYCANCEL, {IDRETRY, IDCANCEL, -1 }},
+ {MB_YESNO, {IDYES, IDNO, -1 }},
+ {MB_YESNOCANCEL, {IDYES, IDNO, IDCANCEL}}
};
#define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0]))
/*
- * The value of TK_MULTI_MAX_PATH dictactes how many files can
- * be retrieved with tk_get*File -multiple 1. It must be allocated
- * on the stack, so make it large enough but not too large. -- hobbs
- * The data is stored as <dir>\0<file1>\0<file2>\0...<fileN>\0\0.
- * MAX_PATH == 260 on Win2K/NT, so *40 is ~10K.
+ * Abstract trivial differences between Win32 and Win64.
+ */
+
+#define TkWinGetHInstance(from) \
+ ((HINSTANCE) GetWindowLongPtr((from), GWLP_HINSTANCE))
+#define TkWinGetUserData(from) \
+ GetWindowLongPtr((from), GWLP_USERDATA)
+#define TkWinSetUserData(to,what) \
+ SetWindowLongPtr((to), GWLP_USERDATA, (LPARAM)(what))
+
+/*
+ * The value of TK_MULTI_MAX_PATH dictactes how many files can be retrieved
+ * with tk_get*File -multiple 1. It must be allocated on the stack, so make it
+ * large enough but not too large. - hobbs
+ *
+ * The data is stored as <dir>\0<file1>\0<file2>\0...<fileN>\0\0. Since
+ * MAX_PATH == 260 on Win2K/NT, *40 is ~10Kbytes.
*/
#define TK_MULTI_MAX_PATH (MAX_PATH*40)
/*
* The following structure is used to pass information between the directory
- * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.
+ * chooser function, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.
*/
typedef struct ChooseDir {
- Tcl_Interp *interp; /* Interp, used only if debug is turned on,
+ Tcl_Interp *interp; /* Interp, used only if debug is turned on,
* for setting the "tk_dialog" variable. */
int lastCtrl; /* Used by hook proc to keep track of last
- * control that had input focus, so when OK
- * is pressed we know whether to browse a
- * new directory or return. */
- int lastIdx; /* Last item that was selected in directory
+ * control that had input focus, so when OK is
+ * pressed we know whether to browse a new
+ * directory or return. */
+ int lastIdx; /* Last item that was selected in directory
* browser listbox. */
- TCHAR path[MAX_PATH]; /* On return from choose directory dialog,
- * holds the selected path. Cannot return
+ TCHAR path[MAX_PATH]; /* On return from choose directory dialog,
+ * holds the selected path. Cannot return
* selected path in ofnPtr->lpstrFile because
- * the default dialog proc stores a '\0' in
- * it, since, of course, no _file_ was
+ * the default dialog proc stores a '\0' in
+ * it, since, of course, no _file_ was
* selected. */
OPENFILENAME *ofnPtr; /* pointer to the OFN structure */
} ChooseDir;
/*
- * Definitions of procedures used only in this file.
+ * The following structure is used to pass information between GetFileName/W
+ * functions and OFN dialog hook procedures. [Bug 2896501, Patch 2898255]
+ */
+
+typedef struct OFNData {
+ Tcl_Interp *interp; /* Interp, used only if debug is turned on,
+ * for setting the "tk_dialog" variable. */
+ int dynFileBufferSize; /* Dynamic filename buffer size, stored to
+ * avoid shrinking and expanding the buffer
+ * when selection changes */
+ char *dynFileBuffer; /* Dynamic filename buffer, cast to WCHAR* in
+ * UNICODE procedures */
+} OFNData;
+
+/*
+ * Definitions of functions used only in this file.
*/
-#ifdef USE_NEW_CHOOSEDIR
static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg,
LPARAM wParam, LPARAM lParam);
-#else
-static UINT APIENTRY ChooseDirectoryHookProc(HWND hdlg, UINT uMsg,
- WPARAM wParam, LPARAM lParam);
-#endif
static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
LPARAM lParam);
-static int GetFileNameA(ClientData clientData,
- Tcl_Interp *interp, int objc,
+static int GetFileNameA(ClientData clientData,
+ Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[], int isOpen);
-static int GetFileNameW(ClientData clientData,
- Tcl_Interp *interp, int objc,
+static int GetFileNameW(ClientData clientData,
+ Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[], int isOpen);
-static int MakeFilter(Tcl_Interp *interp, char *string,
- Tcl_DString *dsPtr);
-static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
+static int MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr,
+ Tcl_DString *dsPtr, Tcl_Obj *initialPtr,
+ int *index);
+static UINT APIENTRY OFNHookProcA(HWND hdlg, UINT uMsg, WPARAM wParam,
LPARAM lParam);
-static UINT APIENTRY OFNHookProcW(HWND hdlg, UINT uMsg, WPARAM wParam,
+static UINT APIENTRY OFNHookProcW(HWND hdlg, UINT uMsg, WPARAM wParam,
LPARAM lParam);
static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam);
static void SetTkDialog(ClientData clientData);
+static char * ConvertExternalFilename(Tcl_Encoding encoding,
+ char *filename, Tcl_DString *dsPtr);
/*
*-------------------------------------------------------------------------
*
* EatSpuriousMessageBugFix --
*
- * In the file open/save dialog, double clicking on a list item
- * causes the dialog box to close, but an unwanted WM_LBUTTONUP
- * message is sent to the window underneath. If the window underneath
- * happens to be a windows control (eg a button) then it will be
- * activated by accident.
- *
- * This problem does not occur in dialog boxes, because windows
- * must do some special processing to solve the problem. (separate
- * message processing functions are used to cope with keyboard
- * navigation of controls.)
- *
- * Here is one solution. After returning, we poll the message queue
- * for 200ms looking for WM_LBUTTON up messages. If we see one it's
- * consumed. If we get a WM_LBUTTONDOWN message, then we exit early,
- * since the user must be doing something new. This fix only works
- * for the current application, so the problem will still occur if
- * the open dialog happens to be over another applications button.
- * However this is a fairly rare occurrance.
+ * In the file open/save dialog, double clicking on a list item causes
+ * the dialog box to close, but an unwanted WM_LBUTTONUP message is sent
+ * to the window underneath. If the window underneath happens to be a
+ * windows control (eg a button) then it will be activated by accident.
+ *
+ * This problem does not occur in dialog boxes, because windows must do
+ * some special processing to solve the problem. (separate message
+ * processing functions are used to cope with keyboard navigation of
+ * controls.)
+ *
+ * Here is one solution. After returning, we poll the message queue for
+ * 1/4s looking for WM_LBUTTON up messages. If we see one it's consumed.
+ * If we get a WM_LBUTTONDOWN message, then we exit early, since the user
+ * must be doing something new. This fix only works for the current
+ * application, so the problem will still occur if the open dialog
+ * happens to be over another applications button. However this is a
+ * fairly rare occurrance.
*
* Results:
* None.
@@ -212,12 +249,13 @@ static void
EatSpuriousMessageBugFix(void)
{
MSG msg;
- DWORD nTime = GetTickCount() + 200;
+ DWORD nTime = GetTickCount() + 250;
+
while (GetTickCount() < nTime) {
- if (PeekMessage(&msg,0,WM_LBUTTONDOWN,WM_LBUTTONDOWN,PM_NOREMOVE)) {
+ if (PeekMessage(&msg, 0, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_NOREMOVE)){
break;
}
- PeekMessage(&msg,0,WM_LBUTTONUP,WM_LBUTTONUP,PM_REMOVE);
+ PeekMessage(&msg, 0, WM_LBUTTONUP, WM_LBUTTONUP, PM_REMOVE);
}
}
@@ -227,8 +265,8 @@ EatSpuriousMessageBugFix(void)
* TkWinDialogDebug --
*
* Function to turn on/off debugging support for common dialogs under
- * windows. The variable "tk_debug" is set to the identifier of the
- * dialog window when the modal dialog window pops up and it is safe to
+ * windows. The variable "tk_debug" is set to the identifier of the
+ * dialog window when the modal dialog window pops up and it is safe to
* send messages to the dialog.
*
* Results:
@@ -240,12 +278,12 @@ EatSpuriousMessageBugFix(void)
*-------------------------------------------------------------------------
*/
-void
+void
TkWinDialogDebug(
int debug)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
tsdPtr->debugFlag = debug;
}
@@ -255,15 +293,14 @@ TkWinDialogDebug(
*
* Tk_ChooseColorObjCmd --
*
- * This procedure implements the color dialog box for the Windows
- * platform. See the user documentation for details on what it
- * does.
+ * This function implements the color dialog box for the Windows
+ * platform. See the user documentation for details on what it does.
*
* Results:
* See user documentation.
*
* Side effects:
- * A dialog window is created the first time this procedure is called.
+ * A dialog window is created the first time this function is called.
* This window is not destroyed and will be reused the next time the
* application invokes the "tk_chooseColor" command.
*
@@ -271,13 +308,13 @@ TkWinDialogDebug(
*/
int
-Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Main window associated with interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tk_ChooseColorObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- Tk_Window tkwin, parent;
+ Tk_Window tkwin = (Tk_Window) clientData, parent;
HWND hWnd;
int i, oldMode, winCode, result;
CHOOSECOLOR chooseColor;
@@ -294,11 +331,12 @@ Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
result = TCL_OK;
if (inited == 0) {
/*
- * dwCustColors stores the custom color which the user can
- * modify. We store these colors in a static array so that the next
- * time the color dialog pops up, the same set of custom colors
- * remain in the dialog.
+ * dwCustColors stores the custom color which the user can modify. We
+ * store these colors in a static array so that the next time the
+ * color dialog pops up, the same set of custom colors remain in the
+ * dialog.
*/
+
for (i = 0; i < 16; i++) {
dwCustColors[i] = RGB(255-i * 10, i, i * 10);
}
@@ -306,11 +344,9 @@ Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
inited = 1;
}
- tkwin = (Tk_Window) clientData;
-
parent = tkwin;
chooseColor.lStructSize = sizeof(CHOOSECOLOR);
- chooseColor.hwndOwner = NULL;
+ chooseColor.hwndOwner = NULL;
chooseColor.hInstance = NULL;
chooseColor.rgbResult = oldColor;
chooseColor.lpCustColors = dwCustColors;
@@ -332,36 +368,34 @@ Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
if (i + 1 == objc) {
- string = Tcl_GetStringFromObj(optionPtr, NULL);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- (char *) NULL);
+ string = Tcl_GetString(optionPtr);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ NULL);
return TCL_ERROR;
}
- string = Tcl_GetStringFromObj(valuePtr, NULL);
+ string = Tcl_GetString(valuePtr);
switch ((enum options) index) {
- case COLOR_INITIAL: {
- XColor *colorPtr;
+ case COLOR_INITIAL: {
+ XColor *colorPtr;
- colorPtr = Tk_GetColor(interp, tkwin, string);
- if (colorPtr == NULL) {
- return TCL_ERROR;
- }
- chooseColor.rgbResult = RGB(colorPtr->red / 0x100,
- colorPtr->green / 0x100, colorPtr->blue / 0x100);
- break;
- }
- case COLOR_PARENT: {
- parent = Tk_NameToWindow(interp, string, tkwin);
- if (parent == NULL) {
- return TCL_ERROR;
- }
- break;
+ colorPtr = Tk_GetColor(interp, tkwin, string);
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
}
- case COLOR_TITLE: {
- chooseColor.lCustData = (LPARAM) string;
- break;
+ chooseColor.rgbResult = RGB(colorPtr->red / 0x100,
+ colorPtr->green / 0x100, colorPtr->blue / 0x100);
+ break;
+ }
+ case COLOR_PARENT:
+ parent = Tk_NameToWindow(interp, string, tkwin);
+ if (parent == NULL) {
+ return TCL_ERROR;
}
+ break;
+ case COLOR_TITLE:
+ chooseColor.lCustData = (LPARAM) string;
+ break;
}
}
@@ -369,16 +403,17 @@ Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
chooseColor.hwndOwner = NULL;
hWnd = Tk_GetHWND(Tk_WindowId(parent));
chooseColor.hwndOwner = hWnd;
-
+
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
winCode = ChooseColor(&chooseColor);
(void) 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).
+ * 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).
*/
+
EnableWindow(hWnd, 1);
/*
@@ -399,10 +434,10 @@ Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
char color[100];
sprintf(color, "#%02x%02x%02x",
- GetRValue(chooseColor.rgbResult),
- GetGValue(chooseColor.rgbResult),
+ GetRValue(chooseColor.rgbResult),
+ GetGValue(chooseColor.rgbResult),
GetBValue(chooseColor.rgbResult));
- Tcl_AppendResult(interp, color, NULL);
+ Tcl_AppendResult(interp, color, NULL);
oldColor = chooseColor.rgbResult;
result = TCL_OK;
}
@@ -415,12 +450,12 @@ Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
*
* ColorDlgHookProc --
*
- * Provides special handling of messages for the Color common dialog
- * box. Used to set the title when the dialog first appears.
+ * Provides special handling of messages for the Color common dialog box.
+ * Used to set the title when the dialog first appears.
*
* Results:
- * The return value is 0 if the default dialog box procedure should
- * handle the message, non-zero otherwise.
+ * The return value is 0 if the default dialog box function should handle
+ * the message, non-zero otherwise.
*
* Side effects:
* Changes the title of the dialog window.
@@ -428,39 +463,39 @@ Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
*----------------------------------------------------------------------
*/
-static UINT CALLBACK
-ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
- HWND hDlg; /* Handle to the color dialog. */
- UINT uMsg; /* Type of message. */
- WPARAM wParam; /* First message parameter. */
- LPARAM lParam; /* Second message parameter. */
+static UINT CALLBACK
+ColorDlgHookProc(
+ HWND hDlg, /* Handle to the color dialog. */
+ UINT uMsg, /* Type of message. */
+ WPARAM wParam, /* First message parameter. */
+ LPARAM lParam) /* Second message parameter. */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ const char *title;
+ CHOOSECOLOR *ccPtr;
- switch (uMsg) {
- case WM_INITDIALOG: {
- const char *title;
- CHOOSECOLOR *ccPtr;
- Tcl_DString ds;
+ if (WM_INITDIALOG == uMsg) {
- /*
- * Set the title string of the dialog.
- */
+ /*
+ * Set the title string of the dialog.
+ */
- ccPtr = (CHOOSECOLOR *) lParam;
- title = (const char *) ccPtr->lCustData;
- if ((title != NULL) && (title[0] != '\0')) {
- (*tkWinProcs->setWindowText)(hDlg,
- Tcl_WinUtfToTChar(title, -1, &ds));
- Tcl_DStringFree(&ds);
- }
- if (tsdPtr->debugFlag) {
- tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
- }
- return TRUE;
+ ccPtr = (CHOOSECOLOR *) lParam;
+ title = (const char *) ccPtr->lCustData;
+
+ if ((title != NULL) && (title[0] != '\0')) {
+ Tcl_DString ds;
+
+ (*tkWinProcs->setWindowText)(hDlg,
+ Tcl_WinUtfToTChar(title, -1, &ds));
+ Tcl_DStringFree(&ds);
+ }
+ if (tsdPtr->debugFlag) {
+ tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
}
+ return TRUE;
}
return FALSE;
}
@@ -470,25 +505,24 @@ ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
*
* Tk_GetOpenFileCmd --
*
- * This procedure implements the "open file" dialog box for the
- * Windows platform. See the user documentation for details on what
- * it does.
+ * This function implements the "open file" dialog box for the Windows
+ * platform. See the user documentation for details on what it does.
*
* Results:
* See user documentation.
*
* Side effects:
- * A dialog window is created the first this procedure is called.
+ * A dialog window is created the first this function is called.
*
*----------------------------------------------------------------------
*/
int
-Tk_GetOpenFileObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Main window associated with interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tk_GetOpenFileObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
return GetFileNameW(clientData, interp, objc, objv, 1);
@@ -515,11 +549,11 @@ Tk_GetOpenFileObjCmd(clientData, interp, objc, objv)
*/
int
-Tk_GetSaveFileObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Main window associated with interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tk_GetSaveFileObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
return GetFileNameW(clientData, interp, objc, objv, 0);
@@ -544,42 +578,47 @@ Tk_GetSaveFileObjCmd(clientData, interp, objc, objv)
*----------------------------------------------------------------------
*/
-static int
-GetFileNameW(clientData, interp, objc, objv, open)
- 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(). */
+static int
+GetFileNameW(
+ 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(). */
{
OPENFILENAMEW ofn;
WCHAR file[TK_MULTI_MAX_PATH];
- int result, winCode, oldMode, i, multi = 0;
- char *extension, *filter, *title;
- Tk_Window tkwin;
+ OFNData ofnData;
+ int cdlgerr;
+ int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0;
+ int confirmOverwrite = 1;
+ char *extension = NULL, *title = NULL;
+ Tk_Window tkwin = (Tk_Window) clientData;
HWND hWnd;
- Tcl_DString utfFilterString, utfDirString;
+ Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
+ Tcl_DString utfFilterString, utfDirString, ds;
Tcl_DString extString, filterString, dirString, titleString;
Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
enum options {
- FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
- FILE_MULTIPLE, FILE_PARENT, FILE_TITLE
+ FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_PARENT,
+ FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW
};
struct Options {
CONST char *name;
enum options value;
};
- CONST struct Options *options;
static CONST struct Options saveOptions[] = {
+ {"-confirmoverwrite", FILE_CONFIRMOW},
{"-defaultextension", FILE_DEFAULT},
{"-filetypes", FILE_TYPES},
{"-initialdir", FILE_INITDIR},
{"-initialfile", FILE_INITFILE},
{"-parent", FILE_PARENT},
{"-title", FILE_TITLE},
+ {"-typevariable", FILE_TYPEVARIABLE},
{NULL, FILE_DEFAULT/*ignored*/ }
};
static CONST struct Options openOptions[] = {
@@ -590,142 +629,130 @@ GetFileNameW(clientData, interp, objc, objv, open)
{"-multiple", FILE_MULTIPLE},
{"-parent", FILE_PARENT},
{"-title", FILE_TITLE},
+ {"-typevariable", FILE_TYPEVARIABLE},
{NULL, FILE_DEFAULT/*ignored*/ }
};
+ CONST struct Options *options = open ? openOptions : saveOptions;
- /*
- * Parse the arguments.
- */
-
- result = TCL_ERROR;
file[0] = '\0';
- extension = NULL;
- filter = NULL;
+ ZeroMemory(&ofnData, sizeof(OFNData));
Tcl_DStringInit(&utfFilterString);
Tcl_DStringInit(&utfDirString);
- tkwin = (Tk_Window) clientData;
- title = NULL;
- if (open) {
- options = openOptions;
- } else {
- options = saveOptions;
- }
+ /*
+ * Parse the arguments.
+ */
for (i = 1; i < objc; i += 2) {
int index;
char *string;
- Tcl_Obj *optionPtr, *valuePtr;
-
- optionPtr = objv[i];
- valuePtr = objv[i + 1];
+ Tcl_Obj *valuePtr = objv[i + 1];
- if (Tcl_GetIndexFromObjStruct(interp, optionPtr, options,
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
sizeof(struct Options), "option", 0, &index) != TCL_OK) {
goto end;
- }
- if (i + 1 == objc) {
- string = Tcl_GetStringFromObj(optionPtr, NULL);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- (char *) NULL);
+ } else if (i + 1 == objc) {
+ Tcl_AppendResult(interp, "value for \"", options[index].name,
+ "\" missing", NULL);
goto end;
}
- string = Tcl_GetStringFromObj(valuePtr, NULL);
+ string = Tcl_GetString(valuePtr);
switch (options[index].value) {
- case FILE_DEFAULT: {
- if (string[0] == '.') {
- string++;
- }
- extension = string;
- break;
+ case FILE_DEFAULT:
+ if (string[0] == '.') {
+ string++;
}
- case FILE_TYPES: {
- Tcl_DStringFree(&utfFilterString);
- if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
- goto end;
- }
- filter = Tcl_DStringValue(&utfFilterString);
- break;
- }
- case FILE_INITDIR: {
- Tcl_DStringFree(&utfDirString);
- if (Tcl_TranslateFileName(interp, string,
- &utfDirString) == NULL) {
- goto end;
- }
- break;
+ extension = string;
+ break;
+ case FILE_TYPES:
+ filterObj = valuePtr;
+ break;
+ case FILE_INITDIR:
+ Tcl_DStringFree(&utfDirString);
+ if (Tcl_TranslateFileName(interp, string,
+ &utfDirString) == NULL) {
+ goto end;
}
- case FILE_INITFILE: {
- Tcl_DString ds;
-
- if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
- goto end;
- }
- Tcl_UtfToExternal(NULL, unicodeEncoding, Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds), 0, NULL, (char *) file,
- sizeof(file), NULL, NULL, NULL);
- break;
+ break;
+ case FILE_INITFILE:
+ if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
+ goto end;
}
- case FILE_MULTIPLE: {
- if (Tcl_GetBooleanFromObj(interp, valuePtr,
- &multi) != TCL_OK) {
- return TCL_ERROR;
- }
- break;
+ Tcl_UtfToExternal(NULL, unicodeEncoding, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), 0, NULL, (char *) file,
+ sizeof(file), NULL, NULL, NULL);
+ Tcl_DStringFree(&ds);
+ break;
+ case FILE_PARENT:
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto end;
}
- case FILE_PARENT: {
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
- goto end;
- }
- break;
+ break;
+ case FILE_TITLE:
+ title = string;
+ break;
+ case FILE_TYPEVARIABLE:
+ typeVariableObj = valuePtr;
+ initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL,
+ TCL_GLOBAL_ONLY);
+ break;
+ case FILE_MULTIPLE:
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) {
+ return TCL_ERROR;
}
- case FILE_TITLE: {
- title = string;
- break;
+ break;
+ case FILE_CONFIRMOW:
+ if (Tcl_GetBooleanFromObj(interp, valuePtr,
+ &confirmOverwrite) != TCL_OK) {
+ return TCL_ERROR;
}
+ break;
}
}
- if (filter == NULL) {
- if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
- goto end;
- }
+ if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj,
+ &filterIndex) != TCL_OK) {
+ goto end;
}
Tk_MakeWindowExist(tkwin);
hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
ZeroMemory(&ofn, sizeof(OPENFILENAMEW));
- ofn.lStructSize = sizeof(OPENFILENAMEW);
- ofn.hwndOwner = hWnd;
-#ifdef _WIN64
- ofn.hInstance = (HINSTANCE) GetWindowLongPtr(ofn.hwndOwner,
- GWLP_HINSTANCE);
-#else
- ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
- GWL_HINSTANCE);
-#endif
- ofn.lpstrFile = (WCHAR *) file;
- ofn.nMaxFile = TK_MULTI_MAX_PATH;
- ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST
- | OFN_NOCHANGEDIR | OFN_EXPLORER;
- ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProcW;
- ofn.lCustData = (LPARAM) interp;
+ if (LOBYTE(LOWORD(GetVersion())) < 5) {
+ ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400;
+ } else {
+ ofn.lStructSize = sizeof(OPENFILENAMEW);
+ }
+ ofn.hwndOwner = hWnd;
+ ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner);
+ ofn.lpstrFile = (WCHAR *) file;
+ ofn.nMaxFile = TK_MULTI_MAX_PATH;
+ ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR
+ | OFN_EXPLORER | OFN_ENABLEHOOK| OFN_ENABLESIZING;
+ ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProcW;
+ ofn.lCustData = (LPARAM) &ofnData;
if (open != 0) {
ofn.Flags |= OFN_FILEMUSTEXIST;
- } else {
+ } else if (confirmOverwrite) {
ofn.Flags |= OFN_OVERWRITEPROMPT;
}
-
if (tsdPtr->debugFlag != 0) {
- ofn.Flags |= OFN_ENABLEHOOK;
+ ofnData.interp = interp;
}
-
if (multi != 0) {
ofn.Flags |= OFN_ALLOWMULTISELECT;
+
+ /*
+ * Starting buffer size. The buffer will be expanded by the OFN dialog
+ * procedure when necessary
+ */
+
+ ofnData.dynFileBufferSize = 1024;
+ ofnData.dynFileBuffer = ckalloc(1024);
}
if (extension != NULL) {
@@ -737,6 +764,7 @@ GetFileNameW(clientData, interp, objc, objv, open)
Tcl_DStringValue(&utfFilterString),
Tcl_DStringLength(&utfFilterString), &filterString);
ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);
+ ofn.nFilterIndex = filterIndex;
if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
Tcl_UtfToExternalDString(unicodeEncoding,
@@ -744,14 +772,14 @@ GetFileNameW(clientData, interp, objc, objv, open)
Tcl_DStringLength(&utfDirString), &dirString);
} else {
/*
- * NT 5.0 changed the meaning of lpstrInitialDir, so we have
- * to ensure that we set the [pwd] if the user didn't specify
- * anything else.
+ * NT 5.0 changed the meaning of lpstrInitialDir, so we have to ensure
+ * that we set the [pwd] if the user didn't specify anything else.
*/
+
Tcl_DString cwd;
Tcl_DStringFree(&utfDirString);
- if ((Tcl_GetCwd(interp, &utfDirString) == (char *) NULL) ||
+ if ((Tcl_GetCwd(interp, &utfDirString) == NULL) ||
(Tcl_TranslateFileName(interp,
Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
Tcl_ResetResult(interp);
@@ -782,10 +810,11 @@ GetFileNameW(clientData, interp, objc, objv, open)
EatSpuriousMessageBugFix();
/*
- * 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).
+ * 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).
*/
+
EnableWindow(hWnd, 1);
/*
@@ -797,42 +826,48 @@ GetFileNameW(clientData, interp, objc, objv, open)
/*
* Process the results.
+ *
+ * Use the CommDlgExtendedError() function to retrieve the error code.
+ * This function can return one of about two dozen codes; most of these
+ * indicate some sort of gross system failure (insufficient memory, bad
+ * window handles, etc.). Most of the error codes will be ignored; as we
+ * find we want more specific error messages for particular errors, we can
+ * extend the code as needed.
*/
- if (winCode != 0) {
+ cdlgerr = CommDlgExtendedError();
+
+ /*
+ * We now allow FNERR_BUFFERTOOSMALL when multiselection is enabled. The
+ * filename buffer has been dynamically allocated by the OFN dialog
+ * procedure to accomodate all selected files.
+ */
+
+ if ((winCode != 0)
+ || ((cdlgerr == FNERR_BUFFERTOOSMALL)
+ && (ofn.Flags & OFN_ALLOWMULTISELECT))) {
+ int gotFilename = 0; /* Flag for tracking whether we have any
+ * filename at all. For details, see
+ * http://stackoverflow.com/q/9227859/301832
+ */
+
if (ofn.Flags & OFN_ALLOWMULTISELECT) {
- /*
- * The result in custData->szFile contains many items,
- * separated with null characters. It is terminated with
- * two nulls in a row. The first element is the directory
- * path.
+ /*
+ * The result in dynFileBuffer contains many items, separated by
+ * NUL characters. It is terminated with two nulls in a row. The
+ * first element is the directory path.
*/
- char *dir;
- char *p;
- char *file;
- WCHAR *files;
- Tcl_DString ds;
- Tcl_DString fullname, filename;
- Tcl_Obj *returnList;
- int count = 0;
- returnList = Tcl_NewObj();
- Tcl_IncrRefCount(returnList);
+ WCHAR *files = (WCHAR *) ofnData.dynFileBuffer;
+ Tcl_Obj *returnList = Tcl_NewObj();
+ int count = 0;
- files = ofn.lpstrFile;
- Tcl_ExternalToUtfDString(unicodeEncoding, (char *) files, -1, &ds);
+ /*
+ * Get directory.
+ */
- /* Get directory */
- dir = Tcl_DStringValue(&ds);
- for (p = dir; p && *p; p++) {
- /*
- * Change the pathname to the Tcl "normalized" pathname, where
- * back slashes are used instead of forward slashes
- */
- if (*p == '\\') {
- *p = '/';
- }
- }
+ (void) ConvertExternalFilename(unicodeEncoding, (char *) files,
+ &ds);
while (*files != '\0') {
while (*files != '\0') {
@@ -840,90 +875,70 @@ GetFileNameW(clientData, interp, objc, objv, open)
}
files++;
if (*files != '\0') {
+ Tcl_Obj *fullnameObj;
+ Tcl_DString filenameBuf;
+
count++;
- Tcl_ExternalToUtfDString(unicodeEncoding,
- (char *)files, -1, &filename);
- file = Tcl_DStringValue(&filename);
- for (p = file; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
- Tcl_DStringInit(&fullname);
- Tcl_DStringAppend(&fullname, dir, -1);
- Tcl_DStringAppend(&fullname, "/", -1);
- Tcl_DStringAppend(&fullname, file, -1);
- Tcl_ListObjAppendElement(interp, returnList,
- Tcl_NewStringObj(Tcl_DStringValue(&fullname), -1));
- Tcl_DStringFree(&fullname);
- Tcl_DStringFree(&filename);
+ (void) ConvertExternalFilename(unicodeEncoding,
+ (char *) files, &filenameBuf);
+
+ fullnameObj = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_AppendToObj(fullnameObj, "/", -1);
+ Tcl_AppendToObj(fullnameObj, Tcl_DStringValue(&filenameBuf),
+ Tcl_DStringLength(&filenameBuf));
+ gotFilename = 1;
+ Tcl_DStringFree(&filenameBuf);
+ Tcl_ListObjAppendElement(NULL, returnList, fullnameObj);
}
}
+
if (count == 0) {
/*
* Only one file was returned.
*/
- Tcl_ListObjAppendElement(interp, returnList,
- Tcl_NewStringObj(dir, -1));
+
+ Tcl_ListObjAppendElement(NULL, returnList,
+ Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds)));
+ gotFilename |= (Tcl_DStringLength(&ds) > 0);
}
Tcl_SetObjResult(interp, returnList);
- Tcl_DecrRefCount(returnList);
Tcl_DStringFree(&ds);
} else {
- char *p;
- Tcl_DString ds;
-
- Tcl_ExternalToUtfDString(unicodeEncoding,
- (char *) ofn.lpstrFile, -1, &ds);
- for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
- /*
- * Change the pathname to the Tcl "normalized" pathname, where
- * back slashes are used instead of forward slashes
- */
- if (*p == '\\') {
- *p = '/';
- }
- }
- Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_AppendResult(interp, ConvertExternalFilename(unicodeEncoding,
+ (char *) ofn.lpstrFile, &ds), NULL);
+ gotFilename = (Tcl_DStringLength(&ds) > 0);
Tcl_DStringFree(&ds);
}
result = TCL_OK;
- } else {
- /*
- * Use the CommDlgExtendedError() function to retrieve the error code.
- * This function can return one of about two dozen codes; most of
- * these indicate some sort of gross system failure (insufficient
- * memory, bad window handles, etc.). Most of the error codes will be
- * ignored; as we find we want more specific error messages for
- * particular errors, we can extend the code as needed.
- *
- * We could also check for FNERR_BUFFERTOOSMALL, but we can't
- * really do anything about it when it happens.
- */
-
- if (CommDlgExtendedError() == FNERR_INVALIDFILENAME) {
- char *p;
- Tcl_DString ds;
-
- Tcl_ExternalToUtfDString(unicodeEncoding,
- (char *) ofn.lpstrFile, -1, &ds);
- for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
- /*
- * Change the pathname to the Tcl "normalized" pathname,
- * where back slashes are used instead of forward slashes
- */
- if (*p == '\\') {
- *p = '/';
- }
+ if ((ofn.nFilterIndex > 0) && gotFilename && typeVariableObj
+ && filterObj) {
+ int listObjc, count;
+ Tcl_Obj **listObjv = NULL;
+ Tcl_Obj **typeInfo = NULL;
+
+ if (Tcl_ListObjGetElements(interp, filterObj,
+ &listObjc, &listObjv) != TCL_OK) {
+ result = TCL_ERROR;
+ } else if (Tcl_ListObjGetElements(interp,
+ listObjv[ofn.nFilterIndex - 1], &count,
+ &typeInfo) != TCL_OK) {
+ result = TCL_ERROR;
+ } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL,
+ typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
}
- Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
- Tcl_AppendResult(interp, Tcl_DStringValue(&ds), "\"", NULL);
- Tcl_DStringFree(&ds);
- } else {
- result = TCL_OK;
}
+ } else if (cdlgerr == FNERR_INVALIDFILENAME) {
+ Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
+ Tcl_AppendResult(interp, ConvertExternalFilename(unicodeEncoding,
+ (char *) ofn.lpstrFile, &ds), "\"", NULL);
+ Tcl_DStringFree(&ds);
+ } else {
+ result = TCL_OK;
}
-
+
if (ofn.lpstrTitle != NULL) {
Tcl_DStringFree(&titleString);
}
@@ -935,9 +950,13 @@ GetFileNameW(clientData, interp, objc, objv, open)
Tcl_DStringFree(&extString);
}
- end:
+ end:
Tcl_DStringFree(&utfDirString);
Tcl_DStringFree(&utfFilterString);
+ if (ofnData.dynFileBuffer != NULL) {
+ ckfree(ofnData.dynFileBuffer);
+ ofnData.dynFileBuffer = NULL;
+ }
return result;
}
@@ -947,9 +966,10 @@ GetFileNameW(clientData, interp, objc, objv, open)
*
* OFNHookProcW --
*
- * Hook procedure called only if debugging is turned on. Sets
- * the "tk_dialog" variable when the dialog is ready to receive
- * messages.
+ * Dialog box hook function. This is used to sets the "tk_dialog"
+ * variable for test/debugging when the dialog is ready to receive
+ * messages. When multiple file selection is enabled this function
+ * is used to process the list of names.
*
* Results:
* Returns 0 to allow default processing of messages to occur.
@@ -960,45 +980,127 @@ GetFileNameW(clientData, interp, objc, objv, open)
*-------------------------------------------------------------------------
*/
-static UINT APIENTRY
+static UINT APIENTRY
OFNHookProcW(
- HWND hdlg, // handle to child dialog window
- UINT uMsg, // message identifier
- WPARAM wParam, // message parameter
- LPARAM lParam) // message parameter
+ HWND hdlg, /* Handle to child dialog window. */
+ UINT uMsg, /* Message identifier */
+ WPARAM wParam, /* Message parameter */
+ LPARAM lParam) /* Message parameter */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
OPENFILENAMEW *ofnPtr;
+ OFNData *ofnData;
if (uMsg == WM_INITDIALOG) {
-#ifdef _WIN64
- SetWindowLongPtr(hdlg, GWLP_USERDATA, lParam);
-#else
- SetWindowLong(hdlg, GWL_USERDATA, lParam);
-#endif
+ TkWinSetUserData(hdlg, lParam);
+ } else if (uMsg == WM_NOTIFY) {
+ OFNOTIFYW *notifyPtr = (OFNOTIFYW *) lParam;
+
+ /*
+ * This is weird... or not. The CDN_FILEOK is NOT sent when the selection
+ * exceeds declared buffer size (the nMaxFile member of the OPENFILENAMEW
+ * struct passed to GetOpenFileNameW function). So, we have to rely on
+ * the most recent CDN_SELCHANGE then. Unfortunately this means, that
+ * gathering the selected filenames happens twice when they fit into the
+ * declared buffer. Luckily, it's not frequent operation so it should
+ * not incur any noticeable delay. See [tktoolkit-Bugs-2987995]
+ */
+ if (notifyPtr->hdr.code == CDN_FILEOK ||
+ notifyPtr->hdr.code == CDN_SELCHANGE) {
+ int dirsize, selsize;
+ WCHAR *buffer;
+ int buffersize;
+
+ /*
+ * Change of selection. Unscramble the unholy mess that's in the
+ * selection buffer, resizing it if necessary.
+ */
+
+ ofnPtr = notifyPtr->lpOFN;
+ ofnData = (OFNData *) ofnPtr->lCustData;
+ buffer = (WCHAR *) ofnData->dynFileBuffer;
+ hdlg = GetParent(hdlg);
+
+ selsize = SendMessageW(hdlg, CDM_GETSPEC, 0, 0);
+ dirsize = SendMessageW(hdlg, CDM_GETFOLDERPATH, 0, 0);
+ buffersize = (selsize + dirsize + 1) * 2;
+
+ /*
+ * Just empty the buffer if dirsize indicates an error [Bug 3071836]
+ */
+ if ((selsize > 1) && (dirsize > 0)) {
+ if (ofnData->dynFileBufferSize < buffersize) {
+ buffer = (WCHAR *) ckrealloc((char *) buffer, buffersize);
+ ofnData->dynFileBufferSize = buffersize;
+ ofnData->dynFileBuffer = (char *) buffer;
+ }
+
+ SendMessageW(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer);
+ buffer += dirsize;
+
+ SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
+
+ /*
+ * If there are multiple files, delete the quotes and change
+ * every second quote to NULL terminator
+ */
+
+ if (buffer[0] == '"') {
+ BOOL findquote = TRUE;
+ WCHAR *tmp = buffer;
+
+ while(*buffer != '\0') {
+ if (findquote) {
+ if (*buffer == '"') {
+ findquote = FALSE;
+ }
+ buffer++;
+ } else {
+ if (*buffer == '"') {
+ findquote = TRUE;
+ *buffer = '\0';
+ }
+ *tmp++ = *buffer++;
+ }
+ }
+ *tmp = '\0'; /* Second NULL terminator. */
+ } else {
+ buffer[selsize] = '\0'; /* Second NULL terminator. */
+
+ /*
+ * Replace directory terminating NULL with a backslash.
+ */
+
+ buffer--;
+ *buffer = '\\';
+ }
+ } else {
+ /*
+ * Nothing is selected, so just empty the string.
+ */
+
+ if (buffer != NULL) {
+ *buffer = '\0';
+ }
+ }
+ }
} else if (uMsg == WM_WINDOWPOSCHANGED) {
/*
- * This message is delivered at the right time to enable Tk
- * to set the debug information. Unhooks itself so it
- * won't set the debug information every time it gets a
- * WM_WINDOWPOSCHANGED message.
+ * This message is delivered at the right time to enable Tk to set the
+ * debug information. Unhooks itself so it won't set the debug
+ * information every time it gets a WM_WINDOWPOSCHANGED message.
*/
-#ifdef _WIN64
- ofnPtr = (OPENFILENAMEW *) GetWindowLongPtr(hdlg, GWLP_USERDATA);
-#else
- ofnPtr = (OPENFILENAMEW *) GetWindowLong(hdlg, GWL_USERDATA);
-#endif
+ ofnPtr = (OPENFILENAMEW *) TkWinGetUserData(hdlg);
if (ofnPtr != NULL) {
- hdlg = GetParent(hdlg);
- tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
-#ifdef _WIN64
- SetWindowLongPtr(hdlg, GWLP_USERDATA, (LPARAM) NULL);
-#else
- SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
-#endif
+ ofnData = (OFNData *) ofnPtr->lCustData;
+ if (ofnData->interp != NULL) {
+ hdlg = GetParent(hdlg);
+ tsdPtr->debugInterp = ofnData->interp;
+ Tcl_DoWhenIdle(SetTkDialog, hdlg);
+ }
+ TkWinSetUserData(hdlg, NULL);
}
}
return 0;
@@ -1020,54 +1122,52 @@ OFNHookProcW(
*----------------------------------------------------------------------
*/
-static int
-GetFileNameA(clientData, interp, objc, objv, open)
- 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(). */
+static int
+GetFileNameA(
+ 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(). */
{
OPENFILENAME ofn;
TCHAR file[TK_MULTI_MAX_PATH], savePath[MAX_PATH];
- int result, winCode, oldMode, i, multi = 0;
- char *extension, *filter, *title;
- Tk_Window tkwin;
+ OFNData ofnData;
+ int cdlgerr;
+ int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0;
+ char *extension = NULL, *title = NULL;
+ Tk_Window tkwin = (Tk_Window) clientData;
HWND hWnd;
- Tcl_DString utfFilterString, utfDirString;
+ 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));
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
static CONST char *saveOptionStrings[] = {
"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
- "-parent", "-title", NULL
+ "-parent", "-title", "-typevariable", NULL
};
static CONST char *openOptionStrings[] = {
"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
- "-multiple", "-parent", "-title", NULL
+ "-multiple", "-parent", "-title", "-typevariable", NULL
};
CONST char **optionStrings;
enum options {
FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
- FILE_MULTIPLE, FILE_PARENT, FILE_TITLE
+ FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE
};
- result = TCL_ERROR;
file[0] = '\0';
+ ZeroMemory(&ofnData, sizeof(OFNData));
+ Tcl_DStringInit(&utfFilterString);
+ Tcl_DStringInit(&utfDirString);
/*
* Parse the arguments.
*/
- extension = NULL;
- filter = NULL;
- Tcl_DStringInit(&utfFilterString);
- Tcl_DStringInit(&utfDirString);
- tkwin = (Tk_Window) clientData;
- title = NULL;
-
if (open) {
optionStrings = openOptionStrings;
} else {
@@ -1082,124 +1182,114 @@ GetFileNameA(clientData, interp, objc, objv, open)
optionPtr = objv[i];
valuePtr = objv[i + 1];
- if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings,
- "option", 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 0,
+ &index) != TCL_OK) {
goto end;
}
+
/*
* We want to maximize code sharing between the open and save file
* dialog implementations; in particular, the switch statement below.
* We use different sets of option strings from the GetIndexFromObj
- * call above, but a single enumeration for both. The save file
- * dialog doesn't support -multiple, but it falls in the middle of
- * the enumeration. Ultimately, this means that when the index found
- * by GetIndexFromObj is >= FILE_MULTIPLE, when doing a save file
- * dialog, we have to increment the index, so that it matches the
- * open file dialog enumeration.
+ * call above, but a single enumeration for both. The save file dialog
+ * doesn't support -multiple, but it falls in the middle of the
+ * enumeration. Ultimately, this means that when the index found by
+ * GetIndexFromObj is >= FILE_MULTIPLE, when doing a save file dialog,
+ * we have to increment the index, so that it matches the open file
+ * dialog enumeration.
*/
+
if (!open && index >= FILE_MULTIPLE) {
index++;
}
if (i + 1 == objc) {
- string = Tcl_GetStringFromObj(optionPtr, NULL);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- (char *) NULL);
+ string = Tcl_GetString(optionPtr);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ NULL);
goto end;
}
- string = Tcl_GetStringFromObj(valuePtr, NULL);
+ string = Tcl_GetString(valuePtr);
switch ((enum options) index) {
- case FILE_DEFAULT: {
- if (string[0] == '.') {
- string++;
- }
- extension = string;
- break;
- }
- case FILE_TYPES: {
- Tcl_DStringFree(&utfFilterString);
- if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
- goto end;
- }
- filter = Tcl_DStringValue(&utfFilterString);
- break;
- }
- case FILE_INITDIR: {
- Tcl_DStringFree(&utfDirString);
- if (Tcl_TranslateFileName(interp, string,
- &utfDirString) == NULL) {
- goto end;
- }
- break;
+ case FILE_DEFAULT:
+ if (string[0] == '.') {
+ string++;
}
- case FILE_INITFILE: {
- Tcl_DString ds;
-
- if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
- goto end;
- }
- Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds), 0, NULL, (char *) file,
- sizeof(file), NULL, NULL, NULL);
- break;
+ extension = string;
+ break;
+ case FILE_TYPES:
+ filterObj = valuePtr;
+ break;
+ case FILE_INITDIR:
+ Tcl_DStringFree(&utfDirString);
+ if (Tcl_TranslateFileName(interp, string, &utfDirString) == NULL) {
+ goto end;
}
- case FILE_MULTIPLE: {
- if (Tcl_GetBooleanFromObj(interp, valuePtr,
- &multi) != TCL_OK) {
- return TCL_ERROR;
- }
- break;
+ break;
+ case FILE_INITFILE:
+ if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
+ goto end;
}
- case FILE_PARENT: {
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
- goto end;
- }
- break;
+ Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), 0, NULL, (char *) file,
+ sizeof(file), NULL, NULL, NULL);
+ Tcl_DStringFree(&ds);
+ break;
+ case FILE_MULTIPLE:
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) {
+ return TCL_ERROR;
}
- case FILE_TITLE: {
- title = string;
- break;
+ break;
+ case FILE_PARENT:
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto end;
}
+ break;
+ case FILE_TITLE:
+ title = string;
+ break;
+ case FILE_TYPEVARIABLE:
+ typeVariableObj = valuePtr;
+ initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL,
+ TCL_GLOBAL_ONLY);
+ break;
}
}
- if (filter == NULL) {
- if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
- goto end;
- }
+ if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj,
+ &filterIndex) != TCL_OK) {
+ goto end;
}
Tk_MakeWindowExist(tkwin);
hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
- ofn.lStructSize = sizeof(ofn);
- ofn.hwndOwner = hWnd;
-#ifdef _WIN64
- ofn.hInstance = (HINSTANCE) GetWindowLongPtr(ofn.hwndOwner,
- GWLP_HINSTANCE);
-#else
- ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
- GWL_HINSTANCE);
-#endif
- ofn.lpstrFilter = NULL;
- ofn.lpstrCustomFilter = NULL;
- ofn.nMaxCustFilter = 0;
- ofn.nFilterIndex = 0;
- ofn.lpstrFile = (LPTSTR) file;
- ofn.nMaxFile = TK_MULTI_MAX_PATH;
- ofn.lpstrFileTitle = NULL;
- ofn.nMaxFileTitle = 0;
- ofn.lpstrInitialDir = NULL;
- ofn.lpstrTitle = NULL;
- ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST
- | OFN_NOCHANGEDIR | OFN_EXPLORER;
- ofn.nFileOffset = 0;
- ofn.nFileExtension = 0;
- ofn.lpstrDefExt = NULL;
- ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc;
- ofn.lCustData = (LPARAM) interp;
- ofn.lpTemplateName = NULL;
+ ZeroMemory(&ofn, sizeof(OPENFILENAMEA));
+ if (LOBYTE(LOWORD(GetVersion())) < 5) {
+ ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400;
+ } else {
+ ofn.lStructSize = sizeof(ofn);
+ }
+ ofn.hwndOwner = hWnd;
+ ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner);
+ ofn.lpstrFilter = NULL;
+ ofn.lpstrCustomFilter = NULL;
+ ofn.nMaxCustFilter = 0;
+ ofn.lpstrFile = (LPTSTR) file;
+ ofn.nMaxFile = TK_MULTI_MAX_PATH;
+ ofn.lpstrFileTitle = NULL;
+ ofn.nMaxFileTitle = 0;
+ ofn.lpstrInitialDir = NULL;
+ ofn.lpstrTitle = NULL;
+ ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR
+ | OFN_EXPLORER | OFN_ENABLEHOOK;
+ ofn.nFileOffset = 0;
+ ofn.nFileExtension = 0;
+ ofn.lpstrDefExt = NULL;
+ ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProcA;
+ ofn.lCustData = (LPARAM) &ofnData;
+ ofn.lpTemplateName = NULL;
if (open != 0) {
ofn.Flags |= OFN_FILEMUSTEXIST;
@@ -1208,11 +1298,19 @@ GetFileNameA(clientData, interp, objc, objv, open)
}
if (tsdPtr->debugFlag != 0) {
- ofn.Flags |= OFN_ENABLEHOOK;
+ ofnData.interp = interp;
}
if (multi != 0) {
ofn.Flags |= OFN_ALLOWMULTISELECT;
+
+ /*
+ * Starting buffer size. The buffer will be expanded by the OFN dialog
+ * procedure when necessary
+ */
+
+ ofnData.dynFileBufferSize = 1024;
+ ofnData.dynFileBuffer = ckalloc(1024);
}
if (extension != NULL) {
@@ -1222,20 +1320,21 @@ GetFileNameA(clientData, interp, objc, objv, open)
Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString),
Tcl_DStringLength(&utfFilterString), &filterString);
ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString);
+ ofn.nFilterIndex = filterIndex;
if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
Tcl_DStringLength(&utfDirString), &dirString);
} else {
/*
- * NT 5.0 changed the meaning of lpstrInitialDir, so we have
- * to ensure that we set the [pwd] if the user didn't specify
- * anything else.
+ * NT 5.0 changed the meaning of lpstrInitialDir, so we have to ensure
+ * that we set the [pwd] if the user didn't specify anything else.
*/
+
Tcl_DString cwd;
Tcl_DStringFree(&utfDirString);
- if ((Tcl_GetCwd(interp, &utfDirString) == (char *) NULL) ||
+ if ((Tcl_GetCwd(interp, &utfDirString) == NULL) ||
(Tcl_TranslateFileName(interp,
Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
Tcl_ResetResult(interp);
@@ -1268,10 +1367,11 @@ GetFileNameA(clientData, interp, objc, objv, open)
SetCurrentDirectory(savePath);
/*
- * 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).
+ * 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).
*/
+
EnableWindow(hWnd, 1);
/*
@@ -1283,42 +1383,44 @@ GetFileNameA(clientData, interp, objc, objv, open)
/*
* Process the results.
+ *
+ * Use the CommDlgExtendedError() function to retrieve the error code.
+ * This function can return one of about two dozen codes; most of these
+ * indicate some sort of gross system failure (insufficient memory, bad
+ * window handles, etc.) Most of the error codes will be ignored; as we
+ * find we want specific error messages for particular errors, we can
+ * extend the code as needed.
+ */
+
+ cdlgerr = CommDlgExtendedError();
+
+ /*
+ * We now allow FNERR_BUFFERTOOSMALL when multiselection is enabled. The
+ * filename buffer has been dynamically allocated by the OFN dialog
+ * procedure to accomodate all selected files.
*/
- if (winCode != 0) {
+ if ((winCode != 0)
+ || ((cdlgerr == FNERR_BUFFERTOOSMALL)
+ && (ofn.Flags & OFN_ALLOWMULTISELECT))) {
if (ofn.Flags & OFN_ALLOWMULTISELECT) {
- /*
- * The result in custData->szFile contains many items,
- * separated with null characters. It is terminated with
- * two nulls in a row. The first element is the directory
- * path.
+ /*
+ * The result in dynFileBuffer contains many items, separated by
+ * NUL characters. It is terminated with two nulls in a row. The
+ * first element is the directory path (if multiple files are
+ * selected) or the only returned file (if only a single file has
+ * been chosen).
*/
- char *dir;
- char *p;
- char *file;
- char *files;
- Tcl_DString ds;
- Tcl_DString fullname, filename;
- Tcl_Obj *returnList;
- int count = 0;
- returnList = Tcl_NewObj();
- Tcl_IncrRefCount(returnList);
+ char *files = ofnData.dynFileBuffer;
+ Tcl_Obj *returnList = Tcl_NewObj();
+ int count = 0;
- files = ofn.lpstrFile;
- Tcl_ExternalToUtfDString(NULL, (char *) files, -1, &ds);
+ /*
+ * Get directory.
+ */
- /* Get directory */
- dir = Tcl_DStringValue(&ds);
- for (p = dir; p && *p; p++) {
- /*
- * Change the pathname to the Tcl "normalized" pathname, where
- * back slashes are used instead of forward slashes
- */
- if (*p == '\\') {
- *p = '/';
- }
- }
+ (void) ConvertExternalFilename(NULL, (char *) files, &ds);
while (*files != '\0') {
while (*files != '\0') {
@@ -1326,85 +1428,63 @@ GetFileNameA(clientData, interp, objc, objv, open)
}
files++;
if (*files != '\0') {
+ Tcl_Obj *fullnameObj;
+ Tcl_DString filename;
+
count++;
- Tcl_ExternalToUtfDString(NULL,
- (char *)files, -1, &filename);
- file = Tcl_DStringValue(&filename);
- for (p = file; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
- Tcl_DStringInit(&fullname);
- Tcl_DStringAppend(&fullname, dir, -1);
- Tcl_DStringAppend(&fullname, "/", -1);
- Tcl_DStringAppend(&fullname, file, -1);
- Tcl_ListObjAppendElement(interp, returnList,
- Tcl_NewStringObj(Tcl_DStringValue(&fullname), -1));
- Tcl_DStringFree(&fullname);
+ (void) ConvertExternalFilename(NULL, (char *) files,
+ &filename);
+ fullnameObj = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_AppendToObj(fullnameObj, "/", -1);
+ Tcl_AppendToObj(fullnameObj, Tcl_DStringValue(&filename),
+ Tcl_DStringLength(&filename));
Tcl_DStringFree(&filename);
+ Tcl_ListObjAppendElement(NULL, returnList, fullnameObj);
}
}
if (count == 0) {
/*
* Only one file was returned.
*/
- Tcl_ListObjAppendElement(interp, returnList,
- Tcl_NewStringObj(dir, -1));
+
+ Tcl_ListObjAppendElement(NULL, returnList, Tcl_NewStringObj(
+ Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
}
Tcl_SetObjResult(interp, returnList);
- Tcl_DecrRefCount(returnList);
Tcl_DStringFree(&ds);
} else {
- char *p;
- Tcl_DString ds;
-
- Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds);
- for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
- /*
- * Change the pathname to the Tcl "normalized" pathname, where
- * back slashes are used instead of forward slashes
- */
- if (*p == '\\') {
- *p = '/';
- }
- }
- Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_AppendResult(interp, ConvertExternalFilename(NULL,
+ (char *) ofn.lpstrFile, &ds), NULL);
Tcl_DStringFree(&ds);
}
result = TCL_OK;
- } else {
- /*
- * Use the CommDlgExtendedError() function to retrieve the error code.
- * This function can return one of about two dozen codes; most of
- * these indicate some sort of gross system failure (insufficient
- * memory, bad window handles, etc.). Most of the error codes will be
- * ignored;; as we find we want specific error messages for particular
- * errors, we can extend the code as needed.
- *
- * We could also check for FNERR_BUFFERTOOSMALL, but we can't
- * really do anything about it when it happens.
- */
- if (CommDlgExtendedError() == FNERR_INVALIDFILENAME) {
- char *p;
- Tcl_DString ds;
-
- Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds);
- for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
- /*
- * Change the pathname to the Tcl "normalized" pathname,
- * where back slashes are used instead of forward slashes
- */
- if (*p == '\\') {
- *p = '/';
- }
+ if ((ofn.nFilterIndex > 0) &&
+ (Tcl_GetCharLength(Tcl_GetObjResult(interp)) > 0) &&
+ typeVariableObj && filterObj) {
+ int listObjc, count;
+ Tcl_Obj **listObjv = NULL;
+ Tcl_Obj **typeInfo = NULL;
+
+ if (Tcl_ListObjGetElements(interp, filterObj, &listObjc,
+ &listObjv) != TCL_OK) {
+ result = TCL_ERROR;
+ } else if (Tcl_ListObjGetElements(interp,
+ listObjv[ofn.nFilterIndex - 1], &count,
+ &typeInfo) != TCL_OK) {
+ result = TCL_ERROR;
+ } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL,
+ typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
}
- Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
- Tcl_AppendResult(interp, Tcl_DStringValue(&ds), "\"", NULL);
- Tcl_DStringFree(&ds);
- } else {
- result = TCL_OK;
}
+ } else if (cdlgerr == FNERR_INVALIDFILENAME) {
+ Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
+ Tcl_AppendResult(interp, ConvertExternalFilename(NULL,
+ (char *) ofn.lpstrFile, &ds), "\"", NULL);
+ Tcl_DStringFree(&ds);
+ } else {
+ result = TCL_OK;
}
if (ofn.lpstrTitle != NULL) {
@@ -1418,9 +1498,13 @@ GetFileNameA(clientData, interp, objc, objv, open)
Tcl_DStringFree(&extString);
}
- end:
+ end:
Tcl_DStringFree(&utfDirString);
Tcl_DStringFree(&utfFilterString);
+ if (ofnData.dynFileBuffer != NULL) {
+ ckfree(ofnData.dynFileBuffer);
+ ofnData.dynFileBuffer = NULL;
+ }
return result;
}
@@ -1428,11 +1512,12 @@ GetFileNameA(clientData, interp, objc, objv, open)
/*
*-------------------------------------------------------------------------
*
- * OFNHookProc --
+ * OFNHookProcA --
*
- * Hook procedure called only if debugging is turned on. Sets
- * the "tk_dialog" variable when the dialog is ready to receive
- * messages.
+ * Dialog box hook function. This is used to sets the "tk_dialog"
+ * variable for test/debugging when the dialog is ready to receive
+ * messages. When multiple file selection is enabled this function
+ * is used to process the list of names.
*
* Results:
* Returns 0 to allow default processing of messages to occur.
@@ -1443,48 +1528,130 @@ GetFileNameA(clientData, interp, objc, objv, open)
*-------------------------------------------------------------------------
*/
-static UINT APIENTRY
-OFNHookProc(
- HWND hdlg, // handle to child dialog window
- UINT uMsg, // message identifier
- WPARAM wParam, // message parameter
- LPARAM lParam) // message parameter
+static UINT APIENTRY
+OFNHookProcA(
+ HWND hdlg, /* handle to child dialog window */
+ UINT uMsg, /* message identifier */
+ WPARAM wParam, /* message parameter */
+ LPARAM lParam) /* message parameter */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
OPENFILENAME *ofnPtr;
+ OFNData *ofnData;
if (uMsg == WM_INITDIALOG) {
-#ifdef _WIN64
- SetWindowLongPtr(hdlg, GWLP_USERDATA, lParam);
-#else
- SetWindowLong(hdlg, GWL_USERDATA, lParam);
-#endif
+ TkWinSetUserData(hdlg, lParam);
+ } else if (uMsg == WM_NOTIFY) {
+ OFNOTIFY *notifyPtr = (OFNOTIFY *) lParam;
+
+ /*
+ * This is weird... or not. The CDN_FILEOK is NOT sent when the selection
+ * exceeds declared buffer size (the nMaxFile member of the OPENFILENAMEW
+ * struct passed to GetOpenFileNameW function). So, we have to rely on
+ * the most recent CDN_SELCHANGE then. Unfortunately this means, that
+ * gathering the selected filenames happens twice when they fit into the
+ * declared buffer. Luckily, it's not frequent operation so it should
+ * not incur any noticeable delay. See [tktoolkit-Bugs-2987995]
+ */
+ if (notifyPtr->hdr.code == CDN_FILEOK ||
+ notifyPtr->hdr.code == CDN_SELCHANGE) {
+ int dirsize, selsize;
+ char *buffer;
+ int buffersize;
+
+ /*
+ * Change of selection. Unscramble the unholy mess that's in the
+ * selection buffer, resizing it if necessary.
+ */
+
+ ofnPtr = notifyPtr->lpOFN;
+ ofnData = (OFNData *) ofnPtr->lCustData;
+ buffer = ofnData->dynFileBuffer;
+ hdlg = GetParent(hdlg);
+
+ selsize = SendMessage(hdlg, CDM_GETSPEC, 0, 0);
+ dirsize = SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0);
+ buffersize = selsize + dirsize + 1;
+
+ /*
+ * Just empty the buffer if dirsize indicates an error [Bug 3071836]
+ */
+ if ((selsize > 1) && (dirsize > 0)) {
+ if (ofnData->dynFileBufferSize < buffersize) {
+ buffer = ckrealloc(buffer, buffersize);
+ ofnData->dynFileBufferSize = buffersize;
+ ofnData->dynFileBuffer = buffer;
+ }
+
+ SendMessage(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer);
+ buffer += dirsize;
+ SendMessage(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
+
+ /*
+ * If there are multiple files, delete the quotes and change
+ * every second quote to NULL terminator.
+ */
+
+ if (buffer[0] == '"') {
+ BOOL findquote = TRUE;
+ char *tmp = buffer;
+
+ while (*buffer != '\0') {
+ if (findquote) {
+ if (*buffer == '"') {
+ findquote = FALSE;
+ }
+ buffer++;
+ } else {
+ if (*buffer == '"') {
+ findquote = TRUE;
+ *buffer = '\0';
+ }
+ *tmp++ = *buffer++;
+ }
+ }
+ *tmp = '\0'; /* Second NULL terminator. */
+ } else {
+ buffer[selsize] = '\0'; /* Second NULL terminator. */
+
+ /*
+ * Replace directory terminating NULL with a backslash.
+ */
+
+ buffer--;
+ *buffer = '\\';
+ }
+
+ } else {
+ /*
+ * Nothing is selected, so just empty the string.
+ */
+
+ if (buffer != NULL) {
+ *buffer = '\0';
+ }
+ }
+ }
} else if (uMsg == WM_WINDOWPOSCHANGED) {
/*
- * This message is delivered at the right time to both
- * old-style and explorer-style hook procs to enable Tk
- * to set the debug information. Unhooks itself so it
- * won't set the debug information every time it gets a
- * WM_WINDOWPOSCHANGED message.
+ * This message is delivered at the right time to both old-style and
+ * explorer-style hook procs to enable Tk to set the debug
+ * information. Unhooks itself so it won't set the debug information
+ * every time it gets a WM_WINDOWPOSCHANGED message.
*/
-#ifdef _WIN64
- ofnPtr = (OPENFILENAME *) GetWindowLongPtr(hdlg, GWLP_USERDATA);
-#else
- ofnPtr = (OPENFILENAME *) GetWindowLong(hdlg, GWL_USERDATA);
-#endif
+ ofnPtr = (OPENFILENAME *) TkWinGetUserData(hdlg);
if (ofnPtr != NULL) {
- if (ofnPtr->Flags & OFN_EXPLORER) {
- hdlg = GetParent(hdlg);
+ ofnData = (OFNData *) ofnPtr->lCustData;
+ if (ofnData->interp != NULL) {
+ if (ofnPtr->Flags & OFN_EXPLORER) {
+ hdlg = GetParent(hdlg);
+ }
+ tsdPtr->debugInterp = ofnData->interp;
+ Tcl_DoWhenIdle(SetTkDialog, hdlg);
}
- tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
-#ifdef _WIN64
- SetWindowLongPtr(hdlg, GWLP_USERDATA, (LPARAM) NULL);
-#else
- SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
-#endif
+ TkWinSetUserData(hdlg, NULL);
}
}
return 0;
@@ -1496,7 +1663,7 @@ OFNHookProc(
* MakeFilter --
*
* Allocate a buffer to store the filters in a format understood by
- * Windows
+ * Windows.
*
* Results:
* A standard TCL return value.
@@ -1506,20 +1673,28 @@ OFNHookProc(
*
*----------------------------------------------------------------------
*/
-static int
-MakeFilter(interp, string, dsPtr)
- Tcl_Interp *interp; /* Current interpreter. */
- char *string; /* String value of the -filetypes option */
- Tcl_DString *dsPtr; /* Filled with windows filter string. */
+
+static int
+MakeFilter(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Obj *valuePtr, /* Value of the -filetypes option */
+ Tcl_DString *dsPtr, /* Filled with windows filter string. */
+ Tcl_Obj *initialPtr, /* Initial type name */
+ int *index) /* Index of initial type in filter string */
{
char *filterStr;
char *p;
+ char *initial = NULL;
int pass;
+ int ix = 0; /* index counter */
FileFilterList flist;
FileFilter *filterPtr;
+ if (initialPtr) {
+ initial = Tcl_GetStringFromObj(initialPtr, NULL);
+ }
TkInitFileFilters(&flist);
- if (TkGetFileFilters(interp, &flist, string, 1) != TCL_OK) {
+ if (TkGetFileFilters(interp, &flist, valuePtr, 1) != TCL_OK) {
return TCL_ERROR;
}
@@ -1543,9 +1718,18 @@ MakeFilter(interp, string, dsPtr)
*p = '\0';
} else {
- /* We format the filetype into a string understood by Windows:
- * {"Text Documents" {.doc .txt} {TEXT}} becomes
- * "Text Documents (*.doc,*.txt)\0*.doc;*.txt\0"
+ int len;
+
+ if (valuePtr == NULL) {
+ len = 0;
+ } else {
+ (void) Tcl_GetStringFromObj(valuePtr, &len);
+ }
+
+ /*
+ * We format the filetype into a string understood by Windows: {"Text
+ * Documents" {.doc .txt} {TEXT}} becomes "Text Documents
+ * (*.doc,*.txt)\0*.doc;*.txt\0"
*
* See the Windows OPENFILENAME manual page for details on the filter
* string format.
@@ -1555,16 +1739,27 @@ MakeFilter(interp, string, dsPtr)
* Since we may only add asterisks (*) to the filter, we need at most
* twice the size of the string to format the filter
*/
- filterStr = ckalloc((unsigned int) strlen(string) * 3);
+
+ filterStr = ckalloc((unsigned int) len * 3);
for (filterPtr = flist.filters, p = filterStr; filterPtr;
- filterPtr = filterPtr->next) {
+ filterPtr = filterPtr->next) {
char *sep;
FileFilterClause *clausePtr;
/*
- * First, put in the name of the file type
+ * Check initial index for match, set index. Filter index is 1
+ * based so increment first
*/
+ ix++;
+ if (index && initial && (strcmp(initial, filterPtr->name) == 0)) {
+ *index = ix;
+ }
+
+ /*
+ * First, put in the name of the file type.
+ */
+
strcpy(p, filterPtr->name);
p+= strlen(filterPtr->name);
*p++ = ' ';
@@ -1572,24 +1767,24 @@ MakeFilter(interp, string, dsPtr)
for (pass = 1; pass <= 2; pass++) {
/*
- * In the first pass, we format the extensions in the
- * name field. In the second pass, we format the extensions in
- * the filter pattern field
+ * In the first pass, we format the extensions in the name
+ * field. In the second pass, we format the extensions in the
+ * filter pattern field
*/
+
sep = "";
for (clausePtr=filterPtr->clauses;clausePtr;
- clausePtr=clausePtr->next) {
+ clausePtr=clausePtr->next) {
GlobPattern *globPtr;
-
- for (globPtr=clausePtr->patterns; globPtr;
- globPtr=globPtr->next) {
+ for (globPtr = clausePtr->patterns; globPtr;
+ globPtr = globPtr->next) {
strcpy(p, sep);
- p+= strlen(sep);
+ p += strlen(sep);
strcpy(p, globPtr->pattern);
- p+= strlen(globPtr->pattern);
+ p += strlen(globPtr->pattern);
- if (pass==1) {
+ if (pass == 1) {
sep = ",";
} else {
sep = ";";
@@ -1597,11 +1792,9 @@ MakeFilter(interp, string, dsPtr)
}
}
if (pass == 1) {
- if (pass == 1) {
- *p ++ = ')';
- }
+ *p ++ = ')';
}
- *p ++ = '\0';
+ *p++ = '\0';
}
}
@@ -1609,6 +1802,7 @@ MakeFilter(interp, string, dsPtr)
* Windows requires the filter string to be ended by two NULL
* characters.
*/
+
*p++ = '\0';
*p = '\0';
}
@@ -1620,176 +1814,167 @@ MakeFilter(interp, string, dsPtr)
return TCL_OK;
}
-#ifdef USE_NEW_CHOOSEDIR
/*
*----------------------------------------------------------------------
*
* Tk_ChooseDirectoryObjCmd --
*
- * This procedure implements the "tk_chooseDirectory" dialog box
- * for the Windows platform. See the user documentation for details
- * on what it does. Uses the newer SHBrowseForFolder explorer type
- * interface.
+ * This function implements the "tk_chooseDirectory" dialog box for the
+ * Windows platform. See the user documentation for details on what it
+ * does. Uses the newer SHBrowseForFolder explorer type interface.
*
* Results:
- * See user documentation.
+ * See user documentation.
*
* Side effects:
- * A modal dialog window is created. Tcl_SetServiceMode() is
- * called to allow background events to be processed
+ * A modal dialog window is created. Tcl_SetServiceMode() is called to
+ * allow background events to be processed
*
*----------------------------------------------------------------------
-
-The procedure tk_chooseDirectory pops up a dialog box for the user to
-select a directory. The following option-value pairs are possible as
-command line arguments:
-
--initialdir dirname
-
-Specifies that the directories in directory 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 parameter specifies
-a relative path, the return value will convert the relative path to an
-absolute path. This option may not always work on the Macintosh. This is
-not a bug. Rather, the General Controls control panel on the Mac allows
-the end user to override the application default directory.
-
--parent window
-
-Makes window the logical parent of the dialog. The dialog is displayed on
-top of its parent window.
-
--title titleString
-
-Specifies a string to display as the title of the dialog box. If this
-option is not specified, then a default title will be displayed.
-
--mustexist boolean
-
-Specifies whether the user may specify non-existant directories. If this
-parameter is true, then the user may only select directories that already
-exist. The default value is false.
-
-New Behaviour:
-
-- If mustexist = 0 and a user entered folder does not exist, a prompt will
- pop-up asking if the user wants another chance to change it. The old
- dialog just returned the bogus entry. On mustexist = 1, the entries MUST
- exist before exiting the box with OK.
-
- Bugs:
-
-- If valid abs directory name is entered into the entry box and Enter
- pressed, the box will close returning the name. This is inconsistent when
- entering relative names or names with forward slashes, which are
- invalidated then corrected in the callback. After correction, the box is
- held open to allow further modification by the user.
-
-- Not sure how to implement localization of message prompts.
-
-- -title is really -message.
-ToDo:
-- Fix bugs.
-- test to see what platforms this really works on. May require v4.71
- of shell32.dll everywhere (what is standard?).
*
+ * The function tk_chooseDirectory pops up a dialog box for the user to select
+ * a directory. The following option-value pairs are possible as command line
+ * arguments:
+ *
+ * -initialdir dirname
+ *
+ * Specifies that the directories in directory 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 parameter specifies a
+ * relative path, the return value will convert the relative path to an
+ * absolute path. This option may not always work on the Macintosh. This is
+ * not a bug. Rather, the General Controls control panel on the Mac allows the
+ * end user to override the application default directory.
+ *
+ * -parent window
+ *
+ * Makes window the logical parent of the dialog. The dialog is displayed on
+ * top of its parent window.
+ *
+ * -title titleString
+ *
+ * Specifies a string to display as the title of the dialog box. If this
+ * option is not specified, then a default title will be displayed.
+ *
+ * -mustexist boolean
+ *
+ * Specifies whether the user may specify non-existant directories. If this
+ * parameter is true, then the user may only select directories that already
+ * exist. The default value is false.
+ *
+ * New Behaviour:
+ *
+ * - If mustexist = 0 and a user entered folder does not exist, a prompt will
+ * pop-up asking if the user wants another chance to change it. The old
+ * dialog just returned the bogus entry. On mustexist = 1, the entries MUST
+ * exist before exiting the box with OK.
+ *
+ * Bugs:
+ *
+ * - If valid abs directory name is entered into the entry box and Enter
+ * pressed, the box will close returning the name. This is inconsistent when
+ * entering relative names or names with forward slashes, which are
+ * invalidated then corrected in the callback. After correction, the box is
+ * held open to allow further modification by the user.
+ *
+ * - Not sure how to implement localization of message prompts.
+ *
+ * - -title is really -message.
+ *
+ *----------------------------------------------------------------------
*/
+
int
-Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Main window associated with interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tk_ChooseDirectoryObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
char path[MAX_PATH];
- int oldMode, result, i;
+ int oldMode, result = TCL_ERROR, i;
LPCITEMIDLIST pidl; /* Returned by browser */
BROWSEINFO bInfo; /* Used by browser */
CHOOSEDIRDATA cdCBData; /* Structure to pass back and forth */
LPMALLOC pMalloc; /* Used by shell */
-
- Tk_Window tkwin;
+ Tk_Window tkwin = (Tk_Window) clientData;
HWND hWnd;
- char *utfTitle; /* Title for window */
+ char *utfTitle = NULL;/* Title for window */
TCHAR saveDir[MAX_PATH];
Tcl_DString titleString; /* UTF Title */
Tcl_DString initDirString; /* Initial directory */
+ Tcl_Obj *objPtr;
static CONST char *optionStrings[] = {
- "-initialdir", "-mustexist", "-parent", "-title", (char *) NULL
+ "-initialdir", "-mustexist", "-parent", "-title", NULL
};
enum options {
- DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
+ DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
};
/*
* Initialize
*/
- result = TCL_ERROR;
- path[0] = '\0';
- utfTitle = NULL;
+ path[0] = '\0';
ZeroMemory(&cdCBData, sizeof(CHOOSEDIRDATA));
- cdCBData.interp = interp;
+ cdCBData.interp = interp;
- tkwin = (Tk_Window) clientData;
/*
* Process the command line options
*/
+
for (i = 1; i < objc; i += 2) {
- int index;
- char *string;
- 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_GetStringFromObj(optionPtr, NULL);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- (char *) NULL);
- goto cleanup;
- }
+ int index;
+ char *string;
+ 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;
+ }
string = Tcl_GetString(valuePtr);
- switch ((enum options) index) {
- case DIR_INITIAL: {
- if (Tcl_TranslateFileName(interp, string,
- &initDirString) == NULL) {
- goto cleanup;
- }
- string = Tcl_DStringValue(&initDirString);
- /*
- * Convert possible relative path to full path to keep
- * dialog happy
- */
- GetFullPathName(string, MAX_PATH, saveDir, NULL);
- lstrcpyn(cdCBData.utfInitDir, saveDir, MAX_PATH);
- Tcl_DStringFree(&initDirString);
- 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;
- }
- }
+ switch ((enum options) index) {
+ case DIR_INITIAL:
+ if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) {
+ goto cleanup;
+ }
+ string = Tcl_DStringValue(&initDirString);
+
+ /*
+ * Convert possible relative path to full path to keep dialog
+ * happy.
+ */
+
+ GetFullPathName(string, MAX_PATH, saveDir, NULL);
+ lstrcpyn(cdCBData.utfInitDir, saveDir, MAX_PATH);
+ Tcl_DStringFree(&initDirString);
+ 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;
+ }
}
/*
@@ -1803,44 +1988,66 @@ Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
* Setup the parameters used by SHBrowseForFolder
*/
- bInfo.hwndOwner = hWnd;
+ bInfo.hwndOwner = hWnd;
bInfo.pszDisplayName = path;
- bInfo.pidlRoot = NULL;
+ bInfo.pidlRoot = NULL;
if (lstrlen(cdCBData.utfInitDir) == 0) {
- GetCurrentDirectory(MAX_PATH, cdCBData.utfInitDir);
+ GetCurrentDirectory(MAX_PATH, cdCBData.utfInitDir);
}
bInfo.lParam = (LPARAM) &cdCBData;
if (utfTitle != NULL) {
- Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
- bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString);
+ Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
+ bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString);
} else {
- bInfo.lpszTitle = "Please choose a directory, then select OK.";
+ bInfo.lpszTitle = "Please choose a directory, then select OK.";
}
/*
- * Set flags to add edit box (needs 4.71 Shell DLLs), status text line,
- * validate edit box and
+ * Set flags to add edit box, status text line and use the new ui. Allow
+ * override with magic variable (ignore errors in retrieval). See
+ * http://msdn.microsoft.com/en-us/library/bb773205(VS.85).aspx for
+ * possible flag values.
*/
- bInfo.ulFlags = BIF_EDITBOX | BIF_STATUSTEXT | BIF_RETURNFSANCESTORS
- | BIF_VALIDATE;
+
+ bInfo.ulFlags = BIF_EDITBOX | BIF_STATUSTEXT | BIF_RETURNFSANCESTORS
+ | BIF_VALIDATE | BIF_NEWDIALOGSTYLE;
+ objPtr = Tcl_GetVar2Ex(interp, "::tk::winChooseDirFlags", NULL,
+ TCL_GLOBAL_ONLY);
+ if (objPtr != NULL) {
+ int flags;
+ Tcl_GetIntFromObj(NULL, objPtr, &flags);
+ bInfo.ulFlags = flags;
+ }
/*
* Callback to handle events
*/
- bInfo.lpfn = (BFFCALLBACK) ChooseDirectoryValidateProc;
+
+ bInfo.lpfn = (BFFCALLBACK) ChooseDirectoryValidateProc;
/*
- * Display dialog in background and process result.
- * We look to give the user a chance to change their mind
- * on an invalid folder if mustexist is 0;
+ * Display dialog in background and process result. We look to give the
+ * user a chance to change their mind on an invalid folder if mustexist is
+ * 0.
*/
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
GetCurrentDirectory(MAX_PATH, saveDir);
if (SHGetMalloc(&pMalloc) == NOERROR) {
pidl = SHBrowseForFolder(&bInfo);
- /* Null for cancel button or invalid dir, otherwise valid*/
+
+ /*
+ * This is a fix for Windows 2000, which seems to modify the folder name
+ * buffer even when the dialog is canceled (in this case the buffer
+ * contains garbage). See [Bug #3002230]
+ */
+ path[0] = '\0';
+
+ /*
+ * Null for cancel button or invalid dir, otherwise valid.
+ */
+
if (pidl != NULL) {
if (!SHGetPathFromIDList(pidl, path)) {
Tcl_SetResult(interp, "Error: Not a file system folder\n",
@@ -1856,38 +2063,34 @@ Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
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).
+ * 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).
*/
+
EnableWindow(hWnd, 1);
/*
- * Change the pathname to the Tcl "normalized" pathname, where
- * back slashes are used instead of forward slashes
+ * Change the pathname to the Tcl "normalized" pathname, where back
+ * slashes are used instead of forward slashes
*/
+
Tcl_ResetResult(interp);
if (*path) {
- char *p;
- Tcl_DString ds;
-
- Tcl_ExternalToUtfDString(NULL, (char *) path, -1, &ds);
- for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
- Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
- Tcl_DStringFree(&ds);
+ Tcl_DString ds;
+
+ Tcl_AppendResult(interp, ConvertExternalFilename(NULL, (char *) path,
+ &ds), NULL);
+ Tcl_DStringFree(&ds);
}
result = TCL_OK;
if (utfTitle != NULL) {
- Tcl_DStringFree(&titleString);
+ Tcl_DStringFree(&titleString);
}
- cleanup:
+ cleanup:
return result;
}
@@ -1896,658 +2099,213 @@ Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
*
* ChooseDirectoryValidateProc --
*
- * Hook procedure called by the explorer ChooseDirectory dialog when events
- * occur. It is used to validate the text entry the user may have entered.
+ * Hook function called by the explorer ChooseDirectory dialog when
+ * events occur. It is used to validate the text entry the user may have
+ * entered.
*
* Results:
- * Returns 0 to allow default processing of message, or 1 to
- * tell default dialog procedure not to close.
+ * Returns 0 to allow default processing of message, or 1 to tell default
+ * dialog function not to close.
*
*----------------------------------------------------------------------
*/
+
static UINT APIENTRY
-ChooseDirectoryValidateProc (
+ChooseDirectoryValidateProc(
HWND hwnd,
UINT message,
LPARAM lParam,
LPARAM lpData)
{
TCHAR selDir[MAX_PATH];
- CHOOSEDIRDATA *chooseDirSharedData;
+ CHOOSEDIRDATA *chooseDirSharedData = (CHOOSEDIRDATA *) lpData;
Tcl_DString initDirString;
char string[MAX_PATH];
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- chooseDirSharedData = (CHOOSEDIRDATA *)lpData;
-
-#ifdef _WIN64
- SetWindowLongPtr(hwnd, GWLP_USERDATA, lpData);
-#else
- SetWindowLong(hwnd, GWL_USERDATA, lpData);
-#endif
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (tsdPtr->debugFlag) {
- tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
+ tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
}
chooseDirSharedData->utfRetDir[0] = '\0';
switch (message) {
- case BFFM_VALIDATEFAILED:
- /*
- * First save and check to see if it is a valid path name, if
- * so then make that path the one shown in the
- * window. Otherwise, it failed the check and should be treated
- * as such. Use Set/GetCurrentDirectory which allows relative
- * path names and names with forward slashes. Use
- * Tcl_TranslateFileName to make sure names like ~ are
- * converted correctly.
- */
- Tcl_TranslateFileName(chooseDirSharedData->interp,
- (char *)lParam, &initDirString);
- lstrcpyn (string, Tcl_DStringValue(&initDirString), MAX_PATH);
- Tcl_DStringFree(&initDirString);
-
- if (SetCurrentDirectory((char *)string) == 0) {
- LPTSTR lpFilePart[MAX_PATH];
-
- /*
- * Get the full path name to the user entry,
- * at this point it doesn't exist so see if
- * it is supposed to. Otherwise just return it.
- */
- GetFullPathName(string, MAX_PATH,
- chooseDirSharedData->utfRetDir, /*unused*/ lpFilePart);
- if (chooseDirSharedData->mustExist) {
- /*
- * User HAS to select a valid directory.
- */
- wsprintf(selDir, TEXT("Directory '%.200s' does not exist,\nplease select or enter an existing directory."), chooseDirSharedData->utfRetDir);
- MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
- chooseDirSharedData->utfRetDir[0] = '\0';
- return 1;
- }
- } else {
- /*
- * Changed to new folder OK, return immediatly with the
- * current directory in utfRetDir.
- */
- GetCurrentDirectory(MAX_PATH, chooseDirSharedData->utfRetDir);
- return 0;
- }
- return 0;
-
- case BFFM_SELCHANGED:
- /*
- * Set the status window to the currently selected path.
- * And enable the OK button if a file system folder, otherwise
- * disable the OK button for things like server names.
- * perhaps a new switch -enablenonfolders can be used to allow
- * non folders to be selected.
- *
- * Not called when user changes edit box directly.
- */
-
- if (SHGetPathFromIDList((LPITEMIDLIST) lParam, selDir)) {
- SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir);
- // enable the OK button
- SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
- SetCurrentDirectory(selDir);
- } else {
- // disable the OK button
- SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0);
- }
- UpdateWindow(hwnd);
- return 1;
-
- case BFFM_INITIALIZED: {
- /*
- * Directory browser intializing - tell it where to start from,
- * user specified parameter.
- */
- char *initDir = chooseDirSharedData->utfInitDir;
-
- SetCurrentDirectory(initDir);
- if (*initDir == '\\') {
- /*
- * BFFM_SETSELECTION only understands UNC paths as pidls,
- * so convert path to pidl using IShellFolder interface.
- */
- LPMALLOC pMalloc;
- LPSHELLFOLDER psfFolder;
-
- if (SUCCEEDED(SHGetMalloc(&pMalloc))) {
- if (SUCCEEDED(SHGetDesktopFolder(&psfFolder))) {
- LPITEMIDLIST pidlMain;
- ULONG ulCount, ulAttr;
- Tcl_DString ds;
-
- Tcl_UtfToExternalDString(TkWinGetUnicodeEncoding(),
- initDir, -1, &ds);
- if (SUCCEEDED(psfFolder->lpVtbl->ParseDisplayName(
- psfFolder, hwnd, NULL,
- (WCHAR *) Tcl_DStringValue(&ds),
- &ulCount, &pidlMain, &ulAttr))
- && (pidlMain != NULL)) {
- SendMessage(hwnd, BFFM_SETSELECTION, FALSE,
- (LPARAM)pidlMain);
- pMalloc->lpVtbl->Free(pMalloc, pidlMain);
- }
- psfFolder->lpVtbl->Release(psfFolder);
- Tcl_DStringFree(&ds);
- }
- pMalloc->lpVtbl->Release(pMalloc);
- }
- } else {
- SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM)initDir);
- }
- SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
- break;
- }
-
- }
- return 0;
-}
-#else
-/*
- *----------------------------------------------------------------------
- *
- * Tk_ChooseDirectoryObjCmd --
- *
- * This procedure implements the "tk_chooseDirectory" dialog box
- * for the Windows platform. See the user documentation for details
- * on what it does.
- *
- * Results:
- * See user documentation.
- *
- * Side effects:
- * A modal dialog window is created. Tcl_SetServiceMode() is
- * called to allow background events to be processed
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Main window associated with interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- OPENFILENAME ofn;
- TCHAR path[MAX_PATH], savePath[MAX_PATH];
- ChooseDir cd;
- int result, mustExist, code, mode, i;
- Tk_Window tkwin;
- HWND hWnd;
- char *utfTitle;
- Tcl_DString utfDirString;
- Tcl_DString titleString, dirString;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- static CONST char *optionStrings[] = {
- "-initialdir", "-mustexist", "-parent", "-title",
- NULL
- };
- enum options {
- DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
- };
-
- if (tsdPtr->WM_LBSELCHANGED == 0) {
- tsdPtr->WM_LBSELCHANGED = RegisterWindowMessage(LBSELCHSTRING);
- }
-
- result = TCL_ERROR;
- path[0] = '\0';
-
- Tcl_DStringInit(&utfDirString);
- mustExist = 0;
- tkwin = (Tk_Window) clientData;
- utfTitle = NULL;
-
- for (i = 1; i < objc; i += 2) {
- int index;
- char *string;
- 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_GetStringFromObj(optionPtr, NULL);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- (char *) NULL);
- goto cleanup;
- }
-
- string = Tcl_GetStringFromObj(valuePtr, NULL);
- switch ((enum options) index) {
- case DIR_INITIAL: {
- Tcl_DStringFree(&utfDirString);
- if (Tcl_TranslateFileName(interp, string,
- &utfDirString) == NULL) {
- goto cleanup;
- }
- break;
- }
- case DIR_EXIST: {
- if (Tcl_GetBooleanFromObj(interp, valuePtr, &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;
- }
- }
- }
-
- Tk_MakeWindowExist(tkwin);
- hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
-
- cd.interp = interp;
- cd.ofnPtr = &ofn;
-
- ofn.lStructSize = sizeof(ofn);
- ofn.hwndOwner = hWnd;
-#ifdef _WIN64
- ofn.hInstance = (HINSTANCE) GetWindowLongPtr(ofn.hwndOwner,
- GWLP_HINSTANCE);
-#else
- ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
- GWL_HINSTANCE);
-#endif
- ofn.lpstrFilter = NULL;
- ofn.lpstrCustomFilter = NULL;
- ofn.nMaxCustFilter = 0;
- ofn.nFilterIndex = 0;
- ofn.lpstrFile = NULL; //(TCHAR *) path;
- ofn.nMaxFile = MAX_PATH;
- ofn.lpstrFileTitle = NULL;
- ofn.nMaxFileTitle = 0;
- ofn.lpstrInitialDir = NULL;
- ofn.lpstrTitle = NULL;
- ofn.Flags = OFN_HIDEREADONLY
- | OFN_ENABLEHOOK | OFN_ENABLETEMPLATE;
- ofn.nFileOffset = 0;
- ofn.nFileExtension = 0;
- ofn.lpstrDefExt = NULL;
- ofn.lCustData = (LPARAM) &cd;
- ofn.lpfnHook = (LPOFNHOOKPROC) ChooseDirectoryHookProc;
- ofn.lpTemplateName = MAKEINTRESOURCE(FILEOPENORD);
-
- if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
- Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
- Tcl_DStringLength(&utfDirString), &dirString);
- } else {
+ case BFFM_VALIDATEFAILED:
/*
- * NT 5.0 changed the meaning of lpstrInitialDir, so we have
- * to ensure that we set the [pwd] if the user didn't specify
- * anything else.
+ * First save and check to see if it is a valid path name, if so then
+ * make that path the one shown in the window. Otherwise, it failed
+ * the check and should be treated as such. Use
+ * Set/GetCurrentDirectory which allows relative path names and names
+ * with forward slashes. Use Tcl_TranslateFileName to make sure names
+ * like ~ are converted correctly.
*/
- Tcl_DString cwd;
- Tcl_DStringFree(&utfDirString);
- if ((Tcl_GetCwd(interp, &utfDirString) == (char *) NULL) ||
- (Tcl_TranslateFileName(interp,
- Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
- Tcl_ResetResult(interp);
- } else {
- Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
- Tcl_DStringLength(&cwd), &dirString);
- }
- Tcl_DStringFree(&cwd);
- }
- ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
-
- if (mustExist) {
- ofn.Flags |= OFN_PATHMUSTEXIST;
- }
- if (utfTitle != NULL) {
- Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
- ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
- }
-
- /*
- * Display dialog. The choose directory dialog doesn't preserve the
- * current directory, so it must be saved and restored here.
- */
-
- GetCurrentDirectory(MAX_PATH, savePath);
- mode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- code = GetOpenFileName(&ofn);
- Tcl_SetServiceMode(mode);
- SetCurrentDirectory(savePath);
-
- /*
- * 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).
- */
- EnableWindow(hWnd, 1);
-
- Tcl_ResetResult(interp);
- if (code != 0) {
- /*
- * Change the pathname to the Tcl "normalized" pathname, where
- * back slashes are used instead of forward slashes
- */
-
- char *p;
- Tcl_DString ds;
-
- Tcl_ExternalToUtfDString(NULL, (char *) cd.path, -1, &ds);
- for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
- Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
- Tcl_DStringFree(&ds);
- }
-
- if (ofn.lpstrTitle != NULL) {
- Tcl_DStringFree(&titleString);
- }
- if (ofn.lpstrInitialDir != NULL) {
- Tcl_DStringFree(&dirString);
- }
- result = TCL_OK;
-
- cleanup:
- Tcl_DStringFree(&utfDirString);
-
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ChooseDirectoryHookProc --
- *
- * Hook procedure called by the ChooseDirectory dialog to modify
- * its default behavior. The ChooseDirectory dialog is really an
- * OpenFile dialog with certain controls rearranged and certain
- * behaviors changed. For instance, typing a name in the
- * ChooseDirectory dialog selects a directory, rather than
- * selecting a file.
- *
- * Results:
- * Returns 0 to allow default processing of message, or 1 to
- * tell default dialog procedure not to process the message.
- *
- * Side effects:
- * A dialog window is created the first this procedure is called.
- * This window is not destroyed and will be reused the next time
- * the application invokes the "tk_getOpenFile" or
- * "tk_getSaveFile" command.
- *
- *----------------------------------------------------------------------
- */
-
-static UINT APIENTRY
-ChooseDirectoryHookProc(
- HWND hwnd,
- UINT message,
- WPARAM wParam,
- LPARAM lParam)
-{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- OPENFILENAME *ofnPtr;
- ChooseDir *cdPtr;
-
- if (message == WM_INITDIALOG) {
- ofnPtr = (OPENFILENAME *) lParam;
- cdPtr = (ChooseDir *) ofnPtr->lCustData;
- cdPtr->lastCtrl = 0;
- cdPtr->lastIdx = 1000;
- cdPtr->path[0] = '\0';
-#ifdef _WIN64
- SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) cdPtr);
-#else
- SetWindowLong(hwnd, GWL_USERDATA, (LONG) cdPtr);
-#endif
+ if (Tcl_TranslateFileName(chooseDirSharedData->interp,
+ (char *) lParam, &initDirString) == NULL) {
+ /*
+ * Should we expose the error (in the interp result) to the user
+ * at this point?
+ */
- if (ofnPtr->lpstrInitialDir == NULL) {
- GetCurrentDirectory(MAX_PATH, cdPtr->path);
- } else {
- lstrcpy(cdPtr->path, ofnPtr->lpstrInitialDir);
- }
- SetDlgItemText(hwnd, edt10, cdPtr->path);
- SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
- if (tsdPtr->debugFlag) {
- tsdPtr->debugInterp = cdPtr->interp;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
+ chooseDirSharedData->utfRetDir[0] = '\0';
+ return 1;
}
- return 0;
- }
-
- /*
- * GWL_USERDATA keeps track of cdPtr.
- */
-
-#ifdef _WIN64
- cdPtr = (ChooseDir *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
-#else
- cdPtr = (ChooseDir *) GetWindowLong(hwnd, GWL_USERDATA);
-#endif
- if (cdPtr == NULL) {
- return 0;
- }
- ofnPtr = cdPtr->ofnPtr;
+ lstrcpyn(string, Tcl_DStringValue(&initDirString), MAX_PATH);
+ Tcl_DStringFree(&initDirString);
- if (message == tsdPtr->WM_LBSELCHANGED) {
- /*
- * Called when double-clicking on directory.
- * If directory wasn't already open, browse that directory.
- * If directory was already open, return selected directory.
- */
+ if (SetCurrentDirectory((char *)string) == 0) {
+ LPTSTR lpFilePart[MAX_PATH];
- int idCtrl, thisItem;
+ /*
+ * Get the full path name to the user entry, at this point it does
+ * not exist so see if it is supposed to. Otherwise just return
+ * it.
+ */
- idCtrl = (int) wParam;
- thisItem = LOWORD(lParam);
+ GetFullPathName(string, MAX_PATH,
+ chooseDirSharedData->utfRetDir, /*unused*/ lpFilePart);
+ if (chooseDirSharedData->mustExist) {
+ /*
+ * User HAS to select a valid directory.
+ */
- GetCurrentDirectory(MAX_PATH, cdPtr->path);
- if (idCtrl == lst2) {
- if (cdPtr->lastIdx == thisItem) {
- EndDialog(hwnd, IDOK);
+ wsprintf(selDir, TEXT("Directory '%.200s' does not exist,\nplease select or enter an existing directory."), chooseDirSharedData->utfRetDir);
+ MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
+ chooseDirSharedData->utfRetDir[0] = '\0';
return 1;
}
- cdPtr->lastIdx = thisItem;
- }
- SetDlgItemText(hwnd, edt10, cdPtr->path);
- SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
- } else if (message == WM_COMMAND) {
- int idCtrl, notifyCode;
-
- idCtrl = LOWORD(wParam);
- notifyCode = HIWORD(wParam);
-
- if ((idCtrl != IDOK) || (notifyCode != BN_CLICKED)) {
+ } else {
/*
- * OK Button wasn't clicked. Do the default.
+ * Changed to new folder OK, return immediatly with the current
+ * directory in utfRetDir.
*/
- if ((idCtrl == lst2) || (idCtrl == edt10)) {
- cdPtr->lastCtrl = idCtrl;
- }
+ GetCurrentDirectory(MAX_PATH, chooseDirSharedData->utfRetDir);
return 0;
}
+ return 0;
+ case BFFM_SELCHANGED:
/*
- * Dialogs also get the message that OK was clicked when Enter
- * is pressed in some other control. Find out what window
- * we were really in when we got the supposed "OK", because the
- * behavior is different.
+ * Set the status window to the currently selected path and enable the
+ * OK button if a file system folder, otherwise disable the OK button
+ * for things like server names. Perhaps a new switch
+ * -enablenonfolders can be used to allow non folders to be selected.
+ *
+ * Not called when user changes edit box directly.
*/
- if (cdPtr->lastCtrl == edt10) {
- /*
- * Hit Enter or clicked OK while typing a directory name in the
- * edit control.
- * If it's a new name, try to go to that directory.
- * If the name hasn't changed since last time, return selected
- * directory.
- */
-
- int changed;
- TCHAR tmp[MAX_PATH];
-
- if (GetDlgItemText(hwnd, edt10, tmp, MAX_PATH) == 0) {
- return 0;
- }
-
- changed = lstrcmp(cdPtr->path, tmp);
- lstrcpy(cdPtr->path, tmp);
-
- if (SetCurrentDirectory(cdPtr->path) == 0) {
- /*
- * Non-existent directory.
- */
-
- if (ofnPtr->Flags & OFN_PATHMUSTEXIST) {
- /*
- * Directory must exist. Complain, then rehighlight text.
- */
-
- wsprintf(tmp, "Cannot change directory to \"%.200s\".",
- cdPtr->path);
- MessageBox(hwnd, tmp, NULL, MB_OK);
- SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
- return 0;
- }
- if (changed) {
- /*
- * Directory was invalid, but we want to keep displaying
- * this name. Don't update the listbox that displays the
- * current directory heirarchy, or it'll erase the name.
- */
-
- SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
- return 0;
- }
- }
- if (changed == 0) {
- /*
- * Name hasn't changed since the last time we hit return
- * or double-clicked on a directory, so return this.
- */
+ if (SHGetPathFromIDList((LPITEMIDLIST) lParam, selDir)) {
+ SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir);
+ // enable the OK button
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
+ } else {
+ // disable the OK button
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0);
+ }
+ UpdateWindow(hwnd);
+ return 1;
- EndDialog(hwnd, IDOK);
- return 1;
- }
-
- cdPtr->lastCtrl = IDOK;
+ case BFFM_INITIALIZED: {
+ /*
+ * Directory browser intializing - tell it where to start from, user
+ * specified parameter.
+ */
- /*
- * The following is the magic code, determined by running
- * Spy++ on some other directory chooser, that it takes to
- * get this dialog to update the listbox to display the
- * current directory.
- */
+ char *initDir = chooseDirSharedData->utfInitDir;
- SetDlgItemText(hwnd, edt1, cdPtr->path);
- SendMessage(hwnd, WM_COMMAND, (WPARAM) MAKELONG(cmb2, 0x8003),
- (LPARAM) GetDlgItem(hwnd, cmb2));
- return 0;
- } else if (idCtrl == lst2) {
+ SetCurrentDirectory(initDir);
+ if (*initDir == '\\') {
/*
- * Enter key was pressed while in listbox.
- * If it's a new directory, allow default behavior to open dir.
- * If the directory hasn't changed, return selected directory.
+ * BFFM_SETSELECTION only understands UNC paths as pidls, so
+ * convert path to pidl using IShellFolder interface.
*/
- int thisItem;
-
- thisItem = (int) SendDlgItemMessage(hwnd, lst2, LB_GETCURSEL, 0, 0);
- if (cdPtr->lastIdx == thisItem) {
- GetCurrentDirectory(MAX_PATH, cdPtr->path);
- EndDialog(hwnd, IDOK);
- return 1;
+ LPMALLOC pMalloc;
+ LPSHELLFOLDER psfFolder;
+
+ if (SUCCEEDED(SHGetMalloc(&pMalloc))) {
+ if (SUCCEEDED(SHGetDesktopFolder(&psfFolder))) {
+ LPITEMIDLIST pidlMain;
+ ULONG ulCount, ulAttr;
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(TkWinGetUnicodeEncoding(),
+ initDir, -1, &ds);
+ if (SUCCEEDED(psfFolder->lpVtbl->ParseDisplayName(
+ psfFolder, hwnd, NULL, (WCHAR *)
+ Tcl_DStringValue(&ds), &ulCount,&pidlMain,&ulAttr))
+ && (pidlMain != NULL)) {
+ SendMessage(hwnd, BFFM_SETSELECTION, FALSE,
+ (LPARAM) pidlMain);
+ pMalloc->lpVtbl->Free(pMalloc, pidlMain);
+ }
+ psfFolder->lpVtbl->Release(psfFolder);
+ Tcl_DStringFree(&ds);
+ }
+ pMalloc->lpVtbl->Release(pMalloc);
}
- } else if (idCtrl == IDOK) {
- /*
- * The OK button was clicked. Return the value currently selected
- * in the entry.
- */
-
- GetCurrentDirectory(MAX_PATH, cdPtr->path);
- EndDialog(hwnd, IDOK);
- return 1;
+ } else {
+ SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM) initDir);
}
+ SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
+ break;
+ }
+
}
return 0;
}
-#endif
/*
*----------------------------------------------------------------------
*
* Tk_MessageBoxObjCmd --
*
- * This procedure implements the MessageBox window for the
- * Windows platform. See the user documentation for details on what
- * it does.
+ * This function implements the MessageBox window for the Windows
+ * platform. See the user documentation for details on what it does.
*
* Results:
* See user documentation.
*
* Side effects:
- * None. The MessageBox window will be destroy before this procedure
+ * None. The MessageBox window will be destroy before this function
* returns.
*
*----------------------------------------------------------------------
*/
int
-Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Main window associated with interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tk_MessageBoxObjCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- Tk_Window tkwin, parent;
+ Tk_Window tkwin = (Tk_Window) clientData, parent;
HWND hWnd;
- char *message, *title;
+ Tcl_Obj *messageObj, *titleObj, *detailObj, *tmpObj;
int defaultBtn, icon, type;
int i, oldMode, winCode;
UINT flags;
- Tcl_DString messageString, titleString;
- Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
static CONST char *optionStrings[] = {
- "-default", "-icon", "-message", "-parent",
- "-title", "-type", NULL
+ "-default", "-detail", "-icon", "-message",
+ "-parent", "-title", "-type", NULL
};
enum options {
- MSG_DEFAULT, MSG_ICON, MSG_MESSAGE, MSG_PARENT,
- MSG_TITLE, MSG_TYPE
+ MSG_DEFAULT, MSG_DETAIL, MSG_ICON, MSG_MESSAGE,
+ MSG_PARENT, MSG_TITLE, MSG_TYPE
};
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-
- tkwin = (Tk_Window) clientData;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- defaultBtn = -1;
- icon = MB_ICONINFORMATION;
- message = NULL;
- parent = tkwin;
- title = NULL;
- type = MB_OK;
+ (void) TkWinGetUnicodeEncoding();
+ defaultBtn = -1;
+ detailObj = NULL;
+ icon = MB_ICONINFORMATION;
+ messageObj = NULL;
+ parent = tkwin;
+ titleObj = NULL;
+ type = MB_OK;
for (i = 1; i < objc; i += 2) {
int index;
@@ -2562,22 +2320,25 @@ Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
if (i + 1 == objc) {
- string = Tcl_GetStringFromObj(optionPtr, NULL);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- (char *) NULL);
+ string = Tcl_GetString(optionPtr);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ NULL);
return TCL_ERROR;
}
- string = Tcl_GetStringFromObj(valuePtr, NULL);
switch ((enum options) index) {
- case MSG_DEFAULT:
- defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap,
+ case MSG_DEFAULT:
+ defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap,
valuePtr);
if (defaultBtn < 0) {
return TCL_ERROR;
}
break;
+ case MSG_DETAIL:
+ detailObj = valuePtr;
+ break;
+
case MSG_ICON:
icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr);
if (icon < 0) {
@@ -2586,18 +2347,18 @@ Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
break;
case MSG_MESSAGE:
- message = string;
+ messageObj = valuePtr;
break;
- case MSG_PARENT:
- parent = Tk_NameToWindow(interp, string, tkwin);
+ case MSG_PARENT:
+ parent = Tk_NameToWindow(interp, Tcl_GetString(valuePtr), tkwin);
if (parent == NULL) {
return TCL_ERROR;
}
break;
case MSG_TITLE:
- title = string;
+ titleObj = valuePtr;
break;
case MSG_TYPE:
@@ -2606,19 +2367,20 @@ Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
break;
-
}
}
+ while (!Tk_IsTopLevel(parent)) {
+ parent = Tk_Parent(parent);
+ }
Tk_MakeWindowExist(parent);
hWnd = Tk_GetHWND(Tk_WindowId(parent));
-
+
flags = 0;
if (defaultBtn >= 0) {
- int defaultBtnIdx;
+ int defaultBtnIdx = -1;
- defaultBtnIdx = -1;
- for (i = 0; i < NUM_TYPES; i++) {
+ for (i = 0; i < (int) NUM_TYPES; i++) {
if (type == allowedTypes[i].type) {
int j;
@@ -2630,7 +2392,7 @@ Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
}
if (defaultBtnIdx < 0) {
Tcl_AppendResult(interp, "invalid default button \"",
- TkFindStateString(buttonMap, defaultBtn),
+ TkFindStateString(buttonMap, defaultBtn),
"\"", NULL);
return TCL_ERROR;
}
@@ -2640,82 +2402,140 @@ Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
flags = buttonFlagMap[defaultBtnIdx];
}
- flags |= icon | type | MB_SYSTEMMODAL;
+ flags |= icon | type | MB_TASKMODAL | MB_SETFOREGROUND;
- Tcl_UtfToExternalDString(unicodeEncoding, message, -1, &messageString);
- Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);
+ tmpObj = messageObj ? Tcl_DuplicateObj(messageObj)
+ : Tcl_NewUnicodeObj(NULL, 0);
+ Tcl_IncrRefCount(tmpObj);
+ if (detailObj) {
+ Tcl_AppendUnicodeToObj(tmpObj, L"\n\n", 2);
+ Tcl_AppendObjToObj(tmpObj, detailObj);
+ }
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
/*
- * MessageBoxW exists for all platforms. Use it to allow unicode
- * error message to be displayed correctly where possible by the OS.
+ * MessageBoxW exists for all platforms. Use it to allow unicode error
+ * message to be displayed correctly where possible by the OS.
*
- * In order to have the parent window icon reflected in a MessageBox,
- * we have to create a hook that will trigger when the MessageBox is
- * being created.
+ * In order to have the parent window icon reflected in a MessageBox, we
+ * have to create a hook that will trigger when the MessageBox is being
+ * created.
*/
+
tsdPtr->hSmallIcon = TkWinGetIcon(parent, ICON_SMALL);
tsdPtr->hBigIcon = TkWinGetIcon(parent, ICON_BIG);
tsdPtr->hMsgBoxHook = SetWindowsHookEx(WH_CBT, MsgBoxCBTProc, NULL,
GetCurrentThreadId());
- winCode = MessageBoxW(hWnd, (WCHAR *) Tcl_DStringValue(&messageString),
- (WCHAR *) Tcl_DStringValue(&titleString), flags);
+ winCode = MessageBoxW(hWnd, Tcl_GetUnicode(tmpObj),
+ titleObj ? Tcl_GetUnicode(titleObj) : L"", flags);
UnhookWindowsHookEx(tsdPtr->hMsgBoxHook);
(void) 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).
+ * 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).
*/
+
EnableWindow(hWnd, 1);
- Tcl_DStringFree(&messageString);
- Tcl_DStringFree(&titleString);
+ Tcl_DecrRefCount(tmpObj);
Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);
return TCL_OK;
}
-
+
static LRESULT CALLBACK
-MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam)
+MsgBoxCBTProc(
+ int nCode,
+ WPARAM wParam,
+ LPARAM lParam)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (nCode == HCBT_CREATEWND) {
/*
- * Window owned by our task is being created. Since the hook is
+ * Window owned by our task is being created. Since the hook is
* installed just before the MessageBox call and removed after the
- * MessageBox call, the window being created is either the message
- * box or one of its controls. Check that the class is WC_DIALOG
- * to ensure that it's the one we want.
+ * MessageBox call, the window being created is either the message box
+ * or one of its controls. Check that the class is WC_DIALOG to ensure
+ * that it's the one we want.
*/
- LPCBT_CREATEWND lpcbtcreate = (LPCBT_CREATEWND)lParam;
+
+ LPCBT_CREATEWND lpcbtcreate = (LPCBT_CREATEWND) lParam;
if (WC_DIALOG == lpcbtcreate->lpcs->lpszClass) {
HWND hwnd = (HWND) wParam;
+
SendMessage(hwnd, WM_SETICON, ICON_SMALL,
(LPARAM) tsdPtr->hSmallIcon);
- SendMessage(hwnd, WM_SETICON, ICON_BIG,
- (LPARAM) tsdPtr->hBigIcon);
+ SendMessage(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon);
}
}
/*
* Call the next hook proc, if there is one
*/
+
return CallNextHookEx(tsdPtr->hMsgBoxHook, nCode, wParam, lParam);
}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SetTkDialog --
+ *
+ * Records the HWND for a native dialog in the 'tk_dialog' variable so
+ * that the test-suite can operate on the correct dialog window. Use of
+ * this is enabled when a test program calls TkWinDialogDebug by calling
+ * the test command 'tkwinevent debug 1'.
+ *
+ * ----------------------------------------------------------------------
+ */
-static void
-SetTkDialog(ClientData clientData)
+static void
+SetTkDialog(
+ ClientData clientData)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
char buf[32];
sprintf(buf, "0x%p", (HWND) clientData);
Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
}
+
+/*
+ * Factored out a common pattern in use in this file.
+ */
+static char *
+ConvertExternalFilename(
+ Tcl_Encoding encoding,
+ char *filename,
+ Tcl_DString *dsPtr)
+{
+ char *p;
+
+ Tcl_ExternalToUtfDString(encoding, filename, -1, dsPtr);
+ for (p = Tcl_DStringValue(dsPtr); *p != '\0'; p++) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where back
+ * slashes are used instead of forward slashes
+ */
+
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ return Tcl_DStringValue(dsPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */