/* * winMain.c -- * * Main entry point for wish and other Tk-based applications. * * Copyright (c) 1995 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: @(#) winMain.c 1.28 96/07/23 16:58:12 */ #include #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN #include #include /* * The following declarations refer to internal Tk routines. These * interfaces are available for use, but are not supported. */ EXTERN void TkConsoleCreate _ANSI_ARGS_((void)); EXTERN int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp)); /* * Forward declarations for procedures defined later in this file: */ static void WishPanic _ANSI_ARGS_(TCL_VARARGS(char *,format)); #ifdef TK_TEST EXTERN int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* TK_TEST */ /* *---------------------------------------------------------------------- * * WinMain -- * * Main entry point from Windows. * * Results: * Returns false if initialization fails, otherwise it never * returns. * * Side effects: * Just about anything, since from here we call arbitrary Tcl code. * *---------------------------------------------------------------------- */ int APIENTRY WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow) HINSTANCE hInstance; HINSTANCE hPrevInstance; LPSTR lpszCmdLine; int nCmdShow; { char **argv, **argvlist, *p; int argc, size, i; char buffer[MAX_PATH]; /* * Set up the default locale to be standard "C" locale so parsing * is performed correctly. */ setlocale(LC_ALL, "C"); /* * Increase the application queue size from default value of 8. * At the default value, cross application SendMessage of WM_KILLFOCUS * will fail because the handler will not be able to do a PostMessage! * This is only needed for Windows 3.x, since NT dynamically expands * the queue. */ SetMessageQueue(64); /* * Create the console channels and install them as the standard * channels. All I/O will be discarded until TkConsoleInit is * called to attach the console to a text widget. */ TkConsoleCreate(); /* * Precompute an overly pessimistic guess at the number of arguments * in the command line by counting non-space spans. Note that we * have to allow room for the executable name and the trailing NULL * argument. */ for (size = 3, p = lpszCmdLine; *p != '\0'; p++) { if (isspace(*p)) { size++; while (isspace(*p)) { p++; } if (*p == '\0') { break; } } } argvlist = (char **) ckalloc((unsigned) (size * sizeof(char *))); argv = argvlist; /* * Parse the Windows command line string. If an argument begins with a * double quote, then spaces are considered part of the argument until the * next double quote. The argument terminates at the second quote. Note * that this is different from the usual Unix semantics. */ for (i = 1, p = lpszCmdLine; *p != '\0'; i++) { while (isspace(*p)) { p++; } if (*p == '\0') { break; } if (*p == '"') { p++; argv[i] = p; while ((*p != '\0') && (*p != '"')) { p++; } } else { argv[i] = p; while (*p != '\0' && !isspace(*p)) { p++; } } if (*p != '\0') { *p = '\0'; p++; } } argv[i] = NULL; argc = i; /* * Since Windows programs don't get passed the command name as the * first argument, we need to fetch it explicitly. */ GetModuleFileName(NULL, buffer, sizeof(buffer)); argv[0] = buffer; Tk_Main(argc, argv, Tcl_AppInit); return 1; } /* *---------------------------------------------------------------------- * * Tcl_AppInit -- * * This procedure performs application-specific initialization. * Most applications, especially those that incorporate additional * packages, will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error * message in interp->result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ int Tcl_AppInit(interp) Tcl_Interp *interp; /* Interpreter for application. */ { if (Tcl_Init(interp) == TCL_ERROR) { goto error; } if (Tk_Init(interp) == TCL_ERROR) { goto error; } Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL); /* * Initialize the console only if we are running as an interactive * application. */ if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1") == 0) { if (TkConsoleInit(interp) == TCL_ERROR) { goto error; } } #ifdef TK_TEST if (Tktest_Init(interp) == TCL_ERROR) { goto error; } Tcl_StaticPackage(interp, "Tktest", Tktest_Init, (Tcl_PackageInitProc *) NULL); #endif /* TK_TEST */ Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY); return TCL_OK; error: WishPanic(interp->result); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * WishPanic -- * * Display a message and exit. * * Results: * None. * * Side effects: * Exits the program. * *---------------------------------------------------------------------- */ void WishPanic TCL_VARARGS_DEF(char *,arg1) { va_list argList; char buf[1024]; char *format; format = TCL_VARARGS_START(char *,arg1,argList); vsprintf(buf, format, argList); MessageBeep(MB_ICONEXCLAMATION); MessageBox(NULL, buf, "Fatal Error in Wish", MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); ExitProcess(1); }