55 #if TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 5
57 #define TclFormatInt( buf, n ) sprintf( ( buf ), "%ld", (long) ( n ) )
63 #ifndef TclObjCommandComplete_TCL_DECLARED
64 EXTERN
int TclObjCommandComplete
_ANSI_ARGS_( ( Tcl_Obj * cmdPtr ) );
67 # undef TCL_STORAGE_CLASS
68 # define TCL_STORAGE_CLASS DLLEXPORT
90 extern char * strcpy
_ANSI_ARGS_( (
char *dst, CONST
char *src ) );
114 "Specifying the filename on the command line is compatible with modern",
115 "tclsh syntax. Old tclsh's used the -f syntax, which is still supported.",
116 "You may use either syntax but not both.",
128 "File from which to read commands"
137 "File from which to read commands"
146 "Script to execute on startup"
179 tclStartupScriptFileName =
fileName;
227 int ( *appInitProc )( Tcl_Interp *interp ) )
230 Tcl_Obj *commandPtr = NULL;
232 int code, gotPartial,
tty, length;
234 Tcl_Channel inChannel, outChannel, errChannel;
236 Tcl_DString argString;
240 Tcl_FindExecutable( argv[0] );
241 interp = Tcl_CreateInterp();
242 Tcl_InitMemory( interp );
246 sprintf( usage,
"\nUsage:\n %s [filename] [options]\n", argv[0] );
248 plMergeOpts( options,
"pltcl options", pltcl_notes );
257 if ( tclStartupScriptFileName == NULL )
259 if ( ( argc > 1 ) && ( argv[1][0] !=
'-' ) )
261 tclStartupScriptFileName = argv[1];
266 args = Tcl_Merge( argc - 1, ( CONST
char * CONST * )argv + 1 );
267 Tcl_ExternalToUtfDString( NULL, args, -1, &argString );
268 Tcl_SetVar( interp,
"argv", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
269 Tcl_DStringFree( &argString );
272 if ( tclStartupScriptFileName == NULL )
274 Tcl_ExternalToUtfDString( NULL, argv[0], -1, &argString );
278 tclStartupScriptFileName = Tcl_ExternalToUtfDString( NULL,
279 tclStartupScriptFileName, -1, &argString );
282 TclFormatInt( buffer, argc - 1 );
283 Tcl_SetVar( interp,
"argc", buffer, TCL_GLOBAL_ONLY );
284 Tcl_SetVar( interp,
"argv0", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
291 Tcl_SetVar( interp,
"tcl_interactive",
292 ( ( tclStartupScriptFileName == NULL ) && tty ) ?
"1" :
"0",
299 if ( ( *appInitProc )( interp ) != TCL_OK )
301 errChannel = Tcl_GetStdChannel( TCL_STDERR );
304 Tcl_WriteChars( errChannel,
305 "application-specific initialization failed: ", -1 );
306 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
307 Tcl_WriteChars( errChannel,
"\n", 1 );
315 if ( tclStartupScript != NULL )
317 code = Tcl_VarEval( interp, tclStartupScript, (
char *) NULL );
318 if ( code != TCL_OK )
320 fprintf( stderr,
"%s\n", Tcl_GetStringResult( interp ) );
330 if ( tclStartupScriptFileName != NULL )
332 code = Tcl_EvalFile( interp, tclStartupScriptFileName );
333 if ( code != TCL_OK )
335 errChannel = Tcl_GetStdChannel( TCL_STDERR );
343 Tcl_AddErrorInfo( interp,
"" );
344 Tcl_WriteObj( errChannel, Tcl_GetVar2Ex( interp,
"errorInfo",
345 NULL, TCL_GLOBAL_ONLY ) );
346 Tcl_WriteChars( errChannel,
"\n", 1 );
352 Tcl_DStringFree( &argString );
359 Tcl_SourceRCFile( interp );
367 commandPtr = Tcl_NewObj();
368 Tcl_IncrRefCount( commandPtr );
370 inChannel = Tcl_GetStdChannel( TCL_STDIN );
371 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
377 Tcl_Obj *promptCmdPtr;
379 promptCmdPtr = Tcl_GetVar2Ex( interp,
380 ( gotPartial ?
"tcl_prompt2" :
"tcl_prompt1" ),
381 NULL, TCL_GLOBAL_ONLY );
382 if ( promptCmdPtr == NULL )
385 if ( !gotPartial && outChannel )
387 Tcl_WriteChars( outChannel,
"% ", 2 );
392 code = Tcl_EvalObjEx( interp, promptCmdPtr, 0 );
393 inChannel = Tcl_GetStdChannel( TCL_STDIN );
394 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
395 errChannel = Tcl_GetStdChannel( TCL_STDERR );
396 if ( code != TCL_OK )
400 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
401 Tcl_WriteChars( errChannel,
"\n", 1 );
403 Tcl_AddErrorInfo( interp,
404 "\n (script that generates prompt)" );
410 Tcl_Flush( outChannel );
417 length = Tcl_GetsObj( inChannel, commandPtr );
422 if ( ( length == 0 ) && Tcl_Eof( inChannel ) && ( !gotPartial ) )
431 Tcl_AppendToObj( commandPtr,
"\n", 1 );
432 if ( !TclObjCommandComplete( commandPtr ) )
439 code = Tcl_RecordAndEvalObj( interp, commandPtr, 0 );
440 inChannel = Tcl_GetStdChannel( TCL_STDIN );
441 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
442 errChannel = Tcl_GetStdChannel( TCL_STDERR );
443 Tcl_DecrRefCount( commandPtr );
444 commandPtr = Tcl_NewObj();
445 Tcl_IncrRefCount( commandPtr );
450 ( *tclErrorHandler )(
interp, code,
tty );
458 if ( code != TCL_OK )
462 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
463 Tcl_WriteChars( errChannel,
"\n", 1 );
468 resultPtr = Tcl_GetObjResult( interp );
469 Tcl_GetStringFromObj( resultPtr, &length );
470 if ( ( length > 0 ) && outChannel )
472 Tcl_WriteObj( outChannel, resultPtr );
473 Tcl_WriteChars( outChannel,
"\n", 1 );
486 if ( commandPtr != NULL )
488 Tcl_DecrRefCount( commandPtr );
490 sprintf( buffer,
"exit %d", exitCode );
491 Tcl_Eval( interp, buffer );
void TclSetStartupScriptFileName(char *fileName)
static char * tclStartupScript
const char * TclGetStartupScriptFileName(void)
static const char * fileName
static const char * pltcl_notes[]
int(* tclDummyLinkVarPtr)()
static const char * usage
int plMergeOpts(PLOptionTable *options, const char *name, const char **notes)
static PLOptionTable options[]
static const char * tclStartupScriptFileName
void(* tclPrepOutputHandler)(Tcl_Interp *interp, int code, int tty)
int PLDLLEXPORT pltclMain(int argc, const char **argv, char *PL_UNUSED(RcFileName), int(*appInitProc)(Tcl_Interp *interp))
static Tcl_Interp * interp
void(* tclErrorHandler)(Tcl_Interp *interp, int code, int tty)
EXTERN int TclFormatInt _ANSI_ARGS_((char *buffer, long n))
static void plPrepOutputHandler(Tcl_Interp *interp, int code, int tty)