summaryrefslogtreecommitdiffstats
path: root/win/tkWinDialog.c
diff options
context:
space:
mode:
authorrjohnson <rjohnson>1998-04-01 09:51:44 (GMT)
committerrjohnson <rjohnson>1998-04-01 09:51:44 (GMT)
commit066ea7fd88d49cb456f74da71dbe875e4fc0aabb (patch)
tree8fb30cb152c4dc191be47fa043d2e6f5ea38c7ba /win/tkWinDialog.c
parent13242623d2ff3ea02ab6a62bfb48a7dbb5c27e22 (diff)
downloadtk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.zip
tk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.tar.gz
tk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.tar.bz2
Initial revision
Diffstat (limited to 'win/tkWinDialog.c')
-rw-r--r--win/tkWinDialog.c1050
1 files changed, 1050 insertions, 0 deletions
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
new file mode 100644
index 0000000..7d01edb
--- /dev/null
+++ b/win/tkWinDialog.c
@@ -0,0 +1,1050 @@
+/*
+ * 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.
+ *
+ * SCCS: @(#) tkWinDialog.c 1.10 97/10/21 11:29:18
+ *
+ */
+
+#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 */
+
+#if ((TK_MAJOR_VERSION == 4) && (TK_MINOR_VERSION <= 2))
+/*
+ * The following function is implemented on tk4.3 and after only
+ */
+#define Tk_GetHWND TkWinGetHWND
+#endif
+
+#define SAVE_FILE 0
+#define OPEN_FILE 1
+
+/*----------------------------------------------------------------------
+ * MsgTypeInfo --
+ *
+ * This structure stores the type of available message box in an
+ * easy-to-process format. Used by th Tk_MessageBox() function
+ *----------------------------------------------------------------------
+ */
+typedef struct MsgTypeInfo {
+ char * name;
+ int type;
+ int numButtons;
+ char * btnNames[3];
+} MsgTypeInfo;
+
+#define NUM_TYPES 6
+
+static MsgTypeInfo
+msgTypeInfo[NUM_TYPES] = {
+ {"abortretryignore", MB_ABORTRETRYIGNORE, 3, {"abort", "retry", "ignore"}},
+ {"ok", MB_OK, 1, {"ok" }},
+ {"okcancel", MB_OKCANCEL, 2, {"ok", "cancel" }},
+ {"retrycancel", MB_RETRYCANCEL, 2, {"retry", "cancel" }},
+ {"yesno", MB_YESNO, 2, {"yes", "no" }},
+ {"yesnocancel", MB_YESNOCANCEL, 3, {"yes", "no", "cancel"}}
+};
+
+/*
+ * The following structure is used in the GetOpenFileName() and
+ * GetSaveFileName() calls.
+ */
+typedef struct _OpenFileData {
+ Tcl_Interp * interp;
+ TCHAR szFile[MAX_PATH+1];
+} OpenFileData;
+
+/*
+ * The following structure is used in the ChooseColor() call.
+ */
+typedef struct _ChooseColorData {
+ Tcl_Interp * interp;
+ char * title; /* Title of the color dialog */
+} ChooseColorData;
+
+
+static int GetFileName _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv,
+ int isOpen));
+static UINT CALLBACK ColorDlgHookProc _ANSI_ARGS_((HWND hDlg, UINT uMsg,
+ WPARAM wParam, LPARAM lParam));
+static int MakeFilter _ANSI_ARGS_((Tcl_Interp *interp,
+ OPENFILENAME *ofnPtr, char * string));
+static int ParseFileDlgArgs _ANSI_ARGS_((Tcl_Interp * interp,
+ OPENFILENAME *ofnPtr, int argc, char ** argv,
+ int isOpen));
+static int ProcessCDError _ANSI_ARGS_((Tcl_Interp * interp,
+ DWORD dwErrorCode, HWND hWnd));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EvalArgv --
+ *
+ * Invokes the Tcl procedure with the arguments. argv[0] is set by
+ * the caller of this function. It may be different than cmdName.
+ * The TCL command will see argv[0], not cmdName, as its name if it
+ * invokes [lindex [info level 0] 0]
+ *
+ * Results:
+ * TCL_ERROR if the command does not exist and cannot be autoloaded.
+ * Otherwise, return the result of the evaluation of the command.
+ *
+ * Side effects:
+ * The command may be autoloaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EvalArgv(interp, cmdName, argc, argv)
+ Tcl_Interp *interp; /* Current interpreter. */
+ char * cmdName; /* Name of the TCL command to call */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tcl_CmdInfo cmdInfo;
+
+ if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
+ char * cmdArgv[2];
+
+ /*
+ * This comand is not in the interpreter yet -- looks like we
+ * have to auto-load it
+ */
+ if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ cmdArgv[0] = "auto_load";
+ cmdArgv[1] = cmdName;
+
+ if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){
+ return TCL_ERROR;
+ }
+
+ if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "cannot auto-load command \"",
+ cmdName, "\"",NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseColorCmd --
+ *
+ * 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_ChooseColorCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window parent = Tk_MainWindow(interp);
+ ChooseColorData custData;
+ int oldMode;
+ CHOOSECOLOR chooseColor;
+ char * colorStr = NULL;
+ int i;
+ int winCode, tclCode;
+ XColor * colorPtr = NULL;
+ static inited = 0;
+ static long dwCustColors[16];
+ static long oldColor; /* the color selected last time */
+
+ custData.title = NULL;
+
+ if (!inited) {
+ /*
+ * dwCustColors stores the custom color which the user can
+ * modify. We store these colors in a fixed 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;
+ }
+
+ /*
+ * 1. Parse the arguments
+ */
+
+ chooseColor.lStructSize = sizeof(CHOOSECOLOR) ;
+ chooseColor.hwndOwner = 0; /* filled in below */
+ chooseColor.hInstance = 0;
+ chooseColor.rgbResult = oldColor;
+ chooseColor.lpCustColors = (LPDWORD) dwCustColors ;
+ chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
+ chooseColor.lCustData = (LPARAM)&custData;
+ chooseColor.lpfnHook = ColorDlgHookProc;
+ chooseColor.lpTemplateName = NULL;
+
+ for (i=1; i<argc; i+=2) {
+ int v = i+1;
+ int len = strlen(argv[i]);
+
+ if (strncmp(argv[i], "-initialcolor", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ colorStr = argv[v];
+ }
+ else if (strncmp(argv[i], "-parent", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ else if (strncmp(argv[i], "-title", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ custData.title = argv[v];
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"",
+ argv[i], "\", must be -initialcolor, -parent or -title",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (Tk_WindowId(parent) == None) {
+ Tk_MakeWindowExist(parent);
+ }
+ chooseColor.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
+
+ if (colorStr != NULL) {
+ colorPtr = Tk_GetColor(interp, Tk_MainWindow(interp), colorStr);
+ if (!colorPtr) {
+ return TCL_ERROR;
+ }
+ chooseColor.rgbResult = RGB((colorPtr->red/0x100),
+ (colorPtr->green/0x100), (colorPtr->blue/0x100));
+ }
+
+ /*
+ * 2. Popup the dialog
+ */
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ winCode = ChooseColor(&chooseColor);
+ (void) Tcl_SetServiceMode(oldMode);
+
+ /*
+ * 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);
+ tclCode = TCL_OK;
+
+ oldColor = chooseColor.rgbResult;
+ } else {
+ /*
+ * User probably pressed Cancel, or an error occurred
+ */
+ tclCode = ProcessCDError(interp, CommDlgExtendedError(),
+ chooseColor.hwndOwner);
+ }
+
+ if (colorPtr) {
+ Tk_FreeColor(colorPtr);
+ }
+
+ return tclCode;
+
+ arg_missing:
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
+ NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ColorDlgHookProc --
+ *
+ * Gets called during the execution of the color dialog. It processes
+ * the "interesting" messages that Windows send to the dialog.
+ *
+ * Results:
+ * TRUE if the message has been processed, FALSE otherwise.
+ *
+ * Side effects:
+ * Changes the title of the dialog window when it is popped up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static UINT
+CALLBACK ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
+ HWND hDlg; /* Handle to the color dialog */
+ UINT uMsg; /* Type of message */
+ WPARAM wParam; /* word param, interpretation depends on uMsg*/
+ LPARAM lParam; /* long param, interpretation depends on uMsg*/
+{
+ CHOOSECOLOR * ccPtr;
+ ChooseColorData * pCustData;
+
+ switch (uMsg) {
+ case WM_INITDIALOG:
+ /* Save the pointer to CHOOSECOLOR so that we can use it later */
+ SetWindowLong(hDlg, DWL_USER, lParam);
+
+ /* Set the title string of the dialog */
+ ccPtr = (CHOOSECOLOR*)lParam;
+ pCustData = (ChooseColorData*)(ccPtr->lCustData);
+ if (pCustData->title && *(pCustData->title)) {
+ SetWindowText(hDlg, (LPCSTR)pCustData->title);
+ }
+
+ 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.
+ * This window is not destroyed and will be reused the next time
+ * the application invokes the "tk_getOpenFile" or
+ * "tk_getSaveFile" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetOpenFileCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_GetSaveFileCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFileName --
+ *
+ * Calls GetOpenFileName() or GetSaveFileName().
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * See user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetFileName(clientData, interp, argc, argv, isOpen)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+ int isOpen; /* true if we should call GetOpenFileName(),
+ * false if we should call GetSaveFileName() */
+{
+ OPENFILENAME openFileName, *ofnPtr;
+ int tclCode, winCode, oldMode;
+ OpenFileData *custData;
+ char buffer[MAX_PATH+1];
+
+ ofnPtr = &openFileName;
+
+ /*
+ * 1. Parse the arguments.
+ */
+ if (ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ custData = (OpenFileData*) ofnPtr->lCustData;
+
+ /*
+ * 2. Call the common dialog function.
+ */
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ GetCurrentDirectory(MAX_PATH+1, buffer);
+ if (isOpen) {
+ winCode = GetOpenFileName(ofnPtr);
+ } else {
+ winCode = GetSaveFileName(ofnPtr);
+ }
+ SetCurrentDirectory(buffer);
+ (void) Tcl_SetServiceMode(oldMode);
+
+ /*
+ * Clear the interp result since anything may have happened during the
+ * modal loop.
+ */
+
+ Tcl_ResetResult(interp);
+
+ if (ofnPtr->lpstrInitialDir != NULL) {
+ ckfree((char*) ofnPtr->lpstrInitialDir);
+ }
+
+ /*
+ * 3. Process the results.
+ */
+ if (winCode) {
+ char *p;
+ Tcl_ResetResult(interp);
+
+ for (p = custData->szFile; p && *p; p++) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where
+ * back slashes are used instead of forward slashes
+ */
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ Tcl_AppendResult(interp, custData->szFile, NULL);
+ tclCode = TCL_OK;
+ } else {
+ tclCode = ProcessCDError(interp, CommDlgExtendedError(),
+ ofnPtr->hwndOwner);
+ }
+
+ if (custData) {
+ ckfree((char*)custData);
+ }
+ if (ofnPtr->lpstrFilter) {
+ ckfree((char*)ofnPtr->lpstrFilter);
+ }
+
+ return tclCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseFileDlgArgs --
+ *
+ * Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
+ *
+ * Results:
+ * A standard TCL return value.
+ *
+ * Side effects:
+ * The OPENFILENAME structure is initialized and modified according
+ * to the arguments.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen)
+ Tcl_Interp * interp; /* Current interpreter. */
+ OPENFILENAME *ofnPtr; /* Info about the file dialog */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+ int isOpen; /* true if we should call GetOpenFileName(),
+ * false if we should call GetSaveFileName() */
+{
+ OpenFileData * custData;
+ int i;
+ Tk_Window parent = Tk_MainWindow(interp);
+ int doneFilter = 0;
+ int windowsMajorVersion;
+ Tcl_DString buffer;
+
+ custData = (OpenFileData*)ckalloc(sizeof(OpenFileData));
+ custData->interp = interp;
+ strcpy(custData->szFile, "");
+
+ /* Fill in the OPENFILENAME structure to */
+ ofnPtr->lStructSize = sizeof(OPENFILENAME);
+ ofnPtr->hwndOwner = 0; /* filled in below */
+ ofnPtr->lpstrFilter = NULL;
+ ofnPtr->lpstrCustomFilter = NULL;
+ ofnPtr->nMaxCustFilter = 0;
+ ofnPtr->nFilterIndex = 0;
+ ofnPtr->lpstrFile = custData->szFile;
+ ofnPtr->nMaxFile = sizeof(custData->szFile);
+ ofnPtr->lpstrFileTitle = NULL;
+ ofnPtr->nMaxFileTitle = 0;
+ ofnPtr->lpstrInitialDir = NULL;
+ ofnPtr->lpstrTitle = NULL;
+ ofnPtr->nFileOffset = 0;
+ ofnPtr->nFileExtension = 0;
+ ofnPtr->lpstrDefExt = NULL;
+ ofnPtr->lpfnHook = NULL;
+ ofnPtr->lCustData = (DWORD)custData;
+ ofnPtr->lpTemplateName = NULL;
+ ofnPtr->Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST;
+
+ windowsMajorVersion = LOBYTE(LOWORD(GetVersion()));
+ if (windowsMajorVersion >= 4) {
+ /*
+ * Use the "explorer" style file selection box on platforms that
+ * support it (Win95 and NT4.0, both have a major version number
+ * of 4)
+ */
+ ofnPtr->Flags |= OFN_EXPLORER;
+ }
+
+
+ if (isOpen) {
+ ofnPtr->Flags |= OFN_FILEMUSTEXIST;
+ } else {
+ ofnPtr->Flags |= OFN_OVERWRITEPROMPT;
+ }
+
+ for (i=1; i<argc; i+=2) {
+ int v = i+1;
+ int len = strlen(argv[i]);
+
+ if (strncmp(argv[i], "-defaultextension", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ ofnPtr->lpstrDefExt = argv[v];
+ if (ofnPtr->lpstrDefExt[0] == '.') {
+ /* Windows will insert the dot for us */
+ ofnPtr->lpstrDefExt ++;
+ }
+ }
+ else if (strncmp(argv[i], "-filetypes", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ if (MakeFilter(interp, ofnPtr, argv[v]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ doneFilter = 1;
+ }
+ else if (strncmp(argv[i], "-initialdir", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
+ return TCL_ERROR;
+ }
+ ofnPtr->lpstrInitialDir = ckalloc(Tcl_DStringLength(&buffer)+1);
+ strcpy((char*)ofnPtr->lpstrInitialDir, Tcl_DStringValue(&buffer));
+ Tcl_DStringFree(&buffer);
+ }
+ else if (strncmp(argv[i], "-initialfile", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
+ return TCL_ERROR;
+ }
+ strcpy(ofnPtr->lpstrFile, Tcl_DStringValue(&buffer));
+ Tcl_DStringFree(&buffer);
+ }
+ else if (strncmp(argv[i], "-parent", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ else if (strncmp(argv[i], "-title", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ ofnPtr->lpstrTitle = argv[v];
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"",
+ argv[i], "\", must be -defaultextension, ",
+ "-filetypes, -initialdir, -initialfile, -parent or -title",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (!doneFilter) {
+ if (MakeFilter(interp, ofnPtr, "") != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (Tk_WindowId(parent) == None) {
+ Tk_MakeWindowExist(parent);
+ }
+ ofnPtr->hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
+
+ return TCL_OK;
+
+ arg_missing:
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
+ NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, ofnPtr, string)
+ Tcl_Interp *interp; /* Current interpreter. */
+ OPENFILENAME *ofnPtr; /* Info about the file dialog */
+ char *string; /* String value of the -filetypes option */
+{
+ 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 is 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';
+ }
+
+ if (ofnPtr->lpstrFilter != NULL) {
+ ckfree((char*)ofnPtr->lpstrFilter);
+ }
+ ofnPtr->lpstrFilter = filterStr;
+
+ TkFreeFileFilters(&flist);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MessageBoxCmd --
+ *
+ * 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_MessageBoxCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int flags;
+ Tk_Window parent = Tk_MainWindow(interp);
+ HWND hWnd;
+ char *message = "";
+ char *title = "";
+ int icon = MB_ICONINFORMATION;
+ int type = MB_OK;
+ int i, j;
+ char *result;
+ int code, oldMode;
+ char *defaultBtn = NULL;
+ int defaultBtnIdx = -1;
+
+ for (i=1; i<argc; i+=2) {
+ int v = i+1;
+ int len = strlen(argv[i]);
+
+ if (strncmp(argv[i], "-default", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ defaultBtn = argv[v];
+ }
+ else if (strncmp(argv[i], "-icon", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ if (strcmp(argv[v], "error") == 0) {
+ icon = MB_ICONERROR;
+ }
+ else if (strcmp(argv[v], "info") == 0) {
+ icon = MB_ICONINFORMATION;
+ }
+ else if (strcmp(argv[v], "question") == 0) {
+ icon = MB_ICONQUESTION;
+ }
+ else if (strcmp(argv[v], "warning") == 0) {
+ icon = MB_ICONWARNING;
+ }
+ else {
+ Tcl_AppendResult(interp, "invalid icon \"", argv[v],
+ "\", must be error, info, question or warning", NULL);
+ return TCL_ERROR;
+ }
+ }
+ else if (strncmp(argv[i], "-message", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ message = argv[v];
+ }
+ else if (strncmp(argv[i], "-parent", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ else if (strncmp(argv[i], "-title", len)==0) {
+ if (v==argc) {goto arg_missing;}
+
+ title = argv[v];
+ }
+ else if (strncmp(argv[i], "-type", len)==0) {
+ int found = 0;
+
+ if (v==argc) {goto arg_missing;}
+
+ for (j=0; j<NUM_TYPES; j++) {
+ if (strcmp(argv[v], msgTypeInfo[j].name) == 0) {
+ type = msgTypeInfo[j].type;
+ found = 1;
+ break;
+ }
+ }
+ if (!found) {
+ Tcl_AppendResult(interp, "invalid message box type \"",
+ argv[v], "\", must be abortretryignore, ok, ",
+ "okcancel, retrycancel, yesno or yesnocancel", NULL);
+ return TCL_ERROR;
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"",
+ argv[i], "\", must be -default, -icon, ",
+ "-message, -parent, -title or -type", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /* Make sure we have a valid hWnd to act as the parent of this message box
+ */
+ if (Tk_WindowId(parent) == None) {
+ Tk_MakeWindowExist(parent);
+ }
+ hWnd = Tk_GetHWND(Tk_WindowId(parent));
+
+ if (defaultBtn != NULL) {
+ for (i=0; i<NUM_TYPES; i++) {
+ if (type == msgTypeInfo[i].type) {
+ for (j=0; j<msgTypeInfo[i].numButtons; j++) {
+ if (strcmp(defaultBtn, msgTypeInfo[i].btnNames[j])==0) {
+ defaultBtnIdx = j;
+ break;
+ }
+ }
+ if (defaultBtnIdx < 0) {
+ Tcl_AppendResult(interp, "invalid default button \"",
+ defaultBtn, "\"", NULL);
+ return TCL_ERROR;
+ }
+ break;
+ }
+ }
+
+ switch (defaultBtnIdx) {
+ case 0: flags = MB_DEFBUTTON1; break;
+ case 1: flags = MB_DEFBUTTON2; break;
+ case 2: flags = MB_DEFBUTTON3; break;
+ case 3: flags = MB_DEFBUTTON4; break;
+ }
+ } else {
+ flags = 0;
+ }
+
+ flags |= icon | type;
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ code = MessageBox(hWnd, message, title, flags|MB_SYSTEMMODAL);
+ (void) Tcl_SetServiceMode(oldMode);
+
+ switch (code) {
+ case IDABORT: result = "abort"; break;
+ case IDCANCEL: result = "cancel"; break;
+ case IDIGNORE: result = "ignore"; break;
+ case IDNO: result = "no"; break;
+ case IDOK: result = "ok"; break;
+ case IDRETRY: result = "retry"; break;
+ case IDYES: result = "yes"; break;
+ default: result = "";
+ }
+
+ /*
+ * When we come to here interp->result may have been changed by some
+ * background scripts. Call Tcl_SetResult() to make sure that any stuff
+ * lingering in interp->result will not appear in the result of
+ * this command.
+ */
+
+ Tcl_SetResult(interp, result, TCL_STATIC);
+ return TCL_OK;
+
+ arg_missing:
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
+ NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcessCDError --
+ *
+ * This procedure gets called if a Windows-specific error message
+ * has occurred during the execution of a common dialog or the
+ * user has pressed the CANCEL button.
+ *
+ * Results:
+ * If an error has indeed happened, returns a standard TCL result
+ * that reports the error code in string format. If the user has
+ * pressed the CANCEL button (dwErrorCode == 0), resets
+ * interp->result to the empty string.
+ *
+ * Side effects:
+ * interp->result is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+static int ProcessCDError(interp, dwErrorCode, hWnd)
+ Tcl_Interp * interp; /* Current interpreter. */
+ DWORD dwErrorCode; /* The Windows-specific error code */
+ HWND hWnd; /* window in which the error happened*/
+{
+ char *string;
+
+ Tcl_ResetResult(interp);
+
+ switch(dwErrorCode) {
+ case 0: /* User has hit CANCEL */
+ return TCL_OK;
+
+ case CDERR_DIALOGFAILURE: string="CDERR_DIALOGFAILURE"; break;
+ case CDERR_STRUCTSIZE: string="CDERR_STRUCTSIZE"; break;
+ case CDERR_INITIALIZATION: string="CDERR_INITIALIZATION"; break;
+ case CDERR_NOTEMPLATE: string="CDERR_NOTEMPLATE"; break;
+ case CDERR_NOHINSTANCE: string="CDERR_NOHINSTANCE"; break;
+ case CDERR_LOADSTRFAILURE: string="CDERR_LOADSTRFAILURE"; break;
+ case CDERR_FINDRESFAILURE: string="CDERR_FINDRESFAILURE"; break;
+ case CDERR_LOADRESFAILURE: string="CDERR_LOADRESFAILURE"; break;
+ case CDERR_LOCKRESFAILURE: string="CDERR_LOCKRESFAILURE"; break;
+ case CDERR_MEMALLOCFAILURE: string="CDERR_MEMALLOCFAILURE"; break;
+ case CDERR_MEMLOCKFAILURE: string="CDERR_MEMLOCKFAILURE"; break;
+ case CDERR_NOHOOK: string="CDERR_NOHOOK"; break;
+ case PDERR_SETUPFAILURE: string="PDERR_SETUPFAILURE"; break;
+ case PDERR_PARSEFAILURE: string="PDERR_PARSEFAILURE"; break;
+ case PDERR_RETDEFFAILURE: string="PDERR_RETDEFFAILURE"; break;
+ case PDERR_LOADDRVFAILURE: string="PDERR_LOADDRVFAILURE"; break;
+ case PDERR_GETDEVMODEFAIL: string="PDERR_GETDEVMODEFAIL"; break;
+ case PDERR_INITFAILURE: string="PDERR_INITFAILURE"; break;
+ case PDERR_NODEVICES: string="PDERR_NODEVICES"; break;
+ case PDERR_NODEFAULTPRN: string="PDERR_NODEFAULTPRN"; break;
+ case PDERR_DNDMMISMATCH: string="PDERR_DNDMMISMATCH"; break;
+ case PDERR_CREATEICFAILURE: string="PDERR_CREATEICFAILURE"; break;
+ case PDERR_PRINTERNOTFOUND: string="PDERR_PRINTERNOTFOUND"; break;
+ case CFERR_NOFONTS: string="CFERR_NOFONTS"; break;
+ case FNERR_SUBCLASSFAILURE: string="FNERR_SUBCLASSFAILURE"; break;
+ case FNERR_INVALIDFILENAME: string="FNERR_INVALIDFILENAME"; break;
+ case FNERR_BUFFERTOOSMALL: string="FNERR_BUFFERTOOSMALL"; break;
+
+ default:
+ string="unknown error";
+ }
+
+ Tcl_AppendResult(interp, "Win32 internal error: ", string, NULL);
+ return TCL_ERROR;
+}