• Main Page
  • Namespaces
  • Classes
  • Files
  • File List
  • File Members

tkMain.c

Go to the documentation of this file.
00001 // $Id: tkMain.c 11680 2011-03-27 17:57:51Z airwin $
00002 //
00003 // Modified version of tkMain.c, from Tk 3.6.
00004 // Maurice LeBrun
00005 // 23-Jun-1994
00006 //
00007 // Copyright (C) 2004  Joao Cardoso
00008 //
00009 // This file is part of PLplot.
00010 //
00011 // PLplot is free software; you can redistribute it and/or modify
00012 // it under the terms of the GNU Library General Public License as published
00013 // by the Free Software Foundation; either version 2 of the License, or
00014 // (at your option) any later version.
00015 //
00016 // PLplot is distributed in the hope that it will be useful,
00017 // but WITHOUT ANY WARRANTY; without even the implied warranty of
00018 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00019 // GNU Library General Public License for more details.
00020 //
00021 // You should have received a copy of the GNU Library General Public License
00022 // along with PLplot; if not, write to the Free Software
00023 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
00024 //
00025 //
00026 // Modifications include:
00027 // 1. main() changed to pltkMain().
00028 // 2. tcl_RcFileName -> RcFileName, now passed in through the argument list.
00029 // 3. Tcl_AppInit -> AppInit, now passed in through the argument list.
00030 // 4. Support for -e <script> startup option
00031 //
00032 // The original notes follow.
00033 //
00034 
00035 //
00036 // main.c --
00037 //
00038 //      This file contains the main program for "wish", a windowing
00039 //      shell based on Tk and Tcl.  It also provides a template that
00040 //      can be used as the basis for main programs for other Tk
00041 //      applications.
00042 //
00043 // Copyright (c) 1990-1993 The Regents of the University of California.
00044 // All rights reserved.
00045 //
00046 // Permission is hereby granted, without written agreement and without
00047 // license or royalty fees, to use, copy, modify, and distribute this
00048 // software and its documentation for any purpose, provided that the
00049 // above copyright notice and the following two paragraphs appear in
00050 // all copies of this software.
00051 //
00052 // IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
00053 // DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
00054 // OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
00055 // CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
00056 //
00057 // THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
00058 // INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
00059 // AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
00060 // ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
00061 // PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
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 // itk.h includes itclInt.h which includes tclInt.h ...disaster -mjl
00078 // #ifdef HAVE_ITK
00079 // #include <itk.h>
00080 // #endif
00081 
00082 // From itkDecls.h
00083 
00084 EXTERN int Itk_Init _ANSI_ARGS_( ( Tcl_Interp * interp ) );
00085 
00086 // From tclIntDecls.h
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 // Declarations for various library procedures and variables (don't want
00101 // to include tkInt.h or tkConfig.h here, because people might copy this
00102 // file out of the Tk source directory to make their own modified versions).
00103 //
00104 
00105 // these are defined in unistd.h, included by plplotP.h
00106 // extern void          exit _ANSI_ARGS_((int status));
00107 // extern int           isatty _ANSI_ARGS_((int fd));
00108 // extern int           read _ANSI_ARGS_((int fd, char *buf, size_t size));
00109 //
00110 extern char *           strrchr _ANSI_ARGS_( ( CONST char *string, int c ) );
00111 
00112 //
00113 // Global variables used by the main program:
00114 //
00115 
00116 static Tcl_Interp  *interp;     // Interpreter for this application.
00117 static Tcl_DString command;     // Used to assemble lines of terminal input
00118                                 // into Tcl commands.
00119 static int         tty;         // Non-zero means standard input is a
00120                                 // terminal-like device.  Zero means it's
00121                                 // a file.
00122 static char errorExitCmd[] = "exit 1";
00123 
00124 //
00125 // Command-line options:
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 // Forward declarations for procedures defined later in this file:
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 // main --
00164 //
00165 //      Main program for Wish.
00166 //
00167 // Results:
00168 //      None. This procedure never returns (it exits the process when
00169 //      it's done
00170 //
00171 // Side effects:
00172 //      This procedure initializes the wish world and then starts
00173 //      interpreting commands;  almost anything could happen, depending
00174 //      on the script being interpreted.
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     // Parse command-line arguments.
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     // If a display was specified, put it into the DISPLAY
00231     // environment variable so that it will be available for
00232     // any sub-processes created by us.
00233     //
00234 
00235     if ( display != NULL )
00236     {
00237         Tcl_SetVar2( interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY );
00238     }
00239 
00240     //
00241     // Initialize the Tk application.
00242     //
00243 
00244     //
00245     // This must be setup *before* calling Tk_Init,
00246     // and `name' has already been setup above
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 // Pulled in this next section from itkwish in itcl3.0.1.
00273 //
00274 
00275     //
00276     //  This is itkwish, so import all [incr Tcl] commands by
00277     //  default into the global namespace.  Fix up the autoloader
00278     //  to do the same.
00279     //
00280     if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
00281              "::itk::*", /* allowOverwrite */ 1 ) != TCL_OK )
00282     {
00283         return TCL_ERROR;
00284     }
00285 
00286     if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
00287              "::itcl::*", /* allowOverwrite */ 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     // Make command-line arguments available in the Tcl variables "argc"
00300     // and "argv".  Also set the "geometry" variable from the geometry
00301     // specified on the command line.
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     // Set the "tcl_interactive" variable.
00317     //
00318 
00319     tty = isatty( 0 );
00320     Tcl_SetVar( interp, "tcl_interactive",
00321         ( ( fileName == NULL ) && tty ) ? "1" : "0", TCL_GLOBAL_ONLY );
00322 
00323     //
00324     // Add a few application-specific commands to the application's
00325     // interpreter.
00326     //
00327 
00328     //
00329     // Invoke application-specific initialization.
00330     //
00331 
00332     if ( ( *AppInit )( interp ) != TCL_OK )
00333     {
00334         fprintf( stderr, "(*AppInit) failed: %s\n", interp->result );
00335     }
00336 
00337     //
00338     // Set the geometry of the main window, if requested.
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     // Process the startup script, if any.
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     // Invoke the script specified on the command line, if any.
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         // Commands will come from standard input, so set up an event
00381         // handler for standard input.  Evaluate the .rc file, if one
00382         // has been specified, set up an event handler for standard
00383         // input, and print a prompt if the input device is a
00384         // terminal.
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 // Exclude UNIX-only feature
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     // Loop infinitely, waiting for commands to execute.  When there
00427     // are no windows left, Tk_MainLoop returns and we exit.
00428     //
00429 
00430     Tk_MainLoop();
00431 
00432     //
00433     // Don't exit directly, but rather invoke the Tcl "exit" command.
00434     // This gives the application the opportunity to redefine "exit"
00435     // to do additional cleanup.
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;                   // Needed only to prevent compiler warnings.
00450 }
00451 
00452 //
00453 //--------------------------------------------------------------------------
00454 //
00455 // StdinProc --
00456 //
00457 //      This procedure is invoked by the event dispatcher whenever
00458 //      standard input becomes readable.  It grabs the next line of
00459 //      input characters, adds them to a command being assembled, and
00460 //      executes the command if it's complete.
00461 //
00462 // Results:
00463 //      None.
00464 //
00465 // Side effects:
00466 //      Could be almost arbitrary, depending on the command that's
00467 //      typed.
00468 //
00469 //--------------------------------------------------------------------------
00470 //
00471 
00472 // ARGSUSED
00473 static void
00474 StdinProc( clientData, mask )
00475 ClientData clientData;                  // Not used.
00476 int mask;                               // Not used.
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     // Disable the stdin file handler while evaluating the command;
00525     // otherwise if the command re-enters the event loop we might
00526     // process commands from stdin before the current command is
00527     // finished.  Among other things, this will trash the text of the
00528     // command being evaluated.
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     // Output a prompt.
00548     //
00549 
00550 prompt:
00551     if ( tty )
00552     {
00553         Prompt( interp, gotPartial );
00554     }
00555 }
00556 
00557 //
00558 //--------------------------------------------------------------------------
00559 //
00560 // Prompt --
00561 //
00562 //      Issue a prompt on standard output, or invoke a script
00563 //      to issue the prompt.
00564 //
00565 // Results:
00566 //      None.
00567 //
00568 // Side effects:
00569 //      A prompt gets output, and a Tcl script may be evaluated
00570 //      in interp.
00571 //
00572 //--------------------------------------------------------------------------
00573 //
00574 
00575 static void
00576 Prompt( interp, partial )
00577 Tcl_Interp * interp;                    // Interpreter to use for prompting.
00578 int partial;                            // Non-zero means there already
00579                                         // exists a partial command, so use
00580                                         // the secondary prompt.
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 }

Generated on Wed Oct 12 2011 20:42:23 for PLplot by  doxygen 1.7.1