4 * Provides a default version of the main program and Tcl_AppInit
5 * procedure for tclsh and other Tcl-based applications (without Tk).
6 * Note that this program must be built in Win32 console mode to work
9 * Copyright (c) 1993 The Regents of the University of California.
10 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
11 * Copyright (c) 1998-1999 Scriptics Corporation.
13 * See the file "license.terms" for information on usage and redistribution of
14 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
18 #define WIN32_LEAN_AND_MEAN
19 #define STRICT /* See MSDN Article Q83456 */
22 #undef WIN32_LEAN_AND_MEAN
28 extern Tcl_PackageInitProc Tcltest_Init;
29 extern Tcl_PackageInitProc Tcltest_SafeInit;
32 #if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES
33 extern Tcl_PackageInitProc Registry_Init;
34 extern Tcl_PackageInitProc Dde_Init;
35 extern Tcl_PackageInitProc Dde_SafeInit;
38 #if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS)
40 #endif /* __GNUC__ || TCL_BROKEN_MAINARGS */
41 #ifdef TCL_BROKEN_MAINARGS
42 static void setargv(int *argcPtr, TCHAR ***argvPtr);
43 #endif /* TCL_BROKEN_MAINARGS */
46 * The following #if block allows you to change the AppInit function by using
47 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
48 * #if checks for that #define and uses Tcl_AppInit if it does not exist.
51 #ifndef TCL_LOCAL_APPINIT
52 #define TCL_LOCAL_APPINIT Tcl_AppInit
55 # define MODULE_SCOPE extern
57 MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
60 * The following #if block allows you to change how Tcl finds the startup
61 * script, prime the library or encoding paths, fiddle with the argv, etc.,
62 * without needing to rewrite Tcl_Main()
65 #ifdef TCL_LOCAL_MAIN_HOOK
66 MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
70 *----------------------------------------------------------------------
74 * This is the main program for the application.
77 * None: Tcl_Main never returns here, so this procedure never returns
81 * Just about anything, since from here we call arbitrary Tcl code.
83 *----------------------------------------------------------------------
86 #ifdef TCL_BROKEN_MAINARGS
89 int argc, /* Number of command-line arguments. */
90 char *dummy[]) /* Not used. */
96 int argc, /* Number of command-line arguments. */
97 TCHAR *argv[]) /* Values of command-line arguments. */
103 * Set up the default locale to be standard "C" locale so parsing is
104 * performed correctly.
107 setlocale(LC_ALL, "C");
109 #ifdef TCL_BROKEN_MAINARGS
111 * Get our args from the c-runtime. Ignore command line.
114 setargv(&argc, &argv);
118 * Forward slashes substituted for backslashes.
121 for (p = argv[0]; *p != '\0'; p++) {
127 #ifdef TCL_LOCAL_MAIN_HOOK
128 TCL_LOCAL_MAIN_HOOK(&argc, &argv);
131 Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
132 return 0; /* Needed only to prevent compiler warning. */
136 *----------------------------------------------------------------------
140 * This procedure performs application-specific initialization. Most
141 * applications, especially those that incorporate additional packages,
142 * will have their own version of this procedure.
145 * Returns a standard Tcl completion code, and leaves an error message in
146 * the interp's result if an error occurs.
149 * Depends on the startup script.
151 *----------------------------------------------------------------------
156 Tcl_Interp *interp) /* Interpreter for application. */
158 if ((Tcl_Init)(interp) == TCL_ERROR) {
162 #if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES
163 if (Registry_Init(interp) == TCL_ERROR) {
166 Tcl_StaticPackage(interp, "Registry", Registry_Init, NULL);
168 if (Dde_Init(interp) == TCL_ERROR) {
171 Tcl_StaticPackage(interp, "Dde", Dde_Init, Dde_SafeInit);
175 if (Tcltest_Init(interp) == TCL_ERROR) {
178 Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
179 #endif /* TCL_TEST */
182 * Call the init procedures for included packages. Each call should look
185 * if (Mod_Init(interp) == TCL_ERROR) {
189 * where "Mod" is the name of the module. (Dynamically-loadable packages
190 * should have the same entry-point name.)
194 * Call Tcl_CreateCommand for application-specific commands, if they
195 * weren't already created by the init procedures called above.
199 * Specify a user-specific startup file to invoke if the application is
200 * run interactively. Typically the startup file is "~/.apprc" where "app"
201 * is the name of the application. If this line is deleted then no
202 * user-specific startup file will be run under any conditions.
205 (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
206 Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
211 *-------------------------------------------------------------------------
215 * Parse the Windows command line string into argc/argv. Done here
216 * because we don't trust the builtin argument parser in crt0. Windows
217 * applications are responsible for breaking their command line into
220 * 2N backslashes + quote -> N backslashes + begin quoted string
221 * 2N + 1 backslashes + quote -> literal
222 * N backslashes + non-quote -> literal
223 * quote + quote in a quoted string -> single quote
224 * quote + quote not in quoted string -> empty string
225 * quote -> begin quoted string
228 * Fills argcPtr with the number of arguments and argvPtr with the array
234 *--------------------------------------------------------------------------
237 #ifdef TCL_BROKEN_MAINARGS
240 int *argcPtr, /* Filled with number of argument strings. */
241 TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */
243 TCHAR *cmdLine, *p, *arg, *argSpace;
245 int argc, size, inquote, copy, slashes;
247 cmdLine = GetCommandLine();
250 * Precompute an overly pessimistic guess at the number of arguments in
251 * the command line by counting non-space spans.
255 for (p = cmdLine; *p != '\0'; p++) {
256 if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
258 while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
267 /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
271 argSpace = (TCHAR *)ckalloc(size * sizeof(char *)
272 + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
273 argv = (TCHAR **) argSpace;
274 argSpace += size * (sizeof(char *)/sizeof(TCHAR));
278 for (argc = 0; argc < size; argc++) {
279 argv[argc] = arg = argSpace;
280 while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
296 if ((slashes & 1) == 0) {
298 if ((inquote) && (p[1] == '"')) {
314 if ((*p == '\0') || (!inquote &&
315 ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
332 #endif /* TCL_BROKEN_MAINARGS */