diff options
Diffstat (limited to 'win/tkWinDialog.c')
| -rw-r--r-- | win/tkWinDialog.c | 1350 |
1 files changed, 665 insertions, 685 deletions
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index 36747b0..ba4c2df 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 */ + char utfInitDir[MAX_PATH]; /* Initial folder to use */ + char utfRetDir[MAX_PATH]; /* Returned folder to use */ Tcl_Interp *interp; int mustExist; /* True if file must exist to return from * callback */ @@ -163,18 +162,18 @@ 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 * it, since, of course, no _file_ was * selected. */ - OPENFILENAME *ofnPtr; /* pointer to the OFN structure */ + OPENFILENAMEA *ofnPtr; /* pointer to the OFN structure */ } ChooseDir; /* - * The following structure is used to pass information between GetFileName/W - * functions and OFN dialog hook procedures. [Bug 2896501, Patch 2898255] + * The following structure is used to pass information between GetFileName + * function and OFN dialog hook procedures. [Bug 2896501, Patch 2898255] */ typedef struct OFNData { @@ -195,18 +194,13 @@ 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); @@ -252,10 +246,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 +276,7 @@ void TkWinDialogDebug( int debug) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->debugFlag = debug; @@ -312,16 +306,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; + CHOOSECOLORA 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 { @@ -353,11 +347,11 @@ Tk_ChooseColorObjCmd( chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK; chooseColor.lCustData = (LPARAM) NULL; chooseColor.lpfnHook = (LPOFNHOOKPROC) ColorDlgHookProc; - chooseColor.lpTemplateName = (LPTSTR) interp; + chooseColor.lpTemplateName = (LPSTR) interp; for (i = 1; i < objc; i += 2) { int index; - char *string; + const char *string; Tcl_Obj *optionPtr, *valuePtr; optionPtr = objv[i]; @@ -405,7 +399,7 @@ Tk_ChooseColorObjCmd( chooseColor.hwndOwner = hWnd; oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - winCode = ChooseColor(&chooseColor); + winCode = ChooseColorA(&chooseColor); (void) Tcl_SetServiceMode(oldMode); /* @@ -470,7 +464,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 +481,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 +515,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 +542,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,21 +564,21 @@ 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; - char *extension = NULL, *filter = 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; @@ -601,16 +586,15 @@ GetFileNameW( Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding(); ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - static CONST char *saveOptionStrings[] = { + static const char *const saveOptionStrings[] = { "-defaultextension", "-filetypes", "-initialdir", "-initialfile", "-parent", "-title", "-typevariable", NULL }; - static CONST char *openOptionStrings[] = { + static const char *const openOptionStrings[] = { "-defaultextension", "-filetypes", "-initialdir", "-initialfile", "-multiple", "-parent", "-title", "-typevariable", NULL }; - CONST char **optionStrings; - + const char *const *optionStrings; enum options { FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE @@ -633,7 +617,7 @@ GetFileNameW( for (i = 1; i < objc; i += 2) { int index; - char *string; + const char *string; Tcl_Obj *optionPtr, *valuePtr; optionPtr = objv[i]; @@ -719,7 +703,6 @@ GetFileNameW( &filterIndex) != TCL_OK) { goto end; } - filter = Tcl_DStringValue(&utfFilterString); Tk_MakeWindowExist(tkwin); hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); @@ -736,7 +719,7 @@ GetFileNameW( 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) { @@ -806,9 +789,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(); @@ -961,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 @@ -978,26 +961,26 @@ 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 *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - OPENFILENAMEW *ofnPtr; + OPENFILENAME *ofnPtr; OFNData *ofnData; if (uMsg == WM_INITDIALOG) { TkWinSetUserData(hdlg, lParam); } else if (uMsg == WM_NOTIFY) { - OFNOTIFYW *notifyPtr = (OFNOTIFYW *) lParam; + 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 + * 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 @@ -1019,8 +1002,8 @@ OFNHookProcW( buffer = (WCHAR *) ofnData->dynFileBuffer; hdlg = GetParent(hdlg); - selsize = SendMessageW(hdlg, CDM_GETSPEC, 0, 0); - dirsize = SendMessageW(hdlg, CDM_GETFOLDERPATH, 0, 0); + selsize = SendMessage(hdlg, CDM_GETSPEC, 0, 0); + dirsize = SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0); buffersize = (selsize + dirsize + 1) * 2; /* @@ -1028,15 +1011,15 @@ OFNHookProcW( */ if ((selsize > 1) && (dirsize > 0)) { if (ofnData->dynFileBufferSize < buffersize) { - buffer = (WCHAR *) ckrealloc((char *) buffer, buffersize); + buffer = ckrealloc(buffer, buffersize); ofnData->dynFileBufferSize = buffersize; ofnData->dynFileBuffer = (char *) buffer; } - SendMessageW(hdlg, CDM_GETFOLDERPATH, dirsize, (int) buffer); + SendMessage(hdlg, CDM_GETFOLDERPATH, dirsize, (int) buffer); buffer += dirsize; - SendMessageW(hdlg, CDM_GETSPEC, selsize, (int) buffer); + SendMessage(hdlg, CDM_GETSPEC, selsize, (int) buffer); /* * If there are multiple files, delete the quotes and change @@ -1089,563 +1072,11 @@ OFNHookProcW( * 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, *filter = 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; - } - filter = Tcl_DStringValue(&utfFilterString); - - Tk_MakeWindowExist(tkwin); - hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); - - ZeroMemory(&ofn, sizeof(OPENFILENAMEA)); - if (LOBYTE(LOWORD(GetVersion())) < 5) { - ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400; - } else { - ofn.lStructSize = sizeof(ofn); - } - ofn.hwndOwner = hWnd; - ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner); - ofn.lpstrFilter = NULL; - ofn.lpstrCustomFilter = NULL; - ofn.nMaxCustFilter = 0; - ofn.lpstrFile = (LPTSTR) file; - ofn.nMaxFile = TK_MULTI_MAX_PATH; - ofn.lpstrFileTitle = NULL; - ofn.nMaxFileTitle = 0; - ofn.lpstrInitialDir = NULL; - ofn.lpstrTitle = NULL; - ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR - | OFN_EXPLORER | OFN_ENABLEHOOK; - ofn.nFileOffset = 0; - ofn.nFileExtension = 0; - ofn.lpstrDefExt = NULL; - ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProcA; - ofn.lCustData = (LPARAM) &ofnData; - ofn.lpTemplateName = NULL; - - if (open != 0) { - ofn.Flags |= OFN_FILEMUSTEXIST; - } else { - ofn.Flags |= OFN_OVERWRITEPROMPT; - } - - if (tsdPtr->debugFlag != 0) { - ofnData.interp = interp; - } - - if (multi != 0) { - ofn.Flags |= OFN_ALLOWMULTISELECT; - - /* - * Starting buffer size. The buffer will be expanded by the OFN dialog - * procedure when necessary - */ - - ofnData.dynFileBufferSize = 1024; - ofnData.dynFileBuffer = ckalloc(1024); - } - - if (extension != NULL) { - Tcl_UtfToExternalDString(NULL, extension, -1, &extString); - ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString); - } - Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString), - Tcl_DStringLength(&utfFilterString), &filterString); - ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString); - ofn.nFilterIndex = filterIndex; - - if (Tcl_DStringValue(&utfDirString)[0] != '\0') { - Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString), - Tcl_DStringLength(&utfDirString), &dirString); - } else { - /* - * NT 5.0 changed the meaning of lpstrInitialDir, so we have to ensure - * that we set the [pwd] if the user didn't specify anything else. - */ - - Tcl_DString cwd; - - Tcl_DStringFree(&utfDirString); - if ((Tcl_GetCwd(interp, &utfDirString) == NULL) || - (Tcl_TranslateFileName(interp, - Tcl_DStringValue(&utfDirString), &cwd) == NULL)) { - Tcl_ResetResult(interp); - } else { - Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), - Tcl_DStringLength(&cwd), &dirString); - } - Tcl_DStringFree(&cwd); - } - ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString); - - if (title != NULL) { - Tcl_UtfToExternalDString(NULL, title, -1, &titleString); - ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString); - } - - /* - * Popup the dialog. - */ - - GetCurrentDirectory(MAX_PATH, savePath); - oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - if (open != 0) { - winCode = GetOpenFileName(&ofn); - } else { - winCode = GetSaveFileName(&ofn); - } - Tcl_SetServiceMode(oldMode); - EatSpuriousMessageBugFix(); - SetCurrentDirectory(savePath); - - /* - * Ensure that hWnd is enabled, because it can happen that we have updated - * the wrapper of the parent, which causes us to leave this child disabled - * (Windows loses sync). - */ - - EnableWindow(hWnd, 1); - - /* - * Clear the interp result since anything may have happened during the - * modal loop. - */ - - Tcl_ResetResult(interp); - - /* - * Process the results. - * - * Use the CommDlgExtendedError() function to retrieve the error code. - * This function can return one of about two dozen codes; most of these - * indicate some sort of gross system failure (insufficient memory, bad - * window handles, etc.) Most of the error codes will be ignored; as we - * find we want specific error messages for particular errors, we can - * extend the code as needed. - */ - - cdlgerr = CommDlgExtendedError(); - - /* - * We now allow FNERR_BUFFERTOOSMALL when multiselection is enabled. The - * filename buffer has been dynamically allocated by the OFN dialog - * procedure to accomodate all selected files. - */ - - if ((winCode != 0) - || ((cdlgerr == FNERR_BUFFERTOOSMALL) - && (ofn.Flags & OFN_ALLOWMULTISELECT))) { - if (ofn.Flags & OFN_ALLOWMULTISELECT) { - /* - * The result in dynFileBuffer contains many items, separated by - * NUL characters. It is terminated with two nulls in a row. The - * first element is the directory path (if multiple files are - * selected) or the only returned file (if only a single file has - * been chosen). - */ - - char *files = ofnData.dynFileBuffer; - Tcl_Obj *returnList = Tcl_NewObj(); - int count = 0; - - /* - * Get directory. - */ - - (void) ConvertExternalFilename(NULL, (char *) files, &ds); - - while (*files != '\0') { - while (*files != '\0') { - files++; - } - files++; - if (*files != '\0') { - Tcl_Obj *fullnameObj; - Tcl_DString filename; - - count++; - (void) ConvertExternalFilename(NULL, (char *) files, - &filename); - fullnameObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_AppendToObj(fullnameObj, "/", -1); - Tcl_AppendToObj(fullnameObj, Tcl_DStringValue(&filename), - Tcl_DStringLength(&filename)); - Tcl_DStringFree(&filename); - Tcl_ListObjAppendElement(NULL, returnList, fullnameObj); - } - } - if (count == 0) { - /* - * Only one file was returned. - */ - - Tcl_ListObjAppendElement(NULL, returnList, Tcl_NewStringObj( - Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); - } - Tcl_SetObjResult(interp, returnList); - Tcl_DStringFree(&ds); - } else { - Tcl_AppendResult(interp, ConvertExternalFilename(NULL, - (char *) ofn.lpstrFile, &ds), NULL); - Tcl_DStringFree(&ds); - } - result = TCL_OK; - if ((ofn.nFilterIndex > 0) && - (Tcl_GetCharLength(Tcl_GetObjResult(interp)) > 0) && - typeVariableObj && filterObj) { - int listObjc, count; - Tcl_Obj **listObjv = NULL; - Tcl_Obj **typeInfo = NULL; - - if (Tcl_ListObjGetElements(interp, filterObj, &listObjc, - &listObjv) != TCL_OK) { - result = TCL_ERROR; - } else if (Tcl_ListObjGetElements(interp, - listObjv[ofn.nFilterIndex - 1], &count, - &typeInfo) != TCL_OK) { - result = TCL_ERROR; - } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL, - typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; - } - } - } else if (cdlgerr == FNERR_INVALIDFILENAME) { - Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC); - Tcl_AppendResult(interp, ConvertExternalFilename(NULL, - (char *) ofn.lpstrFile, &ds), "\"", NULL); - Tcl_DStringFree(&ds); - } else { - result = TCL_OK; - } - - if (ofn.lpstrTitle != NULL) { - Tcl_DStringFree(&titleString); - } - if (ofn.lpstrInitialDir != NULL) { - Tcl_DStringFree(&dirString); - } - Tcl_DStringFree(&filterString); - if (ofn.lpstrDefExt != NULL) { - Tcl_DStringFree(&extString); - } - - end: - Tcl_DStringFree(&utfDirString); - Tcl_DStringFree(&utfFilterString); - if (ofnData.dynFileBuffer != NULL) { - ckfree(ofnData.dynFileBuffer); - ofnData.dynFileBuffer = NULL; - } - - return result; -} - -/* - *------------------------------------------------------------------------- - * - * OFNHookProcA -- - * - * Dialog box hook function. This is used to sets the "tk_dialog" - * variable for test/debugging when the dialog is ready to receive - * messages. When multiple file selection is enabled this function - * is used to process the list of names. - * - * Results: - * Returns 0 to allow default processing of messages to occur. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static UINT APIENTRY -OFNHookProcA( - HWND hdlg, /* handle to child dialog window */ - UINT uMsg, /* message identifier */ - WPARAM wParam, /* message parameter */ - LPARAM lParam) /* message parameter */ -{ - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - OPENFILENAME *ofnPtr; - OFNData *ofnData; - - if (uMsg == WM_INITDIALOG) { - TkWinSetUserData(hdlg, lParam); - } else if (uMsg == WM_NOTIFY) { - OFNOTIFY *notifyPtr = (OFNOTIFY *) lParam; - - /* - * This is weird... or not. The CDN_FILEOK is NOT sent when the selection - * exceeds declared buffer size (the nMaxFile member of the OPENFILENAMEW - * struct passed to GetOpenFileNameW function). So, we have to rely on - * the most recent CDN_SELCHANGE then. Unfortunately this means, that - * gathering the selected filenames happens twice when they fit into the - * declared buffer. Luckily, it's not frequent operation so it should - * not incur any noticeable delay. See [tktoolkit-Bugs-2987995] - */ - if (notifyPtr->hdr.code == CDN_FILEOK || - notifyPtr->hdr.code == CDN_SELCHANGE) { - int dirsize, selsize; - char *buffer; - int buffersize; - - /* - * Change of selection. Unscramble the unholy mess that's in the - * selection buffer, resizing it if necessary. - */ - - ofnPtr = notifyPtr->lpOFN; - ofnData = (OFNData *) ofnPtr->lCustData; - buffer = ofnData->dynFileBuffer; - hdlg = GetParent(hdlg); - - selsize = SendMessage(hdlg, CDM_GETSPEC, 0, 0); - dirsize = SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0); - buffersize = selsize + dirsize + 1; - - /* - * Just empty the buffer if dirsize indicates an error [Bug 3071836] - */ - if ((selsize > 1) && (dirsize > 0)) { - if (ofnData->dynFileBufferSize < buffersize) { - buffer = ckrealloc(buffer, buffersize); - ofnData->dynFileBufferSize = buffersize; - ofnData->dynFileBuffer = buffer; - } - - SendMessage(hdlg, CDM_GETFOLDERPATH, dirsize, (int) buffer); - buffer += dirsize; - SendMessage(hdlg, CDM_GETSPEC, selsize, (int) buffer); - - /* - * If there are multiple files, delete the quotes and change - * every second quote to NULL terminator. - */ - - if (buffer[0] == '"') { - BOOL findquote = TRUE; - char *tmp = buffer; - - while (*buffer != '\0') { - if (findquote) { - if (*buffer == '"') { - findquote = FALSE; - } - buffer++; - } else { - if (*buffer == '"') { - findquote = TRUE; - *buffer = '\0'; - } - *tmp++ = *buffer++; - } - } - *tmp = '\0'; /* Second NULL terminator. */ - } else { - buffer[selsize] = '\0'; /* Second NULL terminator. */ - - /* - * Replace directory terminating NULL with a backslash. - */ - - buffer--; - *buffer = '\\'; - } - - } else { - /* - * Nothing is selected, so just empty the string. - */ - - if (buffer != NULL) { - *buffer = '\0'; - } - } - } - } else if (uMsg == WM_WINDOWPOSCHANGED) { - /* - * This message is delivered at the right time to both old-style and - * explorer-style hook procs to enable Tk to set the debug - * information. Unhooks itself so it won't set the debug information - * every time it gets a WM_WINDOWPOSCHANGED message. - */ - 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); } @@ -1678,11 +1109,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; @@ -1700,9 +1131,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); @@ -1738,20 +1169,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; } /* @@ -1806,7 +1239,7 @@ MakeFilter( } Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr)); - ckfree((char *) filterStr); + ckfree(filterStr); TkFreeFileFilters(&flist); return TCL_OK; @@ -1878,6 +1311,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?). * *---------------------------------------------------------------------- */ @@ -1887,22 +1324,22 @@ 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]; int oldMode, result = TCL_ERROR, i; LPCITEMIDLIST pidl; /* Returned by browser */ - BROWSEINFO bInfo; /* Used by browser */ + BROWSEINFOA 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 */ - TCHAR saveDir[MAX_PATH]; + const char *utfTitle = NULL;/* Title for window */ + char saveDir[MAX_PATH]; Tcl_DString titleString; /* UTF Title */ Tcl_DString initDirString; /* Initial directory */ Tcl_Obj *objPtr; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "-initialdir", "-mustexist", "-parent", "-title", NULL }; enum options { @@ -1923,7 +1360,7 @@ Tk_ChooseDirectoryObjCmd( for (i = 1; i < objc; i += 2) { int index; - char *string; + const char *string; Tcl_Obj *optionPtr, *valuePtr; optionPtr = objv[i]; @@ -1953,8 +1390,8 @@ Tk_ChooseDirectoryObjCmd( * happy. */ - GetFullPathName(string, MAX_PATH, saveDir, NULL); - lstrcpyn(cdCBData.utfInitDir, saveDir, MAX_PATH); + GetFullPathNameA(string, MAX_PATH, saveDir, NULL); + lstrcpynA(cdCBData.utfInitDir, saveDir, MAX_PATH); Tcl_DStringFree(&initDirString); break; case DIR_EXIST: @@ -1989,14 +1426,14 @@ Tk_ChooseDirectoryObjCmd( bInfo.hwndOwner = hWnd; bInfo.pszDisplayName = path; bInfo.pidlRoot = NULL; - if (lstrlen(cdCBData.utfInitDir) == 0) { - GetCurrentDirectory(MAX_PATH, cdCBData.utfInitDir); + if (lstrlenA(cdCBData.utfInitDir) == 0) { + GetCurrentDirectoryA(MAX_PATH, cdCBData.utfInitDir); } bInfo.lParam = (LPARAM) &cdCBData; if (utfTitle != NULL) { Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString); - bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString); + bInfo.lpszTitle = (LPSTR) Tcl_DStringValue(&titleString); } else { bInfo.lpszTitle = "Please choose a directory, then select OK."; } @@ -2031,9 +1468,9 @@ Tk_ChooseDirectoryObjCmd( */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - GetCurrentDirectory(MAX_PATH, saveDir); + GetCurrentDirectoryA(MAX_PATH, saveDir); if (SHGetMalloc(&pMalloc) == NOERROR) { - pidl = SHBrowseForFolder(&bInfo); + pidl = SHBrowseForFolderA(&bInfo); /* * This is a fix for Windows 2000, which seems to modify the folder name @@ -2047,17 +1484,17 @@ Tk_ChooseDirectoryObjCmd( */ if (pidl != NULL) { - if (!SHGetPathFromIDList(pidl, path)) { + if (!SHGetPathFromIDListA(pidl, path)) { Tcl_SetResult(interp, "Error: Not a file system folder\n", TCL_VOLATILE); }; pMalloc->lpVtbl->Free(pMalloc, (void *) pidl); - } else if (lstrlen(cdCBData.utfRetDir) > 0) { - lstrcpy(path, cdCBData.utfRetDir); + } else if (lstrlenA(cdCBData.utfRetDir) > 0) { + lstrcpyA(path, cdCBData.utfRetDir); } pMalloc->lpVtbl->Release(pMalloc); } - SetCurrentDirectory(saveDir); + SetCurrentDirectoryA(saveDir); Tcl_SetServiceMode(oldMode); /* @@ -2115,16 +1552,16 @@ ChooseDirectoryValidateProc( LPARAM lParam, LPARAM lpData) { - TCHAR selDir[MAX_PATH]; + char selDir[MAX_PATH]; CHOOSEDIRDATA *chooseDirSharedData = (CHOOSEDIRDATA *) lpData; Tcl_DString initDirString; char string[MAX_PATH]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + 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'; switch (message) { @@ -2133,7 +1570,7 @@ ChooseDirectoryValidateProc( * 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. */ @@ -2148,11 +1585,11 @@ ChooseDirectoryValidateProc( chooseDirSharedData->utfRetDir[0] = '\0'; return 1; } - lstrcpyn(string, Tcl_DStringValue(&initDirString), MAX_PATH); + lstrcpynA(string, Tcl_DStringValue(&initDirString), MAX_PATH); Tcl_DStringFree(&initDirString); - if (SetCurrentDirectory((char *)string) == 0) { - LPTSTR lpFilePart[MAX_PATH]; + if (SetCurrentDirectoryA((char *)string) == 0) { + LPSTR lpFilePart[MAX_PATH]; /* * Get the full path name to the user entry, at this point it does @@ -2160,15 +1597,15 @@ ChooseDirectoryValidateProc( * it. */ - GetFullPathName(string, MAX_PATH, + GetFullPathNameA(string, MAX_PATH, chooseDirSharedData->utfRetDir, /*unused*/ lpFilePart); if (chooseDirSharedData->mustExist) { /* * User HAS to select a valid directory. */ - wsprintf(selDir, TEXT("Directory '%.200s' does not exist,\nplease select or enter an existing directory."), chooseDirSharedData->utfRetDir); - MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK); + wsprintfA(selDir, "Directory '%.200s' does not exist,\nplease select or enter an existing directory.", chooseDirSharedData->utfRetDir); + MessageBoxA(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK); chooseDirSharedData->utfRetDir[0] = '\0'; return 1; } @@ -2178,7 +1615,7 @@ ChooseDirectoryValidateProc( * directory in utfRetDir. */ - GetCurrentDirectory(MAX_PATH, chooseDirSharedData->utfRetDir); + GetCurrentDirectoryA(MAX_PATH, chooseDirSharedData->utfRetDir); return 0; } return 0; @@ -2193,13 +1630,13 @@ ChooseDirectoryValidateProc( * Not called when user changes edit box directly. */ - if (SHGetPathFromIDList((LPITEMIDLIST) lParam, selDir)) { - SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir); + if (SHGetPathFromIDListA((LPITEMIDLIST) lParam, selDir)) { + SendMessageA(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir); // enable the OK button - SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); + SendMessageA(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); } else { // disable the OK button - SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0); + SendMessageA(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0); } UpdateWindow(hwnd); return 1; @@ -2212,7 +1649,7 @@ ChooseDirectoryValidateProc( char *initDir = chooseDirSharedData->utfInitDir; - SetCurrentDirectory(initDir); + SetCurrentDirectoryA(initDir); if (*initDir == '\\') { /* * BFFM_SETSELECTION only understands UNC paths as pidls, so @@ -2234,7 +1671,7 @@ ChooseDirectoryValidateProc( psfFolder, hwnd, NULL, (WCHAR *) Tcl_DStringValue(&ds), &ulCount,&pidlMain,&ulAttr)) && (pidlMain != NULL)) { - SendMessage(hwnd, BFFM_SETSELECTION, FALSE, + SendMessageA(hwnd, BFFM_SETSELECTION, FALSE, (LPARAM) pidlMain); pMalloc->lpVtbl->Free(pMalloc, pidlMain); } @@ -2244,9 +1681,9 @@ ChooseDirectoryValidateProc( pMalloc->lpVtbl->Release(pMalloc); } } else { - SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM) initDir); + SendMessageA(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM) initDir); } - SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); + SendMessageA(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); break; } @@ -2277,15 +1714,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 }; @@ -2293,7 +1730,7 @@ 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(); @@ -2307,7 +1744,7 @@ Tk_MessageBoxObjCmd( for (i = 1; i < objc; i += 2) { int index; - char *string; + const char *string; Tcl_Obj *optionPtr, *valuePtr; optionPtr = objv[i]; @@ -2423,9 +1860,9 @@ Tk_MessageBoxObjCmd( tsdPtr->hSmallIcon = TkWinGetIcon(parent, ICON_SMALL); tsdPtr->hBigIcon = TkWinGetIcon(parent, ICON_BIG); - tsdPtr->hMsgBoxHook = SetWindowsHookEx(WH_CBT, MsgBoxCBTProc, NULL, + tsdPtr->hMsgBoxHook = SetWindowsHookExA(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); @@ -2440,7 +1877,8 @@ Tk_MessageBoxObjCmd( Tcl_DecrRefCount(tmpObj); - Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC); + Tcl_SetResult(interp, + (char *)TkFindStateString(buttonMap, winCode), TCL_STATIC); return TCL_OK; } @@ -2450,8 +1888,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) { /* @@ -2467,9 +1905,9 @@ MsgBoxCBTProc( if (WC_DIALOG == lpcbtcreate->lpcs->lpszClass) { HWND hwnd = (HWND) wParam; - SendMessage(hwnd, WM_SETICON, ICON_SMALL, + SendMessageA(hwnd, WM_SETICON, ICON_SMALL, (LPARAM) tsdPtr->hSmallIcon); - SendMessage(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon); + SendMessageA(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon); } } @@ -2497,7 +1935,7 @@ static void SetTkDialog( ClientData clientData) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); char buf[32]; @@ -2531,6 +1969,548 @@ 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, LOGFONTA *plf) +{ + Tcl_Obj *resObj; + int pt = 0; + + resObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(NULL, resObj, + Tcl_NewStringObj(plf->lfFaceName, -1)); + pt = -MulDiv(plf->lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY)); + Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewIntObj(pt)); + if (plf->lfWeight >= 700) { + Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewStringObj("bold", -1)); + } + if (plf->lfItalic) { + Tcl_ListObjAppendElement(NULL, resObj, + Tcl_NewStringObj("italic", -1)); + } + if (plf->lfUnderline) { + Tcl_ListObjAppendElement(NULL, resObj, + Tcl_NewStringObj("underline", -1)); + } + if (plf->lfStrikeOut) { + Tcl_ListObjAppendElement(NULL, resObj, + Tcl_NewStringObj("overstrike", -1)); + } + return resObj; +} + +static void +ApplyLogfont(Tcl_Interp *interp, Tcl_Obj *cmdObj, HDC hdc, LOGFONTA *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 = (Tcl_Interp *) phd->interp; + Tcl_DoWhenIdle(SetTkDialog, hwndDlg); + } + if (phd->titleObj != NULL) { + Tcl_DString title; + + Tcl_WinUtfToTChar(Tcl_GetString(phd->titleObj), -1, &title); + if (Tcl_DStringLength(&title) > 0) { + 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) { + LOGFONTA lf = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {0, 0}}; + HDC hdc = GetDC(hwndDlg); + + SendMessageA(hwndDlg, WM_CHOOSEFONT_GETLOGFONT, 0, (LPARAM) &lf); + if (phd && phd->cmdObj) { + ApplyLogfont(phd->interp, phd->cmdObj, hdc, &lf); + } + if (phd && phd->parent) { + TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged"); + } + return 1; + } + return 0; /* pass on for default processing */ +} + +/* + * Helper for the FontchooserConfigure command to return the current value of + * any of the options (which may be NULL in the structure) + */ + +enum FontchooserOption { + FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd, + FontchooserVisible +}; + +static Tcl_Obj * +FontchooserCget(HookData *hdPtr, int optionIndex) +{ + Tcl_Obj *resObj = NULL; + + switch(optionIndex) { + case FontchooserParent: + if (hdPtr->parentObj) { + resObj = hdPtr->parentObj; + } else { + resObj = Tcl_NewStringObj(".", 1); + } + break; + case FontchooserTitle: + if (hdPtr->titleObj) { + resObj = hdPtr->titleObj; + } else { + resObj = Tcl_NewStringObj("", 0); + } + break; + case FontchooserFont: + if (hdPtr->fontObj) { + resObj = hdPtr->fontObj; + } else { + resObj = Tcl_NewStringObj("", 0); + } + break; + case FontchooserCmd: + if (hdPtr->cmdObj) { + resObj = hdPtr->cmdObj; + } else { + resObj = Tcl_NewStringObj("", 0); + } + break; + case FontchooserVisible: + resObj = Tcl_NewBooleanObj(hdPtr->hwnd && IsWindow(hdPtr->hwnd)); + break; + default: + resObj = Tcl_NewStringObj("", 0); + } + return resObj; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserConfigureCmd -- + * + * Implementation of the 'tk fontchooser configure' ensemble command. See + * the user documentation for what it does. + * + * Results: + * See the user documentation. + * + * Side effects: + * Per-interp data structure may be modified + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserConfigureCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tk_Window tkwin = clientData; + HookData *hdPtr = NULL; + int i, r = TCL_OK; + static const char *const optionStrings[] = { + "-parent", "-title", "-font", "-command", "-visible", NULL + }; + + hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL); + + /* + * With no arguments we return all the options in a dict. + */ + + if (objc == 1) { + Tcl_Obj *keyObj, *valueObj; + Tcl_Obj *dictObj = Tcl_NewDictObj(); + + for (i = 0; r == TCL_OK && optionStrings[i] != NULL; ++i) { + keyObj = Tcl_NewStringObj(optionStrings[i], -1); + valueObj = FontchooserCget(hdPtr, i); + r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj); + } + if (r == TCL_OK) { + Tcl_SetObjResult(interp, dictObj); + } + return r; + } + + for (i = 1; i < objc; i += 2) { + int optionIndex, len; + + if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, + "option", 0, &optionIndex) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 2) { + /* + * If one option and no arg - return the current value. + */ + + Tcl_SetObjResult(interp, FontchooserCget(hdPtr, optionIndex)); + return TCL_OK; + } + if (i + 1 == objc) { + Tcl_AppendResult(interp, "value for \"", + Tcl_GetString(objv[i]), "\" missing", NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case FontchooserVisible: { + const char *msg = "cannot change read-only option " + "\"-visible\": use the show or hide command"; + + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + return TCL_ERROR; + } + case FontchooserParent: { + Tk_Window parent = Tk_NameToWindow(interp, + Tcl_GetString(objv[i+1]), tkwin); + + if (parent == None) { + return TCL_ERROR; + } + if (hdPtr->parentObj) { + Tcl_DecrRefCount(hdPtr->parentObj); + } + hdPtr->parentObj = objv[i+1]; + if (Tcl_IsShared(hdPtr->parentObj)) { + hdPtr->parentObj = Tcl_DuplicateObj(hdPtr->parentObj); + } + Tcl_IncrRefCount(hdPtr->parentObj); + break; + } + case FontchooserTitle: + if (hdPtr->titleObj) { + Tcl_DecrRefCount(hdPtr->titleObj); + } + hdPtr->titleObj = objv[i+1]; + if (Tcl_IsShared(hdPtr->titleObj)) { + hdPtr->titleObj = Tcl_DuplicateObj(hdPtr->titleObj); + } + Tcl_IncrRefCount(hdPtr->titleObj); + break; + case FontchooserFont: + if (hdPtr->fontObj) { + Tcl_DecrRefCount(hdPtr->fontObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + hdPtr->fontObj = objv[i+1]; + if (Tcl_IsShared(hdPtr->fontObj)) { + hdPtr->fontObj = Tcl_DuplicateObj(hdPtr->fontObj); + } + Tcl_IncrRefCount(hdPtr->fontObj); + } else { + hdPtr->fontObj = NULL; + } + break; + case FontchooserCmd: + if (hdPtr->cmdObj) { + Tcl_DecrRefCount(hdPtr->cmdObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + hdPtr->cmdObj = objv[i+1]; + if (Tcl_IsShared(hdPtr->cmdObj)) { + hdPtr->cmdObj = Tcl_DuplicateObj(hdPtr->cmdObj); + } + Tcl_IncrRefCount(hdPtr->cmdObj); + } else { + hdPtr->cmdObj = NULL; + } + break; + } + } + return TCL_OK; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserShowCmd -- + * + * Implements the 'tk fontchooser show' ensemble command. The per-interp + * configuration data for the dialog is held in an interp associated + * structure. + * + * Calls the Win32 FontChooser API which provides a modal dialog. See + * HookProc where we make a few changes to the dialog and set some + * additional state. + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserShowCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tk_Window tkwin = clientData, parent; + CHOOSEFONTA cf; + LOGFONTA 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(CHOOSEFONTA)); + ZeroMemory(&lf, sizeof(LOGFONTA)); + lf.lfCharSet = DEFAULT_CHARSET; + cf.lStructSize = sizeof(CHOOSEFONTA); + cf.hwndOwner = Tk_GetHWND(Tk_WindowId(parent)); + cf.lpLogFont = &lf; + cf.nFontType = SCREEN_FONTTYPE; + cf.Flags = CF_SCREENFONTS | CF_EFFECTS | CF_ENABLEHOOK; + cf.rgbColors = RGB(0,0,0); + cf.lpfnHook = HookProc; + cf.lCustData = (INT_PTR) hdPtr; + hdPtr->interp = interp; + hdPtr->parent = parent; + hdc = GetDC(cf.hwndOwner); + + if (hdPtr->fontObj != NULL) { + TkFont *fontPtr; + Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, hdPtr->fontObj); + + if (f == NULL) { + return TCL_ERROR; + } + fontPtr = (TkFont *) f; + cf.Flags |= CF_INITTOLOGFONTSTRUCT; + strncpy(lf.lfFaceName, Tk_GetUid(fontPtr->fa.family), LF_FACESIZE-1); + lf.lfFaceName[LF_FACESIZE-1] = 0; + lf.lfHeight = -MulDiv(TkFontGetPoints(tkwin, fontPtr->fa.size), + GetDeviceCaps(hdc, LOGPIXELSY), 72); + if (fontPtr->fa.weight == TK_FW_BOLD) { + lf.lfWeight = FW_BOLD; + } + if (fontPtr->fa.slant != TK_FS_ROMAN) { + lf.lfItalic = TRUE; + } + if (fontPtr->fa.underline) { + lf.lfUnderline = TRUE; + } + if (fontPtr->fa.overstrike) { + lf.lfStrikeOut = TRUE; + } + Tk_FreeFont(f); + } + + if (TCL_OK == r && hdPtr->cmdObj != NULL) { + int len = 0; + + r = Tcl_ListObjLength(interp, hdPtr->cmdObj, &len); + if (len > 0) { + cf.Flags |= CF_APPLY; + } + } + + if (TCL_OK == r) { + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); + if (ChooseFontA(&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 |