PLplot  5.9.9
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
tkMain.c
Go to the documentation of this file.
1 // $Id: tkMain.c 12286 2013-01-29 23:36:01Z airwin $
2 //
3 // Modified version of tkMain.c, from Tk 3.6.
4 // Maurice LeBrun
5 // 23-Jun-1994
6 //
7 // Copyright (C) 2004 Joao Cardoso
8 //
9 // This file is part of PLplot.
10 //
11 // PLplot is free software; you can redistribute it and/or modify
12 // it under the terms of the GNU Library General Public License as published
13 // by the Free Software Foundation; either version 2 of the License, or
14 // (at your option) any later version.
15 //
16 // PLplot is distributed in the hope that it will be useful,
17 // but WITHOUT ANY WARRANTY; without even the implied warranty of
18 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 // GNU Library General Public License for more details.
20 //
21 // You should have received a copy of the GNU Library General Public License
22 // along with PLplot; if not, write to the Free Software
23 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
24 //
25 //
26 // Modifications include:
27 // 1. main() changed to pltkMain().
28 // 2. tcl_RcFileName -> RcFileName, now passed in through the argument list.
29 // 3. Tcl_AppInit -> AppInit, now passed in through the argument list.
30 // 4. Support for -e <script> startup option
31 //
32 // The original notes follow.
33 //
34 
35 //
36 // main.c --
37 //
38 // This file contains the main program for "wish", a windowing
39 // shell based on Tk and Tcl. It also provides a template that
40 // can be used as the basis for main programs for other Tk
41 // applications.
42 //
43 // Copyright (c) 1990-1993 The Regents of the University of California.
44 // All rights reserved.
45 //
46 // Permission is hereby granted, without written agreement and without
47 // license or royalty fees, to use, copy, modify, and distribute this
48 // software and its documentation for any purpose, provided that the
49 // above copyright notice and the following two paragraphs appear in
50 // all copies of this software.
51 //
52 // IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
53 // DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
54 // OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
55 // CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
56 //
57 // THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
58 // INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
59 // AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
60 // ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
61 // PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
62 //
63 
64 #include "plplotP.h"
65 #include "pltkd.h"
66 #include <stdio.h>
67 #include <stdlib.h>
68 #include <tcl.h>
69 #include <tk.h>
70 #ifdef HAVE_ITCL
71 # ifndef HAVE_ITCLDECLS_H
72 # define RESOURCE_INCLUDED
73 # endif
74 # include <itcl.h>
75 #endif
76 
77 // itk.h includes itclInt.h which includes tclInt.h ...disaster -mjl
78 // #ifdef HAVE_ITK
79 // #include <itk.h>
80 // #endif
81 
82 // From itkDecls.h
83 
84 EXTERN int Itk_Init _ANSI_ARGS_( ( Tcl_Interp * interp ) );
85 
86 // From tclIntDecls.h
87 
88 #ifndef Tcl_Import_TCL_DECLARED
89 EXTERN int Tcl_Import _ANSI_ARGS_( ( Tcl_Interp * interp,
90  Tcl_Namespace * nsPtr, char * pattern,
91  int allowOverwrite ) );
92 #endif
93 
94 #ifndef Tcl_GetGlobalNamespace_TCL_DECLARE
95 EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace _ANSI_ARGS_( (
96  Tcl_Interp * interp ) );
97 #endif
98 
99 //
100 // Declarations for various library procedures and variables (don't want
101 // to include tkInt.h or tkConfig.h here, because people might copy this
102 // file out of the Tk source directory to make their own modified versions).
103 //
104 
105 // these are defined in unistd.h, included by plplotP.h
106 // extern void exit _ANSI_ARGS_((int status));
107 // extern int isatty _ANSI_ARGS_((int fd));
108 // extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
109 //
110 extern char * strrchr _ANSI_ARGS_( ( CONST char *string, int c ) );
111 
112 //
113 // Global variables used by the main program:
114 //
115 
116 static Tcl_Interp *interp; // Interpreter for this application.
117 static Tcl_DString command; // Used to assemble lines of terminal input
118  // into Tcl commands.
119 static int tty; // Non-zero means standard input is a
120  // terminal-like device. Zero means it's
121  // a file.
122 static char errorExitCmd[] = "exit 1";
123 
124 //
125 // Command-line options:
126 //
127 
128 static int synchronize = 0;
129 static const char *script = NULL;
130 static const char *fileName = NULL;
131 static const char *name = NULL;
132 static const char *display = NULL;
133 static const char *geometry = NULL;
134 
135 static Tk_ArgvInfo argTable[] = {
136  { "-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
137  "File from which to read commands" },
138  { "-e", TK_ARGV_STRING, (char *) NULL, (char *) &script,
139  "Script to execute on startup" },
140  { "-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
141  "Initial geometry for window" },
142  { "-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
143  "Display to use" },
144  { "-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
145  "Name to use for application" },
146  { "-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
147  "Use synchronous mode for display server" },
148  { (char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
149  (char *) NULL }
150 };
151 
152 //
153 // Forward declarations for procedures defined later in this file:
154 //
155 
156 static void Prompt _ANSI_ARGS_( ( Tcl_Interp * interp, int partial ) );
157 static void StdinProc _ANSI_ARGS_( ( ClientData clientData,
158  int mask ) );
159 
160 //
161 //--------------------------------------------------------------------------
162 //
163 // main --
164 //
165 // Main program for Wish.
166 //
167 // Results:
168 // None. This procedure never returns (it exits the process when
169 // it's done
170 //
171 // Side effects:
172 // This procedure initializes the wish world and then starts
173 // interpreting commands; almost anything could happen, depending
174 // on the script being interpreted.
175 //
176 //--------------------------------------------------------------------------
177 //
178 
179 int
180 pltkMain( int argc, const char **argv, char *RcFileName,
181  int ( *AppInit )( Tcl_Interp *interp ) )
182 {
183  char *args;
184  const char *msg, *p;
185  char buf[20];
186  int code;
187 
188 #ifdef PL_HAVE_PTHREAD
189  XInitThreads();
190 #endif
191 
192  Tcl_FindExecutable( argv[0] );
193  interp = Tcl_CreateInterp();
194 #ifdef TCL_MEM_DEBUG
195  Tcl_InitMemory( interp );
196 #endif
197 
198  //
199  // Parse command-line arguments.
200  //
201 
202  if ( Tk_ParseArgv( interp, (Tk_Window) NULL, &argc, argv, argTable, 0 )
203  != TCL_OK )
204  {
205  fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
206  exit( 1 );
207  }
208  if ( name == NULL )
209  {
210  if ( fileName != NULL )
211  {
212  p = fileName;
213  }
214  else
215  {
216  p = argv[0];
217  }
218  name = strrchr( p, '/' );
219  if ( name != NULL )
220  {
221  name++;
222  }
223  else
224  {
225  name = p;
226  }
227  }
228 
229  //
230  // If a display was specified, put it into the DISPLAY
231  // environment variable so that it will be available for
232  // any sub-processes created by us.
233  //
234 
235  if ( display != NULL )
236  {
237  Tcl_SetVar2( interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY );
238  }
239 
240  //
241  // Initialize the Tk application.
242  //
243 
244  //
245  // This must be setup *before* calling Tk_Init,
246  // and `name' has already been setup above
247  //
248 
249  Tcl_SetVar( interp, "argv0", name, TCL_GLOBAL_ONLY );
250 
251  if ( Tcl_Init( interp ) == TCL_ERROR )
252  {
253  return TCL_ERROR;
254  }
255  if ( Tk_Init( interp ) == TCL_ERROR )
256  {
257  return TCL_ERROR;
258  }
259 #ifdef HAVE_ITCL
260  if ( Itcl_Init( interp ) == TCL_ERROR )
261  {
262  return TCL_ERROR;
263  }
264 #endif
265 #ifdef HAVE_ITK
266  if ( Itk_Init( interp ) == TCL_ERROR )
267  {
268  return TCL_ERROR;
269  }
270 
271 //
272 // Pulled in this next section from itkwish in itcl3.0.1.
273 //
274 
275  //
276  // This is itkwish, so import all [incr Tcl] commands by
277  // default into the global namespace. Fix up the autoloader
278  // to do the same.
279  //
280  if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
281  "::itk::*", /* allowOverwrite */ 1 ) != TCL_OK )
282  {
283  return TCL_ERROR;
284  }
285 
286  if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
287  "::itcl::*", /* allowOverwrite */ 1 ) != TCL_OK )
288  {
289  return TCL_ERROR;
290  }
291 
292  if ( Tcl_Eval( interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }" ) != TCL_OK )
293  {
294  return TCL_ERROR;
295  }
296 #endif
297 
298  //
299  // Make command-line arguments available in the Tcl variables "argc"
300  // and "argv". Also set the "geometry" variable from the geometry
301  // specified on the command line.
302  //
303 
304  args = Tcl_Merge( argc - 1, ( CONST char * CONST * )argv + 1 );
305  Tcl_SetVar( interp, "argv", args, TCL_GLOBAL_ONLY );
306  ckfree( args );
307  sprintf( buf, "%d", argc - 1 );
308  Tcl_SetVar( interp, "argc", buf, TCL_GLOBAL_ONLY );
309 
310  if ( geometry != NULL )
311  {
312  Tcl_SetVar( interp, "geometry", geometry, TCL_GLOBAL_ONLY );
313  }
314 
315  //
316  // Set the "tcl_interactive" variable.
317  //
318 
319  tty = isatty( 0 );
320  Tcl_SetVar( interp, "tcl_interactive",
321  ( ( fileName == NULL ) && tty ) ? "1" : "0", TCL_GLOBAL_ONLY );
322 
323  //
324  // Add a few application-specific commands to the application's
325  // interpreter.
326  //
327 
328  //
329  // Invoke application-specific initialization.
330  //
331 
332  if ( ( *AppInit )( interp ) != TCL_OK )
333  {
334  fprintf( stderr, "(*AppInit) failed: %s\n", Tcl_GetStringResult( interp ) );
335  }
336 
337  //
338  // Set the geometry of the main window, if requested.
339  //
340 
341  if ( geometry != NULL )
342  {
343  code = Tcl_VarEval( interp, "wm geometry . ", geometry, (char *) NULL );
344  if ( code != TCL_OK )
345  {
346  fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
347  }
348  }
349 
350  //
351  // Process the startup script, if any.
352  //
353 
354  if ( script != NULL )
355  {
356  code = Tcl_VarEval( interp, script, (char *) NULL );
357  if ( code != TCL_OK )
358  {
359  goto error;
360  }
361  tty = 0;
362  }
363 
364  //
365  // Invoke the script specified on the command line, if any.
366  //
367 
368  if ( fileName != NULL )
369  {
370  code = Tcl_VarEval( interp, "source ", fileName, (char *) NULL );
371  if ( code != TCL_OK )
372  {
373  goto error;
374  }
375  tty = 0;
376  }
377  else
378  {
379  //
380  // Commands will come from standard input, so set up an event
381  // handler for standard input. Evaluate the .rc file, if one
382  // has been specified, set up an event handler for standard
383  // input, and print a prompt if the input device is a
384  // terminal.
385  //
386 
387  if ( RcFileName != NULL )
388  {
389  Tcl_DString buffer;
390  char *fullName;
391  FILE *f;
392 
393  fullName = Tcl_TildeSubst( interp, RcFileName, &buffer );
394  if ( fullName == NULL )
395  {
396  fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
397  }
398  else
399  {
400  f = fopen( fullName, "r" );
401  if ( f != NULL )
402  {
403  code = Tcl_EvalFile( interp, fullName );
404  if ( code != TCL_OK )
405  {
406  fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
407  }
408  fclose( f );
409  }
410  }
411  Tcl_DStringFree( &buffer );
412  }
413 // Exclude UNIX-only feature
414 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
415  Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
416 #endif
417  if ( tty )
418  {
419  Prompt( interp, 0 );
420  }
421  }
422  fflush( stdout );
423  Tcl_DStringInit( &command );
424 
425  //
426  // Loop infinitely, waiting for commands to execute. When there
427  // are no windows left, Tk_MainLoop returns and we exit.
428  //
429 
430  Tk_MainLoop();
431 
432  //
433  // Don't exit directly, but rather invoke the Tcl "exit" command.
434  // This gives the application the opportunity to redefine "exit"
435  // to do additional cleanup.
436  //
437 
438  Tcl_Eval( interp, "exit" );
439  exit( 1 );
440 
441 error:
442  msg = Tcl_GetVar( interp, "errorInfo", TCL_GLOBAL_ONLY );
443  if ( msg == NULL )
444  {
445  msg = Tcl_GetStringResult( interp );
446  }
447  fprintf( stderr, "%s\n", msg );
448  Tcl_Eval( interp, errorExitCmd );
449  return 1; // Needed only to prevent compiler warnings.
450 }
451 
452 //
453 //--------------------------------------------------------------------------
454 //
455 // StdinProc --
456 //
457 // This procedure is invoked by the event dispatcher whenever
458 // standard input becomes readable. It grabs the next line of
459 // input characters, adds them to a command being assembled, and
460 // executes the command if it's complete.
461 //
462 // Results:
463 // None.
464 //
465 // Side effects:
466 // Could be almost arbitrary, depending on the command that's
467 // typed.
468 //
469 //--------------------------------------------------------------------------
470 //
471 
472 // ARGSUSED
473 static void
474 StdinProc( ClientData PL_UNUSED( clientData ), int PL_UNUSED( mask ) )
475 {
476 #define BUFFER_SIZE 4000
477  char input[BUFFER_SIZE + 1];
478  static int gotPartial = 0;
479  char *cmd;
480  int code, count;
481  const char *res;
482 
483  count = (int) read( fileno( stdin ), input, BUFFER_SIZE );
484  if ( count <= 0 )
485  {
486  if ( !gotPartial )
487  {
488  if ( tty )
489  {
490  Tcl_Eval( interp, "exit" );
491  exit( 1 );
492  }
493  else
494  {
495 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
496  Tk_DeleteFileHandler( 0 );
497 #endif
498  }
499  return;
500  }
501  else
502  {
503  count = 0;
504  }
505  }
506  cmd = Tcl_DStringAppend( &command, input, count );
507  if ( count != 0 )
508  {
509  if ( ( input[count - 1] != '\n' ) && ( input[count - 1] != ';' ) )
510  {
511  gotPartial = 1;
512  goto prompt;
513  }
514  if ( !Tcl_CommandComplete( cmd ) )
515  {
516  gotPartial = 1;
517  goto prompt;
518  }
519  }
520  gotPartial = 0;
521 
522  //
523  // Disable the stdin file handler while evaluating the command;
524  // otherwise if the command re-enters the event loop we might
525  // process commands from stdin before the current command is
526  // finished. Among other things, this will trash the text of the
527  // command being evaluated.
528  //
529 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
530  Tk_CreateFileHandler( 0, 0, StdinProc, (ClientData) 0 );
531 #endif
532  code = Tcl_RecordAndEval( interp, cmd, 0 );
533 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
534  Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
535 #endif
536  Tcl_DStringFree( &command );
537  res = Tcl_GetStringResult( interp );
538  if ( *res != 0 )
539  {
540  if ( ( code != TCL_OK ) || ( tty ) )
541  {
542  printf( "%s\n", res );
543  }
544  }
545 
546  //
547  // Output a prompt.
548  //
549 
550 prompt:
551  if ( tty )
552  {
553  Prompt( interp, gotPartial );
554  }
555 }
556 
557 //
558 //--------------------------------------------------------------------------
559 //
560 // Prompt --
561 //
562 // Issue a prompt on standard output, or invoke a script
563 // to issue the prompt.
564 //
565 // Results:
566 // None.
567 //
568 // Side effects:
569 // A prompt gets output, and a Tcl script may be evaluated
570 // in interp.
571 //
572 //--------------------------------------------------------------------------
573 //
574 
575 static void
576 Prompt( intp, partial )
577 Tcl_Interp * intp; // Interpreter to use for prompting.
578 int partial; // Non-zero means there already
579  // exists a partial command, so use
580  // the secondary prompt.
581 {
582  const char *promptCmd;
583  int code;
584 
585  promptCmd = Tcl_GetVar( intp,
586  partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY );
587  if ( promptCmd == NULL )
588  {
589 defaultPrompt:
590  if ( !partial )
591  {
592  fputs( "% ", stdout );
593  }
594  }
595  else
596  {
597  code = Tcl_Eval( intp, promptCmd );
598  if ( code != TCL_OK )
599  {
600  Tcl_AddErrorInfo( intp,
601  "\n (script that generates prompt)" );
602  fprintf( stderr, "%s\n", Tcl_GetStringResult( intp ) );
603  goto defaultPrompt;
604  }
605  }
606  fflush( stdout );
607 }