PLplot
5.10.0
|
00001 // Modified version of tclMain.c, from Tcl 8.3.2. 00002 // Maurice LeBrun 00003 // Jan 2 2001 00004 // 00005 // Copyright (C) 2004 Joao Cardoso 00006 // 00007 // This file is part of PLplot. 00008 // 00009 // PLplot is free software; you can redistribute it and/or modify 00010 // it under the terms of the GNU Library General Public License as published 00011 // by the Free Software Foundation; either version 2 of the License, or 00012 // (at your option) any later version. 00013 // 00014 // PLplot is distributed in the hope that it will be useful, 00015 // but WITHOUT ANY WARRANTY; without even the implied warranty of 00016 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00017 // GNU Library General Public License for more details. 00018 // 00019 // You should have received a copy of the GNU Library General Public License 00020 // along with PLplot; if not, write to the Free Software 00021 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 00022 // 00023 // 00024 // Based on previous version of tclMain.c, from Tcl 7.3. 00025 // Modifications include: 00026 // 1. Tcl_Main() changed to pltclMain(). 00027 // 2. Changes to work with ANSI C 00028 // 3. Changes to support user-installable error or output handlers. 00029 // 4. PLplot argument parsing routine called to handle arguments. 00030 // 5. Added define of _POSIX_SOURCE and eliminated include of tclInt.h. 00031 // 00032 // Original comments follow. 00033 // 00034 00035 // 00036 // tclMain.c -- 00037 // 00038 // Main program for Tcl shells and other Tcl-based applications. 00039 // 00040 // Copyright (c) 1988-1994 The Regents of the University of California. 00041 // Copyright (c) 1994-1997 Sun Microsystems, Inc. 00042 // 00043 // See the file "license.terms" for information on usage and redistribution 00044 // of this file, and for a DISCLAIMER OF ALL WARRANTIES. 00045 // 00046 00047 #include "pltcl.h" 00048 // Required for definition of PL_UNUSED macro 00049 #include "plplotP.h" 00050 00051 #define TclFormatInt( buf, n ) sprintf( ( buf ), "%ld", (long) ( n ) ) 00052 00053 # undef TCL_STORAGE_CLASS 00054 # define TCL_STORAGE_CLASS DLLEXPORT 00055 00056 // 00057 // The following code ensures that tclLink.c is linked whenever 00058 // Tcl is linked. Without this code there's no reference to the 00059 // code in that file from anywhere in Tcl, so it may not be 00060 // linked into the application. 00061 // 00062 00063 // Experiments show this is no longer required, and in any case 00064 // it screws up using the Tcl stub library. So comment out (AWI). 00065 //EXTERN int Tcl_LinkVar( ); 00066 //int ( *tclDummyLinkVarPtr )() = Tcl_LinkVar; 00067 00068 // 00069 // Declarations for various library procedures and variables (don't want 00070 // to include tclPort.h here, because people might copy this file out of 00071 // the Tcl source directory to make their own modified versions). 00072 // Note: "exit" should really be declared here, but there's no way to 00073 // declare it without causing conflicts with other definitions elsewher 00074 // on some systems, so it's better just to leave it out. 00075 // 00076 00077 extern int isatty _ANSI_ARGS_( (int fd) ); 00078 extern char * strcpy _ANSI_ARGS_( ( char *dst, CONST char *src ) ); 00079 00080 static const char *tclStartupScriptFileName = NULL; 00081 00082 // pltcl enhancements 00083 00084 static void 00085 plPrepOutputHandler( Tcl_Interp *interp, int code, int tty ); 00086 00087 // Other function prototypes 00088 void TclSetStartupScriptFileName( char *fileName ); 00089 const char *TclGetStartupScriptFileName( void ); 00090 00091 // These are globally visible and can be replaced 00092 00093 void ( *tclErrorHandler )( Tcl_Interp *interp, int code, int tty ) = NULL; 00094 00095 void ( *tclPrepOutputHandler )( Tcl_Interp *interp, int code, int tty ) 00096 = plPrepOutputHandler; 00097 00098 // Options data structure definition. 00099 00100 static char *tclStartupScript = NULL; 00101 static const char *pltcl_notes[] = { 00102 "Specifying the filename on the command line is compatible with modern", 00103 "tclsh syntax. Old tclsh's used the -f syntax, which is still supported.", 00104 "You may use either syntax but not both.", 00105 NULL 00106 }; 00107 00108 static PLOptionTable options[] = { 00109 { 00110 "f", // File to read & process 00111 NULL, 00112 NULL, 00113 &tclStartupScriptFileName, 00114 PL_OPT_STRING, 00115 "-f", 00116 "File from which to read commands" 00117 }, 00118 { 00119 "file", // File to read & process (alias) 00120 NULL, 00121 NULL, 00122 &tclStartupScriptFileName, 00123 PL_OPT_STRING | PL_OPT_INVISIBLE, 00124 "-file", 00125 "File from which to read commands" 00126 }, 00127 { 00128 "e", // Script to run on startup 00129 NULL, 00130 NULL, 00131 &tclStartupScript, 00132 PL_OPT_STRING, 00133 "-e", 00134 "Script to execute on startup" 00135 }, 00136 { 00137 NULL, // option 00138 NULL, // handler 00139 NULL, // client data 00140 NULL, // address of variable to set 00141 0, // mode flag 00142 NULL, // short syntax 00143 NULL 00144 } // long syntax 00145 }; 00146 00147 00148 // 00149 //-------------------------------------------------------------------------- 00150 // 00151 // TclSetStartupScriptFileName -- 00152 // 00153 // Primes the startup script file name, used to override the 00154 // command line processing. 00155 // 00156 // Results: 00157 // None. 00158 // 00159 // Side effects: 00160 // This procedure initializes the file name of the Tcl script to 00161 // run at startup. 00162 // 00163 //-------------------------------------------------------------------------- 00164 // 00165 void TclSetStartupScriptFileName( char *fileName ) 00166 { 00167 tclStartupScriptFileName = fileName; 00168 } 00169 00170 00171 // 00172 //-------------------------------------------------------------------------- 00173 // 00174 // TclGetStartupScriptFileName -- 00175 // 00176 // Gets the startup script file name, used to override the 00177 // command line processing. 00178 // 00179 // Results: 00180 // The startup script file name, NULL if none has been set. 00181 // 00182 // Side effects: 00183 // None. 00184 // 00185 //-------------------------------------------------------------------------- 00186 // 00187 const char *TclGetStartupScriptFileName( void ) 00188 { 00189 return tclStartupScriptFileName; 00190 } 00191 00192 00193 00194 // 00195 //-------------------------------------------------------------------------- 00196 // 00197 // Tcl_Main -- 00198 // 00199 // Main program for tclsh and most other Tcl-based applications. 00200 // 00201 // Results: 00202 // None. This procedure never returns (it exits the process when 00203 // it's done. 00204 // 00205 // Side effects: 00206 // This procedure initializes the Tcl world and then starts 00207 // interpreting commands; almost anything could happen, depending 00208 // on the script being interpreted. 00209 // 00210 //-------------------------------------------------------------------------- 00211 // 00212 00213 int PLDLLEXPORT 00214 pltclMain( int argc, const char **argv, char * PL_UNUSED( RcFileName ) /* OBSOLETE */, 00215 int ( *appInitProc )( Tcl_Interp *interp ) ) 00216 { 00217 Tcl_Obj *resultPtr; 00218 Tcl_Obj *commandPtr = NULL; 00219 char buffer[1000], *args; 00220 int code, gotPartial, tty, length; 00221 int exitCode = 0; 00222 Tcl_Channel inChannel, outChannel, errChannel; 00223 Tcl_Interp *interp; 00224 Tcl_DString argString; 00225 00226 char usage[500]; 00227 00228 Tcl_FindExecutable( argv[0] ); 00229 interp = Tcl_CreateInterp(); 00230 Tcl_InitMemory( interp ); //no-op if TCL_MEM_DEBUG undefined 00231 00232 // First process plplot-specific args using the PLplot parser. 00233 00234 sprintf( usage, "\nUsage:\n %s [filename] [options]\n", argv[0] ); 00235 plSetUsage( NULL, usage ); 00236 plMergeOpts( options, "pltcl options", pltcl_notes ); 00237 (void) plparseopts( &argc, argv, PL_PARSE_FULL | PL_PARSE_SKIP ); 00238 00239 // 00240 // Make (remaining) command-line arguments available in the Tcl variables 00241 // "argc" and "argv". If the first argument doesn't start with a "-" then 00242 // strip it off and use it as the name of a script file to process. 00243 // 00244 00245 if ( tclStartupScriptFileName == NULL ) 00246 { 00247 if ( ( argc > 1 ) && ( argv[1][0] != '-' ) ) 00248 { 00249 tclStartupScriptFileName = argv[1]; 00250 argc--; 00251 argv++; 00252 } 00253 } 00254 args = Tcl_Merge( argc - 1, ( CONST char * CONST * )argv + 1 ); 00255 Tcl_ExternalToUtfDString( NULL, args, -1, &argString ); 00256 Tcl_SetVar( interp, "argv", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY ); 00257 Tcl_DStringFree( &argString ); 00258 ckfree( args ); 00259 00260 if ( tclStartupScriptFileName == NULL ) 00261 { 00262 Tcl_ExternalToUtfDString( NULL, argv[0], -1, &argString ); 00263 } 00264 else 00265 { 00266 tclStartupScriptFileName = Tcl_ExternalToUtfDString( NULL, 00267 tclStartupScriptFileName, -1, &argString ); 00268 } 00269 00270 TclFormatInt( buffer, argc - 1 ); 00271 Tcl_SetVar( interp, "argc", buffer, TCL_GLOBAL_ONLY ); 00272 Tcl_SetVar( interp, "argv0", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY ); 00273 00274 // 00275 // Set the "tcl_interactive" variable. 00276 // 00277 00278 tty = isatty( 0 ); 00279 Tcl_SetVar( interp, "tcl_interactive", 00280 ( ( tclStartupScriptFileName == NULL ) && tty ) ? "1" : "0", 00281 TCL_GLOBAL_ONLY ); 00282 00283 // 00284 // Invoke application-specific initialization. 00285 // 00286 00287 if ( ( *appInitProc )( interp ) != TCL_OK ) 00288 { 00289 errChannel = Tcl_GetStdChannel( TCL_STDERR ); 00290 if ( errChannel ) 00291 { 00292 Tcl_WriteChars( errChannel, 00293 "application-specific initialization failed: ", -1 ); 00294 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) ); 00295 Tcl_WriteChars( errChannel, "\n", 1 ); 00296 } 00297 } 00298 00299 // 00300 // Process the startup script, if any. 00301 // 00302 00303 if ( tclStartupScript != NULL ) 00304 { 00305 code = Tcl_VarEval( interp, tclStartupScript, (char *) NULL ); 00306 if ( code != TCL_OK ) 00307 { 00308 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) ); 00309 exitCode = 1; 00310 } 00311 } 00312 00313 // 00314 // If a script file was specified then just source that file 00315 // and quit. 00316 // 00317 00318 if ( tclStartupScriptFileName != NULL ) 00319 { 00320 code = Tcl_EvalFile( interp, tclStartupScriptFileName ); 00321 if ( code != TCL_OK ) 00322 { 00323 errChannel = Tcl_GetStdChannel( TCL_STDERR ); 00324 if ( errChannel ) 00325 { 00326 // 00327 // The following statement guarantees that the errorInfo 00328 // variable is set properly. 00329 // 00330 00331 Tcl_AddErrorInfo( interp, "" ); 00332 Tcl_WriteObj( errChannel, Tcl_GetVar2Ex( interp, "errorInfo", 00333 NULL, TCL_GLOBAL_ONLY ) ); 00334 Tcl_WriteChars( errChannel, "\n", 1 ); 00335 } 00336 exitCode = 1; 00337 } 00338 goto done; 00339 } 00340 Tcl_DStringFree( &argString ); 00341 00342 // 00343 // We're running interactively. Source a user-specific startup 00344 // file if the application specified one and if the file exists. 00345 // 00346 00347 Tcl_SourceRCFile( interp ); 00348 00349 // 00350 // Process commands from stdin until there's an end-of-file. Note 00351 // that we need to fetch the standard channels again after every 00352 // eval, since they may have been changed. 00353 // 00354 00355 commandPtr = Tcl_NewObj(); 00356 Tcl_IncrRefCount( commandPtr ); 00357 00358 inChannel = Tcl_GetStdChannel( TCL_STDIN ); 00359 outChannel = Tcl_GetStdChannel( TCL_STDOUT ); 00360 gotPartial = 0; 00361 while ( 1 ) 00362 { 00363 if ( tty ) 00364 { 00365 Tcl_Obj *promptCmdPtr; 00366 00367 promptCmdPtr = Tcl_GetVar2Ex( interp, 00368 ( gotPartial ? "tcl_prompt2" : "tcl_prompt1" ), 00369 NULL, TCL_GLOBAL_ONLY ); 00370 if ( promptCmdPtr == NULL ) 00371 { 00372 defaultPrompt: 00373 if ( !gotPartial && outChannel ) 00374 { 00375 Tcl_WriteChars( outChannel, "% ", 2 ); 00376 } 00377 } 00378 else 00379 { 00380 code = Tcl_EvalObjEx( interp, promptCmdPtr, 0 ); 00381 inChannel = Tcl_GetStdChannel( TCL_STDIN ); 00382 outChannel = Tcl_GetStdChannel( TCL_STDOUT ); 00383 errChannel = Tcl_GetStdChannel( TCL_STDERR ); 00384 if ( code != TCL_OK ) 00385 { 00386 if ( errChannel ) 00387 { 00388 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) ); 00389 Tcl_WriteChars( errChannel, "\n", 1 ); 00390 } 00391 Tcl_AddErrorInfo( interp, 00392 "\n (script that generates prompt)" ); 00393 goto defaultPrompt; 00394 } 00395 } 00396 if ( outChannel ) 00397 { 00398 Tcl_Flush( outChannel ); 00399 } 00400 } 00401 if ( !inChannel ) 00402 { 00403 goto done; 00404 } 00405 length = Tcl_GetsObj( inChannel, commandPtr ); 00406 if ( length < 0 ) 00407 { 00408 goto done; 00409 } 00410 if ( ( length == 0 ) && Tcl_Eof( inChannel ) && ( !gotPartial ) ) 00411 { 00412 goto done; 00413 } 00414 00415 // 00416 // Add the newline removed by Tcl_GetsObj back to the string. 00417 // 00418 00419 Tcl_AppendToObj( commandPtr, "\n", 1 ); 00420 if ( !Tcl_CommandComplete( Tcl_GetString( commandPtr ) ) ) 00421 { 00422 gotPartial = 1; 00423 continue; 00424 } 00425 00426 gotPartial = 0; 00427 code = Tcl_RecordAndEvalObj( interp, commandPtr, 0 ); 00428 inChannel = Tcl_GetStdChannel( TCL_STDIN ); 00429 outChannel = Tcl_GetStdChannel( TCL_STDOUT ); 00430 errChannel = Tcl_GetStdChannel( TCL_STDERR ); 00431 Tcl_DecrRefCount( commandPtr ); 00432 commandPtr = Tcl_NewObj(); 00433 Tcl_IncrRefCount( commandPtr ); 00434 00435 // User defined function to deal with tcl command output 00436 // Deprecated; for backward compatibility only 00437 if ( ( ( code != TCL_OK ) || tty ) && tclErrorHandler ) 00438 ( *tclErrorHandler )( interp, code, tty ); 00439 else 00440 { 00441 // User defined function to prepare for tcl output 00442 // This is the new way 00443 if ( ( ( code != TCL_OK ) || tty ) && tclPrepOutputHandler ) 00444 ( *tclPrepOutputHandler )( interp, code, tty ); 00445 // Back to the stock tcl code 00446 if ( code != TCL_OK ) 00447 { 00448 if ( errChannel ) 00449 { 00450 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) ); 00451 Tcl_WriteChars( errChannel, "\n", 1 ); 00452 } 00453 } 00454 else if ( tty ) 00455 { 00456 resultPtr = Tcl_GetObjResult( interp ); 00457 Tcl_GetStringFromObj( resultPtr, &length ); 00458 if ( ( length > 0 ) && outChannel ) 00459 { 00460 Tcl_WriteObj( outChannel, resultPtr ); 00461 Tcl_WriteChars( outChannel, "\n", 1 ); 00462 } 00463 } 00464 } 00465 } 00466 00467 // 00468 // Rather than calling exit, invoke the "exit" command so that 00469 // users can replace "exit" with some other command to do additional 00470 // cleanup on exit. The Tcl_Eval call should never return. 00471 // 00472 00473 done: 00474 if ( commandPtr != NULL ) 00475 { 00476 Tcl_DecrRefCount( commandPtr ); 00477 } 00478 sprintf( buffer, "exit %d", exitCode ); 00479 Tcl_Eval( interp, buffer ); 00480 return 0; // to silence warnings 00481 } 00482 00483 // 00484 //-------------------------------------------------------------------------- 00485 // 00486 // plPrepOutputHandler -- 00487 // 00488 // Prepares for output during command parsing. We use it here to 00489 // ensure we are on the text screen before issuing the error message, 00490 // otherwise it may disappear. 00491 // 00492 // Results: 00493 // None. 00494 // 00495 // Side effects: 00496 // For some graphics devices, a switch between graphics and text modes 00497 // is done. 00498 // 00499 //-------------------------------------------------------------------------- 00500 // 00501 00502 static void 00503 plPrepOutputHandler( Tcl_Interp *PL_UNUSED( interp ), int PL_UNUSED( code ), int PL_UNUSED( tty ) ) 00504 { 00505 pltext(); 00506 }