PLplot  5.10.0
tkMain.c
Go to the documentation of this file.
00001 // Modified version of tkMain.c, from Tk 3.6.
00002 // Maurice LeBrun
00003 // 23-Jun-1994
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 // Modifications include:
00025 // 1. main() changed to pltkMain().
00026 // 2. tcl_RcFileName -> RcFileName, now passed in through the argument list.
00027 // 3. Tcl_AppInit -> AppInit, now passed in through the argument list.
00028 // 4. Support for -e <script> startup option
00029 //
00030 // The original notes follow.
00031 //
00032 
00033 //
00034 // main.c --
00035 //
00036 //      This file contains the main program for "wish", a windowing
00037 //      shell based on Tk and Tcl.  It also provides a template that
00038 //      can be used as the basis for main programs for other Tk
00039 //      applications.
00040 //
00041 // Copyright (c) 1990-1993 The Regents of the University of California.
00042 // All rights reserved.
00043 //
00044 // Permission is hereby granted, without written agreement and without
00045 // license or royalty fees, to use, copy, modify, and distribute this
00046 // software and its documentation for any purpose, provided that the
00047 // above copyright notice and the following two paragraphs appear in
00048 // all copies of this software.
00049 //
00050 // IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
00051 // DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
00052 // OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
00053 // CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
00054 //
00055 // THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
00056 // INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
00057 // AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
00058 // ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
00059 // PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
00060 //
00061 
00062 #include "plplotP.h"
00063 #include "pltkd.h"
00064 #include <stdio.h>
00065 #include <stdlib.h>
00066 #include <tcl.h>
00067 #include <tk.h>
00068 #ifdef HAVE_ITCL
00069 # ifndef HAVE_ITCLDECLS_H
00070 #  define RESOURCE_INCLUDED
00071 # endif
00072 # include <itcl.h>
00073 #endif
00074 
00075 // itk.h includes itclInt.h which includes tclInt.h ...disaster -mjl
00076 // #ifdef HAVE_ITK
00077 // #include <itk.h>
00078 // #endif
00079 
00080 // From itkDecls.h
00081 
00082 EXTERN int Itk_Init _ANSI_ARGS_( ( Tcl_Interp * interp ) );
00083 
00084 // From tclIntDecls.h
00085 
00086 //#ifndef Tcl_Import_TCL_DECLARED
00087 #if 0
00088 EXTERN int Tcl_Import _ANSI_ARGS_( ( Tcl_Interp * interp,
00089                                      Tcl_Namespace * nsPtr, char * pattern,
00090                                      int allowOverwrite ) );
00091 #endif
00092 
00093 #ifndef Tcl_GetGlobalNamespace_TCL_DECLARE
00094 EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace _ANSI_ARGS_( (
00095                                                                Tcl_Interp * interp ) );
00096 #endif
00097 
00098 //
00099 // Declarations for various library procedures and variables (don't want
00100 // to include tkInt.h or tkConfig.h here, because people might copy this
00101 // file out of the Tk source directory to make their own modified versions).
00102 //
00103 
00104 // these are defined in unistd.h, included by plplotP.h
00105 // extern void          exit _ANSI_ARGS_((int status));
00106 // extern int           isatty _ANSI_ARGS_((int fd));
00107 // extern int           read _ANSI_ARGS_((int fd, char *buf, size_t size));
00108 //
00109 #if !defined ( __WIN32__ )
00110 extern char *           strrchr _ANSI_ARGS_( ( CONST char *string, int c ) );
00111 #else
00112 // On Windows we do not have a convenient console to work with
00113 #define isatty( a )    0
00114 #endif
00115 
00116 //
00117 // Global variables used by the main program:
00118 //
00119 
00120 static Tcl_Interp  *interp;     // Interpreter for this application.
00121 static Tcl_DString command;     // Used to assemble lines of terminal input
00122                                 // into Tcl commands.
00123 static int         tty;         // Non-zero means standard input is a
00124                                 // terminal-like device.  Zero means it's
00125                                 // a file.
00126 static char errorExitCmd[] = "exit 1";
00127 
00128 //
00129 // Command-line options:
00130 //
00131 
00132 static int         synchronize = 0;
00133 static const char  *script     = NULL;
00134 static const char  *fileName   = NULL;
00135 static const char  *name       = NULL;
00136 static const char  *display    = NULL;
00137 static const char  *geometry   = NULL;
00138 
00139 static Tk_ArgvInfo argTable[] = {
00140     { "-file",       TK_ARGV_STRING,   (char *) NULL, (char *) &fileName,
00141       "File from which to read commands" },
00142     { "-e",          TK_ARGV_STRING,   (char *) NULL, (char *) &script,
00143       "Script to execute on startup" },
00144     { "-geometry",   TK_ARGV_STRING,   (char *) NULL, (char *) &geometry,
00145       "Initial geometry for window" },
00146     { "-display",    TK_ARGV_STRING,   (char *) NULL, (char *) &display,
00147       "Display to use" },
00148     { "-name",       TK_ARGV_STRING,   (char *) NULL, (char *) &name,
00149       "Name to use for application" },
00150     { "-sync",       TK_ARGV_CONSTANT, (char *) 1,    (char *) &synchronize,
00151       "Use synchronous mode for display server" },
00152     { (char *) NULL, TK_ARGV_END,      (char *) NULL, (char *) NULL,
00153       (char *) NULL }
00154 };
00155 
00156 //
00157 // Forward declarations for procedures defined later in this file:
00158 //
00159 
00160 static void Prompt _ANSI_ARGS_( ( Tcl_Interp * interploc, int partial ) );
00161 static void StdinProc _ANSI_ARGS_( ( ClientData clientData,
00162                                      int mask ) );
00163 
00164 //
00165 //--------------------------------------------------------------------------
00166 //
00167 // main --
00168 //
00169 //      Main program for Wish.
00170 //
00171 // Results:
00172 //      None. This procedure never returns (it exits the process when
00173 //      it's done
00174 //
00175 // Side effects:
00176 //      This procedure initializes the wish world and then starts
00177 //      interpreting commands;  almost anything could happen, depending
00178 //      on the script being interpreted.
00179 //
00180 //--------------------------------------------------------------------------
00181 //
00182 
00183 int
00184 pltkMain( int argc, const char **argv, char *RcFileName,
00185           int ( *AppInit )( Tcl_Interp *interp ) )
00186 {
00187     char       *args;
00188     const char *msg, *p;
00189     char       buf[20];
00190     int        code;
00191 
00192 #ifdef PL_HAVE_PTHREAD
00193     XInitThreads();
00194 #endif
00195 
00196     Tcl_FindExecutable( argv[0] );
00197     interp = Tcl_CreateInterp();
00198 #ifdef TCL_MEM_DEBUG
00199     Tcl_InitMemory( interp );
00200 #endif
00201 
00202     //
00203     // Parse command-line arguments.
00204     //
00205     //fprintf( stderr, "Before Tk_ParseArgv\n" );
00206 
00207     if ( Tk_ParseArgv( interp, (Tk_Window) NULL, &argc, argv, argTable, 0 )
00208          != TCL_OK )
00209     {
00210         fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
00211         exit( 1 );
00212     }
00213     //fprintf( stderr, "After Tk_ParseArgv\n" );
00214     if ( name == NULL )
00215     {
00216         if ( fileName != NULL )
00217         {
00218             p = fileName;
00219         }
00220         else
00221         {
00222             p = argv[0];
00223         }
00224         name = strrchr( p, '/' );
00225         if ( name != NULL )
00226         {
00227             name++;
00228         }
00229         else
00230         {
00231             name = p;
00232         }
00233     }
00234 
00235     //
00236     // If a display was specified, put it into the DISPLAY
00237     // environment variable so that it will be available for
00238     // any sub-processes created by us.
00239     //
00240 
00241     if ( display != NULL )
00242     {
00243         Tcl_SetVar2( interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY );
00244     }
00245 
00246     //
00247     // Initialize the Tk application.
00248     //
00249 
00250     //
00251     // This must be setup *before* calling Tk_Init,
00252     // and `name' has already been setup above
00253     //
00254 
00255     Tcl_SetVar( interp, "argv0", name, TCL_GLOBAL_ONLY );
00256 
00257     if ( Tcl_Init( interp ) == TCL_ERROR )
00258     {
00259         fprintf( stderr, "Tcl initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
00260         return TCL_ERROR;
00261     }
00262     if ( Tk_Init( interp ) == TCL_ERROR )
00263     {
00264         fprintf( stderr, "Tk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
00265         return TCL_ERROR;
00266     }
00267 #ifdef HAVE_ITCL
00268     if ( Itcl_Init( interp ) == TCL_ERROR )
00269     {
00270         fprintf( stderr, "Itcl initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
00271         return TCL_ERROR;
00272     }
00273 #endif
00274 #ifdef HAVE_ITK
00275     if ( Itk_Init( interp ) == TCL_ERROR )
00276     {
00277         fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
00278         return TCL_ERROR;
00279     }
00280 
00281 //
00282 // Pulled in this next section from itkwish in itcl3.0.1.
00283 //
00284 
00285     //
00286     //  This is itkwish, so import all [incr Tcl] commands by
00287     //  default into the global namespace.  Fix up the autoloader
00288     //  to do the same.
00289     //
00290     if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
00291              "::itk::*", /* allowOverwrite */ 1 ) != TCL_OK )
00292     {
00293         fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
00294         return TCL_ERROR;
00295     }
00296 
00297     if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
00298              "::itcl::*", /* allowOverwrite */ 1 ) != TCL_OK )
00299     {
00300         fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
00301         return TCL_ERROR;
00302     }
00303 
00304     if ( Tcl_Eval( interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }" ) != TCL_OK )
00305     {
00306         fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
00307         return TCL_ERROR;
00308     }
00309 #endif
00310 
00311     //
00312     // Make command-line arguments available in the Tcl variables "argc"
00313     // and "argv".  Also set the "geometry" variable from the geometry
00314     // specified on the command line.
00315     //
00316     //fprintf( stderr, "Before Tcl_Merge\n" );
00317 
00318     args = Tcl_Merge( argc - 1, ( CONST char * CONST * )argv + 1 );
00319     Tcl_SetVar( interp, "argv", args, TCL_GLOBAL_ONLY );
00320     ckfree( args );
00321     sprintf( buf, "%d", argc - 1 );
00322     Tcl_SetVar( interp, "argc", buf, TCL_GLOBAL_ONLY );
00323 
00324     //fprintf( stderr, "After Tcl_Merge\n" );
00325     if ( geometry != NULL )
00326     {
00327         Tcl_SetVar( interp, "geometry", geometry, TCL_GLOBAL_ONLY );
00328     }
00329 
00330     //
00331     // Set the "tcl_interactive" variable.
00332     //
00333 
00334     tty = isatty( 0 );
00335     Tcl_SetVar( interp, "tcl_interactive",
00336         ( ( fileName == NULL ) && tty ) ? "1" : "0", TCL_GLOBAL_ONLY );
00337 
00338     //
00339     // Add a few application-specific commands to the application's
00340     // interpreter.
00341     //
00342 
00343     //
00344     // Invoke application-specific initialization.
00345     //
00346     //fprintf( stderr, "Before AppInit\n" );
00347 
00348     if ( ( *AppInit )( interp ) != TCL_OK )
00349     {
00350         fprintf( stderr, "(*AppInit) failed: %s\n", Tcl_GetStringResult( interp ) );
00351         return TCL_ERROR;
00352     }
00353 
00354     //
00355     // Set the geometry of the main window, if requested.
00356     //
00357 
00358     if ( geometry != NULL )
00359     {
00360         code = Tcl_VarEval( interp, "wm geometry . ", geometry, (char *) NULL );
00361         if ( code != TCL_OK )
00362         {
00363             fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
00364         }
00365     }
00366 
00367     //
00368     // Process the startup script, if any.
00369     //
00370     //fprintf( stderr, "Before startup\n" );
00371 
00372     if ( script != NULL )
00373     {
00374         code = Tcl_VarEval( interp, script, (char *) NULL );
00375         if ( code != TCL_OK )
00376         {
00377             goto error;
00378         }
00379         tty = 0;
00380     }
00381 
00382     //
00383     // Invoke the script specified on the command line, if any.
00384     //
00385     //fprintf( stderr, "Before source\n" );
00386 
00387     if ( fileName != NULL )
00388     {
00389         code = Tcl_VarEval( interp, "source ", fileName, (char *) NULL );
00390         if ( code != TCL_OK )
00391         {
00392             goto error;
00393         }
00394         tty = 0;
00395     }
00396     else
00397     {
00398         //
00399         // Commands will come from standard input, so set up an event
00400         // handler for standard input.  Evaluate the .rc file, if one
00401         // has been specified, set up an event handler for standard
00402         // input, and print a prompt if the input device is a
00403         // terminal.
00404         //
00405 
00406         if ( RcFileName != NULL )
00407         {
00408             Tcl_DString buffer;
00409             char        *fullName;
00410             FILE        *f;
00411 
00412             fullName = Tcl_TildeSubst( interp, RcFileName, &buffer );
00413             if ( fullName == NULL )
00414             {
00415                 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
00416             }
00417             else
00418             {
00419                 f = fopen( fullName, "r" );
00420                 if ( f != NULL )
00421                 {
00422                     code = Tcl_EvalFile( interp, fullName );
00423                     if ( code != TCL_OK )
00424                     {
00425                         fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
00426                     }
00427                     fclose( f );
00428                 }
00429             }
00430             Tcl_DStringFree( &buffer );
00431         }
00432 // Exclude UNIX-only feature
00433 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
00434         Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
00435 #endif
00436         if ( tty )
00437         {
00438             Prompt( interp, 0 );
00439         }
00440     }
00441     fflush( stdout );
00442     Tcl_DStringInit( &command );
00443 
00444     //
00445     // Loop infinitely, waiting for commands to execute.  When there
00446     // are no windows left, Tk_MainLoop returns and we exit.
00447     //
00448 
00449     //fprintf( stderr, "Before Tk_MainLoop\n" );
00450     Tk_MainLoop();
00451 
00452     //
00453     // Don't exit directly, but rather invoke the Tcl "exit" command.
00454     // This gives the application the opportunity to redefine "exit"
00455     // to do additional cleanup.
00456     //
00457 
00458     Tcl_Eval( interp, "exit" );
00459     exit( 1 );
00460 
00461 error:
00462     msg = Tcl_GetVar( interp, "errorInfo", TCL_GLOBAL_ONLY );
00463     if ( msg == NULL )
00464     {
00465         msg = Tcl_GetStringResult( interp );
00466     }
00467     fprintf( stderr, "%s\n", msg );
00468     Tcl_Eval( interp, errorExitCmd );
00469     return 1;                   // Needed only to prevent compiler warnings.
00470 }
00471 
00472 //
00473 //--------------------------------------------------------------------------
00474 //
00475 // StdinProc --
00476 //
00477 //      This procedure is invoked by the event dispatcher whenever
00478 //      standard input becomes readable.  It grabs the next line of
00479 //      input characters, adds them to a command being assembled, and
00480 //      executes the command if it's complete.
00481 //
00482 // Results:
00483 //      None.
00484 //
00485 // Side effects:
00486 //      Could be almost arbitrary, depending on the command that's
00487 //      typed.
00488 //
00489 //--------------------------------------------------------------------------
00490 //
00491 
00492 // ARGSUSED
00493 static void
00494 StdinProc( ClientData PL_UNUSED( clientData ), int PL_UNUSED( mask ) )
00495 {
00496 #define BUFFER_SIZE    4000
00497     char       input[BUFFER_SIZE + 1];
00498     static int gotPartial = 0;
00499     char       *cmd;
00500     int        code, count;
00501     const char *res;
00502 
00503 #if !defined ( __WIN32__ )
00504     count = (int) read( fileno( stdin ), input, BUFFER_SIZE );
00505 #else
00506     count = fread( input, BUFFER_SIZE, sizeof ( char ), stdin );
00507 #endif
00508     if ( count <= 0 )
00509     {
00510         if ( !gotPartial )
00511         {
00512             if ( tty )
00513             {
00514                 Tcl_Eval( interp, "exit" );
00515                 exit( 1 );
00516             }
00517             else
00518             {
00519 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
00520                 Tk_DeleteFileHandler( 0 );
00521 #endif
00522             }
00523             return;
00524         }
00525         else
00526         {
00527             count = 0;
00528         }
00529     }
00530     cmd = Tcl_DStringAppend( &command, input, count );
00531     if ( count != 0 )
00532     {
00533         if ( ( input[count - 1] != '\n' ) && ( input[count - 1] != ';' ) )
00534         {
00535             gotPartial = 1;
00536             goto prompt;
00537         }
00538         if ( !Tcl_CommandComplete( cmd ) )
00539         {
00540             gotPartial = 1;
00541             goto prompt;
00542         }
00543     }
00544     gotPartial = 0;
00545 
00546     //
00547     // Disable the stdin file handler while evaluating the command;
00548     // otherwise if the command re-enters the event loop we might
00549     // process commands from stdin before the current command is
00550     // finished.  Among other things, this will trash the text of the
00551     // command being evaluated.
00552     //
00553 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
00554     Tk_CreateFileHandler( 0, 0, StdinProc, (ClientData) 0 );
00555 #endif
00556     code = Tcl_RecordAndEval( interp, cmd, 0 );
00557 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
00558     Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
00559 #endif
00560     Tcl_DStringFree( &command );
00561     res = Tcl_GetStringResult( interp );
00562     if ( *res != 0 )
00563     {
00564         if ( ( code != TCL_OK ) || ( tty ) )
00565         {
00566             printf( "%s\n", res );
00567         }
00568     }
00569 
00570     //
00571     // Output a prompt.
00572     //
00573 
00574 prompt:
00575     if ( tty )
00576     {
00577         Prompt( interp, gotPartial );
00578     }
00579 }
00580 
00581 //
00582 //--------------------------------------------------------------------------
00583 //
00584 // Prompt --
00585 //
00586 //      Issue a prompt on standard output, or invoke a script
00587 //      to issue the prompt.
00588 //
00589 // Results:
00590 //      None.
00591 //
00592 // Side effects:
00593 //      A prompt gets output, and a Tcl script may be evaluated
00594 //      in interp.
00595 //
00596 //--------------------------------------------------------------------------
00597 //
00598 
00599 static void
00600 Prompt( interploc, partial )
00601 Tcl_Interp * interploc;               // Interpreter to use for prompting.
00602 int partial;                          // Non-zero means there already
00603                                       // exists a partial command, so use
00604                                       // the secondary prompt.
00605 {
00606     const char *promptCmd;
00607     int        code;
00608 
00609     promptCmd = Tcl_GetVar( interploc,
00610         partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY );
00611     if ( promptCmd == NULL )
00612     {
00613 defaultPrompt:
00614         if ( !partial )
00615         {
00616             fputs( "% ", stdout );
00617         }
00618     }
00619     else
00620     {
00621         code = Tcl_Eval( interploc, promptCmd );
00622         if ( code != TCL_OK )
00623         {
00624             Tcl_AddErrorInfo( interploc,
00625                 "\n    (script that generates prompt)" );
00626             fprintf( stderr, "%s\n", Tcl_GetStringResult( interploc ) );
00627             goto defaultPrompt;
00628         }
00629     }
00630     fflush( stdout );
00631 }
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Defines