static char rcsid[] = "$Id: winxpvm.c,v 4.50 1998/04/09 21:12:15 kohl Exp $"; /* * winxpvm.c (modified from tk/win/winMain.c) -- * * Main entry point for XPVM Windows. * * 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.27 96/04/11 17:50:25 */ #include #define WIN32_LEAN_AND_MEAN #include #undef WIN32_LEAN_AND_MEAN #include #include /* * Forward declarations for procedures defined later in this file: */ static void XpvmPanic _ANSI_ARGS_( TCL_VARARGS( char *, format ) ); int Xpvm_Init( Tcl_Interp * ); /* *---------------------------------------------------------------------- * * 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 buffer[MAX_PATH]; char **argv; char **argvlist; char *p; int argc; int size; int i; /* * Set up the default locale to be Windows ANSI character set. */ setlocale( LC_ALL, "" ); Tcl_SetPanicProc( XpvmPanic ); /* * 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 (and extra dummy "-" arg for XPVM hostfile). */ for ( size = 4, 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=2, 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; /* Stuff in Dummy Arg for Hostfile */ argv[1] = trc_copy_str( "-" ); /* Pass to TK */ 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 ( TclHasSockets( interp ) == TCL_ERROR ) goto error; if ( Tk_Init( interp ) == TCL_ERROR ) goto error; if ( Xpvm_Init( interp ) == TCL_ERROR ) goto error; Tcl_StaticPackage( interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL ); Tcl_StaticPackage( interp, "XPVM", Xpvm_Init, (Tcl_PackageInitProc *) NULL ); Tcl_SetVar( interp, "tcl_rcFileName", "~/.xpvmrc", TCL_GLOBAL_ONLY ); /* * 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; } return TCL_OK; error: WishPanic(interp->result); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * XpvmPanic -- * * Display a message and exit. * * Results: * None. * * Side effects: * Exits the program. * *---------------------------------------------------------------------- */ void XpvmPanic 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 XPVM", MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); ExitProcess(1); }