home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / win / winMain.c < prev   
Encoding:
C/C++ Source or Header  |  1996-04-14  |  5.8 KB  |  251 lines
  1. /* 
  2.  * winMain.c --
  3.  *
  4.  *    Main entry point for wish and other Tk-based applications.
  5.  *
  6.  * Copyright (c) 1995 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * SCCS: @(#) winMain.c 1.27 96/04/11 17:50:25
  12.  */
  13.  
  14. #include <tk.h>
  15. #define WIN32_LEAN_AND_MEAN
  16. #include <windows.h>
  17. #undef WIN32_LEAN_AND_MEAN
  18. #include <malloc.h>
  19. #include <locale.h>
  20.  
  21. /*
  22.  * The following declarations refer to internal Tk routines.  These
  23.  * interfaces are available for use, but are not supported.
  24.  */
  25.  
  26. EXTERN void        TkConsoleCreate _ANSI_ARGS_((void));
  27. EXTERN int        TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
  28.  
  29. /*
  30.  * Forward declarations for procedures defined later in this file:
  31.  */
  32.  
  33. static void WishPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));
  34.  
  35. #ifdef TK_TEST
  36. EXTERN int        Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
  37. #endif /* TK_TEST */
  38.  
  39.  
  40. /*
  41.  *----------------------------------------------------------------------
  42.  *
  43.  * WinMain --
  44.  *
  45.  *    Main entry point from Windows.
  46.  *
  47.  * Results:
  48.  *    Returns false if initialization fails, otherwise it never
  49.  *    returns. 
  50.  *
  51.  * Side effects:
  52.  *    Just about anything, since from here we call arbitrary Tcl code.
  53.  *
  54.  *----------------------------------------------------------------------
  55.  */
  56.  
  57. int APIENTRY
  58. WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
  59.     HINSTANCE hInstance;
  60.     HINSTANCE hPrevInstance;
  61.     LPSTR lpszCmdLine;
  62.     int nCmdShow;
  63. {
  64.     char **argv, **argvlist, *p;
  65.     int argc, size, i;
  66.     char buffer[MAX_PATH];
  67.  
  68.     /*
  69.      * Set up the default locale to be Windows ANSI character set.
  70.      */
  71.  
  72.     setlocale(LC_ALL, "");
  73.  
  74.     Tcl_SetPanicProc(WishPanic);
  75.  
  76.     /*
  77.      * Increase the application queue size from default value of 8.
  78.      * At the default value, cross application SendMessage of WM_KILLFOCUS
  79.      * will fail because the handler will not be able to do a PostMessage!
  80.      * This is only needed for Windows 3.x, since NT dynamically expands
  81.      * the queue.
  82.      */
  83.     SetMessageQueue(64);
  84.  
  85.     /*
  86.      * Create the console channels and install them as the standard
  87.      * channels.  All I/O will be discarded until TkConsoleInit is
  88.      * called to attach the console to a text widget.
  89.      */
  90.  
  91.     TkConsoleCreate();
  92.  
  93.     /*
  94.      * Precompute an overly pessimistic guess at the number of arguments
  95.      * in the command line by counting non-space spans.  Note that we
  96.      * have to allow room for the executable name and the trailing NULL
  97.      * argument.
  98.      */
  99.  
  100.     for (size = 3, p = lpszCmdLine; *p != '\0'; p++) {
  101.     if (isspace(*p)) {
  102.         size++;
  103.         while (isspace(*p)) {
  104.         p++;
  105.         }
  106.         if (*p == '\0') {
  107.         break;
  108.         }
  109.     }
  110.     }
  111.     argvlist = (char **) ckalloc((unsigned) (size * sizeof(char *)));
  112.     argv = argvlist;
  113.  
  114.     /*
  115.      * Parse the Windows command line string.  If an argument begins with a
  116.      * double quote, then spaces are considered part of the argument until the
  117.      * next double quote.  The argument terminates at the second quote.  Note
  118.      * that this is different from the usual Unix semantics.
  119.      */
  120.  
  121.     for (i = 1, p = lpszCmdLine; *p != '\0'; i++) {
  122.     while (isspace(*p)) {
  123.         p++;
  124.     }
  125.     if (*p == '\0') {
  126.         break;
  127.     }
  128.     if (*p == '"') {
  129.         p++;
  130.         argv[i] = p;
  131.         while ((*p != '\0') && (*p != '"')) {
  132.         p++;
  133.         }
  134.     } else {
  135.         argv[i] = p;
  136.         while (*p != '\0' && !isspace(*p)) {
  137.         p++;
  138.         }
  139.     }
  140.     if (*p != '\0') {
  141.         *p = '\0';
  142.         p++;
  143.     }
  144.     }
  145.     argv[i] = NULL;
  146.     argc = i;
  147.  
  148.     /*
  149.      * Since Windows programs don't get passed the command name as the
  150.      * first argument, we need to fetch it explicitly.
  151.      */
  152.  
  153.     GetModuleFileName(NULL, buffer, sizeof(buffer));
  154.     argv[0] = buffer;
  155.  
  156.     Tk_Main(argc, argv, Tcl_AppInit);
  157.     return 1;
  158. }
  159.  
  160.  
  161. /*
  162.  *----------------------------------------------------------------------
  163.  *
  164.  * Tcl_AppInit --
  165.  *
  166.  *    This procedure performs application-specific initialization.
  167.  *    Most applications, especially those that incorporate additional
  168.  *    packages, will have their own version of this procedure.
  169.  *
  170.  * Results:
  171.  *    Returns a standard Tcl completion code, and leaves an error
  172.  *    message in interp->result if an error occurs.
  173.  *
  174.  * Side effects:
  175.  *    Depends on the startup script.
  176.  *
  177.  *----------------------------------------------------------------------
  178.  */
  179.  
  180. int
  181. Tcl_AppInit(interp)
  182.     Tcl_Interp *interp;        /* Interpreter for application. */
  183. {
  184.     if (Tcl_Init(interp) == TCL_ERROR) {
  185.     goto error;
  186.     }
  187.     if (Tk_Init(interp) == TCL_ERROR) {
  188.     goto error;
  189.     }
  190.     Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
  191.  
  192.     /*
  193.      * Initialize the console only if we are running as an interactive
  194.      * application.
  195.      */
  196.  
  197.     if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
  198.         == 0) {
  199.     if (TkConsoleInit(interp) == TCL_ERROR) {
  200.     goto error;
  201.     }
  202.     }
  203.  
  204. #ifdef TK_TEST
  205.     if (Tktest_Init(interp) == TCL_ERROR) {
  206.     goto error;
  207.     }
  208.     Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
  209.             (Tcl_PackageInitProc *) NULL);
  210. #endif /* TK_TEST */
  211.  
  212.     Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY);
  213.     return TCL_OK;
  214.  
  215. error:
  216.     WishPanic(interp->result);
  217.     return TCL_ERROR;
  218. }
  219.  
  220. /*
  221.  *----------------------------------------------------------------------
  222.  *
  223.  * WishPanic --
  224.  *
  225.  *    Display a message and exit.
  226.  *
  227.  * Results:
  228.  *    None.
  229.  *
  230.  * Side effects:
  231.  *    Exits the program.
  232.  *
  233.  *----------------------------------------------------------------------
  234.  */
  235.  
  236. void
  237. WishPanic TCL_VARARGS_DEF(char *,arg1)
  238. {
  239.     va_list argList;
  240.     char buf[1024];
  241.     char *format;
  242.     
  243.     format = TCL_VARARGS_START(char *,arg1,argList);
  244.     vsprintf(buf, format, argList);
  245.  
  246.     MessageBeep(MB_ICONEXCLAMATION);
  247.     MessageBox(NULL, buf, "Fatal Error in Wish",
  248.         MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
  249.     ExitProcess(1);
  250. }
  251.