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 (25 years, 1 month 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_5_msu, version_2_11_5, 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

#include <tcl.h>
#include <stdio.h>

#ifdef __cplusplus
extern C {
#endif

extern void exit _ANSI_ARGS_((int status));
extern int isupper _ANSI_ARGS_((int ch));
extern int tolower _ANSI_ARGS_((int ch));

#ifdef __cplusplus
}
#endif

#define MAX_STRING_LEN 8192 /* give warning if string length exceeds this value */

#ifdef NO_STRING_H
#   include <strings.h>
#   define strchr index
#   define strrchr rindex
#else
#   include <string.h>
#endif

typedef struct tableitem {
    char *package;/* corresponding packagename */
    char *option; /* option expected */
    int flag ;    /* which packages are needed */
} tableitem;

static tableitem table[] = {
{"Tcl"  ,"-tcl"  ,  1},
{"Tk"   ,"-tk"   ,  3},
{"Tclx" ,"-tclx" ,  5},
{"Itcl" ,"-itcl" ,  9},
{"Otcl" ,"-otcl" , 17},	/* not tested yet */
{"Pvm"  ,"-pvm"  , 33},
{"Tkx"  ,"-tkx"  , 71},
{"Itk"  ,"-itk" ,  139},
{"Iwidgets" ,"-iwidgets" ,  395},
{"Img"  ,"-img"  ,515},
{"Tix"  ,"-tix"  ,1027}, /* not tested yet */
{"Blt"  ,"-blt"  ,2051}, /* not tested yet */
{"Vtcl" ,"-vtcl" ,4103}, /* not tested yet */
{"Quizzer", "-qz",8195},
{"Grader", "-gd", 16387},
{"Manager", "-mn", 32771},
{"Webpage", "-wb", 65537},
};

static char *verbose = "\n\
*************************** tcl2c ********************************\n\
written by: Jan Nijtmans\n\
            CMG (Computer Management Group) Arnhem B.V.\n\
	    email: nijtmans@worldaccess.nl (private)\n\
	           Jan.Nijtmans@cmg.nl (work)\n\
	    url:   http://www.worldaccess.nl/~nijtmans/\n\n\
Modified by: Guy Albertelli \n\n\
usage:	tcl2c -o file source1 source2 ... ?options?\n\
	tcl2c -help\n\
";

static char *help = "\n\
available options:\n\
        -a              use character array instead of string for script\n\
        -n script_name  name of script variable\n\
        -o filename	output file (default is stdout)\n\
	-tcl		use Tcl\n\
	-tclx		use Tclx\n\
	-otcl		use Otcl (not tested yet)\n\
	-pvm		use tkPvm\n\
	-tk		use Tk\n\
	-tkx		use Tkx (not really useful)\n\
	-img		use Img\n\
	-tix		use Tix (not tested yet)\n\
	-blt		use Blt (not tested yet)\n\
	-vtcl		use Vtcl (not tested yet)\n\
        -qz	    use Quizzer\n\
	-gd	    use Grader\n\
Other command line arguments are assumed to be tcl script-files. It is \n\
possible to include C-files (with the extension .c), which are already\n\
converted tcl-scripts. These are included using the \"#include\".\n\n\
The output file can be compiled with any C or C++ compiler.\n\
";

static char *part1 = "\n\
/* This file is created by the \"tcl2c-qz\" utility, which is included in\n\
 * most \"plus\"-patches (e.g. for Tcl7.6 and Tcl8.0). Standalone\n\
 * executables can be made by providing alternative initialization\n\
 * functions which don't read files any more. Sometimes, small\n\
 * adaptations to the original libraries are needed to get the\n\
 * application truly standalone. The \"plus\"-patches contain these\n\
 * adaptations for Tcl and Tk. If you just create your own\n\
 * Xxx_InitStandAlone() function for your package, you can\n\
 * easyly extend the \"tcl2c\" utility to your own requirements.\n\
 *\n\
 *	Jan Nijtmans\n\
 *	CMG (Computer Management Group) Arnhem B.V.\n\
 *	email: nijtmans@worldaccess.nl (private)\n\
 *	       Jan.Nijtmans@cmg.nl (work)\n\
 *	url:   http://www.worldaccess.nl/~nijtmans/\n\
 */\n\
#include \"tcl.h\"\n\
#ifdef __WIN32__\n\
#define WIN32_LEAN_AND_MEAN\n\
#include <windows.h>\n\
#undef WIN32_LEAN_AND_MEAN\n\
#include <malloc.h>\n\
#include <locale.h>\n\
\n\
static int setargv _ANSI_ARGS_((char ***argvPtr));\n\
static void TclshPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));\n\
extern void TclWinSetTclInstance(HINSTANCE instance);\n\
\n\
#endif\n\
\n\
/*\n\
 * Defines to replace the standard Xxx_Init calls to Xxx_InitStandAlone.\n\
 * If you don't have this function, just delete the corresponding\n\
 * define such that the normal initialization function is used.\n\
 * Similar: If SafeInit functions exists, you can use these\n\
 * by commenting out the corresponding lines below.\n\
 */\n\
\n\
#if defined(TCL_ACTIVE) && !defined(SHARED)\n\
";

static char *part2 = "#endif\n\
\n\
#if TCL_MAJOR_VERSION < 8\n\
";

static char *part3 = "\
#endif\n\
\n\
/*\n\
 * Prototypes of all initialization functions and the free() function.\n\
 * So, only \"tcl.h\" needs to be included now.\n\
 */\n\
\n\
#ifdef __cplusplus\n\
extern \"C\" {\n\
#endif\n\
\n\
#ifndef USE_TCLALLOC\n\
#   define USE_TCLALLOC 0\n\
#endif\n\
#if USE_TCLALLOC == 0\n\
extern void free _ANSI_ARGS_((void *));\n\
#endif\n\
extern int  Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));\n\
\n\
";

static char *part3a = "\n\
extern void Tk_MainLoop _ANSI_ARGS_((void));\n\
#define HAS_TK\n\
#ifdef __WIN32__\n\
extern void TkWinXInit _ANSI_ARGS_((HINSTANCE hinstance));\n\
extern void TkWinXCleanup _ANSI_ARGS_((HINSTANCE hinstance));\n\
#endif\n\
\n\
";

static char *part4 = "\n\
\n\
#ifdef __cplusplus\n\
}\n\
#endif\n\
\n\
/*\n\
 * The array \"%s\" contains the script that is compiled in.\n\
 * It will be executed in tclAppInit() after the other initializations.\n\
 */\n\
\n\
";

static char *part4a = "\
static char *lineformat = \"%%.0s%%d\";\n\
static int line = (__LINE__ + 1);\n\
";

static char *part4b = "\
static char *lineformat = \"%%s_line%%d\";\n\
static int line = 0;\n\
";

static char *part5 = "\
/*\n\
 *----------------------------------------------------------------------\n\
 *\n\
 * main --\n\
 *\n\
 *	This is the main program for the application.\n\
 *\n\
 * Results:\n\
 *	None.\n\
 *\n\
 * Side effects:\n\
 *	Whatever the application does.\n\
 *\n\
 *----------------------------------------------------------------------\n\
 */\n\
\n\
#if defined(__WIN32__) && defined(HAS_TK)\n\
int APIENTRY\n\
WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)\n\
    HINSTANCE hInstance;\n\
    HINSTANCE hPrevInstance;\n\
    LPSTR lpszCmdLine;\n\
    int nCmdShow;\n\
{\n\
    char **argv;\n\
    int argc;\n\
#else\n\
";

static char *part5a = "\
int\n\
#ifdef _USING_PROTOTYPES_\n\
main (int    argc,		/* Number of command-line arguments. */\n\
      char **argv)		/* Values of command-line arguments. */\n\
#else\n\
main(argc, argv)\n\
    int argc;			/* Number of command-line arguments. */\n\
    char **argv;		/* Values of command-line arguments. */\n\
#endif\n\
{\n\
#endif\n\
    Tcl_Interp *interp;\n\
    char **p = %s;\n\
    char *q, buffer[256];\n\
    Tcl_DString data;\n\
    Tcl_Channel inChannel, outChannel, errChannel;\n\
\n\
#ifdef __WIN32__\n\
#if defined(TCL_ACTIVE) && !defined(SHARED) && defined(HAS_TK)\n\
    TclWinSetTclInstance(hInstance);\n\
    TkWinXInit(hInstance);\n\
    Tcl_CreateExitHandler((Tcl_ExitProc *) TkWinXCleanup, (ClientData) hInstance);\n\
#endif\n\
\n\
    Tcl_SetPanicProc(TclshPanic);\n\
\n";

static char *part5b = "\n\
    /*\n\
     * Set up the default locale to be standard \"C\" locale so parsing\n\
     * is performed correctly.\n\
     */\n\
\n\
    setlocale(LC_ALL, \"C\");\n\
\n\
    /*\n\
     * Increase the application queue size from default value of 8.\n\
     * At the default value, cross application SendMessage of WM_KILLFOCUS\n\
     * will fail because the handler will not be able to do a PostMessage!\n\
     * This is only needed for Windows 3.x, since NT dynamically expands\n\
     * the queue.\n\
     */\n\
    SetMessageQueue(64);\n\
\n\
    argc = setargv(&argv);\n\
\n\
    /*\n\
     * Replace argv[0] with full pathname of executable, and forward\n\
     * slashes substituted for backslashes.\n\
     */\n\
\n\
";

static char *part5c = "\
    GetModuleFileName(NULL, buffer, sizeof(buffer));\n\
    argv[0] = buffer;\n\
    for (q = buffer; *q != '\\0'; q++) {\n\
	if (*q == '\\\\') {\n\
	    *q = '/';\n\
	}\n\
    }\n\
\n\
#endif\n\
    Tcl_FindExecutable(argv[0]);\n\
    interp = Tcl_CreateInterp();\n\
\n\
    q = Tcl_Merge(argc-1, argv+1);\n\
    Tcl_SetVar(interp, \"argv\", q, TCL_GLOBAL_ONLY);\n\
    ckfree(q);\n\
    sprintf(buffer, \"%%d\", argc-1);\n\
    Tcl_SetVar(interp, \"argc\", buffer, TCL_GLOBAL_ONLY);\n\
    Tcl_SetVar(interp, \"argv0\", argv[0],TCL_GLOBAL_ONLY);\n\
    Tcl_SetVar(interp, \"tcl_interactive\",\"0\", TCL_GLOBAL_ONLY);\n\
\n\
";

static char *part6 = "\n\
    /*\n\
     * Execute the script that is compiled in.\n\
     */\n\
\n\
    inChannel = Tcl_GetStdChannel(TCL_STDIN);\n\
    outChannel = Tcl_GetStdChannel(TCL_STDOUT);\n\
    Tcl_DStringInit(&data);\n\
    while(*p) {\n\
	Tcl_DStringSetLength(&data,0);\n\
	Tcl_DStringAppend(&data,*p++,-1);\n\
	if (Tcl_Eval(interp,Tcl_DStringValue(&data)) != TCL_OK) {\n\
	    Tcl_DStringFree(&data);\n\
	    while (p-- != %s) {\n\
		for (q = *p;*q; q++) {\n\
		    if (*q=='\\n') line++;\n\
		}\n\
		line++;\n\
	    }\n\
	    sprintf(buffer,lineformat,\"%s\",line);\n\
	    Tcl_AddErrorInfo(interp,\"\\n	( Error in file: \\\"\");\n\
	    Tcl_AddErrorInfo(interp,__FILE__);\n\
	    Tcl_AddErrorInfo(interp,\"\\\", line: \");\n\
	    Tcl_AddErrorInfo(interp,buffer);\n\
	    Tcl_AddErrorInfo(interp,\")\");\n\
	    errChannel = Tcl_GetStdChannel(TCL_STDERR);\n\
	    if (errChannel) {\n\
		Tcl_Write(errChannel,\n\
			Tcl_GetVar(interp, \"errorInfo\", TCL_GLOBAL_ONLY), -1);\n\
		Tcl_Write(errChannel, \"\\n\", 1);\n\
	    }\n\
#ifdef __WIN32__\n\
	    TclshPanic(Tcl_GetVar(interp, \"errorInfo\", TCL_GLOBAL_ONLY));\n\
#endif\n\
	    sprintf(buffer, \"exit %%d\", 1);\n\
	    Tcl_Eval(interp, buffer);\n\
	}\n\
    }\n\
    Tcl_DStringFree(&data);\n\
";

static char *part6a = "\
    Tk_MainLoop();\n\
";

static char *part6b = "\
    sprintf(buffer, \"exit %%d\", 0);\n\
    Tcl_Eval(interp, buffer);\n\
\n\
error:\n\
    errChannel = Tcl_GetStdChannel(TCL_STDERR);\n\
    if (errChannel) {\n\
	Tcl_Write(errChannel,\n\
		\"application-specific initialization failed: \", -1);\n\
	Tcl_Write(errChannel, interp->result, -1);\n\
	Tcl_Write(errChannel, \"\\n\", 1);\n\
    }\n\
#ifdef __WIN32__\n\
    TclshPanic(interp->result);\n\
#endif\n\
    sprintf(buffer, \"exit %%d\", 1);\n\
    Tcl_Eval(interp, buffer);\n\
    return 0;\n\
}\n\
\n\
#ifdef __WIN32__\n\
/*\n\
 *----------------------------------------------------------------------\n\
 *\n\
 * TclshPanic --\n\
 *\n\
 *	Display a message and exit.\n\
 *\n\
 * Results:\n\
 *	None.\n\
 *\n\
 * Side effects:\n\
 *	Exits the program.\n\
 *\n\
 *----------------------------------------------------------------------\n\
 */\n\
\n\
void\n\
TclshPanic TCL_VARARGS_DEF(char *,arg1)\n\
{\n\
    va_list argList;\n\
    char buf[1024];\n\
    char *format;\n\
\n\
    format = TCL_VARARGS_START(char *,arg1,argList);\n\
    vsprintf(buf, format, argList);\n\
\n\
    MessageBeep(MB_ICONEXCLAMATION);\n\
    MessageBox(NULL, buf, \"Fatal Error in Tclsh\",\n\
	    MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);\n\
#ifdef _MSC_VER\n\
    _asm {\n\
        int 3\n\
    }\n\
#endif\n\
    ExitProcess(1);\n\
}\n\
";

static char *part6c = "\
\n\
/*\n\
 *-------------------------------------------------------------------------\n\
 *\n\
 * setargv --\n\
 *\n\
 *	Parse the Windows command line string into argc/argv.  Done here\n\
 *	because we don't trust the builtin argument parser in crt0.  \n\
 *	Windows applications are responsible for breaking their command\n\
 *	line into arguments.\n\
 *\n\
 *	2N backslashes + quote -> N backslashes + begin quoted string\n\
 *	2N + 1 backslashes + quote -> literal\n\
 *	N backslashes + non-quote -> literal\n\
 *	quote + quote in a quoted string -> single quote\n\
 *	quote + quote not in quoted string -> empty string\n\
 *	quote -> begin quoted string\n\
 *\n\
 * Results:\n\
 *	returns the number of arguments and fill argvPtr with the\n\
 *	array of arguments.\n\
 *\n\
 * Side effects:\n\
 *	Memory allocated.\n\
 *\n\
 *--------------------------------------------------------------------------\n\
 */\n\
\n\
";

static char *part6d = "\
static int\n\
setargv(argvPtr)\n\
    char ***argvPtr;		/* Filled with argument strings (malloc'd). */\n\
{\n\
    char *cmdLine, *p, *arg, *argSpace;\n\
    char **argv;\n\
    int argc, size, inquote, copy, slashes;\n\
\n\
    cmdLine = GetCommandLine();\n\
\n\
    /*\n\
     * Precompute an overly pessimistic guess at the number of arguments\n\
     * in the command line by counting non-space spans.\n\
     */\n\
\n\
    size = 2;\n\
    for (p = cmdLine; *p != '\\0'; p++) {\n\
	if (isspace(*p)) {\n\
	    size++;\n\
	    while (isspace(*p)) {\n\
		p++;\n\
	    }\n\
	    if (*p == '\\0') {\n\
		break;\n\
	    }\n\
	}\n\
    }\n\
    argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *)\n\
	    + strlen(cmdLine) + 1));\n\
    argv = (char **) argSpace;\n\
    argSpace += size * sizeof(char *);\n\
    size--;\n\
\n\
    p = cmdLine;\n\
    for (argc = 0; argc < size; argc++) {\n\
	argv[argc] = arg = argSpace;\n\
	while (isspace(*p)) {\n\
	    p++;\n\
	}\n\
	if (*p == '\\0') {\n\
	    break;\n\
	}\n\
\n\
";

static char *part6e = "\
	inquote = 0;\n\
	slashes = 0;\n\
	while (1) {\n\
	    copy = 1;\n\
	    while (*p == '\\\\') {\n\
		slashes++;\n\
		p++;\n\
	    }\n\
	    if (*p == '\"') {\n\
		if ((slashes & 1) == 0) {\n\
		    copy = 0;\n\
		    if ((inquote) && (p[1] == '\"')) {\n\
			p++;\n\
			copy = 1;\n\
		    } else {\n\
			inquote = !inquote;\n\
		    }\n\
                }\n\
                slashes >>= 1;\n\
            }\n\
\n\
            while (slashes) {\n\
		*arg = '\\\\';\n\
		arg++;\n\
		slashes--;\n\
	    }\n\
\n\
	    if ((*p == '\\0') || (!inquote && isspace(*p))) {\n\
		break;\n\
	    }\n\
	    if (copy != 0) {\n\
		*arg = *p;\n\
		arg++;\n\
	    }\n\
	    p++;\n\
        }\n\
	*arg = '\\0';\n\
	argSpace = arg + 1;\n\
    }\n\
    argv[argc] = NULL;\n\
\n\
    *argvPtr = argv;\n\
    return argc;\n\
}\n\
#endif /* __WIN32__ */\n\
";

static char *partwebpage ="\
 if (argc >1) {\n\
    if (!strcmp(argv[1],\"-emailcapaid\")) { emailcapaid(argc,argv);return 0;}\n\
    if (!strcmp(argv[1],\"-getid\")) { getid(argc,argv);return 0;}\n\
  }\n\
";

static char *defineproto1 = "\
#define %s_Init %s_InitStandAlone\n\
";

static char *defineproto2 = "\
#define %s_SafeInit (Tcl_PackageInitProc *) NULL\n\
";

static char *initproto = "\
extern int  %s_Init _ANSI_ARGS_((Tcl_Interp *interp));\n\
#ifndef %s_SafeInit\n\
extern int  %s_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));\n\
#endif\n\
";

static char *packageproto = "\
    Tcl_StaticPackage(interp, \"%s\", %s_Init, %s_SafeInit);\n\
";

static char *callinit = "\
    if (%s_Init(interp) != TCL_OK) {\n\
        goto error;\n\
    }\n\
";

static char buffer[32768];
static unsigned int max_buffer = 0;
static char max_buffer_content[80];

static char array_instead_of_string = 0;
static unsigned int num_lines = 0;

static char script_name[256];

int printline _ANSI_ARGS_((FILE *f, char *buf, char *dir, int flags));
int printfile _ANSI_ARGS_((FILE *fout, char *filename, char *dir, int flags));

int
#ifdef _USING_PROTOTYPES_
printline (
    FILE *f,
    char *buf,
    char *dir,
    int flags)
#else
printline(f,buf,dir,flags)
    FILE *f;
    char *buf;
    char *dir;
    int flags;
#endif
{
    char *p,*q;
    char path[128];
    unsigned int l;

    p=buf; while (*p=='\t' || *p==' ') p++;
    if (!strncmp(p,"catch",5)) {
	q=p+5; while (*q=='\t' || *q==' ') q++;
	if (*q++=='{') {
	    while (*q=='\t' || *q==' ') q++;
	    if (strncmp(q,"source",6)) q=(char *)NULL;
	} else {
	    q=(char *)NULL;
	}
    } else {
	q=(char *)NULL;
    }
    if (!strncmp(p,"source",6) || q) {
	if (q!=(char *)NULL) {
	    p = q;	    
	}
	p += 6;
	while(*p=='\t' || *p==' ') p++;
	if (*p=='/') {
	    strcpy(path,p);
	} else {
	    strcpy(path,dir);
	    strcat(path,p);
	}
	if (q) {
	    q=strrchr(p,'}');
	    if (q) {
		*q=0;
	    }
	}

	if (!printfile(f, path, dir, flags)) {
	    return 0;
	} else {
	    p = strrchr(p,'/');
	    if (p) {
		strcpy(path,dir);
		strcat(path,p+1);
		if (!printfile(f ,path ,dir, flags)) {
		    return 0;
		}
	    }
	}
	if (q) {
	    *q='}';
	}
    }
    p = buf;
    while ((p = strstr(p, "[list source [file join $dir")) != NULL) {
	q = strstr(p,".tcl]]");
	if (q != NULL) {
	    memcpy(p,"{source -rsrc",13);
	    memcpy(p+13,p+28,q-p-28);
	    memcpy(q-15,"}",1);
	    strcpy(q-14,q+6);
	} else {
	    p++;
	}
    }
    if (array_instead_of_string) {
      fprintf(f, "\nstatic char %s_line%d[] = {\n   ",
         script_name, ++num_lines);
      while (*buf) {
         for (l = 0; *buf && l < 14; l++) {
            fputc('\'', f);
            if (*buf == '\n') { fprintf(f,"\\n',"); buf++; continue; }
            if (*buf == '\'' || *buf == '\\') fputc('\\', f);
            fprintf(f, "%c',", *buf++);
         }
         fprintf(f, "\n   ");
      }
      fprintf(f, "'\\0' };\n");
    } else {
      fputc('\"',f);
      l = strlen(buf);
      if (l>max_buffer) {
	max_buffer = l;
	p = (strchr(buf,'\n'));
	if (p) {
	    l = p - buf;
	} else {
	    l = strlen(buf);
	}
	if (l>72) {l = 72;}
	memcpy(max_buffer_content,buf,l);
	max_buffer_content[l] = 0;
      }
      while(*buf) {
	if (*buf=='\"'||*buf=='\\') fputc('\\',f);
	if (*buf=='\n') {fputc('\\',f); fputc('n',f); fputc('\\',f); }
	fputc(*buf++,f);
      }
      fprintf(f, "\",\n");
    }
    return 0;
}

int
#ifdef _USING_PROTOTYPES_
printfile (
    FILE *fout,
    char *filename,
    char *dir,
    int flags)
#else
printfile(fout,filename,dir, flags)
    FILE *fout;
    char *filename;
    char *dir;
    int flags;
#endif
{
    FILE *fin;
    char *p, *q;
    int c;

    if (!(fin=fopen(filename,"r"))) {
	return 1 /* cannot open file */;
    }
    p = q = buffer;
    while ((c=fgetc(fin))!=EOF) {
	*p = 0;
	if (c=='\n') {
	    if (!strncmp(buffer,"if {[info exists tk_library] && [string compare $tk_library {}]} {",66)) {
		int flag = 1;
		while (((c=fgetc(fin))!=EOF) && flag) {
		    if (c=='{') {
			flag++;
		    } else if (c=='}') {
			flag--;
		    }
		}
		p=q=buffer;
	    } else if ((p==buffer)||(*q=='\n')||(*q=='#')) {
		if ((*q=='#') && (*(p-1)=='\\')) {
		    p=q+1;
		} else {
		    p=q;
		}
	    } else {
		*p++ = '\n'; *p=0;
		if (Tcl_CommandComplete(buffer)) {
		    p--; *p = 0; printline(fout,buffer,dir,flags);
		    p = q = buffer;
		} else {
		    q=p;
		}
	    }
	} else {
	    *p++ = (char) c;
	}
    }
    if (p!=buffer) {
	*p=0; printline(fout,buffer,dir,flags);
    }
    fclose(fin);
    return 0; /* O.K. */
}

int
#ifdef _USING_PROTOTYPES_
main (
	int argc,
	char *argv[])
#else
main(argc, argv)
	int argc;
	char *argv[];
#endif
{
    FILE *fout;
    char *p,*q, *filename=NULL;
    char dir[128];
    tableitem *t;
    int c,i, flags=0;

    if (argc==1) {
	printf(verbose);
	exit(0);
    }
    if (argc==2&&!strcmp(argv[1],"-help")) {
	printf(verbose);
	printf(help);
	exit(0);
    }
    script_name[0] = 0;
/* parse all command line arguments */
    for (i=1; i<argc; i++) {
	if (!strcmp(argv[i],"-a")) {
	    array_instead_of_string = 1;
	} else if (!strcmp(argv[i],"-n")) {
	    i++; strcpy(script_name,argv[i]);
	} else if (!strcmp(argv[i],"-o")) {
	    i++; filename = argv[i];
	} else {
	    for (t=table;t<table+(sizeof(table)/sizeof(tableitem));t++) {
		if (!strcmp(argv[i],t->option)) {
		    flags |= t->flag;
		}
	    }
	}
    }
/* open output file, if not stdout */
    if (filename) {
	fout = fopen(filename,"w");
	if (fout==NULL) {
	    fprintf(stderr,"error opening file %s\n",filename);
	    exit(1);
	}
    } else {
	fout = stdout;
    }
    p = script_name;
    if ((q = strrchr(p,':')) != NULL) {
	p = q+1;
    }
    if ((q = strrchr(p,'/')) != NULL) {
	p = q+1;
    }
    if ((q = strrchr(p,'\\')) != NULL) {
	p = q+1;
    }
    strcpy(script_name,p);
    q = script_name;
    while (*q) {
	if (*q == '.') {
	    *q = '_';
	} else if (isupper(*q)) {
	    *q = tolower(*q);
	}
	q++;
    }
    while ((q = strchr(script_name,'.')) != NULL) {
	*q = '_';
    }
/* create prototypes for all initialization functions that are used */
    if (flags) {
	if (script_name[0] == 0) {
	    strcpy(script_name,"script");
	}
	fprintf(fout, part1);
	for (i=0,c=1;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
	    if (flags & c) {
		fprintf(fout,defineproto1,table[i].package,
			table[i].package);
	    }
	}
	fprintf(fout, part2);
	for (i=1,c=2;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
	    if (flags & c) {
		fprintf(fout,defineproto2,table[i].package);
	    }
	}
	fprintf(fout, part3);
	if (flags & 2) {
	    fprintf(fout, part3a);
	}
	for (i=1,c=2;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
	    if (flags & c) {
		fprintf(fout,initproto,table[i].package,
			table[i].package,table[i].package);
	    }
	}
	fprintf(fout, part4, script_name);
	if (array_instead_of_string) {
	    fprintf(fout, part4b);
	} else {
	    fprintf(fout, part4a);
	}
    }
    if ( !array_instead_of_string && script_name[0]) {
	fprintf(fout, "static char *%s[] = {\n", script_name);
    }
/* handle all remaining arguments */
    if (argc) {argc--; argv++;}
    while(argc) {
	if ((*argv)[0]=='-') {
	    if ((((*argv)[1]=='o')||((*argv)[1]=='n'))&&((*argv)[2]==0)) {
		argc--; argv++;
	    }
	} else if ((p=strstr(*argv,".c"))&&(p[2]==0)) {
	    fprintf(fout,"#include \"%s\"\n",*argv);
	} else {
	    strcpy(dir,*argv);
	    if ((p=strrchr(dir,'/'))!= NULL) { *(p+1)=0; } else {*dir=0;}
	    if (printfile(fout,*argv,dir,flags)) {
		fprintf(stderr,"Error: cannot open file %s\n",*argv);
	    }
	}
	argc--; argv++;
    }
    if ( array_instead_of_string ) {
      fprintf(fout, "static char *%s[] = {\n", script_name);
      for (i = 0; (unsigned int)i < num_lines;)
          fprintf(fout, "%s_line%d,\n", script_name, ++i);
    }
    if (script_name[0]) {
      fprintf(fout, "(char *) NULL\n};\n\n");
    }
/* end of scripts, finally the functions main() and tclAppInit()  */
    if (flags) {
	fprintf(fout, part5, script_name);
	fprintf(fout, part5a, script_name);
	fprintf(fout, part5b);
	fprintf(fout, part5c);
    if (flags==65537) { fprintf(fout, partwebpage); }
	fprintf(fout,callinit,table[0].package);
	for (i=1,c=2;i<(sizeof(table)/sizeof(tableitem));i++,c<<=1) {
	    if (flags & c) {
		fprintf(fout,callinit,table[i].package);
		fprintf(fout,packageproto,table[i].package,table[i].package,table[i].package);
	    }
	}
	p=filename?filename:"app";
	if ((q=strrchr(p,'/')) != NULL) p=q+1;
	if ((q=strchr(p,'.')) != NULL) *q=0;
	if (!*p) p="app";
	fprintf(fout, part6,script_name,script_name,p,p);
	if (flags & 2) {
	    fprintf(fout, part6a);
	}
	fprintf(fout, part6b);
	fprintf(fout, part6c);
	fprintf(fout, part6d);
	fprintf(fout, part6e);
    }
/* close output-file, if not stdout */
    if (fout!=stdout) {
	fclose(fout);
    }
    if (max_buffer>MAX_STRING_LEN) {
	fprintf(stderr,"warning: largest sting in output file is %d bytes\n\
         many compilers can only handle %d characters in a string\n\
	 first line: %s\n",max_buffer,MAX_STRING_LEN,max_buffer_content);
    }
    exit(0);
    return 0;
}



FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>