|
1 /* |
|
2 * tclMain.c -- |
|
3 * |
|
4 * Main program for Tcl shells and other Tcl-based applications. |
|
5 * |
|
6 * Copyright (c) 1988-1994 The Regents of the University of California. |
|
7 * Copyright (c) 1994-1997 Sun Microsystems, Inc. |
|
8 * Copyright (c) 2000 Ajuba Solutions. |
|
9 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. |
|
10 * |
|
11 * See the file "license.terms" for information on usage and redistribution |
|
12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
|
13 * |
|
14 * RCS: @(#) $Id: tclMain.c,v 1.20.2.3 2006/05/05 18:08:58 dgp Exp $ |
|
15 */ |
|
16 |
|
17 #include "tcl.h" |
|
18 #include "tclInt.h" |
|
19 #if defined(__SYMBIAN32__) |
|
20 #include "tclPort.h" |
|
21 #include "tclSymbianGlobals.h" |
|
22 #include "tclIntPlatDecls.h" |
|
23 #endif |
|
24 |
|
25 # undef TCL_STORAGE_CLASS |
|
26 # define TCL_STORAGE_CLASS DLLEXPORT |
|
27 |
|
28 /* |
|
29 * Declarations for various library procedures and variables (don't want |
|
30 * to include tclPort.h here, because people might copy this file out of |
|
31 * the Tcl source directory to make their own modified versions). |
|
32 */ |
|
33 |
|
34 #if !defined(MAC_TCL) |
|
35 extern int isatty _ANSI_ARGS_((int fd)); |
|
36 #else |
|
37 #include <unistd.h> |
|
38 #endif |
|
39 |
|
40 static Tcl_Obj *tclStartupScriptPath = NULL; |
|
41 |
|
42 static Tcl_MainLoopProc *mainLoopProc = NULL; |
|
43 |
|
44 /* |
|
45 * Structure definition for information used to keep the state of |
|
46 * an interactive command processor that reads lines from standard |
|
47 * input and writes prompts and results to standard output. |
|
48 */ |
|
49 |
|
50 typedef enum { |
|
51 PROMPT_NONE, /* Print no prompt */ |
|
52 PROMPT_START, /* Print prompt for command start */ |
|
53 PROMPT_CONTINUE /* Print prompt for command continuation */ |
|
54 } PromptType; |
|
55 |
|
56 typedef struct InteractiveState { |
|
57 Tcl_Channel input; /* The standard input channel from which |
|
58 * lines are read. */ |
|
59 int tty; /* Non-zero means standard input is a |
|
60 * terminal-like device. Zero means it's |
|
61 * a file. */ |
|
62 Tcl_Obj *commandPtr; /* Used to assemble lines of input into |
|
63 * Tcl commands. */ |
|
64 PromptType prompt; /* Next prompt to print */ |
|
65 Tcl_Interp *interp; /* Interpreter that evaluates interactive |
|
66 * commands. */ |
|
67 } InteractiveState; |
|
68 |
|
69 /* |
|
70 * Forward declarations for procedures defined later in this file. |
|
71 */ |
|
72 |
|
73 static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, |
|
74 PromptType *promptPtr)); |
|
75 static void StdinProc _ANSI_ARGS_((ClientData clientData, |
|
76 int mask)); |
|
77 /* |
|
78 *---------------------------------------------------------------------- |
|
79 * |
|
80 * TclSetStartupScriptPath -- |
|
81 * |
|
82 * Primes the startup script VFS path, used to override the |
|
83 * command line processing. |
|
84 * |
|
85 * Results: |
|
86 * None. |
|
87 * |
|
88 * Side effects: |
|
89 * This procedure initializes the VFS path of the Tcl script to |
|
90 * run at startup. |
|
91 * |
|
92 *---------------------------------------------------------------------- |
|
93 */ |
|
94 void TclSetStartupScriptPath(pathPtr) |
|
95 Tcl_Obj *pathPtr; |
|
96 { |
|
97 if (tclStartupScriptPath != NULL) { |
|
98 Tcl_DecrRefCount(tclStartupScriptPath); |
|
99 } |
|
100 tclStartupScriptPath = pathPtr; |
|
101 if (tclStartupScriptPath != NULL) { |
|
102 Tcl_IncrRefCount(tclStartupScriptPath); |
|
103 } |
|
104 } |
|
105 |
|
106 |
|
107 /* |
|
108 *---------------------------------------------------------------------- |
|
109 * |
|
110 * TclGetStartupScriptPath -- |
|
111 * |
|
112 * Gets the startup script VFS path, used to override the |
|
113 * command line processing. |
|
114 * |
|
115 * Results: |
|
116 * The startup script VFS path, NULL if none has been set. |
|
117 * |
|
118 * Side effects: |
|
119 * None. |
|
120 * |
|
121 *---------------------------------------------------------------------- |
|
122 */ |
|
123 Tcl_Obj *TclGetStartupScriptPath() |
|
124 { |
|
125 return tclStartupScriptPath; |
|
126 } |
|
127 |
|
128 |
|
129 /* |
|
130 *---------------------------------------------------------------------- |
|
131 * |
|
132 * TclSetStartupScriptFileName -- |
|
133 * |
|
134 * Primes the startup script file name, used to override the |
|
135 * command line processing. |
|
136 * |
|
137 * Results: |
|
138 * None. |
|
139 * |
|
140 * Side effects: |
|
141 * This procedure initializes the file name of the Tcl script to |
|
142 * run at startup. |
|
143 * |
|
144 *---------------------------------------------------------------------- |
|
145 */ |
|
146 void TclSetStartupScriptFileName(fileName) |
|
147 CONST char *fileName; |
|
148 { |
|
149 Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); |
|
150 TclSetStartupScriptPath(pathPtr); |
|
151 } |
|
152 |
|
153 |
|
154 /* |
|
155 *---------------------------------------------------------------------- |
|
156 * |
|
157 * TclGetStartupScriptFileName -- |
|
158 * |
|
159 * Gets the startup script file name, used to override the |
|
160 * command line processing. |
|
161 * |
|
162 * Results: |
|
163 * The startup script file name, NULL if none has been set. |
|
164 * |
|
165 * Side effects: |
|
166 * None. |
|
167 * |
|
168 *---------------------------------------------------------------------- |
|
169 */ |
|
170 CONST char *TclGetStartupScriptFileName() |
|
171 { |
|
172 Tcl_Obj *pathPtr = TclGetStartupScriptPath(); |
|
173 |
|
174 if (pathPtr == NULL) { |
|
175 return NULL; |
|
176 } |
|
177 return Tcl_GetString(pathPtr); |
|
178 } |
|
179 |
|
180 |
|
181 |
|
182 /* |
|
183 *---------------------------------------------------------------------- |
|
184 * |
|
185 * Tcl_Main -- |
|
186 * |
|
187 * Main program for tclsh and most other Tcl-based applications. |
|
188 * |
|
189 * Results: |
|
190 * None. This procedure never returns (it exits the process when |
|
191 * it's done). |
|
192 * |
|
193 * Side effects: |
|
194 * This procedure initializes the Tcl world and then starts |
|
195 * interpreting commands; almost anything could happen, depending |
|
196 * on the script being interpreted. |
|
197 * |
|
198 *---------------------------------------------------------------------- |
|
199 */ |
|
200 |
|
201 void |
|
202 Tcl_Main(argc, argv, appInitProc) |
|
203 int argc; /* Number of arguments. */ |
|
204 char **argv; /* Array of argument strings. */ |
|
205 Tcl_AppInitProc *appInitProc; |
|
206 /* Application-specific initialization |
|
207 * procedure to call after most |
|
208 * initialization but before starting to |
|
209 * execute commands. */ |
|
210 { |
|
211 Tcl_Obj *resultPtr, *argvPtr, *commandPtr = NULL; |
|
212 PromptType prompt = PROMPT_START; |
|
213 int code, length, tty, exitCode = 0; |
|
214 Tcl_Channel inChannel, outChannel, errChannel; |
|
215 Tcl_Interp *interp; |
|
216 Tcl_DString appName; |
|
217 Tcl_Obj *objPtr; |
|
218 |
|
219 #if defined(__SYMBIAN32__) |
|
220 int isChildProcess = 0; |
|
221 int oldArgc = 0; |
|
222 #endif |
|
223 Tcl_FindExecutable(argv[0]); |
|
224 interp = Tcl_CreateInterp(); |
|
225 |
|
226 #if defined(__SYMBIAN32__) |
|
227 if (ChildProcessInit(&argc, &argv)) |
|
228 { |
|
229 oldArgc = argc; |
|
230 argc = argc-4; |
|
231 isChildProcess = 1; |
|
232 } |
|
233 #endif |
|
234 |
|
235 Tcl_InitMemory(interp); |
|
236 |
|
237 /* |
|
238 * Make command-line arguments available in the Tcl variables "argc" |
|
239 * and "argv". If the first argument doesn't start with a "-" then |
|
240 * strip it off and use it as the name of a script file to process. |
|
241 */ |
|
242 |
|
243 if (TclGetStartupScriptPath() == NULL) { |
|
244 if ((argc > 1) && (argv[1][0] != '-')) { |
|
245 TclSetStartupScriptFileName(argv[1]); |
|
246 argc--; |
|
247 argv++; |
|
248 } |
|
249 } |
|
250 |
|
251 if (TclGetStartupScriptPath() == NULL) { |
|
252 Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); |
|
253 } else { |
|
254 TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL, |
|
255 TclGetStartupScriptFileName(), -1, &appName)); |
|
256 } |
|
257 Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); |
|
258 Tcl_DStringFree(&appName); |
|
259 argc--; |
|
260 argv++; |
|
261 |
|
262 objPtr = Tcl_NewIntObj(argc); |
|
263 Tcl_IncrRefCount(objPtr); |
|
264 Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY); |
|
265 Tcl_DecrRefCount(objPtr); |
|
266 |
|
267 argvPtr = Tcl_NewListObj(0, NULL); |
|
268 while (argc--) { |
|
269 Tcl_DString ds; |
|
270 Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds); |
|
271 Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( |
|
272 Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); |
|
273 Tcl_DStringFree(&ds); |
|
274 } |
|
275 Tcl_IncrRefCount(argvPtr); |
|
276 Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); |
|
277 Tcl_DecrRefCount(argvPtr); |
|
278 |
|
279 /* |
|
280 * Set the "tcl_interactive" variable. |
|
281 */ |
|
282 |
|
283 tty = isatty(0); |
|
284 Tcl_SetVar(interp, "tcl_interactive", |
|
285 ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0", |
|
286 TCL_GLOBAL_ONLY); |
|
287 |
|
288 /* |
|
289 * Invoke application-specific initialization. |
|
290 */ |
|
291 |
|
292 Tcl_Preserve((ClientData) interp); |
|
293 if ((*appInitProc)(interp) != TCL_OK) { |
|
294 errChannel = Tcl_GetStdChannel(TCL_STDERR); |
|
295 if (errChannel) { |
|
296 Tcl_WriteChars(errChannel, |
|
297 "application-specific initialization failed: ", -1); |
|
298 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); |
|
299 Tcl_WriteChars(errChannel, "\n", 1); |
|
300 } |
|
301 } |
|
302 if (Tcl_InterpDeleted(interp)) { |
|
303 goto done; |
|
304 } |
|
305 |
|
306 /* |
|
307 * If a script file was specified then just source that file |
|
308 * and quit. |
|
309 */ |
|
310 |
|
311 if (TclGetStartupScriptPath() != NULL) { |
|
312 code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath()); |
|
313 if (code != TCL_OK) { |
|
314 errChannel = Tcl_GetStdChannel(TCL_STDERR); |
|
315 if (errChannel) { |
|
316 |
|
317 /* |
|
318 * The following statement guarantees that the errorInfo |
|
319 * variable is set properly. |
|
320 */ |
|
321 |
|
322 Tcl_AddErrorInfo(interp, ""); |
|
323 Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo", |
|
324 NULL, TCL_GLOBAL_ONLY)); |
|
325 Tcl_WriteChars(errChannel, "\n", 1); |
|
326 } |
|
327 exitCode = 1; |
|
328 } |
|
329 goto done; |
|
330 } |
|
331 |
|
332 /* |
|
333 * We're running interactively. Source a user-specific startup |
|
334 * file if the application specified one and if the file exists. |
|
335 */ |
|
336 |
|
337 Tcl_SourceRCFile(interp); |
|
338 |
|
339 /* |
|
340 * Process commands from stdin until there's an end-of-file. Note |
|
341 * that we need to fetch the standard channels again after every |
|
342 * eval, since they may have been changed. |
|
343 */ |
|
344 |
|
345 commandPtr = Tcl_NewObj(); |
|
346 Tcl_IncrRefCount(commandPtr); |
|
347 |
|
348 /* |
|
349 * Get a new value for tty if anyone writes to ::tcl_interactive |
|
350 */ |
|
351 Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN); |
|
352 inChannel = Tcl_GetStdChannel(TCL_STDIN); |
|
353 outChannel = Tcl_GetStdChannel(TCL_STDOUT); |
|
354 while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) { |
|
355 if (mainLoopProc == NULL) { |
|
356 if (tty) { |
|
357 Prompt(interp, &prompt); |
|
358 if (Tcl_InterpDeleted(interp)) { |
|
359 break; |
|
360 } |
|
361 inChannel = Tcl_GetStdChannel(TCL_STDIN); |
|
362 if (inChannel == (Tcl_Channel) NULL) { |
|
363 break; |
|
364 } |
|
365 } |
|
366 if (Tcl_IsShared(commandPtr)) { |
|
367 Tcl_DecrRefCount(commandPtr); |
|
368 commandPtr = Tcl_DuplicateObj(commandPtr); |
|
369 Tcl_IncrRefCount(commandPtr); |
|
370 } |
|
371 length = Tcl_GetsObj(inChannel, commandPtr); |
|
372 if (length < 0) { |
|
373 if (Tcl_InputBlocked(inChannel)) { |
|
374 |
|
375 /* |
|
376 * This can only happen if stdin has been set to |
|
377 * non-blocking. In that case cycle back and try |
|
378 * again. This sets up a tight polling loop (since |
|
379 * we have no event loop running). If this causes |
|
380 * bad CPU hogging, we might try toggling the blocking |
|
381 * on stdin instead. |
|
382 */ |
|
383 |
|
384 continue; |
|
385 } |
|
386 |
|
387 /* |
|
388 * Either EOF, or an error on stdin; we're done |
|
389 */ |
|
390 |
|
391 break; |
|
392 } |
|
393 |
|
394 /* |
|
395 * Add the newline removed by Tcl_GetsObj back to the string. |
|
396 */ |
|
397 |
|
398 if (Tcl_IsShared(commandPtr)) { |
|
399 Tcl_DecrRefCount(commandPtr); |
|
400 commandPtr = Tcl_DuplicateObj(commandPtr); |
|
401 Tcl_IncrRefCount(commandPtr); |
|
402 } |
|
403 Tcl_AppendToObj(commandPtr, "\n", 1); |
|
404 if (!TclObjCommandComplete(commandPtr)) { |
|
405 prompt = PROMPT_CONTINUE; |
|
406 continue; |
|
407 } |
|
408 |
|
409 prompt = PROMPT_START; |
|
410 code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); |
|
411 inChannel = Tcl_GetStdChannel(TCL_STDIN); |
|
412 outChannel = Tcl_GetStdChannel(TCL_STDOUT); |
|
413 errChannel = Tcl_GetStdChannel(TCL_STDERR); |
|
414 Tcl_DecrRefCount(commandPtr); |
|
415 commandPtr = Tcl_NewObj(); |
|
416 Tcl_IncrRefCount(commandPtr); |
|
417 if (code != TCL_OK) { |
|
418 if (errChannel) { |
|
419 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); |
|
420 Tcl_WriteChars(errChannel, "\n", 1); |
|
421 } |
|
422 } else if (tty) { |
|
423 resultPtr = Tcl_GetObjResult(interp); |
|
424 Tcl_IncrRefCount(resultPtr); |
|
425 Tcl_GetStringFromObj(resultPtr, &length); |
|
426 if ((length > 0) && outChannel) { |
|
427 Tcl_WriteObj(outChannel, resultPtr); |
|
428 Tcl_WriteChars(outChannel, "\n", 1); |
|
429 } |
|
430 Tcl_DecrRefCount(resultPtr); |
|
431 } |
|
432 } else { /* (mainLoopProc != NULL) */ |
|
433 /* |
|
434 * If a main loop has been defined while running interactively, |
|
435 * we want to start a fileevent based prompt by establishing a |
|
436 * channel handler for stdin. |
|
437 */ |
|
438 |
|
439 InteractiveState *isPtr = NULL; |
|
440 |
|
441 if (inChannel) { |
|
442 if (tty) { |
|
443 Prompt(interp, &prompt); |
|
444 } |
|
445 isPtr = (InteractiveState *) |
|
446 ckalloc((int) sizeof(InteractiveState)); |
|
447 isPtr->input = inChannel; |
|
448 isPtr->tty = tty; |
|
449 isPtr->commandPtr = commandPtr; |
|
450 isPtr->prompt = prompt; |
|
451 isPtr->interp = interp; |
|
452 |
|
453 Tcl_UnlinkVar(interp, "tcl_interactive"); |
|
454 Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty), |
|
455 TCL_LINK_BOOLEAN); |
|
456 |
|
457 Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, |
|
458 (ClientData) isPtr); |
|
459 } |
|
460 |
|
461 (*mainLoopProc)(); |
|
462 mainLoopProc = NULL; |
|
463 |
|
464 if (inChannel) { |
|
465 tty = isPtr->tty; |
|
466 Tcl_UnlinkVar(interp, "tcl_interactive"); |
|
467 Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, |
|
468 TCL_LINK_BOOLEAN); |
|
469 prompt = isPtr->prompt; |
|
470 commandPtr = isPtr->commandPtr; |
|
471 if (isPtr->input != (Tcl_Channel) NULL) { |
|
472 Tcl_DeleteChannelHandler(isPtr->input, StdinProc, |
|
473 (ClientData) isPtr); |
|
474 } |
|
475 ckfree((char *)isPtr); |
|
476 } |
|
477 inChannel = Tcl_GetStdChannel(TCL_STDIN); |
|
478 outChannel = Tcl_GetStdChannel(TCL_STDOUT); |
|
479 errChannel = Tcl_GetStdChannel(TCL_STDERR); |
|
480 } |
|
481 #ifdef TCL_MEM_DEBUG |
|
482 |
|
483 /* |
|
484 * This code here only for the (unsupported and deprecated) |
|
485 * [checkmem] command. |
|
486 */ |
|
487 |
|
488 if (tclMemDumpFileName != NULL) { |
|
489 mainLoopProc = NULL; |
|
490 Tcl_DeleteInterp(interp); |
|
491 } |
|
492 #endif |
|
493 } |
|
494 |
|
495 done: |
|
496 if ((exitCode == 0) && (mainLoopProc != NULL)) { |
|
497 |
|
498 /* |
|
499 * If everything has gone OK so far, call the main loop proc, |
|
500 * if it exists. Packages (like Tk) can set it to start processing |
|
501 * events at this point. |
|
502 */ |
|
503 |
|
504 (*mainLoopProc)(); |
|
505 mainLoopProc = NULL; |
|
506 } |
|
507 if (commandPtr != NULL) { |
|
508 Tcl_DecrRefCount(commandPtr); |
|
509 } |
|
510 |
|
511 #if defined(__SYMBIAN32__) |
|
512 ChildProcessCleanup(isChildProcess, oldArgc, argv); |
|
513 #else |
|
514 close (TCL_STDIN); |
|
515 close (TCL_STDOUT); |
|
516 close (TCL_STDERR); //every process has a error file |
|
517 #endif |
|
518 |
|
519 /* |
|
520 * Rather than calling exit, invoke the "exit" command so that |
|
521 * users can replace "exit" with some other command to do additional |
|
522 * cleanup on exit. The Tcl_Eval call should never return. |
|
523 */ |
|
524 |
|
525 if (!Tcl_InterpDeleted(interp)) { |
|
526 char buffer[TCL_INTEGER_SPACE + 5]; |
|
527 sprintf(buffer, "exit %d", exitCode); |
|
528 Tcl_Eval(interp, buffer); |
|
529 |
|
530 /* |
|
531 * If Tcl_Eval returns, trying to eval [exit], something |
|
532 * unusual is happening. Maybe interp has been deleted; |
|
533 * maybe [exit] was redefined. We still want to cleanup |
|
534 * and exit. |
|
535 */ |
|
536 |
|
537 if (!Tcl_InterpDeleted(interp)) { |
|
538 Tcl_DeleteInterp(interp); |
|
539 } |
|
540 } |
|
541 TclSetStartupScriptPath(NULL); |
|
542 |
|
543 /* |
|
544 * If we get here, the master interp has been deleted. Allow |
|
545 * its destruction with the last matching Tcl_Release. |
|
546 */ |
|
547 |
|
548 Tcl_Release((ClientData) interp); |
|
549 Tcl_Exit(exitCode); |
|
550 } |
|
551 |
|
552 /* |
|
553 *--------------------------------------------------------------- |
|
554 * |
|
555 * Tcl_SetMainLoop -- |
|
556 * |
|
557 * Sets an alternative main loop procedure. |
|
558 * |
|
559 * Results: |
|
560 * Returns the previously defined main loop procedure. |
|
561 * |
|
562 * Side effects: |
|
563 * This procedure will be called before Tcl exits, allowing for |
|
564 * the creation of an event loop. |
|
565 * |
|
566 *--------------------------------------------------------------- |
|
567 */ |
|
568 |
|
569 EXPORT_C void |
|
570 Tcl_SetMainLoop(proc) |
|
571 Tcl_MainLoopProc *proc; |
|
572 { |
|
573 mainLoopProc = proc; |
|
574 } |
|
575 |
|
576 /* |
|
577 *---------------------------------------------------------------------- |
|
578 * |
|
579 * StdinProc -- |
|
580 * |
|
581 * This procedure is invoked by the event dispatcher whenever |
|
582 * standard input becomes readable. It grabs the next line of |
|
583 * input characters, adds them to a command being assembled, and |
|
584 * executes the command if it's complete. |
|
585 * |
|
586 * Results: |
|
587 * None. |
|
588 * |
|
589 * Side effects: |
|
590 * Could be almost arbitrary, depending on the command that's |
|
591 * typed. |
|
592 * |
|
593 *---------------------------------------------------------------------- |
|
594 */ |
|
595 |
|
596 /* ARGSUSED */ |
|
597 static void |
|
598 StdinProc(clientData, mask) |
|
599 ClientData clientData; /* The state of interactive cmd line */ |
|
600 int mask; /* Not used. */ |
|
601 { |
|
602 InteractiveState *isPtr = (InteractiveState *) clientData; |
|
603 Tcl_Channel chan = isPtr->input; |
|
604 Tcl_Obj *commandPtr = isPtr->commandPtr; |
|
605 Tcl_Interp *interp = isPtr->interp; |
|
606 int code, length; |
|
607 |
|
608 if (Tcl_IsShared(commandPtr)) { |
|
609 Tcl_DecrRefCount(commandPtr); |
|
610 commandPtr = Tcl_DuplicateObj(commandPtr); |
|
611 Tcl_IncrRefCount(commandPtr); |
|
612 } |
|
613 length = Tcl_GetsObj(chan, commandPtr); |
|
614 if (length < 0) { |
|
615 if (Tcl_InputBlocked(chan)) { |
|
616 return; |
|
617 } |
|
618 if (isPtr->tty) { |
|
619 /* |
|
620 * Would be better to find a way to exit the mainLoop? |
|
621 * Or perhaps evaluate [exit]? Leaving as is for now due |
|
622 * to compatibility concerns. |
|
623 */ |
|
624 Tcl_Exit(0); |
|
625 } |
|
626 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr); |
|
627 return; |
|
628 } |
|
629 |
|
630 if (Tcl_IsShared(commandPtr)) { |
|
631 Tcl_DecrRefCount(commandPtr); |
|
632 commandPtr = Tcl_DuplicateObj(commandPtr); |
|
633 Tcl_IncrRefCount(commandPtr); |
|
634 } |
|
635 Tcl_AppendToObj(commandPtr, "\n", 1); |
|
636 if (!TclObjCommandComplete(commandPtr)) { |
|
637 isPtr->prompt = PROMPT_CONTINUE; |
|
638 goto prompt; |
|
639 } |
|
640 isPtr->prompt = PROMPT_START; |
|
641 |
|
642 /* |
|
643 * Disable the stdin channel handler while evaluating the command; |
|
644 * otherwise if the command re-enters the event loop we might |
|
645 * process commands from stdin before the current command is |
|
646 * finished. Among other things, this will trash the text of the |
|
647 * command being evaluated. |
|
648 */ |
|
649 |
|
650 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr); |
|
651 code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); |
|
652 isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN); |
|
653 Tcl_DecrRefCount(commandPtr); |
|
654 isPtr->commandPtr = commandPtr = Tcl_NewObj(); |
|
655 Tcl_IncrRefCount(commandPtr); |
|
656 if (chan != (Tcl_Channel) NULL) { |
|
657 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, |
|
658 (ClientData) isPtr); |
|
659 } |
|
660 if (code != TCL_OK) { |
|
661 Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); |
|
662 if (errChannel != (Tcl_Channel) NULL) { |
|
663 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); |
|
664 Tcl_WriteChars(errChannel, "\n", 1); |
|
665 } |
|
666 } else if (isPtr->tty) { |
|
667 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); |
|
668 Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT); |
|
669 Tcl_IncrRefCount(resultPtr); |
|
670 Tcl_GetStringFromObj(resultPtr, &length); |
|
671 if ((length >0) && (outChannel != (Tcl_Channel) NULL)) { |
|
672 Tcl_WriteObj(outChannel, resultPtr); |
|
673 Tcl_WriteChars(outChannel, "\n", 1); |
|
674 } |
|
675 Tcl_DecrRefCount(resultPtr); |
|
676 } |
|
677 |
|
678 /* |
|
679 * If a tty stdin is still around, output a prompt. |
|
680 */ |
|
681 |
|
682 prompt: |
|
683 if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) { |
|
684 Prompt(interp, &(isPtr->prompt)); |
|
685 isPtr->input = Tcl_GetStdChannel(TCL_STDIN); |
|
686 } |
|
687 } |
|
688 |
|
689 /* |
|
690 *---------------------------------------------------------------------- |
|
691 * |
|
692 * Prompt -- |
|
693 * |
|
694 * Issue a prompt on standard output, or invoke a script |
|
695 * to issue the prompt. |
|
696 * |
|
697 * Results: |
|
698 * None. |
|
699 * |
|
700 * Side effects: |
|
701 * A prompt gets output, and a Tcl script may be evaluated |
|
702 * in interp. |
|
703 * |
|
704 *---------------------------------------------------------------------- |
|
705 */ |
|
706 |
|
707 static void |
|
708 Prompt(interp, promptPtr) |
|
709 Tcl_Interp *interp; /* Interpreter to use for prompting. */ |
|
710 PromptType *promptPtr; /* Points to type of prompt to print. |
|
711 * Filled with PROMPT_NONE after a |
|
712 * prompt is printed. */ |
|
713 { |
|
714 Tcl_Obj *promptCmdPtr; |
|
715 int code; |
|
716 Tcl_Channel outChannel, errChannel; |
|
717 |
|
718 if (*promptPtr == PROMPT_NONE) { |
|
719 return; |
|
720 } |
|
721 |
|
722 promptCmdPtr = Tcl_GetVar2Ex(interp, |
|
723 ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"), |
|
724 NULL, TCL_GLOBAL_ONLY); |
|
725 if (Tcl_InterpDeleted(interp)) { |
|
726 return; |
|
727 } |
|
728 if (promptCmdPtr == NULL) { |
|
729 defaultPrompt: |
|
730 outChannel = Tcl_GetStdChannel(TCL_STDOUT); |
|
731 if ((*promptPtr == PROMPT_START) |
|
732 && (outChannel != (Tcl_Channel) NULL)) { |
|
733 Tcl_WriteChars(outChannel, "% ", 2); |
|
734 } |
|
735 } else { |
|
736 code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL); |
|
737 if (code != TCL_OK) { |
|
738 Tcl_AddErrorInfo(interp, |
|
739 "\n (script that generates prompt)"); |
|
740 errChannel = Tcl_GetStdChannel(TCL_STDERR); |
|
741 if (errChannel != (Tcl_Channel) NULL) { |
|
742 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); |
|
743 Tcl_WriteChars(errChannel, "\n", 1); |
|
744 } |
|
745 goto defaultPrompt; |
|
746 } |
|
747 } |
|
748 outChannel = Tcl_GetStdChannel(TCL_STDOUT); |
|
749 if (outChannel != (Tcl_Channel) NULL) { |
|
750 Tcl_Flush(outChannel); |
|
751 } |
|
752 *promptPtr = PROMPT_NONE; |
|
753 } |