summaryrefslogtreecommitdiffstats
path: root/win/tkWinDialog.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tkWinDialog.c')
-rw-r--r--win/tkWinDialog.c1557
1 files changed, 790 insertions, 767 deletions
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 069991b..35d07d1 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -9,10 +9,9 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#define WINVER 0x0500 /* Requires Windows 2K definitions */
-#define _WIN32_WINNT 0x0500
#include "tkWinInt.h"
#include "tkFileFilter.h"
+#include "tkFont.h"
#include <commdlg.h> /* includes common dialog functionality */
#ifdef _MSC_VER
@@ -53,12 +52,12 @@
/*
* The following structure is used by the new Tk_ChooseDirectoryObjCmd to pass
- * data between it and its callback. Unqiue to Winodws platform.
+ * data between it and its callback. Unique to Windows platform.
*/
typedef struct ChooseDirData {
- TCHAR utfInitDir[MAX_PATH]; /* Initial folder to use */
- TCHAR utfRetDir[MAX_PATH]; /* Returned folder to use */
+ TCHAR initDir[MAX_PATH]; /* Initial folder to use */
+ TCHAR retDir[MAX_PATH]; /* Returned folder to use */
Tcl_Interp *interp;
int mustExist; /* True if file must exist to return from
* callback */
@@ -139,7 +138,7 @@ static const struct {int type; int btnIds[3];} allowedTypes[] = {
SetWindowLongPtr((to), GWLP_USERDATA, (LPARAM)(what))
/*
- * The value of TK_MULTI_MAX_PATH dictactes how many files can be retrieved
+ * The value of TK_MULTI_MAX_PATH dictates 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
*
@@ -163,7 +162,7 @@ typedef struct ChooseDir {
* directory or return. */
int lastIdx; /* Last item that was selected in directory
* browser listbox. */
- TCHAR path[MAX_PATH]; /* On return from choose directory dialog,
+ char 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
@@ -173,8 +172,8 @@ typedef struct ChooseDir {
} ChooseDir;
/*
- * The following structure is used to pass information between GetFileName/W
- * functions and OFN dialog hook procedures. [Bug 2896501, Patch 2898255]
+ * The following structure is used to pass information between GetFileName
+ * function and OFN dialog hook procedures. [Bug 2896501, Patch 2898255]
*/
typedef struct OFNData {
@@ -183,8 +182,7 @@ typedef struct OFNData {
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 */
+ TCHAR *dynFileBuffer; /* Dynamic filename buffer */
} OFNData;
/*
@@ -195,23 +193,18 @@ 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,
+static int GetFileName(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);
+ Tcl_Obj *const objv[], int isOpen);
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,
+ int *indexPtr);
+static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
LPARAM lParam);
static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam);
static void SetTkDialog(ClientData clientData);
-static char * ConvertExternalFilename(Tcl_Encoding encoding,
- char *filename, Tcl_DString *dsPtr);
+static const char *ConvertExternalFilename(TCHAR *filename,
+ Tcl_DString *dsPtr);
/*
*-------------------------------------------------------------------------
@@ -252,10 +245,10 @@ EatSpuriousMessageBugFix(void)
DWORD nTime = GetTickCount() + 250;
while (GetTickCount() < nTime) {
- if (PeekMessage(&msg, 0, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_NOREMOVE)){
+ if (PeekMessageA(&msg, 0, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_NOREMOVE)){
break;
}
- PeekMessage(&msg, 0, WM_LBUTTONUP, WM_LBUTTONUP, PM_REMOVE);
+ PeekMessageA(&msg, 0, WM_LBUTTONUP, WM_LBUTTONUP, PM_REMOVE);
}
}
@@ -282,7 +275,7 @@ void
TkWinDialogDebug(
int debug)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
tsdPtr->debugFlag = debug;
@@ -312,16 +305,16 @@ 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. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData, parent;
+ Tk_Window tkwin = clientData, parent;
HWND hWnd;
int i, oldMode, winCode, result;
CHOOSECOLOR chooseColor;
static int inited = 0;
static COLORREF dwCustColors[16];
static long oldColor; /* the color selected last time */
- static CONST char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"-initialcolor", "-parent", "-title", NULL
};
enum options {
@@ -357,20 +350,20 @@ Tk_ChooseColorObjCmd(
for (i = 1; i < objc; i += 2) {
int index;
- char *string;
+ 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) {
+ if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", NULL);
return TCL_ERROR;
}
@@ -431,13 +424,11 @@ Tk_ChooseColorObjCmd(
/*
* User has selected a color
*/
- char color[100];
- sprintf(color, "#%02x%02x%02x",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%02x%02x%02x",
GetRValue(chooseColor.rgbResult),
GetGValue(chooseColor.rgbResult),
- GetBValue(chooseColor.rgbResult));
- Tcl_AppendResult(interp, color, NULL);
+ GetBValue(chooseColor.rgbResult)));
oldColor = chooseColor.rgbResult;
result = TCL_OK;
}
@@ -470,7 +461,7 @@ ColorDlgHookProc(
WPARAM wParam, /* First message parameter. */
LPARAM lParam) /* Second message parameter. */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
const char *title;
CHOOSECOLOR *ccPtr;
@@ -487,13 +478,12 @@ ColorDlgHookProc(
if ((title != NULL) && (title[0] != '\0')) {
Tcl_DString ds;
- (*tkWinProcs->setWindowText)(hDlg,
- Tcl_WinUtfToTChar(title, -1, &ds));
+ SetWindowText(hDlg, Tcl_WinUtfToTChar(title,-1,&ds));
Tcl_DStringFree(&ds);
}
if (tsdPtr->debugFlag) {
tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
+ Tcl_DoWhenIdle(SetTkDialog, hDlg);
}
return TRUE;
}
@@ -522,13 +512,9 @@ 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. */
+ 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);
- }
+ return GetFileName(clientData, interp, objc, objv, 1);
}
/*
@@ -553,19 +539,15 @@ 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. */
+ 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);
- }
+ return GetFileName(clientData, interp, objc, objv, 0);
}
/*
*----------------------------------------------------------------------
*
- * GetFileNameW --
+ * GetFileName --
*
* Calls GetOpenFileName() or GetSaveFileName().
*
@@ -579,38 +561,37 @@ Tk_GetSaveFileObjCmd(
*/
static int
-GetFileNameW(
+GetFileName(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[], /* Argument objects. */
+ Tcl_Obj *const objv[], /* Argument objects. */
int open) /* 1 to call GetOpenFileName(), 0 to call
* GetSaveFileName(). */
{
- OPENFILENAMEW ofn;
- WCHAR file[TK_MULTI_MAX_PATH];
+ OPENFILENAME ofn;
+ TCHAR file[TK_MULTI_MAX_PATH];
OFNData ofnData;
int cdlgerr;
int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0;
int confirmOverwrite = 1;
- char *extension = NULL, *title = NULL;
- Tk_Window tkwin = (Tk_Window) clientData;
+ const char *extension = NULL, *title = NULL;
+ Tk_Window tkwin = clientData;
HWND hWnd;
Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
Tcl_DString utfFilterString, utfDirString, ds;
Tcl_DString extString, filterString, dirString, titleString;
- Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding();
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
enum options {
FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_PARENT,
FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW
};
struct Options {
- CONST char *name;
+ const char *name;
enum options value;
};
- static CONST struct Options saveOptions[] = {
+ static const struct Options saveOptions[] = {
{"-confirmoverwrite", FILE_CONFIRMOW},
{"-defaultextension", FILE_DEFAULT},
{"-filetypes", FILE_TYPES},
@@ -621,7 +602,7 @@ GetFileNameW(
{"-typevariable", FILE_TYPEVARIABLE},
{NULL, FILE_DEFAULT/*ignored*/ }
};
- static CONST struct Options openOptions[] = {
+ static const struct Options openOptions[] = {
{"-defaultextension", FILE_DEFAULT},
{"-filetypes", FILE_TYPES},
{"-initialdir", FILE_INITDIR},
@@ -632,7 +613,7 @@ GetFileNameW(
{"-typevariable", FILE_TYPEVARIABLE},
{NULL, FILE_DEFAULT/*ignored*/ }
};
- CONST struct Options *options = open ? openOptions : saveOptions;
+ const struct Options *const options = open ? openOptions : saveOptions;
file[0] = '\0';
ZeroMemory(&ofnData, sizeof(OFNData));
@@ -645,15 +626,16 @@ GetFileNameW(
for (i = 1; i < objc; i += 2) {
int index;
- char *string;
+ const char *string;
Tcl_Obj *valuePtr = objv[i + 1];
if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
sizeof(struct Options), "option", 0, &index) != TCL_OK) {
goto end;
} else if (i + 1 == objc) {
- Tcl_AppendResult(interp, "value for \"", options[index].name,
- "\" missing", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", options[index].name));
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
goto end;
}
@@ -679,9 +661,9 @@ GetFileNameW(
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_UtfToExternal(NULL, TkWinGetUnicodeEncoding(),
+ Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL,
+ (char *) file, sizeof(file), NULL, NULL, NULL);
Tcl_DStringFree(&ds);
break;
case FILE_PARENT:
@@ -720,19 +702,19 @@ GetFileNameW(
Tk_MakeWindowExist(tkwin);
hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
- ZeroMemory(&ofn, sizeof(OPENFILENAMEW));
+ ZeroMemory(&ofn, sizeof(OPENFILENAME));
if (LOBYTE(LOWORD(GetVersion())) < 5) {
ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400;
} else {
- ofn.lStructSize = sizeof(OPENFILENAMEW);
+ ofn.lStructSize = sizeof(OPENFILENAME);
}
ofn.hwndOwner = hWnd;
ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner);
- ofn.lpstrFile = (WCHAR *) file;
+ ofn.lpstrFile = 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.lpfnHook = (LPOFNHOOKPROC) OFNHookProc;
ofn.lCustData = (LPARAM) &ofnData;
if (open != 0) {
@@ -751,24 +733,22 @@ GetFileNameW(
* procedure when necessary
*/
- ofnData.dynFileBufferSize = 1024;
- ofnData.dynFileBuffer = ckalloc(1024);
+ ofnData.dynFileBufferSize = 512;
+ ofnData.dynFileBuffer = ckalloc(512 * sizeof(TCHAR));
}
if (extension != NULL) {
- Tcl_UtfToExternalDString(unicodeEncoding, extension, -1, &extString);
- ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString);
+ Tcl_WinUtfToTChar(extension, -1, &extString);
+ ofn.lpstrDefExt = (TCHAR *) Tcl_DStringValue(&extString);
}
- Tcl_UtfToExternalDString(unicodeEncoding,
- Tcl_DStringValue(&utfFilterString),
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&utfFilterString),
Tcl_DStringLength(&utfFilterString), &filterString);
- ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);
+ ofn.lpstrFilter = (TCHAR *) Tcl_DStringValue(&filterString);
ofn.nFilterIndex = filterIndex;
if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
- Tcl_UtfToExternalDString(unicodeEncoding,
- Tcl_DStringValue(&utfDirString),
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&utfDirString),
Tcl_DStringLength(&utfDirString), &dirString);
} else {
/*
@@ -784,16 +764,16 @@ GetFileNameW(
Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
Tcl_ResetResult(interp);
} else {
- Tcl_UtfToExternalDString(unicodeEncoding, Tcl_DStringValue(&cwd),
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&cwd),
Tcl_DStringLength(&cwd), &dirString);
}
Tcl_DStringFree(&cwd);
}
- ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);
+ ofn.lpstrInitialDir = (TCHAR *) Tcl_DStringValue(&dirString);
if (title != NULL) {
- Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);
- ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);
+ Tcl_WinUtfToTChar(title, -1, &titleString);
+ ofn.lpstrTitle = (TCHAR *) Tcl_DStringValue(&titleString);
}
/*
@@ -802,9 +782,9 @@ GetFileNameW(
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
if (open != 0) {
- winCode = GetOpenFileNameW(&ofn);
+ winCode = GetOpenFileName(&ofn);
} else {
- winCode = GetSaveFileNameW(&ofn);
+ winCode = GetSaveFileName(&ofn);
}
Tcl_SetServiceMode(oldMode);
EatSpuriousMessageBugFix();
@@ -858,7 +838,7 @@ GetFileNameW(
* first element is the directory path.
*/
- WCHAR *files = (WCHAR *) ofnData.dynFileBuffer;
+ TCHAR *files = ofnData.dynFileBuffer;
Tcl_Obj *returnList = Tcl_NewObj();
int count = 0;
@@ -866,8 +846,7 @@ GetFileNameW(
* Get directory.
*/
- (void) ConvertExternalFilename(unicodeEncoding, (char *) files,
- &ds);
+ ConvertExternalFilename(files, &ds);
while (*files != '\0') {
while (*files != '\0') {
@@ -879,8 +858,7 @@ GetFileNameW(
Tcl_DString filenameBuf;
count++;
- (void) ConvertExternalFilename(unicodeEncoding,
- (char *) files, &filenameBuf);
+ ConvertExternalFilename(files, &filenameBuf);
fullnameObj = Tcl_NewStringObj(Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds));
@@ -906,8 +884,8 @@ GetFileNameW(
Tcl_SetObjResult(interp, returnList);
Tcl_DStringFree(&ds);
} else {
- Tcl_AppendResult(interp, ConvertExternalFilename(unicodeEncoding,
- (char *) ofn.lpstrFile, &ds), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ ConvertExternalFilename(ofn.lpstrFile, &ds), -1));
gotFilename = (Tcl_DStringLength(&ds) > 0);
Tcl_DStringFree(&ds);
}
@@ -931,9 +909,11 @@ GetFileNameW(
}
}
} else if (cdlgerr == FNERR_INVALIDFILENAME) {
- Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
- Tcl_AppendResult(interp, ConvertExternalFilename(unicodeEncoding,
- (char *) ofn.lpstrFile, &ds), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid filename \"%s\"",
+ ConvertExternalFilename(ofn.lpstrFile, &ds)));
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "INVALID_FILENAME",
+ NULL);
Tcl_DStringFree(&ds);
} else {
result = TCL_OK;
@@ -964,7 +944,7 @@ GetFileNameW(
/*
*-------------------------------------------------------------------------
*
- * OFNHookProcW --
+ * OFNHookProc --
*
* Dialog box hook function. This is used to sets the "tk_dialog"
* variable for test/debugging when the dialog is ready to receive
@@ -981,561 +961,13 @@ GetFileNameW(
*/
static UINT APIENTRY
-OFNHookProcW(
+OFNHookProc(
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));
- 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;
-
- /*
- * Just empty the buffer if dirsize indicates an error [Bug 3071836]
- */
- if ((selsize > 1) && (dirsize > 0)) {
- if (ofnData->dynFileBufferSize < buffersize) {
- buffer = (WCHAR *) ckrealloc((char *) buffer, buffersize);
- ofnData->dynFileBufferSize = buffersize;
- ofnData->dynFileBuffer = (char *) buffer;
- }
-
- SendMessageW(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer);
- buffer += dirsize;
-
- SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
-
- /*
- * If there are multiple files, delete the quotes and change
- * every second quote to NULL terminator
- */
-
- if (buffer[0] == '"') {
- BOOL findquote = TRUE;
- WCHAR *tmp = buffer;
-
- while(*buffer != '\0') {
- if (findquote) {
- if (*buffer == '"') {
- findquote = FALSE;
- }
- buffer++;
- } else {
- if (*buffer == '"') {
- findquote = TRUE;
- *buffer = '\0';
- }
- *tmp++ = *buffer++;
- }
- }
- *tmp = '\0'; /* Second NULL terminator. */
- } else {
- buffer[selsize] = '\0'; /* Second NULL terminator. */
-
- /*
- * Replace directory terminating NULL with a backslash.
- */
-
- buffer--;
- *buffer = '\\';
- }
- } else {
- /*
- * Nothing is selected, so just empty the string.
- */
-
- if (buffer != NULL) {
- *buffer = '\0';
- }
- }
- }
- } else if (uMsg == WM_WINDOWPOSCHANGED) {
- /*
- * This message is delivered at the right time to enable Tk to set the
- * debug information. Unhooks itself so it won't set the debug
- * information every time it gets a WM_WINDOWPOSCHANGED message.
- */
-
- 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;
- char *extension = NULL, *title = NULL;
- Tk_Window tkwin = (Tk_Window) clientData;
- HWND hWnd;
- Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
- Tcl_DString utfFilterString, utfDirString, ds;
- Tcl_DString extString, filterString, dirString, titleString;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- static CONST char *saveOptionStrings[] = {
- "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
- "-parent", "-title", "-typevariable", NULL
- };
- static CONST char *openOptionStrings[] = {
- "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
- "-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_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;
- 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;
- }
-
- 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 = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
OPENFILENAME *ofnPtr;
OFNData *ofnData;
@@ -1546,18 +978,20 @@ OFNHookProcA(
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]
+ * This is weird... or not. The CDN_FILEOK is NOT sent when the
+ * selection exceeds declared buffer size (the nMaxFile member of the
+ * OPENFILENAME struct passed to GetOpenFileName 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 [Bug
+ * 2987995]
*/
+
if (notifyPtr->hdr.code == CDN_FILEOK ||
notifyPtr->hdr.code == CDN_SELCHANGE) {
int dirsize, selsize;
- char *buffer;
+ TCHAR *buffer;
int buffersize;
/*
@@ -1572,30 +1006,33 @@ OFNHookProcA(
selsize = SendMessage(hdlg, CDM_GETSPEC, 0, 0);
dirsize = SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0);
- buffersize = selsize + dirsize + 1;
+ buffersize = (selsize + dirsize + 1);
/*
- * Just empty the buffer if dirsize indicates an error [Bug 3071836]
+ * Just empty the buffer if dirsize indicates an error. [Bug
+ * 3071836]
*/
+
if ((selsize > 1) && (dirsize > 0)) {
if (ofnData->dynFileBufferSize < buffersize) {
- buffer = ckrealloc(buffer, buffersize);
+ buffer = ckrealloc(buffer, buffersize * sizeof(TCHAR));
ofnData->dynFileBufferSize = buffersize;
ofnData->dynFileBuffer = buffer;
}
SendMessage(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer);
buffer += dirsize;
+
SendMessage(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
/*
* If there are multiple files, delete the quotes and change
- * every second quote to NULL terminator.
+ * every second quote to NULL terminator
*/
if (buffer[0] == '"') {
BOOL findquote = TRUE;
- char *tmp = buffer;
+ TCHAR *tmp = buffer;
while (*buffer != '\0') {
if (findquote) {
@@ -1613,16 +1050,25 @@ OFNHookProcA(
}
*tmp = '\0'; /* Second NULL terminator. */
} else {
- buffer[selsize] = '\0'; /* Second NULL terminator. */
- /*
- * Replace directory terminating NULL with a backslash.
+ /*
+ * Replace directory terminating NULL with a with a backslash,
+ * but only if not an absolute path.
*/
- buffer--;
- *buffer = '\\';
+ Tcl_DString tmpfile;
+ ConvertExternalFilename(buffer, &tmpfile);
+ if (TCL_PATH_ABSOLUTE ==
+ Tcl_GetPathType(Tcl_DStringValue(&tmpfile))) {
+ /* re-get the full path to the start of the buffer */
+ buffer = (TCHAR *) ofnData->dynFileBuffer;
+ SendMessage(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
+ } else {
+ *(buffer-1) = '\\';
+ }
+ buffer[selsize] = '\0'; /* Second NULL terminator. */
+ Tcl_DStringFree(&tmpfile);
}
-
} else {
/*
* Nothing is selected, so just empty the string.
@@ -1635,19 +1081,16 @@ OFNHookProcA(
}
} 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 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);
- }
+ hdlg = GetParent(hdlg);
tsdPtr->debugInterp = ofnData->interp;
Tcl_DoWhenIdle(SetTkDialog, hdlg);
}
@@ -1680,18 +1123,18 @@ MakeFilter(
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 */
+ int *indexPtr) /* Index of initial type in filter string */
{
char *filterStr;
char *p;
- char *initial = NULL;
+ const char *initial = NULL;
int pass;
int ix = 0; /* index counter */
FileFilterList flist;
FileFilter *filterPtr;
if (initialPtr) {
- initial = Tcl_GetStringFromObj(initialPtr, NULL);
+ initial = Tcl_GetString(initialPtr);
}
TkInitFileFilters(&flist);
if (TkGetFileFilters(interp, &flist, valuePtr, 1) != TCL_OK) {
@@ -1702,9 +1145,9 @@ MakeFilter(
/*
* Use "All Files (*.*) as the default filter if none is specified
*/
- char *defaultFilter = "All Files (*.*)";
+ const char *defaultFilter = "All Files (*.*)";
- p = filterStr = (char*)ckalloc(30 * sizeof(char));
+ p = filterStr = ckalloc(30);
strcpy(p, defaultFilter);
p+= strlen(defaultFilter);
@@ -1718,12 +1161,13 @@ MakeFilter(
*p = '\0';
} else {
- int len;
+ size_t len;
if (valuePtr == NULL) {
len = 0;
} else {
- (void) Tcl_GetStringFromObj(valuePtr, &len);
+ (void) Tcl_GetString(valuePtr);
+ len = valuePtr->length;
}
/*
@@ -1740,20 +1184,22 @@ MakeFilter(
* twice the size of the string to format the filter
*/
- filterStr = ckalloc((unsigned int) len * 3);
+ filterStr = ckalloc(len * 3);
for (filterPtr = flist.filters, p = filterStr; filterPtr;
filterPtr = filterPtr->next) {
- char *sep;
+ const char *sep;
FileFilterClause *clausePtr;
/*
- * Check initial index for match, set index. Filter index is 1
+ * Check initial index for match, set *indexPtr. Filter index is 1
* based so increment first
*/
+
ix++;
- if (index && initial && (strcmp(initial, filterPtr->name) == 0)) {
- *index = ix;
+ if (indexPtr && initial
+ && (strcmp(initial, filterPtr->name) == 0)) {
+ *indexPtr = ix;
}
/*
@@ -1808,7 +1254,7 @@ MakeFilter(
}
Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr));
- ckfree((char *) filterStr);
+ ckfree(filterStr);
TkFreeFileFilters(&flist);
return TCL_OK;
@@ -1880,6 +1326,10 @@ MakeFilter(
* - 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?).
*
*----------------------------------------------------------------------
*/
@@ -1889,22 +1339,23 @@ 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. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char path[MAX_PATH];
+ TCHAR 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 = (Tk_Window) clientData;
+ Tk_Window tkwin = clientData;
HWND hWnd;
- char *utfTitle = NULL;/* Title for window */
+ const char *utfTitle = NULL;/* Title for window */
TCHAR saveDir[MAX_PATH];
- Tcl_DString titleString; /* UTF Title */
+ Tcl_DString titleString; /* Title */
Tcl_DString initDirString; /* Initial directory */
+ Tcl_DString tempString; /* temporary */
Tcl_Obj *objPtr;
- static CONST char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"-initialdir", "-mustexist", "-parent", "-title", NULL
};
enum options {
@@ -1925,20 +1376,21 @@ Tk_ChooseDirectoryObjCmd(
for (i = 1; i < objc; i += 2) {
int index;
- char *string;
+ const char *string;
+ const TCHAR *uniStr;
Tcl_Obj *optionPtr, *valuePtr;
optionPtr = objv[i];
valuePtr = objv[i + 1];
- if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
goto cleanup;
}
if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL);
goto cleanup;
}
@@ -1948,16 +1400,19 @@ Tk_ChooseDirectoryObjCmd(
if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) {
goto cleanup;
}
- string = Tcl_DStringValue(&initDirString);
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1,
+ &tempString);
+ uniStr = (TCHAR *) Tcl_DStringValue(&tempString);
/*
* Convert possible relative path to full path to keep dialog
* happy.
*/
- GetFullPathName(string, MAX_PATH, saveDir, NULL);
- lstrcpyn(cdCBData.utfInitDir, saveDir, MAX_PATH);
+ GetFullPathName(uniStr, MAX_PATH, saveDir, NULL);
+ _tcsncpy(cdCBData.initDir, saveDir, MAX_PATH);
Tcl_DStringFree(&initDirString);
+ Tcl_DStringFree(&tempString);
break;
case DIR_EXIST:
if (Tcl_GetBooleanFromObj(interp, valuePtr,
@@ -1991,16 +1446,16 @@ Tk_ChooseDirectoryObjCmd(
bInfo.hwndOwner = hWnd;
bInfo.pszDisplayName = path;
bInfo.pidlRoot = NULL;
- if (lstrlen(cdCBData.utfInitDir) == 0) {
- GetCurrentDirectory(MAX_PATH, cdCBData.utfInitDir);
+ if (_tcslen(cdCBData.initDir) == 0) {
+ GetCurrentDirectory(MAX_PATH, cdCBData.initDir);
}
bInfo.lParam = (LPARAM) &cdCBData;
if (utfTitle != NULL) {
- Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
+ Tcl_WinUtfToTChar(utfTitle, -1, &titleString);
bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString);
} else {
- bInfo.lpszTitle = "Please choose a directory, then select OK.";
+ bInfo.lpszTitle = TEXT("Please choose a directory, then select OK.");
}
/*
@@ -2038,10 +1493,11 @@ Tk_ChooseDirectoryObjCmd(
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]
+ * 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';
/*
@@ -2050,12 +1506,13 @@ Tk_ChooseDirectoryObjCmd(
if (pidl != NULL) {
if (!SHGetPathFromIDList(pidl, path)) {
- Tcl_SetResult(interp, "Error: Not a file system folder\n",
- TCL_VOLATILE);
- };
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error: not a file system folder", -1));
+ Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "PSEUDO", NULL);
+ }
pMalloc->lpVtbl->Free(pMalloc, (void *) pidl);
- } else if (lstrlen(cdCBData.utfRetDir) > 0) {
- lstrcpy(path, cdCBData.utfRetDir);
+ } else if (_tcslen(cdCBData.retDir) > 0) {
+ _tcscpy(path, cdCBData.retDir);
}
pMalloc->lpVtbl->Release(pMalloc);
}
@@ -2079,8 +1536,8 @@ Tk_ChooseDirectoryObjCmd(
if (*path) {
Tcl_DString ds;
- Tcl_AppendResult(interp, ConvertExternalFilename(NULL, (char *) path,
- &ds), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ ConvertExternalFilename(path, &ds), -1));
Tcl_DStringFree(&ds);
}
@@ -2119,42 +1576,47 @@ ChooseDirectoryValidateProc(
{
TCHAR selDir[MAX_PATH];
CHOOSEDIRDATA *chooseDirSharedData = (CHOOSEDIRDATA *) lpData;
+ Tcl_DString tempString;
Tcl_DString initDirString;
- char string[MAX_PATH];
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TCHAR string[MAX_PATH];
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (tsdPtr->debugFlag) {
tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp;
- Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
+ Tcl_DoWhenIdle(SetTkDialog, hwnd);
}
- chooseDirSharedData->utfRetDir[0] = '\0';
+ chooseDirSharedData->retDir[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
+ * Set/GetCurrentDirectoryA which allows relative path names and names
* with forward slashes. Use Tcl_TranslateFileName to make sure names
* like ~ are converted correctly.
*/
+ Tcl_WinTCharToUtf((TCHAR *) lParam, -1, &initDirString);
if (Tcl_TranslateFileName(chooseDirSharedData->interp,
- (char *) lParam, &initDirString) == NULL) {
+ Tcl_DStringValue(&initDirString), &tempString) == NULL) {
/*
* Should we expose the error (in the interp result) to the user
* at this point?
*/
- chooseDirSharedData->utfRetDir[0] = '\0';
+ chooseDirSharedData->retDir[0] = '\0';
return 1;
}
- lstrcpyn(string, Tcl_DStringValue(&initDirString), MAX_PATH);
+ Tcl_DStringFree(&initDirString);
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&tempString), -1, &initDirString);
+ Tcl_DStringFree(&tempString);
+ _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString),
+ MAX_PATH);
Tcl_DStringFree(&initDirString);
- if (SetCurrentDirectory((char *)string) == 0) {
- LPTSTR lpFilePart[MAX_PATH];
+ if (SetCurrentDirectory(string) == 0) {
/*
* Get the full path name to the user entry, at this point it does
@@ -2163,15 +1625,17 @@ ChooseDirectoryValidateProc(
*/
GetFullPathName(string, MAX_PATH,
- chooseDirSharedData->utfRetDir, /*unused*/ lpFilePart);
+ chooseDirSharedData->retDir, NULL);
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);
+ wsprintf(selDir, TEXT("Directory '%s' does not exist,\n")
+ TEXT("please select or enter an existing directory."),
+ chooseDirSharedData->retDir);
MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
- chooseDirSharedData->utfRetDir[0] = '\0';
+ chooseDirSharedData->retDir[0] = '\0';
return 1;
}
} else {
@@ -2180,7 +1644,7 @@ ChooseDirectoryValidateProc(
* directory in utfRetDir.
*/
- GetCurrentDirectory(MAX_PATH, chooseDirSharedData->utfRetDir);
+ GetCurrentDirectory(MAX_PATH, chooseDirSharedData->retDir);
return 0;
}
return 0;
@@ -2212,9 +1676,10 @@ ChooseDirectoryValidateProc(
* specified parameter.
*/
- char *initDir = chooseDirSharedData->utfInitDir;
+ TCHAR *initDir = chooseDirSharedData->initDir;
SetCurrentDirectory(initDir);
+
if (*initDir == '\\') {
/*
* BFFM_SETSELECTION only understands UNC paths as pidls, so
@@ -2228,20 +1693,16 @@ ChooseDirectoryValidateProc(
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))
+ psfFolder, hwnd, NULL, (TCHAR *)
+ initDir, &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);
}
@@ -2279,15 +1740,15 @@ 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. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData, parent;
+ Tk_Window tkwin = clientData, parent;
HWND hWnd;
Tcl_Obj *messageObj, *titleObj, *detailObj, *tmpObj;
int defaultBtn, icon, type;
int i, oldMode, winCode;
UINT flags;
- static CONST char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"-default", "-detail", "-icon", "-message",
"-parent", "-title", "-type", NULL
};
@@ -2295,10 +1756,9 @@ Tk_MessageBoxObjCmd(
MSG_DEFAULT, MSG_DETAIL, MSG_ICON, MSG_MESSAGE,
MSG_PARENT, MSG_TITLE, MSG_TYPE
};
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- (void) TkWinGetUnicodeEncoding();
defaultBtn = -1;
detailObj = NULL;
icon = MB_ICONINFORMATION;
@@ -2309,20 +1769,19 @@ Tk_MessageBoxObjCmd(
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",
- TCL_EXACT, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings,
+ sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL);
return TCL_ERROR;
}
@@ -2391,9 +1850,10 @@ Tk_MessageBoxObjCmd(
}
}
if (defaultBtnIdx < 0) {
- Tcl_AppendResult(interp, "invalid default button \"",
- TkFindStateString(buttonMap, defaultBtn),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid default button \"%s\"",
+ TkFindStateString(buttonMap, defaultBtn)));
+ Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL);
return TCL_ERROR;
}
break;
@@ -2427,7 +1887,7 @@ Tk_MessageBoxObjCmd(
tsdPtr->hBigIcon = TkWinGetIcon(parent, ICON_BIG);
tsdPtr->hMsgBoxHook = SetWindowsHookEx(WH_CBT, MsgBoxCBTProc, NULL,
GetCurrentThreadId());
- winCode = MessageBoxW(hWnd, Tcl_GetUnicode(tmpObj),
+ winCode = MessageBox(hWnd, Tcl_GetUnicode(tmpObj),
titleObj ? Tcl_GetUnicode(titleObj) : L"", flags);
UnhookWindowsHookEx(tsdPtr->hMsgBoxHook);
(void) Tcl_SetServiceMode(oldMode);
@@ -2441,8 +1901,8 @@ Tk_MessageBoxObjCmd(
EnableWindow(hWnd, 1);
Tcl_DecrRefCount(tmpObj);
-
- Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TkFindStateString(buttonMap, winCode), -1));
return TCL_OK;
}
@@ -2452,8 +1912,8 @@ MsgBoxCBTProc(
WPARAM wParam,
LPARAM lParam)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (nCode == HCBT_CREATEWND) {
/*
@@ -2499,26 +1959,26 @@ static void
SetTkDialog(
ClientData clientData)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
char buf[32];
sprintf(buf, "0x%p", (HWND) clientData);
- Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(tsdPtr->debugInterp, "tk_dialog", NULL, buf, TCL_GLOBAL_ONLY);
}
/*
* Factored out a common pattern in use in this file.
*/
-static char *
+
+static const char *
ConvertExternalFilename(
- Tcl_Encoding encoding,
- char *filename,
+ TCHAR *filename,
Tcl_DString *dsPtr)
{
char *p;
- Tcl_ExternalToUtfDString(encoding, filename, -1, dsPtr);
+ Tcl_WinTCharToUtf(filename, -1, dsPtr);
for (p = Tcl_DStringValue(dsPtr); *p != '\0'; p++) {
/*
* Change the pathname to the Tcl "normalized" pathname, where back
@@ -2533,6 +1993,569 @@ ConvertExternalFilename(
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * GetFontObj --
+ *
+ * Convert a windows LOGFONT into a Tk font description.
+ *
+ * Result:
+ * A list containing a Tk font description.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetFontObj(
+ HDC hdc,
+ LOGFONT *plf)
+{
+ Tcl_DString ds;
+ Tcl_Obj *resObj;
+ int pt = 0;
+
+ resObj = Tcl_NewListObj(0, NULL);
+ Tcl_WinTCharToUtf(plf->lfFaceName, -1, &ds);
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj(Tcl_DStringValue(&ds), -1));
+ Tcl_DStringFree(&ds);
+ pt = -MulDiv(plf->lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY));
+ Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewIntObj(pt));
+ if (plf->lfWeight >= 700) {
+ Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewStringObj("bold", -1));
+ }
+ if (plf->lfItalic) {
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj("italic", -1));
+ }
+ if (plf->lfUnderline) {
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj("underline", -1));
+ }
+ if (plf->lfStrikeOut) {
+ Tcl_ListObjAppendElement(NULL, resObj,
+ Tcl_NewStringObj("overstrike", -1));
+ }
+ return resObj;
+}
+
+static void
+ApplyLogfont(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdObj,
+ HDC hdc,
+ LOGFONT *logfontPtr)
+{
+ int objc;
+ Tcl_Obj **objv, **tmpv;
+
+ Tcl_ListObjGetElements(NULL, cmdObj, &objc, &objv);
+ tmpv = ckalloc(sizeof(Tcl_Obj *) * (objc + 2));
+ memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
+ tmpv[objc] = GetFontObj(hdc, logfontPtr);
+ TkBackgroundEvalObjv(interp, objc+1, tmpv, TCL_EVAL_GLOBAL);
+ ckfree(tmpv);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * HookProc --
+ *
+ * Font selection hook. If the user selects Apply on the dialog, we call
+ * the applyProc script with the currently selected font as arguments.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+typedef struct HookData {
+ Tcl_Interp *interp;
+ Tcl_Obj *titleObj;
+ Tcl_Obj *cmdObj;
+ Tcl_Obj *parentObj;
+ Tcl_Obj *fontObj;
+ HWND hwnd;
+ Tk_Window parent;
+} HookData;
+
+static UINT_PTR CALLBACK
+HookProc(
+ HWND hwndDlg,
+ UINT msg,
+ WPARAM wParam,
+ LPARAM lParam)
+{
+ CHOOSEFONT *pcf = (CHOOSEFONT *) lParam;
+ HWND hwndCtrl;
+ static HookData *phd = NULL;
+ ThreadSpecificData *tsdPtr =
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (WM_INITDIALOG == msg && lParam != 0) {
+ phd = (HookData *) pcf->lCustData;
+ phd->hwnd = hwndDlg;
+ if (tsdPtr->debugFlag) {
+ tsdPtr->debugInterp = phd->interp;
+ Tcl_DoWhenIdle(SetTkDialog, hwndDlg);
+ }
+ if (phd->titleObj != NULL) {
+ Tcl_DString title;
+
+ Tcl_WinUtfToTChar(Tcl_GetString(phd->titleObj), -1, &title);
+ if (Tcl_DStringLength(&title) > 0) {
+ SetWindowText(hwndDlg, (LPCTSTR) Tcl_DStringValue(&title));
+ }
+ Tcl_DStringFree(&title);
+ }
+
+ /*
+ * Disable the colour combobox (0x473) and its label (0x443).
+ */
+
+ hwndCtrl = GetDlgItem(hwndDlg, 0x443);
+ if (IsWindow(hwndCtrl)) {
+ EnableWindow(hwndCtrl, FALSE);
+ }
+ hwndCtrl = GetDlgItem(hwndDlg, 0x473);
+ if (IsWindow(hwndCtrl)) {
+ EnableWindow(hwndCtrl, FALSE);
+ }
+ TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+ return 1; /* we handled the message */
+ }
+
+ if (WM_DESTROY == msg) {
+ phd->hwnd = NULL;
+ TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+ return 0;
+ }
+
+ /*
+ * Handle apply button by calling the provided command script as a
+ * background evaluation (ie: errors dont come back here).
+ */
+
+ if (WM_COMMAND == msg && LOWORD(wParam) == 1026) {
+ LOGFONT lf = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {0, 0}};
+ HDC hdc = GetDC(hwndDlg);
+
+ SendMessage(hwndDlg, WM_CHOOSEFONT_GETLOGFONT, 0, (LPARAM) &lf);
+ if (phd && phd->cmdObj) {
+ ApplyLogfont(phd->interp, phd->cmdObj, hdc, &lf);
+ }
+ if (phd && phd->parent) {
+ TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged");
+ }
+ return 1;
+ }
+ return 0; /* pass on for default processing */
+}
+
+/*
+ * Helper for the FontchooserConfigure command to return the current value of
+ * any of the options (which may be NULL in the structure)
+ */
+
+enum FontchooserOption {
+ FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd,
+ FontchooserVisible
+};
+
+static Tcl_Obj *
+FontchooserCget(
+ HookData *hdPtr,
+ int optionIndex)
+{
+ Tcl_Obj *resObj = NULL;
+
+ switch(optionIndex) {
+ case FontchooserParent:
+ if (hdPtr->parentObj) {
+ resObj = hdPtr->parentObj;
+ } else {
+ resObj = Tcl_NewStringObj(".", 1);
+ }
+ break;
+ case FontchooserTitle:
+ if (hdPtr->titleObj) {
+ resObj = hdPtr->titleObj;
+ } else {
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ break;
+ case FontchooserFont:
+ if (hdPtr->fontObj) {
+ resObj = hdPtr->fontObj;
+ } else {
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ break;
+ case FontchooserCmd:
+ if (hdPtr->cmdObj) {
+ resObj = hdPtr->cmdObj;
+ } else {
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ break;
+ case FontchooserVisible:
+ resObj = Tcl_NewBooleanObj(hdPtr->hwnd && IsWindow(hdPtr->hwnd));
+ break;
+ default:
+ resObj = Tcl_NewStringObj("", 0);
+ }
+ return resObj;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserConfigureCmd --
+ *
+ * Implementation of the 'tk fontchooser configure' ensemble command. See
+ * the user documentation for what it does.
+ *
+ * Results:
+ * See the user documentation.
+ *
+ * Side effects:
+ * Per-interp data structure may be modified
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserConfigureCmd(
+ ClientData clientData, /* Main window */
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tk_Window tkwin = clientData;
+ HookData *hdPtr = NULL;
+ int i, r = TCL_OK;
+ static const char *const optionStrings[] = {
+ "-parent", "-title", "-font", "-command", "-visible", NULL
+ };
+
+ hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+ /*
+ * With no arguments we return all the options in a dict.
+ */
+
+ if (objc == 1) {
+ Tcl_Obj *keyObj, *valueObj;
+ Tcl_Obj *dictObj = Tcl_NewDictObj();
+
+ for (i = 0; r == TCL_OK && optionStrings[i] != NULL; ++i) {
+ keyObj = Tcl_NewStringObj(optionStrings[i], -1);
+ valueObj = FontchooserCget(hdPtr, i);
+ r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj);
+ }
+ if (r == TCL_OK) {
+ Tcl_SetObjResult(interp, dictObj);
+ }
+ return r;
+ }
+
+ for (i = 1; i < objc; i += 2) {
+ int optionIndex;
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ /*
+ * If one option and no arg - return the current value.
+ */
+
+ Tcl_SetObjResult(interp, FontchooserCget(hdPtr, optionIndex));
+ return TCL_OK;
+ }
+ if (i + 1 == objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL);
+ return TCL_ERROR;
+ }
+ switch (optionIndex) {
+ case FontchooserVisible: {
+ static const char *msg = "cannot change read-only option "
+ "\"-visible\": use the show or hide command";
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+ Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL);
+ return TCL_ERROR;
+ }
+ case FontchooserParent: {
+ Tk_Window parent = Tk_NameToWindow(interp,
+ Tcl_GetString(objv[i+1]), tkwin);
+
+ if (parent == None) {
+ return TCL_ERROR;
+ }
+ if (hdPtr->parentObj) {
+ Tcl_DecrRefCount(hdPtr->parentObj);
+ }
+ hdPtr->parentObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->parentObj)) {
+ hdPtr->parentObj = Tcl_DuplicateObj(hdPtr->parentObj);
+ }
+ Tcl_IncrRefCount(hdPtr->parentObj);
+ break;
+ }
+ case FontchooserTitle:
+ if (hdPtr->titleObj) {
+ Tcl_DecrRefCount(hdPtr->titleObj);
+ }
+ hdPtr->titleObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->titleObj)) {
+ hdPtr->titleObj = Tcl_DuplicateObj(hdPtr->titleObj);
+ }
+ Tcl_IncrRefCount(hdPtr->titleObj);
+ break;
+ case FontchooserFont:
+ if (hdPtr->fontObj) {
+ Tcl_DecrRefCount(hdPtr->fontObj);
+ }
+ (void)Tcl_GetString(objv[i+1]);
+ if (objv[i+1]->length) {
+ hdPtr->fontObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->fontObj)) {
+ hdPtr->fontObj = Tcl_DuplicateObj(hdPtr->fontObj);
+ }
+ Tcl_IncrRefCount(hdPtr->fontObj);
+ } else {
+ hdPtr->fontObj = NULL;
+ }
+ break;
+ case FontchooserCmd:
+ if (hdPtr->cmdObj) {
+ Tcl_DecrRefCount(hdPtr->cmdObj);
+ }
+ (void)Tcl_GetString(objv[i+1]);
+ if (objv[i+1]->length) {
+ hdPtr->cmdObj = objv[i+1];
+ if (Tcl_IsShared(hdPtr->cmdObj)) {
+ hdPtr->cmdObj = Tcl_DuplicateObj(hdPtr->cmdObj);
+ }
+ Tcl_IncrRefCount(hdPtr->cmdObj);
+ } else {
+ hdPtr->cmdObj = NULL;
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserShowCmd --
+ *
+ * Implements the 'tk fontchooser show' ensemble command. The per-interp
+ * configuration data for the dialog is held in an interp associated
+ * structure.
+ *
+ * Calls the Win32 FontChooser API which provides a modal dialog. See
+ * HookProc where we make a few changes to the dialog and set some
+ * additional state.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserShowCmd(
+ ClientData clientData, /* Main window */
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_DString ds;
+ Tk_Window tkwin = clientData, parent;
+ CHOOSEFONT cf;
+ LOGFONT lf;
+ HDC hdc;
+ HookData *hdPtr;
+ int r = TCL_OK, oldMode = 0;
+
+ hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+ parent = tkwin;
+ if (hdPtr->parentObj) {
+ parent = Tk_NameToWindow(interp, Tcl_GetString(hdPtr->parentObj),
+ tkwin);
+ if (parent == None) {
+ return TCL_ERROR;
+ }
+ }
+
+ Tk_MakeWindowExist(parent);
+
+ ZeroMemory(&cf, sizeof(CHOOSEFONT));
+ ZeroMemory(&lf, sizeof(LOGFONT));
+ lf.lfCharSet = DEFAULT_CHARSET;
+ cf.lStructSize = sizeof(CHOOSEFONT);
+ cf.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
+ cf.lpLogFont = &lf;
+ cf.nFontType = SCREEN_FONTTYPE;
+ cf.Flags = CF_SCREENFONTS | CF_EFFECTS | CF_ENABLEHOOK;
+ cf.rgbColors = RGB(0,0,0);
+ cf.lpfnHook = HookProc;
+ cf.lCustData = (INT_PTR) hdPtr;
+ hdPtr->interp = interp;
+ hdPtr->parent = parent;
+ hdc = GetDC(cf.hwndOwner);
+
+ if (hdPtr->fontObj != NULL) {
+ TkFont *fontPtr;
+ Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, hdPtr->fontObj);
+
+ if (f == NULL) {
+ return TCL_ERROR;
+ }
+ fontPtr = (TkFont *) f;
+ cf.Flags |= CF_INITTOLOGFONTSTRUCT;
+ Tcl_WinUtfToTChar(fontPtr->fa.family, -1, &ds);
+ _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds),
+ LF_FACESIZE-1);
+ Tcl_DStringFree(&ds);
+ lf.lfFaceName[LF_FACESIZE-1] = 0;
+ lf.lfHeight = -MulDiv(TkFontGetPoints(tkwin, fontPtr->fa.size),
+ GetDeviceCaps(hdc, LOGPIXELSY), 72);
+ if (fontPtr->fa.weight == TK_FW_BOLD) {
+ lf.lfWeight = FW_BOLD;
+ }
+ if (fontPtr->fa.slant != TK_FS_ROMAN) {
+ lf.lfItalic = TRUE;
+ }
+ if (fontPtr->fa.underline) {
+ lf.lfUnderline = TRUE;
+ }
+ if (fontPtr->fa.overstrike) {
+ lf.lfStrikeOut = TRUE;
+ }
+ Tk_FreeFont(f);
+ }
+
+ if (TCL_OK == r && hdPtr->cmdObj != NULL) {
+ int len = 0;
+
+ r = Tcl_ListObjLength(interp, hdPtr->cmdObj, &len);
+ if (len > 0) {
+ cf.Flags |= CF_APPLY;
+ }
+ }
+
+ if (TCL_OK == r) {
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ if (ChooseFont(&cf)) {
+ if (hdPtr->cmdObj) {
+ ApplyLogfont(hdPtr->interp, hdPtr->cmdObj, hdc, &lf);
+ }
+ if (hdPtr->parent) {
+ TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged");
+ }
+ }
+ Tcl_SetServiceMode(oldMode);
+ EnableWindow(cf.hwndOwner, 1);
+ }
+
+ ReleaseDC(cf.hwndOwner, hdc);
+ return r;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserHideCmd --
+ *
+ * Implementation of the 'tk fontchooser hide' ensemble. See the user
+ * documentation for details.
+ * As the Win32 FontChooser function is always modal all we do here is
+ * destroy the dialog
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserHideCmd(
+ ClientData clientData, /* Main window */
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ HookData *hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+ if (hdPtr->hwnd && IsWindow(hdPtr->hwnd)) {
+ EndDialog(hdPtr->hwnd, 0);
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeleteHookData --
+ *
+ * Clean up the font chooser configuration data when the interp is
+ * destroyed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeleteHookData(ClientData clientData, Tcl_Interp *interp)
+{
+ HookData *hdPtr = clientData;
+
+ if (hdPtr->parentObj) {
+ Tcl_DecrRefCount(hdPtr->parentObj);
+ }
+ if (hdPtr->fontObj) {
+ Tcl_DecrRefCount(hdPtr->fontObj);
+ }
+ if (hdPtr->titleObj) {
+ Tcl_DecrRefCount(hdPtr->titleObj);
+ }
+ if (hdPtr->cmdObj) {
+ Tcl_DecrRefCount(hdPtr->cmdObj);
+ }
+ ckfree(hdPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TkInitFontchooser --
+ *
+ * Associate the font chooser configuration data with the Tcl
+ * interpreter. There is one font chooser per interp.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[];
+const TkEnsemble tkFontchooserEnsemble[] = {
+ { "configure", FontchooserConfigureCmd, NULL },
+ { "show", FontchooserShowCmd, NULL },
+ { "hide", FontchooserHideCmd, NULL },
+ { NULL, NULL, NULL }
+};
+
+int
+TkInitFontchooser(Tcl_Interp *interp, ClientData clientData)
+{
+ HookData *hdPtr = ckalloc(sizeof(HookData));
+
+ memset(hdPtr, 0, sizeof(HookData));
+ Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteHookData, hdPtr);
+ return TCL_OK;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4