wok-6.x view tcl2c/stuff/tcl2c.u @ rev 21975
updated st (0.5 -> 0.8.2)
| author | Hans-G?nter Theisgen |
|---|---|
| date | Fri Oct 11 14:31:25 2019 +0100 (2019-10-11) |
| parents | 013bad3709d7 |
| children |
line source
1 http://web.tiscali.it/pas80/tklauncher.htm
2 http://web.tiscali.it/pas80/tcl2c.tar.gz
3 --- sourceforge/tcl2c.c
4 +++ Pasquale_Frega_fork/tcl2c.c
5 @@ -1,26 +1,10 @@
6 -//tcl2c @ 1997-2016 (04/2016) - Under G.P.L. License
7 -//Based on tcl2c.c written by: Jan Nijtmans
8 -//Cyril BARBATO
9 -//tcl2c.sourceforge.net
10 -//cyril.barbato@gmx.com
11 +#include <tcl.h>
13 -#include "tcl.h"
14 -#include <stdio.h>
15 -#include <stdlib.h>
16 -
17 -#ifdef _APPLICATION_IS_ROOT_PATH_
18 -#include <string.h>
19 -#include <limits.h>
20 -#include <unistd.h>
21 -#endif
22 -
23 #ifdef __cplusplus
24 extern C {
25 #endif
27 extern void exit _ANSI_ARGS_((int status));
28 -extern int isupper _ANSI_ARGS_((int ch));
29 -extern int tolower _ANSI_ARGS_((int ch));
31 #ifdef __cplusplus
32 }
33 @@ -44,55 +28,48 @@
35 static tableitem table[] = {
36 {"Tcl" ,"-tcl" , 1},
37 -{"Tk" ,"-tk" , 3},
38 -{"Tclx" ,"-tclx" , 5},
39 -{"Itcl" ,"-itcl" , 9},
40 -{"Otcl" ,"-otcl" , 17}, /* not tested yet */
41 -{"Pvm" ,"-pvm" , 33},
42 -{"Tkx" ,"-tkx" , 71},
43 -{"Itk" ,"-itk" , 139},
44 -{"Iwidgets" ,"-iwidgets" , 395},
45 -{"Img" ,"-img" ,515},
46 -{"Tix" ,"-tix" ,1027}, /* not tested yet */
47 -{"Blt" ,"-blt" ,2051}, /* not tested yet */
48 -{"Vtcl" ,"-vtcl" ,4103}, /* not tested yet */
49 +{"Tclx" ,"-tclx" , 3},
50 +{"Itcl" ,"-itcl" , 5},
51 +{"Otcl" ,"-otcl" , 9}, /* not tested yet */
52 +{"Pvm" ,"-pvm" , 17},
53 +{"Tk" ,"-tk" , 33},
54 +{"Tkx" ,"-tkx" , 99},
55 +{"Itk" ,"-itk" , 165},
56 +{"Iwidgets" ,"-iwidgets" , 421},
57 +{"Img" ,"-img" ,545},
58 +{"Tix" ,"-tix" ,1057}, /* not tested yet */
59 +{"Blt" ,"-blt" ,2081}, /* not tested yet */
60 +{"Vtcl" ,"-vtcl" ,4261}, /* not tested yet */
61 };
63 -static char verbose[] = "\n\
64 +static char *verbose = "\n\
65 *************************** tcl2c ********************************\n\
66 -Based on tcl2c.c written by: Jan Nijtmans\n\
67 - CMG (Computer Management Group) Arnhem B.V.\n\
68 - email: Jan.Nijtmans@wxs.nl (private)\n\
69 - Jan.Nijtmans@cmg.nl (work)\n\
70 - url: http://home.wxs.nl/~nijtmans/\n\n\
71 - new options for gcc by: Cyril Barbato (cyril.barbato@gmx.com)\n\
72 - -D__MALLOC__ : for using malloc()\n\
73 - -D__LIBPATH__=\"your lib\" : change tcl lib path\n\
74 - -D_APPLICATION_IS_ROOT_PATH_ : for application is root path\n\\n\
75 - -D_CONSOLEWOZHIDE_ : Hide windows console\n\\n\
76 - new, add 2 tcl commands for windows console :\n\
77 - _tcl2c_consoleWOZHide for Hide windows console\n\
78 - _tcl2c_consoleWOZShow for Show windows console\n\\n\
79 - url : http://tcl2c.sourceforge.net/\n\n\
80 - usage: tcl2c -o file source1 source2 ... ?options?\n\
81 +written by: Jan Nijtmans\n\
82 + NICI (Nijmegen Institute of Cognition and Information)\n\
83 + email: nijtmans@nici.kun.nl\n\
84 + url: http://www.cogsci.kun.nl/~nijtmans/\n\n\
85 +usage: tcl2c -o file source1 source2 ... ?options?\n\
86 tcl2c -help\n\
87 ";
89 -static char help[] = "\n\
90 +static char *help = "\n\
91 available options:\n\
92 -a use character array instead of string for script\n\
93 -n script_name name of script variable\n\
94 -o filename output file (default is stdout)\n\
95 -tcl use Tcl\n\
96 -tclx use Tclx\n\
97 + -itcl use Itcl\n\
98 -otcl use Otcl (not tested yet)\n\
99 -pvm use tkPvm\n\
100 -tk use Tk\n\
101 - -tkx use Tkx (not really useful)\n\
102 - -img use Img\n\
103 + -tkx use Tkx (not really usefull)\n\
104 + -itk use Itk\n\
105 + -iwidgets use Iwidgets\n\
106 -tix use Tix (not tested yet)\n\
107 -blt use Blt (not tested yet)\n\
108 -vtcl use Vtcl (not tested yet)\n\
109 + -index convert tclIndex files\n\n\
110 Other command line arguments are assumed to be tcl script-files. It is \n\
111 possible to include C-files (with the extension .c), which are already\n\
112 converted tcl-scripts. These are included using the \"#include\".\n\n\
113 @@ -101,7 +78,7 @@
115 static char *part1 = "\n\
116 /* This file is created by the \"tcl2c\" utility, which is included in\n\
117 - * most \"plus\"-patches (e.g. for Tcl8.6). Standalone\n\
118 + * most \"plus\"-patches (e.g. for Tcl7.6 and Tcl8.0). Standalone\n\
119 * executables can be made by providing alternative initialization\n\
120 * functions which don't read files any more. Sometimes, small\n\
121 * adaptations to the original libraries are needed to get the\n\
122 @@ -111,68 +88,29 @@
123 * easyly extend the \"tcl2c\" utility to your own requirements.\n\
124 *\n\
125 * Jan Nijtmans\n\
126 - * CMG (Computer Management Group) Arnhem B.V.\n\
127 - * email: Jan.Nijtmans@wxs.nl (private)\n\
128 - * Jan.Nijtmans@cmg.nl (work)\n\
129 - * url: http://home.wxs.nl/~nijtmans/\n\
130 - *\n\
131 - *new options for gcc by: Cyril Barbato (cyril.barbato@gmx.com)\n\
132 - * -D__MALLOC__ : for using malloc()\n\
133 - * -D__LIBPATH__=\"your lib\" : change tcl lib path\n\
134 - * -D_APPLICATION_IS_ROOT_PATH_ : for application is root path\n\\n\
135 - -D_CONSOLEWOZHIDE_ : Hide windows console\n\
136 - *\n\
137 - new, add 2 tcl commands for windows console :\n\
138 - _tcl2c_consoleWOZHide for Hide windows console\n\
139 - _tcl2c_consoleWOZShow for Show windows console\n\\n\
140 - *\n\
141 - * url: http://tcl2c.sourceforge.net/\n\
142 - *\n\
143 - * usage: tcl2c -o file source1 source2 ... ?options?\n\
144 - * tcl2c -help\n\
145 + * NICI (Nijmegen Institute of Cognition and Information)\n\
146 + * email: nijtmans@nici.kun.nl\n\
147 + * url: http://www.cogsci.kun.nl/~nijtmans/\n\
148 */\n\
149 +#define USE_INTERP_RESULT 1\n\
150 #include \"tcl.h\"\n\
151 -#ifdef _MACOSX_APP_\n\
152 -#import <crt_externs.h>\n\
153 -#endif\n\
154 -#ifdef __WIN32__\n\
155 -#define _WIN32_WINNT 0x0500\n\
156 -#define WIN32_LEAN_AND_MEAN\n\
157 -#include <windows.h>\n\
158 -#undef WIN32_LEAN_AND_MEAN\n\
159 -#ifndef __MALLOC_H__\n\
160 -#include <malloc.h>\n\
161 -#endif\n\
162 -#include <locale.h>\n\
163 -#ifndef __LIBPATH__\n\
164 -#define __LIBPATH__ \"lib\"\n\
165 -#endif\n\
166 -#include <unistd.h>\n\
167 -#ifdef _APPLICATION_IS_ROOT_PATH_\n\
168 -#include <string.h>\n\
169 -#include <limits.h>\n\
170 -#include <unistd.h>\n\
171 -#endif\n\
172 \n\
173 -static int setargv _ANSI_ARGS_((char ***argvPtr));\n\
174 -static void TclshPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));\n\
175 -extern void TclWinInit(HINSTANCE instance);\n\
176 -extern int Registry_Init _ANSI_ARGS_((Tcl_Interp *interp));\n\
177 -\n\
178 -#endif\n\
179 -\n\
180 /*\n\
181 * Defines to replace the standard Xxx_Init calls to Xxx_InitStandAlone.\n\
182 * If you don't have this function, just delete the corresponding\n\
183 * define such that the normal initialization function is used.\n\
184 - * If no Xxx_SafeInit function exists, use NULL pointers instead\n\
185 - * by commenting out the appropriate lines below.\n\
186 + * Similar: If SafeInit functions exists, you can use these\n\
187 + * by commenting out the corresponding lines below.\n\
188 */\n\
189 \n\
190 -#if defined(TCL_ACTIVE) && !defined(SHARED)\n\
191 +#ifdef TCL_ACTIVE\n\
192 ";
194 -static char *part2 = "\n\
195 +static char *part2 = "#endif\n\
196 +\n\
197 +";
198 +
199 +static char *part3 = "\n\
200 /*\n\
201 * Prototypes of all initialization functions and the free() function.\n\
202 * So, only \"tcl.h\" needs to be included now.\n\
203 @@ -182,27 +120,8 @@
204 extern \"C\" {\n\
205 #endif\n\
206 \n\
207 -#ifndef USE_TCLALLOC\n\
208 -# define USE_TCLALLOC 0\n\
209 -#endif\n\
210 -#if USE_TCLALLOC == 0\n\
211 extern void free _ANSI_ARGS_((void *));\n\
212 -extern VOID *malloc _ANSI_ARGS_((int));\n\
213 -#endif\n\
214 -extern int Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));\n\
215 -\n\
216 ";
217 -
218 -static char *part3 = "\n\
219 -extern void Tk_MainLoop _ANSI_ARGS_((void));\n\
220 -#define HAS_TK\n\
221 -#ifdef __WIN32__\n\
222 -extern void TkWinXInit _ANSI_ARGS_((HINSTANCE hinstance));\n\
223 -extern void TkWinXCleanup _ANSI_ARGS_((HINSTANCE hinstance));\n\
224 -#endif\n\
225 -\n\
226 -";
227 -
228 static char *part4 = "\n\
229 #ifdef __cplusplus\n\
230 }\n\
231 @@ -213,64 +132,10 @@
232 * It will be executed in tclAppInit() after the other initializations.\n\
233 */\n\
234 \n\
235 -";
236 -
237 -static char *part4a = "\
238 -static char *lineformat = \"%%.0s%%d\";\n\
239 static int line = (__LINE__ + 1);\n\
240 ";
242 -static char *part4b = "\
243 -static char *lineformat = \"%%s_line%%d\";\n\
244 -static int line = 0;\n\
245 -";
246 -
247 static char *part5 = "\
248 -#ifdef _APPLICATION_IS_ROOT_PATH_\n\
249 -#define PATH_MAX 1024\n\
250 -char abs_exe_path[PATH_MAX];\n\
251 -char *\n\
252 -#ifdef _USING_PROTOTYPES_\n\
253 -app_GetPath(\n\
254 - int argc,\n\
255 - char *argv[])\n\
256 -#else\n\
257 -app_GetPath(argc, argv)\n\
258 - int argc;\n\
259 - char *argv[];\n\
260 -#endif\n\
261 -{\n\
262 - char path_save[PATH_MAX];\n\
263 - char *p;\n\
264 - if(!(p = strrchr(argv[0], '/')))\n\
265 - getcwd(abs_exe_path, sizeof(abs_exe_path));\n\
266 - else\n\
267 - {\n\
268 - *p = '\\0';\n\
269 - getcwd(path_save, sizeof(path_save));\n\
270 - chdir(argv[0]);\n\
271 - getcwd(abs_exe_path, sizeof(abs_exe_path));\n\
272 - chdir(path_save);\n\
273 - }\n\
274 - //printf(\"Absolute path to executable is: %s\\n\", abs_exe_path);\n\
275 - return abs_exe_path;\n\
276 -};\n\
277 -#endif\n\
278 -#ifdef __WIN32__\n\
279 -HWND hConsoleWnd=NULL;\n\
280 -int _tcl2c_consoleWOZHideCmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) {\n\
281 - if (hConsoleWnd==NULL) {hConsoleWnd = GetConsoleWindow();};\n\
282 - if (hConsoleWnd==NULL) {return TCL_OK;};\n\
283 - SetWindowPos(hConsoleWnd,HWND_NOTOPMOST,0,0,320,240,SWP_HIDEWINDOW);\n\
284 - return TCL_OK;\n\
285 -};\n\
286 -int _tcl2c_consoleWOZShowCmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) {\n\
287 - if (hConsoleWnd==NULL) {hConsoleWnd = GetConsoleWindow();};\n\
288 - if (hConsoleWnd==NULL) {return TCL_OK;};\n\
289 - ShowWindow(hConsoleWnd,SW_SHOW);\n\
290 - return TCL_OK;\n\
291 -};\n\
292 -#endif\n\
293 /*\n\
294 *----------------------------------------------------------------------\n\
295 *\n\
296 @@ -287,18 +152,7 @@
297 *----------------------------------------------------------------------\n\
298 */\n\
299 \n\
300 -#if defined(__WIN32__) && defined(HAS_TK)\n\
301 -int APIENTRY\n\
302 -WinMain (HINSTANCE hInstance, HINSTANCE hPrevInstance,\n\
303 - LPSTR lpszCmdLine, int nCmdShow)\n\
304 -{\n\
305 - char **argv;\n\
306 - int argc;\n\
307 -#else\n\
308 -";
309 -//MAIN Tcl App
310 -static char *part5a = "\
311 -int\n\
312 +void\n\
313 #ifdef _USING_PROTOTYPES_\n\
314 main (int argc, /* Number of command-line arguments. */\n\
315 char **argv) /* Values of command-line arguments. */\n\
316 @@ -308,78 +162,12 @@
317 char **argv; /* Values of command-line arguments. */\n\
318 #endif\n\
319 {\n\
320 -#endif\n\
321 Tcl_Interp *interp;\n\
322 char **p = %s;\n\
323 - char *q, buffer[16];\n\
324 + char *q, buffer[10];\n\
325 Tcl_DString data;\n\
326 Tcl_Channel inChannel, outChannel, errChannel;\n\
327 \n\
328 -#ifdef __LIBPATH__\n\
329 - ////char _cwd[1024];\n\
330 - char _libpath[2048];\n\
331 -#endif\n\
332 -#ifdef __WIN32__\n\
333 - char argv0[128];\n\
334 -#endif\n\
335 -#ifdef _MACOSX_APP_\n\
336 -argc = *_NSGetArgc();\n\
337 -char *progname = *_NSGetProgname();\n\
338 -char **envp = *_NSGetEnviron();\n\
339 -argv = *_NSGetArgv();\n\
340 -#endif\n\
341 -#ifdef _APPLICATION_IS_ROOT_PATH_\n\
342 - /* GOTO APPLICATION PATH FOR MAC OS*/\n\
343 - chdir(app_GetPath(argc, argv));\n\
344 -#endif\n\
345 -#ifdef __WIN32__\n\
346 -#ifdef _CONSOLEWOZHIDE_\n\
347 -_tcl2c_consoleWOZHideCmd(NULL, NULL, NULL, (char **) NULL);\n\
348 -#endif\n\
349 -#if defined(TCL_ACTIVE) && !defined(SHARED) && defined(HAS_TK)\n\
350 - TclWinInit(hInstance);\n\
351 - TkWinXInit(hInstance);\n\
352 - Tcl_CreateExitHandler((Tcl_ExitProc *) TkWinXCleanup, (ClientData) hInstance);\n\
353 -#endif\n\
354 -\n\
355 - Tcl_SetPanicProc(TclshPanic);\n\
356 -\n";
357 -
358 -static char *part5b = "\n\
359 - /*\n\
360 - * Set up the default locale to be standard \"C\" locale so parsing\n\
361 - * is performed correctly.\n\
362 - */\n\
363 -\n\
364 - setlocale(LC_ALL, \"C\");\n\
365 -\n\
366 - /*\n\
367 - * Increase the application queue size from default value of 8.\n\
368 - * At the default value, cross application SendMessage of WM_KILLFOCUS\n\
369 - * will fail because the handler will not be able to do a PostMessage!\n\
370 - * This is only needed for Windows 3.x, since NT dynamically expands\n\
371 - * the queue.\n\
372 - */\n\
373 - SetMessageQueue(64);\n\
374 -\n\
375 - argc = setargv(&argv);\n\
376 -\n\
377 - /*\n\
378 - * Replace argv[0] with full pathname of executable, and forward\n\
379 - * slashes substituted for backslashes.\n\
380 - */\n\
381 -\n\
382 -";
383 -static char *part5c = "\
384 - GetModuleFileName(NULL, argv0, sizeof(argv0));\n\
385 - argv[0] = argv0;\n\
386 - for (q = argv0; *q != '\\0'; q++) {\n\
387 - if (*q == '\\\\') {\n\
388 - *q = '/';\n\
389 - }\n\
390 - }\n\
391 -\n\
392 -#endif\n\
393 Tcl_FindExecutable(argv[0]);\n\
394 interp = Tcl_CreateInterp();\n\
395 \n\
396 @@ -391,32 +179,8 @@
397 Tcl_SetVar(interp, \"argv0\", argv[0],TCL_GLOBAL_ONLY);\n\
398 Tcl_SetVar(interp, \"tcl_interactive\",\"0\", TCL_GLOBAL_ONLY);\n\
399 \n\
400 -#ifdef __LIBPATH__\n\
401 - ////chdir(__LIBPATH__);\n\
402 - ////getcwd(_cwd,sizeof(_cwd));\n\
403 - ////printf(\"libpath:%%s\\n\", _cwd);\n\
404 - sprintf(_libpath, \"set env(PWD) [pwd]\");\n\
405 - Tcl_Eval(interp, _libpath);\n\
406 - sprintf(_libpath, \"%%s/%%s/tcl%%s\", Tcl_GetVar2(interp, \"env\", \"PWD\", TCL_GLOBAL_ONLY),__LIBPATH__, Tcl_GetVar(interp,\"tcl_version\", TCL_GLOBAL_ONLY));\n\
407 - Tcl_SetVar2(interp, \"env\", \"TCL_LIBRARY\", _libpath, TCL_GLOBAL_ONLY);\n\
408 - Tcl_SetVar2(interp, \"env\", \"TK_LIBRARY\", _libpath, TCL_GLOBAL_ONLY);\n\
409 - Tcl_SetVar(interp, \"auto_path\", _libpath, TCL_GLOBAL_ONLY);\n\
410 - Tcl_SetVar(interp, \"tcl_libPath\", _libpath, TCL_GLOBAL_ONLY);\n\
411 -#endif\n\
412 -\n\
413 -if (Tcl_Init(interp) != TCL_OK) {\n\
414 - goto error;\n\
415 - }\n\
416 -\n\
417 -#ifdef __WIN32__\n\
418 - Tcl_StaticPackage((Tcl_Interp *) NULL, \"registry\", Registry_Init,\n\
419 - (Tcl_PackageInitProc *) NULL);\n\n\
420 - //Create commands _tcl2c_consoleWOZHide and _tcl2c_consoleWOZShow\n\
421 - Tcl_CreateCommand(interp, \"_tcl2c_consoleWOZHide\", _tcl2c_consoleWOZHideCmd, NULL, NULL);\n\
422 - Tcl_CreateCommand(interp, \"_tcl2c_consoleWOZShow\", _tcl2c_consoleWOZShowCmd, NULL, NULL);\n\n\
423 -#endif\n\
424 -\n\
425 ";
426 +
427 static char *part6 = "\n\
428 /*\n\
429 * Execute the script that is compiled in.\n\
430 @@ -436,17 +200,27 @@
431 }\n\
432 line++;\n\
433 }\n\
434 - sprintf(buffer,lineformat,\"%s\",line);\n\
435 - printf(\"ERROR : (line %%s) : %%s\\n\", buffer, Tcl_GetVar(interp, \"errorInfo\", TCL_GLOBAL_ONLY));\n\
436 + sprintf(buffer,\"%%d\",line);\n\
437 + Tcl_AddErrorInfo(interp,\"\\n ( Error in file: \\\"\");\n\
438 + Tcl_AddErrorInfo(interp,__FILE__);\n\
439 + Tcl_AddErrorInfo(interp,\"\\\", line: \");\n\
440 + Tcl_AddErrorInfo(interp,buffer);\n\
441 + Tcl_AddErrorInfo(interp,\")\");\n\
442 + errChannel = Tcl_GetStdChannel(TCL_STDERR);\n\
443 + if (errChannel) {\n\
444 + Tcl_Write(errChannel,\n\
445 + Tcl_GetVar(interp, \"errorInfo\", TCL_GLOBAL_ONLY), -1);\n\
446 + Tcl_Write(errChannel, \"\\n\", 1);\n\
447 + }\n\
448 + sprintf(buffer, \"exit %%d\", 1);\n\
449 Tcl_Eval(interp, buffer);\n\
450 - }};\n\
451 -";
452 -
453 -static char *part6a = "\
454 - Tk_MainLoop();\n\
455 -";
456 -
457 -static char *part6b = "\
458 + }\n\
459 + }\n\
460 + Tcl_DStringFree(&data);\n\
461 +\n\
462 + while (Tcl_DoOneEvent(0)) {\n\
463 + /* empty loop body */ ;\n\
464 + }\n\
465 sprintf(buffer, \"exit %%d\", 0);\n\
466 Tcl_Eval(interp, buffer);\n\
467 \n\
468 @@ -455,185 +229,20 @@
469 if (errChannel) {\n\
470 Tcl_Write(errChannel,\n\
471 \"application-specific initialization failed: \", -1);\n\
472 - Tcl_Write(errChannel, Tcl_GetStringResult(interp), -1);\n\
473 + Tcl_Write(errChannel, interp->result, -1);\n\
474 Tcl_Write(errChannel, \"\\n\", 1);\n\
475 }\n\
476 -#ifdef __WIN32__\n\
477 - TclshPanic(Tcl_GetStringResult(interp));\n\
478 -#endif\n\
479 sprintf(buffer, \"exit %%d\", 1);\n\
480 Tcl_Eval(interp, buffer);\n\
481 - return 0;\n\
482 }\n\
483 -\n\
484 -#ifdef __WIN32__\n\
485 -/*\n\
486 - *----------------------------------------------------------------------\n\
487 - *\n\
488 - * TclshPanic --\n\
489 - *\n\
490 - * Display a message and exit.\n\
491 - *\n\
492 - * Results:\n\
493 - * None.\n\
494 - *\n\
495 - * Side effects:\n\
496 - * Exits the program.\n\
497 - *\n\
498 - *----------------------------------------------------------------------\n\
499 - */\n\
500 -\n\
501 -void\n\
502 -TclshPanic TCL_VARARGS_DEF(char *,arg1)\n\
503 -{\n\
504 - va_list argList;\n\
505 - char buf[1024];\n\
506 - char *format;\n\
507 -\n\
508 - format = TCL_VARARGS_START(char *,arg1,argList);\n\
509 - vsprintf(buf, format, argList);\n\
510 -\n\
511 - MessageBeep(MB_ICONEXCLAMATION);\n\
512 - MessageBox(NULL, buf, \"Fatal Error in Tclsh\",\n\
513 - MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);\n\
514 -#ifdef _MSC_VER\n\
515 - DebugBreak();\n\
516 -#endif\n\
517 - ExitProcess(1);\n\
518 -}\n\
519 ";
521 -static char *part6c = "\
522 -\n\
523 -/*\n\
524 - *-------------------------------------------------------------------------\n\
525 - *\n\
526 - * setargv --\n\
527 - *\n\
528 - * Parse the Windows command line string into argc/argv. Done here\n\
529 - * because we don't trust the builtin argument parser in crt0. \n\
530 - * Windows applications are responsible for breaking their command\n\
531 - * line into arguments.\n\
532 - *\n\
533 - * 2N backslashes + quote -> N backslashes + begin quoted string\n\
534 - * 2N + 1 backslashes + quote -> literal\n\
535 - * N backslashes + non-quote -> literal\n\
536 - * quote + quote in a quoted string -> single quote\n\
537 - * quote + quote not in quoted string -> empty string\n\
538 - * quote -> begin quoted string\n\
539 - *\n\
540 - * Results:\n\
541 - * returns the number of arguments and fill argvPtr with the\n\
542 - * array of arguments.\n\
543 - *\n\
544 - * Side effects:\n\
545 - * Memory allocated.\n\
546 - *\n\
547 - *--------------------------------------------------------------------------\n\
548 - */\n\
549 -\n\
550 -";
551 -
552 -static char *part6d = "\
553 -static int\n\
554 -setargv(argvPtr)\n\
555 - char ***argvPtr; /* Filled with argument strings (malloc'd). */\n\
556 -{\n\
557 - char *cmdLine, *p, *arg, *argSpace;\n\
558 - char **argv;\n\
559 - int argc, size, inquote, copy, slashes;\n\
560 -\n\
561 - cmdLine = GetCommandLine();\n\
562 -\n\
563 - /*\n\
564 - * Precompute an overly pessimistic guess at the number of arguments\n\
565 - * in the command line by counting non-space spans.\n\
566 - */\n\
567 -\n\
568 - size = 2;\n\
569 - for (p = cmdLine; *p != '\\0'; p++) {\n\
570 - if (isspace(*p)) {\n\
571 - size++;\n\
572 - while (isspace(*p)) {\n\
573 - p++;\n\
574 - }\n\
575 - if (*p == '\\0') {\n\
576 - break;\n\
577 - }\n\
578 - }\n\
579 - }\n\
580 - argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *)\n\
581 - + strlen(cmdLine) + 1));\n\
582 - argv = (char **) argSpace;\n\
583 - argSpace += size * sizeof(char *);\n\
584 - size--;\n\
585 -\n\
586 - p = cmdLine;\n\
587 - for (argc = 0; argc < size; argc++) {\n\
588 - argv[argc] = arg = argSpace;\n\
589 - while (isspace(*p)) {\n\
590 - p++;\n\
591 - }\n\
592 - if (*p == '\\0') {\n\
593 - break;\n\
594 - }\n\
595 -\n\
596 -";
597 -
598 -static char *part6e = "\
599 - inquote = 0;\n\
600 - slashes = 0;\n\
601 - while (1) {\n\
602 - copy = 1;\n\
603 - while (*p == '\\\\') {\n\
604 - slashes++;\n\
605 - p++;\n\
606 - }\n\
607 - if (*p == '\"') {\n\
608 - if ((slashes & 1) == 0) {\n\
609 - copy = 0;\n\
610 - if ((inquote) && (p[1] == '\"')) {\n\
611 - p++;\n\
612 - copy = 1;\n\
613 - } else {\n\
614 - inquote = !inquote;\n\
615 - }\n\
616 - }\n\
617 - slashes >>= 1;\n\
618 - }\n\
619 -\n\
620 - while (slashes) {\n\
621 - *arg = '\\\\';\n\
622 - arg++;\n\
623 - slashes--;\n\
624 - }\n\
625 -\n\
626 - if ((*p == '\\0') || (!inquote && isspace(*p))) {\n\
627 - break;\n\
628 - }\n\
629 - if (copy != 0) {\n\
630 - *arg = *p;\n\
631 - arg++;\n\
632 - }\n\
633 - p++;\n\
634 - }\n\
635 - *arg = '\\0';\n\
636 - argSpace = arg + 1;\n\
637 - }\n\
638 - argv[argc] = NULL;\n\
639 -\n\
640 - *argvPtr = argv;\n\
641 - return argc;\n\
642 -}\n\
643 -#endif /* __WIN32__ */\n\
644 -";
645 -
646 -static char *defineproto = "\
647 +static char *defineproto1 = "\
648 #define %s_Init %s_InitStandAlone\n\
649 ";
651 static char *defineproto2 = "\
652 -/*#define %s_SafeInit ((Tcl_PackageInitProc *) NULL)*/\n\
653 +#define %s_SafeInit (Tcl_PackageInitProc *) NULL\n\
654 ";
656 static char *initproto = "\
657 @@ -653,9 +262,8 @@
658 }\n\
659 ";
661 -static char *buffer;
662 +static char buffer[32768];
663 static unsigned int max_buffer = 0;
664 -static unsigned int buffer_size = MAX_STRING_LEN;
665 static char max_buffer_content[80];
667 static char array_instead_of_string = 0;
668 @@ -663,23 +271,25 @@
670 static char script_name[256];
672 -int printline _ANSI_ARGS_((FILE *f, char *dir, int flags));
673 +int printline _ANSI_ARGS_((FILE *f, char *buf, char *dir, int flags));
674 int printfile _ANSI_ARGS_((FILE *fout, char *filename, char *dir, int flags));
676 int
677 #ifdef _USING_PROTOTYPES_
678 printline (
679 FILE *f,
680 + char *buf,
681 char *dir,
682 int flags)
683 #else
684 -printline(f, dir, flags)
685 +printline(f,buf,dir,flags)
686 FILE *f;
687 + char *buf;
688 char *dir;
689 int flags;
690 #endif
691 {
692 - char *p, *q, *buf = buffer;
693 + char *p,*q;
694 char path[128];
695 unsigned int l;
697 @@ -730,7 +340,7 @@
698 *q='}';
699 }
700 }
701 - p = buffer;
702 + p = buf;
703 while ((p = strstr(p, "[list source [file join $dir")) != NULL) {
704 q = strstr(p,".tcl]]");
705 if (q != NULL) {
706 @@ -805,14 +415,6 @@
707 p = q = buffer;
708 while ((c=fgetc(fin))!=EOF) {
709 *p = 0;
710 - if (p + 10 > buffer + buffer_size) {
711 - char *new;
712 - buffer_size += MAX_STRING_LEN;
713 - new = (char *) realloc(buffer, buffer_size);
714 - p = new + (p - buffer);
715 - q = new + (q - buffer);
716 - buffer = new;
717 - }
718 if (c=='\n') {
719 if (!strncmp(buffer,"if {[info exists tk_library] && [string compare $tk_library {}]} {",66)) {
720 int flag = 1;
721 @@ -823,6 +425,7 @@
722 flag--;
723 }
724 }
725 + flag=0;
726 p=q=buffer;
727 } else if ((p==buffer)||(*q=='\n')||(*q=='#')) {
728 if ((*q=='#') && (*(p-1)=='\\')) {
729 @@ -833,54 +436,23 @@
730 } else {
731 *p++ = '\n'; *p=0;
732 if (Tcl_CommandComplete(buffer)) {
733 - p--; *p = 0; printline(fout,dir,flags);
734 + p--; *p = 0; printline(fout,buffer,dir,flags);
735 p = q = buffer;
736 } else {
737 q=p;
738 }
739 }
740 } else {
741 - *p++ = (char) c;
742 + *p++ = c;
743 }
744 }
745 if (p!=buffer) {
746 - *p=0; printline(fout, dir, flags);
747 + *p=0; printline(fout,buffer,dir,flags);
748 }
749 fclose(fin);
750 return 0; /* O.K. */
751 }
753 -#ifdef _APPLICATION_IS_ROOT_PATH_
754 -char abs_exe_path[PATH_MAX];
755 -char *
756 -#ifdef _USING_PROTOTYPES_
757 -app_GetPath(
758 - int argc,
759 - char *argv[])
760 -#else
761 -app_GetPath(argc, argv)
762 - int argc;
763 - char *argv[];
764 -#endif
765 -{
766 - char path_save[PATH_MAX];
767 - char *p;
768 - if(!(p = strrchr(argv[0], '/')))
769 - getcwd(abs_exe_path, sizeof(abs_exe_path));
770 - else
771 - {
772 - *p = '\0';
773 - getcwd(path_save, sizeof(path_save));
774 - chdir(argv[0]);
775 - getcwd(abs_exe_path, sizeof(abs_exe_path));
776 - chdir(path_save);
777 - }
778 - //printf("Absolute path to executable is: %s\n", abs_exe_path);
779 - return abs_exe_path;
780 -};
781 -#endif
782 -
783 -/* MAIN */
784 int
785 #ifdef _USING_PROTOTYPES_
786 main (
787 @@ -898,11 +470,6 @@
788 tableitem *t;
789 int c,i, flags=0;
791 -#ifdef _APPLICATION_IS_ROOT_PATH_
792 - /* GOTO APPLICATION PATH */
793 - chdir(app_GetPath(argc, argv));
794 -#endif
795 -
796 if (argc==1) {
797 printf(verbose);
798 exit(0);
799 @@ -921,6 +488,8 @@
800 i++; strcpy(script_name,argv[i]);
801 } else if (!strcmp(argv[i],"-o")) {
802 i++; filename = argv[i];
803 + } else if (!strcmp(argv[i],"-index")) {
804 + flags = -1;
805 } else {
806 for (t=table;t<table+(sizeof(table)/sizeof(tableitem));t++) {
807 if (!strcmp(argv[i],t->option)) {
808 @@ -950,61 +519,41 @@
809 p = q+1;
810 }
811 strcpy(script_name,p);
812 - q = script_name;
813 - while (*q) {
814 - if (*q == '.') {
815 - *q = '_';
816 - } else if (isupper(*q)) {
817 - *q = tolower(*q);
818 - }
819 - q++;
820 - }
821 while ((q = strchr(script_name,'.')) != NULL) {
822 *q = '_';
823 }
824 /* create prototypes for all initialization functions that are used */
825 - if (flags) {
826 + if (flags && (flags != -1)) {
827 if (script_name[0] == 0) {
828 strcpy(script_name,"script");
829 }
830 fprintf(fout, part1);
831 for (i=0,c=1;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
832 if (flags & c) {
833 - fprintf(fout,defineproto,table[i].package,
834 + fprintf(fout,defineproto1,table[i].package,
835 table[i].package);
836 }
837 }
838 - fprintf(fout, "#endif\n\n");
839 - for (i=1,c=2;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
840 + fprintf(fout, part2);
841 + for (i=0,c=1;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
842 if (flags & c) {
843 fprintf(fout,defineproto2,table[i].package);
844 }
845 }
846 - fprintf(fout, part2);
847 -
848 - if (flags & 2) {
849 fprintf(fout, part3);
850 - }
851 - for (i=1,c=2;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
852 + for (i=0,c=1;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
853 if (flags & c) {
854 fprintf(fout,initproto,table[i].package,
855 table[i].package,table[i].package);
856 }
857 }
858 fprintf(fout, part4, script_name);
859 - if (array_instead_of_string) {
860 - fprintf(fout, part4b);
861 - } else {
862 - fprintf(fout, part4a);
863 }
864 - }
865 if ( !array_instead_of_string && script_name[0]) {
866 fprintf(fout, "static char *%s[] = {\n", script_name);
867 }
868 /* handle all remaining arguments */
869 if (argc) {argc--; argv++;}
870 - buffer = (char *) malloc(4*MAX_STRING_LEN);
871 - buffer_size = 4*MAX_STRING_LEN;
872 while(argc) {
873 if ((*argv)[0]=='-') {
874 if ((((*argv)[1]=='o')||((*argv)[1]=='n'))&&((*argv)[2]==0)) {
875 @@ -1021,7 +570,6 @@
876 }
877 argc--; argv++;
878 }
879 - free(buffer);
880 if ( array_instead_of_string ) {
881 fprintf(fout, "static char *%s[] = {\n", script_name);
882 for (i = 0; (unsigned int)i < num_lines;)
883 @@ -1031,39 +579,34 @@
884 fprintf(fout, "(char *) NULL\n};\n\n");
885 }
886 /* end of scripts, finally the functions main() and tclAppInit() */
887 - if (flags) {
888 + if (flags && (flags != -1)) {
889 fprintf(fout, part5, script_name);
890 - fprintf(fout, part5a, script_name);
891 - fprintf(fout, part5b);
892 - fprintf(fout, part5c);
893 - for (i=1,c=2;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
894 - if (flags & c) {
895 - fprintf(fout,callinit,table[i].package);
896 + fprintf(fout,callinit,table[0].package);
897 + if (flags & 0x20) {
898 + fprintf(fout,callinit,table[5].package);
899 + }
900 + for (i=0,c=1;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
901 + if ((flags & c) && (i!=0))
902 fprintf(fout,packageproto,table[i].package,table[i].package,table[i].package);
903 }
904 + for (i=0,c=1;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
905 + if ((flags & c) && (i!=0) && (i!=5))
906 + fprintf(fout,callinit,table[i].package);
907 }
908 p=filename?filename:"app";
909 if ((q=strrchr(p,'/')) != NULL) p=q+1;
910 if ((q=strchr(p,'.')) != NULL) *q=0;
911 if (!*p) p="app";
912 - fprintf(fout, part6,script_name,script_name,p,p);
913 - if (flags & 2) {
914 - fprintf(fout, part6a);
915 + fprintf(fout, part6,script_name,p,p);
916 }
917 - fprintf(fout, part6b);
918 - fprintf(fout, part6c);
919 - fprintf(fout, part6d);
920 - fprintf(fout, part6e);
921 - }
922 /* close output-file, if not stdout */
923 if (fout!=stdout) {
924 fclose(fout);
925 }
926 if (max_buffer>MAX_STRING_LEN) {
927 - fprintf(stderr,"warning: largest sting in output file is %d bytes\n\
928 + fprintf(stderr,"warning: largest string in output file is %d bytes\n\
929 many compilers can only handle %d characters in a string\n\
930 first line: %s\n",max_buffer,MAX_STRING_LEN,max_buffer_content);
931 }
932 exit(0);
933 - return 0;
934 }