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"
167 tclStartupScriptFileName =
fileName;
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();
230 Tcl_InitMemory( interp );
234 sprintf( usage,
"\nUsage:\n %s [filename] [options]\n", argv[0] );
236 plMergeOpts( options,
"pltcl options", pltcl_notes );
245 if ( tclStartupScriptFileName == NULL )
247 if ( ( argc > 1 ) && ( argv[1][0] !=
'-' ) )
249 tclStartupScriptFileName = argv[1];
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 );
260 if ( tclStartupScriptFileName == NULL )
262 Tcl_ExternalToUtfDString( NULL, argv[0], -1, &argString );
266 tclStartupScriptFileName = Tcl_ExternalToUtfDString( NULL,
267 tclStartupScriptFileName, -1, &argString );
271 Tcl_SetVar( interp,
"argc", buffer, TCL_GLOBAL_ONLY );
272 Tcl_SetVar( interp,
"argv0", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
279 Tcl_SetVar( interp,
"tcl_interactive",
280 ( ( tclStartupScriptFileName == NULL ) && tty ) ?
"1" :
"0",
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 );
303 if ( tclStartupScript != NULL )
305 code = Tcl_VarEval( interp, tclStartupScript, (
char *) NULL );
306 if ( code != TCL_OK )
308 fprintf( stderr,
"%s\n", Tcl_GetStringResult( interp ) );
318 if ( tclStartupScriptFileName != NULL )
320 code = Tcl_EvalFile( interp, tclStartupScriptFileName );
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 );
391 Tcl_AddErrorInfo( interp,
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 );
479 Tcl_Eval( interp, buffer );
PLINT plMergeOpts(PLOptionTable *options, PLCHAR_VECTOR name, PLCHAR_VECTOR *notes)
void TclSetStartupScriptFileName(char *fileName)
static PLCHAR_VECTOR usage
int PLDLLEXPORT pltclMain(int argc, char **argv, char *PL_UNUSED(RcFileName), int(*appInitProc)(Tcl_Interp *interp))
static char * tclStartupScript
const char * TclGetStartupScriptFileName(void)
static const char * fileName
#define TclFormatInt(buf, n)
static const char * pltcl_notes[]
static PLOptionTable options[]
static const char * tclStartupScriptFileName
void(* tclPrepOutputHandler)(Tcl_Interp *interp, int code, int tty)
static Tcl_Interp * interp
void(* tclErrorHandler)(Tcl_Interp *interp, int code, int tty)
static void plPrepOutputHandler(Tcl_Interp *interp, int code, int tty)
int isatty _ANSI_ARGS_((int fd))