File:
[LON-CAPA] /
capa /
capa51 /
GUITools /
tcl2c-qz.c
Revision
1.1.1.1 (vendor branch):
download - view:
text,
annotated -
select for diffs
Tue Sep 28 21:25:36 1999 UTC (24 years, 9 months ago) by
albertel
Branches:
capa,
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_12_X,
version_2_11_X,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
version_1_2_0,
version_1_1_X,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
version_1_1_99_0,
version_1_1_3,
version_1_1_2,
version_1_1_1,
version_1_1_0,
version_1_0_99_3,
version_1_0_99_2,
version_1_0_99_1,
version_1_0_99,
version_1_0_3,
version_1_0_2,
version_1_0_1,
version_1_0_0,
version_0_99_5,
version_0_99_4,
version_0_99_3,
version_0_99_2,
version_0_99_1,
version_0_99_0,
version_0_6_2,
version_0_6,
version_0_5_1,
version_0_5,
version_0_4,
version5-1-2-first_release,
start,
stable_2002_spring,
stable_2002_july,
stable_2002_april,
stable_2001_fall,
release_5-1-3,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
conference_2003,
bz6209-base,
bz6209,
STABLE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
CAPA_5-1-6,
CAPA_5-1-5,
CAPA_5-1-4_RC1,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
Created directory structure
1: #include <tcl.h>
2: #include <stdio.h>
3:
4: #ifdef __cplusplus
5: extern C {
6: #endif
7:
8: extern void exit _ANSI_ARGS_((int status));
9: extern int isupper _ANSI_ARGS_((int ch));
10: extern int tolower _ANSI_ARGS_((int ch));
11:
12: #ifdef __cplusplus
13: }
14: #endif
15:
16: #define MAX_STRING_LEN 8192 /* give warning if string length exceeds this value */
17:
18: #ifdef NO_STRING_H
19: # include <strings.h>
20: # define strchr index
21: # define strrchr rindex
22: #else
23: # include <string.h>
24: #endif
25:
26: typedef struct tableitem {
27: char *package;/* corresponding packagename */
28: char *option; /* option expected */
29: int flag ; /* which packages are needed */
30: } tableitem;
31:
32: static tableitem table[] = {
33: {"Tcl" ,"-tcl" , 1},
34: {"Tk" ,"-tk" , 3},
35: {"Tclx" ,"-tclx" , 5},
36: {"Itcl" ,"-itcl" , 9},
37: {"Otcl" ,"-otcl" , 17}, /* not tested yet */
38: {"Pvm" ,"-pvm" , 33},
39: {"Tkx" ,"-tkx" , 71},
40: {"Itk" ,"-itk" , 139},
41: {"Iwidgets" ,"-iwidgets" , 395},
42: {"Img" ,"-img" ,515},
43: {"Tix" ,"-tix" ,1027}, /* not tested yet */
44: {"Blt" ,"-blt" ,2051}, /* not tested yet */
45: {"Vtcl" ,"-vtcl" ,4103}, /* not tested yet */
46: {"Quizzer", "-qz",8195},
47: {"Grader", "-gd", 16387},
48: {"Manager", "-mn", 32771},
49: {"Webpage", "-wb", 65537},
50: };
51:
52: static char *verbose = "\n\
53: *************************** tcl2c ********************************\n\
54: written by: Jan Nijtmans\n\
55: CMG (Computer Management Group) Arnhem B.V.\n\
56: email: nijtmans@worldaccess.nl (private)\n\
57: Jan.Nijtmans@cmg.nl (work)\n\
58: url: http://www.worldaccess.nl/~nijtmans/\n\n\
59: Modified by: Guy Albertelli \n\n\
60: usage: tcl2c -o file source1 source2 ... ?options?\n\
61: tcl2c -help\n\
62: ";
63:
64: static char *help = "\n\
65: available options:\n\
66: -a use character array instead of string for script\n\
67: -n script_name name of script variable\n\
68: -o filename output file (default is stdout)\n\
69: -tcl use Tcl\n\
70: -tclx use Tclx\n\
71: -otcl use Otcl (not tested yet)\n\
72: -pvm use tkPvm\n\
73: -tk use Tk\n\
74: -tkx use Tkx (not really useful)\n\
75: -img use Img\n\
76: -tix use Tix (not tested yet)\n\
77: -blt use Blt (not tested yet)\n\
78: -vtcl use Vtcl (not tested yet)\n\
79: -qz use Quizzer\n\
80: -gd use Grader\n\
81: Other command line arguments are assumed to be tcl script-files. It is \n\
82: possible to include C-files (with the extension .c), which are already\n\
83: converted tcl-scripts. These are included using the \"#include\".\n\n\
84: The output file can be compiled with any C or C++ compiler.\n\
85: ";
86:
87: static char *part1 = "\n\
88: /* This file is created by the \"tcl2c-qz\" utility, which is included in\n\
89: * most \"plus\"-patches (e.g. for Tcl7.6 and Tcl8.0). Standalone\n\
90: * executables can be made by providing alternative initialization\n\
91: * functions which don't read files any more. Sometimes, small\n\
92: * adaptations to the original libraries are needed to get the\n\
93: * application truly standalone. The \"plus\"-patches contain these\n\
94: * adaptations for Tcl and Tk. If you just create your own\n\
95: * Xxx_InitStandAlone() function for your package, you can\n\
96: * easyly extend the \"tcl2c\" utility to your own requirements.\n\
97: *\n\
98: * Jan Nijtmans\n\
99: * CMG (Computer Management Group) Arnhem B.V.\n\
100: * email: nijtmans@worldaccess.nl (private)\n\
101: * Jan.Nijtmans@cmg.nl (work)\n\
102: * url: http://www.worldaccess.nl/~nijtmans/\n\
103: */\n\
104: #include \"tcl.h\"\n\
105: #ifdef __WIN32__\n\
106: #define WIN32_LEAN_AND_MEAN\n\
107: #include <windows.h>\n\
108: #undef WIN32_LEAN_AND_MEAN\n\
109: #include <malloc.h>\n\
110: #include <locale.h>\n\
111: \n\
112: static int setargv _ANSI_ARGS_((char ***argvPtr));\n\
113: static void TclshPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));\n\
114: extern void TclWinSetTclInstance(HINSTANCE instance);\n\
115: \n\
116: #endif\n\
117: \n\
118: /*\n\
119: * Defines to replace the standard Xxx_Init calls to Xxx_InitStandAlone.\n\
120: * If you don't have this function, just delete the corresponding\n\
121: * define such that the normal initialization function is used.\n\
122: * Similar: If SafeInit functions exists, you can use these\n\
123: * by commenting out the corresponding lines below.\n\
124: */\n\
125: \n\
126: #if defined(TCL_ACTIVE) && !defined(SHARED)\n\
127: ";
128:
129: static char *part2 = "#endif\n\
130: \n\
131: #if TCL_MAJOR_VERSION < 8\n\
132: ";
133:
134: static char *part3 = "\
135: #endif\n\
136: \n\
137: /*\n\
138: * Prototypes of all initialization functions and the free() function.\n\
139: * So, only \"tcl.h\" needs to be included now.\n\
140: */\n\
141: \n\
142: #ifdef __cplusplus\n\
143: extern \"C\" {\n\
144: #endif\n\
145: \n\
146: #ifndef USE_TCLALLOC\n\
147: # define USE_TCLALLOC 0\n\
148: #endif\n\
149: #if USE_TCLALLOC == 0\n\
150: extern void free _ANSI_ARGS_((void *));\n\
151: #endif\n\
152: extern int Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));\n\
153: \n\
154: ";
155:
156: static char *part3a = "\n\
157: extern void Tk_MainLoop _ANSI_ARGS_((void));\n\
158: #define HAS_TK\n\
159: #ifdef __WIN32__\n\
160: extern void TkWinXInit _ANSI_ARGS_((HINSTANCE hinstance));\n\
161: extern void TkWinXCleanup _ANSI_ARGS_((HINSTANCE hinstance));\n\
162: #endif\n\
163: \n\
164: ";
165:
166: static char *part4 = "\n\
167: \n\
168: #ifdef __cplusplus\n\
169: }\n\
170: #endif\n\
171: \n\
172: /*\n\
173: * The array \"%s\" contains the script that is compiled in.\n\
174: * It will be executed in tclAppInit() after the other initializations.\n\
175: */\n\
176: \n\
177: ";
178:
179: static char *part4a = "\
180: static char *lineformat = \"%%.0s%%d\";\n\
181: static int line = (__LINE__ + 1);\n\
182: ";
183:
184: static char *part4b = "\
185: static char *lineformat = \"%%s_line%%d\";\n\
186: static int line = 0;\n\
187: ";
188:
189: static char *part5 = "\
190: /*\n\
191: *----------------------------------------------------------------------\n\
192: *\n\
193: * main --\n\
194: *\n\
195: * This is the main program for the application.\n\
196: *\n\
197: * Results:\n\
198: * None.\n\
199: *\n\
200: * Side effects:\n\
201: * Whatever the application does.\n\
202: *\n\
203: *----------------------------------------------------------------------\n\
204: */\n\
205: \n\
206: #if defined(__WIN32__) && defined(HAS_TK)\n\
207: int APIENTRY\n\
208: WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)\n\
209: HINSTANCE hInstance;\n\
210: HINSTANCE hPrevInstance;\n\
211: LPSTR lpszCmdLine;\n\
212: int nCmdShow;\n\
213: {\n\
214: char **argv;\n\
215: int argc;\n\
216: #else\n\
217: ";
218:
219: static char *part5a = "\
220: int\n\
221: #ifdef _USING_PROTOTYPES_\n\
222: main (int argc, /* Number of command-line arguments. */\n\
223: char **argv) /* Values of command-line arguments. */\n\
224: #else\n\
225: main(argc, argv)\n\
226: int argc; /* Number of command-line arguments. */\n\
227: char **argv; /* Values of command-line arguments. */\n\
228: #endif\n\
229: {\n\
230: #endif\n\
231: Tcl_Interp *interp;\n\
232: char **p = %s;\n\
233: char *q, buffer[256];\n\
234: Tcl_DString data;\n\
235: Tcl_Channel inChannel, outChannel, errChannel;\n\
236: \n\
237: #ifdef __WIN32__\n\
238: #if defined(TCL_ACTIVE) && !defined(SHARED) && defined(HAS_TK)\n\
239: TclWinSetTclInstance(hInstance);\n\
240: TkWinXInit(hInstance);\n\
241: Tcl_CreateExitHandler((Tcl_ExitProc *) TkWinXCleanup, (ClientData) hInstance);\n\
242: #endif\n\
243: \n\
244: Tcl_SetPanicProc(TclshPanic);\n\
245: \n";
246:
247: static char *part5b = "\n\
248: /*\n\
249: * Set up the default locale to be standard \"C\" locale so parsing\n\
250: * is performed correctly.\n\
251: */\n\
252: \n\
253: setlocale(LC_ALL, \"C\");\n\
254: \n\
255: /*\n\
256: * Increase the application queue size from default value of 8.\n\
257: * At the default value, cross application SendMessage of WM_KILLFOCUS\n\
258: * will fail because the handler will not be able to do a PostMessage!\n\
259: * This is only needed for Windows 3.x, since NT dynamically expands\n\
260: * the queue.\n\
261: */\n\
262: SetMessageQueue(64);\n\
263: \n\
264: argc = setargv(&argv);\n\
265: \n\
266: /*\n\
267: * Replace argv[0] with full pathname of executable, and forward\n\
268: * slashes substituted for backslashes.\n\
269: */\n\
270: \n\
271: ";
272:
273: static char *part5c = "\
274: GetModuleFileName(NULL, buffer, sizeof(buffer));\n\
275: argv[0] = buffer;\n\
276: for (q = buffer; *q != '\\0'; q++) {\n\
277: if (*q == '\\\\') {\n\
278: *q = '/';\n\
279: }\n\
280: }\n\
281: \n\
282: #endif\n\
283: Tcl_FindExecutable(argv[0]);\n\
284: interp = Tcl_CreateInterp();\n\
285: \n\
286: q = Tcl_Merge(argc-1, argv+1);\n\
287: Tcl_SetVar(interp, \"argv\", q, TCL_GLOBAL_ONLY);\n\
288: ckfree(q);\n\
289: sprintf(buffer, \"%%d\", argc-1);\n\
290: Tcl_SetVar(interp, \"argc\", buffer, TCL_GLOBAL_ONLY);\n\
291: Tcl_SetVar(interp, \"argv0\", argv[0],TCL_GLOBAL_ONLY);\n\
292: Tcl_SetVar(interp, \"tcl_interactive\",\"0\", TCL_GLOBAL_ONLY);\n\
293: \n\
294: ";
295:
296: static char *part6 = "\n\
297: /*\n\
298: * Execute the script that is compiled in.\n\
299: */\n\
300: \n\
301: inChannel = Tcl_GetStdChannel(TCL_STDIN);\n\
302: outChannel = Tcl_GetStdChannel(TCL_STDOUT);\n\
303: Tcl_DStringInit(&data);\n\
304: while(*p) {\n\
305: Tcl_DStringSetLength(&data,0);\n\
306: Tcl_DStringAppend(&data,*p++,-1);\n\
307: if (Tcl_Eval(interp,Tcl_DStringValue(&data)) != TCL_OK) {\n\
308: Tcl_DStringFree(&data);\n\
309: while (p-- != %s) {\n\
310: for (q = *p;*q; q++) {\n\
311: if (*q=='\\n') line++;\n\
312: }\n\
313: line++;\n\
314: }\n\
315: sprintf(buffer,lineformat,\"%s\",line);\n\
316: Tcl_AddErrorInfo(interp,\"\\n ( Error in file: \\\"\");\n\
317: Tcl_AddErrorInfo(interp,__FILE__);\n\
318: Tcl_AddErrorInfo(interp,\"\\\", line: \");\n\
319: Tcl_AddErrorInfo(interp,buffer);\n\
320: Tcl_AddErrorInfo(interp,\")\");\n\
321: errChannel = Tcl_GetStdChannel(TCL_STDERR);\n\
322: if (errChannel) {\n\
323: Tcl_Write(errChannel,\n\
324: Tcl_GetVar(interp, \"errorInfo\", TCL_GLOBAL_ONLY), -1);\n\
325: Tcl_Write(errChannel, \"\\n\", 1);\n\
326: }\n\
327: #ifdef __WIN32__\n\
328: TclshPanic(Tcl_GetVar(interp, \"errorInfo\", TCL_GLOBAL_ONLY));\n\
329: #endif\n\
330: sprintf(buffer, \"exit %%d\", 1);\n\
331: Tcl_Eval(interp, buffer);\n\
332: }\n\
333: }\n\
334: Tcl_DStringFree(&data);\n\
335: ";
336:
337: static char *part6a = "\
338: Tk_MainLoop();\n\
339: ";
340:
341: static char *part6b = "\
342: sprintf(buffer, \"exit %%d\", 0);\n\
343: Tcl_Eval(interp, buffer);\n\
344: \n\
345: error:\n\
346: errChannel = Tcl_GetStdChannel(TCL_STDERR);\n\
347: if (errChannel) {\n\
348: Tcl_Write(errChannel,\n\
349: \"application-specific initialization failed: \", -1);\n\
350: Tcl_Write(errChannel, interp->result, -1);\n\
351: Tcl_Write(errChannel, \"\\n\", 1);\n\
352: }\n\
353: #ifdef __WIN32__\n\
354: TclshPanic(interp->result);\n\
355: #endif\n\
356: sprintf(buffer, \"exit %%d\", 1);\n\
357: Tcl_Eval(interp, buffer);\n\
358: return 0;\n\
359: }\n\
360: \n\
361: #ifdef __WIN32__\n\
362: /*\n\
363: *----------------------------------------------------------------------\n\
364: *\n\
365: * TclshPanic --\n\
366: *\n\
367: * Display a message and exit.\n\
368: *\n\
369: * Results:\n\
370: * None.\n\
371: *\n\
372: * Side effects:\n\
373: * Exits the program.\n\
374: *\n\
375: *----------------------------------------------------------------------\n\
376: */\n\
377: \n\
378: void\n\
379: TclshPanic TCL_VARARGS_DEF(char *,arg1)\n\
380: {\n\
381: va_list argList;\n\
382: char buf[1024];\n\
383: char *format;\n\
384: \n\
385: format = TCL_VARARGS_START(char *,arg1,argList);\n\
386: vsprintf(buf, format, argList);\n\
387: \n\
388: MessageBeep(MB_ICONEXCLAMATION);\n\
389: MessageBox(NULL, buf, \"Fatal Error in Tclsh\",\n\
390: MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);\n\
391: #ifdef _MSC_VER\n\
392: _asm {\n\
393: int 3\n\
394: }\n\
395: #endif\n\
396: ExitProcess(1);\n\
397: }\n\
398: ";
399:
400: static char *part6c = "\
401: \n\
402: /*\n\
403: *-------------------------------------------------------------------------\n\
404: *\n\
405: * setargv --\n\
406: *\n\
407: * Parse the Windows command line string into argc/argv. Done here\n\
408: * because we don't trust the builtin argument parser in crt0. \n\
409: * Windows applications are responsible for breaking their command\n\
410: * line into arguments.\n\
411: *\n\
412: * 2N backslashes + quote -> N backslashes + begin quoted string\n\
413: * 2N + 1 backslashes + quote -> literal\n\
414: * N backslashes + non-quote -> literal\n\
415: * quote + quote in a quoted string -> single quote\n\
416: * quote + quote not in quoted string -> empty string\n\
417: * quote -> begin quoted string\n\
418: *\n\
419: * Results:\n\
420: * returns the number of arguments and fill argvPtr with the\n\
421: * array of arguments.\n\
422: *\n\
423: * Side effects:\n\
424: * Memory allocated.\n\
425: *\n\
426: *--------------------------------------------------------------------------\n\
427: */\n\
428: \n\
429: ";
430:
431: static char *part6d = "\
432: static int\n\
433: setargv(argvPtr)\n\
434: char ***argvPtr; /* Filled with argument strings (malloc'd). */\n\
435: {\n\
436: char *cmdLine, *p, *arg, *argSpace;\n\
437: char **argv;\n\
438: int argc, size, inquote, copy, slashes;\n\
439: \n\
440: cmdLine = GetCommandLine();\n\
441: \n\
442: /*\n\
443: * Precompute an overly pessimistic guess at the number of arguments\n\
444: * in the command line by counting non-space spans.\n\
445: */\n\
446: \n\
447: size = 2;\n\
448: for (p = cmdLine; *p != '\\0'; p++) {\n\
449: if (isspace(*p)) {\n\
450: size++;\n\
451: while (isspace(*p)) {\n\
452: p++;\n\
453: }\n\
454: if (*p == '\\0') {\n\
455: break;\n\
456: }\n\
457: }\n\
458: }\n\
459: argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *)\n\
460: + strlen(cmdLine) + 1));\n\
461: argv = (char **) argSpace;\n\
462: argSpace += size * sizeof(char *);\n\
463: size--;\n\
464: \n\
465: p = cmdLine;\n\
466: for (argc = 0; argc < size; argc++) {\n\
467: argv[argc] = arg = argSpace;\n\
468: while (isspace(*p)) {\n\
469: p++;\n\
470: }\n\
471: if (*p == '\\0') {\n\
472: break;\n\
473: }\n\
474: \n\
475: ";
476:
477: static char *part6e = "\
478: inquote = 0;\n\
479: slashes = 0;\n\
480: while (1) {\n\
481: copy = 1;\n\
482: while (*p == '\\\\') {\n\
483: slashes++;\n\
484: p++;\n\
485: }\n\
486: if (*p == '\"') {\n\
487: if ((slashes & 1) == 0) {\n\
488: copy = 0;\n\
489: if ((inquote) && (p[1] == '\"')) {\n\
490: p++;\n\
491: copy = 1;\n\
492: } else {\n\
493: inquote = !inquote;\n\
494: }\n\
495: }\n\
496: slashes >>= 1;\n\
497: }\n\
498: \n\
499: while (slashes) {\n\
500: *arg = '\\\\';\n\
501: arg++;\n\
502: slashes--;\n\
503: }\n\
504: \n\
505: if ((*p == '\\0') || (!inquote && isspace(*p))) {\n\
506: break;\n\
507: }\n\
508: if (copy != 0) {\n\
509: *arg = *p;\n\
510: arg++;\n\
511: }\n\
512: p++;\n\
513: }\n\
514: *arg = '\\0';\n\
515: argSpace = arg + 1;\n\
516: }\n\
517: argv[argc] = NULL;\n\
518: \n\
519: *argvPtr = argv;\n\
520: return argc;\n\
521: }\n\
522: #endif /* __WIN32__ */\n\
523: ";
524:
525: static char *partwebpage ="\
526: if (argc >1) {\n\
527: if (!strcmp(argv[1],\"-emailcapaid\")) { emailcapaid(argc,argv);return 0;}\n\
528: if (!strcmp(argv[1],\"-getid\")) { getid(argc,argv);return 0;}\n\
529: }\n\
530: ";
531:
532: static char *defineproto1 = "\
533: #define %s_Init %s_InitStandAlone\n\
534: ";
535:
536: static char *defineproto2 = "\
537: #define %s_SafeInit (Tcl_PackageInitProc *) NULL\n\
538: ";
539:
540: static char *initproto = "\
541: extern int %s_Init _ANSI_ARGS_((Tcl_Interp *interp));\n\
542: #ifndef %s_SafeInit\n\
543: extern int %s_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));\n\
544: #endif\n\
545: ";
546:
547: static char *packageproto = "\
548: Tcl_StaticPackage(interp, \"%s\", %s_Init, %s_SafeInit);\n\
549: ";
550:
551: static char *callinit = "\
552: if (%s_Init(interp) != TCL_OK) {\n\
553: goto error;\n\
554: }\n\
555: ";
556:
557: static char buffer[32768];
558: static unsigned int max_buffer = 0;
559: static char max_buffer_content[80];
560:
561: static char array_instead_of_string = 0;
562: static unsigned int num_lines = 0;
563:
564: static char script_name[256];
565:
566: int printline _ANSI_ARGS_((FILE *f, char *buf, char *dir, int flags));
567: int printfile _ANSI_ARGS_((FILE *fout, char *filename, char *dir, int flags));
568:
569: int
570: #ifdef _USING_PROTOTYPES_
571: printline (
572: FILE *f,
573: char *buf,
574: char *dir,
575: int flags)
576: #else
577: printline(f,buf,dir,flags)
578: FILE *f;
579: char *buf;
580: char *dir;
581: int flags;
582: #endif
583: {
584: char *p,*q;
585: char path[128];
586: unsigned int l;
587:
588: p=buf; while (*p=='\t' || *p==' ') p++;
589: if (!strncmp(p,"catch",5)) {
590: q=p+5; while (*q=='\t' || *q==' ') q++;
591: if (*q++=='{') {
592: while (*q=='\t' || *q==' ') q++;
593: if (strncmp(q,"source",6)) q=(char *)NULL;
594: } else {
595: q=(char *)NULL;
596: }
597: } else {
598: q=(char *)NULL;
599: }
600: if (!strncmp(p,"source",6) || q) {
601: if (q!=(char *)NULL) {
602: p = q;
603: }
604: p += 6;
605: while(*p=='\t' || *p==' ') p++;
606: if (*p=='/') {
607: strcpy(path,p);
608: } else {
609: strcpy(path,dir);
610: strcat(path,p);
611: }
612: if (q) {
613: q=strrchr(p,'}');
614: if (q) {
615: *q=0;
616: }
617: }
618:
619: if (!printfile(f, path, dir, flags)) {
620: return 0;
621: } else {
622: p = strrchr(p,'/');
623: if (p) {
624: strcpy(path,dir);
625: strcat(path,p+1);
626: if (!printfile(f ,path ,dir, flags)) {
627: return 0;
628: }
629: }
630: }
631: if (q) {
632: *q='}';
633: }
634: }
635: p = buf;
636: while ((p = strstr(p, "[list source [file join $dir")) != NULL) {
637: q = strstr(p,".tcl]]");
638: if (q != NULL) {
639: memcpy(p,"{source -rsrc",13);
640: memcpy(p+13,p+28,q-p-28);
641: memcpy(q-15,"}",1);
642: strcpy(q-14,q+6);
643: } else {
644: p++;
645: }
646: }
647: if (array_instead_of_string) {
648: fprintf(f, "\nstatic char %s_line%d[] = {\n ",
649: script_name, ++num_lines);
650: while (*buf) {
651: for (l = 0; *buf && l < 14; l++) {
652: fputc('\'', f);
653: if (*buf == '\n') { fprintf(f,"\\n',"); buf++; continue; }
654: if (*buf == '\'' || *buf == '\\') fputc('\\', f);
655: fprintf(f, "%c',", *buf++);
656: }
657: fprintf(f, "\n ");
658: }
659: fprintf(f, "'\\0' };\n");
660: } else {
661: fputc('\"',f);
662: l = strlen(buf);
663: if (l>max_buffer) {
664: max_buffer = l;
665: p = (strchr(buf,'\n'));
666: if (p) {
667: l = p - buf;
668: } else {
669: l = strlen(buf);
670: }
671: if (l>72) {l = 72;}
672: memcpy(max_buffer_content,buf,l);
673: max_buffer_content[l] = 0;
674: }
675: while(*buf) {
676: if (*buf=='\"'||*buf=='\\') fputc('\\',f);
677: if (*buf=='\n') {fputc('\\',f); fputc('n',f); fputc('\\',f); }
678: fputc(*buf++,f);
679: }
680: fprintf(f, "\",\n");
681: }
682: return 0;
683: }
684:
685: int
686: #ifdef _USING_PROTOTYPES_
687: printfile (
688: FILE *fout,
689: char *filename,
690: char *dir,
691: int flags)
692: #else
693: printfile(fout,filename,dir, flags)
694: FILE *fout;
695: char *filename;
696: char *dir;
697: int flags;
698: #endif
699: {
700: FILE *fin;
701: char *p, *q;
702: int c;
703:
704: if (!(fin=fopen(filename,"r"))) {
705: return 1 /* cannot open file */;
706: }
707: p = q = buffer;
708: while ((c=fgetc(fin))!=EOF) {
709: *p = 0;
710: if (c=='\n') {
711: if (!strncmp(buffer,"if {[info exists tk_library] && [string compare $tk_library {}]} {",66)) {
712: int flag = 1;
713: while (((c=fgetc(fin))!=EOF) && flag) {
714: if (c=='{') {
715: flag++;
716: } else if (c=='}') {
717: flag--;
718: }
719: }
720: p=q=buffer;
721: } else if ((p==buffer)||(*q=='\n')||(*q=='#')) {
722: if ((*q=='#') && (*(p-1)=='\\')) {
723: p=q+1;
724: } else {
725: p=q;
726: }
727: } else {
728: *p++ = '\n'; *p=0;
729: if (Tcl_CommandComplete(buffer)) {
730: p--; *p = 0; printline(fout,buffer,dir,flags);
731: p = q = buffer;
732: } else {
733: q=p;
734: }
735: }
736: } else {
737: *p++ = (char) c;
738: }
739: }
740: if (p!=buffer) {
741: *p=0; printline(fout,buffer,dir,flags);
742: }
743: fclose(fin);
744: return 0; /* O.K. */
745: }
746:
747: int
748: #ifdef _USING_PROTOTYPES_
749: main (
750: int argc,
751: char *argv[])
752: #else
753: main(argc, argv)
754: int argc;
755: char *argv[];
756: #endif
757: {
758: FILE *fout;
759: char *p,*q, *filename=NULL;
760: char dir[128];
761: tableitem *t;
762: int c,i, flags=0;
763:
764: if (argc==1) {
765: printf(verbose);
766: exit(0);
767: }
768: if (argc==2&&!strcmp(argv[1],"-help")) {
769: printf(verbose);
770: printf(help);
771: exit(0);
772: }
773: script_name[0] = 0;
774: /* parse all command line arguments */
775: for (i=1; i<argc; i++) {
776: if (!strcmp(argv[i],"-a")) {
777: array_instead_of_string = 1;
778: } else if (!strcmp(argv[i],"-n")) {
779: i++; strcpy(script_name,argv[i]);
780: } else if (!strcmp(argv[i],"-o")) {
781: i++; filename = argv[i];
782: } else {
783: for (t=table;t<table+(sizeof(table)/sizeof(tableitem));t++) {
784: if (!strcmp(argv[i],t->option)) {
785: flags |= t->flag;
786: }
787: }
788: }
789: }
790: /* open output file, if not stdout */
791: if (filename) {
792: fout = fopen(filename,"w");
793: if (fout==NULL) {
794: fprintf(stderr,"error opening file %s\n",filename);
795: exit(1);
796: }
797: } else {
798: fout = stdout;
799: }
800: p = script_name;
801: if ((q = strrchr(p,':')) != NULL) {
802: p = q+1;
803: }
804: if ((q = strrchr(p,'/')) != NULL) {
805: p = q+1;
806: }
807: if ((q = strrchr(p,'\\')) != NULL) {
808: p = q+1;
809: }
810: strcpy(script_name,p);
811: q = script_name;
812: while (*q) {
813: if (*q == '.') {
814: *q = '_';
815: } else if (isupper(*q)) {
816: *q = tolower(*q);
817: }
818: q++;
819: }
820: while ((q = strchr(script_name,'.')) != NULL) {
821: *q = '_';
822: }
823: /* create prototypes for all initialization functions that are used */
824: if (flags) {
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,defineproto1,table[i].package,
832: table[i].package);
833: }
834: }
835: fprintf(fout, part2);
836: for (i=1,c=2;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
837: if (flags & c) {
838: fprintf(fout,defineproto2,table[i].package);
839: }
840: }
841: fprintf(fout, part3);
842: if (flags & 2) {
843: fprintf(fout, part3a);
844: }
845: for (i=1,c=2;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
846: if (flags & c) {
847: fprintf(fout,initproto,table[i].package,
848: table[i].package,table[i].package);
849: }
850: }
851: fprintf(fout, part4, script_name);
852: if (array_instead_of_string) {
853: fprintf(fout, part4b);
854: } else {
855: fprintf(fout, part4a);
856: }
857: }
858: if ( !array_instead_of_string && script_name[0]) {
859: fprintf(fout, "static char *%s[] = {\n", script_name);
860: }
861: /* handle all remaining arguments */
862: if (argc) {argc--; argv++;}
863: while(argc) {
864: if ((*argv)[0]=='-') {
865: if ((((*argv)[1]=='o')||((*argv)[1]=='n'))&&((*argv)[2]==0)) {
866: argc--; argv++;
867: }
868: } else if ((p=strstr(*argv,".c"))&&(p[2]==0)) {
869: fprintf(fout,"#include \"%s\"\n",*argv);
870: } else {
871: strcpy(dir,*argv);
872: if ((p=strrchr(dir,'/'))!= NULL) { *(p+1)=0; } else {*dir=0;}
873: if (printfile(fout,*argv,dir,flags)) {
874: fprintf(stderr,"Error: cannot open file %s\n",*argv);
875: }
876: }
877: argc--; argv++;
878: }
879: if ( array_instead_of_string ) {
880: fprintf(fout, "static char *%s[] = {\n", script_name);
881: for (i = 0; (unsigned int)i < num_lines;)
882: fprintf(fout, "%s_line%d,\n", script_name, ++i);
883: }
884: if (script_name[0]) {
885: fprintf(fout, "(char *) NULL\n};\n\n");
886: }
887: /* end of scripts, finally the functions main() and tclAppInit() */
888: if (flags) {
889: fprintf(fout, part5, script_name);
890: fprintf(fout, part5a, script_name);
891: fprintf(fout, part5b);
892: fprintf(fout, part5c);
893: if (flags==65537) { fprintf(fout, partwebpage); }
894: fprintf(fout,callinit,table[0].package);
895: for (i=1,c=2;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
896: if (flags & c) {
897: fprintf(fout,callinit,table[i].package);
898: fprintf(fout,packageproto,table[i].package,table[i].package,table[i].package);
899: }
900: }
901: p=filename?filename:"app";
902: if ((q=strrchr(p,'/')) != NULL) p=q+1;
903: if ((q=strchr(p,'.')) != NULL) *q=0;
904: if (!*p) p="app";
905: fprintf(fout, part6,script_name,script_name,p,p);
906: if (flags & 2) {
907: fprintf(fout, part6a);
908: }
909: fprintf(fout, part6b);
910: fprintf(fout, part6c);
911: fprintf(fout, part6d);
912: fprintf(fout, part6e);
913: }
914: /* close output-file, if not stdout */
915: if (fout!=stdout) {
916: fclose(fout);
917: }
918: if (max_buffer>MAX_STRING_LEN) {
919: fprintf(stderr,"warning: largest sting in output file is %d bytes\n\
920: many compilers can only handle %d characters in a string\n\
921: first line: %s\n",max_buffer,MAX_STRING_LEN,max_buffer_content);
922: }
923: exit(0);
924: return 0;
925: }
926:
927:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to tcl2c-qz.c CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools