2 * CDE - Common Desktop Environment
4 * Copyright (c) 1993-2012, The Open Group. All rights reserved.
6 * These libraries and programs are free software; you can
7 * redistribute them and/or modify them under the terms of the GNU
8 * Lesser General Public License as published by the Free Software
9 * Foundation; either version 2 of the License, or (at your option)
12 * These libraries and programs are distributed in the hope that
13 * they will be useful, but WITHOUT ANY WARRANTY; without even the
14 * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
15 * PURPOSE. See the GNU Lesser General Public License for more
18 * You should have received a copy of the GNU Lesser General Public
19 * License along with these librararies and programs; if not, write
20 * to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
21 * Floor, Boston, MA 02110-1301 USA
23 /* $XConsortium: tclMain.c /main/2 1996/08/08 14:45:29 cde-hp $ */
27 * Main program for Tcl shells and other Tcl-based applications.
29 * Copyright (c) 1988-1994 The Regents of the University of California.
30 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
32 * See the file "license.terms" for information on usage and redistribution
33 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
35 * SCCS: @(#) tclMain.c 1.50 96/04/10 16:40:57
42 * The following code ensures that tclLink.c is linked whenever
43 * Tcl is linked. Without this code there's no reference to the
44 * code in that file from anywhere in Tcl, so it may not be
45 * linked into the application.
48 EXTERN int Tcl_LinkVar();
49 int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
52 * Declarations for various library procedures and variables (don't want
53 * to include tclPort.h here, because people might copy this file out of
54 * the Tcl source directory to make their own modified versions).
55 * Note: "exit" should really be declared here, but there's no way to
56 * declare it without causing conflicts with other definitions elsewher
57 * on some systems, so it's better just to leave it out.
60 extern int isatty _ANSI_ARGS_((int fd));
61 extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
63 static Tcl_Interp *interp; /* Interpreter for application. */
64 static Tcl_DString command; /* Used to buffer incomplete commands being
67 static char dumpFile[100]; /* Records where to dump memory allocation
69 static int quitFlag = 0; /* 1 means the "checkmem" command was
70 * invoked, so the application should quit
71 * and dump memory allocation information. */
75 * Forward references for procedures defined later in this file:
79 static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
80 Tcl_Interp *interp, int argc, char *argv[]));
84 *----------------------------------------------------------------------
88 * Main program for tclsh and most other Tcl-based applications.
91 * None. This procedure never returns (it exits the process when
95 * This procedure initializes the Tk world and then starts
96 * interpreting commands; almost anything could happen, depending
97 * on the script being interpreted.
99 *----------------------------------------------------------------------
103 Tcl_Main(argc, argv, appInitProc)
104 int argc; /* Number of arguments. */
105 char **argv; /* Array of argument strings. */
106 Tcl_AppInitProc *appInitProc; /* Application-specific initialization
107 * procedure to call after most
108 * initialization but before starting
109 * to execute commands. */
111 char buffer[1000], *cmd, *args, *fileName;
112 int code, gotPartial, tty, length;
114 Tcl_Channel inChannel, outChannel, errChannel;
117 Tcl_FindExecutable(argv[0]);
118 interp = Tcl_CreateInterp();
120 Tcl_InitMemory(interp);
121 Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
122 (Tcl_CmdDeleteProc *) NULL);
126 * Make command-line arguments available in the Tcl variables "argc"
127 * and "argv". If the first argument doesn't start with a "-" then
128 * strip it off and use it as the name of a script file to process.
132 if ((argc > 1) && (argv[1][0] != '-')) {
137 args = Tcl_Merge(argc-1, argv+1);
138 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
140 sprintf(buffer, "%d", argc-1);
141 Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
142 Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
146 * Set the "tcl_interactive" variable.
150 Tcl_SetVar(interp, "tcl_interactive",
151 ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
154 * Invoke application-specific initialization.
157 if ((*appInitProc)(interp) != TCL_OK) {
158 errChannel = Tcl_GetStdChannel(TCL_STDERR);
160 Tcl_Write(errChannel,
161 "application-specific initialization failed: ", -1);
162 Tcl_Write(errChannel, interp->result, -1);
163 Tcl_Write(errChannel, "\n", 1);
168 * If a script file was specified then just source that file
172 if (fileName != NULL) {
173 code = Tcl_EvalFile(interp, fileName);
174 if (code != TCL_OK) {
175 errChannel = Tcl_GetStdChannel(TCL_STDERR);
178 * The following statement guarantees that the errorInfo
179 * variable is set properly.
182 Tcl_AddErrorInfo(interp, "");
183 Tcl_Write(errChannel,
184 Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
185 Tcl_Write(errChannel, "\n", 1);
193 * We're running interactively. Source a user-specific startup
194 * file if the application specified one and if the file exists.
197 fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
199 if (fileName != NULL) {
203 Tcl_DStringInit(&temp);
204 fullName = Tcl_TranslateFileName(interp, fileName, &temp);
205 if (fullName == NULL) {
206 errChannel = Tcl_GetStdChannel(TCL_STDERR);
208 Tcl_Write(errChannel, interp->result, -1);
209 Tcl_Write(errChannel, "\n", 1);
214 * Test for the existence of the rc file before trying to read it.
217 c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
218 if (c != (Tcl_Channel) NULL) {
220 if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
221 errChannel = Tcl_GetStdChannel(TCL_STDERR);
223 Tcl_Write(errChannel, interp->result, -1);
224 Tcl_Write(errChannel, "\n", 1);
229 Tcl_DStringFree(&temp);
233 * Process commands from stdin until there's an end-of-file. Note
234 * that we need to fetch the standard channels again after every
235 * eval, since they may have been changed.
239 Tcl_DStringInit(&command);
240 inChannel = Tcl_GetStdChannel(TCL_STDIN);
241 outChannel = Tcl_GetStdChannel(TCL_STDOUT);
246 promptCmd = Tcl_GetVar(interp,
247 gotPartial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
248 if (promptCmd == NULL) {
250 if (!gotPartial && outChannel) {
251 Tcl_Write(outChannel, "% ", 2);
254 code = Tcl_Eval(interp, promptCmd);
255 inChannel = Tcl_GetStdChannel(TCL_STDIN);
256 outChannel = Tcl_GetStdChannel(TCL_STDOUT);
257 errChannel = Tcl_GetStdChannel(TCL_STDERR);
258 if (code != TCL_OK) {
260 Tcl_Write(errChannel, interp->result, -1);
261 Tcl_Write(errChannel, "\n", 1);
263 Tcl_AddErrorInfo(interp,
264 "\n (script that generates prompt)");
269 Tcl_Flush(outChannel);
275 length = Tcl_Gets(inChannel, &command);
279 if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
284 * Add the newline removed by Tcl_Gets back to the string.
287 (void) Tcl_DStringAppend(&command, "\n", -1);
289 cmd = Tcl_DStringValue(&command);
290 if (!Tcl_CommandComplete(cmd)) {
296 code = Tcl_RecordAndEval(interp, cmd, 0);
297 inChannel = Tcl_GetStdChannel(TCL_STDIN);
298 outChannel = Tcl_GetStdChannel(TCL_STDOUT);
299 errChannel = Tcl_GetStdChannel(TCL_STDERR);
300 Tcl_DStringFree(&command);
301 if (code != TCL_OK) {
303 Tcl_Write(errChannel, interp->result, -1);
304 Tcl_Write(errChannel, "\n", 1);
306 } else if (tty && (*interp->result != 0)) {
308 Tcl_Write(outChannel, interp->result, -1);
309 Tcl_Write(outChannel, "\n", 1);
314 Tcl_DeleteInterp(interp);
321 * Rather than calling exit, invoke the "exit" command so that
322 * users can replace "exit" with some other command to do additional
323 * cleanup on exit. The Tcl_Eval call should never return.
327 sprintf(buffer, "exit %d", exitCode);
328 Tcl_Eval(interp, buffer);
332 *----------------------------------------------------------------------
336 * This is the command procedure for the "checkmem" command, which
337 * causes the application to exit after printing information about
338 * memory usage to the file passed to this command as its first
342 * Returns a standard Tcl completion code.
347 *----------------------------------------------------------------------
353 CheckmemCmd(clientData, interp, argc, argv)
354 ClientData clientData; /* Not used. */
355 Tcl_Interp *interp; /* Interpreter for evaluation. */
356 int argc; /* Number of arguments. */
357 char *argv[]; /* String values of arguments. */
359 extern char *tclMemDumpFileName;
361 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
362 " fileName\"", (char *) NULL);
365 strcpy(dumpFile, argv[1]);
366 tclMemDumpFileName = dumpFile;