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 of
9 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 */
11 #define WINVER 0x0500 /* Requires Windows 2K definitions */
12 #define _WIN32_WINNT 0x0500
13 #include "tkWinInt.h"
14 #include "tkFileFilter.h"
15
16 #include <commdlg.h> /* includes common dialog functionality */
17 #ifdef _MSC_VER
18 # pragma comment (lib, "comdlg32.lib")
19 #endif
20 #include <dlgs.h> /* includes common dialog template defines */
21 #include <cderr.h> /* includes the common dialog error codes */
22
23 #include <shlobj.h> /* includes SHBrowseForFolder */
24 #ifdef _MSC_VER
25 # pragma comment (lib, "shell32.lib")
26 #endif
27
28 /* These needed for compilation with VC++ 5.2 */
29 #ifndef BIF_EDITBOX
30 #define BIF_EDITBOX 0x10
31 #endif
32
33 #ifndef BIF_VALIDATE
34 #define BIF_VALIDATE 0x0020
35 #endif
36
37 #ifndef BIF_NEWDIALOGSTYLE
38 #define BIF_NEWDIALOGSTYLE 0x0040
39 #endif
40
41 #ifndef BFFM_VALIDATEFAILED
42 #ifdef UNICODE
43 #define BFFM_VALIDATEFAILED 4
44 #else
45 #define BFFM_VALIDATEFAILED 3
46 #endif
47 #endif /* BFFM_VALIDATEFAILED */
48
49 #ifndef OPENFILENAME_SIZE_VERSION_400
50 #define OPENFILENAME_SIZE_VERSION_400 76
51 #endif
52
53 typedef struct ThreadSpecificData {
54 int debugFlag; /* Flags whether we should output debugging
55 * information while displaying a builtin
56 * dialog. */
57 Tcl_Interp *debugInterp; /* Interpreter to used for debugging. */
58 UINT WM_LBSELCHANGED; /* Holds a registered windows event used for
59 * communicating between the Directory Chooser
60 * dialog and its hook proc. */
61 HHOOK hMsgBoxHook; /* Hook proc for tk_messageBox and the */
62 HICON hSmallIcon; /* icons used by a parent to be used in */
63 HICON hBigIcon; /* the message box */
64 } ThreadSpecificData;
65 static Tcl_ThreadDataKey dataKey;
66
67 /*
68 * The following structures are used by Tk_MessageBoxCmd() to parse arguments
69 * and return results.
70 */
71
72 static const TkStateMap iconMap[] = {
73 {MB_ICONERROR, "error"},
74 {MB_ICONINFORMATION, "info"},
75 {MB_ICONQUESTION, "question"},
76 {MB_ICONWARNING, "warning"},
77 {-1, NULL}
78 };
79
80 static const TkStateMap typeMap[] = {
81 {MB_ABORTRETRYIGNORE, "abortretryignore"},
82 {MB_OK, "ok"},
83 {MB_OKCANCEL, "okcancel"},
84 {MB_RETRYCANCEL, "retrycancel"},
85 {MB_YESNO, "yesno"},
86 {MB_YESNOCANCEL, "yesnocancel"},
87 {-1, NULL}
88 };
89
90 static const TkStateMap buttonMap[] = {
91 {IDABORT, "abort"},
92 {IDRETRY, "retry"},
93 {IDIGNORE, "ignore"},
94 {IDOK, "ok"},
95 {IDCANCEL, "cancel"},
96 {IDNO, "no"},
97 {IDYES, "yes"},
98 {-1, NULL}
99 };
100
101 static const int buttonFlagMap[] = {
102 MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4
103 };
104
105 static const struct {int type; int btnIds[3];} allowedTypes[] = {
106 {MB_ABORTRETRYIGNORE, {IDABORT, IDRETRY, IDIGNORE}},
107 {MB_OK, {IDOK, -1, -1 }},
108 {MB_OKCANCEL, {IDOK, IDCANCEL, -1 }},
109 {MB_RETRYCANCEL, {IDRETRY, IDCANCEL, -1 }},
110 {MB_YESNO, {IDYES, IDNO, -1 }},
111 {MB_YESNOCANCEL, {IDYES, IDNO, IDCANCEL}}
112 };
113
114 #define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0]))
115
116 /*
117 * Abstract trivial differences between Win32 and Win64.
118 */
119
120 #define TkWinGetHInstance(from) \
121 ((HINSTANCE) GetWindowLongPtrW((from), GWLP_HINSTANCE))
122 #define TkWinGetUserData(from) \
123 GetWindowLongPtrW((from), GWLP_USERDATA)
124 #define TkWinSetUserData(to,what) \
125 SetWindowLongPtrW((to), GWLP_USERDATA, (LPARAM)(what))
126
127 /*
128 * The value of TK_MULTI_MAX_PATH dictates how many files can be retrieved
129 * with tk_get*File -multiple 1. It must be allocated on the stack, so make it
130 * large enough but not too large. - hobbs
131 *
132 * The data is stored as <dir>\0<file1>\0<file2>\0...<fileN>\0\0. Since
133 * MAX_PATH == 260 on Win2K/NT, *40 is ~10Kbytes.
134 */
135
136 #define TK_MULTI_MAX_PATH (MAX_PATH*40)
137
138 /*
139 * The following structure is used to pass information between the directory
140 * chooser function, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.
141 */
142
143 typedef struct {
144 WCHAR initDir[MAX_PATH]; /* Initial folder to use */
145 WCHAR retDir[MAX_PATH]; /* Returned folder to use */
146 Tcl_Interp *interp;
147 int mustExist; /* True if file must exist to return from
148 * callback */
149 } ChooseDir;
150
151 /*
152 * The following structure is used to pass information between GetFileName
153 * function and OFN dialog hook procedures. [Bug 2896501, Patch 2898255]
154 */
155
156 typedef struct OFNData {
157 Tcl_Interp *interp; /* Interp, used only if debug is turned on,
158 * for setting the "tk_dialog" variable. */
159 int dynFileBufferSize; /* Dynamic filename buffer size, stored to
160 * avoid shrinking and expanding the buffer
161 * when selection changes */
162 WCHAR *dynFileBuffer; /* Dynamic filename buffer */
163 } OFNData;
164
165 /*
166 * Definitions of functions used only in this file.
167 */
168
169 static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg,
170 LPARAM wParam, LPARAM lParam);
171 static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
172 LPARAM lParam);
173 static int GetFileName(ClientData clientData,
174 Tcl_Interp *interp, int objc,
175 Tcl_Obj *const objv[], int isOpen);
176 static int MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr,
177 Tcl_DString *dsPtr, Tcl_Obj *initialPtr,
178 int *indexPtr);
179 static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
180 LPARAM lParam);
181 static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam);
182 static void SetTkDialog(ClientData clientData);
183 static const char *ConvertExternalFilename(WCHAR *filename,
184 Tcl_DString *dsPtr);
185
186 /*
187 *-------------------------------------------------------------------------
188 *
189 * EatSpuriousMessageBugFix --
190 *
191 * In the file open/save dialog, double clicking on a list item causes
192 * the dialog box to close, but an unwanted WM_LBUTTONUP message is sent
193 * to the window underneath. If the window underneath happens to be a
194 * windows control (eg a button) then it will be activated by accident.
195 *
196 * This problem does not occur in dialog boxes, because windows must do
197 * some special processing to solve the problem. (separate message
198 * processing functions are used to cope with keyboard navigation of
199 * controls.)
200 *
201 * Here is one solution. After returning, we poll the message queue for
202 * 1/4s looking for WM_LBUTTON up messages. If we see one it's consumed.
203 * If we get a WM_LBUTTONDOWN message, then we exit early, since the user
204 * must be doing something new. This fix only works for the current
205 * application, so the problem will still occur if the open dialog
206 * happens to be over another applications button. However this is a
207 * fairly rare occurrance.
208 *
209 * Results:
210 * None.
211 *
212 * Side effects:
213 * Consumes an unwanted BUTTON messages.
214 *
215 *-------------------------------------------------------------------------
216 */
217
218 static void
EatSpuriousMessageBugFix(void)219 EatSpuriousMessageBugFix(void)
220 {
221 MSG msg;
222 DWORD nTime = GetTickCount() + 250;
223
224 while (GetTickCount() < nTime) {
225 if (PeekMessageA(&msg, 0, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_NOREMOVE)){
226 break;
227 }
228 PeekMessageA(&msg, 0, WM_LBUTTONUP, WM_LBUTTONUP, PM_REMOVE);
229 }
230 }
231
232 /*
233 *-------------------------------------------------------------------------
234 *
235 * TkWinDialogDebug --
236 *
237 * Function to turn on/off debugging support for common dialogs under
238 * windows. The variable "tk_debug" is set to the identifier of the
239 * dialog window when the modal dialog window pops up and it is safe to
240 * send messages to the dialog.
241 *
242 * Results:
243 * None.
244 *
245 * Side effects:
246 * This variable only makes sense if just one dialog is up at a time.
247 *
248 *-------------------------------------------------------------------------
249 */
250
251 void
TkWinDialogDebug(int debug)252 TkWinDialogDebug(
253 int debug)
254 {
255 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
256 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
257
258 tsdPtr->debugFlag = debug;
259 }
260
261 /*
262 *-------------------------------------------------------------------------
263 *
264 * Tk_ChooseColorObjCmd --
265 *
266 * This function implements the color dialog box for the Windows
267 * platform. See the user documentation for details on what it does.
268 *
269 * Results:
270 * See user documentation.
271 *
272 * Side effects:
273 * A dialog window is created the first time this function is called.
274 * This window is not destroyed and will be reused the next time the
275 * application invokes the "tk_chooseColor" command.
276 *
277 *-------------------------------------------------------------------------
278 */
279
280 int
Tk_ChooseColorObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])281 Tk_ChooseColorObjCmd(
282 ClientData clientData, /* Main window associated with interpreter. */
283 Tcl_Interp *interp, /* Current interpreter. */
284 int objc, /* Number of arguments. */
285 Tcl_Obj *const objv[]) /* Argument objects. */
286 {
287 Tk_Window tkwin = (Tk_Window) clientData, parent;
288 HWND hWnd;
289 int i, oldMode, winCode, result;
290 CHOOSECOLORW chooseColor;
291 static int inited = 0;
292 static COLORREF dwCustColors[16];
293 static long oldColor; /* the color selected last time */
294 static const char *optionStrings[] = {
295 "-initialcolor", "-parent", "-title", NULL
296 };
297 enum options {
298 COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
299 };
300
301 result = TCL_OK;
302 if (inited == 0) {
303 /*
304 * dwCustColors stores the custom color which the user can modify. We
305 * store these colors in a static array so that the next time the
306 * color dialog pops up, the same set of custom colors remain in the
307 * dialog.
308 */
309
310 for (i = 0; i < 16; i++) {
311 dwCustColors[i] = RGB(255-i * 10, i, i * 10);
312 }
313 oldColor = RGB(0xa0, 0xa0, 0xa0);
314 inited = 1;
315 }
316
317 parent = tkwin;
318 chooseColor.lStructSize = sizeof(CHOOSECOLORW);
319 chooseColor.hwndOwner = NULL;
320 chooseColor.hInstance = NULL;
321 chooseColor.rgbResult = oldColor;
322 chooseColor.lpCustColors = dwCustColors;
323 chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
324 chooseColor.lCustData = (LPARAM) NULL;
325 chooseColor.lpfnHook = (LPOFNHOOKPROC) ColorDlgHookProc;
326 chooseColor.lpTemplateName = (LPWSTR) interp;
327
328 for (i = 1; i < objc; i += 2) {
329 int index;
330 const char *string;
331 Tcl_Obj *optionPtr, *valuePtr;
332
333 optionPtr = objv[i];
334 valuePtr = objv[i + 1];
335
336 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
337 TCL_EXACT, &index) != TCL_OK) {
338 return TCL_ERROR;
339 }
340 if (i + 1 == objc) {
341 string = Tcl_GetString(optionPtr);
342 Tcl_AppendResult(interp, "value for \"", string, "\" missing",
343 NULL);
344 return TCL_ERROR;
345 }
346
347 string = Tcl_GetString(valuePtr);
348 switch ((enum options) index) {
349 case COLOR_INITIAL: {
350 XColor *colorPtr;
351
352 colorPtr = Tk_GetColor(interp, tkwin, string);
353 if (colorPtr == NULL) {
354 return TCL_ERROR;
355 }
356 chooseColor.rgbResult = RGB(colorPtr->red / 0x100,
357 colorPtr->green / 0x100, colorPtr->blue / 0x100);
358 break;
359 }
360 case COLOR_PARENT:
361 parent = Tk_NameToWindow(interp, string, tkwin);
362 if (parent == NULL) {
363 return TCL_ERROR;
364 }
365 break;
366 case COLOR_TITLE:
367 chooseColor.lCustData = (LPARAM) string;
368 break;
369 }
370 }
371
372 Tk_MakeWindowExist(parent);
373 chooseColor.hwndOwner = NULL;
374 hWnd = Tk_GetHWND(Tk_WindowId(parent));
375 chooseColor.hwndOwner = hWnd;
376
377 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
378 winCode = ChooseColorW(&chooseColor);
379 (void) Tcl_SetServiceMode(oldMode);
380
381 /*
382 * Ensure that hWnd is enabled, because it can happen that we have updated
383 * the wrapper of the parent, which causes us to leave this child disabled
384 * (Windows loses sync).
385 */
386
387 EnableWindow(hWnd, 1);
388
389 /*
390 * Clear the interp result since anything may have happened during the
391 * modal loop.
392 */
393
394 Tcl_ResetResult(interp);
395
396 /*
397 * 3. Process the result of the dialog
398 */
399
400 if (winCode) {
401 /*
402 * User has selected a color
403 */
404 char color[100];
405
406 sprintf(color, "#%02x%02x%02x",
407 GetRValue(chooseColor.rgbResult),
408 GetGValue(chooseColor.rgbResult),
409 GetBValue(chooseColor.rgbResult));
410 Tcl_AppendResult(interp, color, NULL);
411 oldColor = chooseColor.rgbResult;
412 result = TCL_OK;
413 }
414
415 return result;
416 }
417
418 /*
419 *-------------------------------------------------------------------------
420 *
421 * ColorDlgHookProc --
422 *
423 * Provides special handling of messages for the Color common dialog box.
424 * Used to set the title when the dialog first appears.
425 *
426 * Results:
427 * The return value is 0 if the default dialog box function should handle
428 * the message, non-zero otherwise.
429 *
430 * Side effects:
431 * Changes the title of the dialog window.
432 *
433 *----------------------------------------------------------------------
434 */
435
436 static UINT CALLBACK
ColorDlgHookProc(HWND hDlg,UINT uMsg,WPARAM wParam,LPARAM lParam)437 ColorDlgHookProc(
438 HWND hDlg, /* Handle to the color dialog. */
439 UINT uMsg, /* Type of message. */
440 WPARAM wParam, /* First message parameter. */
441 LPARAM lParam) /* Second message parameter. */
442 {
443 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
444 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
445 const char *title;
446 CHOOSECOLORW *ccPtr;
447
448 if (WM_INITDIALOG == uMsg) {
449
450 /*
451 * Set the title string of the dialog.
452 */
453
454 ccPtr = (CHOOSECOLORW *) lParam;
455 title = (const char *) ccPtr->lCustData;
456
457 if ((title != NULL) && (title[0] != '\0')) {
458 Tcl_DString ds;
459
460 SetWindowTextW(hDlg, (WCHAR *)Tcl_WinUtfToTChar(title,-1,&ds));
461 Tcl_DStringFree(&ds);
462 }
463 if (tsdPtr->debugFlag) {
464 tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
465 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
466 }
467 return TRUE;
468 }
469 return FALSE;
470 }
471
472 /*
473 *----------------------------------------------------------------------
474 *
475 * Tk_GetOpenFileCmd --
476 *
477 * This function implements the "open file" dialog box for the Windows
478 * platform. See the user documentation for details on what it does.
479 *
480 * Results:
481 * See user documentation.
482 *
483 * Side effects:
484 * A dialog window is created the first this function is called.
485 *
486 *----------------------------------------------------------------------
487 */
488
489 int
Tk_GetOpenFileObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])490 Tk_GetOpenFileObjCmd(
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 return GetFileName(clientData, interp, objc, objv, 1);
497 }
498
499 /*
500 *----------------------------------------------------------------------
501 *
502 * Tk_GetSaveFileCmd --
503 *
504 * Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
505 * instead
506 *
507 * Results:
508 * Same as Tk_GetOpenFileCmd.
509 *
510 * Side effects:
511 * Same as Tk_GetOpenFileCmd.
512 *
513 *----------------------------------------------------------------------
514 */
515
516 int
Tk_GetSaveFileObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])517 Tk_GetSaveFileObjCmd(
518 ClientData clientData, /* Main window associated with interpreter. */
519 Tcl_Interp *interp, /* Current interpreter. */
520 int objc, /* Number of arguments. */
521 Tcl_Obj *const objv[]) /* Argument objects. */
522 {
523 return GetFileName(clientData, interp, objc, objv, 0);
524 }
525
526 /*
527 *----------------------------------------------------------------------
528 *
529 * GetFileName --
530 *
531 * Calls GetOpenFileName() or GetSaveFileName().
532 *
533 * Results:
534 * See user documentation.
535 *
536 * Side effects:
537 * See user documentation.
538 *
539 *----------------------------------------------------------------------
540 */
541
542 static int
GetFileName(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[],int open)543 GetFileName(
544 ClientData clientData, /* Main window associated with interpreter. */
545 Tcl_Interp *interp, /* Current interpreter. */
546 int objc, /* Number of arguments. */
547 Tcl_Obj *const objv[], /* Argument objects. */
548 int open) /* 1 to call GetOpenFileName(), 0 to call
549 * GetSaveFileName(). */
550 {
551 OPENFILENAMEW ofn;
552 WCHAR file[TK_MULTI_MAX_PATH];
553 OFNData ofnData;
554 int cdlgerr;
555 int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0;
556 int confirmOverwrite = 1;
557 const char *extension = NULL, *title = NULL;
558 Tk_Window tkwin = (Tk_Window) clientData;
559 HWND hWnd;
560 Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
561 Tcl_DString utfFilterString, utfDirString, ds;
562 Tcl_DString extString, filterString, dirString, titleString;
563 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
564 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
565 enum options {
566 FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_PARENT,
567 FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW
568 };
569 struct Options {
570 const char *name;
571 enum options value;
572 };
573 static const struct Options saveOptions[] = {
574 {"-confirmoverwrite", FILE_CONFIRMOW},
575 {"-defaultextension", FILE_DEFAULT},
576 {"-filetypes", FILE_TYPES},
577 {"-initialdir", FILE_INITDIR},
578 {"-initialfile", FILE_INITFILE},
579 {"-parent", FILE_PARENT},
580 {"-title", FILE_TITLE},
581 {"-typevariable", FILE_TYPEVARIABLE},
582 {NULL, FILE_DEFAULT/*ignored*/ }
583 };
584 static const struct Options openOptions[] = {
585 {"-defaultextension", FILE_DEFAULT},
586 {"-filetypes", FILE_TYPES},
587 {"-initialdir", FILE_INITDIR},
588 {"-initialfile", FILE_INITFILE},
589 {"-multiple", FILE_MULTIPLE},
590 {"-parent", FILE_PARENT},
591 {"-title", FILE_TITLE},
592 {"-typevariable", FILE_TYPEVARIABLE},
593 {NULL, FILE_DEFAULT/*ignored*/ }
594 };
595 const struct Options *options = open ? openOptions : saveOptions;
596
597 file[0] = '\0';
598 ZeroMemory(&ofnData, sizeof(OFNData));
599 Tcl_DStringInit(&utfFilterString);
600 Tcl_DStringInit(&utfDirString);
601
602 /*
603 * Parse the arguments.
604 */
605
606 for (i = 1; i < objc; i += 2) {
607 int index;
608 const char *string;
609 Tcl_Obj *valuePtr = objv[i + 1];
610
611 if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
612 sizeof(struct Options), "option", 0, &index) != TCL_OK) {
613 goto end;
614 } else if (i + 1 == objc) {
615 Tcl_AppendResult(interp, "value for \"", options[index].name,
616 "\" missing", NULL);
617 goto end;
618 }
619
620 string = Tcl_GetString(valuePtr);
621 switch (options[index].value) {
622 case FILE_DEFAULT:
623 if (string[0] == '.') {
624 string++;
625 }
626 extension = string;
627 break;
628 case FILE_TYPES:
629 filterObj = valuePtr;
630 break;
631 case FILE_INITDIR:
632 Tcl_DStringFree(&utfDirString);
633 if (Tcl_TranslateFileName(interp, string,
634 &utfDirString) == NULL) {
635 goto end;
636 }
637 break;
638 case FILE_INITFILE:
639 if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
640 goto end;
641 }
642 Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(),
643 Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL,
644 (char *) file, sizeof(file), NULL, NULL, NULL);
645 Tcl_DStringFree(&ds);
646 break;
647 case FILE_PARENT:
648 tkwin = Tk_NameToWindow(interp, string, tkwin);
649 if (tkwin == NULL) {
650 goto end;
651 }
652 break;
653 case FILE_TITLE:
654 title = string;
655 break;
656 case FILE_TYPEVARIABLE:
657 typeVariableObj = valuePtr;
658 initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL,
659 TCL_GLOBAL_ONLY);
660 break;
661 case FILE_MULTIPLE:
662 if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) {
663 return TCL_ERROR;
664 }
665 break;
666 case FILE_CONFIRMOW:
667 if (Tcl_GetBooleanFromObj(interp, valuePtr,
668 &confirmOverwrite) != TCL_OK) {
669 return TCL_ERROR;
670 }
671 break;
672 }
673 }
674
675 if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj,
676 &filterIndex) != TCL_OK) {
677 goto end;
678 }
679
680 Tk_MakeWindowExist(tkwin);
681 hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
682
683 ZeroMemory(&ofn, sizeof(OPENFILENAMEW));
684 if (LOBYTE(LOWORD(GetVersion())) < 5) {
685 ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400;
686 } else {
687 ofn.lStructSize = sizeof(OPENFILENAMEW);
688 }
689 ofn.hwndOwner = hWnd;
690 ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner);
691 ofn.lpstrFile = file;
692 ofn.nMaxFile = TK_MULTI_MAX_PATH;
693 ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR
694 | OFN_EXPLORER | OFN_ENABLEHOOK| OFN_ENABLESIZING;
695 ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc;
696 ofn.lCustData = (LPARAM) &ofnData;
697
698 if (open != 0) {
699 ofn.Flags |= OFN_FILEMUSTEXIST;
700 } else if (confirmOverwrite) {
701 ofn.Flags |= OFN_OVERWRITEPROMPT;
702 }
703 if (tsdPtr->debugFlag != 0) {
704 ofnData.interp = interp;
705 }
706 if (multi != 0) {
707 ofn.Flags |= OFN_ALLOWMULTISELECT;
708
709 /*
710 * Starting buffer size. The buffer will be expanded by the OFN dialog
711 * procedure when necessary
712 */
713
714 ofnData.dynFileBufferSize = 512;
715 ofnData.dynFileBuffer = (WCHAR *)ckalloc(512 * sizeof(WCHAR));
716 }
717
718 if (extension != NULL) {
719 Tcl_WinUtfToTChar(extension, -1, &extString);
720 ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString);
721 }
722
723 Tcl_WinUtfToTChar(Tcl_DStringValue(&utfFilterString),
724 Tcl_DStringLength(&utfFilterString), &filterString);
725 ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);
726 ofn.nFilterIndex = filterIndex;
727
728 if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
729 Tcl_WinUtfToTChar(Tcl_DStringValue(&utfDirString),
730 Tcl_DStringLength(&utfDirString), &dirString);
731 } else {
732 /*
733 * NT 5.0 changed the meaning of lpstrInitialDir, so we have to ensure
734 * that we set the [pwd] if the user didn't specify anything else.
735 */
736
737 Tcl_DString cwd;
738
739 Tcl_DStringFree(&utfDirString);
740 if ((Tcl_GetCwd(interp, &utfDirString) == NULL) ||
741 (Tcl_TranslateFileName(interp,
742 Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
743 Tcl_ResetResult(interp);
744 } else {
745 Tcl_WinUtfToTChar(Tcl_DStringValue(&cwd),
746 Tcl_DStringLength(&cwd), &dirString);
747 }
748 Tcl_DStringFree(&cwd);
749 }
750 ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);
751
752 if (title != NULL) {
753 Tcl_WinUtfToTChar(title, -1, &titleString);
754 ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);
755 }
756
757 /*
758 * Popup the dialog.
759 */
760
761 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
762 if (open != 0) {
763 winCode = GetOpenFileNameW(&ofn);
764 } else {
765 winCode = GetSaveFileNameW(&ofn);
766 }
767 Tcl_SetServiceMode(oldMode);
768 EatSpuriousMessageBugFix();
769
770 /*
771 * Ensure that hWnd is enabled, because it can happen that we have updated
772 * the wrapper of the parent, which causes us to leave this child disabled
773 * (Windows loses sync).
774 */
775
776 EnableWindow(hWnd, 1);
777
778 /*
779 * Clear the interp result since anything may have happened during the
780 * modal loop.
781 */
782
783 Tcl_ResetResult(interp);
784
785 /*
786 * Process the results.
787 *
788 * Use the CommDlgExtendedError() function to retrieve the error code.
789 * This function can return one of about two dozen codes; most of these
790 * indicate some sort of gross system failure (insufficient memory, bad
791 * window handles, etc.). Most of the error codes will be ignored; as we
792 * find we want more specific error messages for particular errors, we can
793 * extend the code as needed.
794 */
795
796 cdlgerr = CommDlgExtendedError();
797
798 /*
799 * We now allow FNERR_BUFFERTOOSMALL when multiselection is enabled. The
800 * filename buffer has been dynamically allocated by the OFN dialog
801 * procedure to accomodate all selected files.
802 */
803
804 if ((winCode != 0)
805 || ((cdlgerr == FNERR_BUFFERTOOSMALL)
806 && (ofn.Flags & OFN_ALLOWMULTISELECT))) {
807 int gotFilename = 0; /* Flag for tracking whether we have any
808 * filename at all. For details, see
809 * http://stackoverflow.com/q/9227859/301832
810 */
811
812 if (ofn.Flags & OFN_ALLOWMULTISELECT) {
813 /*
814 * The result in dynFileBuffer contains many items, separated by
815 * NUL characters. It is terminated with two nulls in a row. The
816 * first element is the directory path.
817 */
818
819 WCHAR *files = ofnData.dynFileBuffer;
820 Tcl_Obj *returnList = Tcl_NewObj();
821 int count = 0;
822
823 /*
824 * Get directory.
825 */
826
827 ConvertExternalFilename(files, &ds);
828
829 while (*files != '\0') {
830 while (*files != '\0') {
831 files++;
832 }
833 files++;
834 if (*files != '\0') {
835 Tcl_Obj *fullnameObj;
836 Tcl_DString filenameBuf;
837
838 count++;
839 ConvertExternalFilename(files, &filenameBuf);
840
841 fullnameObj = Tcl_NewStringObj(Tcl_DStringValue(&ds),
842 Tcl_DStringLength(&ds));
843 Tcl_AppendToObj(fullnameObj, "/", -1);
844 Tcl_AppendToObj(fullnameObj, Tcl_DStringValue(&filenameBuf),
845 Tcl_DStringLength(&filenameBuf));
846 gotFilename = 1;
847 Tcl_DStringFree(&filenameBuf);
848 Tcl_ListObjAppendElement(NULL, returnList, fullnameObj);
849 }
850 }
851
852 if (count == 0) {
853 /*
854 * Only one file was returned.
855 */
856
857 Tcl_ListObjAppendElement(NULL, returnList,
858 Tcl_NewStringObj(Tcl_DStringValue(&ds),
859 Tcl_DStringLength(&ds)));
860 gotFilename |= (Tcl_DStringLength(&ds) > 0);
861 }
862 Tcl_SetObjResult(interp, returnList);
863 Tcl_DStringFree(&ds);
864 } else {
865 Tcl_AppendResult(interp, ConvertExternalFilename(
866 ofn.lpstrFile, &ds), NULL);
867 gotFilename = (Tcl_DStringLength(&ds) > 0);
868 Tcl_DStringFree(&ds);
869 }
870 result = TCL_OK;
871 if ((ofn.nFilterIndex > 0) && gotFilename && typeVariableObj
872 && filterObj) {
873 int listObjc, count;
874 Tcl_Obj **listObjv = NULL;
875 Tcl_Obj **typeInfo = NULL;
876
877 if (Tcl_ListObjGetElements(interp, filterObj,
878 &listObjc, &listObjv) != TCL_OK) {
879 result = TCL_ERROR;
880 } else if (Tcl_ListObjGetElements(interp,
881 listObjv[ofn.nFilterIndex - 1], &count,
882 &typeInfo) != TCL_OK) {
883 result = TCL_ERROR;
884 } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL,
885 typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
886 result = TCL_ERROR;
887 }
888 }
889 } else if (cdlgerr == FNERR_INVALIDFILENAME) {
890 Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
891 Tcl_AppendResult(interp, ConvertExternalFilename(
892 ofn.lpstrFile, &ds), "\"", NULL);
893 Tcl_DStringFree(&ds);
894 } else {
895 result = TCL_OK;
896 }
897
898 if (ofn.lpstrTitle != NULL) {
899 Tcl_DStringFree(&titleString);
900 }
901 if (ofn.lpstrInitialDir != NULL) {
902 Tcl_DStringFree(&dirString);
903 }
904 Tcl_DStringFree(&filterString);
905 if (ofn.lpstrDefExt != NULL) {
906 Tcl_DStringFree(&extString);
907 }
908
909 end:
910 Tcl_DStringFree(&utfDirString);
911 Tcl_DStringFree(&utfFilterString);
912 if (ofnData.dynFileBuffer != NULL) {
913 ckfree((char *)ofnData.dynFileBuffer);
914 ofnData.dynFileBuffer = NULL;
915 }
916
917 return result;
918 }
919
920 /*
921 *-------------------------------------------------------------------------
922 *
923 * OFNHookProc --
924 *
925 * Dialog box hook function. This is used to sets the "tk_dialog"
926 * variable for test/debugging when the dialog is ready to receive
927 * messages. When multiple file selection is enabled this function
928 * is used to process the list of names.
929 *
930 * Results:
931 * Returns 0 to allow default processing of messages to occur.
932 *
933 * Side effects:
934 * None.
935 *
936 *-------------------------------------------------------------------------
937 */
938
939 static UINT APIENTRY
OFNHookProc(HWND hdlg,UINT uMsg,WPARAM wParam,LPARAM lParam)940 OFNHookProc(
941 HWND hdlg, /* Handle to child dialog window. */
942 UINT uMsg, /* Message identifier */
943 WPARAM wParam, /* Message parameter */
944 LPARAM lParam) /* Message parameter */
945 {
946 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
947 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
948 OPENFILENAMEW *ofnPtr;
949 OFNData *ofnData;
950
951 if (uMsg == WM_INITDIALOG) {
952 TkWinSetUserData(hdlg, lParam);
953 } else if (uMsg == WM_NOTIFY) {
954 OFNOTIFYW *notifyPtr = (OFNOTIFYW *) lParam;
955
956 /*
957 * This is weird... or not. The CDN_FILEOK is NOT sent when the
958 * selection exceeds declared buffer size (the nMaxFile member of the
959 * OPENFILENAME struct passed to GetOpenFileName function). So, we
960 * have to rely on the most recent CDN_SELCHANGE then. Unfortunately
961 * this means, that gathering the selected filenames happens twice
962 * when they fit into the declared buffer. Luckily, it's not frequent
963 * operation so it should not incur any noticeable delay. See [Bug
964 * 2987995]
965 */
966
967 if (notifyPtr->hdr.code == CDN_FILEOK ||
968 notifyPtr->hdr.code == CDN_SELCHANGE) {
969 int dirsize, selsize;
970 WCHAR *buffer;
971 int buffersize;
972
973 /*
974 * Change of selection. Unscramble the unholy mess that's in the
975 * selection buffer, resizing it if necessary.
976 */
977
978 ofnPtr = notifyPtr->lpOFN;
979 ofnData = (OFNData *) ofnPtr->lCustData;
980 buffer = ofnData->dynFileBuffer;
981 hdlg = GetParent(hdlg);
982
983 selsize = SendMessageW(hdlg, CDM_GETSPEC, 0, 0);
984 dirsize = SendMessageW(hdlg, CDM_GETFOLDERPATH, 0, 0);
985 buffersize = (selsize + dirsize + 1);
986
987 /*
988 * Just empty the buffer if dirsize indicates an error. [Bug
989 * 3071836]
990 */
991
992 if ((selsize > 1) && (dirsize > 0)) {
993 if (ofnData->dynFileBufferSize < buffersize) {
994 buffer = (WCHAR *) ckrealloc((char *) buffer, buffersize * sizeof(WCHAR));
995 ofnData->dynFileBufferSize = buffersize;
996 ofnData->dynFileBuffer = buffer;
997 }
998
999 SendMessageW(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer);
1000 buffer += dirsize;
1001
1002 SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
1003
1004 /*
1005 * If there are multiple files, delete the quotes and change
1006 * every second quote to NULL terminator
1007 */
1008
1009 if (buffer[0] == '"') {
1010 BOOL findquote = TRUE;
1011 WCHAR *tmp = buffer;
1012
1013 while (*buffer != '\0') {
1014 if (findquote) {
1015 if (*buffer == '"') {
1016 findquote = FALSE;
1017 }
1018 buffer++;
1019 } else {
1020 if (*buffer == '"') {
1021 findquote = TRUE;
1022 *buffer = '\0';
1023 }
1024 *tmp++ = *buffer++;
1025 }
1026 }
1027 *tmp = '\0'; /* Second NULL terminator. */
1028 } else {
1029
1030 /*
1031 * Replace directory terminating NULL with a with a backslash,
1032 * but only if not an absolute path.
1033 */
1034
1035 Tcl_DString tmpfile;
1036 ConvertExternalFilename(buffer, &tmpfile);
1037 if (TCL_PATH_ABSOLUTE ==
1038 Tcl_GetPathType(Tcl_DStringValue(&tmpfile))) {
1039 /* re-get the full path to the start of the buffer */
1040 buffer = (WCHAR *) ofnData->dynFileBuffer;
1041 SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer);
1042 } else {
1043 *(buffer-1) = '\\';
1044 }
1045 buffer[selsize] = '\0'; /* Second NULL terminator. */
1046 Tcl_DStringFree(&tmpfile);
1047 }
1048 } else {
1049 /*
1050 * Nothing is selected, so just empty the string.
1051 */
1052
1053 if (buffer != NULL) {
1054 *buffer = '\0';
1055 }
1056 }
1057 }
1058 } else if (uMsg == WM_WINDOWPOSCHANGED) {
1059 /*
1060 * This message is delivered at the right time to enable Tk to set the
1061 * debug information. Unhooks itself so it won't set the debug
1062 * information every time it gets a WM_WINDOWPOSCHANGED message.
1063 */
1064
1065 ofnPtr = (OPENFILENAMEW *) TkWinGetUserData(hdlg);
1066 if (ofnPtr != NULL) {
1067 ofnData = (OFNData *) ofnPtr->lCustData;
1068 if (ofnData->interp != NULL) {
1069 hdlg = GetParent(hdlg);
1070 tsdPtr->debugInterp = ofnData->interp;
1071 Tcl_DoWhenIdle(SetTkDialog, hdlg);
1072 }
1073 TkWinSetUserData(hdlg, NULL);
1074 }
1075 }
1076 return 0;
1077 }
1078
1079 /*
1080 *----------------------------------------------------------------------
1081 *
1082 * MakeFilter --
1083 *
1084 * Allocate a buffer to store the filters in a format understood by
1085 * Windows.
1086 *
1087 * Results:
1088 * A standard TCL return value.
1089 *
1090 * Side effects:
1091 * ofnPtr->lpstrFilter is modified.
1092 *
1093 *----------------------------------------------------------------------
1094 */
1095
1096 static int
MakeFilter(Tcl_Interp * interp,Tcl_Obj * valuePtr,Tcl_DString * dsPtr,Tcl_Obj * initialPtr,int * indexPtr)1097 MakeFilter(
1098 Tcl_Interp *interp, /* Current interpreter. */
1099 Tcl_Obj *valuePtr, /* Value of the -filetypes option */
1100 Tcl_DString *dsPtr, /* Filled with windows filter string. */
1101 Tcl_Obj *initialPtr, /* Initial type name */
1102 int *indexPtr) /* Index of initial type in filter string */
1103 {
1104 char *filterStr;
1105 char *p;
1106 const char *initial = NULL;
1107 int pass;
1108 int ix = 0; /* index counter */
1109 FileFilterList flist;
1110 FileFilter *filterPtr;
1111
1112 if (initialPtr) {
1113 initial = Tcl_GetString(initialPtr);
1114 }
1115 TkInitFileFilters(&flist);
1116 if (TkGetFileFilters(interp, &flist, valuePtr, 1) != TCL_OK) {
1117 return TCL_ERROR;
1118 }
1119
1120 if (flist.filters == NULL) {
1121 /*
1122 * Use "All Files (*.*) as the default filter if none is specified
1123 */
1124 const char *defaultFilter = "All Files (*.*)";
1125
1126 p = filterStr = ckalloc(30);
1127
1128 strcpy(p, defaultFilter);
1129 p+= strlen(defaultFilter);
1130
1131 *p++ = '\0';
1132 *p++ = '*';
1133 *p++ = '.';
1134 *p++ = '*';
1135 *p++ = '\0';
1136 *p++ = '\0';
1137 *p = '\0';
1138
1139 } else {
1140 int len;
1141
1142 if (valuePtr == NULL) {
1143 len = 0;
1144 } else {
1145 (void) Tcl_GetStringFromObj(valuePtr, &len);
1146 }
1147
1148 /*
1149 * We format the filetype into a string understood by Windows: {"Text
1150 * Documents" {.doc .txt} {TEXT}} becomes "Text Documents
1151 * (*.doc,*.txt)\0*.doc;*.txt\0"
1152 *
1153 * See the Windows OPENFILENAME manual page for details on the filter
1154 * string format.
1155 */
1156
1157 /*
1158 * Since we may only add asterisks (*) to the filter, we need at most
1159 * twice the size of the string to format the filter
1160 */
1161
1162 filterStr = ckalloc((unsigned int) len * 3);
1163
1164 for (filterPtr = flist.filters, p = filterStr; filterPtr;
1165 filterPtr = filterPtr->next) {
1166 const char *sep;
1167 FileFilterClause *clausePtr;
1168
1169 /*
1170 * Check initial index for match, set *indexPtr. Filter index is 1
1171 * based so increment first
1172 */
1173
1174 ix++;
1175 if (indexPtr && initial
1176 && (strcmp(initial, filterPtr->name) == 0)) {
1177 *indexPtr = ix;
1178 }
1179
1180 /*
1181 * First, put in the name of the file type.
1182 */
1183
1184 strcpy(p, filterPtr->name);
1185 p+= strlen(filterPtr->name);
1186 *p++ = ' ';
1187 *p++ = '(';
1188
1189 for (pass = 1; pass <= 2; pass++) {
1190 /*
1191 * In the first pass, we format the extensions in the name
1192 * field. In the second pass, we format the extensions in the
1193 * filter pattern field
1194 */
1195
1196 sep = "";
1197 for (clausePtr=filterPtr->clauses;clausePtr;
1198 clausePtr=clausePtr->next) {
1199 GlobPattern *globPtr;
1200
1201 for (globPtr = clausePtr->patterns; globPtr;
1202 globPtr = globPtr->next) {
1203 strcpy(p, sep);
1204 p += strlen(sep);
1205 strcpy(p, globPtr->pattern);
1206 p += strlen(globPtr->pattern);
1207
1208 if (pass == 1) {
1209 sep = ",";
1210 } else {
1211 sep = ";";
1212 }
1213 }
1214 }
1215 if (pass == 1) {
1216 *p ++ = ')';
1217 }
1218 *p++ = '\0';
1219 }
1220 }
1221
1222 /*
1223 * Windows requires the filter string to be ended by two NULL
1224 * characters.
1225 */
1226
1227 *p++ = '\0';
1228 *p = '\0';
1229 }
1230
1231 Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr));
1232 ckfree((char *) filterStr);
1233
1234 TkFreeFileFilters(&flist);
1235 return TCL_OK;
1236 }
1237
1238 /*
1239 *----------------------------------------------------------------------
1240 *
1241 * Tk_ChooseDirectoryObjCmd --
1242 *
1243 * This function implements the "tk_chooseDirectory" dialog box for the
1244 * Windows platform. See the user documentation for details on what it
1245 * does. Uses the newer SHBrowseForFolder explorer type interface.
1246 *
1247 * Results:
1248 * See user documentation.
1249 *
1250 * Side effects:
1251 * A modal dialog window is created. Tcl_SetServiceMode() is called to
1252 * allow background events to be processed
1253 *
1254 *----------------------------------------------------------------------
1255 *
1256 * The function tk_chooseDirectory pops up a dialog box for the user to select
1257 * a directory. The following option-value pairs are possible as command line
1258 * arguments:
1259 *
1260 * -initialdir dirname
1261 *
1262 * Specifies that the directories in directory should be displayed when the
1263 * dialog pops up. If this parameter is not specified, then the directories in
1264 * the current working directory are displayed. If the parameter specifies a
1265 * relative path, the return value will convert the relative path to an
1266 * absolute path. This option may not always work on the Macintosh. This is
1267 * not a bug. Rather, the General Controls control panel on the Mac allows the
1268 * end user to override the application default directory.
1269 *
1270 * -parent window
1271 *
1272 * Makes window the logical parent of the dialog. The dialog is displayed on
1273 * top of its parent window.
1274 *
1275 * -title titleString
1276 *
1277 * Specifies a string to display as the title of the dialog box. If this
1278 * option is not specified, then a default title will be displayed.
1279 *
1280 * -mustexist boolean
1281 *
1282 * Specifies whether the user may specify non-existant directories. If this
1283 * parameter is true, then the user may only select directories that already
1284 * exist. The default value is false.
1285 *
1286 * New Behaviour:
1287 *
1288 * - If mustexist = 0 and a user entered folder does not exist, a prompt will
1289 * pop-up asking if the user wants another chance to change it. The old
1290 * dialog just returned the bogus entry. On mustexist = 1, the entries MUST
1291 * exist before exiting the box with OK.
1292 *
1293 * Bugs:
1294 *
1295 * - If valid abs directory name is entered into the entry box and Enter
1296 * pressed, the box will close returning the name. This is inconsistent when
1297 * entering relative names or names with forward slashes, which are
1298 * invalidated then corrected in the callback. After correction, the box is
1299 * held open to allow further modification by the user.
1300 *
1301 * - Not sure how to implement localization of message prompts.
1302 *
1303 * - -title is really -message.
1304 *
1305 *----------------------------------------------------------------------
1306 */
1307
1308 int
Tk_ChooseDirectoryObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1309 Tk_ChooseDirectoryObjCmd(
1310 ClientData clientData, /* Main window associated with interpreter. */
1311 Tcl_Interp *interp, /* Current interpreter. */
1312 int objc, /* Number of arguments. */
1313 Tcl_Obj *const objv[]) /* Argument objects. */
1314 {
1315 WCHAR path[MAX_PATH];
1316 int oldMode, result = TCL_ERROR, i;
1317 LPCITEMIDLIST pidl; /* Returned by browser */
1318 BROWSEINFOW bInfo; /* Used by browser */
1319 ChooseDir cdCBData; /* Structure to pass back and forth */
1320 LPMALLOC pMalloc; /* Used by shell */
1321 Tk_Window tkwin = (Tk_Window) clientData;
1322 HWND hWnd;
1323 const char *utfTitle = NULL;/* Title for window */
1324 WCHAR saveDir[MAX_PATH];
1325 Tcl_DString titleString; /* Title */
1326 Tcl_DString initDirString; /* Initial directory */
1327 Tcl_DString tempString; /* temporary */
1328 Tcl_Obj *objPtr;
1329 static const char *optionStrings[] = {
1330 "-initialdir", "-mustexist", "-parent", "-title", NULL
1331 };
1332 enum options {
1333 DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
1334 };
1335
1336 /*
1337 * Initialize
1338 */
1339
1340 path[0] = '\0';
1341 ZeroMemory(&cdCBData, sizeof(ChooseDir));
1342 cdCBData.interp = interp;
1343
1344 /*
1345 * Process the command line options
1346 */
1347
1348 for (i = 1; i < objc; i += 2) {
1349 int index;
1350 const char *string;
1351 const WCHAR *uniStr;
1352 Tcl_Obj *optionPtr, *valuePtr;
1353
1354 optionPtr = objv[i];
1355 valuePtr = objv[i + 1];
1356
1357 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 0,
1358 &index) != TCL_OK) {
1359 goto cleanup;
1360 }
1361 if (i + 1 == objc) {
1362 string = Tcl_GetString(optionPtr);
1363 Tcl_AppendResult(interp, "value for \"", string, "\" missing",
1364 NULL);
1365 goto cleanup;
1366 }
1367
1368 string = Tcl_GetString(valuePtr);
1369 switch ((enum options) index) {
1370 case DIR_INITIAL:
1371 if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) {
1372 goto cleanup;
1373 }
1374 Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1,
1375 &tempString);
1376 uniStr = (WCHAR *) Tcl_DStringValue(&tempString);
1377
1378 /*
1379 * Convert possible relative path to full path to keep dialog
1380 * happy.
1381 */
1382
1383 GetFullPathNameW(uniStr, MAX_PATH, saveDir, NULL);
1384 wcsncpy(cdCBData.initDir, saveDir, MAX_PATH);
1385 Tcl_DStringFree(&initDirString);
1386 Tcl_DStringFree(&tempString);
1387 break;
1388 case DIR_EXIST:
1389 if (Tcl_GetBooleanFromObj(interp, valuePtr,
1390 &cdCBData.mustExist) != TCL_OK) {
1391 goto cleanup;
1392 }
1393 break;
1394 case DIR_PARENT:
1395 tkwin = Tk_NameToWindow(interp, string, tkwin);
1396 if (tkwin == NULL) {
1397 goto cleanup;
1398 }
1399 break;
1400 case FILE_TITLE:
1401 utfTitle = string;
1402 break;
1403 }
1404 }
1405
1406 /*
1407 * Get ready to call the browser
1408 */
1409
1410 Tk_MakeWindowExist(tkwin);
1411 hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
1412
1413 /*
1414 * Setup the parameters used by SHBrowseForFolder
1415 */
1416
1417 bInfo.hwndOwner = hWnd;
1418 bInfo.pszDisplayName = path;
1419 bInfo.pidlRoot = NULL;
1420 if (wcslen(cdCBData.initDir) == 0) {
1421 GetCurrentDirectoryW(MAX_PATH, cdCBData.initDir);
1422 }
1423 bInfo.lParam = (LPARAM) &cdCBData;
1424
1425 if (utfTitle != NULL) {
1426 Tcl_WinUtfToTChar(utfTitle, -1, &titleString);
1427 bInfo.lpszTitle = (LPWSTR) Tcl_DStringValue(&titleString);
1428 } else {
1429 bInfo.lpszTitle = L"Please choose a directory, then select OK.";
1430 }
1431
1432 /*
1433 * Set flags to add edit box, status text line and use the new ui. Allow
1434 * override with magic variable (ignore errors in retrieval). See
1435 * http://msdn.microsoft.com/en-us/library/bb773205(VS.85).aspx for
1436 * possible flag values.
1437 */
1438
1439 bInfo.ulFlags = BIF_EDITBOX | BIF_STATUSTEXT | BIF_RETURNFSANCESTORS
1440 | BIF_VALIDATE | BIF_NEWDIALOGSTYLE;
1441 objPtr = Tcl_GetVar2Ex(interp, "::tk::winChooseDirFlags", NULL,
1442 TCL_GLOBAL_ONLY);
1443 if (objPtr != NULL) {
1444 int flags;
1445 Tcl_GetIntFromObj(NULL, objPtr, &flags);
1446 bInfo.ulFlags = flags;
1447 }
1448
1449 /*
1450 * Callback to handle events
1451 */
1452
1453 bInfo.lpfn = (BFFCALLBACK) ChooseDirectoryValidateProc;
1454
1455 /*
1456 * Display dialog in background and process result. We look to give the
1457 * user a chance to change their mind on an invalid folder if mustexist is
1458 * 0.
1459 */
1460
1461 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
1462 GetCurrentDirectoryW(MAX_PATH, saveDir);
1463 if (SHGetMalloc(&pMalloc) == NOERROR) {
1464 pidl = SHBrowseForFolderW(&bInfo);
1465
1466 /*
1467 * This is a fix for Windows 2000, which seems to modify the folder
1468 * name buffer even when the dialog is canceled (in this case the
1469 * buffer contains garbage). See [Bug #3002230]
1470 */
1471
1472 path[0] = '\0';
1473
1474 /*
1475 * Null for cancel button or invalid dir, otherwise valid.
1476 */
1477
1478 if (pidl != NULL) {
1479 if (!SHGetPathFromIDListW(pidl, path)) {
1480 Tcl_SetResult(interp, "Error: Not a file system folder\n",
1481 TCL_VOLATILE);
1482 }
1483 pMalloc->lpVtbl->Free(pMalloc, (void *) pidl);
1484 } else if (wcslen(cdCBData.retDir) > 0) {
1485 wcscpy(path, cdCBData.retDir);
1486 }
1487 pMalloc->lpVtbl->Release(pMalloc);
1488 }
1489 SetCurrentDirectoryW(saveDir);
1490 Tcl_SetServiceMode(oldMode);
1491
1492 /*
1493 * Ensure that hWnd is enabled, because it can happen that we have updated
1494 * the wrapper of the parent, which causes us to leave this child disabled
1495 * (Windows loses sync).
1496 */
1497
1498 EnableWindow(hWnd, 1);
1499
1500 /*
1501 * Change the pathname to the Tcl "normalized" pathname, where back
1502 * slashes are used instead of forward slashes
1503 */
1504
1505 Tcl_ResetResult(interp);
1506 if (*path) {
1507 Tcl_DString ds;
1508
1509 Tcl_AppendResult(interp, ConvertExternalFilename(path,
1510 &ds), NULL);
1511 Tcl_DStringFree(&ds);
1512 }
1513
1514 result = TCL_OK;
1515
1516 if (utfTitle != NULL) {
1517 Tcl_DStringFree(&titleString);
1518 }
1519
1520 cleanup:
1521 return result;
1522 }
1523
1524 /*
1525 *----------------------------------------------------------------------
1526 *
1527 * ChooseDirectoryValidateProc --
1528 *
1529 * Hook function called by the explorer ChooseDirectory dialog when
1530 * events occur. It is used to validate the text entry the user may have
1531 * entered.
1532 *
1533 * Results:
1534 * Returns 0 to allow default processing of message, or 1 to tell default
1535 * dialog function not to close.
1536 *
1537 *----------------------------------------------------------------------
1538 */
1539
1540 static UINT APIENTRY
ChooseDirectoryValidateProc(HWND hwnd,UINT message,LPARAM lParam,LPARAM lpData)1541 ChooseDirectoryValidateProc(
1542 HWND hwnd,
1543 UINT message,
1544 LPARAM lParam,
1545 LPARAM lpData)
1546 {
1547 WCHAR selDir[MAX_PATH];
1548 ChooseDir *chooseDirSharedData = (ChooseDir *) lpData;
1549 Tcl_DString tempString;
1550 Tcl_DString initDirString;
1551 WCHAR string[MAX_PATH];
1552 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1553 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1554
1555 if (tsdPtr->debugFlag) {
1556 tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp;
1557 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
1558 }
1559 chooseDirSharedData->retDir[0] = '\0';
1560 switch (message) {
1561 case BFFM_VALIDATEFAILED:
1562 /*
1563 * First save and check to see if it is a valid path name, if so then
1564 * make that path the one shown in the window. Otherwise, it failed
1565 * the check and should be treated as such. Use
1566 * Set/GetCurrentDirectory which allows relative path names and names
1567 * with forward slashes. Use Tcl_TranslateFileName to make sure names
1568 * like ~ are converted correctly.
1569 */
1570
1571 Tcl_WinTCharToUtf((TCHAR *) lParam, -1, &initDirString);
1572 if (Tcl_TranslateFileName(chooseDirSharedData->interp,
1573 Tcl_DStringValue(&initDirString), &tempString) == NULL) {
1574 /*
1575 * Should we expose the error (in the interp result) to the user
1576 * at this point?
1577 */
1578
1579 chooseDirSharedData->retDir[0] = '\0';
1580 return 1;
1581 }
1582 Tcl_DStringFree(&initDirString);
1583 Tcl_WinUtfToTChar(Tcl_DStringValue(&tempString), -1, &initDirString);
1584 Tcl_DStringFree(&tempString);
1585 wcsncpy(string, (WCHAR *) Tcl_DStringValue(&initDirString),
1586 MAX_PATH);
1587 Tcl_DStringFree(&initDirString);
1588
1589 if (SetCurrentDirectoryW(string) == 0) {
1590
1591 /*
1592 * Get the full path name to the user entry, at this point it does
1593 * not exist so see if it is supposed to. Otherwise just return
1594 * it.
1595 */
1596
1597 GetFullPathNameW(string, MAX_PATH,
1598 chooseDirSharedData->retDir, NULL);
1599 if (chooseDirSharedData->mustExist) {
1600 /*
1601 * User HAS to select a valid directory.
1602 */
1603
1604 wsprintfW(selDir, L"Directory '%.200s' does not exist,\nplease select or enter an existing directory.",
1605 chooseDirSharedData->retDir);
1606 MessageBoxW(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
1607 chooseDirSharedData->retDir[0] = '\0';
1608 return 1;
1609 }
1610 } else {
1611 /*
1612 * Changed to new folder OK, return immediatly with the current
1613 * directory in utfRetDir.
1614 */
1615
1616 GetCurrentDirectoryW(MAX_PATH, chooseDirSharedData->retDir);
1617 return 0;
1618 }
1619 return 0;
1620
1621 case BFFM_SELCHANGED:
1622 /*
1623 * Set the status window to the currently selected path and enable the
1624 * OK button if a file system folder, otherwise disable the OK button
1625 * for things like server names. Perhaps a new switch
1626 * -enablenonfolders can be used to allow non folders to be selected.
1627 *
1628 * Not called when user changes edit box directly.
1629 */
1630
1631 if (SHGetPathFromIDListW((LPITEMIDLIST) lParam, selDir)) {
1632 SendMessageW(hwnd, BFFM_SETSTATUSTEXTW, 0, (LPARAM) selDir);
1633 // enable the OK button
1634 SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
1635 } else {
1636 // disable the OK button
1637 SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0);
1638 }
1639 UpdateWindow(hwnd);
1640 return 1;
1641
1642 case BFFM_INITIALIZED: {
1643 /*
1644 * Directory browser intializing - tell it where to start from, user
1645 * specified parameter.
1646 */
1647
1648 WCHAR *initDir = chooseDirSharedData->initDir;
1649
1650 SetCurrentDirectoryW(initDir);
1651
1652 if (*initDir == '\\') {
1653 /*
1654 * BFFM_SETSELECTION only understands UNC paths as pidls, so
1655 * convert path to pidl using IShellFolder interface.
1656 */
1657
1658 LPMALLOC pMalloc;
1659 LPSHELLFOLDER psfFolder;
1660
1661 if (SUCCEEDED(SHGetMalloc(&pMalloc))) {
1662 if (SUCCEEDED(SHGetDesktopFolder(&psfFolder))) {
1663 LPITEMIDLIST pidlMain;
1664 ULONG ulCount, ulAttr;
1665
1666 if (SUCCEEDED(psfFolder->lpVtbl->ParseDisplayName(
1667 psfFolder, hwnd, NULL, (WCHAR *)
1668 initDir, &ulCount,&pidlMain,&ulAttr))
1669 && (pidlMain != NULL)) {
1670 SendMessageW(hwnd, BFFM_SETSELECTIONW, FALSE,
1671 (LPARAM) pidlMain);
1672 pMalloc->lpVtbl->Free(pMalloc, pidlMain);
1673 }
1674 psfFolder->lpVtbl->Release(psfFolder);
1675 }
1676 pMalloc->lpVtbl->Release(pMalloc);
1677 }
1678 } else {
1679 SendMessageW(hwnd, BFFM_SETSELECTIONW, TRUE, (LPARAM) initDir);
1680 }
1681 SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1);
1682 break;
1683 }
1684
1685 }
1686 return 0;
1687 }
1688
1689 /*
1690 *----------------------------------------------------------------------
1691 *
1692 * Tk_MessageBoxObjCmd --
1693 *
1694 * This function implements the MessageBox window for the Windows
1695 * platform. See the user documentation for details on what it does.
1696 *
1697 * Results:
1698 * See user documentation.
1699 *
1700 * Side effects:
1701 * None. The MessageBox window will be destroy before this function
1702 * returns.
1703 *
1704 *----------------------------------------------------------------------
1705 */
1706
1707 int
Tk_MessageBoxObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1708 Tk_MessageBoxObjCmd(
1709 ClientData clientData, /* Main window associated with interpreter. */
1710 Tcl_Interp *interp, /* Current interpreter. */
1711 int objc, /* Number of arguments. */
1712 Tcl_Obj *const objv[]) /* Argument objects. */
1713 {
1714 Tk_Window tkwin = (Tk_Window) clientData, parent;
1715 HWND hWnd;
1716 Tcl_Obj *messageObj, *titleObj, *detailObj, *tmpObj;
1717 int defaultBtn, icon, type;
1718 int i, oldMode, winCode;
1719 UINT flags;
1720 static const char *optionStrings[] = {
1721 "-default", "-detail", "-icon", "-message",
1722 "-parent", "-title", "-type", NULL
1723 };
1724 enum options {
1725 MSG_DEFAULT, MSG_DETAIL, MSG_ICON, MSG_MESSAGE,
1726 MSG_PARENT, MSG_TITLE, MSG_TYPE
1727 };
1728 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1729 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1730
1731 defaultBtn = -1;
1732 detailObj = NULL;
1733 icon = MB_ICONINFORMATION;
1734 messageObj = NULL;
1735 parent = tkwin;
1736 titleObj = NULL;
1737 type = MB_OK;
1738
1739 for (i = 1; i < objc; i += 2) {
1740 int index;
1741 Tcl_Obj *optionPtr, *valuePtr;
1742
1743 optionPtr = objv[i];
1744 valuePtr = objv[i + 1];
1745
1746 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
1747 TCL_EXACT, &index) != TCL_OK) {
1748 return TCL_ERROR;
1749 }
1750 if (i + 1 == objc) {
1751 const char *string = Tcl_GetString(optionPtr);
1752 Tcl_AppendResult(interp, "value for \"", string, "\" missing",
1753 NULL);
1754 return TCL_ERROR;
1755 }
1756
1757 switch ((enum options) index) {
1758 case MSG_DEFAULT:
1759 defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap,
1760 valuePtr);
1761 if (defaultBtn < 0) {
1762 return TCL_ERROR;
1763 }
1764 break;
1765
1766 case MSG_DETAIL:
1767 detailObj = valuePtr;
1768 break;
1769
1770 case MSG_ICON:
1771 icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr);
1772 if (icon < 0) {
1773 return TCL_ERROR;
1774 }
1775 break;
1776
1777 case MSG_MESSAGE:
1778 messageObj = valuePtr;
1779 break;
1780
1781 case MSG_PARENT:
1782 parent = Tk_NameToWindow(interp, Tcl_GetString(valuePtr), tkwin);
1783 if (parent == NULL) {
1784 return TCL_ERROR;
1785 }
1786 break;
1787
1788 case MSG_TITLE:
1789 titleObj = valuePtr;
1790 break;
1791
1792 case MSG_TYPE:
1793 type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr);
1794 if (type < 0) {
1795 return TCL_ERROR;
1796 }
1797 break;
1798 }
1799 }
1800
1801 while (!Tk_IsTopLevel(parent)) {
1802 parent = Tk_Parent(parent);
1803 }
1804 Tk_MakeWindowExist(parent);
1805 hWnd = Tk_GetHWND(Tk_WindowId(parent));
1806
1807 flags = 0;
1808 if (defaultBtn >= 0) {
1809 int defaultBtnIdx = -1;
1810
1811 for (i = 0; i < (int) NUM_TYPES; i++) {
1812 if (type == allowedTypes[i].type) {
1813 int j;
1814
1815 for (j = 0; j < 3; j++) {
1816 if (allowedTypes[i].btnIds[j] == defaultBtn) {
1817 defaultBtnIdx = j;
1818 break;
1819 }
1820 }
1821 if (defaultBtnIdx < 0) {
1822 Tcl_AppendResult(interp, "invalid default button \"",
1823 TkFindStateString(buttonMap, defaultBtn),
1824 "\"", NULL);
1825 return TCL_ERROR;
1826 }
1827 break;
1828 }
1829 }
1830 flags = buttonFlagMap[defaultBtnIdx];
1831 }
1832
1833 flags |= icon | type | MB_TASKMODAL | MB_SETFOREGROUND;
1834
1835 tmpObj = messageObj ? Tcl_DuplicateObj(messageObj)
1836 : Tcl_NewUnicodeObj(NULL, 0);
1837 Tcl_IncrRefCount(tmpObj);
1838 if (detailObj) {
1839 Tcl_AppendUnicodeToObj(tmpObj, L"\n\n", 2);
1840 Tcl_AppendObjToObj(tmpObj, detailObj);
1841 }
1842
1843 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
1844
1845 /*
1846 * MessageBoxW exists for all platforms. Use it to allow unicode error
1847 * message to be displayed correctly where possible by the OS.
1848 *
1849 * In order to have the parent window icon reflected in a MessageBox, we
1850 * have to create a hook that will trigger when the MessageBox is being
1851 * created.
1852 */
1853
1854 tsdPtr->hSmallIcon = TkWinGetIcon(parent, ICON_SMALL);
1855 tsdPtr->hBigIcon = TkWinGetIcon(parent, ICON_BIG);
1856 tsdPtr->hMsgBoxHook = SetWindowsHookExW(WH_CBT, MsgBoxCBTProc, NULL,
1857 GetCurrentThreadId());
1858 winCode = MessageBoxW(hWnd, Tcl_GetUnicode(tmpObj),
1859 titleObj ? Tcl_GetUnicode(titleObj) : L"", flags);
1860 UnhookWindowsHookEx(tsdPtr->hMsgBoxHook);
1861 (void) Tcl_SetServiceMode(oldMode);
1862
1863 /*
1864 * Ensure that hWnd is enabled, because it can happen that we have updated
1865 * the wrapper of the parent, which causes us to leave this child disabled
1866 * (Windows loses sync).
1867 */
1868
1869 EnableWindow(hWnd, 1);
1870
1871 Tcl_DecrRefCount(tmpObj);
1872
1873 Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);
1874 return TCL_OK;
1875 }
1876
1877 static LRESULT CALLBACK
MsgBoxCBTProc(int nCode,WPARAM wParam,LPARAM lParam)1878 MsgBoxCBTProc(
1879 int nCode,
1880 WPARAM wParam,
1881 LPARAM lParam)
1882 {
1883 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1884 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1885
1886 if (nCode == HCBT_CREATEWND) {
1887 /*
1888 * Window owned by our task is being created. Since the hook is
1889 * installed just before the MessageBox call and removed after the
1890 * MessageBox call, the window being created is either the message box
1891 * or one of its controls. Check that the class is WC_DIALOG to ensure
1892 * that it's the one we want.
1893 */
1894
1895 LPCBT_CREATEWND lpcbtcreate = (LPCBT_CREATEWND) lParam;
1896
1897 if (WC_DIALOG == lpcbtcreate->lpcs->lpszClass) {
1898 HWND hwnd = (HWND) wParam;
1899
1900 SendMessageW(hwnd, WM_SETICON, ICON_SMALL,
1901 (LPARAM) tsdPtr->hSmallIcon);
1902 SendMessageW(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon);
1903 }
1904 }
1905
1906 /*
1907 * Call the next hook proc, if there is one
1908 */
1909
1910 return CallNextHookEx(tsdPtr->hMsgBoxHook, nCode, wParam, lParam);
1911 }
1912
1913 /*
1914 * ----------------------------------------------------------------------
1915 *
1916 * SetTkDialog --
1917 *
1918 * Records the HWND for a native dialog in the 'tk_dialog' variable so
1919 * that the test-suite can operate on the correct dialog window. Use of
1920 * this is enabled when a test program calls TkWinDialogDebug by calling
1921 * the test command 'tkwinevent debug 1'.
1922 *
1923 * ----------------------------------------------------------------------
1924 */
1925
1926 static void
SetTkDialog(ClientData clientData)1927 SetTkDialog(
1928 ClientData clientData)
1929 {
1930 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1931 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1932 char buf[32];
1933
1934 sprintf(buf, "0x%p", (HWND) clientData);
1935 Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
1936 }
1937
1938 /*
1939 * Factored out a common pattern in use in this file.
1940 */
1941
1942 static const char *
ConvertExternalFilename(WCHAR * filename,Tcl_DString * dsPtr)1943 ConvertExternalFilename(
1944 WCHAR *filename,
1945 Tcl_DString *dsPtr)
1946 {
1947 char *p;
1948
1949 Tcl_WinTCharToUtf((TCHAR *) filename, -1, dsPtr);
1950 for (p = Tcl_DStringValue(dsPtr); *p != '\0'; p++) {
1951 /*
1952 * Change the pathname to the Tcl "normalized" pathname, where back
1953 * slashes are used instead of forward slashes
1954 */
1955
1956 if (*p == '\\') {
1957 *p = '/';
1958 }
1959 }
1960 return Tcl_DStringValue(dsPtr);
1961 }
1962
1963 /*
1964 * Local Variables:
1965 * mode: c
1966 * c-basic-offset: 4
1967 * fill-column: 78
1968 * End:
1969 */
1970