1 /*
2 * tclAppInit.c --
3 *
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
7 * properly.
8 *
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.
12 *
13 * See the file "license.terms" for information on usage and redistribution of
14 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 */
16
17 #include "tcl.h"
18 #define WIN32_LEAN_AND_MEAN
19 #define STRICT /* See MSDN Article Q83456 */
20 #include <windows.h>
21 #undef STRICT
22 #undef WIN32_LEAN_AND_MEAN
23 #include <locale.h>
24 #include <stdlib.h>
25 #include <tchar.h>
26
27 #ifdef TCL_TEST
28 extern Tcl_PackageInitProc Tcltest_Init;
29 extern Tcl_PackageInitProc Tcltest_SafeInit;
30 #endif /* TCL_TEST */
31
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;
36 #endif
37
38 #if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS)
39 int _CRT_glob = 0;
40 #endif /* __GNUC__ || TCL_BROKEN_MAINARGS */
41 #ifdef TCL_BROKEN_MAINARGS
42 static void setargv(int *argcPtr, TCHAR ***argvPtr);
43 #endif /* TCL_BROKEN_MAINARGS */
44
45 /*
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.
49 */
50
51 #ifndef TCL_LOCAL_APPINIT
52 #define TCL_LOCAL_APPINIT Tcl_AppInit
53 #endif
54 #ifndef MODULE_SCOPE
55 # define MODULE_SCOPE extern
56 #endif
57 MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
58
59 /*
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()
63 */
64
65 #ifdef TCL_LOCAL_MAIN_HOOK
66 MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
67 #endif
68
69 /*
70 *----------------------------------------------------------------------
71 *
72 * main --
73 *
74 * This is the main program for the application.
75 *
76 * Results:
77 * None: Tcl_Main never returns here, so this procedure never returns
78 * either.
79 *
80 * Side effects:
81 * Just about anything, since from here we call arbitrary Tcl code.
82 *
83 *----------------------------------------------------------------------
84 */
85
86 #ifdef TCL_BROKEN_MAINARGS
87 int
main(int argc,char * dummy[])88 main(
89 int argc, /* Number of command-line arguments. */
90 char *dummy[]) /* Not used. */
91 {
92 TCHAR **argv;
93 #else
94 int
95 _tmain(
96 int argc, /* Number of command-line arguments. */
97 TCHAR *argv[]) /* Values of command-line arguments. */
98 {
99 #endif
100 TCHAR *p;
101
102 /*
103 * Set up the default locale to be standard "C" locale so parsing is
104 * performed correctly.
105 */
106
107 setlocale(LC_ALL, "C");
108
109 #ifdef TCL_BROKEN_MAINARGS
110 /*
111 * Get our args from the c-runtime. Ignore command line.
112 */
113
114 setargv(&argc, &argv);
115 #endif
116
117 /*
118 * Forward slashes substituted for backslashes.
119 */
120
121 for (p = argv[0]; *p != '\0'; p++) {
122 if (*p == '\\') {
123 *p = '/';
124 }
125 }
126
127 #ifdef TCL_LOCAL_MAIN_HOOK
128 TCL_LOCAL_MAIN_HOOK(&argc, &argv);
129 #endif
130
131 Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
132 return 0; /* Needed only to prevent compiler warning. */
133 }
134
135 /*
136 *----------------------------------------------------------------------
137 *
138 * Tcl_AppInit --
139 *
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.
143 *
144 * Results:
145 * Returns a standard Tcl completion code, and leaves an error message in
146 * the interp's result if an error occurs.
147 *
148 * Side effects:
149 * Depends on the startup script.
150 *
151 *----------------------------------------------------------------------
152 */
153
154 int
155 Tcl_AppInit(
156 Tcl_Interp *interp) /* Interpreter for application. */
157 {
158 if ((Tcl_Init)(interp) == TCL_ERROR) {
159 return TCL_ERROR;
160 }
161
162 #if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES
163 if (Registry_Init(interp) == TCL_ERROR) {
164 return TCL_ERROR;
165 }
166 Tcl_StaticPackage(interp, "Registry", Registry_Init, NULL);
167
168 if (Dde_Init(interp) == TCL_ERROR) {
169 return TCL_ERROR;
170 }
171 Tcl_StaticPackage(interp, "Dde", Dde_Init, Dde_SafeInit);
172 #endif
173
174 #ifdef TCL_TEST
175 if (Tcltest_Init(interp) == TCL_ERROR) {
176 return TCL_ERROR;
177 }
178 Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
179 #endif /* TCL_TEST */
180
181 /*
182 * Call the init procedures for included packages. Each call should look
183 * like this:
184 *
185 * if (Mod_Init(interp) == TCL_ERROR) {
186 * return TCL_ERROR;
187 * }
188 *
189 * where "Mod" is the name of the module. (Dynamically-loadable packages
190 * should have the same entry-point name.)
191 */
192
193 /*
194 * Call Tcl_CreateCommand for application-specific commands, if they
195 * weren't already created by the init procedures called above.
196 */
197
198 /*
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.
203 */
204
205 (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
206 Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
207 return TCL_OK;
208 }
209
210 /*
211 *-------------------------------------------------------------------------
212 *
213 * setargv --
214 *
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
218 * arguments.
219 *
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
226 *
227 * Results:
228 * Fills argcPtr with the number of arguments and argvPtr with the array
229 * of arguments.
230 *
231 * Side effects:
232 * Memory allocated.
233 *
234 *--------------------------------------------------------------------------
235 */
236
237 #ifdef TCL_BROKEN_MAINARGS
238 static void
239 setargv(
240 int *argcPtr, /* Filled with number of argument strings. */
241 TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */
242 {
243 TCHAR *cmdLine, *p, *arg, *argSpace;
244 TCHAR **argv;
245 int argc, size, inquote, copy, slashes;
246
247 cmdLine = GetCommandLine();
248
249 /*
250 * Precompute an overly pessimistic guess at the number of arguments in
251 * the command line by counting non-space spans.
252 */
253
254 size = 2;
255 for (p = cmdLine; *p != '\0'; p++) {
256 if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
257 size++;
258 while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
259 p++;
260 }
261 if (*p == '\0') {
262 break;
263 }
264 }
265 }
266
267 /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
268 #undef Tcl_Alloc
269 #undef Tcl_DbCkalloc
270
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));
275 size--;
276
277 p = cmdLine;
278 for (argc = 0; argc < size; argc++) {
279 argv[argc] = arg = argSpace;
280 while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
281 p++;
282 }
283 if (*p == '\0') {
284 break;
285 }
286
287 inquote = 0;
288 slashes = 0;
289 while (1) {
290 copy = 1;
291 while (*p == '\\') {
292 slashes++;
293 p++;
294 }
295 if (*p == '"') {
296 if ((slashes & 1) == 0) {
297 copy = 0;
298 if ((inquote) && (p[1] == '"')) {
299 p++;
300 copy = 1;
301 } else {
302 inquote = !inquote;
303 }
304 }
305 slashes >>= 1;
306 }
307
308 while (slashes) {
309 *arg = '\\';
310 arg++;
311 slashes--;
312 }
313
314 if ((*p == '\0') || (!inquote &&
315 ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
316 break;
317 }
318 if (copy != 0) {
319 *arg = *p;
320 arg++;
321 }
322 p++;
323 }
324 *arg = '\0';
325 argSpace = arg + 1;
326 }
327 argv[argc] = NULL;
328
329 *argcPtr = argc;
330 *argvPtr = argv;
331 }
332 #endif /* TCL_BROKEN_MAINARGS */
333
334 /*
335 * Local Variables:
336 * mode: c
337 * c-basic-offset: 4
338 * fill-column: 78
339 * End:
340 */
341