1 /* $Id: tixWinMain.c,v 1.2.2.1 2001/11/04 05:23:02 idiscovery Exp $ */
2
3 /*
4 * tixWinMain.c --
5 *
6 * Main entry point for wish and other Tk-based applications.
7 *
8 * Copyright (c) 1996, Expert Interface Technologies
9 *
10 * See the file "license.terms" for information on usage and redistribution
11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 *
14 */
15
16 #include <tk.h>
17 #include "tixInt.h"
18 #define WIN32_LEAN_AND_MEAN
19 #include <windows.h>
20 #undef WIN32_LEAN_AND_MEAN
21 #include <malloc.h>
22 #include <locale.h>
23
24 #ifdef ITCL_2
25 #include "itcl.h"
26 #include "itk.h"
27 #endif
28
29 /*
30 * The following declarations refer to internal Tk routines. These
31 * interfaces are available for use, but are not supported.
32 */
33 void TkConsoleCreate _ANSI_ARGS_((void));
34 int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
35 void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
36 int devId, char *buffer, long size));
37
38 /*
39 * Forward declarations for procedures defined later in this file:
40 */
41
42 static void WishPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));
43
44
45 /*
46 *----------------------------------------------------------------------
47 *
48 * WinMain --
49 *
50 * Main entry point from Windows.
51 *
52 * Results:
53 * Returns false if initialization fails, otherwise it never
54 * returns.
55 *
56 * Side effects:
57 * Just about anything, since from here we call arbitrary Tcl code.
58 *
59 *----------------------------------------------------------------------
60 */
61
62 int APIENTRY
WinMain(hInstance,hPrevInstance,lpszCmdLine,nCmdShow)63 WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
64 HINSTANCE hInstance;
65 HINSTANCE hPrevInstance;
66 LPSTR lpszCmdLine;
67 int nCmdShow;
68 {
69 char **argv, **argvlist, *p;
70 int argc, size, i;
71 char buffer[MAX_PATH];
72
73 Tcl_SetPanicProc(WishPanic);
74
75 /*
76 * Increase the application queue size from default value of 8.
77 * At the default value, cross application SendMessage of WM_KILLFOCUS
78 * will fail because the handler will not be able to do a PostMessage!
79 * This is only needed for Windows 3.x, since NT dynamically expands
80 * the queue.
81 */
82 SetMessageQueue(64);
83
84 /*
85 * Precompute an overly pessimistic guess at the number of arguments
86 * in the command line by counting non-space spans. Note that we
87 * have to allow room for the executable name and the trailing NULL
88 * argument.
89 */
90
91 for (size = 3, p = lpszCmdLine; *p != '\0'; p++) {
92 if (isspace(*p)) {
93 size++;
94 while (isspace(*p)) {
95 p++;
96 }
97 if (*p == '\0') {
98 break;
99 }
100 }
101 }
102 argvlist = (char **) ckalloc((unsigned) (size * sizeof(char *)));
103 argv = argvlist;
104
105 /*
106 * Parse the Windows command line string. If an argument begins with a
107 * double quote, then spaces are considered part of the argument until the
108 * next double quote. The argument terminates at the second quote. Note
109 * that this is different from the usual Unix semantics.
110 */
111
112 for (i = 1, p = lpszCmdLine; *p != '\0'; i++) {
113 while (isspace(*p)) {
114 p++;
115 }
116 if (*p == '\0') {
117 break;
118 }
119 if (*p == '"') {
120 p++;
121 argv[i] = p;
122 while ((*p != '\0') && (*p != '"')) {
123 p++;
124 }
125 } else {
126 argv[i] = p;
127 while (*p != '\0' && !isspace(*p)) {
128 p++;
129 }
130 }
131 if (*p != '\0') {
132 *p = '\0';
133 p++;
134 }
135 }
136 argv[i] = NULL;
137 argc = i;
138
139 /*
140 * Since Windows programs don't get passed the command name as the
141 * first argument, we need to fetch it explicitly.
142 */
143
144 GetModuleFileName(NULL, buffer, sizeof(buffer));
145 argv[0] = buffer;
146
147 Tk_Main(argc, argv, Tcl_AppInit);
148 return 1;
149 }
150
151
152 /*
153 *----------------------------------------------------------------------
154 *
155 * Tcl_AppInit --
156 *
157 * This procedure performs application-specific initialization.
158 * Most applications, especially those that incorporate additional
159 * packages, will have their own version of this procedure.
160 *
161 * Results:
162 * Returns a standard Tcl completion code, and leaves an error
163 * message in interp->result if an error occurs.
164 *
165 * Side effects:
166 * Depends on the startup script.
167 *
168 *----------------------------------------------------------------------
169 */
170
171 int
Tcl_AppInit(interp)172 Tcl_AppInit(interp)
173 Tcl_Interp *interp; /* Interpreter for application. */
174 {
175 /*
176 * Set up the default locale to be standard "C" locale so parsing
177 * is performed correctly.
178 */
179 setlocale(LC_ALL, "C");
180
181 /*
182 * Increase the application queue size from default value of 8.
183 * At the default value, cross application SendMessage of WM_KILLFOCUS
184 * will fail because the handler will not be able to do a PostMessage!
185 * This is only needed for Windows 3.x, since NT dynamically expands
186 * the queue.
187 */
188 SetMessageQueue(64);
189
190 /*
191 * Create the console channels and install them as the standard
192 * channels. All I/O will be discarded until TkConsoleInit is
193 * called to attach the console to a text widget.
194 */
195
196 TkConsoleCreate();
197
198 if (Tcl_Init(interp) == TCL_ERROR) {
199 if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
200 MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
201 "Tcl Init Error", MB_OK|MB_ICONSTOP);
202 } else {
203 MessageBox(NULL, interp->result, "Tcl Init Error",
204 MB_OK|MB_ICONSTOP );
205 }
206 return TCL_ERROR;
207 }
208
209 if (Tk_Init(interp) == TCL_ERROR) {
210 if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
211 MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
212 "Tk Init Error", MB_OK|MB_ICONSTOP);
213 } else {
214 MessageBox(NULL, interp->result, "Tk Init Error",
215 MB_OK|MB_ICONSTOP);
216 }
217 return TCL_ERROR;
218 }
219 Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
220
221 #ifdef ITCL_2
222 if (Itcl_Init(interp) == TCL_ERROR) {
223 if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
224 MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
225 "Itcl Init Error", MB_OK|MB_ICONSTOP);
226 } else {
227 MessageBox(NULL, interp->result, "Itcl Init Error",
228 MB_OK|MB_ICONSTOP);
229 }
230 return TCL_ERROR;
231 }
232 Tcl_StaticPackage(interp, "Itcl", Itcl_Init, (Tcl_PackageInitProc *) NULL);
233
234 if (Itk_Init(interp) == TCL_ERROR) {
235 if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
236 MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
237 "Itk Init Error", MB_OK|MB_ICONSTOP);
238 } else {
239 MessageBox(NULL, interp->result, "Itk Init Error",
240 MB_OK|MB_ICONSTOP);
241 }
242 return TCL_ERROR;
243 }
244 Tcl_StaticPackage(interp, "Itk", Itk_Init, (Tcl_PackageInitProc *) NULL);
245
246
247 /*
248 * This is itclsh, so import all [incr Tcl] commands by
249 * default into the global namespace. Fix up the autoloader
250 * to do the same.
251 */
252 if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
253 "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
254 return TCL_ERROR;
255 }
256
257 if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
258 return TCL_ERROR;
259 }
260
261 #endif
262
263 if (Tix_Init(interp) == TCL_ERROR) {
264 if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
265 MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
266 "Tix Init Error", MB_OK|MB_ICONSTOP);
267 } else {
268 MessageBox(NULL, interp->result, "Tix Init Error",
269 MB_OK|MB_ICONSTOP);
270 }
271 return TCL_ERROR;
272 }
273 Tcl_StaticPackage(interp, "Tix", Tix_Init, (Tcl_PackageInitProc *) NULL);
274
275 /*
276 * Initialize the console only if we are running as an interactive
277 * application.
278 */
279
280 if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
281 == 0) {
282 if (TkConsoleInit(interp) == TCL_ERROR) {
283 return TCL_ERROR;
284 }
285 }
286
287 /* Now done in Tix.tcl */
288 /* Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY); */
289 return TCL_OK;
290 }
291
292 /*
293 *----------------------------------------------------------------------
294 *
295 * WishPanic --
296 *
297 * Display a message and exit.
298 *
299 * Results:
300 * None.
301 *
302 * Side effects:
303 * Exits the program.
304 *
305 *----------------------------------------------------------------------
306 */
307
308 void
TCL_VARARGS_DEF(char *,arg1)309 WishPanic TCL_VARARGS_DEF(char *,arg1)
310 {
311 va_list argList;
312 char buf[1024];
313 char *format;
314
315 format = TCL_VARARGS_START(char *,arg1,argList);
316 vsprintf(buf, format, argList);
317
318 MessageBeep(MB_ICONEXCLAMATION);
319 MessageBox(NULL, buf, "Fatal Error in Wish",
320 MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
321 ExitProcess(1);
322 }
323
324