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

Diff of /projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkwindialog.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

to_be_filed/sf_code/esrgpcpj/shared/tk_base/tkwindialog.c revision 29 by dashley, Sat Oct 8 07:08:47 2016 UTC projs/dtats/trunk/shared_source/c_tk_base_7_5_w_mods/tkwindialog.c revision 98 by dashley, Sun Dec 18 00:57:31 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkwindialog.c,v 1.1.1.1 2001/06/13 05:12:25 dtashley Exp $ */  
   
   
 /*  
  * tkWinDialog.c --  
  *  
  *      Contains the Windows implementation of the common dialog boxes.  
  *  
  * Copyright (c) 1996-1997 Sun Microsystems, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tkwindialog.c,v 1.1.1.1 2001/06/13 05:12:25 dtashley Exp $  
  *  
  */  
   
 #include "tkWinInt.h"  
 #include "tkFileFilter.h"  
   
 #include <commdlg.h>    /* includes common dialog functionality */  
 #include <dlgs.h>       /* includes common dialog template defines */  
 #include <cderr.h>      /* includes the common dialog error codes */  
   
 typedef struct ThreadSpecificData {  
     int debugFlag;            /* Flags whether we should output debugging  
                                * information while displaying a builtin  
                                * dialog. */  
     Tcl_Interp *debugInterp;  /* Interpreter to used for debugging. */  
     UINT WM_LBSELCHANGED;     /* Holds a registered windows event used for  
                                * communicating between the Directory  
                                * Chooser dialog and its hook proc. */  
 } ThreadSpecificData;  
 static Tcl_ThreadDataKey dataKey;  
   
 /*  
  * The following structures are used by Tk_MessageBoxCmd() to parse  
  * arguments and return results.  
  */  
   
 static const TkStateMap iconMap[] = {  
     {MB_ICONERROR,              "error"},  
     {MB_ICONINFORMATION,        "info"},  
     {MB_ICONQUESTION,           "question"},  
     {MB_ICONWARNING,            "warning"},  
     {-1,                        NULL}  
 };  
             
 static const TkStateMap typeMap[] = {  
     {MB_ABORTRETRYIGNORE,       "abortretryignore"},  
     {MB_OK,                     "ok"},  
     {MB_OKCANCEL,               "okcancel"},  
     {MB_RETRYCANCEL,            "retrycancel"},  
     {MB_YESNO,                  "yesno"},  
     {MB_YESNOCANCEL,            "yesnocancel"},  
     {-1,                        NULL}  
 };  
   
 static const TkStateMap buttonMap[] = {  
     {IDABORT,                   "abort"},  
     {IDRETRY,                   "retry"},  
     {IDIGNORE,                  "ignore"},  
     {IDOK,                      "ok"},  
     {IDCANCEL,                  "cancel"},  
     {IDNO,                      "no"},  
     {IDYES,                     "yes"},  
     {-1,                        NULL}  
 };  
   
 static const int buttonFlagMap[] = {  
     MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4  
 };  
   
 static const struct {int type; int btnIds[3];} allowedTypes[] = {  
     {MB_ABORTRETRYIGNORE,       {IDABORT, IDRETRY,  IDIGNORE}},  
     {MB_OK,                     {IDOK,    -1,       -1      }},  
     {MB_OKCANCEL,               {IDOK,    IDCANCEL, -1      }},  
     {MB_RETRYCANCEL,            {IDRETRY, IDCANCEL, -1      }},  
     {MB_YESNO,                  {IDYES,   IDNO,     -1      }},  
     {MB_YESNOCANCEL,            {IDYES,   IDNO,     IDCANCEL}}  
 };  
   
 #define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0]))  
   
 /*  
  * The following structure is used to pass information between the directory  
  * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.  
  */  
   
 typedef struct ChooseDir {  
     Tcl_Interp *interp;         /* Interp, used only if debug is turned on,  
                                  * for setting the "tk_dialog" variable. */  
     int lastCtrl;               /* Used by hook proc to keep track of last  
                                  * control that had input focus, so when OK  
                                  * is pressed we know whether to browse a  
                                  * new directory or return. */  
     int lastIdx;                /* Last item that was selected in directory  
                                  * browser listbox. */  
     TCHAR path[MAX_PATH];       /* On return from choose directory dialog,  
                                  * holds the selected path.  Cannot return  
                                  * selected path in ofnPtr->lpstrFile because  
                                  * the default dialog proc stores a '\0' in  
                                  * it, since, of course, no _file_ was  
                                  * selected. */  
 } ChooseDir;  
   
 /*  
  * Definitions of procedures used only in this file.  
  */  
   
 static UINT APIENTRY    ChooseDirectoryHookProc(HWND hdlg, UINT uMsg,  
                             WPARAM wParam, LPARAM lParam);  
 static UINT CALLBACK    ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,  
                             LPARAM lParam);  
 static int              GetFileNameA(ClientData clientData,  
                             Tcl_Interp *interp, int objc,  
                             Tcl_Obj *CONST objv[], int isOpen);  
 static int              GetFileNameW(ClientData clientData,  
                             Tcl_Interp *interp, int objc,  
                             Tcl_Obj *CONST objv[], int isOpen);  
 static int              MakeFilter(Tcl_Interp *interp, char *string,  
                             Tcl_DString *dsPtr);  
 static UINT APIENTRY    OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,  
                             LPARAM lParam);  
 static UINT APIENTRY    OFNHookProcW(HWND hdlg, UINT uMsg, WPARAM wParam,  
                             LPARAM lParam);  
 static void             SetTkDialog(ClientData clientData);  
 static int              TrySetDirectory(HWND hwnd, const TCHAR *dir);  
   
 /*  
  *-------------------------------------------------------------------------  
  *  
  * TkWinDialogDebug --  
  *  
  *      Function to turn on/off debugging support for common dialogs under  
  *      windows.  The variable "tk_debug" is set to the identifier of the  
  *      dialog window when the modal dialog window pops up and it is safe to  
  *      send messages to the dialog.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      This variable only makes sense if just one dialog is up at a time.  
  *  
  *-------------------------------------------------------------------------  
  */  
   
 void              
 TkWinDialogDebug(  
     int debug)  
 {  
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)  
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));  
   
     tsdPtr->debugFlag = debug;  
 }  
   
 /*  
  *-------------------------------------------------------------------------  
  *  
  * Tk_ChooseColorObjCmd --  
  *  
  *      This procedure implements the color dialog box for the Windows  
  *      platform. See the user documentation for details on what it  
  *      does.  
  *  
  * Results:  
  *      See user documentation.  
  *  
  * Side effects:  
  *      A dialog window is created the first time this procedure is called.  
  *      This window is not destroyed and will be reused the next time the  
  *      application invokes the "tk_chooseColor" command.  
  *  
  *-------------------------------------------------------------------------  
  */  
   
 int  
 Tk_ChooseColorObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     Tk_Window tkwin, parent;  
     HWND hWnd;  
     int i, oldMode, winCode;  
     CHOOSECOLOR chooseColor;  
     static inited = 0;  
     static COLORREF dwCustColors[16];  
     static long oldColor;               /* the color selected last time */  
     static char *optionStrings[] = {  
         "-initialcolor",    "-parent",      "-title",       NULL  
     };  
     enum options {  
         COLOR_INITIAL,      COLOR_PARENT,   COLOR_TITLE  
     };  
   
     if (inited == 0) {  
         /*  
          * dwCustColors stores the custom color which the user can  
          * modify. We store these colors in a static array so that the next  
          * time the color dialog pops up, the same set of custom colors  
          * remain in the dialog.  
          */  
         for (i = 0; i < 16; i++) {  
             dwCustColors[i] = RGB(255-i * 10, i, i * 10);  
         }  
         oldColor = RGB(0xa0, 0xa0, 0xa0);  
         inited = 1;  
     }  
   
     tkwin = (Tk_Window) clientData;  
   
     parent                      = tkwin;  
     chooseColor.lStructSize     = sizeof(CHOOSECOLOR);  
     chooseColor.hwndOwner       = NULL;                  
     chooseColor.hInstance       = NULL;  
     chooseColor.rgbResult       = oldColor;  
     chooseColor.lpCustColors    = dwCustColors;  
     chooseColor.Flags           = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;  
     chooseColor.lCustData       = (LPARAM) NULL;  
     chooseColor.lpfnHook        = ColorDlgHookProc;  
     chooseColor.lpTemplateName  = (LPTSTR) interp;  
   
     for (i = 1; i < objc; i += 2) {  
         int index;  
         char *string;  
         Tcl_Obj *optionPtr, *valuePtr;  
   
         optionPtr = objv[i];  
         valuePtr = objv[i + 1];  
   
         if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",  
                 TCL_EXACT, &index) != TCL_OK) {  
             return TCL_ERROR;  
         }  
         if (i + 1 == objc) {  
             string = Tcl_GetStringFromObj(optionPtr, NULL);  
             Tcl_AppendResult(interp, "value for \"", string, "\" missing",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
   
         string = Tcl_GetStringFromObj(valuePtr, NULL);  
         switch ((enum options) index) {  
             case COLOR_INITIAL: {  
                 XColor *colorPtr;  
   
                 colorPtr = Tk_GetColor(interp, tkwin, string);  
                 if (colorPtr == NULL) {  
                     return TCL_ERROR;  
                 }  
                 chooseColor.rgbResult = RGB(colorPtr->red / 0x100,  
                         colorPtr->green / 0x100, colorPtr->blue / 0x100);  
                 break;  
             }  
             case COLOR_PARENT: {  
                 parent = Tk_NameToWindow(interp, string, tkwin);  
                 if (parent == NULL) {  
                     return TCL_ERROR;  
                 }  
                 break;  
             }  
             case COLOR_TITLE: {  
                 chooseColor.lCustData = (LPARAM) string;  
                 break;  
             }  
         }  
     }  
   
     Tk_MakeWindowExist(parent);  
     chooseColor.hwndOwner = NULL;  
     hWnd = Tk_GetHWND(Tk_WindowId(parent));  
     chooseColor.hwndOwner = hWnd;  
       
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);  
     winCode = ChooseColor(&chooseColor);  
     (void) Tcl_SetServiceMode(oldMode);  
   
     /*  
      * Ensure that hWnd is enabled, because it can happen that we  
      * have updated the wrapper of the parent, which causes us to  
      * leave this child disabled (Windows loses sync).  
      */  
     EnableWindow(hWnd, 1);  
   
     /*  
      * Clear the interp result since anything may have happened during the  
      * modal loop.  
      */  
   
     Tcl_ResetResult(interp);  
   
     /*  
      * 3. Process the result of the dialog  
      */  
   
     if (winCode) {  
         /*  
          * User has selected a color  
          */  
         char result[100];  
   
         sprintf(result, "#%02x%02x%02x",  
         GetRValue(chooseColor.rgbResult),  
                 GetGValue(chooseColor.rgbResult),  
                 GetBValue(chooseColor.rgbResult));  
         Tcl_AppendResult(interp, result, NULL);  
         oldColor = chooseColor.rgbResult;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *-------------------------------------------------------------------------  
  *  
  * ColorDlgHookProc --  
  *  
  *      Provides special handling of messages for the Color common dialog  
  *      box.  Used to set the title when the dialog first appears.  
  *  
  * Results:  
  *      The return value is 0 if the default dialog box procedure should  
  *      handle the message, non-zero otherwise.  
  *  
  * Side effects:  
  *      Changes the title of the dialog window.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static UINT CALLBACK  
 ColorDlgHookProc(hDlg, uMsg, wParam, lParam)  
     HWND hDlg;                  /* Handle to the color dialog. */  
     UINT uMsg;                  /* Type of message. */  
     WPARAM wParam;              /* First message parameter. */  
     LPARAM lParam;              /* Second message parameter. */  
 {  
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)  
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));  
   
     switch (uMsg) {  
         case WM_INITDIALOG: {  
             const char *title;  
             CHOOSECOLOR *ccPtr;  
             Tcl_DString ds;  
   
             /*  
              * Set the title string of the dialog.  
              */  
   
             ccPtr = (CHOOSECOLOR *) lParam;  
             title = (const char *) ccPtr->lCustData;  
             if ((title != NULL) && (title[0] != '\0')) {  
                 Tcl_UtfToExternalDString(NULL, title, -1, &ds);  
                 SetWindowText(hDlg, (TCHAR *) Tcl_DStringValue(&ds));  
                 Tcl_DStringFree(&ds);  
             }  
             if (tsdPtr->debugFlag) {  
                 tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;  
                 Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);  
             }  
             return TRUE;  
         }  
     }  
     return FALSE;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_GetOpenFileCmd --  
  *  
  *      This procedure implements the "open file" dialog box for the  
  *      Windows platform. See the user documentation for details on what  
  *      it does.  
  *  
  * Results:  
  *      See user documentation.  
  *  
  * Side effects:  
  *      A dialog window is created the first this procedure is called.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_GetOpenFileObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {  
         return GetFileNameW(clientData, interp, objc, objv, 1);  
     } else {  
         return GetFileNameA(clientData, interp, objc, objv, 1);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_GetSaveFileCmd --  
  *  
  *      Same as Tk_GetOpenFileCmd but opens a "save file" dialog box  
  *      instead  
  *  
  * Results:  
  *      Same as Tk_GetOpenFileCmd.  
  *  
  * Side effects:  
  *      Same as Tk_GetOpenFileCmd.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_GetSaveFileObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {  
         return GetFileNameW(clientData, interp, objc, objv, 0);  
     } else {  
         return GetFileNameA(clientData, interp, objc, objv, 0);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * GetFileNameW --  
  *  
  *      Calls GetOpenFileName() or GetSaveFileName().  
  *  
  * Results:  
  *      See user documentation.  
  *  
  * Side effects:  
  *      See user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 GetFileNameW(clientData, interp, objc, objv, open)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
     int open;                   /* 1 to call GetOpenFileName(), 0 to  
                                  * call GetSaveFileName(). */  
 {  
     Tcl_Encoding unicodeEncoding = Tcl_GetEncoding(NULL, "unicode");  
     OPENFILENAMEW ofn;  
     WCHAR file[MAX_PATH];  
     int result, winCode, oldMode, i;  
     char *extension, *filter, *title;  
     Tk_Window tkwin;  
     HWND hWnd;  
     Tcl_DString utfFilterString, utfDirString;  
     Tcl_DString extString, filterString, dirString, titleString;  
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)  
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));  
     static char *optionStrings[] = {  
         "-defaultextension", "-filetypes", "-initialdir", "-initialfile",  
         "-parent",      "-title",       NULL  
     };  
     enum options {  
         FILE_DEFAULT,   FILE_TYPES,     FILE_INITDIR,   FILE_INITFILE,  
         FILE_PARENT,    FILE_TITLE  
     };  
   
     result = TCL_ERROR;  
     file[0] = '\0';  
   
     /*  
      * Parse the arguments.  
      */  
   
     extension = NULL;  
     filter = NULL;  
     Tcl_DStringInit(&utfFilterString);  
     Tcl_DStringInit(&utfDirString);  
     tkwin = (Tk_Window) clientData;  
     title = NULL;  
   
     for (i = 1; i < objc; i += 2) {  
         int index;  
         char *string;  
         Tcl_Obj *optionPtr, *valuePtr;  
   
         optionPtr = objv[i];  
         valuePtr = objv[i + 1];  
   
         if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",  
                 0, &index) != TCL_OK) {  
             goto end;  
         }  
         if (i + 1 == objc) {  
             string = Tcl_GetStringFromObj(optionPtr, NULL);  
             Tcl_AppendResult(interp, "value for \"", string, "\" missing",  
                     (char *) NULL);  
             goto end;  
         }  
   
         string = Tcl_GetStringFromObj(valuePtr, NULL);  
         switch ((enum options) index) {  
             case FILE_DEFAULT: {  
                 if (string[0] == '.') {  
                     string++;  
                 }  
                 extension = string;  
                 break;  
             }  
             case FILE_TYPES: {  
                 Tcl_DStringFree(&utfFilterString);  
                 if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {  
                     goto end;  
                 }  
                 filter = Tcl_DStringValue(&utfFilterString);  
                 break;  
             }  
             case FILE_INITDIR: {  
                 Tcl_DStringFree(&utfDirString);  
                 if (Tcl_TranslateFileName(interp, string,  
                         &utfDirString) == NULL) {  
                     goto end;  
                 }  
                 break;  
             }  
             case FILE_INITFILE: {  
                 Tcl_DString ds;  
   
                 if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {  
                     goto end;  
                 }  
                 Tcl_UtfToExternal(NULL, unicodeEncoding, Tcl_DStringValue(&ds),  
                         Tcl_DStringLength(&ds), 0, NULL, (char *) file,  
                         sizeof(file), NULL, NULL, NULL);  
                 break;  
             }  
             case FILE_PARENT: {  
                 tkwin = Tk_NameToWindow(interp, string, tkwin);  
                 if (tkwin == NULL) {  
                     goto end;  
                 }  
                 break;  
             }  
             case FILE_TITLE: {  
                 title = string;  
                 break;  
             }  
         }  
     }  
   
     if (filter == NULL) {  
         if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {  
             goto end;  
         }  
     }  
   
     Tk_MakeWindowExist(tkwin);  
     hWnd = Tk_GetHWND(Tk_WindowId(tkwin));  
   
     ofn.lStructSize             = sizeof(ofn);  
     ofn.hwndOwner               = hWnd;  
     ofn.hInstance               = (HINSTANCE) GetWindowLong(ofn.hwndOwner,  
                                         GWL_HINSTANCE);  
     ofn.lpstrFilter             = NULL;  
     ofn.lpstrCustomFilter       = NULL;  
     ofn.nMaxCustFilter          = 0;  
     ofn.nFilterIndex            = 0;  
     ofn.lpstrFile               = (WCHAR *) file;  
     ofn.nMaxFile                = MAX_PATH;  
     ofn.lpstrFileTitle          = NULL;  
     ofn.nMaxFileTitle           = 0;  
     ofn.lpstrInitialDir         = NULL;  
     ofn.lpstrTitle              = NULL;  
     ofn.Flags                   = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST  
                                   | OFN_NOCHANGEDIR | OFN_EXPLORER;  
     ofn.nFileOffset             = 0;  
     ofn.nFileExtension          = 0;  
     ofn.lpstrDefExt             = NULL;  
     ofn.lpfnHook                = OFNHookProcW;  
     ofn.lCustData               = (LPARAM) interp;  
     ofn.lpTemplateName          = NULL;  
   
     if (open != 0) {  
         ofn.Flags |= OFN_FILEMUSTEXIST;  
     } else {  
         ofn.Flags |= OFN_OVERWRITEPROMPT;  
     }  
   
     if (tsdPtr->debugFlag != 0) {  
         ofn.Flags |= OFN_ENABLEHOOK;  
     }  
   
     if (extension != NULL) {  
         Tcl_UtfToExternalDString(unicodeEncoding, extension, -1, &extString);  
         ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString);  
     }  
   
     Tcl_UtfToExternalDString(unicodeEncoding, Tcl_DStringValue(&utfFilterString),  
             Tcl_DStringLength(&utfFilterString), &filterString);  
     ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString);  
   
     if (Tcl_DStringValue(&utfDirString)[0] != '\0') {  
         Tcl_UtfToExternalDString(unicodeEncoding, Tcl_DStringValue(&utfDirString),  
                 Tcl_DStringLength(&utfDirString), &dirString);  
         ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);  
     }  
   
     if (title != NULL) {  
         Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);  
         ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);  
     }  
   
     /*  
      * Popup the dialog.  
      */  
   
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);  
     if (open != 0) {  
         winCode = GetOpenFileNameW(&ofn);  
     } else {  
         winCode = GetSaveFileNameW(&ofn);  
     }  
     Tcl_SetServiceMode(oldMode);  
   
     /*  
      * Ensure that hWnd is enabled, because it can happen that we  
      * have updated the wrapper of the parent, which causes us to  
      * leave this child disabled (Windows loses sync).  
      */  
     EnableWindow(hWnd, 1);  
   
     /*  
      * Clear the interp result since anything may have happened during the  
      * modal loop.  
      */  
   
     Tcl_ResetResult(interp);  
   
     /*  
      * Process the results.  
      */  
   
     if (winCode != 0) {  
         char *p;  
         Tcl_DString ds;  
   
         Tcl_ExternalToUtfDString(unicodeEncoding, (char *) ofn.lpstrFile, -1, &ds);  
         for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {  
             /*  
              * Change the pathname to the Tcl "normalized" pathname, where  
              * back slashes are used instead of forward slashes  
              */  
             if (*p == '\\') {  
                 *p = '/';  
             }  
         }  
         Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);  
         Tcl_DStringFree(&ds);  
     }  
   
     if (ofn.lpstrTitle != NULL) {  
         Tcl_DStringFree(&titleString);  
     }  
     if (ofn.lpstrInitialDir != NULL) {  
         Tcl_DStringFree(&dirString);  
     }  
     Tcl_DStringFree(&filterString);  
     if (ofn.lpstrDefExt != NULL) {  
         Tcl_DStringFree(&extString);  
     }  
     result = TCL_OK;  
   
     end:  
     Tcl_DStringFree(&utfDirString);  
     Tcl_DStringFree(&utfFilterString);  
   
     return result;  
 }  
   
 /*  
  *-------------------------------------------------------------------------  
  *  
  * OFNHookProcW --  
  *  
  *      Hook procedure called only if debugging is turned on.  Sets  
  *      the "tk_dialog" variable when the dialog is ready to receive  
  *      messages.  
  *  
  * Results:  
  *      Returns 0 to allow default processing of messages to occur.  
  *  
  * Side effects:  
  *      None.  
  *  
  *-------------------------------------------------------------------------  
  */  
   
 static UINT APIENTRY  
 OFNHookProcW(  
     HWND hdlg,          // handle to child dialog window  
     UINT uMsg,          // message identifier  
     WPARAM wParam,      // message parameter  
     LPARAM lParam)      // message parameter  
 {  
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)  
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));  
     OPENFILENAMEW *ofnPtr;  
   
     if (uMsg == WM_INITDIALOG) {  
         SetWindowLong(hdlg, GWL_USERDATA, lParam);  
     } else if (uMsg == WM_WINDOWPOSCHANGED) {  
         /*  
          * This message is delivered at the right time to enable Tk  
          * to set the debug information.  Unhooks itself so it  
          * won't set the debug information every time it gets a  
          * WM_WINDOWPOSCHANGED message.  
          */  
   
         ofnPtr = (OPENFILENAMEW *) GetWindowLong(hdlg, GWL_USERDATA);  
         if (ofnPtr != NULL) {  
             hdlg = GetParent(hdlg);  
             tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;  
             Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);  
             SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);  
         }  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * GetFileNameA --  
  *  
  *      Calls GetOpenFileName() or GetSaveFileName().  
  *  
  * Results:  
  *      See user documentation.  
  *  
  * Side effects:  
  *      See user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 GetFileNameA(clientData, interp, objc, objv, open)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
     int open;                   /* 1 to call GetOpenFileName(), 0 to  
                                  * call GetSaveFileName(). */  
 {  
     OPENFILENAME ofn;  
     TCHAR file[MAX_PATH], savePath[MAX_PATH];  
     int result, winCode, oldMode, i;  
     char *extension, *filter, *title;  
     Tk_Window tkwin;  
     HWND hWnd;  
     Tcl_DString utfFilterString, utfDirString;  
     Tcl_DString extString, filterString, dirString, titleString;  
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)  
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));  
     static char *optionStrings[] = {  
         "-defaultextension", "-filetypes", "-initialdir", "-initialfile",  
         "-parent",      "-title",       NULL  
     };  
     enum options {  
         FILE_DEFAULT,   FILE_TYPES,     FILE_INITDIR,   FILE_INITFILE,  
         FILE_PARENT,    FILE_TITLE  
     };  
   
     result = TCL_ERROR;  
     file[0] = '\0';  
   
     /*  
      * Parse the arguments.  
      */  
   
     extension = NULL;  
     filter = NULL;  
     Tcl_DStringInit(&utfFilterString);  
     Tcl_DStringInit(&utfDirString);  
     tkwin = (Tk_Window) clientData;  
     title = NULL;  
   
     for (i = 1; i < objc; i += 2) {  
         int index;  
         char *string;  
         Tcl_Obj *optionPtr, *valuePtr;  
   
         optionPtr = objv[i];  
         valuePtr = objv[i + 1];  
   
         if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",  
                 0, &index) != TCL_OK) {  
             goto end;  
         }  
         if (i + 1 == objc) {  
             string = Tcl_GetStringFromObj(optionPtr, NULL);  
             Tcl_AppendResult(interp, "value for \"", string, "\" missing",  
                     (char *) NULL);  
             goto end;  
         }  
   
         string = Tcl_GetStringFromObj(valuePtr, NULL);  
         switch ((enum options) index) {  
             case FILE_DEFAULT: {  
                 if (string[0] == '.') {  
                     string++;  
                 }  
                 extension = string;  
                 break;  
             }  
             case FILE_TYPES: {  
                 Tcl_DStringFree(&utfFilterString);  
                 if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {  
                     goto end;  
                 }  
                 filter = Tcl_DStringValue(&utfFilterString);  
                 break;  
             }  
             case FILE_INITDIR: {  
                 Tcl_DStringFree(&utfDirString);  
                 if (Tcl_TranslateFileName(interp, string,  
                         &utfDirString) == NULL) {  
                     goto end;  
                 }  
                 break;  
             }  
             case FILE_INITFILE: {  
                 Tcl_DString ds;  
   
                 if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {  
                     goto end;  
                 }  
                 Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds),  
                         Tcl_DStringLength(&ds), 0, NULL, (char *) file,  
                         sizeof(file), NULL, NULL, NULL);  
                 break;  
             }  
             case FILE_PARENT: {  
                 tkwin = Tk_NameToWindow(interp, string, tkwin);  
                 if (tkwin == NULL) {  
                     goto end;  
                 }  
                 break;  
             }  
             case FILE_TITLE: {  
                 title = string;  
                 break;  
             }  
         }  
     }  
   
     if (filter == NULL) {  
         if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {  
             goto end;  
         }  
     }  
   
     Tk_MakeWindowExist(tkwin);  
     hWnd = Tk_GetHWND(Tk_WindowId(tkwin));  
   
     ofn.lStructSize             = sizeof(ofn);  
     ofn.hwndOwner               = hWnd;  
     ofn.hInstance               = (HINSTANCE) GetWindowLong(ofn.hwndOwner,  
                                         GWL_HINSTANCE);  
     ofn.lpstrFilter             = NULL;  
     ofn.lpstrCustomFilter       = NULL;  
     ofn.nMaxCustFilter          = 0;  
     ofn.nFilterIndex            = 0;  
     ofn.lpstrFile               = (LPTSTR) file;  
     ofn.nMaxFile                = MAX_PATH;  
     ofn.lpstrFileTitle          = NULL;  
     ofn.nMaxFileTitle           = 0;  
     ofn.lpstrInitialDir         = NULL;  
     ofn.lpstrTitle              = NULL;  
     ofn.Flags                   = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST  
                                   | OFN_NOCHANGEDIR | OFN_EXPLORER;  
     ofn.nFileOffset             = 0;  
     ofn.nFileExtension          = 0;  
     ofn.lpstrDefExt             = NULL;  
     ofn.lpfnHook                = OFNHookProc;  
     ofn.lCustData               = (LPARAM) interp;  
     ofn.lpTemplateName          = NULL;  
   
     if (open != 0) {  
         ofn.Flags |= OFN_FILEMUSTEXIST;  
     } else {  
         ofn.Flags |= OFN_OVERWRITEPROMPT;  
     }  
   
     if (tsdPtr->debugFlag != 0) {  
         ofn.Flags |= OFN_ENABLEHOOK;  
     }  
   
     if (extension != NULL) {  
         Tcl_UtfToExternalDString(NULL, extension, -1, &extString);  
         ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString);  
     }  
     Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString),  
             Tcl_DStringLength(&utfFilterString), &filterString);  
     ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString);  
   
     if (Tcl_DStringValue(&utfDirString)[0] != '\0') {  
         Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),  
                 Tcl_DStringLength(&utfDirString), &dirString);  
         ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);  
     }  
     if (title != NULL) {  
         Tcl_UtfToExternalDString(NULL, title, -1, &titleString);  
         ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);  
     }  
   
     /*  
      * Popup the dialog.    
      */  
   
     GetCurrentDirectory(MAX_PATH, savePath);  
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);  
     if (open != 0) {  
         winCode = GetOpenFileName(&ofn);  
     } else {  
         winCode = GetSaveFileName(&ofn);  
     }  
     Tcl_SetServiceMode(oldMode);  
     SetCurrentDirectory(savePath);  
   
     /*  
      * Ensure that hWnd is enabled, because it can happen that we  
      * have updated the wrapper of the parent, which causes us to  
      * leave this child disabled (Windows loses sync).  
      */  
     EnableWindow(hWnd, 1);  
   
     /*  
      * Clear the interp result since anything may have happened during the  
      * modal loop.  
      */  
   
     Tcl_ResetResult(interp);  
   
     /*  
      * Process the results.  
      */  
   
     if (winCode != 0) {  
         char *p;  
         Tcl_DString ds;  
   
         Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds);  
         for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {  
             /*  
              * Change the pathname to the Tcl "normalized" pathname, where  
              * back slashes are used instead of forward slashes  
              */  
             if (*p == '\\') {  
                 *p = '/';  
             }  
         }  
         Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);  
         Tcl_DStringFree(&ds);  
     }  
   
     if (ofn.lpstrTitle != NULL) {  
         Tcl_DStringFree(&titleString);  
     }  
     if (ofn.lpstrInitialDir != NULL) {  
         Tcl_DStringFree(&dirString);  
     }  
     Tcl_DStringFree(&filterString);  
     if (ofn.lpstrDefExt != NULL) {  
         Tcl_DStringFree(&extString);  
     }  
     result = TCL_OK;  
   
     end:  
     Tcl_DStringFree(&utfDirString);  
     Tcl_DStringFree(&utfFilterString);  
   
     return result;  
 }  
   
 /*  
  *-------------------------------------------------------------------------  
  *  
  * OFNHookProc --  
  *  
  *      Hook procedure called only if debugging is turned on.  Sets  
  *      the "tk_dialog" variable when the dialog is ready to receive  
  *      messages.  
  *  
  * Results:  
  *      Returns 0 to allow default processing of messages to occur.  
  *  
  * Side effects:  
  *      None.  
  *  
  *-------------------------------------------------------------------------  
  */  
   
 static UINT APIENTRY  
 OFNHookProc(  
     HWND hdlg,          // handle to child dialog window  
     UINT uMsg,          // message identifier  
     WPARAM wParam,      // message parameter  
     LPARAM lParam)      // message parameter  
 {  
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)  
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));  
     OPENFILENAME *ofnPtr;  
   
     if (uMsg == WM_INITDIALOG) {  
         SetWindowLong(hdlg, GWL_USERDATA, lParam);  
     } else if (uMsg == WM_WINDOWPOSCHANGED) {  
         /*  
          * This message is delivered at the right time to both  
          * old-style and explorer-style hook procs to enable Tk  
          * to set the debug information.  Unhooks itself so it  
          * won't set the debug information every time it gets a  
          * WM_WINDOWPOSCHANGED message.  
          */  
   
         ofnPtr = (OPENFILENAME *) GetWindowLong(hdlg, GWL_USERDATA);  
         if (ofnPtr != NULL) {  
             if (ofnPtr->Flags & OFN_EXPLORER) {  
                 hdlg = GetParent(hdlg);  
             }  
             tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;  
             Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);  
             SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);  
         }  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * MakeFilter --  
  *  
  *      Allocate a buffer to store the filters in a format understood by  
  *      Windows  
  *  
  * Results:  
  *      A standard TCL return value.  
  *  
  * Side effects:  
  *      ofnPtr->lpstrFilter is modified.  
  *  
  *----------------------------------------------------------------------  
  */  
 static int  
 MakeFilter(interp, string, dsPtr)  
     Tcl_Interp *interp;         /* Current interpreter. */  
     char *string;               /* String value of the -filetypes option */  
     Tcl_DString *dsPtr;         /* Filled with windows filter string. */  
 {  
     char *filterStr;  
     char *p;  
     int pass;  
     FileFilterList flist;  
     FileFilter *filterPtr;  
   
     TkInitFileFilters(&flist);  
     if (TkGetFileFilters(interp, &flist, string, 1) != TCL_OK) {  
         return TCL_ERROR;  
     }  
   
     if (flist.filters == NULL) {  
         /*  
          * Use "All Files (*.*) as the default filter if none is specified  
          */  
         char *defaultFilter = "All Files (*.*)";  
   
         p = filterStr = (char*)ckalloc(30 * sizeof(char));  
   
         strcpy(p, defaultFilter);  
         p+= strlen(defaultFilter);  
   
         *p++ = '\0';  
         *p++ = '*';  
         *p++ = '.';  
         *p++ = '*';  
         *p++ = '\0';  
         *p++ = '\0';  
         *p = '\0';  
   
     } else {  
         /* We format the filetype into a string understood by Windows:  
          * {"Text Documents" {.doc .txt} {TEXT}} becomes  
          * "Text Documents (*.doc,*.txt)\0*.doc;*.txt\0"  
          *  
          * See the Windows OPENFILENAME manual page for details on the filter  
          * string format.  
          */  
   
         /*  
          * Since we may only add asterisks (*) to the filter, we need at most  
          * twice the size of the string to format the filter  
          */  
         filterStr = ckalloc(strlen(string) * 3);  
   
         for (filterPtr = flist.filters, p = filterStr; filterPtr;  
                 filterPtr = filterPtr->next) {  
             char *sep;  
             FileFilterClause *clausePtr;  
   
             /*  
              *  First, put in the name of the file type  
              */  
             strcpy(p, filterPtr->name);  
             p+= strlen(filterPtr->name);  
             *p++ = ' ';  
             *p++ = '(';  
   
             for (pass = 1; pass <= 2; pass++) {  
                 /*  
                  * In the first pass, we format the extensions in the  
                  * name field. In the second pass, we format the extensions in  
                  * the filter pattern field  
                  */  
                 sep = "";  
                 for (clausePtr=filterPtr->clauses;clausePtr;  
                          clausePtr=clausePtr->next) {  
                     GlobPattern *globPtr;  
                   
   
                     for (globPtr=clausePtr->patterns; globPtr;  
                             globPtr=globPtr->next) {  
                         strcpy(p, sep);  
                         p+= strlen(sep);  
                         strcpy(p, globPtr->pattern);  
                         p+= strlen(globPtr->pattern);  
   
                         if (pass==1) {  
                             sep = ",";  
                         } else {  
                             sep = ";";  
                         }  
                     }  
                 }  
                 if (pass == 1) {  
                     if (pass == 1) {  
                         *p ++ = ')';  
                     }  
                 }  
                 *p ++ = '\0';  
             }  
         }  
   
         /*  
          * Windows requires the filter string to be ended by two NULL  
          * characters.  
          */  
         *p++ = '\0';  
         *p = '\0';  
     }  
   
     Tcl_DStringAppend(dsPtr, filterStr, p - filterStr);  
     ckfree((char *) filterStr);  
   
     TkFreeFileFilters(&flist);  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_ChooseDirectoryObjCmd --  
  *  
  *      This procedure implements the "tk_chooseDirectory" dialog box  
  *      for the Windows platform. See the user documentation for details  
  *      on what it does.  
  *  
  * Results:  
  *      See user documentation.  
  *  
  * Side effects:  
  *      A modal dialog window is created.  Tcl_SetServiceMode() is  
  *      called to allow background events to be processed  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     OPENFILENAME ofn;  
     TCHAR path[MAX_PATH], savePath[MAX_PATH];  
     ChooseDir cd;  
     int result, mustExist, code, mode, i;  
     Tk_Window tkwin;  
     HWND hWnd;  
     char *utfTitle;  
     Tcl_DString utfDirString;  
     Tcl_DString titleString, dirString;  
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)  
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));  
     static char *optionStrings[] = {  
         "-initialdir",  "-mustexist",   "-parent",      "-title",  
         NULL  
     };  
     enum options {  
         DIR_INITIAL,    DIR_EXIST,      DIR_PARENT,     FILE_TITLE  
     };  
   
     if (tsdPtr->WM_LBSELCHANGED == 0) {  
         tsdPtr->WM_LBSELCHANGED = RegisterWindowMessage(LBSELCHSTRING);  
     }  
     
     result = TCL_ERROR;  
     path[0] = '\0';  
   
     Tcl_DStringInit(&utfDirString);  
     mustExist = 0;  
     tkwin = (Tk_Window) clientData;  
     utfTitle = NULL;  
   
     for (i = 1; i < objc; i += 2) {  
         int index;  
         char *string;  
         Tcl_Obj *optionPtr, *valuePtr;  
   
         optionPtr = objv[i];  
         valuePtr = objv[i + 1];  
   
         if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",  
                 0, &index) != TCL_OK) {  
             goto cleanup;  
         }  
         if (i + 1 == objc) {  
             string = Tcl_GetStringFromObj(optionPtr, NULL);  
             Tcl_AppendResult(interp, "value for \"", string, "\" missing",  
                     (char *) NULL);  
             goto cleanup;  
         }  
   
         string = Tcl_GetStringFromObj(valuePtr, NULL);  
         switch ((enum options) index) {  
             case DIR_INITIAL: {  
                 Tcl_DStringFree(&utfDirString);  
                 if (Tcl_TranslateFileName(interp, string,  
                         &utfDirString) == NULL) {  
                     goto cleanup;  
                 }  
                 break;  
             }  
             case DIR_EXIST: {  
                 if (Tcl_GetBooleanFromObj(interp, valuePtr, &mustExist) != TCL_OK) {  
                     goto cleanup;  
                 }  
                 break;  
             }  
             case DIR_PARENT: {  
                 tkwin = Tk_NameToWindow(interp, string, tkwin);  
                 if (tkwin == NULL) {  
                     goto cleanup;  
                 }  
                 break;  
             }  
             case FILE_TITLE: {  
                 utfTitle = string;  
                 break;  
             }  
         }  
     }  
   
     Tk_MakeWindowExist(tkwin);  
     hWnd = Tk_GetHWND(Tk_WindowId(tkwin));  
   
     cd.interp = interp;  
   
     ofn.lStructSize             = sizeof(ofn);  
     ofn.hwndOwner               = hWnd;  
     ofn.hInstance               = (HINSTANCE) GetWindowLong(ofn.hwndOwner,  
                                         GWL_HINSTANCE);  
     ofn.lpstrFilter             = NULL;  
     ofn.lpstrCustomFilter       = NULL;  
     ofn.nMaxCustFilter          = 0;  
     ofn.nFilterIndex            = 0;  
     ofn.lpstrFile               = NULL; //(TCHAR *) path;  
     ofn.nMaxFile                = MAX_PATH;  
     ofn.lpstrFileTitle          = NULL;  
     ofn.nMaxFileTitle           = 0;  
     ofn.lpstrInitialDir         = NULL;  
     ofn.lpstrTitle              = NULL;  
     ofn.Flags                   = OFN_HIDEREADONLY  
                                   | OFN_ENABLEHOOK | OFN_ENABLETEMPLATE;  
     ofn.nFileOffset             = 0;  
     ofn.nFileExtension          = 0;  
     ofn.lpstrDefExt             = NULL;  
     ofn.lCustData               = (LPARAM) &cd;  
     ofn.lpfnHook                = ChooseDirectoryHookProc;  
     ofn.lpTemplateName          = MAKEINTRESOURCE(FILEOPENORD);  
   
     if (Tcl_DStringValue(&utfDirString)[0] != '\0') {  
         Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),  
                 Tcl_DStringLength(&utfDirString), &dirString);  
         ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);  
     }  
     if (mustExist) {  
         ofn.Flags |= OFN_PATHMUSTEXIST;  
     }  
     if (utfTitle != NULL) {  
         Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);  
         ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);  
     }  
   
     /*  
      * Display dialog.  The choose directory dialog doesn't preserve the  
      * current directory, so it must be saved and restored here.  
      */  
       
     GetCurrentDirectory(MAX_PATH, savePath);  
     mode = Tcl_SetServiceMode(TCL_SERVICE_ALL);  
     code = GetOpenFileName(&ofn);  
     Tcl_SetServiceMode(mode);  
     SetCurrentDirectory(savePath);  
   
     /*  
      * Ensure that hWnd is enabled, because it can happen that we  
      * have updated the wrapper of the parent, which causes us to  
      * leave this child disabled (Windows loses sync).  
      */  
     EnableWindow(hWnd, 1);  
   
     Tcl_ResetResult(interp);  
     if (code != 0) {  
         /*  
          * Change the pathname to the Tcl "normalized" pathname, where  
          * back slashes are used instead of forward slashes  
          */  
   
         char *p;  
         Tcl_DString ds;  
   
         Tcl_ExternalToUtfDString(NULL, (char *) cd.path, -1, &ds);  
         for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {  
             if (*p == '\\') {  
                 *p = '/';  
             }  
         }  
         Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);  
         Tcl_DStringFree(&ds);  
     }  
   
     if (ofn.lpstrTitle != NULL) {  
         Tcl_DStringFree(&titleString);  
     }  
     if (ofn.lpstrInitialDir != NULL) {  
         Tcl_DStringFree(&dirString);  
     }  
     result = TCL_OK;  
   
     cleanup:  
     Tcl_DStringFree(&utfDirString);  
   
     return result;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ChooseDirectoryHookProc --  
  *  
  *      Hook procedure called by the ChooseDirectory dialog to modify  
  *      its default behavior.  The ChooseDirectory dialog is really an  
  *      OpenFile dialog with certain controls rearranged and certain  
  *      behaviors changed.  For instance, typing a name in the  
  *      ChooseDirectory dialog selects a directory, rather than  
  *      selecting a file.  
  *  
  * Results:  
  *      Returns 0 to allow default processing of message, or 1 to  
  *      tell default dialog procedure not to process the message.  
  *  
  * Side effects:  
  *      A dialog window is created the first this procedure is called.  
  *      This window is not destroyed and will be reused the next time  
  *      the application invokes the "tk_getOpenFile" or  
  *      "tk_getSaveFile" command.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static UINT APIENTRY  
 ChooseDirectoryHookProc(  
     HWND hwnd,  
     UINT message,  
     WPARAM wParam,  
     LPARAM lParam)  
 {  
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)  
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));  
     OPENFILENAME *ofnPtr;  
   
     /*  
      * GWL_USERDATA keeps track of ofnPtr.  
      */  
       
     ofnPtr = (OPENFILENAME *) GetWindowLong(hwnd, GWL_USERDATA);  
   
     if (message == WM_INITDIALOG) {  
         ChooseDir *cdPtr;  
   
         SetWindowLong(hwnd, GWL_USERDATA, lParam);  
         ofnPtr = (OPENFILENAME *) lParam;  
         cdPtr = (ChooseDir *) ofnPtr->lCustData;  
         cdPtr->lastCtrl = 0;  
         cdPtr->lastIdx = 1000;  
         cdPtr->path[0] = '\0';  
   
         if (ofnPtr->lpstrInitialDir == NULL) {  
             GetCurrentDirectory(MAX_PATH, cdPtr->path);  
         } else {  
             lstrcpy(cdPtr->path, ofnPtr->lpstrInitialDir);  
         }  
         SetDlgItemText(hwnd, edt10, cdPtr->path);  
         SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);  
         if (tsdPtr->debugFlag) {  
             tsdPtr->debugInterp = cdPtr->interp;  
             Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);  
         }  
         return 0;  
     }  
     if (ofnPtr == NULL) {  
         return 0;  
     }  
   
     if (message == tsdPtr->WM_LBSELCHANGED) {  
         /*  
          * Called when double-clicking on directory.  
          * If directory wasn't already open, browse that directory.  
          * If directory was already open, return selected directory.  
          */  
   
         ChooseDir *cdPtr;  
         int idCtrl, thisItem;  
   
         idCtrl = (int) wParam;  
         thisItem = LOWORD(lParam);  
         cdPtr = (ChooseDir *) ofnPtr->lCustData;  
   
         GetCurrentDirectory(MAX_PATH, cdPtr->path);  
         if (idCtrl == lst2) {  
             if (cdPtr->lastIdx == thisItem) {  
                 EndDialog(hwnd, IDOK);  
                 return 1;  
             }  
             cdPtr->lastIdx = thisItem;  
         }  
         SetDlgItemText(hwnd, edt10, cdPtr->path);  
         SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);  
     } else if (message == WM_COMMAND) {  
         ChooseDir *cdPtr;  
         int idCtrl, notifyCode;  
   
         idCtrl = LOWORD(wParam);  
         notifyCode = HIWORD(wParam);  
         cdPtr = (ChooseDir *) ofnPtr->lCustData;  
   
         if ((idCtrl != IDOK) || (notifyCode != BN_CLICKED)) {  
             /*  
              * OK Button wasn't clicked.  Do the default.  
              */  
   
             if ((idCtrl == lst2) || (idCtrl == edt10)) {  
                 cdPtr->lastCtrl = idCtrl;  
             }  
             return 0;  
         }  
   
         /*  
          * Dialogs also get the message that OK was clicked when Enter  
          * is pressed in some other control.  Find out what window  
          * we were really in when we got the supposed "OK", because the  
          * behavior is different.  
          */  
   
         if (cdPtr->lastCtrl == edt10) {  
             /*  
              * Hit Enter or clicked OK while typing a directory name in the  
              * edit control.  
              * If it's a new name, try to go to that directory.  
              * If the name hasn't changed since last time, return selected  
              * directory.  
              */  
   
             int changed;  
             TCHAR tmp[MAX_PATH];  
   
             if (GetDlgItemText(hwnd, edt10, tmp, MAX_PATH) == 0) {  
                 return 0;  
             }  
   
             changed = lstrcmp(cdPtr->path, tmp);  
             lstrcpy(cdPtr->path, tmp);  
   
             if (SetCurrentDirectory(cdPtr->path) == 0) {  
                 /*  
                  * Non-existent directory.  
                  */  
   
                 if (ofnPtr->Flags & OFN_PATHMUSTEXIST) {  
                     /*  
                      * Directory must exist.  Complain, then rehighlight text.  
                      */  
   
                     wsprintf(tmp, _T("Cannot change directory to \"%.200s\"."),  
                             cdPtr->path);  
                     MessageBox(hwnd, tmp, NULL, MB_OK);  
                     SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);  
                     return 0;  
                 }  
                 if (changed) {  
                     /*  
                      * Directory was invalid, but we want to keep displaying  
                      * this name.  Don't update the listbox that displays the  
                      * current directory heirarchy, or it'll erase the name.  
                      */  
                       
                     SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);  
                     return 0;  
                 }  
             }  
             if (changed == 0) {  
                 /*  
                  * Name hasn't changed since the last time we hit return  
                  * or double-clicked on a directory, so return this.  
                  */  
   
                 EndDialog(hwnd, IDOK);  
                 return 1;  
             }  
               
             cdPtr->lastCtrl = IDOK;  
   
             /*  
              * The following is the magic code, determined by running  
              * Spy++ on some other directory chooser, that it takes to  
              * get this dialog to update the listbox to display the  
              * current directory.  
              */  
   
             SetDlgItemText(hwnd, edt1, cdPtr->path);  
             SendMessage(hwnd, WM_COMMAND, (WPARAM) MAKELONG(cmb2, 0x8003),  
                     (LPARAM) GetDlgItem(hwnd, cmb2));  
             return 0;  
         } else if (idCtrl == lst2) {  
             /*  
              * Enter key was pressed while in listbox.    
              * If it's a new directory, allow default behavior to open dir.  
              * If the directory hasn't changed, return selected directory.  
              */  
   
             int thisItem;  
   
             thisItem = (int) SendDlgItemMessage(hwnd, lst2, LB_GETCURSEL, 0, 0);  
             if (cdPtr->lastIdx == thisItem) {  
                 GetCurrentDirectory(MAX_PATH, cdPtr->path);  
                 EndDialog(hwnd, IDOK);  
                 return 1;  
             }  
         } else if (idCtrl == IDOK) {  
             /*  
              * The OK button was clicked. Return the value currently selected  
              * in the entry.  
              */  
   
             GetCurrentDirectory(MAX_PATH, cdPtr->path);  
             EndDialog(hwnd, IDOK);  
             return 1;  
         }  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_MessageBoxObjCmd --  
  *  
  *      This procedure implements the MessageBox window for the  
  *      Windows platform. See the user documentation for details on what  
  *      it does.  
  *  
  * Results:  
  *      See user documentation.  
  *  
  * Side effects:  
  *      None. The MessageBox window will be destroy before this procedure  
  *      returns.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_MessageBoxObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     Tk_Window tkwin, parent;  
     HWND hWnd;  
     char *message, *title;  
     int defaultBtn, icon, type;  
     int i, oldMode, flags, winCode;  
     Tcl_DString messageString, titleString;  
     static char *optionStrings[] = {  
         "-default",     "-icon",        "-message",     "-parent",  
         "-title",       "-type",        NULL  
     };  
     enum options {  
         MSG_DEFAULT,    MSG_ICON,       MSG_MESSAGE,    MSG_PARENT,  
         MSG_TITLE,      MSG_TYPE  
     };  
   
     tkwin = (Tk_Window) clientData;  
   
     defaultBtn  = -1;  
     icon        = MB_ICONINFORMATION;  
     message     = NULL;  
     parent      = tkwin;  
     title       = NULL;  
     type        = MB_OK;  
   
     for (i = 1; i < objc; i += 2) {  
         int index;  
         char *string;  
         Tcl_Obj *optionPtr, *valuePtr;  
   
         optionPtr = objv[i];  
         valuePtr = objv[i + 1];  
   
         if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",  
                 TCL_EXACT, &index) != TCL_OK) {  
             return TCL_ERROR;  
         }  
         if (i + 1 == objc) {  
             string = Tcl_GetStringFromObj(optionPtr, NULL);  
             Tcl_AppendResult(interp, "value for \"", string, "\" missing",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
   
         string = Tcl_GetStringFromObj(valuePtr, NULL);  
         switch ((enum options) index) {  
         case MSG_DEFAULT:  
             defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap,  
                     valuePtr);  
             if (defaultBtn < 0) {  
                 return TCL_ERROR;  
             }  
             break;  
   
         case MSG_ICON:  
             icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr);  
             if (icon < 0) {  
                 return TCL_ERROR;  
             }  
             break;  
   
         case MSG_MESSAGE:  
             message = string;  
             break;  
   
         case MSG_PARENT:  
             parent = Tk_NameToWindow(interp, string, tkwin);  
             if (parent == NULL) {  
                 return TCL_ERROR;  
             }  
             break;  
   
         case MSG_TITLE:  
             title = string;  
             break;  
   
         case MSG_TYPE:  
             type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr);  
             if (type < 0) {  
                 return TCL_ERROR;  
             }  
             break;  
   
         }  
     }  
   
     Tk_MakeWindowExist(parent);  
     hWnd = Tk_GetHWND(Tk_WindowId(parent));  
       
     flags = 0;  
     if (defaultBtn >= 0) {  
         int defaultBtnIdx;  
   
         defaultBtnIdx = -1;  
         for (i = 0; i < NUM_TYPES; i++) {  
             if (type == allowedTypes[i].type) {  
                 int j;  
   
                 for (j = 0; j < 3; j++) {  
                     if (allowedTypes[i].btnIds[j] == defaultBtn) {  
                         defaultBtnIdx = j;  
                         break;  
                     }  
                 }  
                 if (defaultBtnIdx < 0) {  
                     Tcl_AppendResult(interp, "invalid default button \"",  
                             TkFindStateString(buttonMap, defaultBtn),  
                             "\"", NULL);  
                     return TCL_ERROR;  
                 }  
                 break;  
             }  
         }  
         flags = buttonFlagMap[defaultBtnIdx];  
     }  
   
     flags |= icon | type | MB_SYSTEMMODAL;  
   
     Tcl_UtfToExternalDString(NULL, message, -1, &messageString);  
     Tcl_UtfToExternalDString(NULL, title, -1, &titleString);  
   
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);  
     winCode = MessageBox(hWnd, Tcl_DStringValue(&messageString),  
                 Tcl_DStringValue(&titleString), flags);  
     (void) Tcl_SetServiceMode(oldMode);  
   
     /*  
      * Ensure that hWnd is enabled, because it can happen that we  
      * have updated the wrapper of the parent, which causes us to  
      * leave this child disabled (Windows loses sync).  
      */  
     EnableWindow(hWnd, 1);  
   
     Tcl_DStringFree(&messageString);  
     Tcl_DStringFree(&titleString);  
   
     Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);  
     return TCL_OK;  
 }  
   
 static void  
 SetTkDialog(ClientData clientData)  
 {  
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)  
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));  
     char buf[32];  
     HWND hwnd;  
   
     hwnd = (HWND) clientData;  
   
     sprintf(buf, "0x%08x", hwnd);  
     Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);  
 }  
   
   
 /* $History: tkWinDialog.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 3:17a  
  * Created in $/IjuScripter, IjuConsole/Source/Tk Base  
  * Initial check-in.  
  */  
   
 /* End of TKWINDIALOG.C */  
1    /* $Header$ */
2    
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    /* End of tkwindialog.c */
Legend:
Removed from v.29  
changed lines
  Added in v.98
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25