| 1 | /* | 
|---|
| 2 |  * tclAppInit.c -- | 
|---|
| 3 |  * | 
|---|
| 4 |  *      Provides a default version of the main program and Tcl_AppInit | 
|---|
| 5 |  *      function for Tcl applications (without Tk). Note that this program | 
|---|
| 6 |  *      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 of | 
|---|
| 12 |  * this file, and for a DISCLAIMER OF ALL WARRANTIES. | 
|---|
| 13 |  * | 
|---|
| 14 |  * RCS: @(#) $Id: tclAppInit.c,v 1.25 2007/04/16 13:36:36 dkf Exp $ | 
|---|
| 15 |  */ | 
|---|
| 16 |  | 
|---|
| 17 | #include "tcl.h" | 
|---|
| 18 | #include <windows.h> | 
|---|
| 19 | #include <locale.h> | 
|---|
| 20 |  | 
|---|
| 21 | #ifdef TCL_TEST | 
|---|
| 22 | extern Tcl_PackageInitProc      Procbodytest_Init; | 
|---|
| 23 | extern Tcl_PackageInitProc      Procbodytest_SafeInit; | 
|---|
| 24 | extern Tcl_PackageInitProc      Tcltest_Init; | 
|---|
| 25 | extern Tcl_PackageInitProc      TclObjTest_Init; | 
|---|
| 26 | #endif /* TCL_TEST */ | 
|---|
| 27 |  | 
|---|
| 28 | #if defined(__GNUC__) | 
|---|
| 29 | static void             setargv(int *argcPtr, char ***argvPtr); | 
|---|
| 30 | #endif /* __GNUC__ */ | 
|---|
| 31 |  | 
|---|
| 32 | /* | 
|---|
| 33 |  *---------------------------------------------------------------------- | 
|---|
| 34 |  * | 
|---|
| 35 |  * main -- | 
|---|
| 36 |  * | 
|---|
| 37 |  *      This is the main program for the application. | 
|---|
| 38 |  * | 
|---|
| 39 |  * Results: | 
|---|
| 40 |  *      None: Tcl_Main never returns here, so this function never returns | 
|---|
| 41 |  *      either. | 
|---|
| 42 |  * | 
|---|
| 43 |  * Side effects: | 
|---|
| 44 |  *      Whatever the application does. | 
|---|
| 45 |  * | 
|---|
| 46 |  *---------------------------------------------------------------------- | 
|---|
| 47 |  */ | 
|---|
| 48 |  | 
|---|
| 49 | int | 
|---|
| 50 | main( | 
|---|
| 51 |     int argc, | 
|---|
| 52 |     char *argv[]) | 
|---|
| 53 | { | 
|---|
| 54 |     /* | 
|---|
| 55 |      * The following #if block allows you to change the AppInit function by | 
|---|
| 56 |      * using a #define of TCL_LOCAL_APPINIT instead of rewriting this entire | 
|---|
| 57 |      * file. The #if checks for that #define and uses Tcl_AppInit if it | 
|---|
| 58 |      * doesn't exist. | 
|---|
| 59 |      */ | 
|---|
| 60 |  | 
|---|
| 61 | #ifndef TCL_LOCAL_APPINIT | 
|---|
| 62 | #define TCL_LOCAL_APPINIT Tcl_AppInit | 
|---|
| 63 | #endif | 
|---|
| 64 |     extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp)); | 
|---|
| 65 |  | 
|---|
| 66 |     /* | 
|---|
| 67 |      * The following #if block allows you to change how Tcl finds the startup | 
|---|
| 68 |      * script, prime the library or encoding paths, fiddle with the argv, | 
|---|
| 69 |      * etc., without needing to rewrite Tcl_Main() | 
|---|
| 70 |      */ | 
|---|
| 71 |  | 
|---|
| 72 | #ifdef TCL_LOCAL_MAIN_HOOK | 
|---|
| 73 |     extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); | 
|---|
| 74 | #endif | 
|---|
| 75 |  | 
|---|
| 76 |     char *p; | 
|---|
| 77 |  | 
|---|
| 78 |     /* | 
|---|
| 79 |      * Set up the default locale to be standard "C" locale so parsing is | 
|---|
| 80 |      * performed correctly. | 
|---|
| 81 |      */ | 
|---|
| 82 |  | 
|---|
| 83 | #if defined(__GNUC__) | 
|---|
| 84 |     setargv( &argc, &argv ); | 
|---|
| 85 | #endif | 
|---|
| 86 |     setlocale(LC_ALL, "C"); | 
|---|
| 87 |  | 
|---|
| 88 |     /* | 
|---|
| 89 |      * Forward slashes substituted for backslashes. | 
|---|
| 90 |      */ | 
|---|
| 91 |  | 
|---|
| 92 |     for (p = argv[0]; *p != '\0'; p++) { | 
|---|
| 93 |         if (*p == '\\') { | 
|---|
| 94 |             *p = '/'; | 
|---|
| 95 |         } | 
|---|
| 96 |     } | 
|---|
| 97 |  | 
|---|
| 98 | #ifdef TCL_LOCAL_MAIN_HOOK | 
|---|
| 99 |     TCL_LOCAL_MAIN_HOOK(&argc, &argv); | 
|---|
| 100 | #endif | 
|---|
| 101 |  | 
|---|
| 102 |     Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); | 
|---|
| 103 |  | 
|---|
| 104 |     return 0;                   /* Needed only to prevent compiler warning. */ | 
|---|
| 105 | } | 
|---|
| 106 |  | 
|---|
| 107 | /* | 
|---|
| 108 |  *---------------------------------------------------------------------- | 
|---|
| 109 |  * | 
|---|
| 110 |  * Tcl_AppInit -- | 
|---|
| 111 |  * | 
|---|
| 112 |  *      This function performs application-specific initialization. Most | 
|---|
| 113 |  *      applications, especially those that incorporate additional packages, | 
|---|
| 114 |  *      will have their own version of this function. | 
|---|
| 115 |  * | 
|---|
| 116 |  * Results: | 
|---|
| 117 |  *      Returns a standard Tcl completion code, and leaves an error message in | 
|---|
| 118 |  *      the interp's result if an error occurs. | 
|---|
| 119 |  * | 
|---|
| 120 |  * Side effects: | 
|---|
| 121 |  *      Depends on the startup script. | 
|---|
| 122 |  * | 
|---|
| 123 |  *---------------------------------------------------------------------- | 
|---|
| 124 |  */ | 
|---|
| 125 |  | 
|---|
| 126 | int | 
|---|
| 127 | Tcl_AppInit( | 
|---|
| 128 |     Tcl_Interp *interp)         /* Interpreter for application. */ | 
|---|
| 129 | { | 
|---|
| 130 |     if (Tcl_Init(interp) == TCL_ERROR) { | 
|---|
| 131 |         return TCL_ERROR; | 
|---|
| 132 |     } | 
|---|
| 133 |  | 
|---|
| 134 | #ifdef TCL_TEST | 
|---|
| 135 |     if (Tcltest_Init(interp) == TCL_ERROR) { | 
|---|
| 136 |         return TCL_ERROR; | 
|---|
| 137 |     } | 
|---|
| 138 |     Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL); | 
|---|
| 139 |     if (TclObjTest_Init(interp) == TCL_ERROR) { | 
|---|
| 140 |         return TCL_ERROR; | 
|---|
| 141 |     } | 
|---|
| 142 |     if (Procbodytest_Init(interp) == TCL_ERROR) { | 
|---|
| 143 |         return TCL_ERROR; | 
|---|
| 144 |     } | 
|---|
| 145 |     Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, | 
|---|
| 146 |             Procbodytest_SafeInit); | 
|---|
| 147 | #endif /* TCL_TEST */ | 
|---|
| 148 |  | 
|---|
| 149 | #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES | 
|---|
| 150 |     { | 
|---|
| 151 |         extern Tcl_PackageInitProc Registry_Init; | 
|---|
| 152 |         extern Tcl_PackageInitProc Dde_Init; | 
|---|
| 153 |         extern Tcl_PackageInitProc Dde_SafeInit; | 
|---|
| 154 |  | 
|---|
| 155 |         if (Registry_Init(interp) == TCL_ERROR) { | 
|---|
| 156 |             return TCL_ERROR; | 
|---|
| 157 |         } | 
|---|
| 158 |         Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); | 
|---|
| 159 |  | 
|---|
| 160 |         if (Dde_Init(interp) == TCL_ERROR) { | 
|---|
| 161 |             return TCL_ERROR; | 
|---|
| 162 |         } | 
|---|
| 163 |         Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); | 
|---|
| 164 |    } | 
|---|
| 165 | #endif | 
|---|
| 166 |  | 
|---|
| 167 |     /* | 
|---|
| 168 |      * Call the init functions for included packages. Each call should look | 
|---|
| 169 |      * like this: | 
|---|
| 170 |      * | 
|---|
| 171 |      * if (Mod_Init(interp) == TCL_ERROR) { | 
|---|
| 172 |      *     return TCL_ERROR; | 
|---|
| 173 |      * } | 
|---|
| 174 |      * | 
|---|
| 175 |      * where "Mod" is the name of the module. | 
|---|
| 176 |      */ | 
|---|
| 177 |  | 
|---|
| 178 |     /* | 
|---|
| 179 |      * Call Tcl_CreateCommand for application-specific commands, if they | 
|---|
| 180 |      * weren't already created by the init functions called above. | 
|---|
| 181 |      */ | 
|---|
| 182 |  | 
|---|
| 183 |     /* | 
|---|
| 184 |      * Specify a user-specific startup file to invoke if the application is | 
|---|
| 185 |      * run interactively. Typically the startup file is "~/.apprc" where "app" | 
|---|
| 186 |      * is the name of the application. If this line is deleted then no | 
|---|
| 187 |      * user-specific startup file will be run under any conditions. | 
|---|
| 188 |      */ | 
|---|
| 189 |  | 
|---|
| 190 |     Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); | 
|---|
| 191 |     return TCL_OK; | 
|---|
| 192 | } | 
|---|
| 193 |  | 
|---|
| 194 | /* | 
|---|
| 195 |  *------------------------------------------------------------------------- | 
|---|
| 196 |  * | 
|---|
| 197 |  * setargv -- | 
|---|
| 198 |  * | 
|---|
| 199 |  *      Parse the Windows command line string into argc/argv. Done here | 
|---|
| 200 |  *      because we don't trust the builtin argument parser in crt0. Windows | 
|---|
| 201 |  *      applications are responsible for breaking their command line into | 
|---|
| 202 |  *      arguments. | 
|---|
| 203 |  * | 
|---|
| 204 |  *      2N backslashes + quote -> N backslashes + begin quoted string | 
|---|
| 205 |  *      2N + 1 backslashes + quote -> literal | 
|---|
| 206 |  *      N backslashes + non-quote -> literal | 
|---|
| 207 |  *      quote + quote in a quoted string -> single quote | 
|---|
| 208 |  *      quote + quote not in quoted string -> empty string | 
|---|
| 209 |  *      quote -> begin quoted string | 
|---|
| 210 |  * | 
|---|
| 211 |  * Results: | 
|---|
| 212 |  *      Fills argcPtr with the number of arguments and argvPtr with the array | 
|---|
| 213 |  *      of arguments. | 
|---|
| 214 |  * | 
|---|
| 215 |  * Side effects: | 
|---|
| 216 |  *      Memory allocated. | 
|---|
| 217 |  * | 
|---|
| 218 |  *-------------------------------------------------------------------------- | 
|---|
| 219 |  */ | 
|---|
| 220 |  | 
|---|
| 221 | #if defined(__GNUC__) | 
|---|
| 222 | static void | 
|---|
| 223 | setargv( | 
|---|
| 224 |     int *argcPtr,               /* Filled with number of argument strings. */ | 
|---|
| 225 |     char ***argvPtr)            /* Filled with argument strings (malloc'd). */ | 
|---|
| 226 | { | 
|---|
| 227 |     char *cmdLine, *p, *arg, *argSpace; | 
|---|
| 228 |     char **argv; | 
|---|
| 229 |     int argc, size, inquote, copy, slashes; | 
|---|
| 230 |  | 
|---|
| 231 |     cmdLine = GetCommandLine(); /* INTL: BUG */ | 
|---|
| 232 |  | 
|---|
| 233 |     /* | 
|---|
| 234 |      * Precompute an overly pessimistic guess at the number of arguments in | 
|---|
| 235 |      * the command line by counting non-space spans. | 
|---|
| 236 |      */ | 
|---|
| 237 |  | 
|---|
| 238 |     size = 2; | 
|---|
| 239 |     for (p = cmdLine; *p != '\0'; p++) { | 
|---|
| 240 |         if ((*p == ' ') || (*p == '\t')) {      /* INTL: ISO space. */ | 
|---|
| 241 |             size++; | 
|---|
| 242 |             while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ | 
|---|
| 243 |                 p++; | 
|---|
| 244 |             } | 
|---|
| 245 |             if (*p == '\0') { | 
|---|
| 246 |                 break; | 
|---|
| 247 |             } | 
|---|
| 248 |         } | 
|---|
| 249 |     } | 
|---|
| 250 |     argSpace = (char *) ckalloc( | 
|---|
| 251 |             (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1)); | 
|---|
| 252 |     argv = (char **) argSpace; | 
|---|
| 253 |     argSpace += size * sizeof(char *); | 
|---|
| 254 |     size--; | 
|---|
| 255 |  | 
|---|
| 256 |     p = cmdLine; | 
|---|
| 257 |     for (argc = 0; argc < size; argc++) { | 
|---|
| 258 |         argv[argc] = arg = argSpace; | 
|---|
| 259 |         while ((*p == ' ') || (*p == '\t')) {   /* INTL: ISO space. */ | 
|---|
| 260 |             p++; | 
|---|
| 261 |         } | 
|---|
| 262 |         if (*p == '\0') { | 
|---|
| 263 |             break; | 
|---|
| 264 |         } | 
|---|
| 265 |  | 
|---|
| 266 |         inquote = 0; | 
|---|
| 267 |         slashes = 0; | 
|---|
| 268 |         while (1) { | 
|---|
| 269 |             copy = 1; | 
|---|
| 270 |             while (*p == '\\') { | 
|---|
| 271 |                 slashes++; | 
|---|
| 272 |                 p++; | 
|---|
| 273 |             } | 
|---|
| 274 |             if (*p == '"') { | 
|---|
| 275 |                 if ((slashes & 1) == 0) { | 
|---|
| 276 |                     copy = 0; | 
|---|
| 277 |                     if ((inquote) && (p[1] == '"')) { | 
|---|
| 278 |                         p++; | 
|---|
| 279 |                         copy = 1; | 
|---|
| 280 |                     } else { | 
|---|
| 281 |                         inquote = !inquote; | 
|---|
| 282 |                     } | 
|---|
| 283 |                 } | 
|---|
| 284 |                 slashes >>= 1; | 
|---|
| 285 |             } | 
|---|
| 286 |  | 
|---|
| 287 |             while (slashes) { | 
|---|
| 288 |                 *arg = '\\'; | 
|---|
| 289 |                 arg++; | 
|---|
| 290 |                 slashes--; | 
|---|
| 291 |             } | 
|---|
| 292 |  | 
|---|
| 293 |             if ((*p == '\0') || (!inquote && | 
|---|
| 294 |                     ((*p == ' ') || (*p == '\t')))) {   /* INTL: ISO space. */ | 
|---|
| 295 |                 break; | 
|---|
| 296 |             } | 
|---|
| 297 |             if (copy != 0) { | 
|---|
| 298 |                 *arg = *p; | 
|---|
| 299 |                 arg++; | 
|---|
| 300 |             } | 
|---|
| 301 |             p++; | 
|---|
| 302 |         } | 
|---|
| 303 |         *arg = '\0'; | 
|---|
| 304 |         argSpace = arg + 1; | 
|---|
| 305 |     } | 
|---|
| 306 |     argv[argc] = NULL; | 
|---|
| 307 |  | 
|---|
| 308 |     *argcPtr = argc; | 
|---|
| 309 |     *argvPtr = argv; | 
|---|
| 310 | } | 
|---|
| 311 | #endif /* __GNUC__ */ | 
|---|
| 312 |  | 
|---|
| 313 | /* | 
|---|
| 314 |  * Local Variables: | 
|---|
| 315 |  * mode: c | 
|---|
| 316 |  * c-basic-offset: 4 | 
|---|
| 317 |  * fill-column: 78 | 
|---|
| 318 |  * End: | 
|---|
| 319 |  */ | 
|---|