diff options
Diffstat (limited to 'tix/win/tixWinMain.c')
| -rw-r--r-- | tix/win/tixWinMain.c | 303 |
1 files changed, 303 insertions, 0 deletions
diff --git a/tix/win/tixWinMain.c b/tix/win/tixWinMain.c new file mode 100644 index 00000000000..b06862d499a --- /dev/null +++ b/tix/win/tixWinMain.c @@ -0,0 +1,303 @@ +/* + * tixWinMain.c -- + * + * Main entry point for wish and other Tk-based applications. + * + * Copyright (c) 1996, Expert Interface Technologies + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * + */ + +#include <tk.h> +#include <tixInt.h> +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN +#include <malloc.h> +#include <locale.h> + +#ifdef ITCL_2 +#include "itcl.h" +#include "itk.h" +#endif + +/* + * 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)); + + +/* + *---------------------------------------------------------------------- + * + * 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]; + + Tcl_SetPanicProc(WishPanic); + + /* + * 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); + + /* + * 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. */ +{ + /* + * 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(); + + if (Tcl_Init(interp) == TCL_ERROR) { + if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) { + MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), + "Tcl Init Error", MB_OK|MB_ICONSTOP); + } else { + MessageBox(NULL, interp->result, "Tcl Init Error", + MB_OK|MB_ICONSTOP ); + } + return TCL_ERROR; + } + + if (Tk_Init(interp) == TCL_ERROR) { + if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) { + MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), + "Tk Init Error", MB_OK|MB_ICONSTOP); + } else { + MessageBox(NULL, interp->result, "Tk Init Error", + MB_OK|MB_ICONSTOP); + } + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL); + +#ifdef ITCL_2 + if (Itcl_Init(interp) == TCL_ERROR) { + if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) { + MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), + "Itcl Init Error", MB_OK|MB_ICONSTOP); + } else { + MessageBox(NULL, interp->result, "Itcl Init Error", + MB_OK|MB_ICONSTOP); + } + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Itcl", Itcl_Init, (Tcl_PackageInitProc *) NULL); + + if (Itk_Init(interp) == TCL_ERROR) { + if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) { + MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), + "Itk Init Error", MB_OK|MB_ICONSTOP); + } else { + MessageBox(NULL, interp->result, "Itk Init Error", + MB_OK|MB_ICONSTOP); + } + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Itk", Itk_Init, (Tcl_PackageInitProc *) NULL); +#endif + + if (Tix_Init(interp) == TCL_ERROR) { + if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) { + MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), + "Tix Init Error", MB_OK|MB_ICONSTOP); + } else { + MessageBox(NULL, interp->result, "Tix Init Error", + MB_OK|MB_ICONSTOP); + } + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Tix", Tix_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) { + return TCL_ERROR; + } + } + + Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * 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); +} + |