/*
* tkWinDialog.c --
*
* Contains the Windows implementation of the common dialog boxes.
*
* 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.
*
* RCS: @(#) $Id: tkWinDialog.c,v 1.77 2010/09/13 08:11:59 nijtmans Exp $
*
*/
/* TODO: This file does not compile in UNICODE mode.
* See [Freq 2965056]: Windows build with -DUNICODE
*/
#undef UNICODE
#undef _UNICODE
#include "tkWinInt.h"
#include "tkFileFilter.h"
#include "tkFont.h"
#include <commdlg.h> /* includes common dialog functionality */
#ifdef _MSC_VER
# pragma comment (lib, "comdlg32.lib")
#endif
#include <dlgs.h> /* includes common dialog template defines */
#include <cderr.h> /* includes the common dialog error codes */
#include <shlobj.h> /* includes SHBrowseForFolder */
#ifdef _MSC_VER
# pragma comment (lib, "shell32.lib")
#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 /* 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.
*/
typedef struct ChooseDirData {
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 */
} CHOOSEDIRDATA;
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.
*/
static const TkStateMap iconMap[] = {
{MB_ICONERROR, "error"},
{MB_ICONINFORMATION, "info"},
{MB_ICONQUESTION, "question"},
{MB_ICONWARNING, "warning"},
{-1, NULL}
};
static const TkStateMap typeMap[] = {
{MB_ABORTRETRYIGNORE, "abortretryignore"},
{MB_OK, "ok"},
{MB_OKCANCEL, "okcancel"},
{MB_RETRYCANCEL, "retrycancel"},
{MB_YESNO, "yesno"},
{MB_YESNOCANCEL, "yesnocancel"},
{-1, NULL}
};
static const TkStateMap buttonMap[] = {
{IDABORT, "abort"},
{IDRETRY, "retry"},
{IDIGNORE, "ignore"},
{IDOK, "ok"},
{IDCANCEL, "cancel"},
{IDNO, "no"},
{IDYES, "yes"},
{-1, NULL}
};
static const int buttonFlagMap[] = {
MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4
};
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}}
};
#define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0]))
/*
* 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 function, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.
*/
typedef struct ChooseDir {
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
* browser listbox. */
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
* selected. */
OPENFILENAME *ofnPtr; /* pointer to the OFN structure */
} ChooseDir;
/*
* 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.
*/
static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg,
LPARAM wParam, LPARAM lParam);
static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
LPARAM lParam);
static 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,
Tcl_Obj *const objv[], int isOpen);
static int MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr,
Tcl_DString *dsPtr, Tcl_Obj *initialPtr,
int *indexPtr);
static UINT APIENTRY OFNHookProcA(HWND hdlg, UINT uMsg, WPARAM wParam,
LPARAM lParam);
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
* 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.
*
* Side effects:
* Consumes an unwanted BUTTON messages.
*
*-------------------------------------------------------------------------
*/
static void
EatSpuriousMessageBugFix(void)
{
MSG msg;
DWORD nTime = GetTickCount() + 250;
while (GetTickCount() < nTime) {
if (PeekMessage(&msg, 0, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_NOREMOVE)){
break;
}
PeekMessage(&msg, 0, WM_LBUTTONUP, WM_LBUTTONUP, PM_REMOVE);
}
}
/*
*-------------------------------------------------------------------------
*
* 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
* send messages to the dialog.
*
* Results:
* None.
*
* Side effects:
* This variable only makes sense if just one dialog is up at a time.
*
*-------------------------------------------------------------------------
*/
void
TkWinDialogDebug(
int debug)
{
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
tsdPtr->debugFlag = debug;
}
/*
*-------------------------------------------------------------------------
*
* Tk_ChooseColorObjCmd --
*
* 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 function is called.
* This window is not destroyed and will be reused the next time the
* application invokes the "tk_chooseColor" command.
*
*-------------------------------------------------------------------------
*/
int
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 = clientData, parent;
HWND hWnd;
int i, oldMode, winCode, result;
CHOOSECOLOR chooseColor;
static int inited = 0;
static COLORREF dwCustColors[16];
static long oldColor; /* the color selected last time */
static const char *const optionStrings[] = {
"-initialcolor", "-parent", "-title", NULL
};
enum options {
COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
};
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.
*/
for (i = 0; i < 16; i++) {
dwCustColors[i] = RGB(255-i * 10, i, i * 10);
}
oldColor = RGB(0xa0, 0xa0, 0xa0);
inited = 1;
}
parent = tkwin;
chooseColor.lStructSize = sizeof(CHOOSECOLOR);
chooseColor.hwndOwner = NULL;
chooseColor.hInstance = NULL;
chooseColor.rgbResult = oldColor;
chooseColor.lpCustColors = dwCustColors;
chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
chooseColor.lCustData = (LPARAM) NULL;
chooseColor.lpfnHook = (LPOFNHOOKPROC) ColorDlgHookProc;
chooseColor.lpTemplateName = (LPTSTR) interp;
for (i = 1; i < objc; i += 2) {
int index;
const char *string;
Tcl_Obj *optionPtr, *valuePtr;
optionPtr = objv[i];
valuePtr = objv[i + 1];
if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (i + 1 == objc) {
string = Tcl_GetString(optionPtr);
Tcl_AppendResult(interp, "value for \"", string, "\" missing",
NULL);
return TCL_ERROR;
}
string = Tcl_GetString(valuePtr);
switch ((enum options) index) {
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;
case COLOR_TITLE:
chooseColor.lCustData = (LPARAM) string;
break;
}
}
Tk_MakeWindowExist(parent);
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).
*/
EnableWindow(hWnd, 1);
/*
* Clear the interp result since anything may have happened during the
* modal loop.
*/
Tcl_ResetResult(interp);
/*
* 3. Process the result of the dialog
*/
if (winCode) {
/*
* User has selected a color
*/
char color[100];
sprintf(color, "#%02x%02x%02x",
GetRValue(chooseColor.rgbResult),
GetGValue(chooseColor.rgbResult),
GetBValue(chooseColor.rgbResult));
Tcl_AppendResult(interp, color, NULL);
oldColor = chooseColor.rgbResult;
result = TCL_OK;
}
return result;
}
/*
*-------------------------------------------------------------------------
*
* ColorDlgHookProc --
*
* 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 function should handle
* the message, non-zero otherwise.
*
* Side effects:
* Changes the title of the dialog window.
*
*----------------------------------------------------------------------
*/
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 =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
const char *title;
CHOOSECOLOR *ccPtr;
if (WM_INITDIALOG == uMsg) {
/*
* Set the title string of the dialog.
*/
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, hDlg);
}
return TRUE;
}
return FALSE;
}
/*
*----------------------------------------------------------------------
*
* Tk_GetOpenFileCmd --
*
* 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 function is called.
*
*----------------------------------------------------------------------
*/
int
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);
} else {
return GetFileNameA(clientData, interp, objc, objv, 1);
}
}
/*
*----------------------------------------------------------------------
*
* Tk_GetSaveFileCmd --
*
* Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
* instead
*
* Results:
* Same as Tk_GetOpenFileCmd.
*
* Side effects:
* Same as Tk_GetOpenFileCmd.
*
*----------------------------------------------------------------------
*/
int
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);
} else {
return GetFileNameA(clientData, interp, objc, objv, 0);
}
}
/*
*----------------------------------------------------------------------
*
* GetFileNameW --
*
* Calls GetOpenFileName() or GetSaveFileName().
*
* Results:
* See user documentation.
*
* Side effects:
* See user documentation.
*
*----------------------------------------------------------------------
*/
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];
OFNData ofnData;
int cdlgerr;
int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0;
const char *extension = NULL, *filter = NULL, *title = NULL;
Tk_Window tkwin = clientData;
HWND hWnd;
Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
Tcl_DString utfFilterString, utfDirString, ds;
Tcl_DString extString, filterString, dirString, titleString;
Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
static const char *const saveOptionStrings[] = {
"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
"-parent", "-title", "-typevariable", NULL
};
static const char *const openOptionStrings[] = {
"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
"-multiple", "-parent", "-title", "-typevariable", NULL
};
const char *const *optionStrings;
enum options {
FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE
};
file[0] = '\0';
ZeroMemory(&ofnData, sizeof(OFNData));
Tcl_DStringInit(&utfFilterString);
Tcl_DStringInit(&utfDirString);
/*
* Parse the arguments.
*/
if (open) {
optionStrings = openOptionStrings;
} else {
optionStrings = saveOptionStrings;
}
for (i = 1; i < objc; i += 2) {
int index;
const 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 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.
*/
if (!open && index >= FILE_MULTIPLE) {
index++;
}
if (i + 1 == objc) {
string = Tcl_GetString(optionPtr);
Tcl_AppendResult(interp, "value for \"", string, "\" missing",
NULL);
goto end;
}
string = Tcl_GetString(valuePtr);
switch ((enum options) index) {
case FILE_DEFAULT:
if (string[0] == '.') {
string++;
}
extension = string;
break;
case FILE_TYPES:
filterObj = valuePtr;
break;
case FILE_INITDIR:
Tcl_DStringFree(&utfDirString);
if (Tcl_TranslateFileName(interp, string,
&utfDirString) == NULL) {
goto end;
}
break;
case FILE_INITFILE:
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);
Tcl_DStringFree(&ds);
break;
case FILE_MULTIPLE:
if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) {
return TCL_ERROR;
}
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 (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj,
&filterIndex) != TCL_OK) {
goto end;
}
filter = Tcl_DStringValue(&utfFilterString);
Tk_MakeWindowExist(tkwin);
hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
ZeroMemory(&ofn, sizeof(OPENFILENAMEW));
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.lpfnHook = (LPOFNHOOKPROC) OFNHookProcW;
ofn.lCustData = (LPARAM) &ofnData;
if (open != 0) {
ofn.Flags |= OFN_FILEMUSTEXIST;
} else {
ofn.Flags |= OFN_OVERWRITEPROMPT;
}
if (tsdPtr->debugFlag != 0) {
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) {
Tcl_UtfToExternalDString(unicodeEncoding, extension, -1, &extString);
ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString);
}
Tcl_UtfToExternalDString(unicodeEncoding,
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,
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) == NULL) ||
(Tcl_TranslateFileName(interp,
Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
Tcl_ResetResult(interp);
} else {
Tcl_UtfToExternalDString(unicodeEncoding, Tcl_DStringValue(&cwd),
Tcl_DStringLength(&cwd), &dirString);
}
Tcl_DStringFree(&cwd);
}
ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);
if (title != NULL) {
Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);
ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);
}
/*
* Popup the dialog.
*/
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
if (open != 0) {
winCode = GetOpenFileNameW(&ofn);
} else {
winCode = GetSaveFileNameW(&ofn);
}
Tcl_SetServiceMode(oldMode);
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).
*/
EnableWindow(hWnd, 1);
/*
* Clear the interp result since anything may have happened during the
* modal loop.
*/
Tcl_ResetResult(interp);
/*
* 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.
*/
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 dynFileBuffer contains many items, separated by
* NUL characters. It is terminated with two nulls in a row. The
* first element is the directory path.
*/
WCHAR *files = (WCHAR *) ofnData.dynFileBuffer;
Tcl_Obj *returnList = Tcl_NewObj();
int count = 0;
/*
* Get directory.
*/
(void) ConvertExternalFilename(unicodeEncoding, (char *) files,
&ds);
while (*files != '\0') {
while (*files != '\0') {
files++;
}
files++;
if (*files != '\0') {
Tcl_Obj *fullnameObj;
Tcl_DString filenameBuf;
count++;
(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(NULL, returnList,
Tcl_NewStringObj(Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds)));
}
Tcl_SetObjResult(interp, returnList);
Tcl_DStringFree(&ds);
} else {
Tcl_AppendResult(interp, ConvertExternalFilename(unicodeEncoding,
(char *) ofn.lpstrFile, &ds), NULL);
Tcl_DStringFree(&ds);
}
result = TCL_OK;
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;
}
}
} 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);
}
if (ofn.lpstrInitialDir != NULL) {
Tcl_DStringFree(&dirString);
}
Tcl_DStringFree(&filterString);
if (ofn.lpstrDefExt != NULL) {
Tcl_DStringFree(&extString);
}
end:
Tcl_DStringFree(&utfDirString);
Tcl_DStringFree(&utfFilterString);
if (ofnData.dynFileBuffer != NULL) {
ckfree(ofnData.dynFileBuffer);
ofnData.dynFileBuffer = NULL;
}
return result;
}
/*
*-------------------------------------------------------------------------
*
* OFNHookProcW --
*
* 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.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
static UINT APIENTRY
OFNHookProcW(
HWND hdlg, /* Handle to child dialog window. */
UINT uMsg, /* Message identifier */
WPARAM wParam, /* Message parameter */
LPARAM lParam) /* Message parameter */
{
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
OPENFILENAMEW *ofnPtr;
OFNData *ofnData;
if (uMsg == WM_INITDIALOG) {
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;
if (selsize > 1) {
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.
*/
ofnPtr = (OPENFILENAMEW *) TkWinGetUserData(hdlg);
if (ofnPtr != NULL) {
ofnData = (OFNData *) ofnPtr->lCustData;
if (ofnData->interp != NULL) {
hdlg = GetParent(hdlg);
tsdPtr->debugInterp = ofnData->interp;
Tcl_DoWhenIdle(SetTkDialog, hdlg);
}
TkWinSetUserData(hdlg, NULL);
}
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* GetFileNameA --
*
* Calls GetOpenFileName() or GetSaveFileName().
*
* Results:
* See user documentation.
*
* Side effects:
* See user documentation.
*
*----------------------------------------------------------------------
*/
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];
OFNData ofnData;
int cdlgerr;
int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0;
const char *extension = NULL, *filter = NULL, *title = NULL;
Tk_Window tkwin = clientData;
HWND hWnd;
Tcl_Obj *filterObj=NULL, *initialTypeObj=NULL, *typeVariableObj=NULL;
Tcl_DString utfFilterString, utfDirString, ds;
Tcl_DString extString, filterString, dirString, titleString;
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
static const char *const saveOptionStrings[] = {
"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
"-parent", "-title", "-typevariable", NULL
};
static const char *const openOptionStrings[] = {
"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
"-multiple", "-parent", "-title", "-typevariable", NULL
};
const char *const *optionStrings;
enum options {
FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE
};
file[0] = '\0';
ZeroMemory(&ofnData, sizeof(OFNData));
Tcl_DStringInit(&utfFilterString);
Tcl_DStringInit(&utfDirString);
/*
* Parse the arguments.
*/
if (open) {
optionStrings = openOptionStrings;
} else {
optionStrings = saveOptionStrings;
}
for (i = 1; i < objc; i += 2) {
int index;
const 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 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.
*/
if (!open && index >= FILE_MULTIPLE) {
index++;
}
if (i + 1 == objc) {
string = Tcl_GetString(optionPtr);
Tcl_AppendResult(interp, "value for \"", string, "\" missing",
NULL);
goto end;
}
string = Tcl_GetString(valuePtr);
switch ((enum options) index) {
case FILE_DEFAULT:
if (string[0] == '.') {
string++;
}
extension = string;
break;
case FILE_TYPES:
filterObj = valuePtr;
break;
case FILE_INITDIR:
Tcl_DStringFree(&utfDirString);
if (Tcl_TranslateFileName(interp, string, &utfDirString) == NULL) {
goto end;
}
break;
case FILE_INITFILE:
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);
Tcl_DStringFree(&ds);
break;
case FILE_MULTIPLE:
if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) {
return TCL_ERROR;
}
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 (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj,
&filterIndex) != TCL_OK) {
goto end;
}
filter = Tcl_DStringValue(&utfFilterString);
Tk_MakeWindowExist(tkwin);
hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
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;
} else {
ofn.Flags |= OFN_OVERWRITEPROMPT;
}
if (tsdPtr->debugFlag != 0) {
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) {
Tcl_UtfToExternalDString(NULL, extension, -1, &extString);
ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString);
}
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.
*/
Tcl_DString cwd;
Tcl_DStringFree(&utfDirString);
if ((Tcl_GetCwd(interp, &utfDirString) == 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 (title != NULL) {
Tcl_UtfToExternalDString(NULL, title, -1, &titleString);
ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
}
/*
* Popup the dialog.
*/
GetCurrentDirectory(MAX_PATH, savePath);
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
if (open != 0) {
winCode = GetOpenFileName(&ofn);
} else {
winCode = GetSaveFileName(&ofn);
}
Tcl_SetServiceMode(oldMode);
EatSpuriousMessageBugFix();
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);
/*
* Clear the interp result since anything may have happened during the
* modal loop.
*/
Tcl_ResetResult(interp);
/*
* 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)
|| ((cdlgerr == FNERR_BUFFERTOOSMALL)
&& (ofn.Flags & OFN_ALLOWMULTISELECT))) {
if (ofn.Flags & OFN_ALLOWMULTISELECT) {
/*
* 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 *files = ofnData.dynFileBuffer;
Tcl_Obj *returnList = Tcl_NewObj();
int count = 0;
/*
* Get directory.
*/
(void) ConvertExternalFilename(NULL, (char *) files, &ds);
while (*files != '\0') {
while (*files != '\0') {
files++;
}
files++;
if (*files != '\0') {
Tcl_Obj *fullnameObj;
Tcl_DString filename;
count++;
(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(NULL, returnList, Tcl_NewStringObj(
Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
}
Tcl_SetObjResult(interp, returnList);
Tcl_DStringFree(&ds);
} else {
Tcl_AppendResult(interp, ConvertExternalFilename(NULL,
(char *) ofn.lpstrFile, &ds), NULL);
Tcl_DStringFree(&ds);
}
result = TCL_OK;
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;
}
}
} 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) {
Tcl_DStringFree(&titleString);
}
if (ofn.lpstrInitialDir != NULL) {
Tcl_DStringFree(&dirString);
}
Tcl_DStringFree(&filterString);
if (ofn.lpstrDefExt != NULL) {
Tcl_DStringFree(&extString);
}
end:
Tcl_DStringFree(&utfDirString);
Tcl_DStringFree(&utfFilterString);
if (ofnData.dynFileBuffer != NULL) {
ckfree(ofnData.dynFileBuffer);
ofnData.dynFileBuffer = NULL;
}
return result;
}
/*
*-------------------------------------------------------------------------
*
* OFNHookProcA --
*
* 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.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
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 =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
OPENFILENAME *ofnPtr;
OFNData *ofnData;
if (uMsg == WM_INITDIALOG) {
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;
if (selsize > 1) {
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.
*/
ofnPtr = (OPENFILENAME *) TkWinGetUserData(hdlg);
if (ofnPtr != NULL) {
ofnData = (OFNData *) ofnPtr->lCustData;
if (ofnData->interp != NULL) {
if (ofnPtr->Flags & OFN_EXPLORER) {
hdlg = GetParent(hdlg);
}
tsdPtr->debugInterp = ofnData->interp;
Tcl_DoWhenIdle(SetTkDialog, hdlg);
}
TkWinSetUserData(hdlg, NULL);
}
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* MakeFilter --
*
* Allocate a buffer to store the filters in a format understood by
* Windows.
*
* Results:
* A standard TCL return value.
*
* Side effects:
* ofnPtr->lpstrFilter is modified.
*
*----------------------------------------------------------------------
*/
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 *indexPtr) /* Index of initial type in filter string */
{
char *filterStr;
char *p;
const char *initial = NULL;
int pass;
int ix = 0; /* index counter */
FileFilterList flist;
FileFilter *filterPtr;
if (initialPtr) {
initial = Tcl_GetStringFromObj(initialPtr, NULL);
}
TkInitFileFilters(&flist);
if (TkGetFileFilters(interp, &flist, valuePtr, 1) != TCL_OK) {
return TCL_ERROR;
}
if (flist.filters == NULL) {
/*
* Use "All Files (*.*) as the default filter if none is specified
*/
const char *defaultFilter = "All Files (*.*)";
p = filterStr = (char*)ckalloc(30 * sizeof(char));
strcpy(p, defaultFilter);
p+= strlen(defaultFilter);
*p++ = '\0';
*p++ = '*';
*p++ = '.';
*p++ = '*';
*p++ = '\0';
*p++ = '\0';
*p = '\0';
} else {
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.
*/
/*
* 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) len * 3);
for (filterPtr = flist.filters, p = filterStr; filterPtr;
filterPtr = filterPtr->next) {
const char *sep;
FileFilterClause *clausePtr;
/*
* Check initial index for match, set *indexPtr. Filter index is 1
* based so increment first
*/
ix++;
if (indexPtr && initial
&& (strcmp(initial, filterPtr->name) == 0)) {
*indexPtr = ix;
}
/*
* First, put in the name of the file type.
*/
strcpy(p, filterPtr->name);
p+= strlen(filterPtr->name);
*p++ = ' ';
*p++ = '(';
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
*/
sep = "";
for (clausePtr=filterPtr->clauses;clausePtr;
clausePtr=clausePtr->next) {
GlobPattern *globPtr;
for (globPtr = clausePtr->patterns; globPtr;
globPtr = globPtr->next) {
strcpy(p, sep);
p += strlen(sep);
strcpy(p, globPtr->pattern);
p += strlen(globPtr->pattern);
if (pass == 1) {
sep = ",";
} else {
sep = ";";
}
}
}
if (pass == 1) {
*p ++ = ')';
}
*p++ = '\0';
}
}
/*
* Windows requires the filter string to be ended by two NULL
* characters.
*/
*p++ = '\0';
*p = '\0';
}
Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr));
ckfree((char *) filterStr);
TkFreeFileFilters(&flist);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tk_ChooseDirectoryObjCmd --
*
* 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.
*
* Side effects:
* A modal dialog window is created. Tcl_SetServiceMode() is called to
* allow background events to be processed
*
*----------------------------------------------------------------------
*
* 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.
* ToDo:
* - Fix bugs.
* - test to see what platforms this really works on. May require v4.71 of
* shell32.dll everywhere (what is standard?).
*
*----------------------------------------------------------------------
*/
int
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 = 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 = clientData;
HWND hWnd;
const 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 *const optionStrings[] = {
"-initialdir", "-mustexist", "-parent", "-title", NULL
};
enum options {
DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
};
/*
* Initialize
*/
path[0] = '\0';
ZeroMemory(&cdCBData, sizeof(CHOOSEDIRDATA));
cdCBData.interp = interp;
/*
* Process the command line options
*/
for (i = 1; i < objc; i += 2) {
int index;
const 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;
}
}
/*
* Get ready to call the browser
*/
Tk_MakeWindowExist(tkwin);
hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
/*
* Setup the parameters used by SHBrowseForFolder
*/
bInfo.hwndOwner = hWnd;
bInfo.pszDisplayName = path;
bInfo.pidlRoot = NULL;
if (lstrlen(cdCBData.utfInitDir) == 0) {
GetCurrentDirectory(MAX_PATH, cdCBData.utfInitDir);
}
bInfo.lParam = (LPARAM) &cdCBData;
if (utfTitle != NULL) {
Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString);
} else {
bInfo.lpszTitle = "Please choose a directory, then select OK.";
}
/*
* 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 | 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;
/*
* 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);
/*
* 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",
TCL_VOLATILE);
};
pMalloc->lpVtbl->Free(pMalloc, (void *) pidl);
} else if (lstrlen(cdCBData.utfRetDir) > 0) {
lstrcpy(path, cdCBData.utfRetDir);
}
pMalloc->lpVtbl->Release(pMalloc);
}
SetCurrentDirectory(saveDir);
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).
*/
EnableWindow(hWnd, 1);
/*
* Change the pathname to the Tcl "normalized" pathname, where back
* slashes are used instead of forward slashes
*/
Tcl_ResetResult(interp);
if (*path) {
Tcl_DString ds;
Tcl_AppendResult(interp, ConvertExternalFilename(NULL, (char *) path,
&ds), NULL);
Tcl_DStringFree(&ds);
}
result = TCL_OK;
if (utfTitle != NULL) {
Tcl_DStringFree(&titleString);
}
cleanup:
return result;
}
/*
*----------------------------------------------------------------------
*
* ChooseDirectoryValidateProc --
*
* 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 function not to close.
*
*----------------------------------------------------------------------
*/
static UINT APIENTRY
ChooseDirectoryValidateProc(
HWND hwnd,
UINT message,
LPARAM lParam,
LPARAM lpData)
{
TCHAR selDir[MAX_PATH];
CHOOSEDIRDATA *chooseDirSharedData = (CHOOSEDIRDATA *) lpData;
Tcl_DString initDirString;
char string[MAX_PATH];
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (tsdPtr->debugFlag) {
tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp;
Tcl_DoWhenIdle(SetTkDialog, 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.
*/
if (Tcl_TranslateFileName(chooseDirSharedData->interp,
(char *) lParam, &initDirString) == NULL) {
/*
* Should we expose the error (in the interp result) to the user
* at this point?
*/
chooseDirSharedData->utfRetDir[0] = '\0';
return 1;
}
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 does
* not 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);
} 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;
}
/*
*----------------------------------------------------------------------
*
* Tk_MessageBoxObjCmd --
*
* 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 function
* returns.
*
*----------------------------------------------------------------------
*/
int
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 = clientData, parent;
HWND hWnd;
Tcl_Obj *messageObj, *titleObj, *detailObj, *tmpObj;
int defaultBtn, icon, type;
int i, oldMode, winCode;
UINT flags;
static const char *const optionStrings[] = {
"-default", "-detail", "-icon", "-message",
"-parent", "-title", "-type", NULL
};
enum options {
MSG_DEFAULT, MSG_DETAIL, MSG_ICON, MSG_MESSAGE,
MSG_PARENT, MSG_TITLE, MSG_TYPE
};
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
(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;
const char *string;
Tcl_Obj *optionPtr, *valuePtr;
optionPtr = objv[i];
valuePtr = objv[i + 1];
if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (i + 1 == objc) {
string = Tcl_GetString(optionPtr);
Tcl_AppendResult(interp, "value for \"", string, "\" missing",
NULL);
return TCL_ERROR;
}
switch ((enum options) index) {
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) {
return TCL_ERROR;
}
break;
case MSG_MESSAGE:
messageObj = valuePtr;
break;
case MSG_PARENT:
parent = Tk_NameToWindow(interp, Tcl_GetString(valuePtr), tkwin);
if (parent == NULL) {
return TCL_ERROR;
}
break;
case MSG_TITLE:
titleObj = valuePtr;
break;
case MSG_TYPE:
type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr);
if (type < 0) {
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 = -1;
for (i = 0; i < (int) NUM_TYPES; i++) {
if (type == allowedTypes[i].type) {
int j;
for (j = 0; j < 3; j++) {
if (allowedTypes[i].btnIds[j] == defaultBtn) {
defaultBtnIdx = j;
break;
}
}
if (defaultBtnIdx < 0) {
Tcl_AppendResult(interp, "invalid default button \"",
TkFindStateString(buttonMap, defaultBtn),
"\"", NULL);
return TCL_ERROR;
}
break;
}
}
flags = buttonFlagMap[defaultBtnIdx];
}
flags |= icon | type | MB_TASKMODAL | MB_SETFOREGROUND;
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.
*
* 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, 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).
*/
EnableWindow(hWnd, 1);
Tcl_DecrRefCount(tmpObj);
Tcl_SetResult(interp,
(char *)TkFindStateString(buttonMap, winCode), TCL_STATIC);
return TCL_OK;
}
static LRESULT CALLBACK
MsgBoxCBTProc(
int nCode,
WPARAM wParam,
LPARAM lParam)
{
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (nCode == HCBT_CREATEWND) {
/*
* 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.
*/
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);
}
}
/*
* 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)
{
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
char buf[32];
sprintf(buf, "0x%p", (HWND) clientData);
Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
}
/*
* 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);
}
/*
* ----------------------------------------------------------------------
*
* GetFontObj --
*
* Convert a windows LOGFONT into a Tk font description.
*
* Result:
* A list containing a Tk font description.
*
* ----------------------------------------------------------------------
*/
static Tcl_Obj *
GetFontObj(HDC hdc, LOGFONT *plf)
{
Tcl_Obj *resObj;
int pt = 0;
resObj = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, resObj,
Tcl_NewStringObj(plf->lfFaceName, -1));
pt = -MulDiv(plf->lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY));
Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewIntObj(pt));
if (plf->lfWeight >= 700) {
Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewStringObj("bold", -1));
}
if (plf->lfItalic) {
Tcl_ListObjAppendElement(NULL, resObj,
Tcl_NewStringObj("italic", -1));
}
if (plf->lfUnderline) {
Tcl_ListObjAppendElement(NULL, resObj,
Tcl_NewStringObj("underline", -1));
}
if (plf->lfStrikeOut) {
Tcl_ListObjAppendElement(NULL, resObj,
Tcl_NewStringObj("overstrike", -1));
}
return resObj;
}
static void
ApplyLogfont(Tcl_Interp *interp, Tcl_Obj *cmdObj, HDC hdc, LOGFONT *logfontPtr)
{
int objc;
Tcl_Obj **objv, **tmpv;
Tcl_ListObjGetElements(NULL, cmdObj, &objc, &objv);
tmpv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (objc + 2));
memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
tmpv[objc] = GetFontObj(hdc, logfontPtr);
TkBackgroundEvalObjv(interp, objc+1, tmpv, TCL_EVAL_GLOBAL);
ckfree((char *) tmpv);
}
/*
* ----------------------------------------------------------------------
*
* HookProc --
*
* Font selection hook. If the user selects Apply on the dialog, we call
* the applyProc script with the currently selected font as arguments.
*
* ----------------------------------------------------------------------
*/
typedef struct HookData {
Tcl_Interp *interp;
Tcl_Obj *titleObj;
Tcl_Obj *cmdObj;
Tcl_Obj *parentObj;
Tcl_Obj *fontObj;
HWND hwnd;
Tk_Window parent;
} HookData;
static UINT_PTR CALLBACK
HookProc(HWND hwndDlg, UINT msg, WPARAM wParam, LPARAM lParam)
{
CHOOSEFONT *pcf = (CHOOSEFONT *) lParam;
HWND hwndCtrl;
static HookData *phd = NULL;
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (WM_INITDIALOG == msg && lParam != 0) {
phd = (HookData *) pcf->lCustData;
phd->hwnd = hwndDlg;
if (tsdPtr->debugFlag) {
tsdPtr->debugInterp = (Tcl_Interp *) phd->interp;
Tcl_DoWhenIdle(SetTkDialog, hwndDlg);
}
if (phd->titleObj != NULL) {
Tcl_DString title;
Tcl_WinUtfToTChar(Tcl_GetString(phd->titleObj), -1, &title);
if (Tcl_DStringLength(&title) > 0) {
tkWinProcs->setWindowText(hwndDlg,
(LPCTSTR) Tcl_DStringValue(&title));
}
Tcl_DStringFree(&title);
}
/*
* Disable the colour combobox (0x473) and its label (0x443).
*/
hwndCtrl = GetDlgItem(hwndDlg, 0x443);
if (IsWindow(hwndCtrl)) {
EnableWindow(hwndCtrl, FALSE);
}
hwndCtrl = GetDlgItem(hwndDlg, 0x473);
if (IsWindow(hwndCtrl)) {
EnableWindow(hwndCtrl, FALSE);
}
TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
return 1; /* we handled the message */
}
if (WM_DESTROY == msg) {
phd->hwnd = NULL;
TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
return 0;
}
/*
* Handle apply button by calling the provided command script as a
* background evaluation (ie: errors dont come back here).
*/
if (WM_COMMAND == msg && LOWORD(wParam) == 1026) {
LOGFONT lf = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {0, 0}};
HDC hdc = GetDC(hwndDlg);
SendMessage(hwndDlg, WM_CHOOSEFONT_GETLOGFONT, 0, (LPARAM) &lf);
if (phd && phd->cmdObj) {
ApplyLogfont(phd->interp, phd->cmdObj, hdc, &lf);
}
if (phd && phd->parent) {
TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged");
}
return 1;
}
return 0; /* pass on for default processing */
}
/*
* Helper for the FontchooserConfigure command to return the current value of
* any of the options (which may be NULL in the structure)
*/
enum FontchooserOption {
FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd,
FontchooserVisible
};
static Tcl_Obj *
FontchooserCget(HookData *hdPtr, int optionIndex)
{
Tcl_Obj *resObj = NULL;
switch(optionIndex) {
case FontchooserParent:
if (hdPtr->parentObj) {
resObj = hdPtr->parentObj;
} else {
resObj = Tcl_NewStringObj(".", 1);
}
break;
case FontchooserTitle:
if (hdPtr->titleObj) {
resObj = hdPtr->titleObj;
} else {
resObj = Tcl_NewStringObj("", 0);
}
break;
case FontchooserFont:
if (hdPtr->fontObj) {
resObj = hdPtr->fontObj;
} else {
resObj = Tcl_NewStringObj("", 0);
}
break;
case FontchooserCmd:
if (hdPtr->cmdObj) {
resObj = hdPtr->cmdObj;
} else {
resObj = Tcl_NewStringObj("", 0);
}
break;
case FontchooserVisible:
resObj = Tcl_NewBooleanObj(hdPtr->hwnd && IsWindow(hdPtr->hwnd));
break;
default:
resObj = Tcl_NewStringObj("", 0);
}
return resObj;
}
/*
* ----------------------------------------------------------------------
*
* FontchooserConfigureCmd --
*
* Implementation of the 'tk fontchooser configure' ensemble command. See
* the user documentation for what it does.
*
* Results:
* See the user documentation.
*
* Side effects:
* Per-interp data structure may be modified
*
* ----------------------------------------------------------------------
*/
static int
FontchooserConfigureCmd(
ClientData clientData, /* Main window */
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Tk_Window tkwin = clientData;
HookData *hdPtr = NULL;
int i, r = TCL_OK;
static const char *const optionStrings[] = {
"-parent", "-title", "-font", "-command", "-visible", NULL
};
hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
/*
* With no arguments we return all the options in a dict.
*/
if (objc == 1) {
Tcl_Obj *keyObj, *valueObj;
Tcl_Obj *dictObj = Tcl_NewDictObj();
for (i = 0; r == TCL_OK && optionStrings[i] != NULL; ++i) {
keyObj = Tcl_NewStringObj(optionStrings[i], -1);
valueObj = FontchooserCget(hdPtr, i);
r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj);
}
if (r == TCL_OK) {
Tcl_SetObjResult(interp, dictObj);
}
return r;
}
for (i = 1; i < objc; i += 2) {
int optionIndex, len;
if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings,
"option", 0, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 2) {
/*
* If one option and no arg - return the current value.
*/
Tcl_SetObjResult(interp, FontchooserCget(hdPtr, optionIndex));
return TCL_OK;
}
if (i + 1 == objc) {
Tcl_AppendResult(interp, "value for \"",
Tcl_GetString(objv[i]), "\" missing", NULL);
return TCL_ERROR;
}
switch (optionIndex) {
case FontchooserVisible: {
const char *msg = "cannot change read-only option "
"\"-visible\": use the show or hide command";
Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
return TCL_ERROR;
}
case FontchooserParent: {
Tk_Window parent = Tk_NameToWindow(interp,
Tcl_GetString(objv[i+1]), tkwin);
if (parent == None) {
return TCL_ERROR;
}
if (hdPtr->parentObj) {
Tcl_DecrRefCount(hdPtr->parentObj);
}
hdPtr->parentObj = objv[i+1];
if (Tcl_IsShared(hdPtr->parentObj)) {
hdPtr->parentObj = Tcl_DuplicateObj(hdPtr->parentObj);
}
Tcl_IncrRefCount(hdPtr->parentObj);
break;
}
case FontchooserTitle:
if (hdPtr->titleObj) {
Tcl_DecrRefCount(hdPtr->titleObj);
}
hdPtr->titleObj = objv[i+1];
if (Tcl_IsShared(hdPtr->titleObj)) {
hdPtr->titleObj = Tcl_DuplicateObj(hdPtr->titleObj);
}
Tcl_IncrRefCount(hdPtr->titleObj);
break;
case FontchooserFont:
if (hdPtr->fontObj) {
Tcl_DecrRefCount(hdPtr->fontObj);
}
Tcl_GetStringFromObj(objv[i+1], &len);
if (len) {
hdPtr->fontObj = objv[i+1];
if (Tcl_IsShared(hdPtr->fontObj)) {
hdPtr->fontObj = Tcl_DuplicateObj(hdPtr->fontObj);
}
Tcl_IncrRefCount(hdPtr->fontObj);
} else {
hdPtr->fontObj = NULL;
}
break;
case FontchooserCmd:
if (hdPtr->cmdObj) {
Tcl_DecrRefCount(hdPtr->cmdObj);
}
Tcl_GetStringFromObj(objv[i+1], &len);
if (len) {
hdPtr->cmdObj = objv[i+1];
if (Tcl_IsShared(hdPtr->cmdObj)) {
hdPtr->cmdObj = Tcl_DuplicateObj(hdPtr->cmdObj);
}
Tcl_IncrRefCount(hdPtr->cmdObj);
} else {
hdPtr->cmdObj = NULL;
}
break;
}
}
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* FontchooserShowCmd --
*
* Implements the 'tk fontchooser show' ensemble command. The per-interp
* configuration data for the dialog is held in an interp associated
* structure.
*
* Calls the Win32 FontChooser API which provides a modal dialog. See
* HookProc where we make a few changes to the dialog and set some
* additional state.
*
* ----------------------------------------------------------------------
*/
static int
FontchooserShowCmd(
ClientData clientData, /* Main window */
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Tk_Window tkwin = clientData, parent;
CHOOSEFONT cf;
LOGFONT lf;
HDC hdc;
HookData *hdPtr;
int r = TCL_OK, oldMode = 0;
hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
parent = tkwin;
if (hdPtr->parentObj) {
parent = Tk_NameToWindow(interp, Tcl_GetString(hdPtr->parentObj),
tkwin);
if (parent == None) {
return TCL_ERROR;
}
}
Tk_MakeWindowExist(parent);
ZeroMemory(&cf, sizeof(CHOOSEFONT));
ZeroMemory(&lf, sizeof(LOGFONT));
lf.lfCharSet = DEFAULT_CHARSET;
cf.lStructSize = sizeof(CHOOSEFONT);
cf.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
cf.lpLogFont = &lf;
cf.nFontType = SCREEN_FONTTYPE;
cf.Flags = CF_SCREENFONTS | CF_EFFECTS | CF_ENABLEHOOK;
cf.rgbColors = RGB(0,0,0);
cf.lpfnHook = HookProc;
cf.lCustData = (INT_PTR) hdPtr;
hdPtr->interp = interp;
hdPtr->parent = parent;
hdc = GetDC(cf.hwndOwner);
if (hdPtr->fontObj != NULL) {
TkFont *fontPtr;
Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, hdPtr->fontObj);
if (f == NULL) {
return TCL_ERROR;
}
fontPtr = (TkFont *) f;
cf.Flags |= CF_INITTOLOGFONTSTRUCT;
strncpy(lf.lfFaceName, Tk_GetUid(fontPtr->fa.family), LF_FACESIZE-1);
lf.lfFaceName[LF_FACESIZE-1] = 0;
lf.lfHeight = -MulDiv(TkFontGetPoints(tkwin, fontPtr->fa.size),
GetDeviceCaps(hdc, LOGPIXELSY), 72);
if (fontPtr->fa.weight == TK_FW_BOLD) {
lf.lfWeight = FW_BOLD;
}
if (fontPtr->fa.slant != TK_FS_ROMAN) {
lf.lfItalic = TRUE;
}
if (fontPtr->fa.underline) {
lf.lfUnderline = TRUE;
}
if (fontPtr->fa.overstrike) {
lf.lfStrikeOut = TRUE;
}
Tk_FreeFont(f);
}
if (TCL_OK == r && hdPtr->cmdObj != NULL) {
int len = 0;
r = Tcl_ListObjLength(interp, hdPtr->cmdObj, &len);
if (len > 0) {
cf.Flags |= CF_APPLY;
}
}
if (TCL_OK == r) {
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
if (ChooseFont(&cf)) {
if (hdPtr->cmdObj) {
ApplyLogfont(hdPtr->interp, hdPtr->cmdObj, hdc, &lf);
}
if (hdPtr->parent) {
TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged");
}
}
Tcl_SetServiceMode(oldMode);
EnableWindow(cf.hwndOwner, 1);
}
ReleaseDC(cf.hwndOwner, hdc);
return r;
}
/*
* ----------------------------------------------------------------------
*
* FontchooserHideCmd --
*
* Implementation of the 'tk fontchooser hide' ensemble. See the user
* documentation for details.
* As the Win32 FontChooser function is always modal all we do here is
* destroy the dialog
*
* ----------------------------------------------------------------------
*/
static int
FontchooserHideCmd(
ClientData clientData, /* Main window */
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
HookData *hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
if (hdPtr->hwnd && IsWindow(hdPtr->hwnd)) {
EndDialog(hdPtr->hwnd, 0);
}
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* DeleteHookData --
*
* Clean up the font chooser configuration data when the interp is
* destroyed.
*
* ----------------------------------------------------------------------
*/
static void
DeleteHookData(ClientData clientData, Tcl_Interp *interp)
{
HookData *hdPtr = clientData;
if (hdPtr->parentObj) {
Tcl_DecrRefCount(hdPtr->parentObj);
}
if (hdPtr->fontObj) {
Tcl_DecrRefCount(hdPtr->fontObj);
}
if (hdPtr->titleObj) {
Tcl_DecrRefCount(hdPtr->titleObj);
}
if (hdPtr->cmdObj) {
Tcl_DecrRefCount(hdPtr->cmdObj);
}
ckfree((char *) hdPtr);
}
/*
* ----------------------------------------------------------------------
*
* TkInitFontchooser --
*
* Associate the font chooser configuration data with the Tcl
* interpreter. There is one font chooser per interp.
*
* ----------------------------------------------------------------------
*/
MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[];
const TkEnsemble tkFontchooserEnsemble[] = {
{ "configure", FontchooserConfigureCmd, NULL },
{ "show", FontchooserShowCmd, NULL },
{ "hide", FontchooserHideCmd, NULL },
{ NULL, NULL, NULL }
};
int
TkInitFontchooser(Tcl_Interp *interp, ClientData clientData)
{
HookData *hdPtr = (HookData *) ckalloc(sizeof(HookData));
memset(hdPtr, 0, sizeof(HookData));
Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteHookData, hdPtr);
return TCL_OK;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/