51 #define TclFormatInt( buf, n ) sprintf( ( buf ), "%ld", (long) ( n ) )
53 # undef TCL_STORAGE_CLASS
54 # define TCL_STORAGE_CLASS DLLEXPORT
78 extern char * strcpy
_ANSI_ARGS_( (
char *dst, CONST
char *src ) );
102 "Specifying the filename on the command line is compatible with modern",
103 "tclsh syntax. Old tclsh's used the -f syntax, which is still supported.",
104 "You may use either syntax but not both.",
116 "File from which to read commands"
125 "File from which to read commands"
134 "Script to execute on startup"
215 int ( *appInitProc )( Tcl_Interp *
interp ) )
218 Tcl_Obj *commandPtr = NULL;
220 int code, gotPartial,
tty, length;
222 Tcl_Channel inChannel, outChannel, errChannel;
224 Tcl_DString argString;
228 Tcl_FindExecutable(
argv[0] );
229 interp = Tcl_CreateInterp();
234 sprintf(
usage,
"\nUsage:\n %s [filename] [options]\n",
argv[0] );
247 if ( (
argc > 1 ) && (
argv[1][0] !=
'-' ) )
254 args = Tcl_Merge(
argc - 1, ( CONST
char * CONST * )
argv + 1 );
255 Tcl_ExternalToUtfDString( NULL, args, -1, &argString );
256 Tcl_SetVar(
interp,
"argv", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
257 Tcl_DStringFree( &argString );
262 Tcl_ExternalToUtfDString( NULL,
argv[0], -1, &argString );
272 Tcl_SetVar(
interp,
"argv0", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
279 Tcl_SetVar(
interp,
"tcl_interactive",
287 if ( ( *appInitProc )(
interp ) != TCL_OK )
289 errChannel = Tcl_GetStdChannel( TCL_STDERR );
292 Tcl_WriteChars( errChannel,
293 "application-specific initialization failed: ", -1 );
294 Tcl_WriteObj( errChannel, Tcl_GetObjResult(
interp ) );
295 Tcl_WriteChars( errChannel,
"\n", 1 );
306 if ( code != TCL_OK )
308 fprintf( stderr,
"%s\n", Tcl_GetStringResult(
interp ) );
321 if ( code != TCL_OK )
323 errChannel = Tcl_GetStdChannel( TCL_STDERR );
331 Tcl_AddErrorInfo(
interp,
"" );
332 Tcl_WriteObj( errChannel, Tcl_GetVar2Ex(
interp,
"errorInfo",
333 NULL, TCL_GLOBAL_ONLY ) );
334 Tcl_WriteChars( errChannel,
"\n", 1 );
340 Tcl_DStringFree( &argString );
347 Tcl_SourceRCFile(
interp );
355 commandPtr = Tcl_NewObj();
356 Tcl_IncrRefCount( commandPtr );
358 inChannel = Tcl_GetStdChannel( TCL_STDIN );
359 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
365 Tcl_Obj *promptCmdPtr;
367 promptCmdPtr = Tcl_GetVar2Ex(
interp,
368 ( gotPartial ?
"tcl_prompt2" :
"tcl_prompt1" ),
369 NULL, TCL_GLOBAL_ONLY );
370 if ( promptCmdPtr == NULL )
373 if ( !gotPartial && outChannel )
375 Tcl_WriteChars( outChannel,
"% ", 2 );
380 code = Tcl_EvalObjEx(
interp, promptCmdPtr, 0 );
381 inChannel = Tcl_GetStdChannel( TCL_STDIN );
382 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
383 errChannel = Tcl_GetStdChannel( TCL_STDERR );
384 if ( code != TCL_OK )
388 Tcl_WriteObj( errChannel, Tcl_GetObjResult(
interp ) );
389 Tcl_WriteChars( errChannel,
"\n", 1 );
392 "\n (script that generates prompt)" );
398 Tcl_Flush( outChannel );
405 length = Tcl_GetsObj( inChannel, commandPtr );
410 if ( ( length == 0 ) && Tcl_Eof( inChannel ) && ( !gotPartial ) )
419 Tcl_AppendToObj( commandPtr,
"\n", 1 );
420 if ( !Tcl_CommandComplete( Tcl_GetString( commandPtr ) ) )
427 code = Tcl_RecordAndEvalObj(
interp, commandPtr, 0 );
428 inChannel = Tcl_GetStdChannel( TCL_STDIN );
429 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
430 errChannel = Tcl_GetStdChannel( TCL_STDERR );
431 Tcl_DecrRefCount( commandPtr );
432 commandPtr = Tcl_NewObj();
433 Tcl_IncrRefCount( commandPtr );
438 ( *tclErrorHandler )(
interp, code,
tty );
446 if ( code != TCL_OK )
450 Tcl_WriteObj( errChannel, Tcl_GetObjResult(
interp ) );
451 Tcl_WriteChars( errChannel,
"\n", 1 );
456 resultPtr = Tcl_GetObjResult(
interp );
457 Tcl_GetStringFromObj( resultPtr, &length );
458 if ( ( length > 0 ) && outChannel )
460 Tcl_WriteObj( outChannel, resultPtr );
461 Tcl_WriteChars( outChannel,
"\n", 1 );
474 if ( commandPtr != NULL )
476 Tcl_DecrRefCount( commandPtr );
478 sprintf(
buffer,
"exit %d", exitCode );