home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tk42r2s.zip / tk4.2 / os2 / tkOS2Dialog.c < prev    next >
C/C++ Source or Header  |  1999-07-26  |  23KB  |  801 lines
  1. /*
  2.  * tkOS2Dialog.c --
  3.  *
  4.  *    Contains the OS/2 implementation of the common dialog boxes.
  5.  *
  6.  * Copyright (c) 1996 Sun Microsystems, Inc.
  7.  * Copyright (c) 1998 Illya Vaes
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tkOS2Dialog.c 1.5 96/09/11 19:24:28
  13.  *
  14.  */
  15.  
  16. #include "tkOS2Int.h"
  17. #include "tkFileFilter.h"
  18.  
  19. #if ((TK_MAJOR_VERSION == 4) && (TK_MINOR_VERSION <= 2))
  20. /*
  21.  * The following function is implemented on tk4.3 and after only 
  22.  */
  23. #define Tk_GetHWND TkOS2GetHWND
  24. #endif
  25.  
  26. #define SAVE_FILE 0
  27. #define OPEN_FILE 1
  28.  
  29. /*----------------------------------------------------------------------
  30.  * MsgTypeInfo --
  31.  *
  32.  *    This structure stores the type of available message box in an
  33.  *    easy-to-process format. Used by the Tk_MessageBox() function
  34.  *----------------------------------------------------------------------
  35.  */
  36. typedef struct MsgTypeInfo {
  37.     char * name;
  38.     int type;
  39.     int numButtons;
  40.     char * btnNames[3];
  41. } MsgTypeInfo;
  42.  
  43. #define NUM_TYPES 6
  44.  
  45. static MsgTypeInfo msgTypeInfo[NUM_TYPES] = {
  46.     {"abortretryignore", MB_ABORTRETRYIGNORE, 3, {"abort", "retry", "ignore"}},
  47.     {"ok",          MB_OK,           1, {"ok"                      }},
  48.     {"okcancel",     MB_OKCANCEL,          2, {"ok",    "cancel"         }},
  49.     {"retrycancel",     MB_RETRYCANCEL,      2, {"retry", "cancel"         }},
  50.     {"yesno",         MB_YESNO,          2, {"yes",   "no"             }},
  51.     {"yesnocancel",     MB_YESNOCANCEL,      3, {"yes",   "no",    "cancel"}}
  52. };
  53.  
  54. static int         GetFileName _ANSI_ARGS_((ClientData clientData,
  55.                     Tcl_Interp *interp, int argc, char **argv,
  56.                     int isOpen));
  57. static int         MakeFilter _ANSI_ARGS_((Tcl_Interp *interp,
  58.                     FILEDLG *fdlgPtr, char * string,
  59.                             FileFilterList *flistPtr));
  60. static int        ParseFileDlgArgs _ANSI_ARGS_((Tcl_Interp * interp,
  61.                     FILEDLG *fdlgPtr, int argc, char ** argv,
  62.                 int isOpen, HWND *hwndParent,
  63.                             FileFilterList *flistPtr));
  64. static int         ProcessError _ANSI_ARGS_((Tcl_Interp * interp,
  65.                 ERRORID lastError, HWND hWnd));
  66.  
  67. /*
  68.  *----------------------------------------------------------------------
  69.  *
  70.  * EvalArgv --
  71.  *
  72.  *    Invokes the Tcl procedure with the arguments. argv[0] is set by
  73.  *    the caller of this function. It may be different than cmdName.
  74.  *    The TCL command will see argv[0], not cmdName, as its name if it
  75.  *    invokes [lindex [info level 0] 0]
  76.  *
  77.  * Results:
  78.  *    TCL_ERROR if the command does not exist and cannot be autoloaded.
  79.  *    Otherwise, return the result of the evaluation of the command.
  80.  *
  81.  * Side effects:
  82.  *    The command may be autoloaded.
  83.  *
  84.  *----------------------------------------------------------------------
  85.  */
  86.  
  87. static int EvalArgv(interp, cmdName, argc, argv)
  88.     Tcl_Interp *interp;        /* Current interpreter. */
  89.     char * cmdName;        /* Name of the TCL command to call */
  90.     int argc;            /* Number of arguments. */
  91.     char **argv;        /* Argument strings. */
  92. {
  93.     Tcl_CmdInfo cmdInfo;
  94.  
  95.     if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
  96.     char * cmdArgv[2];
  97.  
  98.     /*
  99.      * This comand is not in the interpreter yet -- looks like we
  100.      * have to auto-load it
  101.      */
  102.     if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
  103.         Tcl_ResetResult(interp);
  104.         Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
  105.         NULL);
  106.         return TCL_ERROR;
  107.     }
  108.  
  109.     cmdArgv[0] = "auto_load";
  110.     cmdArgv[1] = cmdName;
  111.  
  112.     if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){ 
  113.         return TCL_ERROR;
  114.     }
  115.  
  116.     if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
  117.         Tcl_ResetResult(interp);
  118.         Tcl_AppendResult(interp, "cannot auto-load command \"",
  119.         cmdName, "\"",NULL);
  120.         return TCL_ERROR;
  121.     }
  122.     }
  123.  
  124.     return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
  125. }
  126.  
  127. /*
  128.  *----------------------------------------------------------------------
  129.  *
  130.  * Tk_ChooseColorCmd --
  131.  *
  132.  *    This procedure implements the color dialog box for the OS/2
  133.  *    platform. See the user documentation for details on what it
  134.  *    does.
  135.  *
  136.  * Results:
  137.  *    See user documentation.
  138.  *
  139.  * Side effects:
  140.  *    A dialog window is created the first time this procedure is called.
  141.  *    This window is not destroyed and will be reused the next time the
  142.  *    application invokes the "tk_chooseColor" command.
  143.  *
  144.  *----------------------------------------------------------------------
  145.  */
  146.  
  147. int
  148. Tk_ChooseColorCmd(clientData, interp, argc, argv)
  149.     ClientData clientData;    /* Main window associated with interpreter. */
  150.     Tcl_Interp *interp;        /* Current interpreter. */
  151.     int argc;            /* Number of arguments. */
  152.     char **argv;        /* Argument strings. */
  153. {
  154.     return EvalArgv(interp, "tkColorDialog", argc, argv);
  155. }
  156.  
  157. /*
  158.  *----------------------------------------------------------------------
  159.  *
  160.  * Tk_GetOpenFileCmd --
  161.  *
  162.  *    This procedure implements the "open file" dialog box for the
  163.  *    OS/2 platform. See the user documentation for details on what
  164.  *    it does.
  165.  *
  166.  * Results:
  167.  *    See user documentation.
  168.  *
  169.  * Side effects:
  170.  *    A dialog window is created the first this procedure is called.
  171.  *    This window is not destroyed and will be reused the next time
  172.  *    the application invokes the "tk_getOpenFile" or
  173.  *    "tk_getSaveFile" command.
  174.  *
  175.  *----------------------------------------------------------------------
  176.  */
  177.  
  178. int
  179. Tk_GetOpenFileCmd(clientData, interp, argc, argv)
  180.     ClientData clientData;    /* Main window associated with interpreter. */
  181.     Tcl_Interp *interp;        /* Current interpreter. */
  182.     int argc;            /* Number of arguments. */
  183.     char **argv;        /* Argument strings. */
  184. {
  185. /* "Unix look-and-feel"
  186.     return EvalArgv(interp, "tkFDialog", argc, argv);
  187. */
  188.     return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
  189. }
  190.  
  191. /*
  192.  *----------------------------------------------------------------------
  193.  *
  194.  * Tk_GetSaveFileCmd --
  195.  *
  196.  *    Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
  197.  *    instead
  198.  *
  199.  * Results:
  200.  *    Same as Tk_GetOpenFileCmd.
  201.  *
  202.  * Side effects:
  203.  *    Same as Tk_GetOpenFileCmd.
  204.  *
  205.  *----------------------------------------------------------------------
  206.  */
  207.  
  208. int
  209. Tk_GetSaveFileCmd(clientData, interp, argc, argv)
  210.     ClientData clientData;    /* Main window associated with interpreter. */
  211.     Tcl_Interp *interp;        /* Current interpreter. */
  212.     int argc;            /* Number of arguments. */
  213.     char **argv;        /* Argument strings. */
  214. {
  215. /* "Unix look-and-feel"
  216.     return EvalArgv(interp, "tkFDialog", argc, argv);
  217. */
  218.     return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
  219. }
  220.  
  221. /*
  222.  *----------------------------------------------------------------------
  223.  *
  224.  * GetFileName --
  225.  *
  226.  *    Create File Open or File Save Dialog.
  227.  *
  228.  * Results:
  229.  *    See user documentation.
  230.  *
  231.  * Side effects:
  232.  *    See user documentation.
  233.  *
  234.  *----------------------------------------------------------------------
  235.  */
  236.  
  237. static int GetFileName(clientData, interp, argc, argv, isOpen)
  238.     ClientData clientData;    /* Main window associated with interpreter. */
  239.     Tcl_Interp *interp;        /* Current interpreter. */
  240.     int argc;            /* Number of arguments. */
  241.     char **argv;        /* Argument strings. */
  242.     int isOpen;            /* true if we should open a file,
  243.                  * false if we should save a file */
  244. {
  245.     FILEDLG fileDlg;
  246.     int tclCode;
  247.     ULONG length = MAX_PATH+1;
  248.     ULONG curDrive, logical;
  249.     char buffer[MAX_PATH+1];
  250.     HWND hwndParent, hwndDlg;
  251.     ERRORID errorId = NO_ERROR;
  252.     FileFilterList flist;
  253.  
  254.     TkInitFileFilters(&flist);
  255.  
  256.     /*
  257.      * 1. Parse the arguments.
  258.      */
  259.     if (ParseFileDlgArgs(interp, &fileDlg, argc, argv, isOpen, &hwndParent,
  260.                          &flist) != TCL_OK) {
  261.         TkFreeFileFilters(&flist);
  262.     return TCL_ERROR;
  263.     }
  264.  
  265.     /*
  266.      * 2. Call the common dialog function.
  267.      */
  268.     rc = DosQueryCurrentDisk(&curDrive, &logical);
  269.     rc = DosQueryCurrentDir(0, (PBYTE)&buffer, &length);
  270.     TkOS2EnterModalLoop(interp);
  271.     hwndDlg = WinFileDlg(HWND_DESKTOP, hwndParent, &fileDlg);
  272.     if (fileDlg.lReturn == 0) {
  273.         errorId = WinGetLastError(hab);
  274.     }
  275.     TkOS2LeaveModalLoop(interp);
  276.     TkFreeFileFilters(&flist);
  277.     rc = DosSetDefaultDisk(curDrive);
  278.     rc = DosSetCurrentDir(buffer);
  279.  
  280.     if (fileDlg.papszITypeList) {
  281.     ckfree((char*)fileDlg.papszITypeList);
  282.     }
  283.     if (fileDlg.papszIDriveList) {
  284.     ckfree((char*)fileDlg.papszIDriveList);
  285.     }
  286.  
  287.     /*
  288.      * 3. Process the results.
  289.      */
  290.     if (hwndDlg && (fileDlg.lReturn == DID_OK)) {
  291.     char *p;
  292.     Tcl_ResetResult(interp);
  293.  
  294.     for (p = fileDlg.szFullFile; p && *p; p++) {
  295.         /*
  296.          * Change the pathname to the Tcl "normalized" pathname, where
  297.          * back slashes are used instead of forward slashes
  298.          */
  299.         if (*p == '\\') {
  300.         *p = '/';
  301.         }
  302.     }
  303.     Tcl_AppendResult(interp, fileDlg.szFullFile, NULL);
  304.     tclCode = TCL_OK;
  305.     } else {
  306.     if (fileDlg.lReturn == DID_CANCEL) {
  307.         /* User hit Cancel */
  308.         tclCode = TCL_OK;
  309.     } else {
  310.         tclCode = ProcessError(interp, errorId, hwndParent);
  311.     }
  312.     }
  313.  
  314.     return tclCode;
  315. }
  316.  
  317. /*
  318.  *----------------------------------------------------------------------
  319.  *
  320.  * ParseFileDlgArgs --
  321.  *
  322.  *    Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
  323.  *
  324.  * Results:
  325.  *    A standard TCL return value.
  326.  *
  327.  * Side effects:
  328.  *    The FILEDLG structure is initialized and modified according
  329.  *    to the arguments.
  330.  *
  331.  *----------------------------------------------------------------------
  332.  */
  333.  
  334. static int ParseFileDlgArgs(interp, fdlgPtr, argc, argv, isOpen, hwndParent,
  335.                             flistPtr)
  336.     Tcl_Interp * interp;    /* Current interpreter. */
  337.     FILEDLG *fdlgPtr;    /* Info about the file dialog */
  338.     int argc;            /* Number of arguments. */
  339.     char **argv;        /* Argument strings. */
  340.     int isOpen;            /* true if we should call GetOpenFileName(),
  341.                  * false if we should call GetSaveFileName() */
  342.     HWND *hwndParent;        /* Parent for dialog (output) */
  343.     FileFilterList *flistPtr;    /* Filters to be used */
  344. {
  345.     int i;
  346.     Tk_Window parent = Tk_MainWindow(interp);
  347.     int doneFilter = 0;
  348.     BOOL hadInitialFile = FALSE;
  349.  
  350.     /* Fill in the FILEDLG structure */
  351.     memset(fdlgPtr, 0, sizeof(FILEDLG));
  352.     fdlgPtr->cbSize = sizeof(FILEDLG);
  353.     if (isOpen) {
  354.         fdlgPtr->fl = FDS_OPEN_DIALOG | FDS_CENTER | FDS_ENABLEFILELB |
  355.                       FDS_FILTERUNION | FDS_PRELOAD_VOLINFO;
  356.     } else {
  357.         fdlgPtr->fl = FDS_SAVEAS_DIALOG | FDS_CENTER | FDS_ENABLEFILELB |
  358.                       FDS_FILTERUNION | FDS_PRELOAD_VOLINFO;
  359.     }
  360.  
  361.     for (i=1; i<argc; i+=2) {
  362.         int v = i+1;
  363.     int len = strlen(argv[i]);
  364.     char *defExt = "";
  365.  
  366.     if (strncmp(argv[i], "-defaultextension", len)==0) {
  367.         if (v==argc) {goto arg_missing;}
  368.  
  369. /*
  370.         fdlgPtr->lpstrDefExt = argv[v];
  371.             strcpy(fdlgPtr->szFullFile, argv[v]);
  372.             sprintf(fdlgPtr->szFullFile, "*%s", argv[v]);
  373. */
  374.         if (hadInitialFile) {
  375.             /* Add default extension if necessary */
  376.             if (strchr(fdlgPtr->szFullFile, '.') == NULL) {
  377.                 /* No extension given */
  378.                 strcat(fdlgPtr->szFullFile, argv[v]);
  379.             }
  380.         } else {
  381.             /* Remember for if we get an initialfile argument */
  382.             defExt = argv[v];
  383.         }
  384.     }
  385.     else if (strncmp(argv[i], "-filetypes", len)==0) {
  386.         if (v==argc) {goto arg_missing;}
  387.  
  388.         if (MakeFilter(interp, fdlgPtr, argv[v], flistPtr) != TCL_OK) {
  389.         return TCL_ERROR;
  390.         }
  391.         doneFilter = 1;
  392.     }
  393.     else if (strncmp(argv[i], "-initialdir", len)==0) {
  394.         ULONG diskNum;
  395.         if (v==argc) {goto arg_missing;}
  396.  
  397. /*
  398.         fdlgPtr->lpstrInitialDir = argv[v];
  399. */
  400.             diskNum = (ULONG) argv[v][0] - 'A' + 1;
  401.             if (argv[v][0] >= 'a') {
  402.                 diskNum -= ('a' - 'A');
  403.                 }
  404.             rc = DosSetDefaultDisk(diskNum);
  405.             rc = DosSetCurrentDir(argv[v] + 2);
  406.     }
  407.     else if (strncmp(argv[i], "-initialfile", len)==0) {
  408.         if (v==argc) {goto arg_missing;}
  409.  
  410.         hadInitialFile = TRUE;
  411.         strncpy(fdlgPtr->szFullFile, argv[v], MAX_PATH);
  412.         if (strchr(fdlgPtr->szFullFile, '.') == NULL) {
  413.             /* No extension given */
  414.             strcat(fdlgPtr->szFullFile, defExt);
  415.         }
  416.     }
  417.     else if (strncmp(argv[i], "-parent", len)==0) {
  418.         if (v==argc) {goto arg_missing;}
  419.  
  420.         parent = Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  421.         if (parent == NULL) {
  422.         return TCL_ERROR;
  423.         }
  424.     }
  425.     else if (strncmp(argv[i], "-title", len)==0) {
  426.         if (v==argc) {goto arg_missing;}
  427.  
  428.         fdlgPtr->pszTitle = argv[v];
  429.     }
  430.     else {
  431.             Tcl_AppendResult(interp, "unknown option \"", 
  432.         argv[i], "\", must be -defaultextension, ",
  433.         "-filetypes, -initialdir, -initialfile, -parent or -title",
  434.         NULL);
  435.         return TCL_ERROR;
  436.     }
  437.     }
  438.  
  439.     if (!doneFilter) {
  440.     if (MakeFilter(interp, fdlgPtr, "", flistPtr) != TCL_OK) {
  441.         return TCL_ERROR;
  442.     }
  443.     }
  444.  
  445.     if (Tk_WindowId(parent) == None) {
  446.     Tk_MakeWindowExist(parent);
  447.     }
  448.     *hwndParent = Tk_GetHWND(Tk_WindowId(parent));
  449.  
  450.     return TCL_OK;
  451.  
  452.   arg_missing:
  453.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  454.     NULL);
  455.     return TCL_ERROR;
  456. }
  457.  
  458. /*
  459.  *----------------------------------------------------------------------
  460.  *
  461.  * MakeFilter --
  462.  *
  463.  *    Allocate a buffer to store the filters and types in a format
  464.  *      understood by OS/2
  465.  *
  466.  * Results:
  467.  *    A standard TCL return value.
  468.  *
  469.  * Side effects:
  470.  *    fdlgPtr->pszIType, papszITypeList, szFullFile are modified.
  471.  *
  472.  *----------------------------------------------------------------------
  473.  */
  474. static int MakeFilter(interp, fdlgPtr, string, flistPtr) 
  475.     Tcl_Interp *interp;        /* Current interpreter. */
  476.     FILEDLG *fdlgPtr;    /* Info about the file dialog */
  477.     char *string;        /* String value of the -filetypes option */
  478.     FileFilterList *flistPtr;    /* Filters to be used */
  479. {
  480.     CHAR *filterStr;
  481.     char *p;
  482.     FileFilter *filterPtr;
  483.  
  484.     if (TkGetFileFilters(interp, flistPtr, string, 1) != TCL_OK) {
  485.     return TCL_ERROR;
  486.     }
  487.  
  488.     /*
  489.      * Since the full file name only contains CCHMAXPATH characters, we
  490.      * don't need (cannot) to allocate more space.
  491.      */
  492.     filterStr = (CHAR *) ckalloc(CCHMAXPATH);
  493.     if (filterStr == (CHAR *)NULL) {
  494.         return TCL_ERROR;
  495.     }
  496.  
  497.     if (flistPtr->filters == NULL) {
  498.     /*
  499.      * Use "All Files" (*.*) as the default filter is none is specified
  500.      */
  501.     char *defaultFilter = "*.*";
  502.  
  503.     strcpy(filterStr, defaultFilter);
  504.     } else {
  505.     /*
  506.      * We put the filter types in a table, and format the extension
  507.      * into the full filename field.
  508.      * BEWARE! Specifying the same extension twice gets you a crash
  509.      * in PMCTLS.DLL, so make sure that doesn't happen.
  510.      */
  511.  
  512.         char *sep;
  513.     int typeCounter;
  514.  
  515.     filterStr[0] = '\0';
  516.     /* Table of extended-attribute types, *END WITH NULL!* */
  517.         fdlgPtr->papszITypeList = (PAPSZ) ckalloc(flistPtr->numFilters *
  518.                                                   sizeof(PSZ) + 1);
  519.     if (fdlgPtr->papszITypeList == (PAPSZ)NULL) {
  520.             ckfree((char *)filterStr);
  521.         return TCL_ERROR;
  522.     }
  523.  
  524.         sep = "";
  525.     for (filterPtr = flistPtr->filters, typeCounter=0, p = filterStr;
  526.             filterPtr; filterPtr = filterPtr->next, typeCounter++) {
  527.         FileFilterClause *clausePtr;
  528.  
  529.         /*
  530.          *  First, put in the name of the file type
  531.          */
  532.         *(fdlgPtr->papszITypeList)[typeCounter] = (PSZ)filterPtr->name;
  533.  
  534.             /* We format the extensions in the filter pattern field */
  535.             for (clausePtr=filterPtr->clauses;clausePtr;
  536.                      clausePtr=clausePtr->next) {
  537.                 GlobPattern *globPtr;
  538.             
  539.                 for (globPtr=clausePtr->patterns; globPtr;
  540.                      globPtr=globPtr->next) {
  541.                     char *sub = strstr(filterStr, globPtr->pattern);
  542.                     /*
  543.                      * See if pattern is already in filterStr. Watch out for
  544.                      * it being there as a substring of another pattern!
  545.                      * eg. *.c is part of *.cpp
  546.                      */
  547.                     if (sub == NULL ||
  548.                         (*(sub+strlen(globPtr->pattern)) != ';' &&
  549.                          *(sub+strlen(globPtr->pattern)) != '\0')) {
  550. /*
  551. if (strncmp(globPtr->pattern, "*.*", 3) !=0 ) {
  552. */
  553.                         strcpy(p, sep);
  554.                         p+= strlen(sep);
  555.                         strcpy(p, globPtr->pattern);
  556.                         p+= strlen(globPtr->pattern);
  557.                         sep = ";";
  558. /*
  559. }
  560. */
  561.                     }
  562.                 }
  563.             }
  564.         }
  565.         /* End table with NULL! */
  566.     *(fdlgPtr->papszITypeList)[typeCounter] = (PSZ)NULL;
  567.         /* Don't specify initial type, so extensions can play too */
  568.     }
  569.  
  570.     if (strlen(fdlgPtr->szFullFile) == 0) {
  571.         strcpy(fdlgPtr->szFullFile, filterStr);
  572.     }
  573.     ckfree((char *)filterStr);
  574.  
  575.     return TCL_OK;
  576. }
  577.  
  578. /*
  579.  *----------------------------------------------------------------------
  580.  *
  581.  * Tk_MessageBoxCmd --
  582.  *
  583.  *    This procedure implements the MessageBox window for the
  584.  *    OS/2 platform. See the user documentation for details on what
  585.  *    it does.
  586.  *
  587.  * Results:
  588.  *    See user documentation.
  589.  *
  590.  * Side effects:
  591.  *    None. The MessageBox window will be destroy before this procedure
  592.  *    returns.
  593.  *
  594.  *----------------------------------------------------------------------
  595.  */
  596.  
  597. int
  598. Tk_MessageBoxCmd(clientData, interp, argc, argv)
  599.     ClientData clientData;    /* Main window associated with interpreter. */
  600.     Tcl_Interp *interp;        /* Current interpreter. */
  601.     int argc;            /* Number of arguments. */
  602.     char **argv;        /* Argument strings. */
  603. {
  604.     int flags;
  605.     Tk_Window parent = Tk_MainWindow(interp);
  606.     HWND hWnd;
  607.     char *message = "";
  608.     char *title = "";
  609.     int icon = MB_INFORMATION;
  610.     int type = MB_OK;
  611.     int i, j;
  612.     char *result;
  613.     int code;
  614.     char *defaultBtn = NULL;
  615.     int defaultBtnIdx = -1;
  616.  
  617.     for (i=1; i<argc; i+=2) {
  618.     int v = i+1;
  619.     int len = strlen(argv[i]);
  620.  
  621.     if (strncmp(argv[i], "-default", len)==0) {
  622.         if (v==argc) {goto arg_missing;}
  623.  
  624.         defaultBtn = argv[v];
  625.     }
  626.     else if (strncmp(argv[i], "-icon", len)==0) {
  627.         if (v==argc) {goto arg_missing;}
  628.  
  629.         if (strcmp(argv[v], "error") == 0) {
  630.         icon = MB_ERROR;
  631.         }
  632.         else if (strcmp(argv[v], "info") == 0) {
  633.         icon = MB_INFORMATION;
  634.         }
  635.         else if (strcmp(argv[v], "question") == 0) {
  636.         icon = MB_ICONQUESTION;
  637.         }
  638.         else if (strcmp(argv[v], "warning") == 0) {
  639.         icon = MB_WARNING;
  640.         }
  641.         else {
  642.             Tcl_AppendResult(interp, "invalid icon \"", argv[v],
  643.             "\", must be error, info, question or warning", NULL);
  644.         return TCL_ERROR;
  645.         }
  646.     }
  647.     else if (strncmp(argv[i], "-message", len)==0) {
  648.         if (v==argc) {goto arg_missing;}
  649.  
  650.         message = argv[v];
  651.     }
  652.     else if (strncmp(argv[i], "-parent", len)==0) {
  653.         if (v==argc) {goto arg_missing;}
  654.  
  655.         parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  656.         if (parent == NULL) {
  657.         return TCL_ERROR;
  658.         }
  659.     }
  660.     else if (strncmp(argv[i], "-title", len)==0) {
  661.         if (v==argc) {goto arg_missing;}
  662.  
  663.         title = argv[v];
  664.     }
  665.     else if (strncmp(argv[i], "-type", len)==0) {
  666.         int found = 0;
  667.  
  668.         if (v==argc) {goto arg_missing;}
  669.  
  670.         for (j=0; j<NUM_TYPES; j++) {
  671.         if (strcmp(argv[v], msgTypeInfo[j].name) == 0) {
  672.             type = msgTypeInfo[j].type;
  673.             found = 1;
  674.             break;
  675.         }
  676.         }
  677.         if (!found) {
  678.         Tcl_AppendResult(interp, "invalid message box type \"", 
  679.             argv[v], "\", must be abortretryignore, ok, ",
  680.             "okcancel, retrycancel, yesno or yesnocancel", NULL);
  681.         return TCL_ERROR;
  682.         }
  683.     }
  684.     else {
  685.             Tcl_AppendResult(interp, "unknown option \"", 
  686.         argv[i], "\", must be -default, -icon, ",
  687.         "-message, -parent, -title or -type", NULL);
  688.         return TCL_ERROR;
  689.     }
  690.     }
  691.  
  692.     /* Make sure we have a valid hWnd to act as the parent of this message box
  693.      */
  694.     if (Tk_WindowId(parent) == None) {
  695.     Tk_MakeWindowExist(parent);
  696.     }
  697.     hWnd = Tk_GetHWND(Tk_WindowId(parent));
  698.  
  699.     if (defaultBtn != NULL) {
  700.     for (i=0; i<NUM_TYPES; i++) {
  701.         if (type == msgTypeInfo[i].type) {
  702.         for (j=0; j<msgTypeInfo[i].numButtons; j++) {
  703.             if (strcmp(defaultBtn, msgTypeInfo[i].btnNames[j])==0) {
  704.                 defaultBtnIdx = j;
  705.             break;
  706.             }
  707.         }
  708.         if (defaultBtnIdx < 0) {
  709.             Tcl_AppendResult(interp, "invalid default button \"",
  710.             defaultBtn, "\"", NULL);
  711.             return TCL_ERROR;
  712.         }
  713.         break;
  714.         }
  715.     }
  716.  
  717.     switch (defaultBtnIdx) {
  718.       case 0: flags = MB_DEFBUTTON1; break;
  719.       case 1: flags = MB_DEFBUTTON2; break;
  720.       case 2: flags = MB_DEFBUTTON3; break;
  721.       /*
  722.       case 3: flags = MB_DEFBUTTON4; break;
  723.       */
  724.       default: flags = MB_DEFBUTTON1; break;
  725.     }
  726.     } else {
  727.     flags = 0;
  728.     }
  729.     
  730.     flags |= icon | type;
  731.     TkOS2EnterModalLoop(interp);
  732.     /* Windows Port uses SYSTEM modal dialog, I use application modal */
  733.     code = WinMessageBox(HWND_DESKTOP, hWnd, message, title, 0,
  734.                          flags|MB_APPLMODAL);
  735.     TkOS2LeaveModalLoop(interp);
  736.  
  737.     /* Format the result in string form */
  738.     switch (code) {
  739.       case MBID_ABORT:    result = "abort";  break;
  740.       case MBID_CANCEL:    result = "cancel"; break;
  741.       case MBID_IGNORE:    result = "ignore"; break;
  742.       case MBID_NO:    result = "no";     break;
  743.       case MBID_OK:    result = "ok";     break;
  744.       case MBID_RETRY:    result = "retry";  break;
  745.       case MBID_YES:    result = "yes";    break;
  746.       default:        result = "";
  747.     }
  748.  
  749.     Tcl_AppendResult(interp, result, NULL);
  750.     return TCL_OK;
  751.  
  752.   arg_missing:
  753.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  754.     NULL);
  755.     return TCL_ERROR;
  756. }
  757.  
  758. /*
  759.  *----------------------------------------------------------------------
  760.  *
  761.  * ProcessError --
  762.  *
  763.  *    This procedure gets called if a OS/2-specific error message
  764.  *    has occurred during the execution of a common dialog or the
  765.  *    user has pressed the CANCEL button.
  766.  *
  767.  * Results:
  768.  *    If an error has indeed happened, returns a standard TCL result
  769.  *    that reports the error code in string format. If the user has
  770.  *    pressed the CANCEL button (lastError == 0), resets
  771.  *    interp->result to the empty string.
  772.  *
  773.  * Side effects:
  774.  *    interp->result is changed.
  775.  *
  776.  *----------------------------------------------------------------------
  777.  */
  778. static int ProcessError(interp, lastError, hWnd)
  779.     Tcl_Interp * interp;        /* Current interpreter. */
  780.     ERRORID lastError;            /* The OS/2 PM-specific error code */
  781.     HWND hWnd;                /* window in which the error happened*/
  782. {
  783.     /*
  784.     char *string;
  785.     */
  786.     char string[257];
  787.  
  788.     Tcl_ResetResult(interp);
  789.  
  790.     switch(lastError) {
  791.       case 0:
  792.     return TCL_OK;
  793.  
  794.       default:
  795.     sprintf(string, "unknown error, %lx", (ULONG) lastError);
  796.     }
  797.  
  798.     Tcl_AppendResult(interp, "OS/2 internal error: ", string, NULL); 
  799.     return TCL_ERROR;
  800. }
  801.