55 #define TclFormatInt( buf, n ) sprintf( ( buf ), "%ld", (long) ( n ) )
57 # undef TCL_STORAGE_CLASS
58 # define TCL_STORAGE_CLASS DLLEXPORT
82 extern char * strcpy
_ANSI_ARGS_( (
char *dst, CONST
char *src ) );
106 "Specifying the filename on the command line is compatible with modern",
107 "tclsh syntax. Old tclsh's used the -f syntax, which is still supported.",
108 "You may use either syntax but not both.",
120 "File from which to read commands"
129 "File from which to read commands"
138 "Script to execute on startup"
171 tclStartupScriptFileName =
fileName;
219 int ( *appInitProc )( Tcl_Interp *interp ) )
222 Tcl_Obj *commandPtr = NULL;
224 int code, gotPartial,
tty, length;
226 Tcl_Channel inChannel, outChannel, errChannel;
228 Tcl_DString argString;
232 Tcl_FindExecutable( argv[0] );
233 interp = Tcl_CreateInterp();
234 Tcl_InitMemory( interp );
238 sprintf( usage,
"\nUsage:\n %s [filename] [options]\n", argv[0] );
240 plMergeOpts( options,
"pltcl options", pltcl_notes );
249 if ( tclStartupScriptFileName == NULL )
251 if ( ( argc > 1 ) && ( argv[1][0] !=
'-' ) )
253 tclStartupScriptFileName = argv[1];
258 args = Tcl_Merge( argc - 1, ( CONST
char * CONST * )argv + 1 );
259 Tcl_ExternalToUtfDString( NULL, args, -1, &argString );
260 Tcl_SetVar( interp,
"argv", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
261 Tcl_DStringFree( &argString );
264 if ( tclStartupScriptFileName == NULL )
266 Tcl_ExternalToUtfDString( NULL, argv[0], -1, &argString );
270 tclStartupScriptFileName = Tcl_ExternalToUtfDString( NULL,
271 tclStartupScriptFileName, -1, &argString );
275 Tcl_SetVar( interp,
"argc", buffer, TCL_GLOBAL_ONLY );
276 Tcl_SetVar( interp,
"argv0", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
283 Tcl_SetVar( interp,
"tcl_interactive",
284 ( ( tclStartupScriptFileName == NULL ) && tty ) ?
"1" :
"0",
291 if ( ( *appInitProc )( interp ) != TCL_OK )
293 errChannel = Tcl_GetStdChannel( TCL_STDERR );
296 Tcl_WriteChars( errChannel,
297 "application-specific initialization failed: ", -1 );
298 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
299 Tcl_WriteChars( errChannel,
"\n", 1 );
307 if ( tclStartupScript != NULL )
309 code = Tcl_VarEval( interp, tclStartupScript, (
char *) NULL );
310 if ( code != TCL_OK )
312 fprintf( stderr,
"%s\n", Tcl_GetStringResult( interp ) );
322 if ( tclStartupScriptFileName != NULL )
324 code = Tcl_EvalFile( interp, tclStartupScriptFileName );
325 if ( code != TCL_OK )
327 errChannel = Tcl_GetStdChannel( TCL_STDERR );
335 Tcl_AddErrorInfo( interp,
"" );
336 Tcl_WriteObj( errChannel, Tcl_GetVar2Ex( interp,
"errorInfo",
337 NULL, TCL_GLOBAL_ONLY ) );
338 Tcl_WriteChars( errChannel,
"\n", 1 );
344 Tcl_DStringFree( &argString );
351 Tcl_SourceRCFile( interp );
359 commandPtr = Tcl_NewObj();
360 Tcl_IncrRefCount( commandPtr );
362 inChannel = Tcl_GetStdChannel( TCL_STDIN );
363 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
369 Tcl_Obj *promptCmdPtr;
371 promptCmdPtr = Tcl_GetVar2Ex( interp,
372 ( gotPartial ?
"tcl_prompt2" :
"tcl_prompt1" ),
373 NULL, TCL_GLOBAL_ONLY );
374 if ( promptCmdPtr == NULL )
377 if ( !gotPartial && outChannel )
379 Tcl_WriteChars( outChannel,
"% ", 2 );
384 code = Tcl_EvalObjEx( interp, promptCmdPtr, 0 );
385 inChannel = Tcl_GetStdChannel( TCL_STDIN );
386 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
387 errChannel = Tcl_GetStdChannel( TCL_STDERR );
388 if ( code != TCL_OK )
392 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
393 Tcl_WriteChars( errChannel,
"\n", 1 );
395 Tcl_AddErrorInfo( interp,
396 "\n (script that generates prompt)" );
402 Tcl_Flush( outChannel );
409 length = Tcl_GetsObj( inChannel, commandPtr );
414 if ( ( length == 0 ) && Tcl_Eof( inChannel ) && ( !gotPartial ) )
423 Tcl_AppendToObj( commandPtr,
"\n", 1 );
424 if ( !Tcl_CommandComplete( Tcl_GetString( commandPtr ) ) )
431 code = Tcl_RecordAndEvalObj( interp, commandPtr, 0 );
432 inChannel = Tcl_GetStdChannel( TCL_STDIN );
433 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
434 errChannel = Tcl_GetStdChannel( TCL_STDERR );
435 Tcl_DecrRefCount( commandPtr );
436 commandPtr = Tcl_NewObj();
437 Tcl_IncrRefCount( commandPtr );
442 ( *tclErrorHandler )(
interp, code,
tty );
450 if ( code != TCL_OK )
454 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
455 Tcl_WriteChars( errChannel,
"\n", 1 );
460 resultPtr = Tcl_GetObjResult( interp );
461 Tcl_GetStringFromObj( resultPtr, &length );
462 if ( ( length > 0 ) && outChannel )
464 Tcl_WriteObj( outChannel, resultPtr );
465 Tcl_WriteChars( outChannel,
"\n", 1 );
478 if ( commandPtr != NULL )
480 Tcl_DecrRefCount( commandPtr );
482 sprintf( buffer,
"exit %d", exitCode );
483 Tcl_Eval( interp, buffer );