00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051 #include <tcl.h>
00052 #include "plplot.h"
00053
00054 #if TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 5
00055
00056 #define TclFormatInt( buf, n ) sprintf( ( buf ), "%ld", (long) ( n ) )
00057 #else
00058
00059 EXTERN int TclFormatInt _ANSI_ARGS_( ( char * buffer, long n ) );
00060 #endif
00061
00062 #ifndef TclObjCommandComplete_TCL_DECLARED
00063 EXTERN int TclObjCommandComplete _ANSI_ARGS_( ( Tcl_Obj * cmdPtr ) );
00064 #endif
00065
00066 # undef TCL_STORAGE_CLASS
00067 # define TCL_STORAGE_CLASS DLLEXPORT
00068
00069
00070
00071
00072
00073
00074
00075
00076 EXTERN int Tcl_LinkVar();
00077 int ( *tclDummyLinkVarPtr )() = Tcl_LinkVar;
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088 extern int isatty _ANSI_ARGS_( (int fd) );
00089 extern char * strcpy _ANSI_ARGS_( ( char *dst, CONST char *src ) );
00090
00091 static const char *tclStartupScriptFileName = NULL;
00092
00093
00094
00095 static void
00096 plPrepOutputHandler( Tcl_Interp *interp, int code, int tty );
00097
00098
00099
00100 void ( *tclErrorHandler )( Tcl_Interp *interp, int code, int tty ) = NULL;
00101
00102 void ( *tclPrepOutputHandler )( Tcl_Interp *interp, int code, int tty )
00103 = plPrepOutputHandler;
00104
00105
00106
00107 static char *tclStartupScript = NULL;
00108 static const char *pltcl_notes[] = {
00109 "Specifying the filename on the command line is compatible with modern",
00110 "tclsh syntax. Old tclsh's used the -f syntax, which is still supported.",
00111 "You may use either syntax but not both.",
00112 NULL
00113 };
00114
00115 static PLOptionTable options[] = {
00116 {
00117 "f",
00118 NULL,
00119 NULL,
00120 &tclStartupScriptFileName,
00121 PL_OPT_STRING,
00122 "-f",
00123 "File from which to read commands"
00124 },
00125 {
00126 "file",
00127 NULL,
00128 NULL,
00129 &tclStartupScriptFileName,
00130 PL_OPT_STRING | PL_OPT_INVISIBLE,
00131 "-file",
00132 "File from which to read commands"
00133 },
00134 {
00135 "e",
00136 NULL,
00137 NULL,
00138 &tclStartupScript,
00139 PL_OPT_STRING,
00140 "-e",
00141 "Script to execute on startup"
00142 },
00143 {
00144 NULL,
00145 NULL,
00146 NULL,
00147 NULL,
00148 0,
00149 NULL,
00150 NULL
00151 }
00152 };
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172 void TclSetStartupScriptFileName( char *fileName )
00173 {
00174 tclStartupScriptFileName = fileName;
00175 }
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194 const char *TclGetStartupScriptFileName( void )
00195 {
00196 return tclStartupScriptFileName;
00197 }
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220 int PLDLLEXPORT
00221 pltclMain( int argc, const char **argv, char *RcFileName ,
00222 int ( *appInitProc )( Tcl_Interp *interp ) )
00223 {
00224 Tcl_Obj *resultPtr;
00225 Tcl_Obj *commandPtr = NULL;
00226 char buffer[1000], *args;
00227 int code, gotPartial, tty, length;
00228 int exitCode = 0;
00229 Tcl_Channel inChannel, outChannel, errChannel;
00230 Tcl_Interp *interp;
00231 Tcl_DString argString;
00232
00233 char usage[500];
00234
00235 Tcl_FindExecutable( argv[0] );
00236 interp = Tcl_CreateInterp();
00237 Tcl_InitMemory( interp );
00238
00239
00240
00241 sprintf( usage, "\nUsage:\n %s [filename] [options]\n", argv[0] );
00242 plSetUsage( NULL, usage );
00243 plMergeOpts( options, "pltcl options", pltcl_notes );
00244 (void) plparseopts( &argc, argv, PL_PARSE_FULL | PL_PARSE_SKIP );
00245
00246
00247
00248
00249
00250
00251
00252 if ( tclStartupScriptFileName == NULL )
00253 {
00254 if ( ( argc > 1 ) && ( argv[1][0] != '-' ) )
00255 {
00256 tclStartupScriptFileName = argv[1];
00257 argc--;
00258 argv++;
00259 }
00260 }
00261 args = Tcl_Merge( argc - 1, ( CONST char * CONST * )argv + 1 );
00262 Tcl_ExternalToUtfDString( NULL, args, -1, &argString );
00263 Tcl_SetVar( interp, "argv", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
00264 Tcl_DStringFree( &argString );
00265 ckfree( args );
00266
00267 if ( tclStartupScriptFileName == NULL )
00268 {
00269 Tcl_ExternalToUtfDString( NULL, argv[0], -1, &argString );
00270 }
00271 else
00272 {
00273 tclStartupScriptFileName = Tcl_ExternalToUtfDString( NULL,
00274 tclStartupScriptFileName, -1, &argString );
00275 }
00276
00277 TclFormatInt( buffer, argc - 1 );
00278 Tcl_SetVar( interp, "argc", buffer, TCL_GLOBAL_ONLY );
00279 Tcl_SetVar( interp, "argv0", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
00280
00281
00282
00283
00284
00285 tty = isatty( 0 );
00286 Tcl_SetVar( interp, "tcl_interactive",
00287 ( ( tclStartupScriptFileName == NULL ) && tty ) ? "1" : "0",
00288 TCL_GLOBAL_ONLY );
00289
00290
00291
00292
00293
00294 if ( ( *appInitProc )( interp ) != TCL_OK )
00295 {
00296 errChannel = Tcl_GetStdChannel( TCL_STDERR );
00297 if ( errChannel )
00298 {
00299 Tcl_WriteChars( errChannel,
00300 "application-specific initialization failed: ", -1 );
00301 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
00302 Tcl_WriteChars( errChannel, "\n", 1 );
00303 }
00304 }
00305
00306
00307
00308
00309
00310 if ( tclStartupScript != NULL )
00311 {
00312 code = Tcl_VarEval( interp, tclStartupScript, (char *) NULL );
00313 if ( code != TCL_OK )
00314 {
00315 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
00316 exitCode = 1;
00317 }
00318 }
00319
00320
00321
00322
00323
00324
00325 if ( tclStartupScriptFileName != NULL )
00326 {
00327 code = Tcl_EvalFile( interp, tclStartupScriptFileName );
00328 if ( code != TCL_OK )
00329 {
00330 errChannel = Tcl_GetStdChannel( TCL_STDERR );
00331 if ( errChannel )
00332 {
00333
00334
00335
00336
00337
00338 Tcl_AddErrorInfo( interp, "" );
00339 Tcl_WriteObj( errChannel, Tcl_GetVar2Ex( interp, "errorInfo",
00340 NULL, TCL_GLOBAL_ONLY ) );
00341 Tcl_WriteChars( errChannel, "\n", 1 );
00342 }
00343 exitCode = 1;
00344 }
00345 goto done;
00346 }
00347 Tcl_DStringFree( &argString );
00348
00349
00350
00351
00352
00353
00354 Tcl_SourceRCFile( interp );
00355
00356
00357
00358
00359
00360
00361
00362 commandPtr = Tcl_NewObj();
00363 Tcl_IncrRefCount( commandPtr );
00364
00365 inChannel = Tcl_GetStdChannel( TCL_STDIN );
00366 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
00367 gotPartial = 0;
00368 while ( 1 )
00369 {
00370 if ( tty )
00371 {
00372 Tcl_Obj *promptCmdPtr;
00373
00374 promptCmdPtr = Tcl_GetVar2Ex( interp,
00375 ( gotPartial ? "tcl_prompt2" : "tcl_prompt1" ),
00376 NULL, TCL_GLOBAL_ONLY );
00377 if ( promptCmdPtr == NULL )
00378 {
00379 defaultPrompt:
00380 if ( !gotPartial && outChannel )
00381 {
00382 Tcl_WriteChars( outChannel, "% ", 2 );
00383 }
00384 }
00385 else
00386 {
00387 code = Tcl_EvalObjEx( interp, promptCmdPtr, 0 );
00388 inChannel = Tcl_GetStdChannel( TCL_STDIN );
00389 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
00390 errChannel = Tcl_GetStdChannel( TCL_STDERR );
00391 if ( code != TCL_OK )
00392 {
00393 if ( errChannel )
00394 {
00395 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
00396 Tcl_WriteChars( errChannel, "\n", 1 );
00397 }
00398 Tcl_AddErrorInfo( interp,
00399 "\n (script that generates prompt)" );
00400 goto defaultPrompt;
00401 }
00402 }
00403 if ( outChannel )
00404 {
00405 Tcl_Flush( outChannel );
00406 }
00407 }
00408 if ( !inChannel )
00409 {
00410 goto done;
00411 }
00412 length = Tcl_GetsObj( inChannel, commandPtr );
00413 if ( length < 0 )
00414 {
00415 goto done;
00416 }
00417 if ( ( length == 0 ) && Tcl_Eof( inChannel ) && ( !gotPartial ) )
00418 {
00419 goto done;
00420 }
00421
00422
00423
00424
00425
00426 Tcl_AppendToObj( commandPtr, "\n", 1 );
00427 if ( !TclObjCommandComplete( commandPtr ) )
00428 {
00429 gotPartial = 1;
00430 continue;
00431 }
00432
00433 gotPartial = 0;
00434 code = Tcl_RecordAndEvalObj( interp, commandPtr, 0 );
00435 inChannel = Tcl_GetStdChannel( TCL_STDIN );
00436 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
00437 errChannel = Tcl_GetStdChannel( TCL_STDERR );
00438 Tcl_DecrRefCount( commandPtr );
00439 commandPtr = Tcl_NewObj();
00440 Tcl_IncrRefCount( commandPtr );
00441
00442
00443
00444 if ( ( ( code != TCL_OK ) || tty ) && tclErrorHandler )
00445 ( *tclErrorHandler )( interp, code, tty );
00446 else
00447 {
00448
00449
00450 if ( ( ( code != TCL_OK ) || tty ) && tclPrepOutputHandler )
00451 ( *tclPrepOutputHandler )( interp, code, tty );
00452
00453 if ( code != TCL_OK )
00454 {
00455 if ( errChannel )
00456 {
00457 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
00458 Tcl_WriteChars( errChannel, "\n", 1 );
00459 }
00460 }
00461 else if ( tty )
00462 {
00463 resultPtr = Tcl_GetObjResult( interp );
00464 Tcl_GetStringFromObj( resultPtr, &length );
00465 if ( ( length > 0 ) && outChannel )
00466 {
00467 Tcl_WriteObj( outChannel, resultPtr );
00468 Tcl_WriteChars( outChannel, "\n", 1 );
00469 }
00470 }
00471 }
00472 }
00473
00474
00475
00476
00477
00478
00479
00480 done:
00481 if ( commandPtr != NULL )
00482 {
00483 Tcl_DecrRefCount( commandPtr );
00484 }
00485 sprintf( buffer, "exit %d", exitCode );
00486 Tcl_Eval( interp, buffer );
00487 return 0;
00488 }
00489
00490
00491
00492
00493
00494
00495
00496
00497
00498
00499
00500
00501
00502
00503
00504
00505
00506
00507
00508
00509 static void
00510 plPrepOutputHandler( Tcl_Interp *interp, int code, int tty )
00511 {
00512 pltext();
00513 }