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