4 * This file contains a generic main program for Ck-based applications.
5 * It can be used as-is for many applications, just by supplying a
6 * different appInitProc procedure for each specific application.
7 * Or, it can be used as a template for creating new main programs
10 * Copyright (c) 1990-1994 The Regents of the University of California.
11 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
12 * Copyright (c) 1995 Christian Werner
14 * See the file "license.terms" for information on usage and redistribution
15 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
22 * Global variables used by the main program:
25 static Tcl_Interp *interp; /* Interpreter for this application. */
26 static char *fileName = NULL; /* Script to source, if any. */
29 static char dumpFile[100]; /* Records where to dump memory allocation
31 static int quitFlag = 0; /* 1 means the "checkmem" command was
32 * invoked, so the application should quit
33 * and dump memory allocation information. */
34 static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
35 Tcl_Interp *interp, int argc, char *argv[]));
39 *----------------------------------------------------------------------
43 * Main program for curses wish.
46 * None. This procedure never returns (it exits the process when
50 * This procedure initializes the toolkit and then starts
51 * interpreting commands; almost anything could happen, depending
52 * on the script being interpreted.
54 *----------------------------------------------------------------------
58 Ck_Main(argc, argv, appInitProc)
59 int argc; /* Number of arguments. */
60 char **argv; /* Array of argument strings. */
61 int (*appInitProc)(); /* Application-specific initialization
62 * procedure to call after most
63 * initialization but before starting
64 * to execute commands. */
66 char *args, *msg, *argv0;
69 #if !((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4))
70 Tcl_Channel errChannel;
73 #if !((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4))
74 Tcl_FindExecutable(argv[0]);
77 interp = Tcl_CreateInterp();
80 if (!isatty(0) || !isatty(1)) {
81 #if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)
82 fprintf(stderr, "standard input/output must be terminal\n");
85 errChannel = Tcl_GetStdChannel(TCL_STDERR);
88 "standard input/output must be terminal\n", -1);
90 Tcl_Eval(interp, "exit 1");
91 #if (TCL_MAJOR_VERSION >= 8)
94 exit(1); /* Just in case */
100 Tcl_InitMemory(interp);
101 Tcl_InitMemory(interp);
102 Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
103 (Tcl_CmdDeleteProc *) NULL);
107 * Parse command-line arguments. Argv[1] must contain the name
108 * of the script file to process.
119 * Make command-line arguments available in the Tcl variables "argc"
123 args = Tcl_Merge(argc-1, argv+1);
124 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
126 sprintf(buf, "%d", argc-1);
127 Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
128 Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv0,
130 Tcl_SetVar(interp, "tcl_interactive", (fileName == NULL) ? "1" : "0",
134 * Invoke application-specific initialization.
137 if ((*appInitProc)(interp) != TCL_OK) {
138 #if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)
139 fprintf(stderr, "application-specific initialization failed: %s\n",
142 errChannel = Tcl_GetStdChannel(TCL_STDERR);
144 Tcl_Write(errChannel,
145 "application-specific initialization failed: ", -1);
146 Tcl_Write(errChannel, interp->result, -1);
147 Tcl_Write(errChannel, "\n", 1);
150 msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
155 * Invoke the script specified on the command line, if any.
158 if (fileName != NULL) {
159 code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
162 Tcl_ResetResult(interp);
167 * We're running interactively. Source a user-specific startup
168 * file if the application specified one and if the file exists.
171 #if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)
172 if (tcl_RcFileName != NULL) {
177 Tcl_DStringInit(&temp);
178 fullName = Tcl_TildeSubst(interp, fileName, &temp);
179 if (fullName == NULL)
180 fprintf(stderr, "%s\n", interp->result);
184 * Test for the existence of the rc file before trying to read it.
187 f = fopen(fullName, "r");
190 if (Tcl_EvalFile(interp, fullName) != TCL_OK)
191 fprintf(stderr, "%s\n", interp->result);
193 Tcl_DStringFree(&temp);
197 fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
198 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);
228 Tcl_DStringFree(&temp);
235 * Loop infinitely, waiting for commands to execute.
239 Tcl_Eval(interp, "proc exit {{code 0}} {destroy .}");
246 Tcl_DeleteInterp(interp);
247 Tcl_DumpActiveMemory(dumpFile);
252 * Invoke Tcl exit command.
255 Tcl_Eval(interp, "exit");
256 #if (TCL_MAJOR_VERSION >= 8)
259 exit(1); /* Just in case */
263 msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
265 msg = interp->result;
269 #if (TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION <= 4)
270 fprintf(stderr, "%s\n", msg);
272 errChannel = Tcl_GetStdChannel(TCL_STDERR);
274 Tcl_Write(errChannel, msg, -1);
275 Tcl_Write(errChannel, "\n", 1);
279 Tcl_Eval(interp, "exit 1");
280 #if (TCL_MAJOR_VERSION >= 8)
283 exit(1); /* Just in case */
288 *----------------------------------------------------------------------
292 * This is the command procedure for the "checkmem" command, which
293 * causes the application to exit after printing information about
294 * memory usage to the file passed to this command as its first
298 * Returns a standard Tcl completion code.
303 *----------------------------------------------------------------------
308 CheckmemCmd(clientData, interp, argc, argv)
309 ClientData clientData; /* Not used. */
310 Tcl_Interp *interp; /* Interpreter for evaluation. */
311 int argc; /* Number of arguments. */
312 char *argv[]; /* String values of arguments. */
315 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
316 " fileName\"", (char *) NULL);
319 strcpy(dumpFile, argv[1]);