From: genesis AT hermes9 DOT cst DOT cnes DOT fr (Utilisateur genesis) Subject: TCL/TK and GNU B19 24 Mar 1998 17:48:59 -0800 Message-ID: <199803201641.RAA24781.cygnus.gnu-win32@hermes4.cst.cnes.fr> Content-Type: X-sun-attachment To: gnu-win32 AT cygnus DOT com Cc: genesis AT hermes9 DOT cst DOT cnes DOT fr ---------- X-Sun-Data-Type: text X-Sun-Data-Description: text X-Sun-Data-Name: text X-Sun-Charset: us-ascii X-Sun-Content-Lines: 21 Hi there, I have some problems with TCL/TK 8.0 and GNU B19. I have a C application that call TCL interpreteur to execute TCL and TK command. For that I've insert in my application a copy of tkMain.c source, to create and initialize TCL shell. My application work fine with TCL 7.6 and GNU B18, but with B19 when I start the event loop with Tk_MainLoop or Tk_DoOneEvent(ALL_EVENTS) I see the TK window create, but it's impossible to move, close or destroy the window (I have window's hourglass) . I don't understand, the same application work very well on Windows NT with B18 (TCL 7.6 and TK 4.2), and Sun Solaris 2.5 with TCL/TK 8.0. I hope someone can help. Thanks, Jean-Luc CAMES PS : Attach file is a copy of tkMain.c source file, where I've added Tk_MainWindow(interp) and Tk_MapWindow () before the Tk_MainLoop() to display a window. With B19 window is display but I can't send tcl command to add widgets on this window (No problem in B18 and TCL/TK 8.0 on Sun platform). ---------- X-Sun-Data-Type: c-file X-Sun-Data-Description: c-file X-Sun-Data-Name: tk.c X-Sun-Charset: us-ascii X-Sun-Content-Lines: 415 #include #include #include #include #include #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else # include #endif int Tcl_AppInit(interp) Tcl_Interp *interp; /* Interpreter for application. */ { if (Tcl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } if (Tk_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #ifdef TK_TEST if (Tktest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticPackage(interp, "Tktest", Tktest_Init, (Tcl_PackageInitProc *) NULL); #endif /* TK_TEST */ /* * Call the init procedures for included packages. Each call should * look like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * * where "Mod" is the name of the module. */ /* * Call Tcl_CreateCommand for application-specific commands, if * they weren't already created by the init procedures called above. */ /* * Specify a user-specific startup file to invoke if the application * is run interactively. Typically the startup file is "~/.apprc" * where "app" is the name of the application. If this line is deleted * then no user-specific startup file will be run under any conditions. */ Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); return TCL_OK; } /* * tkMain.c -- * * This file contains a generic main program for Tk-based applications. * It can be used as-is for many applications, just by supplying a * different appInitProc procedure for each specific application. * Or, it can be used as a template for creating new main programs * for Tk applications. * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * SCCS: @(#) tkMain.c 1.153 97/04/25 16:51:43 */ /* * Declarations for various library procedures and variables (don't want * to include tkInt.h or tkPort.h here, because people might copy this * file out of the Tk source directory to make their own modified versions). * Note: don't declare "exit" here even though a declaration is really * needed, because it will conflict with a declaration elsewhere on * some systems. */ extern int isatty _ANSI_ARGS_((int fd)); #if !defined(__WIN32__) && !defined(_WIN32) extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); #endif extern void TkpDisplayWarning _ANSI_ARGS_((char *msg, char *title)); /* * Global variables used by the main program: */ static Tcl_Interp *interp; /* Interpreter for this application. */ static Tcl_DString command; /* Used to assemble lines of terminal input * into Tcl commands. */ static Tcl_DString line; /* Used to read the next line from the * terminal input. */ static int tty; /* Non-zero means standard input is a * terminal-like device. Zero means it's * a file. */ /* * Forward declarations for procedures defined later in this file. */ static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial)); static void StdinProc _ANSI_ARGS_((ClientData clientData, int mask)); /* *---------------------------------------------------------------------- * * Tk_Main -- * * Main program for Wish and most other Tk-based applications. * * Results: * None. This procedure never returns (it exits the process when * it's done. * * Side effects: * This procedure initializes the Tk world and then starts * interpreting commands; almost anything could happen, depending * on the script being interpreted. * *---------------------------------------------------------------------- */ void main() { char *args, *fileName; char buf[20]; char argv[256]; char argv0[256]; int code,i,j; size_t length; Tcl_Channel inChannel, outChannel; i = 0; Tcl_FindExecutable("test.exe"); interp = Tcl_CreateInterp(); #ifdef TCL_MEM_DEBUG Tcl_InitMemory(interp); #endif /* * Parse command-line arguments. A leading "-file" argument is * ignored (a historical relic from the distant past). If the * next argument doesn't start with a "-" then strip it off and * use it as the name of a script file to process. */ fileName = NULL; /* * Set the "tcl_interactive" variable. */ /* * For now, under Windows, we assume we are not running as a console mode * app, so we need to use the GUI console. In order to enable this, we * always claim to be running on a tty. This probably isn't the right * way to do it. */ #ifdef __WIN32__ tty = 1; #else tty = isatty(0); #endif Tcl_SetVar(interp, "tcl_interactive", ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. */ if (Tcl_AppInit(interp) != TCL_OK) { TkpDisplayWarning(interp->result, "Application initialization failed"); } /* * Invoke the script specified on the command line, if any. */ if (fileName != NULL) { code = Tcl_EvalFile(interp, fileName); if (code != TCL_OK) { /* * The following statement guarantees that the errorInfo * variable is set properly. */ Tcl_AddErrorInfo(interp, ""); TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), "Error in startup script"); Tcl_DeleteInterp(interp); Tcl_Exit(1); } tty = 0; } else { /* * Evaluate the .rc file, if one has been specified. */ Tcl_SourceRCFile(interp); /* * Establish a channel handler for stdin. */ inChannel = Tcl_GetStdChannel(TCL_STDIN); if (inChannel) { Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, (ClientData) inChannel); } if (tty) { Prompt(interp, 0); } } outChannel = Tcl_GetStdChannel(TCL_STDOUT); if (outChannel) { Tcl_Flush(outChannel); } Tcl_DStringInit(&command); Tcl_DStringInit(&line); Tcl_ResetResult(interp); /* * Loop infinitely, waiting for commands to execute. When there * are no windows left, Tk_MainLoop returns and we exit. */ { Tk_Window tf; tf = Tk_MainWindow(interp); Tk_MapWindow ( tf); Tk_MainLoop(); Tcl_DeleteInterp(interp); Tcl_Exit(0); } } /* *---------------------------------------------------------------------- * * StdinProc -- * * This procedure is invoked by the event dispatcher whenever * standard input becomes readable. It grabs the next line of * input characters, adds them to a command being assembled, and * executes the command if it's complete. * * Results: * None. * * Side effects: * Could be almost arbitrary, depending on the command that's * typed. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static void StdinProc(clientData, mask) ClientData clientData; /* Not used. */ int mask; /* Not used. */ { static int gotPartial = 0; char *cmd; int code, count; Tcl_Channel chan = (Tcl_Channel) clientData; count = Tcl_Gets(chan, &line); if (count < 0) { if (!gotPartial) { if (tty) { Tcl_Exit(0); } else { Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); } return; } } (void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1); cmd = Tcl_DStringAppend(&command, "\n", -1); Tcl_DStringFree(&line); if (!Tcl_CommandComplete(cmd)) { gotPartial = 1; goto prompt; } gotPartial = 0; /* * Disable the stdin channel handler while evaluating the command; * otherwise if the command re-enters the event loop we might * process commands from stdin before the current command is * finished. Among other things, this will trash the text of the * command being evaluated. */ Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan); code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, (ClientData) chan); Tcl_DStringFree(&command); if (*interp->result != 0) { if ((code != TCL_OK) || (tty)) { /* * The statement below used to call "printf", but that resulted * in core dumps under Solaris 2.3 if the result was very long. * * NOTE: This probably will not work under Windows either. */ puts(interp->result); } } /* * Output a prompt. */ prompt: if (tty) { Prompt(interp, gotPartial); } Tcl_ResetResult(interp); } /* *---------------------------------------------------------------------- * * Prompt -- * * Issue a prompt on standard output, or invoke a script * to issue the prompt. * * Results: * None. * * Side effects: * A prompt gets output, and a Tcl script may be evaluated * in interp. * *---------------------------------------------------------------------- */ static void Prompt(interp, partial) Tcl_Interp *interp; /* Interpreter to use for prompting. */ int partial; /* Non-zero means there already * exists a partial command, so use * the secondary prompt. */ { char *promptCmd; int code; Tcl_Channel outChannel, errChannel; promptCmd = Tcl_GetVar(interp, partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY); if (promptCmd == NULL) { defaultPrompt: if (!partial) { /* * We must check that outChannel is a real channel - it * is possible that someone has transferred stdout out of * this interpreter with "interp transfer". */ outChannel = Tcl_GetChannel(interp, "stdout", NULL); if (outChannel != (Tcl_Channel) NULL) { Tcl_Write(outChannel, "% ", 2); } } } else { code = Tcl_Eval(interp, promptCmd); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (script that generates prompt)"); /* * We must check that errChannel is a real channel - it * is possible that someone has transferred stderr out of * this interpreter with "interp transfer". */ errChannel = Tcl_GetChannel(interp, "stderr", NULL); if (errChannel != (Tcl_Channel) NULL) { Tcl_Write(errChannel, interp->result, -1); Tcl_Write(errChannel, "\n", 1); } goto defaultPrompt; } } outChannel = Tcl_GetChannel(interp, "stdout", NULL); if (outChannel != (Tcl_Channel) NULL) { Tcl_Flush(outChannel); } } - For help on using this list (especially unsubscribing), send a message to "gnu-win32-request AT cygnus DOT com" with one line of text: "help".