1/* 2 * tkWinDialog.c -- 3 * 4 * Contains the Windows implementation of the common dialog boxes. 5 * 6 * Copyright (c) 1996-1997 Sun Microsystems, Inc. 7 * 8 * See the file "license.terms" for information on usage and redistribution 9 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 10 * 11 * RCS: @(#) $Id: tkWinDialog.c,v 1.30.2.5 2005/10/05 03:51:09 hobbs Exp $ 12 * 13 */ 14 15#include "tkWinInt.h" 16#include "tkFileFilter.h" 17 18#include <commdlg.h> /* includes common dialog functionality */ 19#include <dlgs.h> /* includes common dialog template defines */ 20#include <cderr.h> /* includes the common dialog error codes */ 21 22/* 23 * This controls the use of the new style tk_chooseDirectory dialog. 24 */ 25#define USE_NEW_CHOOSEDIR 1 26#ifdef USE_NEW_CHOOSEDIR 27#include <shlobj.h> /* includes SHBrowseForFolder */ 28 29/* These needed for compilation with VC++ 5.2 */ 30#ifndef BIF_EDITBOX 31#define BIF_EDITBOX 0x10 32#endif 33#ifndef BIF_VALIDATE 34#define BIF_VALIDATE 0x0020 35#endif 36#ifndef BFFM_VALIDATEFAILED 37#ifdef UNICODE 38#define BFFM_VALIDATEFAILED 4 39#else 40#define BFFM_VALIDATEFAILED 3 41#endif 42#endif 43 44/* 45 * The following structure is used by the new Tk_ChooseDirectoryObjCmd 46 * to pass data between it and its callback. Unqiue to Winodws platform. 47 */ 48typedef struct ChooseDirData { 49 TCHAR utfInitDir[MAX_PATH]; /* Initial folder to use */ 50 TCHAR utfRetDir[MAX_PATH]; /* Returned folder to use */ 51 Tcl_Interp *interp; 52 int mustExist; /* true if file must exist to return from 53 * callback */ 54} CHOOSEDIRDATA; 55#endif 56 57typedef struct ThreadSpecificData { 58 int debugFlag; /* Flags whether we should output debugging 59 * information while displaying a builtin 60 * dialog. */ 61 Tcl_Interp *debugInterp; /* Interpreter to used for debugging. */ 62 UINT WM_LBSELCHANGED; /* Holds a registered windows event used for 63 * communicating between the Directory 64 * Chooser dialog and its hook proc. */ 65 HHOOK hMsgBoxHook; /* Hook proc for tk_messageBox and the */ 66 HICON hSmallIcon; /* icons used by a parent to be used in */ 67 HICON hBigIcon; /* the message box */ 68} ThreadSpecificData; 69static Tcl_ThreadDataKey dataKey; 70 71/* 72 * The following structures are used by Tk_MessageBoxCmd() to parse 73 * arguments and return results. 74 */ 75 76static const TkStateMap iconMap[] = { 77 {MB_ICONERROR, "error"}, 78 {MB_ICONINFORMATION, "info"}, 79 {MB_ICONQUESTION, "question"}, 80 {MB_ICONWARNING, "warning"}, 81 {-1, NULL} 82}; 83 84static const TkStateMap typeMap[] = { 85 {MB_ABORTRETRYIGNORE, "abortretryignore"}, 86 {MB_OK, "ok"}, 87 {MB_OKCANCEL, "okcancel"}, 88 {MB_RETRYCANCEL, "retrycancel"}, 89 {MB_YESNO, "yesno"}, 90 {MB_YESNOCANCEL, "yesnocancel"}, 91 {-1, NULL} 92}; 93 94static const TkStateMap buttonMap[] = { 95 {IDABORT, "abort"}, 96 {IDRETRY, "retry"}, 97 {IDIGNORE, "ignore"}, 98 {IDOK, "ok"}, 99 {IDCANCEL, "cancel"}, 100 {IDNO, "no"}, 101 {IDYES, "yes"}, 102 {-1, NULL} 103}; 104 105static const int buttonFlagMap[] = { 106 MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4 107}; 108 109static const struct {int type; int btnIds[3];} allowedTypes[] = { 110 {MB_ABORTRETRYIGNORE, {IDABORT, IDRETRY, IDIGNORE}}, 111 {MB_OK, {IDOK, -1, -1 }}, 112 {MB_OKCANCEL, {IDOK, IDCANCEL, -1 }}, 113 {MB_RETRYCANCEL, {IDRETRY, IDCANCEL, -1 }}, 114 {MB_YESNO, {IDYES, IDNO, -1 }}, 115 {MB_YESNOCANCEL, {IDYES, IDNO, IDCANCEL}} 116}; 117 118#define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0])) 119 120/* 121 * The value of TK_MULTI_MAX_PATH dictactes how many files can 122 * be retrieved with tk_get*File -multiple 1. It must be allocated 123 * on the stack, so make it large enough but not too large. -- hobbs 124 * The data is stored as <dir>\0<file1>\0<file2>\0...<fileN>\0\0. 125 * MAX_PATH == 260 on Win2K/NT, so *40 is ~10K. 126 */ 127 128#define TK_MULTI_MAX_PATH (MAX_PATH*40) 129 130/* 131 * The following structure is used to pass information between the directory 132 * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc. 133 */ 134 135typedef struct ChooseDir { 136 Tcl_Interp *interp; /* Interp, used only if debug is turned on, 137 * for setting the "tk_dialog" variable. */ 138 int lastCtrl; /* Used by hook proc to keep track of last 139 * control that had input focus, so when OK 140 * is pressed we know whether to browse a 141 * new directory or return. */ 142 int lastIdx; /* Last item that was selected in directory 143 * browser listbox. */ 144 TCHAR path[MAX_PATH]; /* On return from choose directory dialog, 145 * holds the selected path. Cannot return 146 * selected path in ofnPtr->lpstrFile because 147 * the default dialog proc stores a '\0' in 148 * it, since, of course, no _file_ was 149 * selected. */ 150 OPENFILENAME *ofnPtr; /* pointer to the OFN structure */ 151} ChooseDir; 152 153/* 154 * Definitions of procedures used only in this file. 155 */ 156 157#ifdef USE_NEW_CHOOSEDIR 158static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg, 159 LPARAM wParam, LPARAM lParam); 160#else 161static UINT APIENTRY ChooseDirectoryHookProc(HWND hdlg, UINT uMsg, 162 WPARAM wParam, LPARAM lParam); 163#endif 164static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam, 165 LPARAM lParam); 166static int GetFileNameA(ClientData clientData, 167 Tcl_Interp *interp, int objc, 168 Tcl_Obj *CONST objv[], int isOpen); 169static int GetFileNameW(ClientData clientData, 170 Tcl_Interp *interp, int objc, 171 Tcl_Obj *CONST objv[], int isOpen); 172static int MakeFilter(Tcl_Interp *interp, char *string, 173 Tcl_DString *dsPtr); 174static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam, 175 LPARAM lParam); 176static UINT APIENTRY OFNHookProcW(HWND hdlg, UINT uMsg, WPARAM wParam, 177 LPARAM lParam); 178static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam); 179static void SetTkDialog(ClientData clientData); 180 181/* 182 *------------------------------------------------------------------------- 183 * 184 * EatSpuriousMessageBugFix -- 185 * 186 * In the file open/save dialog, double clicking on a list item 187 * causes the dialog box to close, but an unwanted WM_LBUTTONUP 188 * message is sent to the window underneath. If the window underneath 189 * happens to be a windows control (eg a button) then it will be 190 * activated by accident. 191 * 192 * This problem does not occur in dialog boxes, because windows 193 * must do some special processing to solve the problem. (separate 194 * message processing functions are used to cope with keyboard 195 * navigation of controls.) 196 * 197 * Here is one solution. After returning, we poll the message queue 198 * for 200ms looking for WM_LBUTTON up messages. If we see one it's 199 * consumed. If we get a WM_LBUTTONDOWN message, then we exit early, 200 * since the user must be doing something new. This fix only works 201 * for the current application, so the problem will still occur if 202 * the open dialog happens to be over another applications button. 203 * However this is a fairly rare occurrance. 204 * 205 * Results: 206 * None. 207 * 208 * Side effects: 209 * Consumes an unwanted BUTTON messages. 210 * 211 *------------------------------------------------------------------------- 212 */ 213 214static void 215EatSpuriousMessageBugFix(void) 216{ 217 MSG msg; 218 DWORD nTime = GetTickCount() + 200; 219 while (GetTickCount() < nTime) { 220 if (PeekMessage(&msg,0,WM_LBUTTONDOWN,WM_LBUTTONDOWN,PM_NOREMOVE)) { 221 break; 222 } 223 PeekMessage(&msg,0,WM_LBUTTONUP,WM_LBUTTONUP,PM_REMOVE); 224 } 225} 226 227/* 228 *------------------------------------------------------------------------- 229 * 230 * TkWinDialogDebug -- 231 * 232 * Function to turn on/off debugging support for common dialogs under 233 * windows. The variable "tk_debug" is set to the identifier of the 234 * dialog window when the modal dialog window pops up and it is safe to 235 * send messages to the dialog. 236 * 237 * Results: 238 * None. 239 * 240 * Side effects: 241 * This variable only makes sense if just one dialog is up at a time. 242 * 243 *------------------------------------------------------------------------- 244 */ 245 246void 247TkWinDialogDebug( 248 int debug) 249{ 250 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 251 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 252 253 tsdPtr->debugFlag = debug; 254} 255 256/* 257 *------------------------------------------------------------------------- 258 * 259 * Tk_ChooseColorObjCmd -- 260 * 261 * This procedure implements the color dialog box for the Windows 262 * platform. See the user documentation for details on what it 263 * does. 264 * 265 * Results: 266 * See user documentation. 267 * 268 * Side effects: 269 * A dialog window is created the first time this procedure is called. 270 * This window is not destroyed and will be reused the next time the 271 * application invokes the "tk_chooseColor" command. 272 * 273 *------------------------------------------------------------------------- 274 */ 275 276int 277Tk_ChooseColorObjCmd(clientData, interp, objc, objv) 278 ClientData clientData; /* Main window associated with interpreter. */ 279 Tcl_Interp *interp; /* Current interpreter. */ 280 int objc; /* Number of arguments. */ 281 Tcl_Obj *CONST objv[]; /* Argument objects. */ 282{ 283 Tk_Window tkwin, parent; 284 HWND hWnd; 285 int i, oldMode, winCode, result; 286 CHOOSECOLOR chooseColor; 287 static int inited = 0; 288 static COLORREF dwCustColors[16]; 289 static long oldColor; /* the color selected last time */ 290 static CONST char *optionStrings[] = { 291 "-initialcolor", "-parent", "-title", NULL 292 }; 293 enum options { 294 COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE 295 }; 296 297 result = TCL_OK; 298 if (inited == 0) { 299 /* 300 * dwCustColors stores the custom color which the user can 301 * modify. We store these colors in a static array so that the next 302 * time the color dialog pops up, the same set of custom colors 303 * remain in the dialog. 304 */ 305 for (i = 0; i < 16; i++) { 306 dwCustColors[i] = RGB(255-i * 10, i, i * 10); 307 } 308 oldColor = RGB(0xa0, 0xa0, 0xa0); 309 inited = 1; 310 } 311 312 tkwin = (Tk_Window) clientData; 313 314 parent = tkwin; 315 chooseColor.lStructSize = sizeof(CHOOSECOLOR); 316 chooseColor.hwndOwner = NULL; 317 chooseColor.hInstance = NULL; 318 chooseColor.rgbResult = oldColor; 319 chooseColor.lpCustColors = dwCustColors; 320 chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK; 321 chooseColor.lCustData = (LPARAM) NULL; 322 chooseColor.lpfnHook = (LPOFNHOOKPROC) ColorDlgHookProc; 323 chooseColor.lpTemplateName = (LPTSTR) interp; 324 325 for (i = 1; i < objc; i += 2) { 326 int index; 327 char *string; 328 Tcl_Obj *optionPtr, *valuePtr; 329 330 optionPtr = objv[i]; 331 valuePtr = objv[i + 1]; 332 333 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 334 TCL_EXACT, &index) != TCL_OK) { 335 return TCL_ERROR; 336 } 337 if (i + 1 == objc) { 338 string = Tcl_GetStringFromObj(optionPtr, NULL); 339 Tcl_AppendResult(interp, "value for \"", string, "\" missing", 340 (char *) NULL); 341 return TCL_ERROR; 342 } 343 344 string = Tcl_GetStringFromObj(valuePtr, NULL); 345 switch ((enum options) index) { 346 case COLOR_INITIAL: { 347 XColor *colorPtr; 348 349 colorPtr = Tk_GetColor(interp, tkwin, string); 350 if (colorPtr == NULL) { 351 return TCL_ERROR; 352 } 353 chooseColor.rgbResult = RGB(colorPtr->red / 0x100, 354 colorPtr->green / 0x100, colorPtr->blue / 0x100); 355 break; 356 } 357 case COLOR_PARENT: { 358 parent = Tk_NameToWindow(interp, string, tkwin); 359 if (parent == NULL) { 360 return TCL_ERROR; 361 } 362 break; 363 } 364 case COLOR_TITLE: { 365 chooseColor.lCustData = (LPARAM) string; 366 break; 367 } 368 } 369 } 370 371 Tk_MakeWindowExist(parent); 372 chooseColor.hwndOwner = NULL; 373 hWnd = Tk_GetHWND(Tk_WindowId(parent)); 374 chooseColor.hwndOwner = hWnd; 375 376 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); 377 winCode = ChooseColor(&chooseColor); 378 (void) Tcl_SetServiceMode(oldMode); 379 380 /* 381 * Ensure that hWnd is enabled, because it can happen that we 382 * have updated the wrapper of the parent, which causes us to 383 * leave this child disabled (Windows loses sync). 384 */ 385 EnableWindow(hWnd, 1); 386 387 /* 388 * Clear the interp result since anything may have happened during the 389 * modal loop. 390 */ 391 392 Tcl_ResetResult(interp); 393 394 /* 395 * 3. Process the result of the dialog 396 */ 397 398 if (winCode) { 399 /* 400 * User has selected a color 401 */ 402 char color[100]; 403 404 sprintf(color, "#%02x%02x%02x", 405 GetRValue(chooseColor.rgbResult), 406 GetGValue(chooseColor.rgbResult), 407 GetBValue(chooseColor.rgbResult)); 408 Tcl_AppendResult(interp, color, NULL); 409 oldColor = chooseColor.rgbResult; 410 result = TCL_OK; 411 } 412 413 return result; 414} 415 416/* 417 *------------------------------------------------------------------------- 418 * 419 * ColorDlgHookProc -- 420 * 421 * Provides special handling of messages for the Color common dialog 422 * box. Used to set the title when the dialog first appears. 423 * 424 * Results: 425 * The return value is 0 if the default dialog box procedure should 426 * handle the message, non-zero otherwise. 427 * 428 * Side effects: 429 * Changes the title of the dialog window. 430 * 431 *---------------------------------------------------------------------- 432 */ 433 434static UINT CALLBACK 435ColorDlgHookProc(hDlg, uMsg, wParam, lParam) 436 HWND hDlg; /* Handle to the color dialog. */ 437 UINT uMsg; /* Type of message. */ 438 WPARAM wParam; /* First message parameter. */ 439 LPARAM lParam; /* Second message parameter. */ 440{ 441 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 442 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 443 444 switch (uMsg) { 445 case WM_INITDIALOG: { 446 const char *title; 447 CHOOSECOLOR *ccPtr; 448 Tcl_DString ds; 449 450 /* 451 * Set the title string of the dialog. 452 */ 453 454 ccPtr = (CHOOSECOLOR *) lParam; 455 title = (const char *) ccPtr->lCustData; 456 if ((title != NULL) && (title[0] != '\0')) { 457 (*tkWinProcs->setWindowText)(hDlg, 458 Tcl_WinUtfToTChar(title, -1, &ds)); 459 Tcl_DStringFree(&ds); 460 } 461 if (tsdPtr->debugFlag) { 462 tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName; 463 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg); 464 } 465 return TRUE; 466 } 467 } 468 return FALSE; 469} 470 471/* 472 *---------------------------------------------------------------------- 473 * 474 * Tk_GetOpenFileCmd -- 475 * 476 * This procedure implements the "open file" dialog box for the 477 * Windows platform. See the user documentation for details on what 478 * it does. 479 * 480 * Results: 481 * See user documentation. 482 * 483 * Side effects: 484 * A dialog window is created the first this procedure is called. 485 * 486 *---------------------------------------------------------------------- 487 */ 488 489int 490Tk_GetOpenFileObjCmd(clientData, interp, objc, objv) 491 ClientData clientData; /* Main window associated with interpreter. */ 492 Tcl_Interp *interp; /* Current interpreter. */ 493 int objc; /* Number of arguments. */ 494 Tcl_Obj *CONST objv[]; /* Argument objects. */ 495{ 496 if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { 497 return GetFileNameW(clientData, interp, objc, objv, 1); 498 } else { 499 return GetFileNameA(clientData, interp, objc, objv, 1); 500 } 501} 502 503/* 504 *---------------------------------------------------------------------- 505 * 506 * Tk_GetSaveFileCmd -- 507 * 508 * Same as Tk_GetOpenFileCmd but opens a "save file" dialog box 509 * instead 510 * 511 * Results: 512 * Same as Tk_GetOpenFileCmd. 513 * 514 * Side effects: 515 * Same as Tk_GetOpenFileCmd. 516 * 517 *---------------------------------------------------------------------- 518 */ 519 520int 521Tk_GetSaveFileObjCmd(clientData, interp, objc, objv) 522 ClientData clientData; /* Main window associated with interpreter. */ 523 Tcl_Interp *interp; /* Current interpreter. */ 524 int objc; /* Number of arguments. */ 525 Tcl_Obj *CONST objv[]; /* Argument objects. */ 526{ 527 if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { 528 return GetFileNameW(clientData, interp, objc, objv, 0); 529 } else { 530 return GetFileNameA(clientData, interp, objc, objv, 0); 531 } 532} 533 534/* 535 *---------------------------------------------------------------------- 536 * 537 * GetFileNameW -- 538 * 539 * Calls GetOpenFileName() or GetSaveFileName(). 540 * 541 * Results: 542 * See user documentation. 543 * 544 * Side effects: 545 * See user documentation. 546 * 547 *---------------------------------------------------------------------- 548 */ 549 550static int 551GetFileNameW(clientData, interp, objc, objv, open) 552 ClientData clientData; /* Main window associated with interpreter. */ 553 Tcl_Interp *interp; /* Current interpreter. */ 554 int objc; /* Number of arguments. */ 555 Tcl_Obj *CONST objv[]; /* Argument objects. */ 556 int open; /* 1 to call GetOpenFileName(), 0 to 557 * call GetSaveFileName(). */ 558{ 559 OPENFILENAMEW ofn; 560 WCHAR file[TK_MULTI_MAX_PATH]; 561 int result, winCode, oldMode, i, multi = 0; 562 char *extension, *filter, *title; 563 Tk_Window tkwin; 564 HWND hWnd; 565 Tcl_DString utfFilterString, utfDirString; 566 Tcl_DString extString, filterString, dirString, titleString; 567 Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding(); 568 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 569 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 570 static CONST char *saveOptionStrings[] = { 571 "-defaultextension", "-filetypes", "-initialdir", "-initialfile", 572 "-parent", "-title", NULL 573 }; 574 static CONST char *openOptionStrings[] = { 575 "-defaultextension", "-filetypes", "-initialdir", "-initialfile", 576 "-multiple", "-parent", "-title", NULL 577 }; 578 CONST char **optionStrings; 579 580 enum options { 581 FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, 582 FILE_MULTIPLE, FILE_PARENT, FILE_TITLE 583 }; 584 585 result = TCL_ERROR; 586 file[0] = '\0'; 587 588 /* 589 * Parse the arguments. 590 */ 591 592 extension = NULL; 593 filter = NULL; 594 Tcl_DStringInit(&utfFilterString); 595 Tcl_DStringInit(&utfDirString); 596 tkwin = (Tk_Window) clientData; 597 title = NULL; 598 599 if (open) { 600 optionStrings = openOptionStrings; 601 } else { 602 optionStrings = saveOptionStrings; 603 } 604 605 for (i = 1; i < objc; i += 2) { 606 int index; 607 char *string; 608 Tcl_Obj *optionPtr, *valuePtr; 609 610 optionPtr = objv[i]; 611 valuePtr = objv[i + 1]; 612 613 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, 614 "option", 0, &index) != TCL_OK) { 615 goto end; 616 } 617 /* 618 * We want to maximize code sharing between the open and save file 619 * dialog implementations; in particular, the switch statement below. 620 * We use different sets of option strings from the GetIndexFromObj 621 * call above, but a single enumeration for both. The save file 622 * dialog doesn't support -multiple, but it falls in the middle of 623 * the enumeration. Ultimately, this means that when the index found 624 * by GetIndexFromObj is >= FILE_MULTIPLE, when doing a save file 625 * dialog, we have to increment the index, so that it matches the 626 * open file dialog enumeration. 627 */ 628 if (!open && index >= FILE_MULTIPLE) { 629 index++; 630 } 631 if (i + 1 == objc) { 632 string = Tcl_GetStringFromObj(optionPtr, NULL); 633 Tcl_AppendResult(interp, "value for \"", string, "\" missing", 634 (char *) NULL); 635 goto end; 636 } 637 638 string = Tcl_GetStringFromObj(valuePtr, NULL); 639 switch ((enum options) index) { 640 case FILE_DEFAULT: { 641 if (string[0] == '.') { 642 string++; 643 } 644 extension = string; 645 break; 646 } 647 case FILE_TYPES: { 648 Tcl_DStringFree(&utfFilterString); 649 if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) { 650 goto end; 651 } 652 filter = Tcl_DStringValue(&utfFilterString); 653 break; 654 } 655 case FILE_INITDIR: { 656 Tcl_DStringFree(&utfDirString); 657 if (Tcl_TranslateFileName(interp, string, 658 &utfDirString) == NULL) { 659 goto end; 660 } 661 break; 662 } 663 case FILE_INITFILE: { 664 Tcl_DString ds; 665 666 if (Tcl_TranslateFileName(interp, string, &ds) == NULL) { 667 goto end; 668 } 669 Tcl_UtfToExternal(NULL, unicodeEncoding, Tcl_DStringValue(&ds), 670 Tcl_DStringLength(&ds), 0, NULL, (char *) file, 671 sizeof(file), NULL, NULL, NULL); 672 break; 673 } 674 case FILE_MULTIPLE: { 675 if (Tcl_GetBooleanFromObj(interp, valuePtr, 676 &multi) != TCL_OK) { 677 return TCL_ERROR; 678 } 679 break; 680 } 681 case FILE_PARENT: { 682 tkwin = Tk_NameToWindow(interp, string, tkwin); 683 if (tkwin == NULL) { 684 goto end; 685 } 686 break; 687 } 688 case FILE_TITLE: { 689 title = string; 690 break; 691 } 692 } 693 } 694 695 if (filter == NULL) { 696 if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) { 697 goto end; 698 } 699 } 700 701 Tk_MakeWindowExist(tkwin); 702 hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); 703 704 ZeroMemory(&ofn, sizeof(OPENFILENAMEW)); 705 ofn.lStructSize = sizeof(OPENFILENAMEW); 706 ofn.hwndOwner = hWnd; 707#ifdef _WIN64 708 ofn.hInstance = (HINSTANCE) GetWindowLongPtr(ofn.hwndOwner, 709 GWLP_HINSTANCE); 710#else 711 ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner, 712 GWL_HINSTANCE); 713#endif 714 ofn.lpstrFile = (WCHAR *) file; 715 ofn.nMaxFile = TK_MULTI_MAX_PATH; 716 ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST 717 | OFN_NOCHANGEDIR | OFN_EXPLORER; 718 ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProcW; 719 ofn.lCustData = (LPARAM) interp; 720 721 if (open != 0) { 722 ofn.Flags |= OFN_FILEMUSTEXIST; 723 } else { 724 ofn.Flags |= OFN_OVERWRITEPROMPT; 725 } 726 727 if (tsdPtr->debugFlag != 0) { 728 ofn.Flags |= OFN_ENABLEHOOK; 729 } 730 731 if (multi != 0) { 732 ofn.Flags |= OFN_ALLOWMULTISELECT; 733 } 734 735 if (extension != NULL) { 736 Tcl_UtfToExternalDString(unicodeEncoding, extension, -1, &extString); 737 ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString); 738 } 739 740 Tcl_UtfToExternalDString(unicodeEncoding, 741 Tcl_DStringValue(&utfFilterString), 742 Tcl_DStringLength(&utfFilterString), &filterString); 743 ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString); 744 745 if (Tcl_DStringValue(&utfDirString)[0] != '\0') { 746 Tcl_UtfToExternalDString(unicodeEncoding, 747 Tcl_DStringValue(&utfDirString), 748 Tcl_DStringLength(&utfDirString), &dirString); 749 } else { 750 /* 751 * NT 5.0 changed the meaning of lpstrInitialDir, so we have 752 * to ensure that we set the [pwd] if the user didn't specify 753 * anything else. 754 */ 755 Tcl_DString cwd; 756 757 Tcl_DStringFree(&utfDirString); 758 if ((Tcl_GetCwd(interp, &utfDirString) == (char *) NULL) || 759 (Tcl_TranslateFileName(interp, 760 Tcl_DStringValue(&utfDirString), &cwd) == NULL)) { 761 Tcl_ResetResult(interp); 762 } else { 763 Tcl_UtfToExternalDString(unicodeEncoding, Tcl_DStringValue(&cwd), 764 Tcl_DStringLength(&cwd), &dirString); 765 } 766 Tcl_DStringFree(&cwd); 767 } 768 ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString); 769 770 if (title != NULL) { 771 Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString); 772 ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString); 773 } 774 775 /* 776 * Popup the dialog. 777 */ 778 779 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); 780 if (open != 0) { 781 winCode = GetOpenFileNameW(&ofn); 782 } else { 783 winCode = GetSaveFileNameW(&ofn); 784 } 785 Tcl_SetServiceMode(oldMode); 786 EatSpuriousMessageBugFix(); 787 788 /* 789 * Ensure that hWnd is enabled, because it can happen that we 790 * have updated the wrapper of the parent, which causes us to 791 * leave this child disabled (Windows loses sync). 792 */ 793 EnableWindow(hWnd, 1); 794 795 /* 796 * Clear the interp result since anything may have happened during the 797 * modal loop. 798 */ 799 800 Tcl_ResetResult(interp); 801 802 /* 803 * Process the results. 804 */ 805 806 if (winCode != 0) { 807 if (ofn.Flags & OFN_ALLOWMULTISELECT) { 808 /* 809 * The result in custData->szFile contains many items, 810 * separated with null characters. It is terminated with 811 * two nulls in a row. The first element is the directory 812 * path. 813 */ 814 char *dir; 815 char *p; 816 char *file; 817 WCHAR *files; 818 Tcl_DString ds; 819 Tcl_DString fullname, filename; 820 Tcl_Obj *returnList; 821 int count = 0; 822 823 returnList = Tcl_NewObj(); 824 Tcl_IncrRefCount(returnList); 825 826 files = ofn.lpstrFile; 827 Tcl_ExternalToUtfDString(unicodeEncoding, (char *) files, -1, &ds); 828 829 /* Get directory */ 830 dir = Tcl_DStringValue(&ds); 831 for (p = dir; p && *p; p++) { 832 /* 833 * Change the pathname to the Tcl "normalized" pathname, where 834 * back slashes are used instead of forward slashes 835 */ 836 if (*p == '\\') { 837 *p = '/'; 838 } 839 } 840 841 while (*files != '\0') { 842 while (*files != '\0') { 843 files++; 844 } 845 files++; 846 if (*files != '\0') { 847 count++; 848 Tcl_ExternalToUtfDString(unicodeEncoding, 849 (char *)files, -1, &filename); 850 file = Tcl_DStringValue(&filename); 851 for (p = file; *p != '\0'; p++) { 852 if (*p == '\\') { 853 *p = '/'; 854 } 855 } 856 Tcl_DStringInit(&fullname); 857 Tcl_DStringAppend(&fullname, dir, -1); 858 Tcl_DStringAppend(&fullname, "/", -1); 859 Tcl_DStringAppend(&fullname, file, -1); 860 Tcl_ListObjAppendElement(interp, returnList, 861 Tcl_NewStringObj(Tcl_DStringValue(&fullname), -1)); 862 Tcl_DStringFree(&fullname); 863 Tcl_DStringFree(&filename); 864 } 865 } 866 if (count == 0) { 867 /* 868 * Only one file was returned. 869 */ 870 Tcl_ListObjAppendElement(interp, returnList, 871 Tcl_NewStringObj(dir, -1)); 872 } 873 Tcl_SetObjResult(interp, returnList); 874 Tcl_DecrRefCount(returnList); 875 Tcl_DStringFree(&ds); 876 } else { 877 char *p; 878 Tcl_DString ds; 879 880 Tcl_ExternalToUtfDString(unicodeEncoding, 881 (char *) ofn.lpstrFile, -1, &ds); 882 for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { 883 /* 884 * Change the pathname to the Tcl "normalized" pathname, where 885 * back slashes are used instead of forward slashes 886 */ 887 if (*p == '\\') { 888 *p = '/'; 889 } 890 } 891 Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); 892 Tcl_DStringFree(&ds); 893 } 894 result = TCL_OK; 895 } else { 896 /* 897 * Use the CommDlgExtendedError() function to retrieve the error code. 898 * This function can return one of about two dozen codes; most of 899 * these indicate some sort of gross system failure (insufficient 900 * memory, bad window handles, etc.). Most of the error codes will be 901 * ignored; as we find we want more specific error messages for 902 * particular errors, we can extend the code as needed. 903 * 904 * We could also check for FNERR_BUFFERTOOSMALL, but we can't 905 * really do anything about it when it happens. 906 */ 907 908 if (CommDlgExtendedError() == FNERR_INVALIDFILENAME) { 909 char *p; 910 Tcl_DString ds; 911 912 Tcl_ExternalToUtfDString(unicodeEncoding, 913 (char *) ofn.lpstrFile, -1, &ds); 914 for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { 915 /* 916 * Change the pathname to the Tcl "normalized" pathname, 917 * where back slashes are used instead of forward slashes 918 */ 919 if (*p == '\\') { 920 *p = '/'; 921 } 922 } 923 Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC); 924 Tcl_AppendResult(interp, Tcl_DStringValue(&ds), "\"", NULL); 925 Tcl_DStringFree(&ds); 926 } else { 927 result = TCL_OK; 928 } 929 } 930 931 if (ofn.lpstrTitle != NULL) { 932 Tcl_DStringFree(&titleString); 933 } 934 if (ofn.lpstrInitialDir != NULL) { 935 Tcl_DStringFree(&dirString); 936 } 937 Tcl_DStringFree(&filterString); 938 if (ofn.lpstrDefExt != NULL) { 939 Tcl_DStringFree(&extString); 940 } 941 942 end: 943 Tcl_DStringFree(&utfDirString); 944 Tcl_DStringFree(&utfFilterString); 945 946 return result; 947} 948 949/* 950 *------------------------------------------------------------------------- 951 * 952 * OFNHookProcW -- 953 * 954 * Hook procedure called only if debugging is turned on. Sets 955 * the "tk_dialog" variable when the dialog is ready to receive 956 * messages. 957 * 958 * Results: 959 * Returns 0 to allow default processing of messages to occur. 960 * 961 * Side effects: 962 * None. 963 * 964 *------------------------------------------------------------------------- 965 */ 966 967static UINT APIENTRY 968OFNHookProcW( 969 HWND hdlg, // handle to child dialog window 970 UINT uMsg, // message identifier 971 WPARAM wParam, // message parameter 972 LPARAM lParam) // message parameter 973{ 974 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 975 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 976 OPENFILENAMEW *ofnPtr; 977 978 if (uMsg == WM_INITDIALOG) { 979#ifdef _WIN64 980 SetWindowLongPtr(hdlg, GWLP_USERDATA, lParam); 981#else 982 SetWindowLong(hdlg, GWL_USERDATA, lParam); 983#endif 984 } else if (uMsg == WM_WINDOWPOSCHANGED) { 985 /* 986 * This message is delivered at the right time to enable Tk 987 * to set the debug information. Unhooks itself so it 988 * won't set the debug information every time it gets a 989 * WM_WINDOWPOSCHANGED message. 990 */ 991 992#ifdef _WIN64 993 ofnPtr = (OPENFILENAMEW *) GetWindowLongPtr(hdlg, GWLP_USERDATA); 994#else 995 ofnPtr = (OPENFILENAMEW *) GetWindowLong(hdlg, GWL_USERDATA); 996#endif 997 if (ofnPtr != NULL) { 998 hdlg = GetParent(hdlg); 999 tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData; 1000 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg); 1001#ifdef _WIN64 1002 SetWindowLongPtr(hdlg, GWLP_USERDATA, (LPARAM) NULL); 1003#else 1004 SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL); 1005#endif 1006 } 1007 } 1008 return 0; 1009} 1010 1011/* 1012 *---------------------------------------------------------------------- 1013 * 1014 * GetFileNameA -- 1015 * 1016 * Calls GetOpenFileName() or GetSaveFileName(). 1017 * 1018 * Results: 1019 * See user documentation. 1020 * 1021 * Side effects: 1022 * See user documentation. 1023 * 1024 *---------------------------------------------------------------------- 1025 */ 1026 1027static int 1028GetFileNameA(clientData, interp, objc, objv, open) 1029 ClientData clientData; /* Main window associated with interpreter. */ 1030 Tcl_Interp *interp; /* Current interpreter. */ 1031 int objc; /* Number of arguments. */ 1032 Tcl_Obj *CONST objv[]; /* Argument objects. */ 1033 int open; /* 1 to call GetOpenFileName(), 0 to 1034 * call GetSaveFileName(). */ 1035{ 1036 OPENFILENAME ofn; 1037 TCHAR file[TK_MULTI_MAX_PATH], savePath[MAX_PATH]; 1038 int result, winCode, oldMode, i, multi = 0; 1039 char *extension, *filter, *title; 1040 Tk_Window tkwin; 1041 HWND hWnd; 1042 Tcl_DString utfFilterString, utfDirString; 1043 Tcl_DString extString, filterString, dirString, titleString; 1044 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 1045 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 1046 static CONST char *saveOptionStrings[] = { 1047 "-defaultextension", "-filetypes", "-initialdir", "-initialfile", 1048 "-parent", "-title", NULL 1049 }; 1050 static CONST char *openOptionStrings[] = { 1051 "-defaultextension", "-filetypes", "-initialdir", "-initialfile", 1052 "-multiple", "-parent", "-title", NULL 1053 }; 1054 CONST char **optionStrings; 1055 1056 enum options { 1057 FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, 1058 FILE_MULTIPLE, FILE_PARENT, FILE_TITLE 1059 }; 1060 1061 result = TCL_ERROR; 1062 file[0] = '\0'; 1063 1064 /* 1065 * Parse the arguments. 1066 */ 1067 1068 extension = NULL; 1069 filter = NULL; 1070 Tcl_DStringInit(&utfFilterString); 1071 Tcl_DStringInit(&utfDirString); 1072 tkwin = (Tk_Window) clientData; 1073 title = NULL; 1074 1075 if (open) { 1076 optionStrings = openOptionStrings; 1077 } else { 1078 optionStrings = saveOptionStrings; 1079 } 1080 1081 for (i = 1; i < objc; i += 2) { 1082 int index; 1083 char *string; 1084 Tcl_Obj *optionPtr, *valuePtr; 1085 1086 optionPtr = objv[i]; 1087 valuePtr = objv[i + 1]; 1088 1089 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, 1090 "option", 0, &index) != TCL_OK) { 1091 goto end; 1092 } 1093 /* 1094 * We want to maximize code sharing between the open and save file 1095 * dialog implementations; in particular, the switch statement below. 1096 * We use different sets of option strings from the GetIndexFromObj 1097 * call above, but a single enumeration for both. The save file 1098 * dialog doesn't support -multiple, but it falls in the middle of 1099 * the enumeration. Ultimately, this means that when the index found 1100 * by GetIndexFromObj is >= FILE_MULTIPLE, when doing a save file 1101 * dialog, we have to increment the index, so that it matches the 1102 * open file dialog enumeration. 1103 */ 1104 if (!open && index >= FILE_MULTIPLE) { 1105 index++; 1106 } 1107 if (i + 1 == objc) { 1108 string = Tcl_GetStringFromObj(optionPtr, NULL); 1109 Tcl_AppendResult(interp, "value for \"", string, "\" missing", 1110 (char *) NULL); 1111 goto end; 1112 } 1113 1114 string = Tcl_GetStringFromObj(valuePtr, NULL); 1115 switch ((enum options) index) { 1116 case FILE_DEFAULT: { 1117 if (string[0] == '.') { 1118 string++; 1119 } 1120 extension = string; 1121 break; 1122 } 1123 case FILE_TYPES: { 1124 Tcl_DStringFree(&utfFilterString); 1125 if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) { 1126 goto end; 1127 } 1128 filter = Tcl_DStringValue(&utfFilterString); 1129 break; 1130 } 1131 case FILE_INITDIR: { 1132 Tcl_DStringFree(&utfDirString); 1133 if (Tcl_TranslateFileName(interp, string, 1134 &utfDirString) == NULL) { 1135 goto end; 1136 } 1137 break; 1138 } 1139 case FILE_INITFILE: { 1140 Tcl_DString ds; 1141 1142 if (Tcl_TranslateFileName(interp, string, &ds) == NULL) { 1143 goto end; 1144 } 1145 Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds), 1146 Tcl_DStringLength(&ds), 0, NULL, (char *) file, 1147 sizeof(file), NULL, NULL, NULL); 1148 break; 1149 } 1150 case FILE_MULTIPLE: { 1151 if (Tcl_GetBooleanFromObj(interp, valuePtr, 1152 &multi) != TCL_OK) { 1153 return TCL_ERROR; 1154 } 1155 break; 1156 } 1157 case FILE_PARENT: { 1158 tkwin = Tk_NameToWindow(interp, string, tkwin); 1159 if (tkwin == NULL) { 1160 goto end; 1161 } 1162 break; 1163 } 1164 case FILE_TITLE: { 1165 title = string; 1166 break; 1167 } 1168 } 1169 } 1170 1171 if (filter == NULL) { 1172 if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) { 1173 goto end; 1174 } 1175 } 1176 1177 Tk_MakeWindowExist(tkwin); 1178 hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); 1179 1180 ofn.lStructSize = sizeof(ofn); 1181 ofn.hwndOwner = hWnd; 1182#ifdef _WIN64 1183 ofn.hInstance = (HINSTANCE) GetWindowLongPtr(ofn.hwndOwner, 1184 GWLP_HINSTANCE); 1185#else 1186 ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner, 1187 GWL_HINSTANCE); 1188#endif 1189 ofn.lpstrFilter = NULL; 1190 ofn.lpstrCustomFilter = NULL; 1191 ofn.nMaxCustFilter = 0; 1192 ofn.nFilterIndex = 0; 1193 ofn.lpstrFile = (LPTSTR) file; 1194 ofn.nMaxFile = TK_MULTI_MAX_PATH; 1195 ofn.lpstrFileTitle = NULL; 1196 ofn.nMaxFileTitle = 0; 1197 ofn.lpstrInitialDir = NULL; 1198 ofn.lpstrTitle = NULL; 1199 ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST 1200 | OFN_NOCHANGEDIR | OFN_EXPLORER; 1201 ofn.nFileOffset = 0; 1202 ofn.nFileExtension = 0; 1203 ofn.lpstrDefExt = NULL; 1204 ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc; 1205 ofn.lCustData = (LPARAM) interp; 1206 ofn.lpTemplateName = NULL; 1207 1208 if (open != 0) { 1209 ofn.Flags |= OFN_FILEMUSTEXIST; 1210 } else { 1211 ofn.Flags |= OFN_OVERWRITEPROMPT; 1212 } 1213 1214 if (tsdPtr->debugFlag != 0) { 1215 ofn.Flags |= OFN_ENABLEHOOK; 1216 } 1217 1218 if (multi != 0) { 1219 ofn.Flags |= OFN_ALLOWMULTISELECT; 1220 } 1221 1222 if (extension != NULL) { 1223 Tcl_UtfToExternalDString(NULL, extension, -1, &extString); 1224 ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString); 1225 } 1226 Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString), 1227 Tcl_DStringLength(&utfFilterString), &filterString); 1228 ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString); 1229 1230 if (Tcl_DStringValue(&utfDirString)[0] != '\0') { 1231 Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString), 1232 Tcl_DStringLength(&utfDirString), &dirString); 1233 } else { 1234 /* 1235 * NT 5.0 changed the meaning of lpstrInitialDir, so we have 1236 * to ensure that we set the [pwd] if the user didn't specify 1237 * anything else. 1238 */ 1239 Tcl_DString cwd; 1240 1241 Tcl_DStringFree(&utfDirString); 1242 if ((Tcl_GetCwd(interp, &utfDirString) == (char *) NULL) || 1243 (Tcl_TranslateFileName(interp, 1244 Tcl_DStringValue(&utfDirString), &cwd) == NULL)) { 1245 Tcl_ResetResult(interp); 1246 } else { 1247 Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), 1248 Tcl_DStringLength(&cwd), &dirString); 1249 } 1250 Tcl_DStringFree(&cwd); 1251 } 1252 ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString); 1253 1254 if (title != NULL) { 1255 Tcl_UtfToExternalDString(NULL, title, -1, &titleString); 1256 ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString); 1257 } 1258 1259 /* 1260 * Popup the dialog. 1261 */ 1262 1263 GetCurrentDirectory(MAX_PATH, savePath); 1264 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); 1265 if (open != 0) { 1266 winCode = GetOpenFileName(&ofn); 1267 } else { 1268 winCode = GetSaveFileName(&ofn); 1269 } 1270 Tcl_SetServiceMode(oldMode); 1271 EatSpuriousMessageBugFix(); 1272 SetCurrentDirectory(savePath); 1273 1274 /* 1275 * Ensure that hWnd is enabled, because it can happen that we 1276 * have updated the wrapper of the parent, which causes us to 1277 * leave this child disabled (Windows loses sync). 1278 */ 1279 EnableWindow(hWnd, 1); 1280 1281 /* 1282 * Clear the interp result since anything may have happened during the 1283 * modal loop. 1284 */ 1285 1286 Tcl_ResetResult(interp); 1287 1288 /* 1289 * Process the results. 1290 */ 1291 1292 if (winCode != 0) { 1293 if (ofn.Flags & OFN_ALLOWMULTISELECT) { 1294 /* 1295 * The result in custData->szFile contains many items, 1296 * separated with null characters. It is terminated with 1297 * two nulls in a row. The first element is the directory 1298 * path. 1299 */ 1300 char *dir; 1301 char *p; 1302 char *file; 1303 char *files; 1304 Tcl_DString ds; 1305 Tcl_DString fullname, filename; 1306 Tcl_Obj *returnList; 1307 int count = 0; 1308 1309 returnList = Tcl_NewObj(); 1310 Tcl_IncrRefCount(returnList); 1311 1312 files = ofn.lpstrFile; 1313 Tcl_ExternalToUtfDString(NULL, (char *) files, -1, &ds); 1314 1315 /* Get directory */ 1316 dir = Tcl_DStringValue(&ds); 1317 for (p = dir; p && *p; p++) { 1318 /* 1319 * Change the pathname to the Tcl "normalized" pathname, where 1320 * back slashes are used instead of forward slashes 1321 */ 1322 if (*p == '\\') { 1323 *p = '/'; 1324 } 1325 } 1326 1327 while (*files != '\0') { 1328 while (*files != '\0') { 1329 files++; 1330 } 1331 files++; 1332 if (*files != '\0') { 1333 count++; 1334 Tcl_ExternalToUtfDString(NULL, 1335 (char *)files, -1, &filename); 1336 file = Tcl_DStringValue(&filename); 1337 for (p = file; *p != '\0'; p++) { 1338 if (*p == '\\') { 1339 *p = '/'; 1340 } 1341 } 1342 Tcl_DStringInit(&fullname); 1343 Tcl_DStringAppend(&fullname, dir, -1); 1344 Tcl_DStringAppend(&fullname, "/", -1); 1345 Tcl_DStringAppend(&fullname, file, -1); 1346 Tcl_ListObjAppendElement(interp, returnList, 1347 Tcl_NewStringObj(Tcl_DStringValue(&fullname), -1)); 1348 Tcl_DStringFree(&fullname); 1349 Tcl_DStringFree(&filename); 1350 } 1351 } 1352 if (count == 0) { 1353 /* 1354 * Only one file was returned. 1355 */ 1356 Tcl_ListObjAppendElement(interp, returnList, 1357 Tcl_NewStringObj(dir, -1)); 1358 } 1359 Tcl_SetObjResult(interp, returnList); 1360 Tcl_DecrRefCount(returnList); 1361 Tcl_DStringFree(&ds); 1362 } else { 1363 char *p; 1364 Tcl_DString ds; 1365 1366 Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds); 1367 for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { 1368 /* 1369 * Change the pathname to the Tcl "normalized" pathname, where 1370 * back slashes are used instead of forward slashes 1371 */ 1372 if (*p == '\\') { 1373 *p = '/'; 1374 } 1375 } 1376 Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); 1377 Tcl_DStringFree(&ds); 1378 } 1379 result = TCL_OK; 1380 } else { 1381 /* 1382 * Use the CommDlgExtendedError() function to retrieve the error code. 1383 * This function can return one of about two dozen codes; most of 1384 * these indicate some sort of gross system failure (insufficient 1385 * memory, bad window handles, etc.). Most of the error codes will be 1386 * ignored;; as we find we want specific error messages for particular 1387 * errors, we can extend the code as needed. 1388 * 1389 * We could also check for FNERR_BUFFERTOOSMALL, but we can't 1390 * really do anything about it when it happens. 1391 */ 1392 if (CommDlgExtendedError() == FNERR_INVALIDFILENAME) { 1393 char *p; 1394 Tcl_DString ds; 1395 1396 Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds); 1397 for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { 1398 /* 1399 * Change the pathname to the Tcl "normalized" pathname, 1400 * where back slashes are used instead of forward slashes 1401 */ 1402 if (*p == '\\') { 1403 *p = '/'; 1404 } 1405 } 1406 Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC); 1407 Tcl_AppendResult(interp, Tcl_DStringValue(&ds), "\"", NULL); 1408 Tcl_DStringFree(&ds); 1409 } else { 1410 result = TCL_OK; 1411 } 1412 } 1413 1414 if (ofn.lpstrTitle != NULL) { 1415 Tcl_DStringFree(&titleString); 1416 } 1417 if (ofn.lpstrInitialDir != NULL) { 1418 Tcl_DStringFree(&dirString); 1419 } 1420 Tcl_DStringFree(&filterString); 1421 if (ofn.lpstrDefExt != NULL) { 1422 Tcl_DStringFree(&extString); 1423 } 1424 1425 end: 1426 Tcl_DStringFree(&utfDirString); 1427 Tcl_DStringFree(&utfFilterString); 1428 1429 return result; 1430} 1431 1432/* 1433 *------------------------------------------------------------------------- 1434 * 1435 * OFNHookProc -- 1436 * 1437 * Hook procedure called only if debugging is turned on. Sets 1438 * the "tk_dialog" variable when the dialog is ready to receive 1439 * messages. 1440 * 1441 * Results: 1442 * Returns 0 to allow default processing of messages to occur. 1443 * 1444 * Side effects: 1445 * None. 1446 * 1447 *------------------------------------------------------------------------- 1448 */ 1449 1450static UINT APIENTRY 1451OFNHookProc( 1452 HWND hdlg, // handle to child dialog window 1453 UINT uMsg, // message identifier 1454 WPARAM wParam, // message parameter 1455 LPARAM lParam) // message parameter 1456{ 1457 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 1458 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 1459 OPENFILENAME *ofnPtr; 1460 1461 if (uMsg == WM_INITDIALOG) { 1462#ifdef _WIN64 1463 SetWindowLongPtr(hdlg, GWLP_USERDATA, lParam); 1464#else 1465 SetWindowLong(hdlg, GWL_USERDATA, lParam); 1466#endif 1467 } else if (uMsg == WM_WINDOWPOSCHANGED) { 1468 /* 1469 * This message is delivered at the right time to both 1470 * old-style and explorer-style hook procs to enable Tk 1471 * to set the debug information. Unhooks itself so it 1472 * won't set the debug information every time it gets a 1473 * WM_WINDOWPOSCHANGED message. 1474 */ 1475 1476#ifdef _WIN64 1477 ofnPtr = (OPENFILENAME *) GetWindowLongPtr(hdlg, GWLP_USERDATA); 1478#else 1479 ofnPtr = (OPENFILENAME *) GetWindowLong(hdlg, GWL_USERDATA); 1480#endif 1481 if (ofnPtr != NULL) { 1482 if (ofnPtr->Flags & OFN_EXPLORER) { 1483 hdlg = GetParent(hdlg); 1484 } 1485 tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData; 1486 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg); 1487#ifdef _WIN64 1488 SetWindowLongPtr(hdlg, GWLP_USERDATA, (LPARAM) NULL); 1489#else 1490 SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL); 1491#endif 1492 } 1493 } 1494 return 0; 1495} 1496 1497/* 1498 *---------------------------------------------------------------------- 1499 * 1500 * MakeFilter -- 1501 * 1502 * Allocate a buffer to store the filters in a format understood by 1503 * Windows 1504 * 1505 * Results: 1506 * A standard TCL return value. 1507 * 1508 * Side effects: 1509 * ofnPtr->lpstrFilter is modified. 1510 * 1511 *---------------------------------------------------------------------- 1512 */ 1513static int 1514MakeFilter(interp, string, dsPtr) 1515 Tcl_Interp *interp; /* Current interpreter. */ 1516 char *string; /* String value of the -filetypes option */ 1517 Tcl_DString *dsPtr; /* Filled with windows filter string. */ 1518{ 1519 char *filterStr; 1520 char *p; 1521 int pass; 1522 FileFilterList flist; 1523 FileFilter *filterPtr; 1524 1525 TkInitFileFilters(&flist); 1526 if (TkGetFileFilters(interp, &flist, string, 1) != TCL_OK) { 1527 return TCL_ERROR; 1528 } 1529 1530 if (flist.filters == NULL) { 1531 /* 1532 * Use "All Files (*.*) as the default filter if none is specified 1533 */ 1534 char *defaultFilter = "All Files (*.*)"; 1535 1536 p = filterStr = (char*)ckalloc(30 * sizeof(char)); 1537 1538 strcpy(p, defaultFilter); 1539 p+= strlen(defaultFilter); 1540 1541 *p++ = '\0'; 1542 *p++ = '*'; 1543 *p++ = '.'; 1544 *p++ = '*'; 1545 *p++ = '\0'; 1546 *p++ = '\0'; 1547 *p = '\0'; 1548 1549 } else { 1550 /* We format the filetype into a string understood by Windows: 1551 * {"Text Documents" {.doc .txt} {TEXT}} becomes 1552 * "Text Documents (*.doc,*.txt)\0*.doc;*.txt\0" 1553 * 1554 * See the Windows OPENFILENAME manual page for details on the filter 1555 * string format. 1556 */ 1557 1558 /* 1559 * Since we may only add asterisks (*) to the filter, we need at most 1560 * twice the size of the string to format the filter 1561 */ 1562 filterStr = ckalloc((unsigned int) strlen(string) * 3); 1563 1564 for (filterPtr = flist.filters, p = filterStr; filterPtr; 1565 filterPtr = filterPtr->next) { 1566 char *sep; 1567 FileFilterClause *clausePtr; 1568 1569 /* 1570 * First, put in the name of the file type 1571 */ 1572 strcpy(p, filterPtr->name); 1573 p+= strlen(filterPtr->name); 1574 *p++ = ' '; 1575 *p++ = '('; 1576 1577 for (pass = 1; pass <= 2; pass++) { 1578 /* 1579 * In the first pass, we format the extensions in the 1580 * name field. In the second pass, we format the extensions in 1581 * the filter pattern field 1582 */ 1583 sep = ""; 1584 for (clausePtr=filterPtr->clauses;clausePtr; 1585 clausePtr=clausePtr->next) { 1586 GlobPattern *globPtr; 1587 1588 1589 for (globPtr=clausePtr->patterns; globPtr; 1590 globPtr=globPtr->next) { 1591 strcpy(p, sep); 1592 p+= strlen(sep); 1593 strcpy(p, globPtr->pattern); 1594 p+= strlen(globPtr->pattern); 1595 1596 if (pass==1) { 1597 sep = ","; 1598 } else { 1599 sep = ";"; 1600 } 1601 } 1602 } 1603 if (pass == 1) { 1604 if (pass == 1) { 1605 *p ++ = ')'; 1606 } 1607 } 1608 *p ++ = '\0'; 1609 } 1610 } 1611 1612 /* 1613 * Windows requires the filter string to be ended by two NULL 1614 * characters. 1615 */ 1616 *p++ = '\0'; 1617 *p = '\0'; 1618 } 1619 1620 Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr)); 1621 ckfree((char *) filterStr); 1622 1623 TkFreeFileFilters(&flist); 1624 return TCL_OK; 1625} 1626 1627#ifdef USE_NEW_CHOOSEDIR 1628/* 1629 *---------------------------------------------------------------------- 1630 * 1631 * Tk_ChooseDirectoryObjCmd -- 1632 * 1633 * This procedure implements the "tk_chooseDirectory" dialog box 1634 * for the Windows platform. See the user documentation for details 1635 * on what it does. Uses the newer SHBrowseForFolder explorer type 1636 * interface. 1637 * 1638 * Results: 1639 * See user documentation. 1640 * 1641 * Side effects: 1642 * A modal dialog window is created. Tcl_SetServiceMode() is 1643 * called to allow background events to be processed 1644 * 1645 *---------------------------------------------------------------------- 1646 1647The procedure tk_chooseDirectory pops up a dialog box for the user to 1648select a directory. The following option-value pairs are possible as 1649command line arguments: 1650 1651-initialdir dirname 1652 1653Specifies that the directories in directory should be displayed when the 1654dialog pops up. If this parameter is not specified, then the directories 1655in the current working directory are displayed. If the parameter specifies 1656a relative path, the return value will convert the relative path to an 1657absolute path. This option may not always work on the Macintosh. This is 1658not a bug. Rather, the General Controls control panel on the Mac allows 1659the end user to override the application default directory. 1660 1661-parent window 1662 1663Makes window the logical parent of the dialog. The dialog is displayed on 1664top of its parent window. 1665 1666-title titleString 1667 1668Specifies a string to display as the title of the dialog box. If this 1669option is not specified, then a default title will be displayed. 1670 1671-mustexist boolean 1672 1673Specifies whether the user may specify non-existant directories. If this 1674parameter is true, then the user may only select directories that already 1675exist. The default value is false. 1676 1677New Behaviour: 1678 1679- If mustexist = 0 and a user entered folder does not exist, a prompt will 1680 pop-up asking if the user wants another chance to change it. The old 1681 dialog just returned the bogus entry. On mustexist = 1, the entries MUST 1682 exist before exiting the box with OK. 1683 1684 Bugs: 1685 1686- If valid abs directory name is entered into the entry box and Enter 1687 pressed, the box will close returning the name. This is inconsistent when 1688 entering relative names or names with forward slashes, which are 1689 invalidated then corrected in the callback. After correction, the box is 1690 held open to allow further modification by the user. 1691 1692- Not sure how to implement localization of message prompts. 1693 1694- -title is really -message. 1695ToDo: 1696- Fix bugs. 1697- test to see what platforms this really works on. May require v4.71 1698 of shell32.dll everywhere (what is standard?). 1699 * 1700 */ 1701int 1702Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv) 1703 ClientData clientData; /* Main window associated with interpreter. */ 1704 Tcl_Interp *interp; /* Current interpreter. */ 1705 int objc; /* Number of arguments. */ 1706 Tcl_Obj *CONST objv[]; /* Argument objects. */ 1707{ 1708 char path[MAX_PATH]; 1709 int oldMode, result, i; 1710 LPCITEMIDLIST pidl; /* Returned by browser */ 1711 BROWSEINFO bInfo; /* Used by browser */ 1712 CHOOSEDIRDATA cdCBData; /* Structure to pass back and forth */ 1713 LPMALLOC pMalloc; /* Used by shell */ 1714 1715 Tk_Window tkwin; 1716 HWND hWnd; 1717 char *utfTitle; /* Title for window */ 1718 TCHAR saveDir[MAX_PATH]; 1719 Tcl_DString titleString; /* UTF Title */ 1720 Tcl_DString initDirString; /* Initial directory */ 1721 static CONST char *optionStrings[] = { 1722 "-initialdir", "-mustexist", "-parent", "-title", (char *) NULL 1723 }; 1724 enum options { 1725 DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE 1726 }; 1727 1728 /* 1729 * Initialize 1730 */ 1731 result = TCL_ERROR; 1732 path[0] = '\0'; 1733 utfTitle = NULL; 1734 1735 ZeroMemory(&cdCBData, sizeof(CHOOSEDIRDATA)); 1736 cdCBData.interp = interp; 1737 1738 tkwin = (Tk_Window) clientData; 1739 /* 1740 * Process the command line options 1741 */ 1742 for (i = 1; i < objc; i += 2) { 1743 int index; 1744 char *string; 1745 Tcl_Obj *optionPtr, *valuePtr; 1746 1747 optionPtr = objv[i]; 1748 valuePtr = objv[i + 1]; 1749 1750 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 1751 0, &index) != TCL_OK) { 1752 goto cleanup; 1753 } 1754 if (i + 1 == objc) { 1755 string = Tcl_GetStringFromObj(optionPtr, NULL); 1756 Tcl_AppendResult(interp, "value for \"", string, "\" missing", 1757 (char *) NULL); 1758 goto cleanup; 1759 } 1760 1761 string = Tcl_GetString(valuePtr); 1762 switch ((enum options) index) { 1763 case DIR_INITIAL: { 1764 if (Tcl_TranslateFileName(interp, string, 1765 &initDirString) == NULL) { 1766 goto cleanup; 1767 } 1768 string = Tcl_DStringValue(&initDirString); 1769 /* 1770 * Convert possible relative path to full path to keep 1771 * dialog happy 1772 */ 1773 GetFullPathName(string, MAX_PATH, saveDir, NULL); 1774 lstrcpyn(cdCBData.utfInitDir, saveDir, MAX_PATH); 1775 Tcl_DStringFree(&initDirString); 1776 break; 1777 } 1778 case DIR_EXIST: { 1779 if (Tcl_GetBooleanFromObj(interp, valuePtr, 1780 &cdCBData.mustExist) != TCL_OK) { 1781 goto cleanup; 1782 } 1783 break; 1784 } 1785 case DIR_PARENT: { 1786 tkwin = Tk_NameToWindow(interp, string, tkwin); 1787 if (tkwin == NULL) { 1788 goto cleanup; 1789 } 1790 break; 1791 } 1792 case FILE_TITLE: { 1793 utfTitle = string; 1794 break; 1795 } 1796 } 1797 } 1798 1799 /* 1800 * Get ready to call the browser 1801 */ 1802 1803 Tk_MakeWindowExist(tkwin); 1804 hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); 1805 1806 /* 1807 * Setup the parameters used by SHBrowseForFolder 1808 */ 1809 1810 bInfo.hwndOwner = hWnd; 1811 bInfo.pszDisplayName = path; 1812 bInfo.pidlRoot = NULL; 1813 if (lstrlen(cdCBData.utfInitDir) == 0) { 1814 GetCurrentDirectory(MAX_PATH, cdCBData.utfInitDir); 1815 } 1816 bInfo.lParam = (LPARAM) &cdCBData; 1817 1818 if (utfTitle != NULL) { 1819 Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString); 1820 bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString); 1821 } else { 1822 bInfo.lpszTitle = "Please choose a directory, then select OK."; 1823 } 1824 1825 /* 1826 * Set flags to add edit box (needs 4.71 Shell DLLs), status text line, 1827 * validate edit box and 1828 */ 1829 bInfo.ulFlags = BIF_EDITBOX | BIF_STATUSTEXT | BIF_RETURNFSANCESTORS 1830 | BIF_VALIDATE; 1831 1832 /* 1833 * Callback to handle events 1834 */ 1835 bInfo.lpfn = (BFFCALLBACK) ChooseDirectoryValidateProc; 1836 1837 /* 1838 * Display dialog in background and process result. 1839 * We look to give the user a chance to change their mind 1840 * on an invalid folder if mustexist is 0; 1841 */ 1842 1843 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); 1844 GetCurrentDirectory(MAX_PATH, saveDir); 1845 if (SHGetMalloc(&pMalloc) == NOERROR) { 1846 pidl = SHBrowseForFolder(&bInfo); 1847 /* Null for cancel button or invalid dir, otherwise valid*/ 1848 if (pidl != NULL) { 1849 if (!SHGetPathFromIDList(pidl, path)) { 1850 Tcl_SetResult(interp, "Error: Not a file system folder\n", 1851 TCL_VOLATILE); 1852 }; 1853 pMalloc->lpVtbl->Free(pMalloc, (void *) pidl); 1854 } else if (lstrlen(cdCBData.utfRetDir) > 0) { 1855 lstrcpy(path, cdCBData.utfRetDir); 1856 } 1857 pMalloc->lpVtbl->Release(pMalloc); 1858 } 1859 SetCurrentDirectory(saveDir); 1860 Tcl_SetServiceMode(oldMode); 1861 1862 /* 1863 * Ensure that hWnd is enabled, because it can happen that we 1864 * have updated the wrapper of the parent, which causes us to 1865 * leave this child disabled (Windows loses sync). 1866 */ 1867 EnableWindow(hWnd, 1); 1868 1869 /* 1870 * Change the pathname to the Tcl "normalized" pathname, where 1871 * back slashes are used instead of forward slashes 1872 */ 1873 Tcl_ResetResult(interp); 1874 if (*path) { 1875 char *p; 1876 Tcl_DString ds; 1877 1878 Tcl_ExternalToUtfDString(NULL, (char *) path, -1, &ds); 1879 for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { 1880 if (*p == '\\') { 1881 *p = '/'; 1882 } 1883 } 1884 Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); 1885 Tcl_DStringFree(&ds); 1886 } 1887 1888 result = TCL_OK; 1889 1890 if (utfTitle != NULL) { 1891 Tcl_DStringFree(&titleString); 1892 } 1893 1894 cleanup: 1895 return result; 1896} 1897 1898/* 1899 *---------------------------------------------------------------------- 1900 * 1901 * ChooseDirectoryValidateProc -- 1902 * 1903 * Hook procedure called by the explorer ChooseDirectory dialog when events 1904 * occur. It is used to validate the text entry the user may have entered. 1905 * 1906 * Results: 1907 * Returns 0 to allow default processing of message, or 1 to 1908 * tell default dialog procedure not to close. 1909 * 1910 *---------------------------------------------------------------------- 1911 */ 1912static UINT APIENTRY 1913ChooseDirectoryValidateProc ( 1914 HWND hwnd, 1915 UINT message, 1916 LPARAM lParam, 1917 LPARAM lpData) 1918{ 1919 TCHAR selDir[MAX_PATH]; 1920 CHOOSEDIRDATA *chooseDirSharedData; 1921 Tcl_DString initDirString; 1922 char string[MAX_PATH]; 1923 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 1924 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 1925 1926 chooseDirSharedData = (CHOOSEDIRDATA *)lpData; 1927 1928#ifdef _WIN64 1929 SetWindowLongPtr(hwnd, GWLP_USERDATA, lpData); 1930#else 1931 SetWindowLong(hwnd, GWL_USERDATA, lpData); 1932#endif 1933 1934 if (tsdPtr->debugFlag) { 1935 tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp; 1936 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd); 1937 } 1938 chooseDirSharedData->utfRetDir[0] = '\0'; 1939 switch (message) { 1940 case BFFM_VALIDATEFAILED: 1941 /* 1942 * First save and check to see if it is a valid path name, if 1943 * so then make that path the one shown in the 1944 * window. Otherwise, it failed the check and should be treated 1945 * as such. Use Set/GetCurrentDirectory which allows relative 1946 * path names and names with forward slashes. Use 1947 * Tcl_TranslateFileName to make sure names like ~ are 1948 * converted correctly. 1949 */ 1950 Tcl_TranslateFileName(chooseDirSharedData->interp, 1951 (char *)lParam, &initDirString); 1952 lstrcpyn (string, Tcl_DStringValue(&initDirString), MAX_PATH); 1953 Tcl_DStringFree(&initDirString); 1954 1955 if (SetCurrentDirectory((char *)string) == 0) { 1956 LPTSTR lpFilePart[MAX_PATH]; 1957 1958 /* 1959 * Get the full path name to the user entry, 1960 * at this point it doesn't exist so see if 1961 * it is supposed to. Otherwise just return it. 1962 */ 1963 GetFullPathName(string, MAX_PATH, 1964 chooseDirSharedData->utfRetDir, /*unused*/ lpFilePart); 1965 if (chooseDirSharedData->mustExist) { 1966 /* 1967 * User HAS to select a valid directory. 1968 */ 1969 wsprintf(selDir, TEXT("Directory '%.200s' does not exist,\nplease select or enter an existing directory."), chooseDirSharedData->utfRetDir); 1970 MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK); 1971 chooseDirSharedData->utfRetDir[0] = '\0'; 1972 return 1; 1973 } 1974 } else { 1975 /* 1976 * Changed to new folder OK, return immediatly with the 1977 * current directory in utfRetDir. 1978 */ 1979 GetCurrentDirectory(MAX_PATH, chooseDirSharedData->utfRetDir); 1980 return 0; 1981 } 1982 return 0; 1983 1984 case BFFM_SELCHANGED: 1985 /* 1986 * Set the status window to the currently selected path. 1987 * And enable the OK button if a file system folder, otherwise 1988 * disable the OK button for things like server names. 1989 * perhaps a new switch -enablenonfolders can be used to allow 1990 * non folders to be selected. 1991 * 1992 * Not called when user changes edit box directly. 1993 */ 1994 1995 if (SHGetPathFromIDList((LPITEMIDLIST) lParam, selDir)) { 1996 SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir); 1997 // enable the OK button 1998 SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); 1999 SetCurrentDirectory(selDir); 2000 } else { 2001 // disable the OK button 2002 SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0); 2003 } 2004 UpdateWindow(hwnd); 2005 return 1; 2006 2007 case BFFM_INITIALIZED: { 2008 /* 2009 * Directory browser intializing - tell it where to start from, 2010 * user specified parameter. 2011 */ 2012 char *initDir = chooseDirSharedData->utfInitDir; 2013 2014 SetCurrentDirectory(initDir); 2015 if (*initDir == '\\') { 2016 /* 2017 * BFFM_SETSELECTION only understands UNC paths as pidls, 2018 * so convert path to pidl using IShellFolder interface. 2019 */ 2020 LPMALLOC pMalloc; 2021 LPSHELLFOLDER psfFolder; 2022 2023 if (SUCCEEDED(SHGetMalloc(&pMalloc))) { 2024 if (SUCCEEDED(SHGetDesktopFolder(&psfFolder))) { 2025 LPITEMIDLIST pidlMain; 2026 ULONG ulCount, ulAttr; 2027 Tcl_DString ds; 2028 2029 Tcl_UtfToExternalDString(TkWinGetUnicodeEncoding(), 2030 initDir, -1, &ds); 2031 if (SUCCEEDED(psfFolder->lpVtbl->ParseDisplayName( 2032 psfFolder, hwnd, NULL, 2033 (WCHAR *) Tcl_DStringValue(&ds), 2034 &ulCount, &pidlMain, &ulAttr)) 2035 && (pidlMain != NULL)) { 2036 SendMessage(hwnd, BFFM_SETSELECTION, FALSE, 2037 (LPARAM)pidlMain); 2038 pMalloc->lpVtbl->Free(pMalloc, pidlMain); 2039 } 2040 psfFolder->lpVtbl->Release(psfFolder); 2041 Tcl_DStringFree(&ds); 2042 } 2043 pMalloc->lpVtbl->Release(pMalloc); 2044 } 2045 } else { 2046 SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM)initDir); 2047 } 2048 SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); 2049 break; 2050 } 2051 2052 } 2053 return 0; 2054} 2055#else 2056/* 2057 *---------------------------------------------------------------------- 2058 * 2059 * Tk_ChooseDirectoryObjCmd -- 2060 * 2061 * This procedure implements the "tk_chooseDirectory" dialog box 2062 * for the Windows platform. See the user documentation for details 2063 * on what it does. 2064 * 2065 * Results: 2066 * See user documentation. 2067 * 2068 * Side effects: 2069 * A modal dialog window is created. Tcl_SetServiceMode() is 2070 * called to allow background events to be processed 2071 * 2072 *---------------------------------------------------------------------- 2073 */ 2074 2075int 2076Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv) 2077 ClientData clientData; /* Main window associated with interpreter. */ 2078 Tcl_Interp *interp; /* Current interpreter. */ 2079 int objc; /* Number of arguments. */ 2080 Tcl_Obj *CONST objv[]; /* Argument objects. */ 2081{ 2082 OPENFILENAME ofn; 2083 TCHAR path[MAX_PATH], savePath[MAX_PATH]; 2084 ChooseDir cd; 2085 int result, mustExist, code, mode, i; 2086 Tk_Window tkwin; 2087 HWND hWnd; 2088 char *utfTitle; 2089 Tcl_DString utfDirString; 2090 Tcl_DString titleString, dirString; 2091 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 2092 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 2093 static CONST char *optionStrings[] = { 2094 "-initialdir", "-mustexist", "-parent", "-title", 2095 NULL 2096 }; 2097 enum options { 2098 DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE 2099 }; 2100 2101 if (tsdPtr->WM_LBSELCHANGED == 0) { 2102 tsdPtr->WM_LBSELCHANGED = RegisterWindowMessage(LBSELCHSTRING); 2103 } 2104 2105 result = TCL_ERROR; 2106 path[0] = '\0'; 2107 2108 Tcl_DStringInit(&utfDirString); 2109 mustExist = 0; 2110 tkwin = (Tk_Window) clientData; 2111 utfTitle = NULL; 2112 2113 for (i = 1; i < objc; i += 2) { 2114 int index; 2115 char *string; 2116 Tcl_Obj *optionPtr, *valuePtr; 2117 2118 optionPtr = objv[i]; 2119 valuePtr = objv[i + 1]; 2120 2121 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 2122 0, &index) != TCL_OK) { 2123 goto cleanup; 2124 } 2125 if (i + 1 == objc) { 2126 string = Tcl_GetStringFromObj(optionPtr, NULL); 2127 Tcl_AppendResult(interp, "value for \"", string, "\" missing", 2128 (char *) NULL); 2129 goto cleanup; 2130 } 2131 2132 string = Tcl_GetStringFromObj(valuePtr, NULL); 2133 switch ((enum options) index) { 2134 case DIR_INITIAL: { 2135 Tcl_DStringFree(&utfDirString); 2136 if (Tcl_TranslateFileName(interp, string, 2137 &utfDirString) == NULL) { 2138 goto cleanup; 2139 } 2140 break; 2141 } 2142 case DIR_EXIST: { 2143 if (Tcl_GetBooleanFromObj(interp, valuePtr, &mustExist) != TCL_OK) { 2144 goto cleanup; 2145 } 2146 break; 2147 } 2148 case DIR_PARENT: { 2149 tkwin = Tk_NameToWindow(interp, string, tkwin); 2150 if (tkwin == NULL) { 2151 goto cleanup; 2152 } 2153 break; 2154 } 2155 case FILE_TITLE: { 2156 utfTitle = string; 2157 break; 2158 } 2159 } 2160 } 2161 2162 Tk_MakeWindowExist(tkwin); 2163 hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); 2164 2165 cd.interp = interp; 2166 cd.ofnPtr = &ofn; 2167 2168 ofn.lStructSize = sizeof(ofn); 2169 ofn.hwndOwner = hWnd; 2170#ifdef _WIN64 2171 ofn.hInstance = (HINSTANCE) GetWindowLongPtr(ofn.hwndOwner, 2172 GWLP_HINSTANCE); 2173#else 2174 ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner, 2175 GWL_HINSTANCE); 2176#endif 2177 ofn.lpstrFilter = NULL; 2178 ofn.lpstrCustomFilter = NULL; 2179 ofn.nMaxCustFilter = 0; 2180 ofn.nFilterIndex = 0; 2181 ofn.lpstrFile = NULL; //(TCHAR *) path; 2182 ofn.nMaxFile = MAX_PATH; 2183 ofn.lpstrFileTitle = NULL; 2184 ofn.nMaxFileTitle = 0; 2185 ofn.lpstrInitialDir = NULL; 2186 ofn.lpstrTitle = NULL; 2187 ofn.Flags = OFN_HIDEREADONLY 2188 | OFN_ENABLEHOOK | OFN_ENABLETEMPLATE; 2189 ofn.nFileOffset = 0; 2190 ofn.nFileExtension = 0; 2191 ofn.lpstrDefExt = NULL; 2192 ofn.lCustData = (LPARAM) &cd; 2193 ofn.lpfnHook = (LPOFNHOOKPROC) ChooseDirectoryHookProc; 2194 ofn.lpTemplateName = MAKEINTRESOURCE(FILEOPENORD); 2195 2196 if (Tcl_DStringValue(&utfDirString)[0] != '\0') { 2197 Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString), 2198 Tcl_DStringLength(&utfDirString), &dirString); 2199 } else { 2200 /* 2201 * NT 5.0 changed the meaning of lpstrInitialDir, so we have 2202 * to ensure that we set the [pwd] if the user didn't specify 2203 * anything else. 2204 */ 2205 Tcl_DString cwd; 2206 2207 Tcl_DStringFree(&utfDirString); 2208 if ((Tcl_GetCwd(interp, &utfDirString) == (char *) NULL) || 2209 (Tcl_TranslateFileName(interp, 2210 Tcl_DStringValue(&utfDirString), &cwd) == NULL)) { 2211 Tcl_ResetResult(interp); 2212 } else { 2213 Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), 2214 Tcl_DStringLength(&cwd), &dirString); 2215 } 2216 Tcl_DStringFree(&cwd); 2217 } 2218 ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString); 2219 2220 if (mustExist) { 2221 ofn.Flags |= OFN_PATHMUSTEXIST; 2222 } 2223 if (utfTitle != NULL) { 2224 Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString); 2225 ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString); 2226 } 2227 2228 /* 2229 * Display dialog. The choose directory dialog doesn't preserve the 2230 * current directory, so it must be saved and restored here. 2231 */ 2232 2233 GetCurrentDirectory(MAX_PATH, savePath); 2234 mode = Tcl_SetServiceMode(TCL_SERVICE_ALL); 2235 code = GetOpenFileName(&ofn); 2236 Tcl_SetServiceMode(mode); 2237 SetCurrentDirectory(savePath); 2238 2239 /* 2240 * Ensure that hWnd is enabled, because it can happen that we 2241 * have updated the wrapper of the parent, which causes us to 2242 * leave this child disabled (Windows loses sync). 2243 */ 2244 EnableWindow(hWnd, 1); 2245 2246 Tcl_ResetResult(interp); 2247 if (code != 0) { 2248 /* 2249 * Change the pathname to the Tcl "normalized" pathname, where 2250 * back slashes are used instead of forward slashes 2251 */ 2252 2253 char *p; 2254 Tcl_DString ds; 2255 2256 Tcl_ExternalToUtfDString(NULL, (char *) cd.path, -1, &ds); 2257 for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) { 2258 if (*p == '\\') { 2259 *p = '/'; 2260 } 2261 } 2262 Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); 2263 Tcl_DStringFree(&ds); 2264 } 2265 2266 if (ofn.lpstrTitle != NULL) { 2267 Tcl_DStringFree(&titleString); 2268 } 2269 if (ofn.lpstrInitialDir != NULL) { 2270 Tcl_DStringFree(&dirString); 2271 } 2272 result = TCL_OK; 2273 2274 cleanup: 2275 Tcl_DStringFree(&utfDirString); 2276 2277 return result; 2278} 2279 2280/* 2281 *---------------------------------------------------------------------- 2282 * 2283 * ChooseDirectoryHookProc -- 2284 * 2285 * Hook procedure called by the ChooseDirectory dialog to modify 2286 * its default behavior. The ChooseDirectory dialog is really an 2287 * OpenFile dialog with certain controls rearranged and certain 2288 * behaviors changed. For instance, typing a name in the 2289 * ChooseDirectory dialog selects a directory, rather than 2290 * selecting a file. 2291 * 2292 * Results: 2293 * Returns 0 to allow default processing of message, or 1 to 2294 * tell default dialog procedure not to process the message. 2295 * 2296 * Side effects: 2297 * A dialog window is created the first this procedure is called. 2298 * This window is not destroyed and will be reused the next time 2299 * the application invokes the "tk_getOpenFile" or 2300 * "tk_getSaveFile" command. 2301 * 2302 *---------------------------------------------------------------------- 2303 */ 2304 2305static UINT APIENTRY 2306ChooseDirectoryHookProc( 2307 HWND hwnd, 2308 UINT message, 2309 WPARAM wParam, 2310 LPARAM lParam) 2311{ 2312 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 2313 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 2314 OPENFILENAME *ofnPtr; 2315 ChooseDir *cdPtr; 2316 2317 if (message == WM_INITDIALOG) { 2318 ofnPtr = (OPENFILENAME *) lParam; 2319 cdPtr = (ChooseDir *) ofnPtr->lCustData; 2320 cdPtr->lastCtrl = 0; 2321 cdPtr->lastIdx = 1000; 2322 cdPtr->path[0] = '\0'; 2323#ifdef _WIN64 2324 SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) cdPtr); 2325#else 2326 SetWindowLong(hwnd, GWL_USERDATA, (LONG) cdPtr); 2327#endif 2328 2329 if (ofnPtr->lpstrInitialDir == NULL) { 2330 GetCurrentDirectory(MAX_PATH, cdPtr->path); 2331 } else { 2332 lstrcpy(cdPtr->path, ofnPtr->lpstrInitialDir); 2333 } 2334 SetDlgItemText(hwnd, edt10, cdPtr->path); 2335 SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1); 2336 if (tsdPtr->debugFlag) { 2337 tsdPtr->debugInterp = cdPtr->interp; 2338 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd); 2339 } 2340 return 0; 2341 } 2342 2343 /* 2344 * GWL_USERDATA keeps track of cdPtr. 2345 */ 2346 2347#ifdef _WIN64 2348 cdPtr = (ChooseDir *) GetWindowLongPtr(hwnd, GWLP_USERDATA); 2349#else 2350 cdPtr = (ChooseDir *) GetWindowLong(hwnd, GWL_USERDATA); 2351#endif 2352 if (cdPtr == NULL) { 2353 return 0; 2354 } 2355 ofnPtr = cdPtr->ofnPtr; 2356 2357 if (message == tsdPtr->WM_LBSELCHANGED) { 2358 /* 2359 * Called when double-clicking on directory. 2360 * If directory wasn't already open, browse that directory. 2361 * If directory was already open, return selected directory. 2362 */ 2363 2364 int idCtrl, thisItem; 2365 2366 idCtrl = (int) wParam; 2367 thisItem = LOWORD(lParam); 2368 2369 GetCurrentDirectory(MAX_PATH, cdPtr->path); 2370 if (idCtrl == lst2) { 2371 if (cdPtr->lastIdx == thisItem) { 2372 EndDialog(hwnd, IDOK); 2373 return 1; 2374 } 2375 cdPtr->lastIdx = thisItem; 2376 } 2377 SetDlgItemText(hwnd, edt10, cdPtr->path); 2378 SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1); 2379 } else if (message == WM_COMMAND) { 2380 int idCtrl, notifyCode; 2381 2382 idCtrl = LOWORD(wParam); 2383 notifyCode = HIWORD(wParam); 2384 2385 if ((idCtrl != IDOK) || (notifyCode != BN_CLICKED)) { 2386 /* 2387 * OK Button wasn't clicked. Do the default. 2388 */ 2389 2390 if ((idCtrl == lst2) || (idCtrl == edt10)) { 2391 cdPtr->lastCtrl = idCtrl; 2392 } 2393 return 0; 2394 } 2395 2396 /* 2397 * Dialogs also get the message that OK was clicked when Enter 2398 * is pressed in some other control. Find out what window 2399 * we were really in when we got the supposed "OK", because the 2400 * behavior is different. 2401 */ 2402 2403 if (cdPtr->lastCtrl == edt10) { 2404 /* 2405 * Hit Enter or clicked OK while typing a directory name in the 2406 * edit control. 2407 * If it's a new name, try to go to that directory. 2408 * If the name hasn't changed since last time, return selected 2409 * directory. 2410 */ 2411 2412 int changed; 2413 TCHAR tmp[MAX_PATH]; 2414 2415 if (GetDlgItemText(hwnd, edt10, tmp, MAX_PATH) == 0) { 2416 return 0; 2417 } 2418 2419 changed = lstrcmp(cdPtr->path, tmp); 2420 lstrcpy(cdPtr->path, tmp); 2421 2422 if (SetCurrentDirectory(cdPtr->path) == 0) { 2423 /* 2424 * Non-existent directory. 2425 */ 2426 2427 if (ofnPtr->Flags & OFN_PATHMUSTEXIST) { 2428 /* 2429 * Directory must exist. Complain, then rehighlight text. 2430 */ 2431 2432 wsprintf(tmp, _T("Cannot change directory to \"%.200s\"."), 2433 cdPtr->path); 2434 MessageBox(hwnd, tmp, NULL, MB_OK); 2435 SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1); 2436 return 0; 2437 } 2438 if (changed) { 2439 /* 2440 * Directory was invalid, but we want to keep displaying 2441 * this name. Don't update the listbox that displays the 2442 * current directory heirarchy, or it'll erase the name. 2443 */ 2444 2445 SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1); 2446 return 0; 2447 } 2448 } 2449 if (changed == 0) { 2450 /* 2451 * Name hasn't changed since the last time we hit return 2452 * or double-clicked on a directory, so return this. 2453 */ 2454 2455 EndDialog(hwnd, IDOK); 2456 return 1; 2457 } 2458 2459 cdPtr->lastCtrl = IDOK; 2460 2461 /* 2462 * The following is the magic code, determined by running 2463 * Spy++ on some other directory chooser, that it takes to 2464 * get this dialog to update the listbox to display the 2465 * current directory. 2466 */ 2467 2468 SetDlgItemText(hwnd, edt1, cdPtr->path); 2469 SendMessage(hwnd, WM_COMMAND, (WPARAM) MAKELONG(cmb2, 0x8003), 2470 (LPARAM) GetDlgItem(hwnd, cmb2)); 2471 return 0; 2472 } else if (idCtrl == lst2) { 2473 /* 2474 * Enter key was pressed while in listbox. 2475 * If it's a new directory, allow default behavior to open dir. 2476 * If the directory hasn't changed, return selected directory. 2477 */ 2478 2479 int thisItem; 2480 2481 thisItem = (int) SendDlgItemMessage(hwnd, lst2, LB_GETCURSEL, 0, 0); 2482 if (cdPtr->lastIdx == thisItem) { 2483 GetCurrentDirectory(MAX_PATH, cdPtr->path); 2484 EndDialog(hwnd, IDOK); 2485 return 1; 2486 } 2487 } else if (idCtrl == IDOK) { 2488 /* 2489 * The OK button was clicked. Return the value currently selected 2490 * in the entry. 2491 */ 2492 2493 GetCurrentDirectory(MAX_PATH, cdPtr->path); 2494 EndDialog(hwnd, IDOK); 2495 return 1; 2496 } 2497 } 2498 return 0; 2499} 2500#endif 2501 2502/* 2503 *---------------------------------------------------------------------- 2504 * 2505 * Tk_MessageBoxObjCmd -- 2506 * 2507 * This procedure implements the MessageBox window for the 2508 * Windows platform. See the user documentation for details on what 2509 * it does. 2510 * 2511 * Results: 2512 * See user documentation. 2513 * 2514 * Side effects: 2515 * None. The MessageBox window will be destroy before this procedure 2516 * returns. 2517 * 2518 *---------------------------------------------------------------------- 2519 */ 2520 2521int 2522Tk_MessageBoxObjCmd(clientData, interp, objc, objv) 2523 ClientData clientData; /* Main window associated with interpreter. */ 2524 Tcl_Interp *interp; /* Current interpreter. */ 2525 int objc; /* Number of arguments. */ 2526 Tcl_Obj *CONST objv[]; /* Argument objects. */ 2527{ 2528 Tk_Window tkwin, parent; 2529 HWND hWnd; 2530 char *message, *title; 2531 int defaultBtn, icon, type; 2532 int i, oldMode, winCode; 2533 UINT flags; 2534 Tcl_DString messageString, titleString; 2535 Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding(); 2536 static CONST char *optionStrings[] = { 2537 "-default", "-icon", "-message", "-parent", 2538 "-title", "-type", NULL 2539 }; 2540 enum options { 2541 MSG_DEFAULT, MSG_ICON, MSG_MESSAGE, MSG_PARENT, 2542 MSG_TITLE, MSG_TYPE 2543 }; 2544 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 2545 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 2546 2547 tkwin = (Tk_Window) clientData; 2548 2549 defaultBtn = -1; 2550 icon = MB_ICONINFORMATION; 2551 message = NULL; 2552 parent = tkwin; 2553 title = NULL; 2554 type = MB_OK; 2555 2556 for (i = 1; i < objc; i += 2) { 2557 int index; 2558 char *string; 2559 Tcl_Obj *optionPtr, *valuePtr; 2560 2561 optionPtr = objv[i]; 2562 valuePtr = objv[i + 1]; 2563 2564 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 2565 TCL_EXACT, &index) != TCL_OK) { 2566 return TCL_ERROR; 2567 } 2568 if (i + 1 == objc) { 2569 string = Tcl_GetStringFromObj(optionPtr, NULL); 2570 Tcl_AppendResult(interp, "value for \"", string, "\" missing", 2571 (char *) NULL); 2572 return TCL_ERROR; 2573 } 2574 2575 string = Tcl_GetStringFromObj(valuePtr, NULL); 2576 switch ((enum options) index) { 2577 case MSG_DEFAULT: 2578 defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap, 2579 valuePtr); 2580 if (defaultBtn < 0) { 2581 return TCL_ERROR; 2582 } 2583 break; 2584 2585 case MSG_ICON: 2586 icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr); 2587 if (icon < 0) { 2588 return TCL_ERROR; 2589 } 2590 break; 2591 2592 case MSG_MESSAGE: 2593 message = string; 2594 break; 2595 2596 case MSG_PARENT: 2597 parent = Tk_NameToWindow(interp, string, tkwin); 2598 if (parent == NULL) { 2599 return TCL_ERROR; 2600 } 2601 break; 2602 2603 case MSG_TITLE: 2604 title = string; 2605 break; 2606 2607 case MSG_TYPE: 2608 type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr); 2609 if (type < 0) { 2610 return TCL_ERROR; 2611 } 2612 break; 2613 2614 } 2615 } 2616 2617 Tk_MakeWindowExist(parent); 2618 hWnd = Tk_GetHWND(Tk_WindowId(parent)); 2619 2620 flags = 0; 2621 if (defaultBtn >= 0) { 2622 int defaultBtnIdx; 2623 2624 defaultBtnIdx = -1; 2625 for (i = 0; i < NUM_TYPES; i++) { 2626 if (type == allowedTypes[i].type) { 2627 int j; 2628 2629 for (j = 0; j < 3; j++) { 2630 if (allowedTypes[i].btnIds[j] == defaultBtn) { 2631 defaultBtnIdx = j; 2632 break; 2633 } 2634 } 2635 if (defaultBtnIdx < 0) { 2636 Tcl_AppendResult(interp, "invalid default button \"", 2637 TkFindStateString(buttonMap, defaultBtn), 2638 "\"", NULL); 2639 return TCL_ERROR; 2640 } 2641 break; 2642 } 2643 } 2644 flags = buttonFlagMap[defaultBtnIdx]; 2645 } 2646 2647 flags |= icon | type | MB_SYSTEMMODAL; 2648 2649 Tcl_UtfToExternalDString(unicodeEncoding, message, -1, &messageString); 2650 Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString); 2651 2652 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); 2653 2654 /* 2655 * MessageBoxW exists for all platforms. Use it to allow unicode 2656 * error message to be displayed correctly where possible by the OS. 2657 * 2658 * In order to have the parent window icon reflected in a MessageBox, 2659 * we have to create a hook that will trigger when the MessageBox is 2660 * being created. 2661 */ 2662 tsdPtr->hSmallIcon = TkWinGetIcon(parent, ICON_SMALL); 2663 tsdPtr->hBigIcon = TkWinGetIcon(parent, ICON_BIG); 2664 tsdPtr->hMsgBoxHook = SetWindowsHookEx(WH_CBT, MsgBoxCBTProc, NULL, 2665 GetCurrentThreadId()); 2666 winCode = MessageBoxW(hWnd, (WCHAR *) Tcl_DStringValue(&messageString), 2667 (WCHAR *) Tcl_DStringValue(&titleString), flags); 2668 UnhookWindowsHookEx(tsdPtr->hMsgBoxHook); 2669 (void) Tcl_SetServiceMode(oldMode); 2670 2671 /* 2672 * Ensure that hWnd is enabled, because it can happen that we 2673 * have updated the wrapper of the parent, which causes us to 2674 * leave this child disabled (Windows loses sync). 2675 */ 2676 EnableWindow(hWnd, 1); 2677 2678 Tcl_DStringFree(&messageString); 2679 Tcl_DStringFree(&titleString); 2680 2681 Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC); 2682 return TCL_OK; 2683} 2684 2685static LRESULT CALLBACK 2686MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam) 2687{ 2688 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 2689 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 2690 2691 if (nCode == HCBT_CREATEWND) { 2692 /* 2693 * Window owned by our task is being created. Since the hook is 2694 * installed just before the MessageBox call and removed after the 2695 * MessageBox call, the window being created is either the message 2696 * box or one of its controls. Check that the class is WC_DIALOG 2697 * to ensure that it's the one we want. 2698 */ 2699 LPCBT_CREATEWND lpcbtcreate = (LPCBT_CREATEWND)lParam; 2700 2701 if (WC_DIALOG == lpcbtcreate->lpcs->lpszClass) { 2702 HWND hwnd = (HWND) wParam; 2703 SendMessage(hwnd, WM_SETICON, ICON_SMALL, 2704 (LPARAM) tsdPtr->hSmallIcon); 2705 SendMessage(hwnd, WM_SETICON, ICON_BIG, 2706 (LPARAM) tsdPtr->hBigIcon); 2707 } 2708 } 2709 2710 /* 2711 * Call the next hook proc, if there is one 2712 */ 2713 return CallNextHookEx(tsdPtr->hMsgBoxHook, nCode, wParam, lParam); 2714} 2715 2716static void 2717SetTkDialog(ClientData clientData) 2718{ 2719 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 2720 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 2721 char buf[32]; 2722 2723 sprintf(buf, "0x%p", (HWND) clientData); 2724 Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY); 2725} 2726