1/*
2 * winMain.c --
3 *
4 *	Main entry point for wish and other Tk-based applications.
5 *
6 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
7 * Copyright (c) 1998-1999 by Scriptics Corporation.
8 *
9 * See the file "tcl-license.terms" for information on usage and redistribution
10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 *
12 * RCS: @(#) $Id: winMain.c,v 1.1 2004/05/23 22:50:39 neumann Exp $
13 */
14
15#include <tk.h>
16#define WIN32_LEAN_AND_MEAN
17#include <windows.h>
18#undef WIN32_LEAN_AND_MEAN
19#include <malloc.h>
20#include <locale.h>
21#if defined(VISUAL_CC)
22#  include "xotcl.h"
23#else
24#  include <xotcl.h>
25#endif
26
27#include "tkInt.h"
28
29/*
30 * The following declarations refer to internal Tk routines.  These
31 * interfaces are available for use, but are not supported.
32 */
33#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<2
34EXTERN void		TkConsoleCreate(void);
35EXTERN int		TkConsoleInit(Tcl_Interp *interp);
36#endif
37/*
38 * Forward declarations for procedures defined later in this file:
39 */
40
41static void		setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
42static void		WishPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format));
43
44#ifdef TK_TEST
45extern int		Tktest_Init(Tcl_Interp *interp);
46#endif /* TK_TEST */
47
48#ifdef TCL_TEST
49extern int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
50extern int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
51#endif /* TCL_TEST */
52
53static BOOL consoleRequired = TRUE;
54
55
56/*
57 *----------------------------------------------------------------------
58 *
59 * WinMain --
60 *
61 *	Main entry point from Windows.
62 *
63 * Results:
64 *	Returns false if initialization fails, otherwise it never
65 *	returns.
66 *
67 * Side effects:
68 *	Just about anything, since from here we call arbitrary Tcl code.
69 *
70 *----------------------------------------------------------------------
71 */
72
73int APIENTRY
74WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
75    HINSTANCE hInstance;
76    HINSTANCE hPrevInstance;
77    LPSTR lpszCmdLine;
78    int nCmdShow;
79{
80    char **argv;
81    int argc;
82#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<2
83   char buffer[MAX_PATH+1];
84   char *p;
85#endif
86    Tcl_SetPanicProc(WishPanic);
87
88    /*
89     * Set up the default locale to be standard "C" locale so parsing
90     * is performed correctly.
91     */
92
93    setlocale(LC_ALL, "C");
94#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>1
95    setargv(&argc, &argv);
96#endif
97    /*
98     * Increase the application queue size from default value of 8.
99     * At the default value, cross application SendMessage of WM_KILLFOCUS
100     * will fail because the handler will not be able to do a PostMessage!
101     * This is only needed for Windows 3.x, since NT dynamically expands
102     * the queue.
103     */
104
105    SetMessageQueue(64);
106
107    /*
108     * Create the console channels and install them as the standard
109     * channels.  All I/O will be discarded until Tk_CreateConsoleWindow is
110     * called to attach the console to a text widget.
111     */
112#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<2
113    TkConsoleCreate();
114
115    setargv(&argc, &argv);
116
117    /*
118     * Replace argv[0] with full pathname of executable, and forward
119     * slashes substituted for backslashes.
120     */
121
122    GetModuleFileName(NULL, buffer, sizeof(buffer));
123    argv[0] = buffer;
124    for (p = buffer; *p != '\0'; p++) {
125	if (*p == '\\') {
126	    *p = '/';
127	}
128    }
129#endif
130    consoleRequired = TRUE;
131
132    Tk_Main(argc, argv, Tcl_AppInit);
133    return 1;
134}
135
136
137/*
138 *----------------------------------------------------------------------
139 *
140 * Tcl_AppInit --
141 *
142 *	This procedure performs application-specific initialization.
143 *	Most applications, especially those that incorporate additional
144 *	packages, will have their own version of this procedure.
145 *
146 * Results:
147 *	Returns a standard Tcl completion code, and leaves an error
148 *	message in the interp's result if an error occurs.
149 *
150 * Side effects:
151 *	Depends on the startup script.
152 *
153 *----------------------------------------------------------------------
154 */
155
156int
157Tcl_AppInit(interp)
158    Tcl_Interp *interp;		/* Interpreter for application. */
159{
160    if (Tcl_Init(interp) == TCL_ERROR) {
161	goto error;
162    }
163    if (Tk_Init(interp) == TCL_ERROR) {
164	goto error;
165    }
166    Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
167
168    /*
169    if (Xotcl_Init(interp) == TCL_ERROR) {
170      return TCL_ERROR;
171    }
172    Tcl_StaticPackage(interp, "XOTcl", Xotcl_Init, 0);
173    */
174    if (Tcl_PkgRequire(interp, "XOTcl", XOTCLVERSION, 1) == NULL) {
175      return TCL_ERROR;
176    }
177
178    /*
179     *  This is xotclsh, so import all xotcl commands by
180     *  default into the global namespace.
181     */
182    if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
183            "::xotcl::*", /* allowOverwrite */ 1) != TCL_OK) {
184        return TCL_ERROR;
185    }
186
187    /*
188     * Initialize the console only if we are running as an interactive
189     * application.
190     */
191#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<2
192    if (TkConsoleInit(interp) == TCL_ERROR) {
193	goto error;
194    }
195#else
196    if (consoleRequired) {
197	if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
198	    goto error;
199	}
200    }
201#endif
202
203#ifdef TCL_TEST
204    if (Tcltest_Init(interp) == TCL_ERROR) {
205	return TCL_ERROR;
206    }
207    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
208            (Tcl_PackageInitProc *) NULL);
209    if (TclObjTest_Init(interp) == TCL_ERROR) {
210	return TCL_ERROR;
211    }
212#endif /* TCL_TEST */
213
214#ifdef TK_TEST
215    if (Tktest_Init(interp) == TCL_ERROR) {
216	goto error;
217    }
218    Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
219            (Tcl_PackageInitProc *) NULL);
220#endif /* TK_TEST */
221
222    Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY);
223    return TCL_OK;
224
225error:
226    WishPanic(Tcl_GetStringResult(interp));
227    return TCL_ERROR;
228}
229
230/*
231 *----------------------------------------------------------------------
232 *
233 * WishPanic --
234 *
235 *	Display a message and exit.
236 *
237 * Results:
238 *	None.
239 *
240 * Side effects:
241 *	Exits the program.
242 *
243 *----------------------------------------------------------------------
244 */
245
246void
247WishPanic TCL_VARARGS_DEF(CONST char *,arg1)
248{
249    va_list argList;
250    char buf[1024];
251    CONST char *format;
252
253    format = TCL_VARARGS_START(CONST char *,arg1,argList);
254    vsprintf(buf, format, argList);
255
256    MessageBeep(MB_ICONEXCLAMATION);
257    MessageBox(NULL, buf, "Fatal Error in Wish",
258	    MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
259#ifdef _MSC_VER
260    DebugBreak();
261#endif
262    ExitProcess(1);
263}
264/*
265 *-------------------------------------------------------------------------
266 *
267 * setargv --
268 *
269 *	Parse the Windows command line string into argc/argv.  Done here
270 *	because we don't trust the builtin argument parser in crt0.
271 *	Windows applications are responsible for breaking their command
272 *	line into arguments.
273 *
274 *	2N backslashes + quote -> N backslashes + begin quoted string
275 *	2N + 1 backslashes + quote -> literal
276 *	N backslashes + non-quote -> literal
277 *	quote + quote in a quoted string -> single quote
278 *	quote + quote not in quoted string -> empty string
279 *	quote -> begin quoted string
280 *
281 * Results:
282 *	Fills argcPtr with the number of arguments and argvPtr with the
283 *	array of arguments.
284 *
285 * Side effects:
286 *	Memory allocated.
287 *
288 *--------------------------------------------------------------------------
289 */
290
291static void
292setargv(argcPtr, argvPtr)
293    int *argcPtr;		/* Filled with number of argument strings. */
294    char ***argvPtr;		/* Filled with argument strings (malloc'd). */
295{
296    char *cmdLine, *p, *arg, *argSpace;
297    char **argv;
298    int argc, size, inquote, copy, slashes;
299
300    cmdLine = GetCommandLine();	/* INTL: BUG */
301
302    /*
303     * Precompute an overly pessimistic guess at the number of arguments
304     * in the command line by counting non-space spans.
305     */
306
307    size = 2;
308    for (p = cmdLine; *p != '\0'; p++) {
309	if ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
310	    size++;
311	    while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
312		p++;
313	    }
314	    if (*p == '\0') {
315		break;
316	    }
317	}
318    }
319    argSpace = (char *) Tcl_Alloc(
320	    (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
321    argv = (char **) argSpace;
322    argSpace += size * sizeof(char *);
323    size--;
324
325    p = cmdLine;
326    for (argc = 0; argc < size; argc++) {
327	argv[argc] = arg = argSpace;
328	while ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
329	    p++;
330	}
331	if (*p == '\0') {
332	    break;
333	}
334
335	inquote = 0;
336	slashes = 0;
337	while (1) {
338	    copy = 1;
339	    while (*p == '\\') {
340		slashes++;
341		p++;
342	    }
343	    if (*p == '"') {
344		if ((slashes & 1) == 0) {
345		    copy = 0;
346		    if ((inquote) && (p[1] == '"')) {
347			p++;
348			copy = 1;
349		    } else {
350			inquote = !inquote;
351		    }
352                }
353                slashes >>= 1;
354            }
355
356            while (slashes) {
357		*arg = '\\';
358		arg++;
359		slashes--;
360	    }
361
362	    if ((*p == '\0')
363		    || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
364		break;
365	    }
366	    if (copy != 0) {
367		*arg = *p;
368		arg++;
369	    }
370	    p++;
371        }
372	*arg = '\0';
373	argSpace = arg + 1;
374    }
375    argv[argc] = NULL;
376
377    *argcPtr = argc;
378    *argvPtr = argv;
379}
380
381
382/*
383 *----------------------------------------------------------------------
384 *
385 * main --
386 *
387 *	Main entry point from the console.
388 *
389 * Results:
390 *	None: Tk_Main never returns here, so this procedure never
391 *      returns either.
392 *
393 * Side effects:
394 *	Whatever the applications does.
395 *
396 *----------------------------------------------------------------------
397 */
398
399int main(int argc, char **argv)
400{
401    Tcl_SetPanicProc(WishPanic);
402
403    /*
404     * Set up the default locale to be standard "C" locale so parsing
405     * is performed correctly.
406     */
407
408    setlocale(LC_ALL, "C");
409    /*
410     * Increase the application queue size from default value of 8.
411     * At the default value, cross application SendMessage of WM_KILLFOCUS
412     * will fail because the handler will not be able to do a PostMessage!
413     * This is only needed for Windows 3.x, since NT dynamically expands
414     * the queue.
415     */
416
417    SetMessageQueue(64);
418
419    /*
420     * Create the console channels and install them as the standard
421     * channels.  All I/O will be discarded until Tk_CreateConsoleWindow is
422     * called to attach the console to a text widget.
423     */
424
425    consoleRequired = FALSE;
426
427    Tk_Main(argc, argv, Tcl_AppInit);
428    return 0;
429}
430
431