diff options
Diffstat (limited to 'win/tkWinDialog.c')
| -rw-r--r-- | win/tkWinDialog.c | 1556 |
1 files changed, 776 insertions, 780 deletions
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index 069991b..9263830 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,7 +350,7 @@ Tk_ChooseColorObjCmd( for (i = 1; i < objc; i += 2) { int index; - char *string; + const char *string; Tcl_Obj *optionPtr, *valuePtr; optionPtr = objv[i]; @@ -368,9 +361,9 @@ Tk_ChooseColorObjCmd( 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,60 +561,40 @@ 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; - enum options value; + static const char *const saveOptionStrings[] = { + "-confirmoverwrite", "-defaultextension", "-filetypes", "-initialdir", + "-initialfile", "", "-parent", "-title", "-typevariable", NULL }; - static CONST struct Options saveOptions[] = { - {"-confirmoverwrite", FILE_CONFIRMOW}, - {"-defaultextension", FILE_DEFAULT}, - {"-filetypes", FILE_TYPES}, - {"-initialdir", FILE_INITDIR}, - {"-initialfile", FILE_INITFILE}, - {"-parent", FILE_PARENT}, - {"-title", FILE_TITLE}, - {"-typevariable", FILE_TYPEVARIABLE}, - {NULL, FILE_DEFAULT/*ignored*/ } + static const char *const openOptionStrings[] = { + "", "-defaultextension", "-filetypes", "-initialdir", "-initialfile", + "-multiple", "-parent", "-title", "-typevariable", NULL }; - static CONST struct Options openOptions[] = { - {"-defaultextension", FILE_DEFAULT}, - {"-filetypes", FILE_TYPES}, - {"-initialdir", FILE_INITDIR}, - {"-initialfile", FILE_INITFILE}, - {"-multiple", FILE_MULTIPLE}, - {"-parent", FILE_PARENT}, - {"-title", FILE_TITLE}, - {"-typevariable", FILE_TYPEVARIABLE}, - {NULL, FILE_DEFAULT/*ignored*/ } + enum options { + FILE_CONFIRMOW, FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, + FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE }; - CONST struct Options *options = open ? openOptions : saveOptions; file[0] = '\0'; ZeroMemory(&ofnData, sizeof(OFNData)); @@ -645,20 +607,24 @@ 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) { + if (Tcl_GetIndexFromObj(interp, objv[i], + open ? openOptionStrings : saveOptionStrings, + "option", 0, &index) != TCL_OK) { goto end; - } else if (i + 1 == objc) { - Tcl_AppendResult(interp, "value for \"", options[index].name, - "\" missing", NULL); + } + + if (i + 1 == objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); goto end; } string = Tcl_GetString(valuePtr); - switch (options[index].value) { + switch ((enum options) index) { case FILE_DEFAULT: if (string[0] == '.') { string++; @@ -679,9 +645,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 +686,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 +717,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 +748,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 +766,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 +822,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 +830,7 @@ GetFileNameW( * Get directory. */ - (void) ConvertExternalFilename(unicodeEncoding, (char *) files, - &ds); + ConvertExternalFilename(files, &ds); while (*files != '\0') { while (*files != '\0') { @@ -879,8 +842,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 +868,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 +893,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 +928,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 +945,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 +962,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 +990,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) { @@ -1622,7 +1043,6 @@ OFNHookProcA( buffer--; *buffer = '\\'; } - } else { /* * Nothing is selected, so just empty the string. @@ -1635,19 +1055,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,11 +1097,11 @@ 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; @@ -1702,9 +1119,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); @@ -1740,20 +1157,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 +1227,7 @@ MakeFilter( } Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr)); - ckfree((char *) filterStr); + ckfree(filterStr); TkFreeFileFilters(&flist); return TCL_OK; @@ -1880,6 +1299,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 +1312,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,7 +1349,8 @@ 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]; @@ -1936,9 +1361,9 @@ Tk_ChooseDirectoryObjCmd( 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 +1373,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 +1419,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 +1466,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 +1479,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 +1509,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 +1549,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 +1598,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 +1617,7 @@ ChooseDirectoryValidateProc( * directory in utfRetDir. */ - GetCurrentDirectory(MAX_PATH, chooseDirSharedData->utfRetDir); + GetCurrentDirectory(MAX_PATH, chooseDirSharedData->retDir); return 0; } return 0; @@ -2212,9 +1649,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 +1666,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 +1713,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 +1729,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,7 +1742,6 @@ Tk_MessageBoxObjCmd( for (i = 1; i < objc; i += 2) { int index; - char *string; Tcl_Obj *optionPtr, *valuePtr; optionPtr = objv[i]; @@ -2320,9 +1752,9 @@ Tk_MessageBoxObjCmd( 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 +1823,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 +1860,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 +1874,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 +1885,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,7 +1932,7 @@ static void SetTkDialog( ClientData clientData) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); char buf[32]; @@ -2510,15 +1943,15 @@ SetTkDialog( /* * 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 +1966,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, 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_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); + } + 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[]) +{ + 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 |