1/* 2 * tclAppInit.c -- 3 * 4 * Provides a default version of the main program and Tcl_AppInit 5 * procedure for Tcl applications (without Tk). Note that this 6 * program must be built in Win32 console mode to work properly. 7 * 8 * Copyright (c) 1996-1997 by Sun Microsystems, Inc. 9 * Copyright (c) 1998-1999 by Scriptics Corporation. 10 * 11 * See the file "license.terms" for information on usage and redistribution 12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 * 14 * RCS: @(#) $Id: tclAppInit.c,v 1.11.2.3 2007/03/19 17:06:26 dgp Exp $ 15 */ 16 17#include "tcl.h" 18#include <windows.h> 19#include <locale.h> 20 21#ifdef TCL_TEST 22extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp)); 23extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); 24extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); 25extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); 26#ifdef TCL_THREADS 27extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); 28#endif 29#endif /* TCL_TEST */ 30 31static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr)); 32static BOOL __stdcall sigHandler (DWORD fdwCtrlType); 33static Tcl_AsyncProc asyncExit; 34static void AppInitExitHandler(ClientData clientData); 35 36static char ** argvSave = NULL; 37static Tcl_AsyncHandler exitToken = NULL; 38static DWORD exitErrorCode = 0; 39 40 41/* 42 *---------------------------------------------------------------------- 43 * 44 * main -- 45 * 46 * This is the main program for the application. 47 * 48 * Results: 49 * None: Tcl_Main never returns here, so this procedure never 50 * returns either. 51 * 52 * Side effects: 53 * Whatever the application does. 54 * 55 *---------------------------------------------------------------------- 56 */ 57 58int 59main(argc, argv) 60 int argc; /* Number of command-line arguments. */ 61 char **argv; /* Values of command-line arguments. */ 62{ 63 /* 64 * The following #if block allows you to change the AppInit 65 * function by using a #define of TCL_LOCAL_APPINIT instead 66 * of rewriting this entire file. The #if checks for that 67 * #define and uses Tcl_AppInit if it doesn't exist. 68 */ 69 70#ifndef TCL_LOCAL_APPINIT 71#define TCL_LOCAL_APPINIT Tcl_AppInit 72#endif 73 extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp)); 74 75 /* 76 * The following #if block allows you to change how Tcl finds the startup 77 * script, prime the library or encoding paths, fiddle with the argv, 78 * etc., without needing to rewrite Tcl_Main() 79 */ 80 81#ifdef TCL_LOCAL_MAIN_HOOK 82 extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); 83#endif 84 85 char buffer[MAX_PATH +1]; 86 char *p; 87 /* 88 * Set up the default locale to be standard "C" locale so parsing 89 * is performed correctly. 90 */ 91 92 setlocale(LC_ALL, "C"); 93 setargv(&argc, &argv); 94 95 /* 96 * Save this for later, so we can free it. 97 */ 98 argvSave = argv; 99 100 /* 101 * Replace argv[0] with full pathname of executable, and forward 102 * slashes substituted for backslashes. 103 */ 104 105 GetModuleFileName(NULL, buffer, sizeof(buffer)); 106 argv[0] = buffer; 107 for (p = buffer; *p != '\0'; p++) { 108 if (*p == '\\') { 109 *p = '/'; 110 } 111 } 112 113#ifdef TCL_LOCAL_MAIN_HOOK 114 TCL_LOCAL_MAIN_HOOK(&argc, &argv); 115#endif 116 117 Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); 118 119 return 0; /* Needed only to prevent compiler warning. */ 120} 121 122 123/* 124 *---------------------------------------------------------------------- 125 * 126 * Tcl_AppInit -- 127 * 128 * This procedure performs application-specific initialization. 129 * Most applications, especially those that incorporate additional 130 * packages, will have their own version of this procedure. 131 * 132 * Results: 133 * Returns a standard Tcl completion code, and leaves an error 134 * message in the interp's result if an error occurs. 135 * 136 * Side effects: 137 * Depends on the startup script. 138 * 139 *---------------------------------------------------------------------- 140 */ 141 142int 143Tcl_AppInit(interp) 144 Tcl_Interp *interp; /* Interpreter for application. */ 145{ 146 if (Tcl_Init(interp) == TCL_ERROR) { 147 return TCL_ERROR; 148 } 149 150 /* 151 * Install a signal handler to the win32 console tclsh is running in. 152 */ 153 SetConsoleCtrlHandler(sigHandler, TRUE); 154 exitToken = Tcl_AsyncCreate(asyncExit, NULL); 155 156 /* 157 * This exit handler will be used to free the 158 * resources allocated in this file. 159 */ 160 Tcl_CreateExitHandler(AppInitExitHandler, NULL); 161 162#ifdef TCL_TEST 163 if (Tcltest_Init(interp) == TCL_ERROR) { 164 return TCL_ERROR; 165 } 166 Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, 167 (Tcl_PackageInitProc *) NULL); 168 if (TclObjTest_Init(interp) == TCL_ERROR) { 169 return TCL_ERROR; 170 } 171#ifdef TCL_THREADS 172 if (TclThread_Init(interp) == TCL_ERROR) { 173 return TCL_ERROR; 174 } 175#endif 176 if (Procbodytest_Init(interp) == TCL_ERROR) { 177 return TCL_ERROR; 178 } 179 Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, 180 Procbodytest_SafeInit); 181#endif /* TCL_TEST */ 182 183#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) 184 { 185 extern Tcl_PackageInitProc Registry_Init; 186 extern Tcl_PackageInitProc Dde_Init; 187 188 if (Registry_Init(interp) == TCL_ERROR) { 189 return TCL_ERROR; 190 } 191 Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); 192 193 if (Dde_Init(interp) == TCL_ERROR) { 194 return TCL_ERROR; 195 } 196 Tcl_StaticPackage(interp, "dde", Dde_Init, NULL); 197 } 198#endif 199 200 /* 201 * Call the init procedures for included packages. Each call should 202 * look like this: 203 * 204 * if (Mod_Init(interp) == TCL_ERROR) { 205 * return TCL_ERROR; 206 * } 207 * 208 * where "Mod" is the name of the module. 209 */ 210 211 /* 212 * Call Tcl_CreateCommand for application-specific commands, if 213 * they weren't already created by the init procedures called above. 214 */ 215 216 /* 217 * Specify a user-specific startup file to invoke if the application 218 * is run interactively. Typically the startup file is "~/.apprc" 219 * where "app" is the name of the application. If this line is deleted 220 * then no user-specific startup file will be run under any conditions. 221 */ 222 223 Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); 224 return TCL_OK; 225} 226 227/* 228 *---------------------------------------------------------------------- 229 * 230 * AppInitExitHandler -- 231 * 232 * This function is called to cleanup the app init resources before 233 * Tcl is unloaded. 234 * 235 * Results: 236 * None. 237 * 238 * Side effects: 239 * Frees the saved argv and deletes the async exit handler. 240 * 241 *---------------------------------------------------------------------- 242 */ 243 244static void 245AppInitExitHandler( 246 ClientData clientData) 247{ 248 if (argvSave != NULL) { 249 ckfree((char *)argvSave); 250 argvSave = NULL; 251 } 252 253 if (exitToken != NULL) { 254 /* 255 * This should be safe to do even if we 256 * are in an async exit right now. 257 */ 258 Tcl_AsyncDelete(exitToken); 259 exitToken = NULL; 260 } 261} 262 263/* 264 *------------------------------------------------------------------------- 265 * 266 * setargv -- 267 * 268 * Parse the Windows command line string into argc/argv. Done here 269 * because we don't trust the builtin argument parser in crt0. 270 * Windows applications are responsible for breaking their command 271 * line into arguments. 272 * 273 * 2N backslashes + quote -> N backslashes + begin quoted string 274 * 2N + 1 backslashes + quote -> literal 275 * N backslashes + non-quote -> literal 276 * quote + quote in a quoted string -> single quote 277 * quote + quote not in quoted string -> empty string 278 * quote -> begin quoted string 279 * 280 * Results: 281 * Fills argcPtr with the number of arguments and argvPtr with the 282 * array of arguments. 283 * 284 * Side effects: 285 * Memory allocated. 286 * 287 *-------------------------------------------------------------------------- 288 */ 289 290static void 291setargv(argcPtr, argvPtr) 292 int *argcPtr; /* Filled with number of argument strings. */ 293 char ***argvPtr; /* Filled with argument strings (malloc'd). */ 294{ 295 char *cmdLine, *p, *arg, *argSpace; 296 char **argv; 297 int argc, size, inquote, copy, slashes; 298 299 cmdLine = GetCommandLine(); /* INTL: BUG */ 300 301 /* 302 * Precompute an overly pessimistic guess at the number of arguments 303 * in the command line by counting non-space spans. 304 */ 305 306 size = 2; 307 for (p = cmdLine; *p != '\0'; p++) { 308 if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ 309 size++; 310 while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ 311 p++; 312 } 313 if (*p == '\0') { 314 break; 315 } 316 } 317 } 318 argSpace = (char *) ckalloc( 319 (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1)); 320 argv = (char **) argSpace; 321 argSpace += size * sizeof(char *); 322 size--; 323 324 p = cmdLine; 325 for (argc = 0; argc < size; argc++) { 326 argv[argc] = arg = argSpace; 327 while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ 328 p++; 329 } 330 if (*p == '\0') { 331 break; 332 } 333 334 inquote = 0; 335 slashes = 0; 336 while (1) { 337 copy = 1; 338 while (*p == '\\') { 339 slashes++; 340 p++; 341 } 342 if (*p == '"') { 343 if ((slashes & 1) == 0) { 344 copy = 0; 345 if ((inquote) && (p[1] == '"')) { 346 p++; 347 copy = 1; 348 } else { 349 inquote = !inquote; 350 } 351 } 352 slashes >>= 1; 353 } 354 355 while (slashes) { 356 *arg = '\\'; 357 arg++; 358 slashes--; 359 } 360 361 if ((*p == '\0') 362 || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ 363 break; 364 } 365 if (copy != 0) { 366 *arg = *p; 367 arg++; 368 } 369 p++; 370 } 371 *arg = '\0'; 372 argSpace = arg + 1; 373 } 374 argv[argc] = NULL; 375 376 *argcPtr = argc; 377 *argvPtr = argv; 378} 379 380/* 381 *---------------------------------------------------------------------- 382 * 383 * asyncExit -- 384 * 385 * The AsyncProc for the exitToken. 386 * 387 * Results: 388 * doesn't actually return. 389 * 390 * Side effects: 391 * tclsh cleanly exits. 392 * 393 *---------------------------------------------------------------------- 394 */ 395 396int 397asyncExit (ClientData clientData, Tcl_Interp *interp, int code) 398{ 399 Tcl_Exit((int)exitErrorCode); 400 401 /* NOTREACHED */ 402 return code; 403} 404 405/* 406 *---------------------------------------------------------------------- 407 * 408 * sigHandler -- 409 * 410 * Signal handler for the Win32 OS. Catches Ctrl+C, Ctrl+Break and 411 * other exits. This is needed so tclsh can do it's real clean-up 412 * and not an unclean crash terminate. 413 * 414 * Results: 415 * TRUE. 416 * 417 * Side effects: 418 * Effects the way the app exits from a signal. This is an 419 * operating system supplied thread and unsafe to call ANY 420 * Tcl commands except for Tcl_AsyncMark. 421 * 422 *---------------------------------------------------------------------- 423 */ 424 425BOOL __stdcall 426sigHandler(DWORD fdwCtrlType) 427{ 428 HANDLE hStdIn; 429 430 if (!exitToken) { 431 /* Async token must have been destroyed, punt gracefully. */ 432 return FALSE; 433 } 434 435 /* 436 * If Tcl is currently executing some bytecode or in the eventloop, 437 * this will cause Tcl to enter asyncExit at the next command 438 * boundry. 439 */ 440 exitErrorCode = fdwCtrlType; 441 Tcl_AsyncMark(exitToken); 442 443 /* 444 * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF> 445 * should it be blocked on input and our Tcl_AsyncMark didn't grab 446 * the attention of the interpreter. 447 */ 448 hStdIn = GetStdHandle(STD_INPUT_HANDLE); 449 if (hStdIn) { 450 CloseHandle(hStdIn); 451 } 452 453 /* indicate to the OS not to call the default terminator */ 454 return TRUE; 455} 456