/*
* 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);
}