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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25