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 );
static const char * pltcl_notes[]
const char * TclGetStartupScriptFileName(void)
void(* tclPrepOutputHandler)(Tcl_Interp *interp, int code, int tty)
void(* tclErrorHandler)(Tcl_Interp *interp, int code, int tty)
static char * tclStartupScript
static void plPrepOutputHandler(Tcl_Interp *interp, int code, int tty)
int PLDLLEXPORT pltclMain(int argc, char **argv, char *PL_UNUSED(RcFileName), int(*appInitProc)(Tcl_Interp *interp))
static PLOptionTable options[]
static const char * tclStartupScriptFileName
#define TclFormatInt(buf, n)
void TclSetStartupScriptFileName(char *fileName)
int isatty _ANSI_ARGS_((int fd))
static Tcl_Interp * interp
static const char * fileName