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 "license.terms" for information on usage and redistribution of
10 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 */
12
13 #include "tkInt.h"
14 #define WIN32_LEAN_AND_MEAN
15 #include <windows.h>
16 #undef WIN32_LEAN_AND_MEAN
17 #include <locale.h>
18
19 #if defined(__GNUC__)
20 int _CRT_glob = 0;
21 #endif /* __GNUC__ */
22
23 /*
24 * The following declarations refer to internal Tk routines. These interfaces
25 * are available for use, but are not supported.
26 */
27 #ifdef TK_TEST
28 extern Tcl_PackageInitProc Tktest_Init;
29 #endif /* TK_TEST */
30
31 #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
32 extern Tcl_PackageInitProc Registry_Init;
33 extern Tcl_PackageInitProc Dde_Init;
34 extern Tcl_PackageInitProc Dde_SafeInit;
35 #endif
36
37 /*
38 * Forward declarations for procedures defined later in this file:
39 */
40
41 static void WishPanic(CONST char *format, ...);
42
43 static BOOL consoleRequired = TRUE;
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 doesn't exist.
49 */
50
51 #ifndef TK_LOCAL_APPINIT
52 #define TK_LOCAL_APPINIT Tcl_AppInit
53 #endif
54 extern int TK_LOCAL_APPINIT(Tcl_Interp *interp);
55
56 /*
57 * The following #if block allows you to change how Tcl finds the startup
58 * script, prime the library or encoding paths, fiddle with the argv, etc.,
59 * without needing to rewrite Tk_Main()
60 */
61
62 #ifdef TK_LOCAL_MAIN_HOOK
63 extern int TK_LOCAL_MAIN_HOOK(int *argc, char ***argv);
64 #endif
65
66 /*
67 *----------------------------------------------------------------------
68 *
69 * WinMain --
70 *
71 * Main entry point from Windows.
72 *
73 * Results:
74 * Returns false if initialization fails, otherwise it never returns.
75 *
76 * Side effects:
77 * Just about anything, since from here we call arbitrary Tcl code.
78 *
79 *----------------------------------------------------------------------
80 */
81
82 int APIENTRY
WinMain(HINSTANCE hInstance,HINSTANCE hPrevInstance,LPSTR lpszCmdLine,int nCmdShow)83 WinMain(
84 HINSTANCE hInstance,
85 HINSTANCE hPrevInstance,
86 LPSTR lpszCmdLine,
87 int nCmdShow)
88 {
89 char **argv;
90 int argc;
91 char *p;
92
93 Tcl_SetPanicProc(WishPanic);
94
95 /*
96 * Create the console channels and install them as the standard channels.
97 * All I/O will be discarded until Tk_CreateConsoleWindow is called to
98 * attach the console to a text widget.
99 */
100
101 consoleRequired = TRUE;
102
103 /*
104 * Set up the default locale to be standard "C" locale so parsing is
105 * performed correctly.
106 */
107
108 setlocale(LC_ALL, "C");
109
110 /*
111 * Get our args from the c-runtime. Ignore lpszCmdLine.
112 */
113
114 argc = __argc;
115 argv = __argv;
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 TK_LOCAL_MAIN_HOOK
128 TK_LOCAL_MAIN_HOOK(&argc, &argv);
129 #endif
130
131 Tk_Main(argc, argv, TK_LOCAL_APPINIT);
132 return 1;
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
Tcl_AppInit(Tcl_Interp * interp)155 Tcl_AppInit(
156 Tcl_Interp *interp) /* Interpreter for application. */
157 {
158 #define TK_MAX_WARN_LEN 1024
159 WCHAR msgString[TK_MAX_WARN_LEN + 5];
160
161 if (Tcl_Init(interp) == TCL_ERROR) {
162 goto error;
163 }
164 if (Tk_Init(interp) == TCL_ERROR) {
165 goto error;
166 }
167 Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
168
169 /*
170 * Initialize the console only if we are running as an interactive
171 * application.
172 */
173
174 if (consoleRequired) {
175 if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
176 goto error;
177 }
178 }
179 #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
180 if (Registry_Init(interp) == TCL_ERROR) {
181 goto error;
182 }
183 Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
184
185 if (Dde_Init(interp) == TCL_ERROR) {
186 goto error;
187 }
188 Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);
189 #endif
190
191 #ifdef TK_TEST
192 if (Tktest_Init(interp) == TCL_ERROR) {
193 goto error;
194 }
195 Tcl_StaticPackage(interp, "Tktest", Tktest_Init, NULL);
196 #endif /* TK_TEST */
197
198 /*
199 * Call the init procedures for included packages. Each call should look
200 * like this:
201 *
202 * if (Mod_Init(interp) == TCL_ERROR) {
203 * return TCL_ERROR;
204 * }
205 *
206 * where "Mod" is the name of the module. (Dynamically-loadable packages
207 * should have the same entry-point name.)
208 */
209
210 /*
211 * Call Tcl_CreateCommand for application-specific commands, if they
212 * weren't already created by the init procedures called above.
213 */
214
215 /*
216 * Specify a user-specific startup file to invoke if the application is
217 * run interactively. Typically the startup file is "~/.apprc" where "app"
218 * is the name of the application. If this line is deleted then no user-
219 * specific startup file will be run under any conditions.
220 */
221
222 Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY);
223 return TCL_OK;
224
225 error:
226 MultiByteToWideChar(CP_UTF8, 0, Tcl_GetStringResult(interp), -1,
227 msgString, TK_MAX_WARN_LEN);
228 /*
229 * Truncate MessageBox string if it is too long to not overflow the screen
230 * and cause possible oversized window error.
231 */
232 memcpy(msgString + TK_MAX_WARN_LEN, L" ...", 5 * sizeof(WCHAR));
233 MessageBeep(MB_ICONEXCLAMATION);
234 MessageBoxW(NULL, msgString, L"Error in Wish",
235 MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
236 ExitProcess(1);
237
238 /*
239 * We won't reach this, but we need the return.
240 */
241
242 return TCL_ERROR;
243 }
244
245 /*
246 *----------------------------------------------------------------------
247 *
248 * WishPanic --
249 *
250 * Display a message and exit.
251 *
252 * Results:
253 * None.
254 *
255 * Side effects:
256 * Exits the program.
257 *
258 *----------------------------------------------------------------------
259 */
260
261 void
WishPanic(CONST char * format,...)262 WishPanic(
263 CONST char *format, ...)
264 {
265 va_list argList;
266 char buf[TK_MAX_WARN_LEN];
267 WCHAR msgString[TK_MAX_WARN_LEN + 5];
268
269 va_start(argList, format);
270 vsprintf(buf, format, argList);
271
272 MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TK_MAX_WARN_LEN);
273 /*
274 * Truncate MessageBox string if it is too long to not overflow the screen
275 * and cause possible oversized window error.
276 */
277 memcpy(msgString + TK_MAX_WARN_LEN, L" ...", 5 * sizeof(WCHAR));
278 MessageBeep(MB_ICONEXCLAMATION);
279 MessageBoxW(NULL, msgString, L"Fatal Error in Wish",
280 MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
281 #ifdef _MSC_VER
282 DebugBreak();
283 #endif
284 ExitProcess(1);
285 }
286
287 #if defined(TK_TEST)
288 /*
289 *----------------------------------------------------------------------
290 *
291 * main --
292 *
293 * Main entry point from the console.
294 *
295 * Results:
296 * None: Tk_Main never returns here, so this procedure never returns
297 * either.
298 *
299 * Side effects:
300 * Whatever the applications does.
301 *
302 *----------------------------------------------------------------------
303 */
304
305 int
main(int argc,char ** argv)306 main(
307 int argc,
308 char **argv)
309 {
310 Tcl_SetPanicProc(WishPanic);
311
312 /*
313 * Set up the default locale to be standard "C" locale so parsing is
314 * performed correctly.
315 */
316
317 setlocale(LC_ALL, "C");
318
319 /*
320 * Console emulation widget not required as this entry is from the
321 * console subsystem, thus stdin,out,err already have end-points.
322 */
323
324 consoleRequired = FALSE;
325
326 Tk_Main(argc, argv, Tcl_AppInit);
327 return 0;
328 }
329 #endif /* TK_TEST */
330 /*
331 * Local Variables:
332 * mode: c
333 * c-basic-offset: 4
334 * fill-column: 78
335 * End:
336 */
337