Annotation of capa/capa51/GUITools/tcl2c-qz.c, revision 1.1
1.1 ! albertel 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