home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcltk805.zip / tcl805s.zip / tk8.0.5 / os2 / tkOS2Dialog.c < prev    next >
C/C++ Source or Header  |  2001-09-08  |  44KB  |  1,393 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) 1999-2000 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 "TkResIds.h"
  18. #include "tkFileFilter.h"
  19.  
  20. /*
  21.  * Global variables
  22.  */
  23. static PFN colorSelectWndProcPtr = NULL;
  24. static PFNWP oldDlgProc = NULL;
  25. static ULONG chosenColor = 0;
  26.  
  27. #if ((TK_MAJOR_VERSION == 4) && (TK_MINOR_VERSION <= 2))
  28. /*
  29.  * The following function is implemented on tk4.3 and after only 
  30.  */
  31. #define Tk_GetHWND TkOS2GetHWND
  32. #endif
  33.  
  34. #define SAVE_FILE 0
  35. #define OPEN_FILE 1
  36.  
  37. /*----------------------------------------------------------------------
  38.  * MsgTypeInfo --
  39.  *
  40.  *    This structure stores the type of available message box in an
  41.  *    easy-to-process format. Used by the Tk_MessageBox() function
  42.  *----------------------------------------------------------------------
  43.  */
  44. typedef struct MsgTypeInfo {
  45.     char * name;
  46.     int type;
  47.     int numButtons;
  48.     char * btnNames[3];
  49. } MsgTypeInfo;
  50.  
  51. #define NUM_TYPES 6
  52.  
  53. static MsgTypeInfo
  54. msgTypeInfo[NUM_TYPES] = {
  55.     {"abortretryignore", MB_ABORTRETRYIGNORE, 3, {"abort", "retry", "ignore"}},
  56.     {"ok",          MB_OK,           1, {"ok"                      }},
  57.     {"okcancel",     MB_OKCANCEL,          2, {"ok",    "cancel"         }},
  58.     {"retrycancel",     MB_RETRYCANCEL,      2, {"retry", "cancel"         }},
  59.     {"yesno",         MB_YESNO,          2, {"yes",   "no"             }},
  60.     {"yesnocancel",     MB_YESNOCANCEL,      3, {"yes",   "no",    "cancel"}}
  61. };
  62.  
  63. static MRESULT EXPENTRY ColorDlgProc _ANSI_ARGS_((HWND hwnd, ULONG message,
  64.                             MPARAM param1, MPARAM param2));
  65. static int         GetFileName _ANSI_ARGS_((ClientData clientData,
  66.                     Tcl_Interp *interp, int argc, char **argv,
  67.                     int isOpen));
  68. static int         MakeFilter _ANSI_ARGS_((Tcl_Interp *interp,
  69.                     FILEDLG *fdlgPtr, char * string,
  70.                             FileFilterList *flistPtr));
  71. static int        ParseFileDlgArgs _ANSI_ARGS_((Tcl_Interp * interp,
  72.                     FILEDLG *fdlgPtr, int argc, char ** argv,
  73.                 int isOpen, HWND *hwndParent,
  74.                             FileFilterList *flistPtr));
  75. static int         ProcessError _ANSI_ARGS_((Tcl_Interp * interp,
  76.                 ERRORID lastError, HWND hWnd));
  77.  
  78. /*
  79.  *----------------------------------------------------------------------
  80.  *
  81.  * EvalArgv --
  82.  *
  83.  *    Invokes the Tcl procedure with the arguments. argv[0] is set by
  84.  *    the caller of this function. It may be different than cmdName.
  85.  *    The TCL command will see argv[0], not cmdName, as its name if it
  86.  *    invokes [lindex [info level 0] 0]
  87.  *
  88.  * Results:
  89.  *    TCL_ERROR if the command does not exist and cannot be autoloaded.
  90.  *    Otherwise, return the result of the evaluation of the command.
  91.  *
  92.  * Side effects:
  93.  *    The command may be autoloaded.
  94.  *
  95.  *----------------------------------------------------------------------
  96.  */
  97.  
  98. static int
  99. EvalArgv(interp, cmdName, argc, argv)
  100.     Tcl_Interp *interp;        /* Current interpreter. */
  101.     char * cmdName;        /* Name of the TCL command to call */
  102.     int argc;            /* Number of arguments. */
  103.     char **argv;        /* Argument strings. */
  104. {
  105.     Tcl_CmdInfo cmdInfo;
  106.  
  107.     if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
  108.     char * cmdArgv[2];
  109.  
  110.     /*
  111.      * This comand is not in the interpreter yet -- looks like we
  112.      * have to auto-load it
  113.      */
  114.     if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
  115.         Tcl_ResetResult(interp);
  116.         Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
  117.         NULL);
  118.         return TCL_ERROR;
  119.     }
  120.  
  121.     cmdArgv[0] = "auto_load";
  122.     cmdArgv[1] = cmdName;
  123.  
  124.     if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){ 
  125.         return TCL_ERROR;
  126.     }
  127.  
  128.     if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
  129.         Tcl_ResetResult(interp);
  130.         Tcl_AppendResult(interp, "cannot auto-load command \"",
  131.         cmdName, "\"",NULL);
  132.         return TCL_ERROR;
  133.     }
  134.     }
  135.  
  136.     return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
  137. }
  138.  
  139. /*
  140.  *----------------------------------------------------------------------
  141.  *
  142.  * Tk_ChooseColorCmd --
  143.  *
  144.  *    This procedure implements the color dialog box for the OS/2
  145.  *    platform. See the user documentation for details on what it
  146.  *    does.
  147.  *
  148.  * Results:
  149.  *    See user documentation.
  150.  *
  151.  * Side effects:
  152.  *    A dialog window is created the first time this procedure is called.
  153.  *    This window is not destroyed and will be reused the next time the
  154.  *    application invokes the "tk_chooseColor" command.
  155.  *
  156.  *----------------------------------------------------------------------
  157.  */
  158.  
  159. int
  160. Tk_ChooseColorCmd(clientData, interp, argc, argv)
  161.     ClientData clientData;    /* Main window associated with interpreter. */
  162.     Tcl_Interp *interp;        /* Current interpreter. */
  163.     int argc;            /* Number of arguments. */
  164.     char **argv;        /* Argument strings. */
  165. {
  166.     /*
  167.      * From Rick Papo's "Undocumented Features of OS/2" (INF file):
  168.      * The color wheel control used by the Solid and Mixed Color Palette
  169.      * object is a publicly registered window class within OS/2, but is
  170.      * undocumented.  The following notes are all that is necessary to
  171.      * use this control class:
  172.      * (1) You must load the module WPCONFIG.DLL so that the publicly
  173.      *     registered window message processor (colorSelectWndProc) can
  174.      *     be used without an addressing violation.
  175.      * (2) Create your control window with WinCreateWindow or through a
  176.      *     dialog template, using the window class name "ColorSelectClass".
  177.      * (3) If you used WinCreateWindow you will need to reposition the
  178.      *     control window each time the parent window is resized, as
  179.      *     otherwise the control will reposition itself out of view.
  180.      *     Dialogs seem to handle this automatically.
  181.      * (4) The only control message defined -to- the control is 0x0602
  182.      *     under OS/2 Warp 4 or later, or (by some reports) 0x1384 on
  183.      *     older versiosn of OS/2. Message parameter one must contain the
  184.      *     RGB value to which the color wheel will be set.
  185.      * (5) The only control message defined -from- the control is 0x0601
  186.      *     under OS/2 Warp 4 or later, or (by some reports) 0x130C on
  187.      *     older version of OS/2. Message parameter one will contain the
  188.      *     RGB value to which the color wheel will be set.
  189.      * (6) The control can only be sized at creation, and should be sized
  190.      *     so that its height is approximately 60% of its width.
  191.      */
  192.     HMODULE wpConfigHandle;
  193.     UCHAR loadError[256];       /* Area for name of DLL that we failed on */
  194.     Tk_Window parent = Tk_MainWindow(interp);
  195.     int oldMode;
  196.     char * colorStr = NULL;
  197.     char * title = NULL;
  198.     int i;
  199.     int tclCode;
  200.     ULONG ulReply;
  201.     ULONG startColor = 0L;
  202.     XColor * colorPtr = NULL;
  203.     static BOOL inited = FALSE;
  204.     static BOOL useOS2Dlg = FALSE;
  205.     static HWND hwndDlg = NULLHANDLE, hwndWheel = NULLHANDLE;
  206.     HWND hwndOwner;
  207.     static ULONG info[QSV_MAX]= {0};   /* System Information Data Buffer */
  208.  
  209. #ifdef VERBOSE
  210.     printf("Tk_ChooseColorCmd\n");
  211.     fflush(stdout);
  212. #endif
  213.  
  214.     /*
  215.      * 1. Parse the arguments
  216.      * We need to do this before creating the dialog, because we don't want
  217.      * a dialog thrown up and immediately removed again (or worse: staying)
  218.      * because of an error in the arguments.
  219.      */
  220.  
  221.     for (i=1; i<argc; i+=2) {
  222.         int v = i+1;
  223.         int len = strlen(argv[i]);
  224. #ifdef VERBOSE
  225.         printf("   argv[%d] [%s], argv[%d] [%s]\n", i, argv[i], i+1, argv[i+1]);
  226. #endif
  227.  
  228.         if (strncmp(argv[i], "-initialcolor", len)==0) {
  229.             if (v==argc) {goto arg_missing;}
  230.  
  231.             colorStr = argv[v];
  232.         }
  233.         else if (strncmp(argv[i], "-parent", len)==0) {
  234.             if (v==argc) {goto arg_missing;}
  235.  
  236.             parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  237.             if (parent == NULL) {
  238.                 return TCL_ERROR;
  239.             }
  240.         }
  241.         else if (strncmp(argv[i], "-title", len)==0) {
  242.             if (v==argc) {goto arg_missing;}
  243.  
  244.             title =  argv[v];
  245.         }
  246.         else {
  247. #ifdef VERBOSE
  248.         printf("    unknown option \"%s\", must be -initialcolor, -parent or -title", argv[i]);
  249. #endif
  250.             Tcl_AppendResult(interp, "unknown option \"",
  251.                 argv[i], "\", must be -initialcolor, -parent or -title",
  252.                 NULL);
  253.             return TCL_ERROR;
  254.         }
  255.     }
  256.     if (Tk_WindowId(parent) == None) {
  257.         Tk_MakeWindowExist(parent);
  258.     }
  259.     hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
  260. #ifdef VERBOSE
  261.     printf("    hwndOwner now %x\n", hwndOwner);
  262.     fflush(stdout);
  263. #endif
  264.  
  265.     if (!inited) {
  266.         inited = TRUE;
  267.         /* Load DLL to get access to it */
  268.         if (DosLoadModule((PSZ)loadError, sizeof(loadError), "WPCONFIG.DLL",
  269.                           &wpConfigHandle) != NO_ERROR) {
  270. #ifdef VERBOSE
  271.             printf("DosLoadModule WPCONFIG.DLL ERROR on %s\n", loadError);
  272.             fflush(stdout);
  273. #endif
  274.             goto fallback;
  275.         }
  276. #ifdef VERBOSE
  277.         printf("DosLoadModule WPCONFIG.DLL returned %x\n", wpConfigHandle);
  278.         fflush(stdout);
  279. #endif
  280.  
  281.         /* Get address of color selection window procedure */
  282.         rc = DosQueryProcAddr(wpConfigHandle, 0, "ColorSelectWndProc",
  283.                               &colorSelectWndProcPtr);
  284.         if (rc != NO_ERROR) {
  285. #ifdef VERBOSE
  286.             printf("DosQueryProcAddr %x ERROR %d\n", wpConfigHandle, rc);
  287.             fflush(stdout);
  288. #endif
  289.             goto fallback;
  290.         }
  291. #ifdef VERBOSE
  292.         printf("DosQueryProcAddr %x returned %x\n", wpConfigHandle,
  293.                colorSelectWndProcPtr);
  294.         printf("calling WinLoadDlg(H_D %x hOwn %x CDP %x hMod %x ID %x\n",
  295.                HWND_DESKTOP, hwndOwner, ColorDlgProc, Tk_GetHMODULE(),
  296.                ID_COLORDLGTEMPLATE);
  297.         fflush(stdout);
  298. #endif
  299.         /* Load the dialog around the color wheel from our Tk DLL */
  300.         hwndDlg = WinLoadDlg(HWND_DESKTOP, hwndOwner, WinDefDlgProc,
  301.                              Tk_GetHMODULE(), ID_COLORDLGTEMPLATE, NULL);
  302.         if (hwndDlg == NULLHANDLE) {
  303.             goto fallback;
  304.         }
  305. #ifdef VERBOSE
  306.         printf("WinLoadDlg hOwn %x hMod %x returned %x\n", hwndOwner,
  307.                Tk_GetHMODULE(), hwndDlg);
  308.         fflush(stdout);
  309. #endif
  310.         /* Subclass to get our own procedure in */
  311.         hwndWheel = WinWindowFromID(hwndDlg, ID_COLORWHEEL);
  312.         if (hwndWheel == NULLHANDLE) {
  313.             goto fallback;
  314. #ifdef VERBOSE
  315.             printf("WinWindowFromID ID_COLORWHEEL (%x) ERROR %x\n",
  316.                    ID_COLORWHEEL, WinGetLastError(TclOS2GetHAB()));
  317.             fflush(stdout);
  318.         } else {
  319.             printf("WinWindowFromID ID_COLORWHEEL (%x) OK: %x\n", ID_COLORWHEEL,
  320.                    hwndWheel);
  321.             fflush(stdout);
  322. #endif
  323.         }
  324.         oldDlgProc = WinSubclassWindow(hwndDlg, ColorDlgProc);
  325.         if (oldDlgProc == NULL) {
  326.             goto fallback;
  327. #ifdef VERBOSE
  328.             printf("WinSubclassWindow %x ERROR %x\n", hwndDlg,
  329.                    WinGetLastError(TclOS2GetHAB()));
  330.             fflush(stdout);
  331.         } else {
  332.             printf("WinSubclassWindow %x OK\n", hwndDlg);
  333.             fflush(stdout);
  334. #endif
  335.         }
  336.  
  337.         useOS2Dlg = TRUE;
  338.         rc= DosQuerySysInfo (1L, QSV_MAX, (PVOID)info, sizeof(info));
  339.     } else {
  340.         /*
  341.          * If we use the native color dialog and don't have to initialise,
  342.          * we have to reset the 'dismissed' dialog flag FF_DLGDISMISSED
  343.          */
  344.         if (useOS2Dlg) {
  345.             USHORT flags = WinQueryWindowUShort(hwndDlg, QWS_FLAGS);
  346.             rc = WinSetWindowUShort(hwndDlg, QWS_FLAGS,
  347.                                     flags & ~FF_DLGDISMISSED);
  348. #ifdef VERBOSE
  349.             if (rc != TRUE) {
  350.                 printf("WinSetWindowUShort FF_DLGDISMISSED ERROR %x\n",
  351.                        WinGetLastError(TclOS2GetHAB()));
  352.             } else {
  353.                 printf("WinSetWindowUShort FF_DLGDISMISSED OK\n");
  354.             }
  355.             fflush(stdout);
  356. #endif
  357.         }
  358.     }
  359.  
  360.     /* If no init necessary, go to Tcl code if we don't use the Dlg code */
  361.     if (!useOS2Dlg) goto fallback;
  362.  
  363.     if (title != NULL) {
  364.         /* Set title of dialog */
  365.         rc = WinSetWindowText(hwndDlg, title);
  366. #ifdef VERBOSE
  367.         if (rc != TRUE) {
  368.             printf("WinSetWindowText [%s] ERROR %x\n", title,
  369.                    WinGetLastError(TclOS2GetHAB()));
  370.         } else {
  371.             printf("WinSetWindowText [%s] OK\n", title);
  372.         }
  373.         fflush(stdout);
  374. #endif
  375.     }
  376.  
  377.     if (colorStr != NULL) {
  378.         colorPtr = Tk_GetColor(interp, Tk_MainWindow(interp), colorStr);
  379.         if (!colorPtr) {
  380.             return TCL_ERROR;
  381.         }
  382.         startColor = RGB((colorPtr->red/0x100), (colorPtr->green/0x100),
  383.                          (colorPtr->blue/0x100));
  384.         /* pre-"choose" the color */
  385.         chosenColor = startColor;
  386.     } else {
  387.         /* undo any previously chosen color */
  388.         chosenColor = 0L;
  389.     }
  390.  
  391.  
  392.     /*
  393.      * Set to previously chosen color.
  394.      * Hack for LX-versions above 2.11
  395.      *  OS/2 version    MAJOR MINOR
  396.      *  2.0             20    0
  397.      *  2.1             20    10
  398.      *  2.11            20    11
  399.      *  3.0             20    30
  400.      *  4.0             20    40
  401.      */
  402.     if (info[QSV_VERSION_MAJOR - 1] == 20 &&
  403.         info[QSV_VERSION_MINOR - 1] >= 40) {
  404.         /* Warp 4 or higher */
  405. #ifdef VERBOSE
  406.         printf("Warp 4 or higher => msg 0x602, startColor 0x%x\n", startColor);
  407.         fflush(stdout);
  408. #endif
  409.         WinSendMsg(hwndWheel, 0x0602, MPFROMLONG(0x8fff), MPVOID);
  410.         WinSendMsg(hwndWheel, 0x0602, MPFROMLONG(startColor), MPVOID);
  411.     } else {
  412.         /* 2.0 - 3.0 */
  413. #ifdef VERBOSE
  414.         printf("OS/2 2.0 - 3.0 => msg 0x1384, startColor 0x%x\n", startColor);
  415.         fflush(stdout);
  416. #endif
  417.         WinSendMsg(hwndWheel, 0x1384, MPFROMLONG(startColor), MPVOID);
  418.     }
  419.  
  420.     /*
  421.      * 2. Popup the dialog
  422.      */
  423.  
  424.     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  425.     ulReply = WinProcessDlg(hwndDlg);
  426. #ifdef VERBOSE
  427.     printf("WinProcessDlg hwndDlg %x returned 0x%x (%d)\n", hwndDlg, ulReply,
  428.            ulReply);
  429.     fflush(stdout);
  430. #endif
  431.     (void) Tcl_SetServiceMode(oldMode);
  432.  
  433.     /*
  434.      * Clear the interp result since anything may have happened during the
  435.      * modal loop.
  436.      */
  437.  
  438.     Tcl_ResetResult(interp);
  439.  
  440.     if (colorPtr) {
  441.         Tk_FreeColor(colorPtr);
  442.     }
  443.  
  444.     /*
  445.      * 3. Process the result of the dialog
  446.      */
  447.     switch (ulReply) {
  448.     case DID_OK:
  449.     case ID_OK: {
  450.         /*
  451.          * User has selected a color
  452.          */
  453.         char result[100];
  454.  
  455.         sprintf(result, "#%02x%02x%02x", GetRValue(chosenColor),
  456.                 GetGValue(chosenColor), GetBValue(chosenColor));
  457. #ifdef VERBOSE
  458.         printf("ulReply ID_OK, returning color %x (%s)\n", chosenColor, result);
  459.         fflush(stdout);
  460. #endif
  461.         Tcl_AppendResult(interp, result, NULL);
  462.         tclCode = TCL_OK;
  463.         break;
  464.     } 
  465.     case ID_TKVERSION:
  466. #ifdef VERBOSE
  467.         printf("ulReply ID_TKVERSION\n");
  468.         fflush(stdout);
  469. #endif
  470.         goto fallback;
  471.         break;
  472.     case DID_CANCEL:
  473.     case ID_CANCEL:
  474. #ifdef VERBOSE
  475.         printf("ulReply (D)ID_CANCEL\n");
  476.         fflush(stdout);
  477. #endif
  478.         tclCode = TCL_RETURN;
  479.         break;
  480.     default:
  481.         /*
  482.          * User probably pressed Cancel, or an error occurred
  483.          */
  484. #ifdef VERBOSE
  485.         printf("ulReply default for 0x%x\n", ulReply);
  486.         fflush(stdout);
  487. #endif
  488.         tclCode = ProcessError(interp, WinGetLastError(TclOS2GetHAB()),
  489.                                hwndOwner);
  490.     } /* of switch */
  491.  
  492.     return tclCode;
  493.  
  494.   arg_missing:
  495.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  496.         NULL);
  497.     return TCL_ERROR;
  498.  
  499.     /* Have a Tcl-code fallback in place: */
  500.   fallback:
  501.     return EvalArgv(interp, "tkColorDialog", argc, argv);
  502. }
  503.  
  504. /*
  505.  *----------------------------------------------------------------------
  506.  *
  507.  * ColorDlgProc --
  508.  *
  509.  *      This function is called by OS/2 PM whenever an event occurs on
  510.  *      a color dialog control created by Tk.
  511.  *
  512.  * Results:
  513.  *      Standard OS/2 PM return value.
  514.  *
  515.  * Side effects:
  516.  *      May generate events.
  517.  *
  518.  *----------------------------------------------------------------------
  519.  */
  520.  
  521. static MRESULT EXPENTRY
  522. ColorDlgProc(hwnd, message, param1, param2)
  523.     HWND hwnd;
  524.     ULONG message;
  525.     MPARAM param1;
  526.     MPARAM param2;
  527. {
  528.     MRESULT ret;
  529. #ifdef VERBOSE
  530.     printf("ColorDlgProc hwnd %x msg %x mp1 %x mp2 %x\n", hwnd, message, param1,
  531.            param2);
  532.     fflush(stdout);
  533. #endif
  534.     if (message == 0x0601 /* Warp 4 */ || message == 0x130C /* older */) {
  535.         chosenColor = LONGFROMMP(param1);
  536. #ifdef VERBOSE
  537.         printf("Message %x from color dialog, color %x\n", message,chosenColor);
  538.         fflush(stdout);
  539. #endif
  540.     }
  541.     ret = (MRESULT) oldDlgProc(hwnd, message, param1, param2);
  542. #ifdef VERBOSE
  543.     printf("oldDlgProc returned 0x%x (%d)\n", ret, ret);
  544.     fflush(stdout);
  545. #endif
  546.     return ret;
  547. }
  548.  
  549. /*
  550.  *----------------------------------------------------------------------
  551.  *
  552.  * Tk_GetOpenFileCmd --
  553.  *
  554.  *    This procedure implements the "open file" dialog box for the
  555.  *    OS/2 platform. See the user documentation for details on what
  556.  *    it does.
  557.  *
  558.  * Results:
  559.  *    See user documentation.
  560.  *
  561.  * Side effects:
  562.  *    A dialog window is created the first this procedure is called.
  563.  *    This window is not destroyed and will be reused the next time
  564.  *    the application invokes the "tk_getOpenFile" or
  565.  *    "tk_getSaveFile" command.
  566.  *
  567.  *----------------------------------------------------------------------
  568.  */
  569.  
  570. int
  571. Tk_GetOpenFileCmd(clientData, interp, argc, argv)
  572.     ClientData clientData;    /* Main window associated with interpreter. */
  573.     Tcl_Interp *interp;        /* Current interpreter. */
  574.     int argc;            /* Number of arguments. */
  575.     char **argv;        /* Argument strings. */
  576. {
  577.     /* "Unix look-and-feel"
  578.     return EvalArgv(interp, "tkFDialog", argc, argv);
  579.     */
  580.     /* OS/2 look-and-feel */
  581.     return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
  582. }
  583.  
  584. /*
  585.  *----------------------------------------------------------------------
  586.  *
  587.  * Tk_GetSaveFileCmd --
  588.  *
  589.  *    Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
  590.  *    instead
  591.  *
  592.  * Results:
  593.  *    Same as Tk_GetOpenFileCmd.
  594.  *
  595.  * Side effects:
  596.  *    Same as Tk_GetOpenFileCmd.
  597.  *
  598.  *----------------------------------------------------------------------
  599.  */
  600.  
  601. int
  602. Tk_GetSaveFileCmd(clientData, interp, argc, argv)
  603.     ClientData clientData;    /* Main window associated with interpreter. */
  604.     Tcl_Interp *interp;        /* Current interpreter. */
  605.     int argc;            /* Number of arguments. */
  606.     char **argv;        /* Argument strings. */
  607. {
  608.     /* "Unix look-and-feel"
  609.     return EvalArgv(interp, "tkFDialog", argc, argv);
  610.     */
  611.     /* OS/2 look-and-feel */
  612.     return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
  613. }
  614.  
  615. /*
  616.  *----------------------------------------------------------------------
  617.  *
  618.  * GetFileName --
  619.  *
  620.  *    Create File Open or File Save Dialog.
  621.  *
  622.  * Results:
  623.  *    See user documentation.
  624.  *
  625.  * Side effects:
  626.  *    See user documentation.
  627.  *
  628.  *----------------------------------------------------------------------
  629.  */
  630.  
  631. static int
  632. GetFileName(clientData, interp, argc, argv, isOpen)
  633.     ClientData clientData;    /* Main window associated with interpreter. */
  634.     Tcl_Interp *interp;        /* Current interpreter. */
  635.     int argc;            /* Number of arguments. */
  636.     char **argv;        /* Argument strings. */
  637.     int isOpen;            /* true if we should open a file,
  638.                  * false if we should save a file */
  639. {
  640.     FILEDLG fileDlg;
  641.     int tclCode, oldMode;
  642.     ULONG length = MAX_PATH+1;
  643.     ULONG curDrive, logical;
  644.     char buffer[MAX_PATH+1];
  645.     HWND hwndParent, hwndDlg;
  646.     ERRORID errorId = NO_ERROR;
  647.     FileFilterList flist;
  648.  
  649. #ifdef VERBOSE
  650.     printf("GetFileName\n");
  651.     fflush(stdout);
  652. #endif
  653.     
  654.     TkInitFileFilters(&flist);
  655.  
  656.     /*
  657.      * 1. Parse the arguments.
  658.      */
  659.     if (ParseFileDlgArgs(interp, &fileDlg, argc, argv, isOpen, &hwndParent,
  660.                          &flist) != TCL_OK) {
  661.         TkFreeFileFilters(&flist);
  662.     return TCL_ERROR;
  663.     }
  664. #ifdef VERBOSE
  665.     for (tclCode = 0; tclCode < flist.numFilters; tclCode++) {
  666.         printf("Type %d [%s]\n", tclCode, *(fileDlg.papszITypeList)[tclCode]);
  667.         fflush(stdout);
  668.     }
  669. #endif
  670.  
  671.     /*
  672.      * 2. Call the common dialog function.
  673.      */
  674.     rc = DosQueryCurrentDisk(&curDrive, &logical);
  675. #ifdef VERBOSE
  676.     if (rc != NO_ERROR) {
  677.         printf("DosQueryCurrentDisk ERROR %d\n", rc);
  678.         fflush(stdout);
  679.     } else {
  680.         printf("DosQueryCurrentDisk OK\n");
  681.         fflush(stdout);
  682.     }
  683. #endif
  684.     rc = DosQueryCurrentDir(0, (PBYTE)&buffer, &length);
  685. #ifdef VERBOSE
  686.     if (rc != NO_ERROR) {
  687.         printf("DosQueryCurrentDir ERROR %d\n", rc);
  688.         fflush(stdout);
  689.     } else {
  690.         printf("DosQueryCurrentDir OK\n");
  691.         fflush(stdout);
  692.     }
  693. #endif
  694.  
  695.     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  696.     hwndDlg = WinFileDlg(HWND_DESKTOP, hwndParent, &fileDlg);
  697.     (void) Tcl_SetServiceMode(oldMode);
  698.  
  699. #ifdef VERBOSE
  700.     printf("fileDlg.lReturn %x\n", fileDlg.lReturn);
  701. #endif
  702.     if (fileDlg.lReturn == 0) {
  703.         errorId = WinGetLastError(TclOS2GetHAB());
  704.     }
  705.     TkFreeFileFilters(&flist);
  706.     rc = DosSetDefaultDisk(curDrive);
  707.     rc = DosSetCurrentDir(buffer);
  708.  
  709.     /*
  710.      * Clear the interp result since anything may have happened during the
  711.      * modal loop.
  712.      */
  713.  
  714.     Tcl_ResetResult(interp);
  715.  
  716.     if (fileDlg.papszITypeList) {
  717.     ckfree((char*)fileDlg.papszITypeList);
  718.     }
  719.     if (fileDlg.papszIDriveList) {
  720.     ckfree((char*)fileDlg.papszIDriveList);
  721.     }
  722.  
  723.     /*
  724.      * 3. Process the results.
  725.      */
  726.     if (hwndDlg && (fileDlg.lReturn == DID_OK)) {
  727.     char *p;
  728.     Tcl_ResetResult(interp);
  729.  
  730.     for (p = fileDlg.szFullFile; p && *p; p++) {
  731.         /*
  732.          * Change the pathname to the Tcl "normalized" pathname, where
  733.          * back slashes are used instead of forward slashes
  734.          */
  735.         if (*p == '\\') {
  736.         *p = '/';
  737.         }
  738.     }
  739.     Tcl_AppendResult(interp, fileDlg.szFullFile, NULL);
  740.     tclCode = TCL_OK;
  741.     } else {
  742.     if (fileDlg.lReturn == DID_CANCEL) {
  743.         /* User hit Cancel */
  744.         tclCode = TCL_OK;
  745.     } else {
  746.         tclCode = ProcessError(interp, errorId, hwndParent);
  747.     }
  748.     }
  749.  
  750.     return tclCode;
  751. }
  752.  
  753. /*
  754.  *----------------------------------------------------------------------
  755.  *
  756.  * ParseFileDlgArgs --
  757.  *
  758.  *    Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
  759.  *
  760.  * Results:
  761.  *    A standard TCL return value.
  762.  *
  763.  * Side effects:
  764.  *    The FILEDLG structure is initialized and modified according
  765.  *    to the arguments.
  766.  *
  767.  *----------------------------------------------------------------------
  768.  */
  769.  
  770. static int
  771. ParseFileDlgArgs(interp, fdlgPtr, argc, argv, isOpen, hwndParent, flistPtr)
  772.     Tcl_Interp * interp;    /* Current interpreter. */
  773.     FILEDLG *fdlgPtr;    /* Info about the file dialog */
  774.     int argc;            /* Number of arguments. */
  775.     char **argv;        /* Argument strings. */
  776.     int isOpen;            /* true if we should call GetOpenFileName(),
  777.                  * false if we should call GetSaveFileName() */
  778.     HWND *hwndParent;        /* Parent for dialog (output) */
  779.     FileFilterList *flistPtr;    /* Filters to be used */
  780. {
  781.     int i;
  782.     Tk_Window parent = Tk_MainWindow(interp);
  783.     int doneFilter = 0;
  784.     BOOL hadInitialFile = FALSE;
  785.     Tcl_DString buffer;
  786.  
  787. #ifdef VERBOSE
  788.     printf("ParseFileDlgArgs\n");
  789.     fflush(stdout);
  790. #endif
  791.  
  792.     /* Fill in the FILEDLG structure */
  793.     memset(fdlgPtr, 0, sizeof(FILEDLG));
  794.     fdlgPtr->cbSize = sizeof(FILEDLG);
  795.     if (isOpen) {
  796.         fdlgPtr->fl = FDS_OPEN_DIALOG | FDS_CENTER | FDS_ENABLEFILELB |
  797.                       FDS_FILTERUNION | FDS_PRELOAD_VOLINFO;
  798.     } else {
  799.         fdlgPtr->fl = FDS_SAVEAS_DIALOG | FDS_CENTER | FDS_ENABLEFILELB |
  800.                       FDS_FILTERUNION | FDS_PRELOAD_VOLINFO;
  801.     }
  802. #ifdef 0
  803.     fdlgPtr->pszTitle        = (PSZ)NULL;    /* filled in below */
  804.     fdlgPtr->pszOKButton     = (PSZ)NULL;    /* use default text */
  805.     fdlgPtr->pfnDlgProc      = (PFNWP)NULL;    /* No subclassing */
  806.     fdlgPtr->pszIType        = (PSZ)NULL;    /* no EA filter */
  807.     fdlgPtr->papszITypeList  = (PAPSZ)NULL;    /* no EA filter table */
  808.     fdlgPtr->pszIDrive       = (PSZ)NULL;    /* no initial drive */
  809.     fdlgPtr->papszIDriveList = (PAPSZ)NULL;    /* no drive table */
  810.     fdlgPtr->hMod            = NULLHANDLE;    /* no custom dlg module */
  811.     fdlgPtr->szFullFile[0]   = '\0';
  812.     fdlgPtr->papszFQFilename = (PAPSZ)NULL;    /* No multiple selection */
  813.     fdlgPtr->ulFQFCount      = 1;        /* Single file selection */
  814.     /* PM Guide and Reference says 'usDlgID', but EMX defines 'usDlgId' */
  815.     fdlgPtr->usDlgId         = 0;        /* No custom Dialog ID */
  816.     fdlgPtr->x               = 0;        /* Initial X (overridden) */
  817.     fdlgPtr->y               = 0;        /* Initial Y (overridden) */
  818.     fdlgPtr->sEAType         = 0;        /* no selected EA */
  819. #endif
  820.  
  821.     /* We have to check these ourselves in OS/2 */
  822.     /*
  823.     if (isOpen) {
  824.     fdlgPtr->Flags |= OFN_FILEMUSTEXIST;
  825.     } else {
  826.     fdlgPtr->Flags |= OFN_OVERWRITEPROMPT;
  827.     }
  828.     */
  829.  
  830.     for (i=1; i<argc; i+=2) {
  831.         int v = i+1;
  832.     int len = strlen(argv[i]);
  833.     char *defExt = "";
  834.  
  835. #ifdef VERBOSE
  836.         printf("Arg %d [%s] %d [%s]\n", i, argv[i], v, argv[v]);
  837.         fflush(stdout);
  838. #endif
  839.     if (strncmp(argv[i], "-defaultextension", len)==0) {
  840.         if (v==argc) {goto arg_missing;}
  841.  
  842. /*
  843.         fdlgPtr->lpstrDefExt = argv[v];
  844.             strcpy(fdlgPtr->szFullFile, argv[v]);
  845.             sprintf(fdlgPtr->szFullFile, "*%s", argv[v]);
  846. */
  847. #ifdef VERBOSE
  848.             printf("defaultextension %s\n", argv[v]);
  849.             fflush(stdout);
  850. #endif
  851.         if (hadInitialFile) {
  852.             /* Add default extension if necessary */
  853.             if (strchr(fdlgPtr->szFullFile, '.') == NULL) {
  854.                 /* No extension given */
  855. #ifdef VERBOSE
  856.                     printf("initialfile %s, strcat %s\n", fdlgPtr->szFullFile,
  857.                            argv[v]);
  858.                     fflush(stdout);
  859. #endif
  860.                 strcat(fdlgPtr->szFullFile, argv[v]);
  861.             }
  862.         } else {
  863.             /* Remember for if we get an initialfile argument */
  864.             defExt = argv[v];
  865.         }
  866.     }
  867.     else if (strncmp(argv[i], "-filetypes", len)==0) {
  868.         if (v==argc) {goto arg_missing;}
  869.  
  870.         if (MakeFilter(interp, fdlgPtr, argv[v], flistPtr) != TCL_OK) {
  871.         return TCL_ERROR;
  872.         }
  873.         doneFilter = 1;
  874.     }
  875.     else if (strncmp(argv[i], "-initialdir", len)==0) {
  876.         ULONG diskNum;
  877.         if (v==argc) {goto arg_missing;}
  878.  
  879.         if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
  880.             return TCL_ERROR;
  881.             }
  882.  
  883. /*
  884.         fdlgPtr->lpstrInitialDir = argv[v];
  885. */
  886.             diskNum = (ULONG) Tcl_DStringValue(&buffer)[0] - 'A' + 1;
  887.             if (argv[v][0] >= 'a') {
  888.                 diskNum -= ('a' - 'A');
  889.                 }
  890.             rc = DosSetDefaultDisk(diskNum);
  891. #ifdef VERBOSE
  892.             if (rc != NO_ERROR) {
  893.                 printf("DosSetDefaultDisk %c (%d) ERROR %d\n", argv[v][0],
  894.                        diskNum, rc);
  895.                 fflush(stdout);
  896.             } else {
  897.                 printf("DosSetDefaultDisk %c (%d) OK\n", argv[v][0], diskNum);
  898.                 fflush(stdout);
  899.             }
  900. #endif
  901.             rc = DosSetCurrentDir(Tcl_DStringValue(&buffer) + 2);
  902. #ifdef VERBOSE
  903.             if (rc != NO_ERROR) {
  904.                 printf("DosSetCurrentDir %s ERROR %d\n",
  905.                Tcl_DStringValue(&buffer)+2, rc);
  906.                 fflush(stdout);
  907.             } else {
  908.                 printf("DosSetCurrentDir %s OK\n", Tcl_DStringValue(&buffer)+2);
  909.                 fflush(stdout);
  910.             }
  911. #endif
  912.         Tcl_DStringFree(&buffer);
  913.     }
  914.     else if (strncmp(argv[i], "-initialfile", len)==0) {
  915.         if (v==argc) {goto arg_missing;}
  916.  
  917.         if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
  918.             return TCL_ERROR;
  919.             }
  920.         hadInitialFile = TRUE;
  921.         strcpy(fdlgPtr->szFullFile, Tcl_DStringValue(&buffer));
  922.         Tcl_DStringFree(&buffer);
  923.         if (strchr(fdlgPtr->szFullFile, '.') == NULL) {
  924.             /* No extension given */
  925. #ifdef VERBOSE
  926.                 printf("initialfile %s, strcat %s\n", argv[v], defExt);
  927.                 fflush(stdout);
  928. #endif
  929.             strcat(fdlgPtr->szFullFile, defExt);
  930.         }
  931.     }
  932.     else if (strncmp(argv[i], "-parent", len)==0) {
  933.         if (v==argc) {goto arg_missing;}
  934.  
  935.         parent = Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  936.         if (parent == NULL) {
  937.         return TCL_ERROR;
  938.         }
  939.     }
  940.     else if (strncmp(argv[i], "-title", len)==0) {
  941.         if (v==argc) {goto arg_missing;}
  942.  
  943.         fdlgPtr->pszTitle = argv[v];
  944.     }
  945.     else {
  946.             Tcl_AppendResult(interp, "unknown option \"", 
  947.         argv[i], "\", must be -defaultextension, ",
  948.         "-filetypes, -initialdir, -initialfile, -parent or -title",
  949.         NULL);
  950.         return TCL_ERROR;
  951.     }
  952.     }
  953.  
  954.     if (!doneFilter) {
  955.     if (MakeFilter(interp, fdlgPtr, "", flistPtr) != TCL_OK) {
  956.         return TCL_ERROR;
  957.     }
  958.     }
  959.  
  960.     if (Tk_WindowId(parent) == None) {
  961.     Tk_MakeWindowExist(parent);
  962.     }
  963.     *hwndParent = Tk_GetHWND(Tk_WindowId(parent));
  964.  
  965.     return TCL_OK;
  966.  
  967.   arg_missing:
  968.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  969.     NULL);
  970.     return TCL_ERROR;
  971. }
  972.  
  973. /*
  974.  *----------------------------------------------------------------------
  975.  *
  976.  * MakeFilter --
  977.  *
  978.  *    Allocate a buffer to store the filters and types in a format
  979.  *      understood by OS/2
  980.  *
  981.  * Results:
  982.  *    A standard TCL return value.
  983.  *
  984.  * Side effects:
  985.  *    fdlgPtr->pszIType, papszITypeList, szFullFile are modified.
  986.  *
  987.  *----------------------------------------------------------------------
  988.  */
  989. static int MakeFilter(interp, fdlgPtr, string, flistPtr) 
  990.     Tcl_Interp *interp;        /* Current interpreter. */
  991.     FILEDLG *fdlgPtr;    /* Info about the file dialog */
  992.     char *string;        /* String value of the -filetypes option */
  993.     FileFilterList *flistPtr;    /* Filters to be used */
  994. {
  995.     CHAR *filterStr;
  996.     char *p;
  997.     FileFilter *filterPtr;
  998.  
  999.     if (TkGetFileFilters(interp, flistPtr, string, 1) != TCL_OK) {
  1000. #ifdef VERBOSE
  1001.         printf("MakeFilter, TkGetFileFilters failed\n");
  1002.         fflush(stdout);
  1003. #endif
  1004.     return TCL_ERROR;
  1005.     }
  1006.  
  1007. #ifdef VERBOSE
  1008.     printf("MakeFilter, %d filter(s): %s\n", flistPtr->numFilters, string);
  1009.     fflush(stdout);
  1010. #endif
  1011.  
  1012.     /*
  1013.      * Since the full file name only contains CCHMAXPATH characters, we
  1014.      * don't need (cannot) to allocate more space.
  1015.      */
  1016.     filterStr = (CHAR *) ckalloc(CCHMAXPATH);
  1017.     if (filterStr == (CHAR *)NULL) {
  1018.         return TCL_ERROR;
  1019.     }
  1020.  
  1021.     if (flistPtr->filters == NULL) {
  1022.     /*
  1023.      * Use "All Files" (*.*) as the default filter is none is specified
  1024.      */
  1025.     char *defaultFilter = "*.*";
  1026.  
  1027.     strcpy(filterStr, defaultFilter);
  1028. #ifdef VERBOSE
  1029.         printf("    default filter %s\n", defaultFilter);
  1030.         fflush(stdout);
  1031. #endif
  1032.     } else {
  1033.     /*
  1034.      * We put the filter types in a table, and format the extension
  1035.      * into the full filename field.
  1036.      * BEWARE! Specifying the same extension twice gets you a crash
  1037.      * in PMCTLS.DLL, so make sure that doesn't happen.
  1038.      */
  1039.  
  1040.         char *sep;
  1041.     int typeCounter;
  1042.  
  1043.     filterStr[0] = '\0';
  1044.     /* Table of extended-attribute types, *END WITH NULL!* */
  1045.         fdlgPtr->papszITypeList = (PAPSZ) ckalloc(flistPtr->numFilters *
  1046.                                                   sizeof(PSZ) + 1);
  1047.     if (fdlgPtr->papszITypeList == (PAPSZ)NULL) {
  1048.             ckfree((char *)filterStr);
  1049.         return TCL_ERROR;
  1050.     }
  1051.  
  1052.         sep = "";
  1053.     for (filterPtr = flistPtr->filters, typeCounter=0, p = filterStr;
  1054.             filterPtr; filterPtr = filterPtr->next, typeCounter++) {
  1055.         FileFilterClause *clausePtr;
  1056.  
  1057.         /*
  1058.          *  First, put in the name of the file type
  1059.          */
  1060.         *(fdlgPtr->papszITypeList)[typeCounter] = (PSZ)filterPtr->name;
  1061. #ifdef VERBOSE
  1062.             printf("    adding type %s\n", filterPtr->name);
  1063.             fflush(stdout);
  1064. #endif
  1065.  
  1066.             /* We format the extensions in the filter pattern field */
  1067.             for (clausePtr=filterPtr->clauses;clausePtr;
  1068.                      clausePtr=clausePtr->next) {
  1069.                 GlobPattern *globPtr;
  1070.             
  1071.                 for (globPtr=clausePtr->patterns; globPtr;
  1072.                      globPtr=globPtr->next) {
  1073.                     char *sub = strstr(filterStr, globPtr->pattern);
  1074.                     /*
  1075.                      * See if pattern is already in filterStr. Watch out for
  1076.                      * it being there as a substring of another pattern!
  1077.                      * eg. *.c is part of *.cpp
  1078.                      */
  1079.                     if (sub == NULL ||
  1080.                         (*(sub+strlen(globPtr->pattern)) != ';' &&
  1081.                          *(sub+strlen(globPtr->pattern)) != '\0')) {
  1082. /*
  1083. if (strncmp(globPtr->pattern, "*.*", 3) !=0 ) {
  1084. */
  1085.                         strcpy(p, sep);
  1086.                         p+= strlen(sep);
  1087.                         strcpy(p, globPtr->pattern);
  1088. #ifdef VERBOSE
  1089.                         printf("    adding pattern %s, filterStr %s\n",
  1090.                                globPtr->pattern, filterStr);
  1091.                         fflush(stdout);
  1092. #endif
  1093.                         p+= strlen(globPtr->pattern);
  1094.                         sep = ";";
  1095. /*
  1096. }
  1097. */
  1098.                     }
  1099. #ifdef VERBOSE
  1100.                       else {
  1101.                         printf("not re-adding pattern %s\n", globPtr->pattern);
  1102.                     }
  1103. #endif
  1104.                 }
  1105.             }
  1106.         }
  1107.         /* End table with NULL! */
  1108.     *(fdlgPtr->papszITypeList)[typeCounter] = (PSZ)NULL;
  1109.         /* Don't specify initial type, so extensions can play too */
  1110.     }
  1111.  
  1112.     if (strlen(fdlgPtr->szFullFile) == 0) {
  1113.         strcpy(fdlgPtr->szFullFile, filterStr);
  1114.     }
  1115.     ckfree((char *)filterStr);
  1116.  
  1117.     return TCL_OK;
  1118. }
  1119.  
  1120. /*
  1121.  *----------------------------------------------------------------------
  1122.  *
  1123.  * Tk_MessageBoxCmd --
  1124.  *
  1125.  *    This procedure implements the MessageBox window for the
  1126.  *    OS/2 platform. See the user documentation for details on what
  1127.  *    it does.
  1128.  *
  1129.  * Results:
  1130.  *    See user documentation.
  1131.  *
  1132.  * Side effects:
  1133.  *    None. The MessageBox window will be destroy before this procedure
  1134.  *    returns.
  1135.  *
  1136.  *----------------------------------------------------------------------
  1137.  */
  1138.  
  1139. int
  1140. Tk_MessageBoxCmd(clientData, interp, argc, argv)
  1141.     ClientData clientData;    /* Main window associated with interpreter. */
  1142.     Tcl_Interp *interp;        /* Current interpreter. */
  1143.     int argc;            /* Number of arguments. */
  1144.     char **argv;        /* Argument strings. */
  1145. {
  1146.     int flags;
  1147.     Tk_Window parent = Tk_MainWindow(interp);
  1148.     HWND hWnd;
  1149.     char *message = "";
  1150.     char *title = "";
  1151.     int icon = MB_INFORMATION;
  1152.     int type = MB_OK;
  1153.     int i, j;
  1154.     char *result;
  1155.     int code, oldMode;
  1156.     char *defaultBtn = NULL;
  1157.     int defaultBtnIdx = -1;
  1158.  
  1159. #ifdef VERBOSE
  1160.     printf("Tk_MessageBoxCmd\n");
  1161. #endif
  1162.  
  1163.     for (i=1; i<argc; i+=2) {
  1164.     int v = i+1;
  1165.     int len = strlen(argv[i]);
  1166.  
  1167.     if (strncmp(argv[i], "-default", len)==0) {
  1168.         if (v==argc) {goto arg_missing;}
  1169.  
  1170.         defaultBtn = argv[v];
  1171.     }
  1172.     else if (strncmp(argv[i], "-icon", len)==0) {
  1173.         if (v==argc) {goto arg_missing;}
  1174.  
  1175.         if (strcmp(argv[v], "error") == 0) {
  1176.         icon = MB_ERROR;
  1177.         }
  1178.         else if (strcmp(argv[v], "info") == 0) {
  1179.         icon = MB_INFORMATION;
  1180.         }
  1181.         else if (strcmp(argv[v], "question") == 0) {
  1182.         icon = MB_ICONQUESTION;
  1183.         }
  1184.         else if (strcmp(argv[v], "warning") == 0) {
  1185.         icon = MB_WARNING;
  1186.         }
  1187.         else {
  1188.             Tcl_AppendResult(interp, "invalid icon \"", argv[v],
  1189.             "\", must be error, info, question or warning", NULL);
  1190.         return TCL_ERROR;
  1191.         }
  1192.     }
  1193.     else if (strncmp(argv[i], "-message", len)==0) {
  1194.         if (v==argc) {goto arg_missing;}
  1195.  
  1196.         message = argv[v];
  1197.     }
  1198.     else if (strncmp(argv[i], "-parent", len)==0) {
  1199.         if (v==argc) {goto arg_missing;}
  1200.  
  1201.         parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
  1202.         if (parent == NULL) {
  1203.         return TCL_ERROR;
  1204.         }
  1205.     }
  1206.     else if (strncmp(argv[i], "-title", len)==0) {
  1207.         if (v==argc) {goto arg_missing;}
  1208.  
  1209.         title = argv[v];
  1210.     }
  1211.     else if (strncmp(argv[i], "-type", len)==0) {
  1212.         int found = 0;
  1213.  
  1214.         if (v==argc) {goto arg_missing;}
  1215.  
  1216.         for (j=0; j<NUM_TYPES; j++) {
  1217.         if (strcmp(argv[v], msgTypeInfo[j].name) == 0) {
  1218.             type = msgTypeInfo[j].type;
  1219.             found = 1;
  1220.             break;
  1221.         }
  1222.         }
  1223.         if (!found) {
  1224.         Tcl_AppendResult(interp, "invalid message box type \"", 
  1225.             argv[v], "\", must be abortretryignore, ok, ",
  1226.             "okcancel, retrycancel, yesno or yesnocancel", NULL);
  1227.         return TCL_ERROR;
  1228.         }
  1229.     }
  1230.     else {
  1231.             Tcl_AppendResult(interp, "unknown option \"", 
  1232.         argv[i], "\", must be -default, -icon, ",
  1233.         "-message, -parent, -title or -type", NULL);
  1234.         return TCL_ERROR;
  1235.     }
  1236.     }
  1237.  
  1238.     /* Make sure we have a valid hWnd to act as the parent of this message box
  1239.      */
  1240.     if (Tk_WindowId(parent) == None) {
  1241.     Tk_MakeWindowExist(parent);
  1242.     }
  1243.     hWnd = Tk_GetHWND(Tk_WindowId(parent));
  1244.  
  1245.     if (defaultBtn != NULL) {
  1246.     for (i=0; i<NUM_TYPES; i++) {
  1247.         if (type == msgTypeInfo[i].type) {
  1248.         for (j=0; j<msgTypeInfo[i].numButtons; j++) {
  1249.             if (strcmp(defaultBtn, msgTypeInfo[i].btnNames[j])==0) {
  1250.                 defaultBtnIdx = j;
  1251.             break;
  1252.             }
  1253.         }
  1254.         if (defaultBtnIdx < 0) {
  1255.             Tcl_AppendResult(interp, "invalid default button \"",
  1256.             defaultBtn, "\"", NULL);
  1257.             return TCL_ERROR;
  1258.         }
  1259.         break;
  1260.         }
  1261.     }
  1262.  
  1263.     switch (defaultBtnIdx) {
  1264.       case 0: flags = MB_DEFBUTTON1; break;
  1265.       case 1: flags = MB_DEFBUTTON2; break;
  1266.       case 2: flags = MB_DEFBUTTON3; break;
  1267.       /*
  1268.       case 3: flags = MB_DEFBUTTON4; break;
  1269.       */
  1270.       default: flags = MB_DEFBUTTON1; break;
  1271.     }
  1272.     } else {
  1273.     flags = 0;
  1274.     }
  1275.     
  1276.     flags |= icon | type;
  1277.     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  1278. #ifdef VERBOSE
  1279.     printf("WinMessageBox [%s] title [%s], flags %x\n", message, title, flags);
  1280. #endif
  1281.     /* Windows Port uses SYSTEM modal dialog, I use application modal */
  1282.     code = WinMessageBox(HWND_DESKTOP, hWnd, message, title, 0,
  1283.                          flags|MB_APPLMODAL);
  1284.     (void) Tcl_SetServiceMode(oldMode);
  1285.  
  1286.     switch (code) {
  1287.       case MBID_ABORT:    result = "abort";  break;
  1288.       case MBID_CANCEL:    result = "cancel"; break;
  1289.       case MBID_IGNORE:    result = "ignore"; break;
  1290.       case MBID_NO:    result = "no";     break;
  1291.       case MBID_OK:    result = "ok";     break;
  1292.       case MBID_RETRY:    result = "retry";  break;
  1293.       case MBID_YES:    result = "yes";    break;
  1294.       default:        result = "";
  1295.     }
  1296.  
  1297.     /*
  1298.      * When we come to here interp->result may have been changed by some
  1299.      * background scripts. Call Tcl_SetResult() to make sure that any stuff
  1300.      * lingering in interp->result will not appear in the result of
  1301.      * this command.
  1302.      */
  1303.  
  1304.     Tcl_SetResult(interp, result, TCL_STATIC);
  1305.  
  1306.     return TCL_OK;
  1307.  
  1308.   arg_missing:
  1309.     Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
  1310.     NULL);
  1311.     return TCL_ERROR;
  1312. }
  1313.  
  1314. /*
  1315.  *----------------------------------------------------------------------
  1316.  *
  1317.  * ProcessError --
  1318.  *
  1319.  *    This procedure gets called if a OS/2-specific error message
  1320.  *    has occurred during the execution of a common dialog or the
  1321.  *    user has pressed the CANCEL button.
  1322.  *
  1323.  * Results:
  1324.  *    If an error has indeed happened, returns a standard TCL result
  1325.  *    that reports the error code in string format. If the user has
  1326.  *    pressed the CANCEL button (lastError == 0), resets
  1327.  *    interp->result to the empty string.
  1328.  *
  1329.  * Side effects:
  1330.  *    interp->result is changed.
  1331.  *
  1332.  *----------------------------------------------------------------------
  1333.  */
  1334. static int ProcessError(interp, lastError, hWnd)
  1335.     Tcl_Interp * interp;        /* Current interpreter. */
  1336.     ERRORID lastError;            /* The OS/2 PM-specific error code */
  1337.     HWND hWnd;                /* window in which the error happened*/
  1338. {
  1339.     /*
  1340.     char *string;
  1341.     */
  1342.     char string[257];
  1343.  
  1344. #ifdef VERBOSE
  1345.     printf("ProcessError\n");
  1346.     fflush(stdout);
  1347. #endif
  1348.  
  1349.     Tcl_ResetResult(interp);
  1350.  
  1351.     switch(lastError) {
  1352.       case 0:
  1353.     return TCL_OK;
  1354.  
  1355. /*
  1356.       case CDERR_DIALOGFAILURE:   string="CDERR_DIALOGFAILURE";      break;
  1357.       case CDERR_STRUCTSIZE:      string="CDERR_STRUCTSIZE";           break;
  1358.       case CDERR_INITIALIZATION:  string="CDERR_INITIALIZATION";       break;
  1359.       case CDERR_NOTEMPLATE:      string="CDERR_NOTEMPLATE";           break;
  1360.       case CDERR_NOHINSTANCE:     string="CDERR_NOHINSTANCE";       break;
  1361.       case CDERR_LOADSTRFAILURE:  string="CDERR_LOADSTRFAILURE";       break;
  1362.       case CDERR_FINDRESFAILURE:  string="CDERR_FINDRESFAILURE";       break;
  1363.       case CDERR_LOADRESFAILURE:  string="CDERR_LOADRESFAILURE";       break;
  1364.       case CDERR_LOCKRESFAILURE:  string="CDERR_LOCKRESFAILURE";       break;
  1365.       case CDERR_MEMALLOCFAILURE: string="CDERR_MEMALLOCFAILURE";       break;
  1366.       case CDERR_MEMLOCKFAILURE:  string="CDERR_MEMLOCKFAILURE";       break;
  1367.       case CDERR_NOHOOK:          string="CDERR_NOHOOK";            break;
  1368.       case PDERR_SETUPFAILURE:    string="PDERR_SETUPFAILURE";       break;
  1369.       case PDERR_PARSEFAILURE:    string="PDERR_PARSEFAILURE";       break;
  1370.       case PDERR_RETDEFFAILURE:   string="PDERR_RETDEFFAILURE";       break;
  1371.       case PDERR_LOADDRVFAILURE:  string="PDERR_LOADDRVFAILURE";       break;
  1372.       case PDERR_GETDEVMODEFAIL:  string="PDERR_GETDEVMODEFAIL";       break;
  1373.       case PDERR_INITFAILURE:     string="PDERR_INITFAILURE";       break;
  1374.       case PDERR_NODEVICES:       string="PDERR_NODEVICES";           break;
  1375.       case PDERR_NODEFAULTPRN:    string="PDERR_NODEFAULTPRN";       break;
  1376.       case PDERR_DNDMMISMATCH:    string="PDERR_DNDMMISMATCH";       break;
  1377.       case PDERR_CREATEICFAILURE: string="PDERR_CREATEICFAILURE";       break;
  1378.       case PDERR_PRINTERNOTFOUND: string="PDERR_PRINTERNOTFOUND";       break;
  1379.       case CFERR_NOFONTS:         string="CFERR_NOFONTS";            break;
  1380.       case FNERR_SUBCLASSFAILURE: string="FNERR_SUBCLASSFAILURE";       break;
  1381.       case FNERR_INVALIDFILENAME: string="FNERR_INVALIDFILENAME";       break;
  1382.       case FNERR_BUFFERTOOSMALL:  string="FNERR_BUFFERTOOSMALL";       break;
  1383.       case PMERR_INVALID_HWND: string="PMERR_INVALID_HWND";      break;
  1384. */
  1385.     
  1386.       default:
  1387.     sprintf(string, "unknown error, %lx", (ULONG) lastError);
  1388.     }
  1389.  
  1390.     Tcl_AppendResult(interp, "OS/2 internal error: ", string, NULL); 
  1391.     return TCL_ERROR;
  1392. }
  1393.