/* * tkMain.c (CTk) -- * * 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-1995 Sun Microsystems, Inc. * Copyright (c) 1994-1995 Cleveland Clinic Foundation * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * @(#) $Id: ctk.shar,v 1.50 1996/01/15 14:47:16 andrewm Exp andrewm $ */ #include #include #include #include #include "tk.h" #ifdef NO_STDLIB_H # include "compat/stdlib.h" #else # include #endif /* * 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)); extern int read _ANSI_ARGS_((int fd, char *buf, size_t size)); extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); /* * Global variables used by the main program: */ static Tk_Window mainWindow; /* The main window for the application. If * NULL then the application no longer * exists. */ 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. */ static char errorExitCmd[] = "exit 1"; /* * Command-line options: */ static char *fileName = NULL; static char *name = NULL; static char *display = NULL; static char *geometry = NULL; static int rest = 0; static Tk_ArgvInfo argTable[] = { {"-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"}, {"--", 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} }; /* * 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 Tk_Main(argc, argv, appInitProc) int argc; /* Number of arguments. */ char **argv; /* Array of argument strings. */ Tcl_AppInitProc *appInitProc; /* Application-specific initialization * procedure to call after most * initialization but befort starting * to execute commands. */ { char *args, *p, *msg, *argv0, *class; char buf[20]; int code; size_t length; Tcl_Channel inChannel, outChannel, errChannel, chan; 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. Also check * for other standard arguments, such as "-geometry", anywhere * in the argument list. */ argv0 = argv[0]; if (argc > 1) { length = strlen(argv[1]); if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) { argc--; argv++; } } if ((argc > 1) && (argv[1][0] != '-')) { fileName = argv[1]; argc--; argv++; } if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0) != TCL_OK) { fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); exit(1); } if (name == NULL) { if (fileName != NULL) { p = fileName; } else { p = argv[0]; } name = strrchr(p, '/'); if (name != NULL) { name++; } else { name = p; } } /* * Make command-line arguments available in the Tcl variables "argc" * and "argv". */ args = Tcl_Merge(argc-1, argv+1); Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY); ckfree(args); sprintf(buf, "%d", argc-1); Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv0, TCL_GLOBAL_ONLY); /* * If a display was specified, put it into the CTK_DISPLAY * environment variable so that it will be available for * any sub-processes created by us. */ if (display != NULL) { Tcl_SetVar2(interp, "env", "CTK_DISPLAY", display, TCL_GLOBAL_ONLY); } /* * Initialize the Tk application. If a -name option was provided, * use it; otherwise, if a file name was provided, use the last * element of its path as the name of the application; otherwise * use the last element of the program name. For the application's * class, capitalize the first letter of the name. */ if (name == NULL) { p = (fileName != NULL) ? fileName : argv0; name = strrchr(p, '/'); if (name != NULL) { name++; } else { name = p; } } class = (char *) ckalloc((unsigned) (strlen(name) + 1)); strcpy(class, name); class[0] = toupper((unsigned char) class[0]); mainWindow = Tk_CreateMainWindow(interp, display, name, class); ckfree(class); if (mainWindow == NULL) { fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); exit(1); } /* * Set the "tcl_interactive" variable. */ tty = isatty(0); Tcl_SetVar(interp, "tcl_interactive", ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); /* * 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) { fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); } } /* * Invoke application-specific initialization. */ if ((*appInitProc)(interp) != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_Write(errChannel, "application-specific initialization failed: ", -1); Tcl_Write(errChannel, Tcl_GetStringResult(interp), -1); Tcl_Write(errChannel, "\n", 1); } goto error; } /* * Invoke the script specified on the command line, if any. */ if (fileName != NULL) { code = Tcl_EvalFile(interp, fileName); if (code != TCL_OK) { goto error; } tty = 0; } else { /* * Commands will come from standard input, so set up an event * handler for standard input. Evaluate the .rc file, if one * has been specified, set up an event handler for standard * input, and print a prompt if the input device is a terminal. */ fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_DString buffer; char *fullName; fullName = Tcl_TranslateFileName(interp, fileName, &buffer); if (fullName == NULL) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_Write(errChannel, Tcl_GetStringResult(interp), -1); Tcl_Write(errChannel, "\n", 1); } } else { /* * NOTE: The following relies on O_RDONLY==0. */ chan = Tcl_OpenFileChannel(interp, fullName, "r", 0); if (chan != (Tcl_Channel) NULL) { Tcl_Close(NULL, chan); if (Tcl_EvalFile(interp, fullName) != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_Write(errChannel, Tcl_GetStringResult(interp), -1); Tcl_Write(errChannel, "\n", 1); } } } } Tcl_DStringFree(&buffer); } if (tty && !Tcl_GetVar2(interp, "env", "CTK_DISPLAY", TCL_GLOBAL_ONLY)) { /* * Input is a terminal, and display was never set. Instead * of reading command from stdin, pop-up a command dialog * (since we are probably displaying to stdin/stdout). */ if (Tcl_Eval(interp, "ctkDialog") != TCL_OK) { goto error; } } else { Tcl_CreateFileHandler(0, TCL_READABLE, StdinProc, (ClientData) 0); 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_MainLoop(); /* * Don't exit directly, but rather invoke the Tcl "exit" command. * This gives the application the opportunity to redefine "exit" * to do additional cleanup. */ Tcl_Eval(interp, "exit"); exit(1); error: /* * The following statement guarantees that the errorInfo * variable is set properly. */ Tcl_AddErrorInfo(interp, ""); errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_Write(errChannel, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1); Tcl_Write(errChannel, "\n", 1); } Tcl_DeleteInterp(interp); Tcl_Exit(1); } /* *---------------------------------------------------------------------- * * 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; } else { count = 0; } } (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_CreateFileHandler(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 (*(Tcl_GetStringResult(interp)) != 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(Tcl_GetStringResult(interp)); } } /* * 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; promptCmd = Tcl_GetVar(interp, partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY); if (promptCmd == NULL) { defaultPrompt: if (!partial) { fputs("% ", stdout); } } else { code = Tcl_Eval(interp, promptCmd); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (script that generates prompt)"); fprintf(stderr, "%s\n", Tcl_GetStringResult(interp)); goto defaultPrompt; } } fflush(stdout); }