]>
Commit | Line | Data |
---|---|---|
1 | /* | |
2 | * tclXstartup.c -- | |
3 | * | |
4 | * Startup code for the Tcl shell and other interactive applications. Also | |
5 | * create special commands used just by Tcl shell features. | |
6 | *----------------------------------------------------------------------------- | |
7 | * Copyright 1992 Karl Lehenbauer and Mark Diekhans. | |
8 | * | |
9 | * Permission to use, copy, modify, and distribute this software and its | |
10 | * documentation for any purpose and without fee is hereby granted, provided | |
11 | * that the above copyright notice appear in all copies. Karl Lehenbauer and | |
12 | * Mark Diekhans make no representations about the suitability of this | |
13 | * software for any purpose. It is provided "as is" without express or | |
14 | * implied warranty. | |
15 | *----------------------------------------------------------------------------- | |
16 | * $Id: tclXstartup.c,v 2.1 1992/11/10 04:02:06 markd Exp $ | |
17 | *----------------------------------------------------------------------------- | |
18 | */ | |
19 | ||
20 | #include "tclxint.h" | |
21 | #include "patchlvl.h" | |
22 | ||
23 | extern char * etenv (); | |
24 | ||
25 | extern char *optarg; | |
26 | extern int optind, opterr; | |
27 | ||
28 | typedef struct tclParms_t { | |
29 | int execFile; /* Run the specified file. (no searching) */ | |
30 | int execCommand; /* Execute the specified command. */ | |
31 | unsigned options; /* Quick startup option. */ | |
32 | char *execStr; /* Command file or command to execute. */ | |
33 | char **tclArgv; /* Arguments to pass to tcl script. */ | |
34 | int tclArgc; /* Count of arguments to pass to tcl script. */ | |
35 | char *programName; /* Name of program (less path). */ | |
36 | } tclParms_t; | |
37 | ||
38 | /* | |
39 | * Prototypes of internal functions. | |
40 | */ | |
41 | static void | |
42 | ParseCmdArgs _ANSI_ARGS_((int argc, | |
43 | char **argv, | |
44 | tclParms_t *tclParmsPtr)); | |
45 | ||
46 | static int | |
47 | FindDefaultFile _ANSI_ARGS_((Tcl_Interp *interp, | |
48 | char *defaultFile)); | |
49 | ||
50 | static int | |
51 | ProcessDefaultFile _ANSI_ARGS_((Tcl_Interp *interp, | |
52 | char *defaultFile)); | |
53 | ||
54 | static int | |
55 | ProcessInitFile _ANSI_ARGS_((Tcl_Interp *interp)); | |
56 | ||
57 | \f | |
58 | /* | |
59 | *----------------------------------------------------------------------------- | |
60 | * | |
61 | * Tcl_ErrorAbort -- | |
62 | * | |
63 | * Display error information and abort when an error is returned in the | |
64 | * interp->result. | |
65 | * | |
66 | * Parameters: | |
67 | * o interp - A pointer to the interpreter, should contain the | |
68 | * error message in `result'. | |
69 | * o exitCode - The code to pass to exit. | |
70 | *----------------------------------------------------------------------------- | |
71 | */ | |
72 | void | |
73 | Tcl_ErrorAbort (interp, exitCode) | |
74 | Tcl_Interp *interp; | |
75 | int exitCode; | |
76 | { | |
77 | char *errorStack; | |
78 | ||
79 | fflush (stdout); | |
80 | fprintf (stderr, "Error: %s\n", interp->result); | |
81 | ||
82 | errorStack = Tcl_GetVar (interp, "errorInfo", 1); | |
83 | if (errorStack != NULL) | |
84 | fprintf (stderr, "%s\n", errorStack); | |
85 | exit (exitCode); | |
86 | } | |
87 | \f | |
88 | /* | |
89 | *----------------------------------------------------------------------------- | |
90 | * | |
91 | * ParseCmdArgs -- | |
92 | * | |
93 | * Parse the arguments passed to the Tcl shell | |
94 | * | |
95 | * Parameters: | |
96 | * o argc, argv - Arguments passed to main. | |
97 | * o tclParmsPtr - Results of the parsed Tcl shell command line. | |
98 | *----------------------------------------------------------------------------- | |
99 | */ | |
100 | static void | |
101 | ParseCmdArgs (argc, argv, tclParmsPtr) | |
102 | int argc; | |
103 | char **argv; | |
104 | tclParms_t *tclParmsPtr; | |
105 | { | |
106 | char *scanPtr, *programName; | |
107 | int programNameLen; | |
108 | int option; | |
109 | ||
110 | tclParmsPtr->execFile = FALSE; | |
111 | tclParmsPtr->execCommand = FALSE; | |
112 | tclParmsPtr->options = 0; | |
113 | tclParmsPtr->execStr = NULL; | |
114 | ||
115 | /* | |
116 | * Determine file name (less directories) that the Tcl interpreter is | |
117 | * being run under. | |
118 | */ | |
119 | scanPtr = programName = argv[0]; | |
120 | while (*scanPtr != '\0') { | |
121 | if (*scanPtr == '/') | |
122 | programName = scanPtr + 1; | |
123 | scanPtr++; | |
124 | } | |
125 | tclParmsPtr->programName = programName; | |
126 | programNameLen = strlen (programName); | |
127 | ||
128 | /* | |
129 | * Scan arguments looking for flags to process here rather than to pass | |
130 | * on to the scripts. The '-c' or '-f' must also be the last option to | |
131 | * allow for script arguments starting with `-'. | |
132 | */ | |
133 | while ((option = getopt (argc, argv, "qc:f:u")) != -1) { | |
134 | switch (option) { | |
135 | case 'q': | |
136 | if (tclParmsPtr->options & TCLSH_QUICK_STARTUP) | |
137 | goto usageError; | |
138 | tclParmsPtr->options |= TCLSH_QUICK_STARTUP; | |
139 | break; | |
140 | case 'c': | |
141 | tclParmsPtr->execCommand = TRUE; | |
142 | tclParmsPtr->execStr = optarg; | |
143 | goto exitParse; | |
144 | case 'f': | |
145 | tclParmsPtr->execFile = TRUE; | |
146 | tclParmsPtr->execStr = optarg; | |
147 | goto exitParse; | |
148 | case 'u': | |
149 | default: | |
150 | goto usageError; | |
151 | } | |
152 | } | |
153 | exitParse: | |
154 | ||
155 | /* | |
156 | * If neither `-c' nor `-f' were specified and at least one parameter | |
157 | * is supplied, then if is the file to execute. The rest of the arguments | |
158 | * are passed to the script. Check for '--' as the last option, this also | |
159 | * is a terminator for the file to execute. | |
160 | */ | |
161 | if ((!tclParmsPtr->execCommand) && (!tclParmsPtr->execFile) && | |
162 | (optind != argc) && !STREQU (argv [optind-1], "--")) { | |
163 | tclParmsPtr->execFile = TRUE; | |
164 | tclParmsPtr->execStr = argv [optind]; | |
165 | optind++; | |
166 | } | |
167 | ||
168 | tclParmsPtr->tclArgv = &argv [optind]; | |
169 | tclParmsPtr->tclArgc = argc - optind; | |
170 | return; | |
171 | ||
172 | usageError: | |
173 | fprintf (stderr, "usage: %s %s\n", argv [0], | |
174 | "[-qu] [[-f] script]|[-c command] [args]"); | |
175 | exit (1); | |
176 | } | |
177 | \f | |
178 | /* | |
179 | *----------------------------------------------------------------------------- | |
180 | * FindDefaultFile -- | |
181 | * | |
182 | * Find the Tcl default file. If is looked for in the following order: | |
183 | * o A environment variable named `TCLDEFAULT'. | |
184 | * o The specified defaultFile (which normally has an version number | |
185 | * appended. | |
186 | * A tcl variable `TCLDEFAULT', will contain the path of the default file | |
187 | * to use after this procedure is executed, or a null string if it is not | |
188 | * found. | |
189 | * Parameters | |
190 | * o interp (I) - A pointer to the interpreter. | |
191 | * o defaultFile (I) - The file name of the default file to use, it | |
192 | * normally contains a version number. | |
193 | * Returns: | |
194 | * TCL_OK if all is ok, TCL_ERROR if a error occured. | |
195 | *----------------------------------------------------------------------------- | |
196 | */ | |
197 | static int | |
198 | FindDefaultFile (interp, defaultFile) | |
199 | Tcl_Interp *interp; | |
200 | char *defaultFile; | |
201 | { | |
202 | char *defaultFileToUse; | |
203 | struct stat statBuf; | |
204 | ||
205 | if ((defaultFileToUse = getenv ("TCLDEFAULT")) == NULL) | |
206 | defaultFileToUse = defaultFile; | |
207 | ||
208 | if (stat (defaultFileToUse, &statBuf) < 0) | |
209 | defaultFileToUse = ""; | |
210 | if (Tcl_SetVar (interp, "TCLDEFAULT", defaultFileToUse, | |
211 | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) | |
212 | return TCL_ERROR; | |
213 | else | |
214 | return TCL_OK; | |
215 | } | |
216 | \f | |
217 | /* | |
218 | *----------------------------------------------------------------------------- | |
219 | * ProcessDefaultFile -- | |
220 | * | |
221 | * Process the Tcl default file and TclInit files. The default file | |
222 | * is the only file at a fixed path. It is a script file that usaually | |
223 | * defines a variable "TCLINIT", which has the path of the full | |
224 | * initialization file. The default file can also set things such as path | |
225 | * variables. If the TCLINIT variable is set, that file is then evaluated. | |
226 | * If usually does the full Tcl initialization. | |
227 | * | |
228 | * Parameters | |
229 | * o interp (I) - A pointer to the interpreter. | |
230 | * o defaultFile (I) - The file name of the default file to use, it | |
231 | * normally contains a version number. | |
232 | * Returns: | |
233 | * TCL_OK if all is ok, TCL_ERROR if an error occured. | |
234 | *----------------------------------------------------------------------------- | |
235 | */ | |
236 | static int | |
237 | ProcessDefaultFile (interp, defaultFile) | |
238 | Tcl_Interp *interp; | |
239 | char *defaultFile; | |
240 | { | |
241 | char *defaultFileToUse; | |
242 | ||
243 | defaultFileToUse = Tcl_GetVar (interp, "TCLDEFAULT", 1); | |
244 | if (*defaultFileToUse == '\0') { | |
245 | Tcl_AppendResult (interp, | |
246 | "Can't access Tcl default file,\n", | |
247 | " Located in one of the following ways:\n", | |
248 | " Environment variable: `TCLDEFAULT' or,\n", | |
249 | " File `", defaultFile, "'.\n", | |
250 | (char *) NULL); | |
251 | return TCL_ERROR; | |
252 | } | |
253 | if (Tcl_EvalFile (interp, defaultFileToUse) != TCL_OK) | |
254 | return TCL_ERROR; | |
255 | Tcl_ResetResult (interp); | |
256 | ||
257 | return TCL_OK; | |
258 | } | |
259 | \f | |
260 | /* | |
261 | *----------------------------------------------------------------------------- | |
262 | * ProcessInitFile -- | |
263 | * | |
264 | * Process the Tcl init file, its abolute patch should be contained in | |
265 | * a Tcl variable "TCLINIT". If the variable is not found, the file will | |
266 | * not be evaulated. | |
267 | * | |
268 | * Parameters | |
269 | * o interp (I) - A pointer to the interpreter. | |
270 | * Returns: | |
271 | * TCL_OK if all is ok, TCL_ERROR if an error occured. | |
272 | *----------------------------------------------------------------------------- | |
273 | */ | |
274 | static int | |
275 | ProcessInitFile (interp) | |
276 | Tcl_Interp *interp; | |
277 | { | |
278 | char *initFile; | |
279 | ||
280 | initFile = Tcl_GetVar (interp, "TCLINIT", 1); | |
281 | if (initFile != NULL) { | |
282 | if (Tcl_EvalFile (interp, initFile) != TCL_OK) | |
283 | return TCL_ERROR; | |
284 | } | |
285 | Tcl_ResetResult (interp); | |
286 | return TCL_OK; | |
287 | } | |
288 | \f | |
289 | /* | |
290 | *----------------------------------------------------------------------------- | |
291 | * | |
292 | * Tcl_ShellEnvInit -- | |
293 | * | |
294 | * Process the Tcl default file. The default file is the only file at a | |
295 | * fixed path. It is a script file that usaually defines a variable "TCLINIT", | |
296 | * which has the path of the full initialization file. The default file can | |
297 | * also set things such as path variables. | |
298 | * | |
299 | * Parameters | |
300 | * o interp - A pointer to the interpreter. | |
301 | * o options - Flags to control the behavior of this routine, the following | |
302 | * option is supported: | |
303 | * o TCLSH_QUICK_STARTUP - Don't source the default file or Tcl init | |
304 | * file. | |
305 | * o TCLSH_ABORT_STARTUP_ERR - If set, abort the process if an error | |
306 | * occurs. | |
307 | * o TCLSH_NO_INIT_FILE - If set, process the default file, but not the | |
308 | * init file. This can be used to make the default file do all | |
309 | * initialization. | |
310 | * o programName (I) - The name of the program being executed, usually | |
311 | * taken from the main argv [0]. Used to set the Tcl variable. If NULL | |
312 | * then the variable will not be set. | |
313 | * o argc, argv (I) - Arguments to pass to the program in a Tcl list variable | |
314 | * `argv'. Argv [0] should contain the first argument not the program | |
315 | * name. If argv is NULL, then the variable will not be set. | |
316 | * o interactive (I) - The value to assign to the `interactiveSession' Tcl | |
317 | * variable. TRUE if an interactive Tcl command loop will be entered, | |
318 | * FALSE if a script will be executed . The function does not enter the | |
319 | * command loop, it just sets the variable. | |
320 | * o defaultFile (I) - The file name of the default file to use. If NULL, | |
321 | * then the standard Tcl default file is used, which is formed from a | |
322 | * location specified at compile time and the Extended Tcl version | |
323 | * number. | |
324 | * Notes: | |
325 | * The variables tclAppName, tclAppLongName, tclAppVersion | |
326 | * must be set before calling thus routine if special values are desired. | |
327 | * | |
328 | * Returns: | |
329 | * TCL_OK if all is ok, TCL_ERROR if an error occured. | |
330 | *----------------------------------------------------------------------------- | |
331 | */ | |
332 | int | |
333 | Tcl_ShellEnvInit (interp, options, programName, argc, argv, interactive, | |
334 | defaultFile) | |
335 | Tcl_Interp *interp; | |
336 | unsigned options; | |
337 | CONST char *programName; | |
338 | int argc; | |
339 | CONST char **argv; | |
340 | int interactive; | |
341 | CONST char *defaultFile; | |
342 | { | |
343 | int result = TCL_OK; | |
344 | char *defaultFilePath; | |
345 | ||
346 | /* | |
347 | * Setup patch to default file, if not specified. | |
348 | */ | |
349 | if (defaultFile == NULL) { | |
350 | defaultFilePath = ckalloc (strlen (TCL_DEFAULT) + | |
351 | strlen (TCL_VERSION) + | |
352 | strlen (TCL_EXTD_VERSION_SUFFIX) + 1); | |
353 | strcpy (defaultFilePath, TCL_DEFAULT); | |
354 | strcat (defaultFilePath, TCL_VERSION); | |
355 | strcat (defaultFilePath, TCL_EXTD_VERSION_SUFFIX); | |
356 | } else { | |
357 | defaultFilePath = (char *) defaultFile; | |
358 | } | |
359 | ||
360 | if (programName != NULL) { | |
361 | if (Tcl_SetVar (interp, "programName", (char *) programName, | |
362 | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) | |
363 | goto errorExit; | |
364 | } | |
365 | ||
366 | if (argv != NULL) { | |
367 | char *args; | |
368 | ||
369 | args = Tcl_Merge (argc, (char **) argv); | |
370 | if (Tcl_SetVar (interp, "argv", args, | |
371 | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) | |
372 | result = TCL_ERROR; | |
373 | ckfree (args); | |
374 | if (result != TCL_OK) | |
375 | goto errorExit; | |
376 | } | |
377 | if (Tcl_SetVar (interp, "interactiveSession", interactive ? "1" : "0", | |
378 | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) | |
379 | goto errorExit; | |
380 | ||
381 | tclxVersion = ckalloc (strlen (TCL_VERSION) + | |
382 | strlen (TCL_EXTD_VERSION_SUFFIX) + 1); | |
383 | strcpy (tclxVersion, TCL_VERSION); | |
384 | strcat (tclxVersion, TCL_EXTD_VERSION_SUFFIX); | |
385 | ||
386 | #ifdef PATCHLEVEL | |
387 | tclxPatchlevel = PATCHLEVEL; | |
388 | #else | |
389 | tclxPatchlevel = 0; | |
390 | #endif | |
391 | ||
392 | /* | |
393 | * Set application specific values to return from the infox if they | |
394 | * have not been set. | |
395 | */ | |
396 | if (tclAppName == NULL) | |
397 | tclAppName = "TclX"; | |
398 | if (tclAppLongname == NULL) | |
399 | tclAppLongname = "Extended Tcl"; | |
400 | if (tclAppVersion == NULL) | |
401 | tclAppVersion = tclxVersion; | |
402 | ||
403 | /* | |
404 | * Locate the default file and save in Tcl var TCLDEFAULT. If not quick | |
405 | * startup, process the Tcl default file and execute the Tcl | |
406 | * initialization file. | |
407 | */ | |
408 | if (FindDefaultFile (interp, (char *) defaultFilePath) != TCL_OK) | |
409 | goto errorExit; | |
410 | if (!(options & TCLSH_QUICK_STARTUP)) { | |
411 | if (ProcessDefaultFile (interp, defaultFilePath) != TCL_OK) | |
412 | goto errorExit; | |
413 | if (!(options & TCLSH_NO_INIT_FILE)) { | |
414 | if (ProcessInitFile (interp) != TCL_OK) | |
415 | goto errorExit; | |
416 | } | |
417 | } | |
418 | if (defaultFilePath != defaultFile) | |
419 | ckfree (defaultFilePath); | |
420 | return TCL_OK; | |
421 | ||
422 | errorExit: | |
423 | if (defaultFilePath != defaultFile) | |
424 | ckfree (defaultFilePath); | |
425 | if (options & TCLSH_ABORT_STARTUP_ERR) | |
426 | Tcl_ErrorAbort (interp, 255); | |
427 | return TCL_ERROR; | |
428 | } | |
429 | \f | |
430 | /* | |
431 | *----------------------------------------------------------------------------- | |
432 | * | |
433 | * Tcl_Startup -- | |
434 | * | |
435 | * Initializes the Tcl extended environment. This function processes the | |
436 | * standard command line arguments and locates the Tcl default file. It then | |
437 | * sources the default file and initialization file pointed to by the default | |
438 | * file. Either an interactive command loop is created or a Tcl script file | |
439 | * is executed depending on the command line. This functions calls | |
440 | * Tcl_ShellEnvInit, so it should not be called separately. | |
441 | * | |
442 | * Parameters | |
443 | * o interp - A pointer to the interpreter. | |
444 | * o argc, argv - Arguments passed to main for the command line. | |
445 | * o defaultFile (I) - The file name of the default file to use. If NULL, | |
446 | * then the standard Tcl default file is used, which is formed from a | |
447 | * location specified at compile time and the Extended Tcl version | |
448 | * number. | |
449 | * o options (I) - Options that control startup behavior. None are | |
450 | * currently defined. | |
451 | * Notes: | |
452 | * The variables tclAppName, tclAppLongName, tclAppVersion | |
453 | * must be set before calling thus routine if special values are desired. | |
454 | *----------------------------------------------------------------------------- | |
455 | */ | |
456 | void | |
457 | Tcl_Startup (interp, argc, argv, defaultFile, options) | |
458 | Tcl_Interp *interp; | |
459 | int argc; | |
460 | CONST char **argv; | |
461 | CONST char *defaultFile; | |
462 | unsigned options; | |
463 | { | |
464 | char *cmdBuf; | |
465 | tclParms_t tclParms; | |
466 | int result; | |
467 | ||
468 | /* | |
469 | * Process the arguments. | |
470 | */ | |
471 | ParseCmdArgs (argc, (char **) argv, &tclParms); | |
472 | ||
473 | if (Tcl_ShellEnvInit (interp, | |
474 | tclParms.options, | |
475 | (CONST char *)tclParms.programName, | |
476 | tclParms.tclArgc, (CONST char **)tclParms.tclArgv, | |
477 | (tclParms.execStr == NULL), | |
478 | (CONST char *)defaultFile) != TCL_OK) | |
479 | goto errorAbort; | |
480 | ||
481 | /* | |
482 | * If the invoked tcl interactively, give the user an interactive session, | |
483 | * otherwise, source the command file or execute the specified command. | |
484 | */ | |
485 | if (tclParms.execFile) { | |
486 | result = Tcl_EvalFile (interp, tclParms.execStr); | |
487 | if (result != TCL_OK) | |
488 | goto errorAbort; | |
489 | } else if (tclParms.execCommand) { | |
490 | result = Tcl_Eval (interp, tclParms.execStr, 0, NULL); | |
491 | if (result != TCL_OK) | |
492 | goto errorAbort; | |
493 | } else | |
494 | Tcl_CommandLoop (interp, stdin, stdout, tclShellCmdEvalProc, 0); | |
495 | ||
496 | Tcl_ResetResult (interp); | |
497 | return; | |
498 | ||
499 | errorAbort: | |
500 | Tcl_ErrorAbort (interp, 255); | |
501 | } | |
502 |