1/* 2 * winMain.c -- 3 * 4 * Main entry point for wish and other Tk-based applications. 5 * 6 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 7 * Copyright (c) 1998-1999 by Scriptics Corporation. 8 * 9 * See the file "tcl-license.terms" for information on usage and redistribution 10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 * 12 * RCS: @(#) $Id: winMain.c,v 1.1 2004/05/23 22:50:39 neumann Exp $ 13 */ 14 15#include <tk.h> 16#define WIN32_LEAN_AND_MEAN 17#include <windows.h> 18#undef WIN32_LEAN_AND_MEAN 19#include <malloc.h> 20#include <locale.h> 21#if defined(VISUAL_CC) 22# include "xotcl.h" 23#else 24# include <xotcl.h> 25#endif 26 27#include "tkInt.h" 28 29/* 30 * The following declarations refer to internal Tk routines. These 31 * interfaces are available for use, but are not supported. 32 */ 33#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<2 34EXTERN void TkConsoleCreate(void); 35EXTERN int TkConsoleInit(Tcl_Interp *interp); 36#endif 37/* 38 * Forward declarations for procedures defined later in this file: 39 */ 40 41static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr)); 42static void WishPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); 43 44#ifdef TK_TEST 45extern int Tktest_Init(Tcl_Interp *interp); 46#endif /* TK_TEST */ 47 48#ifdef TCL_TEST 49extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); 50extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); 51#endif /* TCL_TEST */ 52 53static BOOL consoleRequired = TRUE; 54 55 56/* 57 *---------------------------------------------------------------------- 58 * 59 * WinMain -- 60 * 61 * Main entry point from Windows. 62 * 63 * Results: 64 * Returns false if initialization fails, otherwise it never 65 * returns. 66 * 67 * Side effects: 68 * Just about anything, since from here we call arbitrary Tcl code. 69 * 70 *---------------------------------------------------------------------- 71 */ 72 73int APIENTRY 74WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow) 75 HINSTANCE hInstance; 76 HINSTANCE hPrevInstance; 77 LPSTR lpszCmdLine; 78 int nCmdShow; 79{ 80 char **argv; 81 int argc; 82#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<2 83 char buffer[MAX_PATH+1]; 84 char *p; 85#endif 86 Tcl_SetPanicProc(WishPanic); 87 88 /* 89 * Set up the default locale to be standard "C" locale so parsing 90 * is performed correctly. 91 */ 92 93 setlocale(LC_ALL, "C"); 94#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>1 95 setargv(&argc, &argv); 96#endif 97 /* 98 * Increase the application queue size from default value of 8. 99 * At the default value, cross application SendMessage of WM_KILLFOCUS 100 * will fail because the handler will not be able to do a PostMessage! 101 * This is only needed for Windows 3.x, since NT dynamically expands 102 * the queue. 103 */ 104 105 SetMessageQueue(64); 106 107 /* 108 * Create the console channels and install them as the standard 109 * channels. All I/O will be discarded until Tk_CreateConsoleWindow is 110 * called to attach the console to a text widget. 111 */ 112#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<2 113 TkConsoleCreate(); 114 115 setargv(&argc, &argv); 116 117 /* 118 * Replace argv[0] with full pathname of executable, and forward 119 * slashes substituted for backslashes. 120 */ 121 122 GetModuleFileName(NULL, buffer, sizeof(buffer)); 123 argv[0] = buffer; 124 for (p = buffer; *p != '\0'; p++) { 125 if (*p == '\\') { 126 *p = '/'; 127 } 128 } 129#endif 130 consoleRequired = TRUE; 131 132 Tk_Main(argc, argv, Tcl_AppInit); 133 return 1; 134} 135 136 137/* 138 *---------------------------------------------------------------------- 139 * 140 * Tcl_AppInit -- 141 * 142 * This procedure performs application-specific initialization. 143 * Most applications, especially those that incorporate additional 144 * packages, will have their own version of this procedure. 145 * 146 * Results: 147 * Returns a standard Tcl completion code, and leaves an error 148 * message in the interp's result if an error occurs. 149 * 150 * Side effects: 151 * Depends on the startup script. 152 * 153 *---------------------------------------------------------------------- 154 */ 155 156int 157Tcl_AppInit(interp) 158 Tcl_Interp *interp; /* Interpreter for application. */ 159{ 160 if (Tcl_Init(interp) == TCL_ERROR) { 161 goto error; 162 } 163 if (Tk_Init(interp) == TCL_ERROR) { 164 goto error; 165 } 166 Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); 167 168 /* 169 if (Xotcl_Init(interp) == TCL_ERROR) { 170 return TCL_ERROR; 171 } 172 Tcl_StaticPackage(interp, "XOTcl", Xotcl_Init, 0); 173 */ 174 if (Tcl_PkgRequire(interp, "XOTcl", XOTCLVERSION, 1) == NULL) { 175 return TCL_ERROR; 176 } 177 178 /* 179 * This is xotclsh, so import all xotcl commands by 180 * default into the global namespace. 181 */ 182 if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp), 183 "::xotcl::*", /* allowOverwrite */ 1) != TCL_OK) { 184 return TCL_ERROR; 185 } 186 187 /* 188 * Initialize the console only if we are running as an interactive 189 * application. 190 */ 191#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<2 192 if (TkConsoleInit(interp) == TCL_ERROR) { 193 goto error; 194 } 195#else 196 if (consoleRequired) { 197 if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) { 198 goto error; 199 } 200 } 201#endif 202 203#ifdef TCL_TEST 204 if (Tcltest_Init(interp) == TCL_ERROR) { 205 return TCL_ERROR; 206 } 207 Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, 208 (Tcl_PackageInitProc *) NULL); 209 if (TclObjTest_Init(interp) == TCL_ERROR) { 210 return TCL_ERROR; 211 } 212#endif /* TCL_TEST */ 213 214#ifdef TK_TEST 215 if (Tktest_Init(interp) == TCL_ERROR) { 216 goto error; 217 } 218 Tcl_StaticPackage(interp, "Tktest", Tktest_Init, 219 (Tcl_PackageInitProc *) NULL); 220#endif /* TK_TEST */ 221 222 Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY); 223 return TCL_OK; 224 225error: 226 WishPanic(Tcl_GetStringResult(interp)); 227 return TCL_ERROR; 228} 229 230/* 231 *---------------------------------------------------------------------- 232 * 233 * WishPanic -- 234 * 235 * Display a message and exit. 236 * 237 * Results: 238 * None. 239 * 240 * Side effects: 241 * Exits the program. 242 * 243 *---------------------------------------------------------------------- 244 */ 245 246void 247WishPanic TCL_VARARGS_DEF(CONST char *,arg1) 248{ 249 va_list argList; 250 char buf[1024]; 251 CONST char *format; 252 253 format = TCL_VARARGS_START(CONST char *,arg1,argList); 254 vsprintf(buf, format, argList); 255 256 MessageBeep(MB_ICONEXCLAMATION); 257 MessageBox(NULL, buf, "Fatal Error in Wish", 258 MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); 259#ifdef _MSC_VER 260 DebugBreak(); 261#endif 262 ExitProcess(1); 263} 264/* 265 *------------------------------------------------------------------------- 266 * 267 * setargv -- 268 * 269 * Parse the Windows command line string into argc/argv. Done here 270 * because we don't trust the builtin argument parser in crt0. 271 * Windows applications are responsible for breaking their command 272 * line into arguments. 273 * 274 * 2N backslashes + quote -> N backslashes + begin quoted string 275 * 2N + 1 backslashes + quote -> literal 276 * N backslashes + non-quote -> literal 277 * quote + quote in a quoted string -> single quote 278 * quote + quote not in quoted string -> empty string 279 * quote -> begin quoted string 280 * 281 * Results: 282 * Fills argcPtr with the number of arguments and argvPtr with the 283 * array of arguments. 284 * 285 * Side effects: 286 * Memory allocated. 287 * 288 *-------------------------------------------------------------------------- 289 */ 290 291static void 292setargv(argcPtr, argvPtr) 293 int *argcPtr; /* Filled with number of argument strings. */ 294 char ***argvPtr; /* Filled with argument strings (malloc'd). */ 295{ 296 char *cmdLine, *p, *arg, *argSpace; 297 char **argv; 298 int argc, size, inquote, copy, slashes; 299 300 cmdLine = GetCommandLine(); /* INTL: BUG */ 301 302 /* 303 * Precompute an overly pessimistic guess at the number of arguments 304 * in the command line by counting non-space spans. 305 */ 306 307 size = 2; 308 for (p = cmdLine; *p != '\0'; p++) { 309 if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ 310 size++; 311 while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ 312 p++; 313 } 314 if (*p == '\0') { 315 break; 316 } 317 } 318 } 319 argSpace = (char *) Tcl_Alloc( 320 (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1)); 321 argv = (char **) argSpace; 322 argSpace += size * sizeof(char *); 323 size--; 324 325 p = cmdLine; 326 for (argc = 0; argc < size; argc++) { 327 argv[argc] = arg = argSpace; 328 while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ 329 p++; 330 } 331 if (*p == '\0') { 332 break; 333 } 334 335 inquote = 0; 336 slashes = 0; 337 while (1) { 338 copy = 1; 339 while (*p == '\\') { 340 slashes++; 341 p++; 342 } 343 if (*p == '"') { 344 if ((slashes & 1) == 0) { 345 copy = 0; 346 if ((inquote) && (p[1] == '"')) { 347 p++; 348 copy = 1; 349 } else { 350 inquote = !inquote; 351 } 352 } 353 slashes >>= 1; 354 } 355 356 while (slashes) { 357 *arg = '\\'; 358 arg++; 359 slashes--; 360 } 361 362 if ((*p == '\0') 363 || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ 364 break; 365 } 366 if (copy != 0) { 367 *arg = *p; 368 arg++; 369 } 370 p++; 371 } 372 *arg = '\0'; 373 argSpace = arg + 1; 374 } 375 argv[argc] = NULL; 376 377 *argcPtr = argc; 378 *argvPtr = argv; 379} 380 381 382/* 383 *---------------------------------------------------------------------- 384 * 385 * main -- 386 * 387 * Main entry point from the console. 388 * 389 * Results: 390 * None: Tk_Main never returns here, so this procedure never 391 * returns either. 392 * 393 * Side effects: 394 * Whatever the applications does. 395 * 396 *---------------------------------------------------------------------- 397 */ 398 399int main(int argc, char **argv) 400{ 401 Tcl_SetPanicProc(WishPanic); 402 403 /* 404 * Set up the default locale to be standard "C" locale so parsing 405 * is performed correctly. 406 */ 407 408 setlocale(LC_ALL, "C"); 409 /* 410 * Increase the application queue size from default value of 8. 411 * At the default value, cross application SendMessage of WM_KILLFOCUS 412 * will fail because the handler will not be able to do a PostMessage! 413 * This is only needed for Windows 3.x, since NT dynamically expands 414 * the queue. 415 */ 416 417 SetMessageQueue(64); 418 419 /* 420 * Create the console channels and install them as the standard 421 * channels. All I/O will be discarded until Tk_CreateConsoleWindow is 422 * called to attach the console to a text widget. 423 */ 424 425 consoleRequired = FALSE; 426 427 Tk_Main(argc, argv, Tcl_AppInit); 428 return 0; 429} 430 431