diff options
Diffstat (limited to 'win')
| -rw-r--r-- | win/tkWinDialog.c | 441 |
1 files changed, 434 insertions, 7 deletions
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index be6230d..e2a9233 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinDialog.c,v 1.22 2001/10/01 21:20:55 hobbs Exp $ + * RCS: @(#) $Id: tkWinDialog.c,v 1.23 2001/12/28 23:43:44 hobbs Exp $ * */ @@ -19,6 +19,30 @@ #include <dlgs.h> /* includes common dialog template defines */ #include <cderr.h> /* includes the common dialog error codes */ +/* + * The new choose directory dialog is almost ready for prime time, but + * it has a very long first load time that needs to be checked to see + * if it can be sped up, as well as checked for cleanup. -- hobbs + * See Patch #468139 + * +#define USE_NEW_CHOOSEDIR 1 + */ +#ifdef USE_NEW_CHOOSEDIR +#include <shlobj.h> /* includes SHBrowseForFolder */ + +/* + * The following structure is used by the new Tk_ChooseDirectoryObjCmd + * to pass data between it and its callback. Unqiue to Winodws platform. + */ +typedef struct ChooseDirData { + TCHAR utfInitDir[MAX_PATH]; /* Initial folder to use */ + TCHAR utfRetDir[MAX_PATH]; /* Returned folder to use */ + Tcl_Interp *interp; + int mustExist; /* true if file must exist to return from + * callback */ +} CHOOSEDIRDATA; +#endif + typedef struct ThreadSpecificData { int debugFlag; /* Flags whether we should output debugging * information while displaying a builtin @@ -116,8 +140,13 @@ typedef struct ChooseDir { * Definitions of procedures used only in this file. */ +#ifdef USE_NEW_CHOOSEDIR +static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg, + LPARAM wParam, LPARAM lParam); +#else static UINT APIENTRY ChooseDirectoryHookProc(HWND hdlg, UINT uMsg, WPARAM wParam, LPARAM lParam); +#endif static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam, LPARAM lParam); static int GetFileNameA(ClientData clientData, @@ -364,8 +393,9 @@ ColorDlgHookProc(hDlg, uMsg, wParam, lParam) ccPtr = (CHOOSECOLOR *) lParam; title = (const char *) ccPtr->lCustData; if ((title != NULL) && (title[0] != '\0')) { - Tcl_UtfToExternalDString(NULL, title, -1, &ds); - SetWindowText(hDlg, (TCHAR *) Tcl_DStringValue(&ds)); + Tcl_WinUtfToTChar(title, -1, &ds); + (*tkWinProcs->setWindowText)(hDlg, + (TCHAR *) Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } if (tsdPtr->debugFlag) { @@ -1532,6 +1562,397 @@ MakeFilter(interp, string, dsPtr) return TCL_OK; } +#ifdef USE_NEW_CHOOSEDIR +/* + *---------------------------------------------------------------------- + * + * Tk_ChooseDirectoryObjCmd -- + * + * This procedure implements the "tk_chooseDirectory" dialog box + * for the Windows platform. See the user documentation for details + * on what it does. Uses the newer SHBrowseForFolder explorer type + * interface. + * + * Results: + * See user documentation. + * + * Side effects: + * A modal dialog window is created. Tcl_SetServiceMode() is + * called to allow background events to be processed + * + *---------------------------------------------------------------------- + +The procedure tk_chooseDirectory pops up a dialog box for the user to +select a directory. The following option-value pairs are possible as +command line arguments: + +-initialdir dirname + +Specifies that the directories in directory should be displayed when the +dialog pops up. If this parameter is not specified, then the directories +in the current working directory are displayed. If the parameter specifies +a relative path, the return value will convert the relative path to an +absolute path. This option may not always work on the Macintosh. This is +not a bug. Rather, the General Controls control panel on the Mac allows +the end user to override the application default directory. + +-parent window + +Makes window the logical parent of the dialog. The dialog is displayed on +top of its parent window. + +-title titleString + +Specifies a string to display as the title of the dialog box. If this +option is not specified, then a default title will be displayed. + +-mustexist boolean + +Specifies whether the user may specify non-existant directories. If this +parameter is true, then the user may only select directories that already +exist. The default value is false. + +New Behaviour: + +- If mustexist = 0 and a user entered folder does not exist, a prompt will + pop-up asking if the user wants another chance to change it. The old + dialog just returned the bogus entry. On mustexist = 1, the entries MUST + exist before exiting the box with OK. + + Bugs: + +- If valid abs directory name is entered into the entry box and Enter + pressed, the box will close returning the name. This is inconsistent when + entering relative names or names with forward slashes, which are + invalidated then corrected in the callback. After correction, the box is + held open to allow further modification by the user. + +- Not sure how to implement localization of message prompts. +ToDo: +- Fix bugs. + * + */ +int +Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Main window associated with interpreter. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + char path[MAX_PATH]; + int oldMode, result, 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; + HWND hWnd; + char *utfTitle; /* Title for window */ + TCHAR saveDir[MAX_PATH]; + Tcl_DString titleString; /* UTF Title */ + Tcl_DString initDirString; /* Initial directory */ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + static char *optionStrings[] = { + "-initialdir", "-mustexist", "-parent", "-title", (char *) NULL + }; + enum options { + DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE + }; + + /* + * Initialize + */ + result = TCL_ERROR; + path[0] = '\0'; + + ZeroMemory(&cdCBData, sizeof(CHOOSEDIRDATA)); + cdCBData.interp = interp; + + tkwin = (Tk_Window) clientData; + /* + * Process the command line options + */ + for (i = 1; i < objc; i += 2) { + int index; + char *string; + Tcl_Obj *optionPtr, *valuePtr; + + optionPtr = objv[i]; + valuePtr = objv[i + 1]; + + if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", + 0, &index) != TCL_OK) { + goto cleanup; + } + if (i + 1 == objc) { + string = Tcl_GetStringFromObj(optionPtr, NULL); + Tcl_AppendResult(interp, "value for \"", string, "\" missing", + (char *) NULL); + goto cleanup; + } + + string = Tcl_GetString(valuePtr); + switch ((enum options) index) { + case DIR_INITIAL: { + if (Tcl_TranslateFileName(interp, string, + &initDirString) == NULL) { + goto cleanup; + } + string = Tcl_DStringValue(&initDirString); + /* + * Convert possible relative path to full path to keep + * dialog happy + */ + GetFullPathName(string, MAX_PATH, saveDir, NULL); + lstrcpyn(cdCBData.utfInitDir, saveDir, MAX_PATH); + Tcl_DStringFree(&initDirString); + break; + } + case DIR_EXIST: { + if (Tcl_GetBooleanFromObj(interp, valuePtr, + &cdCBData.mustExist) != TCL_OK) { + goto cleanup; + } + break; + } + case DIR_PARENT: { + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { + goto cleanup; + } + break; + } + case FILE_TITLE: { + utfTitle = string; + break; + } + } + } + + /* + * Get ready to call the browser + */ + + Tk_MakeWindowExist(tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); + + /* + * Setup the parameters used by SHBrowseForFolder + */ + + bInfo.hwndOwner = hWnd; + bInfo.pszDisplayName = path; + bInfo.pidlRoot = NULL; + if (lstrlen(cdCBData.utfInitDir) == 0) { + GetCurrentDirectory(MAX_PATH, cdCBData.utfInitDir); + } + bInfo.lParam = (LPARAM) &cdCBData; + + if (utfTitle != NULL) { + Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString); + bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString); + } else { + bInfo.lpszTitle = "Please choose a directory, then select OK."; + } + + /* + * Set flags to add edit box (needs 4.71 Shell DLLs), status text line, + * validate edit box and + */ + bInfo.ulFlags = BIF_EDITBOX | BIF_STATUSTEXT | BIF_RETURNFSANCESTORS + | BIF_VALIDATE; + + /* + * Callback to handle events + */ + bInfo.lpfn = (BFFCALLBACK) ChooseDirectoryValidateProc; + + /* + * Display dialog in background and process result. + * We look to give the user a chance to change their mind + * on an invalid folder if mustexist is 0; + */ + + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); + GetCurrentDirectory(MAX_PATH, saveDir); + if (SHGetMalloc(&pMalloc) == NOERROR) { + pidl = SHBrowseForFolder(&bInfo); + /* Null for cancel button or invalid dir, otherwise valid*/ + if (pidl != NULL) { + if (!SHGetPathFromIDList(pidl, path)) { + Tcl_SetResult(interp, "Error: Not a file system folder\n", + TCL_VOLATILE); + }; + pMalloc->lpVtbl->Free(pMalloc, (void *) pidl); + } else if (lstrlen(cdCBData.utfRetDir) > 0) { + lstrcpy(path, cdCBData.utfRetDir); + } + pMalloc->lpVtbl->Release(pMalloc); + } + SetCurrentDirectory(saveDir); + Tcl_SetServiceMode(oldMode); + + /* + * Ensure that hWnd is enabled, because it can happen that we + * have updated the wrapper of the parent, which causes us to + * leave this child disabled (Windows loses sync). + */ + EnableWindow(hWnd, 1); + + /* + * Change the pathname to the Tcl "normalized" pathname, where + * back slashes are used instead of forward slashes + */ + Tcl_ResetResult(interp); + if (*path) { + char *p; + Tcl_DString ds; + + Tcl_ExternalToUtfDString(NULL, (char *) path, -1, &ds); + for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { + if (*p == '\\') { + *p = '/'; + } + } + Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); + Tcl_DStringFree(&ds); + } + + result = TCL_OK; + + if (utfTitle != NULL) { + Tcl_DStringFree(&titleString); + } + + cleanup: + return result; +} + +/* + *---------------------------------------------------------------------- + * + * ChooseDirectoryValidateProc -- + * + * Hook procedure called by the explorer ChooseDirectory dialog when events + * occur. It is used to validate the text entry the user may have entered. + * + * Results: + * Returns 0 to allow default processing of message, or 1 to + * tell default dialog procedure not to close. + * + *---------------------------------------------------------------------- + */ +static UINT APIENTRY +ChooseDirectoryValidateProc ( + HWND hwnd, + UINT message, + LPARAM lParam, + LPARAM lpData) +{ + TCHAR selDir[MAX_PATH]; + CHOOSEDIRDATA *chooseDirSharedData; + Tcl_DString initDirString; + char string[MAX_PATH]; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + chooseDirSharedData = (CHOOSEDIRDATA *)lpData; + +#ifdef _WIN64 + SetWindowLongPtr(hwnd, GWLP_USERDATA, lpData); +#else + SetWindowLong(hwnd, GWL_USERDATA, lpData); +#endif + + if (tsdPtr->debugFlag) { + tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp; + Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd); + } + chooseDirSharedData->utfRetDir[0] = '\0'; + switch (message) { + case BFFM_VALIDATEFAILED: + /* + * First save and check to see if it is a valid path name, if + * so then make that path the one shown in the + * window. Otherwise, it failed the check and should be treated + * as such. Use Set/GetCurrentDirectory which allows relative + * path names and names with forward slashes. Use + * Tcl_TranslateFileName to make sure names like ~ are + * converted correctly. + */ + Tcl_TranslateFileName(chooseDirSharedData->interp, + (char *)lParam, &initDirString); + lstrcpyn (string, Tcl_DStringValue(&initDirString), MAX_PATH); + Tcl_DStringFree(&initDirString); + + if (SetCurrentDirectory((char *)string) == 0) { + LPTSTR lpFilePart[MAX_PATH]; + /* + * Get the full path name to the user entry, + * at this point it doesn't exist so see if + * it is supposed to. Otherwise just return it. + */ + GetFullPathName(string, MAX_PATH, + chooseDirSharedData->utfRetDir, /*unused*/ lpFilePart); + if (chooseDirSharedData->mustExist) { + /* + * User HAS to select a valid directory. + */ + wsprintf(selDir, _T("Directory '%.200s' does not exist,\nplease select or enter an existing directory."), chooseDirSharedData->utfRetDir); + MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK); + return 1; + } + } else { + /* + * Changed to new folder OK, return immediatly with the + * current directory in utfRetDir. + */ + GetCurrentDirectory(MAX_PATH, chooseDirSharedData->utfRetDir); + return 0; + } + return 0; + + case BFFM_SELCHANGED: + /* + * Set the status window to the currently selected path. + * And enable the OK button if a file system folder, otherwise + * disable the OK button for things like server names. + * perhaps a new switch -enablenonfolders can be used to allow + * non folders to be selected. + * + * Not called when user changes edit box directly. + */ + + if (SHGetPathFromIDList((LPITEMIDLIST) lParam, selDir)) { + SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir); + // enable the OK button + SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); + //EnableWindow(GetDlgItem(hwnd, IDOK), TRUE); + SetCurrentDirectory(selDir); + } else { + // disable the OK button + SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0); + //EnableWindow(GetDlgItem(hwnd, IDOK), FALSE); + } + UpdateWindow(hwnd); + return 1; + + case BFFM_INITIALIZED: + /* + * Directory browser intializing - tell it where to start from, + * user specified parameter. + */ + SetCurrentDirectory((char *) lpData); + SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM)lpData); + SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); + break; + + } + return 0; +} +#else /* *---------------------------------------------------------------------- * @@ -1976,6 +2397,7 @@ ChooseDirectoryHookProc( } return 0; } +#endif /* *---------------------------------------------------------------------- @@ -2003,6 +2425,7 @@ Tk_MessageBoxObjCmd(clientData, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { + Tcl_Encoding unicodeEncoding = Tcl_GetEncoding(NULL, "unicode"); Tk_Window tkwin, parent; HWND hWnd; char *message, *title; @@ -2120,12 +2543,16 @@ Tk_MessageBoxObjCmd(clientData, interp, objc, objv) flags |= icon | type | MB_SYSTEMMODAL; - Tcl_UtfToExternalDString(NULL, message, -1, &messageString); - Tcl_UtfToExternalDString(NULL, title, -1, &titleString); + Tcl_UtfToExternalDString(unicodeEncoding, message, -1, &messageString); + Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString); oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - winCode = MessageBox(hWnd, Tcl_DStringValue(&messageString), - Tcl_DStringValue(&titleString), flags); + /* + * MessageBoxW exists for all platforms. Use it to allow unicode + * error message to be displayed correctly where possible by the OS. + */ + winCode = MessageBoxW(hWnd, (WCHAR *) Tcl_DStringValue(&messageString), + (WCHAR *) Tcl_DStringValue(&titleString), flags); (void) Tcl_SetServiceMode(oldMode); /* |