/[dtapublic]/projs/trunk/shared_source/tk_base/tkwindialog.c
ViewVC logotype

Contents of /projs/trunk/shared_source/tk_base/tkwindialog.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 42 - (show annotations) (download)
Fri Oct 14 01:50:00 2016 UTC (7 years, 5 months ago) by dashley
File MIME type: text/plain
File size: 49197 byte(s)
Move shared source code to commonize.
1 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkwindialog.c,v 1.1.1.1 2001/06/13 05:12:25 dtashley Exp $ */
2
3
4 /*
5 * tkWinDialog.c --
6 *
7 * Contains the Windows implementation of the common dialog boxes.
8 *
9 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
10 *
11 * See the file "license.terms" for information on usage and redistribution
12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * RCS: @(#) $Id: tkwindialog.c,v 1.1.1.1 2001/06/13 05:12:25 dtashley Exp $
15 *
16 */
17
18 #include "tkWinInt.h"
19 #include "tkFileFilter.h"
20
21 #include <commdlg.h> /* includes common dialog functionality */
22 #include <dlgs.h> /* includes common dialog template defines */
23 #include <cderr.h> /* includes the common dialog error codes */
24
25 typedef struct ThreadSpecificData {
26 int debugFlag; /* Flags whether we should output debugging
27 * information while displaying a builtin
28 * dialog. */
29 Tcl_Interp *debugInterp; /* Interpreter to used for debugging. */
30 UINT WM_LBSELCHANGED; /* Holds a registered windows event used for
31 * communicating between the Directory
32 * Chooser dialog and its hook proc. */
33 } ThreadSpecificData;
34 static Tcl_ThreadDataKey dataKey;
35
36 /*
37 * The following structures are used by Tk_MessageBoxCmd() to parse
38 * arguments and return results.
39 */
40
41 static const TkStateMap iconMap[] = {
42 {MB_ICONERROR, "error"},
43 {MB_ICONINFORMATION, "info"},
44 {MB_ICONQUESTION, "question"},
45 {MB_ICONWARNING, "warning"},
46 {-1, NULL}
47 };
48
49 static const TkStateMap typeMap[] = {
50 {MB_ABORTRETRYIGNORE, "abortretryignore"},
51 {MB_OK, "ok"},
52 {MB_OKCANCEL, "okcancel"},
53 {MB_RETRYCANCEL, "retrycancel"},
54 {MB_YESNO, "yesno"},
55 {MB_YESNOCANCEL, "yesnocancel"},
56 {-1, NULL}
57 };
58
59 static const TkStateMap buttonMap[] = {
60 {IDABORT, "abort"},
61 {IDRETRY, "retry"},
62 {IDIGNORE, "ignore"},
63 {IDOK, "ok"},
64 {IDCANCEL, "cancel"},
65 {IDNO, "no"},
66 {IDYES, "yes"},
67 {-1, NULL}
68 };
69
70 static const int buttonFlagMap[] = {
71 MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4
72 };
73
74 static const struct {int type; int btnIds[3];} allowedTypes[] = {
75 {MB_ABORTRETRYIGNORE, {IDABORT, IDRETRY, IDIGNORE}},
76 {MB_OK, {IDOK, -1, -1 }},
77 {MB_OKCANCEL, {IDOK, IDCANCEL, -1 }},
78 {MB_RETRYCANCEL, {IDRETRY, IDCANCEL, -1 }},
79 {MB_YESNO, {IDYES, IDNO, -1 }},
80 {MB_YESNOCANCEL, {IDYES, IDNO, IDCANCEL}}
81 };
82
83 #define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0]))
84
85 /*
86 * The following structure is used to pass information between the directory
87 * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.
88 */
89
90 typedef struct ChooseDir {
91 Tcl_Interp *interp; /* Interp, used only if debug is turned on,
92 * for setting the "tk_dialog" variable. */
93 int lastCtrl; /* Used by hook proc to keep track of last
94 * control that had input focus, so when OK
95 * is pressed we know whether to browse a
96 * new directory or return. */
97 int lastIdx; /* Last item that was selected in directory
98 * browser listbox. */
99 TCHAR path[MAX_PATH]; /* On return from choose directory dialog,
100 * holds the selected path. Cannot return
101 * selected path in ofnPtr->lpstrFile because
102 * the default dialog proc stores a '\0' in
103 * it, since, of course, no _file_ was
104 * selected. */
105 } ChooseDir;
106
107 /*
108 * Definitions of procedures used only in this file.
109 */
110
111 static UINT APIENTRY ChooseDirectoryHookProc(HWND hdlg, UINT uMsg,
112 WPARAM wParam, LPARAM lParam);
113 static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
114 LPARAM lParam);
115 static int GetFileNameA(ClientData clientData,
116 Tcl_Interp *interp, int objc,
117 Tcl_Obj *CONST objv[], int isOpen);
118 static int GetFileNameW(ClientData clientData,
119 Tcl_Interp *interp, int objc,
120 Tcl_Obj *CONST objv[], int isOpen);
121 static int MakeFilter(Tcl_Interp *interp, char *string,
122 Tcl_DString *dsPtr);
123 static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
124 LPARAM lParam);
125 static UINT APIENTRY OFNHookProcW(HWND hdlg, UINT uMsg, WPARAM wParam,
126 LPARAM lParam);
127 static void SetTkDialog(ClientData clientData);
128 static int TrySetDirectory(HWND hwnd, const TCHAR *dir);
129
130 /*
131 *-------------------------------------------------------------------------
132 *
133 * TkWinDialogDebug --
134 *
135 * Function to turn on/off debugging support for common dialogs under
136 * windows. The variable "tk_debug" is set to the identifier of the
137 * dialog window when the modal dialog window pops up and it is safe to
138 * send messages to the dialog.
139 *
140 * Results:
141 * None.
142 *
143 * Side effects:
144 * This variable only makes sense if just one dialog is up at a time.
145 *
146 *-------------------------------------------------------------------------
147 */
148
149 void
150 TkWinDialogDebug(
151 int debug)
152 {
153 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
154 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
155
156 tsdPtr->debugFlag = debug;
157 }
158
159 /*
160 *-------------------------------------------------------------------------
161 *
162 * Tk_ChooseColorObjCmd --
163 *
164 * This procedure implements the color dialog box for the Windows
165 * platform. See the user documentation for details on what it
166 * does.
167 *
168 * Results:
169 * See user documentation.
170 *
171 * Side effects:
172 * A dialog window is created the first time this procedure is called.
173 * This window is not destroyed and will be reused the next time the
174 * application invokes the "tk_chooseColor" command.
175 *
176 *-------------------------------------------------------------------------
177 */
178
179 int
180 Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
181 ClientData clientData; /* Main window associated with interpreter. */
182 Tcl_Interp *interp; /* Current interpreter. */
183 int objc; /* Number of arguments. */
184 Tcl_Obj *CONST objv[]; /* Argument objects. */
185 {
186 Tk_Window tkwin, parent;
187 HWND hWnd;
188 int i, oldMode, winCode;
189 CHOOSECOLOR chooseColor;
190 static inited = 0;
191 static COLORREF dwCustColors[16];
192 static long oldColor; /* the color selected last time */
193 static char *optionStrings[] = {
194 "-initialcolor", "-parent", "-title", NULL
195 };
196 enum options {
197 COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
198 };
199
200 if (inited == 0) {
201 /*
202 * dwCustColors stores the custom color which the user can
203 * modify. We store these colors in a static array so that the next
204 * time the color dialog pops up, the same set of custom colors
205 * remain in the dialog.
206 */
207 for (i = 0; i < 16; i++) {
208 dwCustColors[i] = RGB(255-i * 10, i, i * 10);
209 }
210 oldColor = RGB(0xa0, 0xa0, 0xa0);
211 inited = 1;
212 }
213
214 tkwin = (Tk_Window) clientData;
215
216 parent = tkwin;
217 chooseColor.lStructSize = sizeof(CHOOSECOLOR);
218 chooseColor.hwndOwner = NULL;
219 chooseColor.hInstance = NULL;
220 chooseColor.rgbResult = oldColor;
221 chooseColor.lpCustColors = dwCustColors;
222 chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
223 chooseColor.lCustData = (LPARAM) NULL;
224 chooseColor.lpfnHook = ColorDlgHookProc;
225 chooseColor.lpTemplateName = (LPTSTR) interp;
226
227 for (i = 1; i < objc; i += 2) {
228 int index;
229 char *string;
230 Tcl_Obj *optionPtr, *valuePtr;
231
232 optionPtr = objv[i];
233 valuePtr = objv[i + 1];
234
235 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
236 TCL_EXACT, &index) != TCL_OK) {
237 return TCL_ERROR;
238 }
239 if (i + 1 == objc) {
240 string = Tcl_GetStringFromObj(optionPtr, NULL);
241 Tcl_AppendResult(interp, "value for \"", string, "\" missing",
242 (char *) NULL);
243 return TCL_ERROR;
244 }
245
246 string = Tcl_GetStringFromObj(valuePtr, NULL);
247 switch ((enum options) index) {
248 case COLOR_INITIAL: {
249 XColor *colorPtr;
250
251 colorPtr = Tk_GetColor(interp, tkwin, string);
252 if (colorPtr == NULL) {
253 return TCL_ERROR;
254 }
255 chooseColor.rgbResult = RGB(colorPtr->red / 0x100,
256 colorPtr->green / 0x100, colorPtr->blue / 0x100);
257 break;
258 }
259 case COLOR_PARENT: {
260 parent = Tk_NameToWindow(interp, string, tkwin);
261 if (parent == NULL) {
262 return TCL_ERROR;
263 }
264 break;
265 }
266 case COLOR_TITLE: {
267 chooseColor.lCustData = (LPARAM) string;
268 break;
269 }
270 }
271 }
272
273 Tk_MakeWindowExist(parent);
274 chooseColor.hwndOwner = NULL;
275 hWnd = Tk_GetHWND(Tk_WindowId(parent));
276 chooseColor.hwndOwner = hWnd;
277
278 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
279 winCode = ChooseColor(&chooseColor);
280 (void) Tcl_SetServiceMode(oldMode);
281
282 /*
283 * Ensure that hWnd is enabled, because it can happen that we
284 * have updated the wrapper of the parent, which causes us to
285 * leave this child disabled (Windows loses sync).
286 */
287 EnableWindow(hWnd, 1);
288
289 /*
290 * Clear the interp result since anything may have happened during the
291 * modal loop.
292 */
293
294 Tcl_ResetResult(interp);
295
296 /*
297 * 3. Process the result of the dialog
298 */
299
300 if (winCode) {
301 /*
302 * User has selected a color
303 */
304 char result[100];
305
306 sprintf(result, "#%02x%02x%02x",
307 GetRValue(chooseColor.rgbResult),
308 GetGValue(chooseColor.rgbResult),
309 GetBValue(chooseColor.rgbResult));
310 Tcl_AppendResult(interp, result, NULL);
311 oldColor = chooseColor.rgbResult;
312 }
313 return TCL_OK;
314 }
315
316 /*
317 *-------------------------------------------------------------------------
318 *
319 * ColorDlgHookProc --
320 *
321 * Provides special handling of messages for the Color common dialog
322 * box. Used to set the title when the dialog first appears.
323 *
324 * Results:
325 * The return value is 0 if the default dialog box procedure should
326 * handle the message, non-zero otherwise.
327 *
328 * Side effects:
329 * Changes the title of the dialog window.
330 *
331 *----------------------------------------------------------------------
332 */
333
334 static UINT CALLBACK
335 ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
336 HWND hDlg; /* Handle to the color dialog. */
337 UINT uMsg; /* Type of message. */
338 WPARAM wParam; /* First message parameter. */
339 LPARAM lParam; /* Second message parameter. */
340 {
341 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
342 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
343
344 switch (uMsg) {
345 case WM_INITDIALOG: {
346 const char *title;
347 CHOOSECOLOR *ccPtr;
348 Tcl_DString ds;
349
350 /*
351 * Set the title string of the dialog.
352 */
353
354 ccPtr = (CHOOSECOLOR *) lParam;
355 title = (const char *) ccPtr->lCustData;
356 if ((title != NULL) && (title[0] != '\0')) {
357 Tcl_UtfToExternalDString(NULL, title, -1, &ds);
358 SetWindowText(hDlg, (TCHAR *) Tcl_DStringValue(&ds));
359 Tcl_DStringFree(&ds);
360 }
361 if (tsdPtr->debugFlag) {
362 tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
363 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
364 }
365 return TRUE;
366 }
367 }
368 return FALSE;
369 }
370
371 /*
372 *----------------------------------------------------------------------
373 *
374 * Tk_GetOpenFileCmd --
375 *
376 * This procedure implements the "open file" dialog box for the
377 * Windows platform. See the user documentation for details on what
378 * it does.
379 *
380 * Results:
381 * See user documentation.
382 *
383 * Side effects:
384 * A dialog window is created the first this procedure is called.
385 *
386 *----------------------------------------------------------------------
387 */
388
389 int
390 Tk_GetOpenFileObjCmd(clientData, interp, objc, objv)
391 ClientData clientData; /* Main window associated with interpreter. */
392 Tcl_Interp *interp; /* Current interpreter. */
393 int objc; /* Number of arguments. */
394 Tcl_Obj *CONST objv[]; /* Argument objects. */
395 {
396 if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
397 return GetFileNameW(clientData, interp, objc, objv, 1);
398 } else {
399 return GetFileNameA(clientData, interp, objc, objv, 1);
400 }
401 }
402
403 /*
404 *----------------------------------------------------------------------
405 *
406 * Tk_GetSaveFileCmd --
407 *
408 * Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
409 * instead
410 *
411 * Results:
412 * Same as Tk_GetOpenFileCmd.
413 *
414 * Side effects:
415 * Same as Tk_GetOpenFileCmd.
416 *
417 *----------------------------------------------------------------------
418 */
419
420 int
421 Tk_GetSaveFileObjCmd(clientData, interp, objc, objv)
422 ClientData clientData; /* Main window associated with interpreter. */
423 Tcl_Interp *interp; /* Current interpreter. */
424 int objc; /* Number of arguments. */
425 Tcl_Obj *CONST objv[]; /* Argument objects. */
426 {
427 if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
428 return GetFileNameW(clientData, interp, objc, objv, 0);
429 } else {
430 return GetFileNameA(clientData, interp, objc, objv, 0);
431 }
432 }
433
434 /*
435 *----------------------------------------------------------------------
436 *
437 * GetFileNameW --
438 *
439 * Calls GetOpenFileName() or GetSaveFileName().
440 *
441 * Results:
442 * See user documentation.
443 *
444 * Side effects:
445 * See user documentation.
446 *
447 *----------------------------------------------------------------------
448 */
449
450 static int
451 GetFileNameW(clientData, interp, objc, objv, open)
452 ClientData clientData; /* Main window associated with interpreter. */
453 Tcl_Interp *interp; /* Current interpreter. */
454 int objc; /* Number of arguments. */
455 Tcl_Obj *CONST objv[]; /* Argument objects. */
456 int open; /* 1 to call GetOpenFileName(), 0 to
457 * call GetSaveFileName(). */
458 {
459 Tcl_Encoding unicodeEncoding = Tcl_GetEncoding(NULL, "unicode");
460 OPENFILENAMEW ofn;
461 WCHAR file[MAX_PATH];
462 int result, winCode, oldMode, i;
463 char *extension, *filter, *title;
464 Tk_Window tkwin;
465 HWND hWnd;
466 Tcl_DString utfFilterString, utfDirString;
467 Tcl_DString extString, filterString, dirString, titleString;
468 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
469 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
470 static char *optionStrings[] = {
471 "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
472 "-parent", "-title", NULL
473 };
474 enum options {
475 FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
476 FILE_PARENT, FILE_TITLE
477 };
478
479 result = TCL_ERROR;
480 file[0] = '\0';
481
482 /*
483 * Parse the arguments.
484 */
485
486 extension = NULL;
487 filter = NULL;
488 Tcl_DStringInit(&utfFilterString);
489 Tcl_DStringInit(&utfDirString);
490 tkwin = (Tk_Window) clientData;
491 title = NULL;
492
493 for (i = 1; i < objc; i += 2) {
494 int index;
495 char *string;
496 Tcl_Obj *optionPtr, *valuePtr;
497
498 optionPtr = objv[i];
499 valuePtr = objv[i + 1];
500
501 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
502 0, &index) != TCL_OK) {
503 goto end;
504 }
505 if (i + 1 == objc) {
506 string = Tcl_GetStringFromObj(optionPtr, NULL);
507 Tcl_AppendResult(interp, "value for \"", string, "\" missing",
508 (char *) NULL);
509 goto end;
510 }
511
512 string = Tcl_GetStringFromObj(valuePtr, NULL);
513 switch ((enum options) index) {
514 case FILE_DEFAULT: {
515 if (string[0] == '.') {
516 string++;
517 }
518 extension = string;
519 break;
520 }
521 case FILE_TYPES: {
522 Tcl_DStringFree(&utfFilterString);
523 if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
524 goto end;
525 }
526 filter = Tcl_DStringValue(&utfFilterString);
527 break;
528 }
529 case FILE_INITDIR: {
530 Tcl_DStringFree(&utfDirString);
531 if (Tcl_TranslateFileName(interp, string,
532 &utfDirString) == NULL) {
533 goto end;
534 }
535 break;
536 }
537 case FILE_INITFILE: {
538 Tcl_DString ds;
539
540 if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
541 goto end;
542 }
543 Tcl_UtfToExternal(NULL, unicodeEncoding, Tcl_DStringValue(&ds),
544 Tcl_DStringLength(&ds), 0, NULL, (char *) file,
545 sizeof(file), NULL, NULL, NULL);
546 break;
547 }
548 case FILE_PARENT: {
549 tkwin = Tk_NameToWindow(interp, string, tkwin);
550 if (tkwin == NULL) {
551 goto end;
552 }
553 break;
554 }
555 case FILE_TITLE: {
556 title = string;
557 break;
558 }
559 }
560 }
561
562 if (filter == NULL) {
563 if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
564 goto end;
565 }
566 }
567
568 Tk_MakeWindowExist(tkwin);
569 hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
570
571 ofn.lStructSize = sizeof(ofn);
572 ofn.hwndOwner = hWnd;
573 ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
574 GWL_HINSTANCE);
575 ofn.lpstrFilter = NULL;
576 ofn.lpstrCustomFilter = NULL;
577 ofn.nMaxCustFilter = 0;
578 ofn.nFilterIndex = 0;
579 ofn.lpstrFile = (WCHAR *) file;
580 ofn.nMaxFile = MAX_PATH;
581 ofn.lpstrFileTitle = NULL;
582 ofn.nMaxFileTitle = 0;
583 ofn.lpstrInitialDir = NULL;
584 ofn.lpstrTitle = NULL;
585 ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST
586 | OFN_NOCHANGEDIR | OFN_EXPLORER;
587 ofn.nFileOffset = 0;
588 ofn.nFileExtension = 0;
589 ofn.lpstrDefExt = NULL;
590 ofn.lpfnHook = OFNHookProcW;
591 ofn.lCustData = (LPARAM) interp;
592 ofn.lpTemplateName = NULL;
593
594 if (open != 0) {
595 ofn.Flags |= OFN_FILEMUSTEXIST;
596 } else {
597 ofn.Flags |= OFN_OVERWRITEPROMPT;
598 }
599
600 if (tsdPtr->debugFlag != 0) {
601 ofn.Flags |= OFN_ENABLEHOOK;
602 }
603
604 if (extension != NULL) {
605 Tcl_UtfToExternalDString(unicodeEncoding, extension, -1, &extString);
606 ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString);
607 }
608
609 Tcl_UtfToExternalDString(unicodeEncoding, Tcl_DStringValue(&utfFilterString),
610 Tcl_DStringLength(&utfFilterString), &filterString);
611 ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);
612
613 if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
614 Tcl_UtfToExternalDString(unicodeEncoding, Tcl_DStringValue(&utfDirString),
615 Tcl_DStringLength(&utfDirString), &dirString);
616 ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);
617 }
618
619 if (title != NULL) {
620 Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);
621 ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);
622 }
623
624 /*
625 * Popup the dialog.
626 */
627
628 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
629 if (open != 0) {
630 winCode = GetOpenFileNameW(&ofn);
631 } else {
632 winCode = GetSaveFileNameW(&ofn);
633 }
634 Tcl_SetServiceMode(oldMode);
635
636 /*
637 * Ensure that hWnd is enabled, because it can happen that we
638 * have updated the wrapper of the parent, which causes us to
639 * leave this child disabled (Windows loses sync).
640 */
641 EnableWindow(hWnd, 1);
642
643 /*
644 * Clear the interp result since anything may have happened during the
645 * modal loop.
646 */
647
648 Tcl_ResetResult(interp);
649
650 /*
651 * Process the results.
652 */
653
654 if (winCode != 0) {
655 char *p;
656 Tcl_DString ds;
657
658 Tcl_ExternalToUtfDString(unicodeEncoding, (char *) ofn.lpstrFile, -1, &ds);
659 for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
660 /*
661 * Change the pathname to the Tcl "normalized" pathname, where
662 * back slashes are used instead of forward slashes
663 */
664 if (*p == '\\') {
665 *p = '/';
666 }
667 }
668 Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
669 Tcl_DStringFree(&ds);
670 }
671
672 if (ofn.lpstrTitle != NULL) {
673 Tcl_DStringFree(&titleString);
674 }
675 if (ofn.lpstrInitialDir != NULL) {
676 Tcl_DStringFree(&dirString);
677 }
678 Tcl_DStringFree(&filterString);
679 if (ofn.lpstrDefExt != NULL) {
680 Tcl_DStringFree(&extString);
681 }
682 result = TCL_OK;
683
684 end:
685 Tcl_DStringFree(&utfDirString);
686 Tcl_DStringFree(&utfFilterString);
687
688 return result;
689 }
690
691 /*
692 *-------------------------------------------------------------------------
693 *
694 * OFNHookProcW --
695 *
696 * Hook procedure called only if debugging is turned on. Sets
697 * the "tk_dialog" variable when the dialog is ready to receive
698 * messages.
699 *
700 * Results:
701 * Returns 0 to allow default processing of messages to occur.
702 *
703 * Side effects:
704 * None.
705 *
706 *-------------------------------------------------------------------------
707 */
708
709 static UINT APIENTRY
710 OFNHookProcW(
711 HWND hdlg, // handle to child dialog window
712 UINT uMsg, // message identifier
713 WPARAM wParam, // message parameter
714 LPARAM lParam) // message parameter
715 {
716 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
717 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
718 OPENFILENAMEW *ofnPtr;
719
720 if (uMsg == WM_INITDIALOG) {
721 SetWindowLong(hdlg, GWL_USERDATA, lParam);
722 } else if (uMsg == WM_WINDOWPOSCHANGED) {
723 /*
724 * This message is delivered at the right time to enable Tk
725 * to set the debug information. Unhooks itself so it
726 * won't set the debug information every time it gets a
727 * WM_WINDOWPOSCHANGED message.
728 */
729
730 ofnPtr = (OPENFILENAMEW *) GetWindowLong(hdlg, GWL_USERDATA);
731 if (ofnPtr != NULL) {
732 hdlg = GetParent(hdlg);
733 tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;
734 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
735 SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
736 }
737 }
738 return 0;
739 }
740
741 /*
742 *----------------------------------------------------------------------
743 *
744 * GetFileNameA --
745 *
746 * Calls GetOpenFileName() or GetSaveFileName().
747 *
748 * Results:
749 * See user documentation.
750 *
751 * Side effects:
752 * See user documentation.
753 *
754 *----------------------------------------------------------------------
755 */
756
757 static int
758 GetFileNameA(clientData, interp, objc, objv, open)
759 ClientData clientData; /* Main window associated with interpreter. */
760 Tcl_Interp *interp; /* Current interpreter. */
761 int objc; /* Number of arguments. */
762 Tcl_Obj *CONST objv[]; /* Argument objects. */
763 int open; /* 1 to call GetOpenFileName(), 0 to
764 * call GetSaveFileName(). */
765 {
766 OPENFILENAME ofn;
767 TCHAR file[MAX_PATH], savePath[MAX_PATH];
768 int result, winCode, oldMode, i;
769 char *extension, *filter, *title;
770 Tk_Window tkwin;
771 HWND hWnd;
772 Tcl_DString utfFilterString, utfDirString;
773 Tcl_DString extString, filterString, dirString, titleString;
774 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
775 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
776 static char *optionStrings[] = {
777 "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
778 "-parent", "-title", NULL
779 };
780 enum options {
781 FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
782 FILE_PARENT, FILE_TITLE
783 };
784
785 result = TCL_ERROR;
786 file[0] = '\0';
787
788 /*
789 * Parse the arguments.
790 */
791
792 extension = NULL;
793 filter = NULL;
794 Tcl_DStringInit(&utfFilterString);
795 Tcl_DStringInit(&utfDirString);
796 tkwin = (Tk_Window) clientData;
797 title = NULL;
798
799 for (i = 1; i < objc; i += 2) {
800 int index;
801 char *string;
802 Tcl_Obj *optionPtr, *valuePtr;
803
804 optionPtr = objv[i];
805 valuePtr = objv[i + 1];
806
807 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
808 0, &index) != TCL_OK) {
809 goto end;
810 }
811 if (i + 1 == objc) {
812 string = Tcl_GetStringFromObj(optionPtr, NULL);
813 Tcl_AppendResult(interp, "value for \"", string, "\" missing",
814 (char *) NULL);
815 goto end;
816 }
817
818 string = Tcl_GetStringFromObj(valuePtr, NULL);
819 switch ((enum options) index) {
820 case FILE_DEFAULT: {
821 if (string[0] == '.') {
822 string++;
823 }
824 extension = string;
825 break;
826 }
827 case FILE_TYPES: {
828 Tcl_DStringFree(&utfFilterString);
829 if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
830 goto end;
831 }
832 filter = Tcl_DStringValue(&utfFilterString);
833 break;
834 }
835 case FILE_INITDIR: {
836 Tcl_DStringFree(&utfDirString);
837 if (Tcl_TranslateFileName(interp, string,
838 &utfDirString) == NULL) {
839 goto end;
840 }
841 break;
842 }
843 case FILE_INITFILE: {
844 Tcl_DString ds;
845
846 if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
847 goto end;
848 }
849 Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds),
850 Tcl_DStringLength(&ds), 0, NULL, (char *) file,
851 sizeof(file), NULL, NULL, NULL);
852 break;
853 }
854 case FILE_PARENT: {
855 tkwin = Tk_NameToWindow(interp, string, tkwin);
856 if (tkwin == NULL) {
857 goto end;
858 }
859 break;
860 }
861 case FILE_TITLE: {
862 title = string;
863 break;
864 }
865 }
866 }
867
868 if (filter == NULL) {
869 if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
870 goto end;
871 }
872 }
873
874 Tk_MakeWindowExist(tkwin);
875 hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
876
877 ofn.lStructSize = sizeof(ofn);
878 ofn.hwndOwner = hWnd;
879 ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
880 GWL_HINSTANCE);
881 ofn.lpstrFilter = NULL;
882 ofn.lpstrCustomFilter = NULL;
883 ofn.nMaxCustFilter = 0;
884 ofn.nFilterIndex = 0;
885 ofn.lpstrFile = (LPTSTR) file;
886 ofn.nMaxFile = MAX_PATH;
887 ofn.lpstrFileTitle = NULL;
888 ofn.nMaxFileTitle = 0;
889 ofn.lpstrInitialDir = NULL;
890 ofn.lpstrTitle = NULL;
891 ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST
892 | OFN_NOCHANGEDIR | OFN_EXPLORER;
893 ofn.nFileOffset = 0;
894 ofn.nFileExtension = 0;
895 ofn.lpstrDefExt = NULL;
896 ofn.lpfnHook = OFNHookProc;
897 ofn.lCustData = (LPARAM) interp;
898 ofn.lpTemplateName = NULL;
899
900 if (open != 0) {
901 ofn.Flags |= OFN_FILEMUSTEXIST;
902 } else {
903 ofn.Flags |= OFN_OVERWRITEPROMPT;
904 }
905
906 if (tsdPtr->debugFlag != 0) {
907 ofn.Flags |= OFN_ENABLEHOOK;
908 }
909
910 if (extension != NULL) {
911 Tcl_UtfToExternalDString(NULL, extension, -1, &extString);
912 ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString);
913 }
914 Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString),
915 Tcl_DStringLength(&utfFilterString), &filterString);
916 ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString);
917
918 if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
919 Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
920 Tcl_DStringLength(&utfDirString), &dirString);
921 ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
922 }
923 if (title != NULL) {
924 Tcl_UtfToExternalDString(NULL, title, -1, &titleString);
925 ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
926 }
927
928 /*
929 * Popup the dialog.
930 */
931
932 GetCurrentDirectory(MAX_PATH, savePath);
933 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
934 if (open != 0) {
935 winCode = GetOpenFileName(&ofn);
936 } else {
937 winCode = GetSaveFileName(&ofn);
938 }
939 Tcl_SetServiceMode(oldMode);
940 SetCurrentDirectory(savePath);
941
942 /*
943 * Ensure that hWnd is enabled, because it can happen that we
944 * have updated the wrapper of the parent, which causes us to
945 * leave this child disabled (Windows loses sync).
946 */
947 EnableWindow(hWnd, 1);
948
949 /*
950 * Clear the interp result since anything may have happened during the
951 * modal loop.
952 */
953
954 Tcl_ResetResult(interp);
955
956 /*
957 * Process the results.
958 */
959
960 if (winCode != 0) {
961 char *p;
962 Tcl_DString ds;
963
964 Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds);
965 for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
966 /*
967 * Change the pathname to the Tcl "normalized" pathname, where
968 * back slashes are used instead of forward slashes
969 */
970 if (*p == '\\') {
971 *p = '/';
972 }
973 }
974 Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
975 Tcl_DStringFree(&ds);
976 }
977
978 if (ofn.lpstrTitle != NULL) {
979 Tcl_DStringFree(&titleString);
980 }
981 if (ofn.lpstrInitialDir != NULL) {
982 Tcl_DStringFree(&dirString);
983 }
984 Tcl_DStringFree(&filterString);
985 if (ofn.lpstrDefExt != NULL) {
986 Tcl_DStringFree(&extString);
987 }
988 result = TCL_OK;
989
990 end:
991 Tcl_DStringFree(&utfDirString);
992 Tcl_DStringFree(&utfFilterString);
993
994 return result;
995 }
996
997 /*
998 *-------------------------------------------------------------------------
999 *
1000 * OFNHookProc --
1001 *
1002 * Hook procedure called only if debugging is turned on. Sets
1003 * the "tk_dialog" variable when the dialog is ready to receive
1004 * messages.
1005 *
1006 * Results:
1007 * Returns 0 to allow default processing of messages to occur.
1008 *
1009 * Side effects:
1010 * None.
1011 *
1012 *-------------------------------------------------------------------------
1013 */
1014
1015 static UINT APIENTRY
1016 OFNHookProc(
1017 HWND hdlg, // handle to child dialog window
1018 UINT uMsg, // message identifier
1019 WPARAM wParam, // message parameter
1020 LPARAM lParam) // message parameter
1021 {
1022 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1023 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1024 OPENFILENAME *ofnPtr;
1025
1026 if (uMsg == WM_INITDIALOG) {
1027 SetWindowLong(hdlg, GWL_USERDATA, lParam);
1028 } else if (uMsg == WM_WINDOWPOSCHANGED) {
1029 /*
1030 * This message is delivered at the right time to both
1031 * old-style and explorer-style hook procs to enable Tk
1032 * to set the debug information. Unhooks itself so it
1033 * won't set the debug information every time it gets a
1034 * WM_WINDOWPOSCHANGED message.
1035 */
1036
1037 ofnPtr = (OPENFILENAME *) GetWindowLong(hdlg, GWL_USERDATA);
1038 if (ofnPtr != NULL) {
1039 if (ofnPtr->Flags & OFN_EXPLORER) {
1040 hdlg = GetParent(hdlg);
1041 }
1042 tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;
1043 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
1044 SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
1045 }
1046 }
1047 return 0;
1048 }
1049
1050 /*
1051 *----------------------------------------------------------------------
1052 *
1053 * MakeFilter --
1054 *
1055 * Allocate a buffer to store the filters in a format understood by
1056 * Windows
1057 *
1058 * Results:
1059 * A standard TCL return value.
1060 *
1061 * Side effects:
1062 * ofnPtr->lpstrFilter is modified.
1063 *
1064 *----------------------------------------------------------------------
1065 */
1066 static int
1067 MakeFilter(interp, string, dsPtr)
1068 Tcl_Interp *interp; /* Current interpreter. */
1069 char *string; /* String value of the -filetypes option */
1070 Tcl_DString *dsPtr; /* Filled with windows filter string. */
1071 {
1072 char *filterStr;
1073 char *p;
1074 int pass;
1075 FileFilterList flist;
1076 FileFilter *filterPtr;
1077
1078 TkInitFileFilters(&flist);
1079 if (TkGetFileFilters(interp, &flist, string, 1) != TCL_OK) {
1080 return TCL_ERROR;
1081 }
1082
1083 if (flist.filters == NULL) {
1084 /*
1085 * Use "All Files (*.*) as the default filter if none is specified
1086 */
1087 char *defaultFilter = "All Files (*.*)";
1088
1089 p = filterStr = (char*)ckalloc(30 * sizeof(char));
1090
1091 strcpy(p, defaultFilter);
1092 p+= strlen(defaultFilter);
1093
1094 *p++ = '\0';
1095 *p++ = '*';
1096 *p++ = '.';
1097 *p++ = '*';
1098 *p++ = '\0';
1099 *p++ = '\0';
1100 *p = '\0';
1101
1102 } else {
1103 /* We format the filetype into a string understood by Windows:
1104 * {"Text Documents" {.doc .txt} {TEXT}} becomes
1105 * "Text Documents (*.doc,*.txt)\0*.doc;*.txt\0"
1106 *
1107 * See the Windows OPENFILENAME manual page for details on the filter
1108 * string format.
1109 */
1110
1111 /*
1112 * Since we may only add asterisks (*) to the filter, we need at most
1113 * twice the size of the string to format the filter
1114 */
1115 filterStr = ckalloc(strlen(string) * 3);
1116
1117 for (filterPtr = flist.filters, p = filterStr; filterPtr;
1118 filterPtr = filterPtr->next) {
1119 char *sep;
1120 FileFilterClause *clausePtr;
1121
1122 /*
1123 * First, put in the name of the file type
1124 */
1125 strcpy(p, filterPtr->name);
1126 p+= strlen(filterPtr->name);
1127 *p++ = ' ';
1128 *p++ = '(';
1129
1130 for (pass = 1; pass <= 2; pass++) {
1131 /*
1132 * In the first pass, we format the extensions in the
1133 * name field. In the second pass, we format the extensions in
1134 * the filter pattern field
1135 */
1136 sep = "";
1137 for (clausePtr=filterPtr->clauses;clausePtr;
1138 clausePtr=clausePtr->next) {
1139 GlobPattern *globPtr;
1140
1141
1142 for (globPtr=clausePtr->patterns; globPtr;
1143 globPtr=globPtr->next) {
1144 strcpy(p, sep);
1145 p+= strlen(sep);
1146 strcpy(p, globPtr->pattern);
1147 p+= strlen(globPtr->pattern);
1148
1149 if (pass==1) {
1150 sep = ",";
1151 } else {
1152 sep = ";";
1153 }
1154 }
1155 }
1156 if (pass == 1) {
1157 if (pass == 1) {
1158 *p ++ = ')';
1159 }
1160 }
1161 *p ++ = '\0';
1162 }
1163 }
1164
1165 /*
1166 * Windows requires the filter string to be ended by two NULL
1167 * characters.
1168 */
1169 *p++ = '\0';
1170 *p = '\0';
1171 }
1172
1173 Tcl_DStringAppend(dsPtr, filterStr, p - filterStr);
1174 ckfree((char *) filterStr);
1175
1176 TkFreeFileFilters(&flist);
1177 return TCL_OK;
1178 }
1179
1180 /*
1181 *----------------------------------------------------------------------
1182 *
1183 * Tk_ChooseDirectoryObjCmd --
1184 *
1185 * This procedure implements the "tk_chooseDirectory" dialog box
1186 * for the Windows platform. See the user documentation for details
1187 * on what it does.
1188 *
1189 * Results:
1190 * See user documentation.
1191 *
1192 * Side effects:
1193 * A modal dialog window is created. Tcl_SetServiceMode() is
1194 * called to allow background events to be processed
1195 *
1196 *----------------------------------------------------------------------
1197 */
1198
1199 int
1200 Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
1201 ClientData clientData; /* Main window associated with interpreter. */
1202 Tcl_Interp *interp; /* Current interpreter. */
1203 int objc; /* Number of arguments. */
1204 Tcl_Obj *CONST objv[]; /* Argument objects. */
1205 {
1206 OPENFILENAME ofn;
1207 TCHAR path[MAX_PATH], savePath[MAX_PATH];
1208 ChooseDir cd;
1209 int result, mustExist, code, mode, i;
1210 Tk_Window tkwin;
1211 HWND hWnd;
1212 char *utfTitle;
1213 Tcl_DString utfDirString;
1214 Tcl_DString titleString, dirString;
1215 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1216 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1217 static char *optionStrings[] = {
1218 "-initialdir", "-mustexist", "-parent", "-title",
1219 NULL
1220 };
1221 enum options {
1222 DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
1223 };
1224
1225 if (tsdPtr->WM_LBSELCHANGED == 0) {
1226 tsdPtr->WM_LBSELCHANGED = RegisterWindowMessage(LBSELCHSTRING);
1227 }
1228
1229 result = TCL_ERROR;
1230 path[0] = '\0';
1231
1232 Tcl_DStringInit(&utfDirString);
1233 mustExist = 0;
1234 tkwin = (Tk_Window) clientData;
1235 utfTitle = NULL;
1236
1237 for (i = 1; i < objc; i += 2) {
1238 int index;
1239 char *string;
1240 Tcl_Obj *optionPtr, *valuePtr;
1241
1242 optionPtr = objv[i];
1243 valuePtr = objv[i + 1];
1244
1245 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
1246 0, &index) != TCL_OK) {
1247 goto cleanup;
1248 }
1249 if (i + 1 == objc) {
1250 string = Tcl_GetStringFromObj(optionPtr, NULL);
1251 Tcl_AppendResult(interp, "value for \"", string, "\" missing",
1252 (char *) NULL);
1253 goto cleanup;
1254 }
1255
1256 string = Tcl_GetStringFromObj(valuePtr, NULL);
1257 switch ((enum options) index) {
1258 case DIR_INITIAL: {
1259 Tcl_DStringFree(&utfDirString);
1260 if (Tcl_TranslateFileName(interp, string,
1261 &utfDirString) == NULL) {
1262 goto cleanup;
1263 }
1264 break;
1265 }
1266 case DIR_EXIST: {
1267 if (Tcl_GetBooleanFromObj(interp, valuePtr, &mustExist) != TCL_OK) {
1268 goto cleanup;
1269 }
1270 break;
1271 }
1272 case DIR_PARENT: {
1273 tkwin = Tk_NameToWindow(interp, string, tkwin);
1274 if (tkwin == NULL) {
1275 goto cleanup;
1276 }
1277 break;
1278 }
1279 case FILE_TITLE: {
1280 utfTitle = string;
1281 break;
1282 }
1283 }
1284 }
1285
1286 Tk_MakeWindowExist(tkwin);
1287 hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
1288
1289 cd.interp = interp;
1290
1291 ofn.lStructSize = sizeof(ofn);
1292 ofn.hwndOwner = hWnd;
1293 ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
1294 GWL_HINSTANCE);
1295 ofn.lpstrFilter = NULL;
1296 ofn.lpstrCustomFilter = NULL;
1297 ofn.nMaxCustFilter = 0;
1298 ofn.nFilterIndex = 0;
1299 ofn.lpstrFile = NULL; //(TCHAR *) path;
1300 ofn.nMaxFile = MAX_PATH;
1301 ofn.lpstrFileTitle = NULL;
1302 ofn.nMaxFileTitle = 0;
1303 ofn.lpstrInitialDir = NULL;
1304 ofn.lpstrTitle = NULL;
1305 ofn.Flags = OFN_HIDEREADONLY
1306 | OFN_ENABLEHOOK | OFN_ENABLETEMPLATE;
1307 ofn.nFileOffset = 0;
1308 ofn.nFileExtension = 0;
1309 ofn.lpstrDefExt = NULL;
1310 ofn.lCustData = (LPARAM) &cd;
1311 ofn.lpfnHook = ChooseDirectoryHookProc;
1312 ofn.lpTemplateName = MAKEINTRESOURCE(FILEOPENORD);
1313
1314 if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
1315 Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
1316 Tcl_DStringLength(&utfDirString), &dirString);
1317 ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
1318 }
1319 if (mustExist) {
1320 ofn.Flags |= OFN_PATHMUSTEXIST;
1321 }
1322 if (utfTitle != NULL) {
1323 Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
1324 ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
1325 }
1326
1327 /*
1328 * Display dialog. The choose directory dialog doesn't preserve the
1329 * current directory, so it must be saved and restored here.
1330 */
1331
1332 GetCurrentDirectory(MAX_PATH, savePath);
1333 mode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
1334 code = GetOpenFileName(&ofn);
1335 Tcl_SetServiceMode(mode);
1336 SetCurrentDirectory(savePath);
1337
1338 /*
1339 * Ensure that hWnd is enabled, because it can happen that we
1340 * have updated the wrapper of the parent, which causes us to
1341 * leave this child disabled (Windows loses sync).
1342 */
1343 EnableWindow(hWnd, 1);
1344
1345 Tcl_ResetResult(interp);
1346 if (code != 0) {
1347 /*
1348 * Change the pathname to the Tcl "normalized" pathname, where
1349 * back slashes are used instead of forward slashes
1350 */
1351
1352 char *p;
1353 Tcl_DString ds;
1354
1355 Tcl_ExternalToUtfDString(NULL, (char *) cd.path, -1, &ds);
1356 for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
1357 if (*p == '\\') {
1358 *p = '/';
1359 }
1360 }
1361 Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
1362 Tcl_DStringFree(&ds);
1363 }
1364
1365 if (ofn.lpstrTitle != NULL) {
1366 Tcl_DStringFree(&titleString);
1367 }
1368 if (ofn.lpstrInitialDir != NULL) {
1369 Tcl_DStringFree(&dirString);
1370 }
1371 result = TCL_OK;
1372
1373 cleanup:
1374 Tcl_DStringFree(&utfDirString);
1375
1376 return result;
1377 }
1378
1379 /*
1380 *----------------------------------------------------------------------
1381 *
1382 * ChooseDirectoryHookProc --
1383 *
1384 * Hook procedure called by the ChooseDirectory dialog to modify
1385 * its default behavior. The ChooseDirectory dialog is really an
1386 * OpenFile dialog with certain controls rearranged and certain
1387 * behaviors changed. For instance, typing a name in the
1388 * ChooseDirectory dialog selects a directory, rather than
1389 * selecting a file.
1390 *
1391 * Results:
1392 * Returns 0 to allow default processing of message, or 1 to
1393 * tell default dialog procedure not to process the message.
1394 *
1395 * Side effects:
1396 * A dialog window is created the first this procedure is called.
1397 * This window is not destroyed and will be reused the next time
1398 * the application invokes the "tk_getOpenFile" or
1399 * "tk_getSaveFile" command.
1400 *
1401 *----------------------------------------------------------------------
1402 */
1403
1404 static UINT APIENTRY
1405 ChooseDirectoryHookProc(
1406 HWND hwnd,
1407 UINT message,
1408 WPARAM wParam,
1409 LPARAM lParam)
1410 {
1411 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1412 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1413 OPENFILENAME *ofnPtr;
1414
1415 /*
1416 * GWL_USERDATA keeps track of ofnPtr.
1417 */
1418
1419 ofnPtr = (OPENFILENAME *) GetWindowLong(hwnd, GWL_USERDATA);
1420
1421 if (message == WM_INITDIALOG) {
1422 ChooseDir *cdPtr;
1423
1424 SetWindowLong(hwnd, GWL_USERDATA, lParam);
1425 ofnPtr = (OPENFILENAME *) lParam;
1426 cdPtr = (ChooseDir *) ofnPtr->lCustData;
1427 cdPtr->lastCtrl = 0;
1428 cdPtr->lastIdx = 1000;
1429 cdPtr->path[0] = '\0';
1430
1431 if (ofnPtr->lpstrInitialDir == NULL) {
1432 GetCurrentDirectory(MAX_PATH, cdPtr->path);
1433 } else {
1434 lstrcpy(cdPtr->path, ofnPtr->lpstrInitialDir);
1435 }
1436 SetDlgItemText(hwnd, edt10, cdPtr->path);
1437 SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
1438 if (tsdPtr->debugFlag) {
1439 tsdPtr->debugInterp = cdPtr->interp;
1440 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
1441 }
1442 return 0;
1443 }
1444 if (ofnPtr == NULL) {
1445 return 0;
1446 }
1447
1448 if (message == tsdPtr->WM_LBSELCHANGED) {
1449 /*
1450 * Called when double-clicking on directory.
1451 * If directory wasn't already open, browse that directory.
1452 * If directory was already open, return selected directory.
1453 */
1454
1455 ChooseDir *cdPtr;
1456 int idCtrl, thisItem;
1457
1458 idCtrl = (int) wParam;
1459 thisItem = LOWORD(lParam);
1460 cdPtr = (ChooseDir *) ofnPtr->lCustData;
1461
1462 GetCurrentDirectory(MAX_PATH, cdPtr->path);
1463 if (idCtrl == lst2) {
1464 if (cdPtr->lastIdx == thisItem) {
1465 EndDialog(hwnd, IDOK);
1466 return 1;
1467 }
1468 cdPtr->lastIdx = thisItem;
1469 }
1470 SetDlgItemText(hwnd, edt10, cdPtr->path);
1471 SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
1472 } else if (message == WM_COMMAND) {
1473 ChooseDir *cdPtr;
1474 int idCtrl, notifyCode;
1475
1476 idCtrl = LOWORD(wParam);
1477 notifyCode = HIWORD(wParam);
1478 cdPtr = (ChooseDir *) ofnPtr->lCustData;
1479
1480 if ((idCtrl != IDOK) || (notifyCode != BN_CLICKED)) {
1481 /*
1482 * OK Button wasn't clicked. Do the default.
1483 */
1484
1485 if ((idCtrl == lst2) || (idCtrl == edt10)) {
1486 cdPtr->lastCtrl = idCtrl;
1487 }
1488 return 0;
1489 }
1490
1491 /*
1492 * Dialogs also get the message that OK was clicked when Enter
1493 * is pressed in some other control. Find out what window
1494 * we were really in when we got the supposed "OK", because the
1495 * behavior is different.
1496 */
1497
1498 if (cdPtr->lastCtrl == edt10) {
1499 /*
1500 * Hit Enter or clicked OK while typing a directory name in the
1501 * edit control.
1502 * If it's a new name, try to go to that directory.
1503 * If the name hasn't changed since last time, return selected
1504 * directory.
1505 */
1506
1507 int changed;
1508 TCHAR tmp[MAX_PATH];
1509
1510 if (GetDlgItemText(hwnd, edt10, tmp, MAX_PATH) == 0) {
1511 return 0;
1512 }
1513
1514 changed = lstrcmp(cdPtr->path, tmp);
1515 lstrcpy(cdPtr->path, tmp);
1516
1517 if (SetCurrentDirectory(cdPtr->path) == 0) {
1518 /*
1519 * Non-existent directory.
1520 */
1521
1522 if (ofnPtr->Flags & OFN_PATHMUSTEXIST) {
1523 /*
1524 * Directory must exist. Complain, then rehighlight text.
1525 */
1526
1527 wsprintf(tmp, _T("Cannot change directory to \"%.200s\"."),
1528 cdPtr->path);
1529 MessageBox(hwnd, tmp, NULL, MB_OK);
1530 SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
1531 return 0;
1532 }
1533 if (changed) {
1534 /*
1535 * Directory was invalid, but we want to keep displaying
1536 * this name. Don't update the listbox that displays the
1537 * current directory heirarchy, or it'll erase the name.
1538 */
1539
1540 SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
1541 return 0;
1542 }
1543 }
1544 if (changed == 0) {
1545 /*
1546 * Name hasn't changed since the last time we hit return
1547 * or double-clicked on a directory, so return this.
1548 */
1549
1550 EndDialog(hwnd, IDOK);
1551 return 1;
1552 }
1553
1554 cdPtr->lastCtrl = IDOK;
1555
1556 /*
1557 * The following is the magic code, determined by running
1558 * Spy++ on some other directory chooser, that it takes to
1559 * get this dialog to update the listbox to display the
1560 * current directory.
1561 */
1562
1563 SetDlgItemText(hwnd, edt1, cdPtr->path);
1564 SendMessage(hwnd, WM_COMMAND, (WPARAM) MAKELONG(cmb2, 0x8003),
1565 (LPARAM) GetDlgItem(hwnd, cmb2));
1566 return 0;
1567 } else if (idCtrl == lst2) {
1568 /*
1569 * Enter key was pressed while in listbox.
1570 * If it's a new directory, allow default behavior to open dir.
1571 * If the directory hasn't changed, return selected directory.
1572 */
1573
1574 int thisItem;
1575
1576 thisItem = (int) SendDlgItemMessage(hwnd, lst2, LB_GETCURSEL, 0, 0);
1577 if (cdPtr->lastIdx == thisItem) {
1578 GetCurrentDirectory(MAX_PATH, cdPtr->path);
1579 EndDialog(hwnd, IDOK);
1580 return 1;
1581 }
1582 } else if (idCtrl == IDOK) {
1583 /*
1584 * The OK button was clicked. Return the value currently selected
1585 * in the entry.
1586 */
1587
1588 GetCurrentDirectory(MAX_PATH, cdPtr->path);
1589 EndDialog(hwnd, IDOK);
1590 return 1;
1591 }
1592 }
1593 return 0;
1594 }
1595
1596 /*
1597 *----------------------------------------------------------------------
1598 *
1599 * Tk_MessageBoxObjCmd --
1600 *
1601 * This procedure implements the MessageBox window for the
1602 * Windows platform. See the user documentation for details on what
1603 * it does.
1604 *
1605 * Results:
1606 * See user documentation.
1607 *
1608 * Side effects:
1609 * None. The MessageBox window will be destroy before this procedure
1610 * returns.
1611 *
1612 *----------------------------------------------------------------------
1613 */
1614
1615 int
1616 Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
1617 ClientData clientData; /* Main window associated with interpreter. */
1618 Tcl_Interp *interp; /* Current interpreter. */
1619 int objc; /* Number of arguments. */
1620 Tcl_Obj *CONST objv[]; /* Argument objects. */
1621 {
1622 Tk_Window tkwin, parent;
1623 HWND hWnd;
1624 char *message, *title;
1625 int defaultBtn, icon, type;
1626 int i, oldMode, flags, winCode;
1627 Tcl_DString messageString, titleString;
1628 static char *optionStrings[] = {
1629 "-default", "-icon", "-message", "-parent",
1630 "-title", "-type", NULL
1631 };
1632 enum options {
1633 MSG_DEFAULT, MSG_ICON, MSG_MESSAGE, MSG_PARENT,
1634 MSG_TITLE, MSG_TYPE
1635 };
1636
1637 tkwin = (Tk_Window) clientData;
1638
1639 defaultBtn = -1;
1640 icon = MB_ICONINFORMATION;
1641 message = NULL;
1642 parent = tkwin;
1643 title = NULL;
1644 type = MB_OK;
1645
1646 for (i = 1; i < objc; i += 2) {
1647 int index;
1648 char *string;
1649 Tcl_Obj *optionPtr, *valuePtr;
1650
1651 optionPtr = objv[i];
1652 valuePtr = objv[i + 1];
1653
1654 if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
1655 TCL_EXACT, &index) != TCL_OK) {
1656 return TCL_ERROR;
1657 }
1658 if (i + 1 == objc) {
1659 string = Tcl_GetStringFromObj(optionPtr, NULL);
1660 Tcl_AppendResult(interp, "value for \"", string, "\" missing",
1661 (char *) NULL);
1662 return TCL_ERROR;
1663 }
1664
1665 string = Tcl_GetStringFromObj(valuePtr, NULL);
1666 switch ((enum options) index) {
1667 case MSG_DEFAULT:
1668 defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap,
1669 valuePtr);
1670 if (defaultBtn < 0) {
1671 return TCL_ERROR;
1672 }
1673 break;
1674
1675 case MSG_ICON:
1676 icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr);
1677 if (icon < 0) {
1678 return TCL_ERROR;
1679 }
1680 break;
1681
1682 case MSG_MESSAGE:
1683 message = string;
1684 break;
1685
1686 case MSG_PARENT:
1687 parent = Tk_NameToWindow(interp, string, tkwin);
1688 if (parent == NULL) {
1689 return TCL_ERROR;
1690 }
1691 break;
1692
1693 case MSG_TITLE:
1694 title = string;
1695 break;
1696
1697 case MSG_TYPE:
1698 type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr);
1699 if (type < 0) {
1700 return TCL_ERROR;
1701 }
1702 break;
1703
1704 }
1705 }
1706
1707 Tk_MakeWindowExist(parent);
1708 hWnd = Tk_GetHWND(Tk_WindowId(parent));
1709
1710 flags = 0;
1711 if (defaultBtn >= 0) {
1712 int defaultBtnIdx;
1713
1714 defaultBtnIdx = -1;
1715 for (i = 0; i < NUM_TYPES; i++) {
1716 if (type == allowedTypes[i].type) {
1717 int j;
1718
1719 for (j = 0; j < 3; j++) {
1720 if (allowedTypes[i].btnIds[j] == defaultBtn) {
1721 defaultBtnIdx = j;
1722 break;
1723 }
1724 }
1725 if (defaultBtnIdx < 0) {
1726 Tcl_AppendResult(interp, "invalid default button \"",
1727 TkFindStateString(buttonMap, defaultBtn),
1728 "\"", NULL);
1729 return TCL_ERROR;
1730 }
1731 break;
1732 }
1733 }
1734 flags = buttonFlagMap[defaultBtnIdx];
1735 }
1736
1737 flags |= icon | type | MB_SYSTEMMODAL;
1738
1739 Tcl_UtfToExternalDString(NULL, message, -1, &messageString);
1740 Tcl_UtfToExternalDString(NULL, title, -1, &titleString);
1741
1742 oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
1743 winCode = MessageBox(hWnd, Tcl_DStringValue(&messageString),
1744 Tcl_DStringValue(&titleString), flags);
1745 (void) Tcl_SetServiceMode(oldMode);
1746
1747 /*
1748 * Ensure that hWnd is enabled, because it can happen that we
1749 * have updated the wrapper of the parent, which causes us to
1750 * leave this child disabled (Windows loses sync).
1751 */
1752 EnableWindow(hWnd, 1);
1753
1754 Tcl_DStringFree(&messageString);
1755 Tcl_DStringFree(&titleString);
1756
1757 Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);
1758 return TCL_OK;
1759 }
1760
1761 static void
1762 SetTkDialog(ClientData clientData)
1763 {
1764 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1765 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1766 char buf[32];
1767 HWND hwnd;
1768
1769 hwnd = (HWND) clientData;
1770
1771 sprintf(buf, "0x%08x", hwnd);
1772 Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
1773 }
1774
1775
1776 /* $History: tkWinDialog.c $
1777 *
1778 * ***************** Version 1 *****************
1779 * User: Dtashley Date: 1/02/01 Time: 3:17a
1780 * Created in $/IjuScripter, IjuConsole/Source/Tk Base
1781 * Initial check-in.
1782 */
1783
1784 /* End of TKWINDIALOG.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25