Author: Sergei Golovan Description: Fixes Tk intialization by calling Tk_Init instead of using copy&pasted Tk_Init from older Tk. --- expect-5.44.1.14.orig/exp_main_tk.c +++ expect-5.44.1.14/exp_main_tk.c @@ -162,13 +162,7 @@ * the "argv" variable in Tk_Init. */ -static int synchronize; -static CONST char *name; -static char *display; -static char *geometry; -static char *colormap; -static char *visual; -static int rest = 0; +static int rest; /* for Expect */ int my_rc = 1; @@ -181,21 +175,6 @@ int print_version = 0; static Tk_ArgvInfo argTable[] = { - {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap, - "Colormap for main window"}, - {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display, - "Display to use"}, - {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry, - "Initial geometry for window"}, - {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name, - "Name to use for application"}, - {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize, - "Use synchronous mode for display server"}, - {"-visual", TK_ARGV_STRING, (char *) NULL, (char *) &visual, - "Visual for main window"}, - {"--", TK_ARGV_REST, (char *) 1, (char *) &rest, - "Pass all remaining arguments through to script"}, -/* for Expect */ {"-command", TK_ARGV_GENFUNC, (char *) optcmd_eval, (char *)0, "Command(s) to execute immediately"}, {"-diag", TK_ARGV_CONSTANT, (char *) optcmd_diagToStderr, (char *)0, @@ -210,6 +189,8 @@ {"-Debug", TK_ARGV_GENFUNC, (char *) optcmd_debug, (char *)0, "Enable debugger"}, #endif + {"--", TK_ARGV_REST, (char *) 1, (char *) &rest, + "Pass all remaining arguments through to script"}, {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL, (char *) NULL} }; @@ -243,11 +224,11 @@ Tcl_Interp *interp; /* Interpreter to initialize. */ { CONST char *p; - char* alist, *cstr; - int argc, code; - char **argv, *args[20]; - Tcl_DString class; + char *alist, *pp; + int argc, length, i, j; + char **argv, **newargv; char buffer[30]; + size_t len; /* * If there is an "argv" variable, get its value, extract out @@ -255,8 +236,7 @@ * the arguments that we used. */ - synchronize = 0; - name = display = geometry = colormap = visual = NULL; + rest = -1; p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY); argv = NULL; if (p != NULL) { @@ -285,115 +265,57 @@ } } - alist = Tcl_Merge(argc, argv); - Tcl_SetVar2(interp, "argv", (char *) NULL, alist, TCL_GLOBAL_ONLY); - sprintf(buffer, "%d", argc); - Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY); - ckfree(alist); - } - - /* - * Figure out the application's name and class. - */ + if (rest >= 0) { + /* Resore '--' in arguments list + */ - if (name == NULL) { - name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); - if ((name == NULL) || (*name == 0)) { - name = "tk"; - } else { - p = (char *)strrchr(name, '/'); /* added cast - DEL */ - if (p != NULL) { - name = p+1; + length = 0; + for (i = 0; i < argc; i++) { + length += strlen(argv[i]) + 1; } - } - } - Tcl_DStringInit(&class); - Tcl_DStringAppend(&class, name, -1); - cstr = Tcl_DStringValue(&class); - if (islower(*cstr)) { - *cstr = toupper((unsigned char) *cstr); - } - /* - * Create an argument list for creating the top-level window, - * using the information parsed from argv, if any. - */ + newargv = (char **) ckalloc((unsigned) ((argc+2)*sizeof(char *)) + length + 3); - args[0] = "toplevel"; - args[1] = "."; - args[2] = "-class"; - args[3] = Tcl_DStringValue(&class); - argc = 4; - if (display != NULL) { - args[argc] = "-screen"; - args[argc+1] = display; - argc += 2; - - /* - * If this is the first application for this process, save - * the display name in the DISPLAY environment variable so - * that it will be available to subprocesses created by us. - */ + pp = ((char *) newargv) + (argc+2)*sizeof(char *); + j = 0; + for (i = 0; i < argc; i++) { + if (i == rest) { + memcpy(pp, "--", 3); + newargv[j++] = pp; + pp += 3; + } + + len = strlen(argv[i]) + 1; + memcpy(pp, argv[i], len); + newargv[j++] = pp; + pp += len; + } + newargv[j] = NULL; - if (numMainWindows == 0) { - Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY); + alist = Tcl_Merge(argc+1, newargv); + } else { + newargv = NULL; + alist = Tcl_Merge(argc, argv); } - } - if (colormap != NULL) { - args[argc] = "-colormap"; - args[argc+1] = colormap; - argc += 2; - } - if (visual != NULL) { - args[argc] = "-visual"; - args[argc+1] = visual; - argc += 2; - } - args[argc] = NULL; - code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name); - Tcl_DStringFree(&class); - if (code != TCL_OK) { - goto done; - } - Tcl_ResetResult(interp); -#ifndef MAC_OSX_TK - if (synchronize) { - XSynchronize(Tk_Display(Tk_MainWindow(interp)), True); - } -#endif - /* - * Set the geometry of the main window, if requested. Put the - * requested geometry into the "geometry" variable. - */ - - if (geometry != NULL) { - Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY); - code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL); - if (code != TCL_OK) { - goto done; - } - } - if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) { - code = TCL_ERROR; - goto done; - } - code = Tcl_PkgProvide(interp, "Tk", TK_VERSION); - if (code != TCL_OK) { - goto done; + Tcl_SetVar2(interp, "argv", (char *) NULL, alist, TCL_GLOBAL_ONLY); + sprintf(buffer, "%d", argc); + Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY); + ckfree(alist); } - /* - * Invoke platform-specific initialization. - */ - - code = TkpInit(interp, 0); + if (Tk_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } - done: if (argv != NULL) { ckfree((char *) argv); } - return code; + if (newargv != NULL) { + ckfree((char *) newargv); + } + + return TCL_OK; } /*ARGSUSED*/