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