PLplot  5.10.0
tclMain.c
Go to the documentation of this file.
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 }
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Defines