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
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064 #include "plplotP.h"
00065 #include "pltkd.h"
00066 #include <stdio.h>
00067 #include <stdlib.h>
00068 #include <tcl.h>
00069 #include <tk.h>
00070 #ifdef HAVE_ITCL
00071 # ifndef HAVE_ITCLDECLS_H
00072 # define RESOURCE_INCLUDED
00073 # endif
00074 # include <itcl.h>
00075 #endif
00076
00077
00078
00079
00080
00081
00082
00083
00084 EXTERN int Itk_Init _ANSI_ARGS_( ( Tcl_Interp * interp ) );
00085
00086
00087
00088 #ifndef Tcl_Import_TCL_DECLARED
00089 EXTERN int Tcl_Import _ANSI_ARGS_( ( Tcl_Interp * interp,
00090 Tcl_Namespace * nsPtr, char * pattern,
00091 int allowOverwrite ) );
00092 #endif
00093
00094 #ifndef Tcl_GetGlobalNamespace_TCL_DECLARE
00095 EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace _ANSI_ARGS_( (
00096 Tcl_Interp * interp ) );
00097 #endif
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110 extern char * strrchr _ANSI_ARGS_( ( CONST char *string, int c ) );
00111
00112
00113
00114
00115
00116 static Tcl_Interp *interp;
00117 static Tcl_DString command;
00118
00119 static int tty;
00120
00121
00122 static char errorExitCmd[] = "exit 1";
00123
00124
00125
00126
00127
00128 static int synchronize = 0;
00129 static const char *script = NULL;
00130 static const char *fileName = NULL;
00131 static const char *name = NULL;
00132 static const char *display = NULL;
00133 static const char *geometry = NULL;
00134
00135 static Tk_ArgvInfo argTable[] = {
00136 { "-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
00137 "File from which to read commands" },
00138 { "-e", TK_ARGV_STRING, (char *) NULL, (char *) &script,
00139 "Script to execute on startup" },
00140 { "-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
00141 "Initial geometry for window" },
00142 { "-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
00143 "Display to use" },
00144 { "-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
00145 "Name to use for application" },
00146 { "-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
00147 "Use synchronous mode for display server" },
00148 { (char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
00149 (char *) NULL }
00150 };
00151
00152
00153
00154
00155
00156 static void Prompt _ANSI_ARGS_( ( Tcl_Interp * interp, int partial ) );
00157 static void StdinProc _ANSI_ARGS_( ( ClientData clientData,
00158 int mask ) );
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179 int
00180 pltkMain( int argc, const char **argv, char *RcFileName,
00181 int ( *AppInit )( Tcl_Interp *interp ) )
00182 {
00183 char *args, *msg;
00184 const char *p;
00185 char buf[20];
00186 int code;
00187
00188 #ifdef PL_HAVE_PTHREAD
00189 XInitThreads();
00190 #endif
00191
00192 Tcl_FindExecutable( argv[0] );
00193 interp = Tcl_CreateInterp();
00194 #ifdef TCL_MEM_DEBUG
00195 Tcl_InitMemory( interp );
00196 #endif
00197
00198
00199
00200
00201
00202 if ( Tk_ParseArgv( interp, (Tk_Window) NULL, &argc, argv, argTable, 0 )
00203 != TCL_OK )
00204 {
00205 fprintf( stderr, "%s\n", interp->result );
00206 exit( 1 );
00207 }
00208 if ( name == NULL )
00209 {
00210 if ( fileName != NULL )
00211 {
00212 p = fileName;
00213 }
00214 else
00215 {
00216 p = argv[0];
00217 }
00218 name = strrchr( p, '/' );
00219 if ( name != NULL )
00220 {
00221 name++;
00222 }
00223 else
00224 {
00225 name = p;
00226 }
00227 }
00228
00229
00230
00231
00232
00233
00234
00235 if ( display != NULL )
00236 {
00237 Tcl_SetVar2( interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY );
00238 }
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249 Tcl_SetVar( interp, "argv0", name, TCL_GLOBAL_ONLY );
00250
00251 if ( Tcl_Init( interp ) == TCL_ERROR )
00252 {
00253 return TCL_ERROR;
00254 }
00255 if ( Tk_Init( interp ) == TCL_ERROR )
00256 {
00257 return TCL_ERROR;
00258 }
00259 #ifdef HAVE_ITCL
00260 if ( Itcl_Init( interp ) == TCL_ERROR )
00261 {
00262 return TCL_ERROR;
00263 }
00264 #endif
00265 #ifdef HAVE_ITK
00266 if ( Itk_Init( interp ) == TCL_ERROR )
00267 {
00268 return TCL_ERROR;
00269 }
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280 if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
00281 "::itk::*", 1 ) != TCL_OK )
00282 {
00283 return TCL_ERROR;
00284 }
00285
00286 if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
00287 "::itcl::*", 1 ) != TCL_OK )
00288 {
00289 return TCL_ERROR;
00290 }
00291
00292 if ( Tcl_Eval( interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }" ) != TCL_OK )
00293 {
00294 return TCL_ERROR;
00295 }
00296 #endif
00297
00298
00299
00300
00301
00302
00303
00304 args = Tcl_Merge( argc - 1, ( CONST char * CONST * )argv + 1 );
00305 Tcl_SetVar( interp, "argv", args, TCL_GLOBAL_ONLY );
00306 ckfree( args );
00307 sprintf( buf, "%d", argc - 1 );
00308 Tcl_SetVar( interp, "argc", buf, TCL_GLOBAL_ONLY );
00309
00310 if ( geometry != NULL )
00311 {
00312 Tcl_SetVar( interp, "geometry", geometry, TCL_GLOBAL_ONLY );
00313 }
00314
00315
00316
00317
00318
00319 tty = isatty( 0 );
00320 Tcl_SetVar( interp, "tcl_interactive",
00321 ( ( fileName == NULL ) && tty ) ? "1" : "0", TCL_GLOBAL_ONLY );
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332 if ( ( *AppInit )( interp ) != TCL_OK )
00333 {
00334 fprintf( stderr, "(*AppInit) failed: %s\n", interp->result );
00335 }
00336
00337
00338
00339
00340
00341 if ( geometry != NULL )
00342 {
00343 code = Tcl_VarEval( interp, "wm geometry . ", geometry, (char *) NULL );
00344 if ( code != TCL_OK )
00345 {
00346 fprintf( stderr, "%s\n", interp->result );
00347 }
00348 }
00349
00350
00351
00352
00353
00354 if ( script != NULL )
00355 {
00356 code = Tcl_VarEval( interp, script, (char *) NULL );
00357 if ( code != TCL_OK )
00358 {
00359 goto error;
00360 }
00361 tty = 0;
00362 }
00363
00364
00365
00366
00367
00368 if ( fileName != NULL )
00369 {
00370 code = Tcl_VarEval( interp, "source ", fileName, (char *) NULL );
00371 if ( code != TCL_OK )
00372 {
00373 goto error;
00374 }
00375 tty = 0;
00376 }
00377 else
00378 {
00379
00380
00381
00382
00383
00384
00385
00386
00387 if ( RcFileName != NULL )
00388 {
00389 Tcl_DString buffer;
00390 char *fullName;
00391 FILE *f;
00392
00393 fullName = Tcl_TildeSubst( interp, RcFileName, &buffer );
00394 if ( fullName == NULL )
00395 {
00396 fprintf( stderr, "%s\n", interp->result );
00397 }
00398 else
00399 {
00400 f = fopen( fullName, "r" );
00401 if ( f != NULL )
00402 {
00403 code = Tcl_EvalFile( interp, fullName );
00404 if ( code != TCL_OK )
00405 {
00406 fprintf( stderr, "%s\n", interp->result );
00407 }
00408 fclose( f );
00409 }
00410 }
00411 Tcl_DStringFree( &buffer );
00412 }
00413
00414 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
00415 Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
00416 #endif
00417 if ( tty )
00418 {
00419 Prompt( interp, 0 );
00420 }
00421 }
00422 fflush( stdout );
00423 Tcl_DStringInit( &command );
00424
00425
00426
00427
00428
00429
00430 Tk_MainLoop();
00431
00432
00433
00434
00435
00436
00437
00438 Tcl_Eval( interp, "exit" );
00439 exit( 1 );
00440
00441 error:
00442 msg = (char *) Tcl_GetVar( interp, "errorInfo", TCL_GLOBAL_ONLY );
00443 if ( msg == NULL )
00444 {
00445 msg = interp->result;
00446 }
00447 fprintf( stderr, "%s\n", msg );
00448 Tcl_Eval( interp, errorExitCmd );
00449 return 1;
00450 }
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463
00464
00465
00466
00467
00468
00469
00470
00471
00472
00473 static void
00474 StdinProc( clientData, mask )
00475 ClientData clientData;
00476 int mask;
00477 {
00478 #define BUFFER_SIZE 4000
00479 char input[BUFFER_SIZE + 1];
00480 static int gotPartial = 0;
00481 char *cmd;
00482 int code, count;
00483
00484 count = read( fileno( stdin ), input, BUFFER_SIZE );
00485 if ( count <= 0 )
00486 {
00487 if ( !gotPartial )
00488 {
00489 if ( tty )
00490 {
00491 Tcl_Eval( interp, "exit" );
00492 exit( 1 );
00493 }
00494 else
00495 {
00496 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
00497 Tk_DeleteFileHandler( 0 );
00498 #endif
00499 }
00500 return;
00501 }
00502 else
00503 {
00504 count = 0;
00505 }
00506 }
00507 cmd = Tcl_DStringAppend( &command, input, count );
00508 if ( count != 0 )
00509 {
00510 if ( ( input[count - 1] != '\n' ) && ( input[count - 1] != ';' ) )
00511 {
00512 gotPartial = 1;
00513 goto prompt;
00514 }
00515 if ( !Tcl_CommandComplete( cmd ) )
00516 {
00517 gotPartial = 1;
00518 goto prompt;
00519 }
00520 }
00521 gotPartial = 0;
00522
00523
00524
00525
00526
00527
00528
00529
00530 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
00531 Tk_CreateFileHandler( 0, 0, StdinProc, (ClientData) 0 );
00532 #endif
00533 code = Tcl_RecordAndEval( interp, cmd, 0 );
00534 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
00535 Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
00536 #endif
00537 Tcl_DStringFree( &command );
00538 if ( *interp->result != 0 )
00539 {
00540 if ( ( code != TCL_OK ) || ( tty ) )
00541 {
00542 printf( "%s\n", interp->result );
00543 }
00544 }
00545
00546
00547
00548
00549
00550 prompt:
00551 if ( tty )
00552 {
00553 Prompt( interp, gotPartial );
00554 }
00555 }
00556
00557
00558
00559
00560
00561
00562
00563
00564
00565
00566
00567
00568
00569
00570
00571
00572
00573
00574
00575 static void
00576 Prompt( interp, partial )
00577 Tcl_Interp * interp;
00578 int partial;
00579
00580
00581 {
00582 char *promptCmd;
00583 int code;
00584
00585 promptCmd = (char *) Tcl_GetVar( interp,
00586 partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY );
00587 if ( promptCmd == NULL )
00588 {
00589 defaultPrompt:
00590 if ( !partial )
00591 {
00592 fputs( "% ", stdout );
00593 }
00594 }
00595 else
00596 {
00597 code = Tcl_Eval( interp, promptCmd );
00598 if ( code != TCL_OK )
00599 {
00600 Tcl_AddErrorInfo( interp,
00601 "\n (script that generates prompt)" );
00602 fprintf( stderr, "%s\n", interp->result );
00603 goto defaultPrompt;
00604 }
00605 }
00606 fflush( stdout );
00607 }