diff options
Diffstat (limited to 'win/tkWinDialog.c')
| -rw-r--r-- | win/tkWinDialog.c | 2787 |
1 files changed, 1301 insertions, 1486 deletions
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index 775d06b..4110848 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,55 +578,53 @@ 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; + 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)); 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 { @@ -611,122 +643,119 @@ GetFileNameW(clientData, interp, objc, objv, open) "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_DEFAULT: + if (string[0] == '.') { + string++; } - case FILE_INITDIR: { - Tcl_DStringFree(&utfDirString); - if (Tcl_TranslateFileName(interp, string, - &utfDirString) == NULL) { - goto end; - } - break; - } - 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; + 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, unicodeEncoding, 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)); 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 { 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) { @@ -738,6 +767,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, @@ -745,14 +775,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); @@ -783,10 +813,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); /* @@ -798,42 +829,43 @@ 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))) { 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; + + WCHAR *files = (WCHAR *) ofnData.dynFileBuffer; + Tcl_Obj *returnList = Tcl_NewObj(); int count = 0; - returnList = Tcl_NewObj(); - Tcl_IncrRefCount(returnList); + /* + * Get directory. + */ - files = ofn.lpstrFile; - Tcl_ExternalToUtfDString(unicodeEncoding, (char *) files, -1, &ds); - - /* 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') { @@ -841,90 +873,68 @@ 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)); + 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))); } 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); 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) && + 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(unicodeEncoding, + (char *) ofn.lpstrFile, &ds), "\"", NULL); + Tcl_DStringFree(&ds); + } else { + result = TCL_OK; } - + if (ofn.lpstrTitle != NULL) { Tcl_DStringFree(&titleString); } @@ -936,9 +946,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; } @@ -948,9 +962,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. @@ -961,45 +976,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, (int) buffer); + buffer += dirsize; + + SendMessageW(hdlg, CDM_GETSPEC, selsize, (int) 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; @@ -1021,54 +1118,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 { @@ -1083,124 +1178,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; @@ -1209,11 +1294,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) { @@ -1223,20 +1316,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); @@ -1269,10 +1363,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); /* @@ -1284,42 +1379,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') { @@ -1327,85 +1424,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) { @@ -1419,9 +1494,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; } @@ -1429,11 +1508,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. @@ -1444,48 +1524,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, (int) buffer); + buffer += dirsize; + SendMessage(hdlg, CDM_GETSPEC, selsize, (int) 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; @@ -1497,7 +1659,7 @@ OFNHookProc( * MakeFilter -- * * Allocate a buffer to store the filters in a format understood by - * Windows + * Windows. * * Results: * A standard TCL return value. @@ -1507,20 +1669,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; } @@ -1544,9 +1714,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. @@ -1556,16 +1735,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++ = ' '; @@ -1573,24 +1763,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 = ";"; @@ -1598,11 +1788,9 @@ MakeFilter(interp, string, dsPtr) } } if (pass == 1) { - if (pass == 1) { - *p ++ = ')'; - } + *p ++ = ')'; } - *p ++ = '\0'; + *p++ = '\0'; } } @@ -1610,6 +1798,7 @@ MakeFilter(interp, string, dsPtr) * Windows requires the filter string to be ended by two NULL * characters. */ + *p++ = '\0'; *p = '\0'; } @@ -1621,176 +1810,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; + } } /* @@ -1804,44 +1984,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", @@ -1857,38 +2059,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; } @@ -1897,658 +2095,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 { - /* - * 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) || - (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) { + case BFFM_VALIDATEFAILED: /* - * Change the pathname to the Tcl "normalized" pathname, where - * back slashes are used instead of forward slashes + * 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. */ - 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, _T("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; @@ -2563,22 +2316,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) { @@ -2587,18 +2343,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: @@ -2607,19 +2363,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; @@ -2631,7 +2388,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; } @@ -2641,82 +2398,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: + */ |