tcl/win/tclAppInit.c

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