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

Annotation of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkwindialog.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (hide annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (8 years ago) by dashley
File MIME type: text/plain
File size: 49197 byte(s)
Rename for reorganization.
1 dashley 25 /* $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