PLplot
5.10.0
|
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 }