PLplot: tkMain.c Source File

PLplot 5.10.0

- Main Page
- Namespaces
- Classes
- Files

- File List
- File Members

All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
tkMain.c
Go to the documentation of this file.
1 // $Id: tkMain.c 12881 2013-12-19 01:25:14Z 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 #if 0
90 EXTERN int Tcl_Import _ANSI_ARGS_( ( Tcl_Interp * interp,
91 Tcl_Namespace * nsPtr, char * pattern,
92 int allowOverwrite ) );
93 #endif
94
95 #ifndef Tcl_GetGlobalNamespace_TCL_DECLARE
96 EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace _ANSI_ARGS_( (
97 Tcl_Interp * interp ) );
98 #endif
99
100 //
101 // Declarations for various library procedures and variables (don't want
102 // to include tkInt.h or tkConfig.h here, because people might copy this
103 // file out of the Tk source directory to make their own modified versions).
104 //
105
106 // these are defined in unistd.h, included by plplotP.h
107 // extern void exit _ANSI_ARGS_((int status));
108 // extern int isatty _ANSI_ARGS_((int fd));
109 // extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
110 //
111 #if !defined ( __WIN32__ )
112 extern char * strrchr _ANSI_ARGS_( ( CONST char *string, int c ) );
113 #else
114 // On Windows we do not have a convenient console to work with
115 #define isatty( a ) 0
116 #endif
117
118 //
119 // Global variables used by the main program:
120 //
121
122 static Tcl_Interp *interp; // Interpreter for this application.
123 static Tcl_DString command; // Used to assemble lines of terminal input
124 // into Tcl commands.
125 static int tty; // Non-zero means standard input is a
126 // terminal-like device. Zero means it's
127 // a file.
128 static char errorExitCmd[] = "exit 1";
129
130 //
131 // Command-line options:
132 //
133
134 static int synchronize = 0;
135 static const char *script = NULL;
136 static const char *fileName = NULL;
137 static const char *name = NULL;
138 static const char *display = NULL;
139 static const char *geometry = NULL;
140
141 static Tk_ArgvInfo argTable[] = {
142 { "-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
143 "File from which to read commands" },
144 { "-e", TK_ARGV_STRING, (char *) NULL, (char *) &script,
145 "Script to execute on startup" },
146 { "-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
147 "Initial geometry for window" },
148 { "-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
149 "Display to use" },
150 { "-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
151 "Name to use for application" },
152 { "-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
153 "Use synchronous mode for display server" },
154 { (char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
155 (char *) NULL }
156 };
157
158 //
159 // Forward declarations for procedures defined later in this file:
160 //
161
162 static void Prompt _ANSI_ARGS_( ( Tcl_Interp * interploc, int partial ) );
163 static void StdinProc _ANSI_ARGS_( ( ClientData clientData,
164 int mask ) );
165
166 //
167 //--------------------------------------------------------------------------
168 //
169 // main --
170 //
171 // Main program for Wish.
172 //
173 // Results:
174 // None. This procedure never returns (it exits the process when
175 // it's done
176 //
177 // Side effects:
178 // This procedure initializes the wish world and then starts
179 // interpreting commands; almost anything could happen, depending
180 // on the script being interpreted.
181 //
182 //--------------------------------------------------------------------------
183 //
184
185 int
186 pltkMain( int argc, const char **argv, char *RcFileName,
187 int ( *AppInit )( Tcl_Interp *interp ) )
188 {
189 char *args;
190 const char *msg, *p;
191 char buf[20];
192 int code;
193
194 #ifdef PL_HAVE_PTHREAD
195 XInitThreads();
196 #endif
197
198 Tcl_FindExecutable( argv[0] );
199 interp = Tcl_CreateInterp();
200 #ifdef TCL_MEM_DEBUG
201 Tcl_InitMemory( interp );
202 #endif
203
204 //
205 // Parse command-line arguments.
206 //
207 //fprintf( stderr, "Before Tk_ParseArgv\n" );
208
209 if ( Tk_ParseArgv( interp, (Tk_Window) NULL, &argc, argv, argTable, 0 )
210 != TCL_OK )
211 {
212 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
213 exit( 1 );
214 }
215 //fprintf( stderr, "After Tk_ParseArgv\n" );
216 if ( name == NULL )
217 {
218 if ( fileName != NULL )
219 {
220 p = fileName;
221 }
222 else
223 {
224 p = argv[0];
225 }
226 name = strrchr( p, '/' );
227 if ( name != NULL )
228 {
229 name++;
230 }
231 else
232 {
233 name = p;
234 }
235 }
236
237 //
238 // If a display was specified, put it into the DISPLAY
239 // environment variable so that it will be available for
240 // any sub-processes created by us.
241 //
242
243 if ( display != NULL )
244 {
245 Tcl_SetVar2( interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY );
246 }
247
248 //
249 // Initialize the Tk application.
250 //
251
252 //
253 // This must be setup *before* calling Tk_Init,
254 // and `name' has already been setup above
255 //
256
257 Tcl_SetVar( interp, "argv0", name, TCL_GLOBAL_ONLY );
258
259 if ( Tcl_Init( interp ) == TCL_ERROR )
260 {
261 fprintf( stderr, "Tcl initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
262 return TCL_ERROR;
263 }
264 if ( Tk_Init( interp ) == TCL_ERROR )
265 {
266 fprintf( stderr, "Tk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
267 return TCL_ERROR;
268 }
269 #ifdef HAVE_ITCL
270 if ( Itcl_Init( interp ) == TCL_ERROR )
271 {
272 fprintf( stderr, "Itcl initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
273 return TCL_ERROR;
274 }
275 #endif
276 #ifdef HAVE_ITK
277 if ( Itk_Init( interp ) == TCL_ERROR )
278 {
279 fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
280 return TCL_ERROR;
281 }
282
283 //
284 // Pulled in this next section from itkwish in itcl3.0.1.
285 //
286
287 //
288 // This is itkwish, so import all [incr Tcl] commands by
289 // default into the global namespace. Fix up the autoloader
290 // to do the same.
291 //
292 if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
293 "::itk::*", /* allowOverwrite */ 1 ) != TCL_OK )
294 {
295 fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
296 return TCL_ERROR;
297 }
298
299 if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
300 "::itcl::*", /* allowOverwrite */ 1 ) != TCL_OK )
301 {
302 fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
303 return TCL_ERROR;
304 }
305
306 if ( Tcl_Eval( interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }" ) != TCL_OK )
307 {
308 fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
309 return TCL_ERROR;
310 }
311 #endif
312
313 //
314 // Make command-line arguments available in the Tcl variables "argc"
315 // and "argv". Also set the "geometry" variable from the geometry
316 // specified on the command line.
317 //
318 //fprintf( stderr, "Before Tcl_Merge\n" );
319
320 args = Tcl_Merge( argc - 1, ( CONST char * CONST * )argv + 1 );
321 Tcl_SetVar( interp, "argv", args, TCL_GLOBAL_ONLY );
322 ckfree( args );
323 sprintf( buf, "%d", argc - 1 );
324 Tcl_SetVar( interp, "argc", buf, TCL_GLOBAL_ONLY );
325
326 //fprintf( stderr, "After Tcl_Merge\n" );
327 if ( geometry != NULL )
328 {
329 Tcl_SetVar( interp, "geometry", geometry, TCL_GLOBAL_ONLY );
330 }
331
332 //
333 // Set the "tcl_interactive" variable.
334 //
335
336 tty = isatty( 0 );
337 Tcl_SetVar( interp, "tcl_interactive",
338 ( ( fileName == NULL ) && tty ) ? "1" : "0", TCL_GLOBAL_ONLY );
339
340 //
341 // Add a few application-specific commands to the application's
342 // interpreter.
343 //
344
345 //
346 // Invoke application-specific initialization.
347 //
348 //fprintf( stderr, "Before AppInit\n" );
349
350 if ( ( *AppInit )( interp ) != TCL_OK )
351 {
352 fprintf( stderr, "(*AppInit) failed: %s\n", Tcl_GetStringResult( interp ) );
353 return TCL_ERROR;
354 }
355
356 //
357 // Set the geometry of the main window, if requested.
358 //
359
360 if ( geometry != NULL )
361 {
362 code = Tcl_VarEval( interp, "wm geometry . ", geometry, (char *) NULL );
363 if ( code != TCL_OK )
364 {
365 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
366 }
367 }
368
369 //
370 // Process the startup script, if any.
371 //
372 //fprintf( stderr, "Before startup\n" );
373
374 if ( script != NULL )
375 {
376 code = Tcl_VarEval( interp, script, (char *) NULL );
377 if ( code != TCL_OK )
378 {
379 goto error;
380 }
381 tty = 0;
382 }
383
384 //
385 // Invoke the script specified on the command line, if any.
386 //
387 //fprintf( stderr, "Before source\n" );
388
389 if ( fileName != NULL )
390 {
391 code = Tcl_VarEval( interp, "source ", fileName, (char *) NULL );
392 if ( code != TCL_OK )
393 {
394 goto error;
395 }
396 tty = 0;
397 }
398 else
399 {
400 //
401 // Commands will come from standard input, so set up an event
402 // handler for standard input. Evaluate the .rc file, if one
403 // has been specified, set up an event handler for standard
404 // input, and print a prompt if the input device is a
405 // terminal.
406 //
407
408 if ( RcFileName != NULL )
409 {
410 Tcl_DString buffer;
411 char *fullName;
412 FILE *f;
413
414 fullName = Tcl_TildeSubst( interp, RcFileName, &buffer );
415 if ( fullName == NULL )
416 {
417 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
418 }
419 else
420 {
421 f = fopen( fullName, "r" );
422 if ( f != NULL )
423 {
424 code = Tcl_EvalFile( interp, fullName );
425 if ( code != TCL_OK )
426 {
427 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
428 }
429 fclose( f );
430 }
431 }
432 Tcl_DStringFree( &buffer );
433 }
434 // Exclude UNIX-only feature
435 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
436 Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
437 #endif
438 if ( tty )
439 {
440 Prompt( interp, 0 );
441 }
442 }
443 fflush( stdout );
444 Tcl_DStringInit( &command );
445
446 //
447 // Loop infinitely, waiting for commands to execute. When there
448 // are no windows left, Tk_MainLoop returns and we exit.
449 //
450
451 //fprintf( stderr, "Before Tk_MainLoop\n" );
452 Tk_MainLoop();
453
454 //
455 // Don't exit directly, but rather invoke the Tcl "exit" command.
456 // This gives the application the opportunity to redefine "exit"
457 // to do additional cleanup.
458 //
459
460 Tcl_Eval( interp, "exit" );
461 exit( 1 );
462
463 error:
464 msg = Tcl_GetVar( interp, "errorInfo", TCL_GLOBAL_ONLY );
465 if ( msg == NULL )
466 {
467 msg = Tcl_GetStringResult( interp );
468 }
469 fprintf( stderr, "%s\n", msg );
470 Tcl_Eval( interp, errorExitCmd );
471 return 1; // Needed only to prevent compiler warnings.
472 }
473
474 //
475 //--------------------------------------------------------------------------
476 //
477 // StdinProc --
478 //
479 // This procedure is invoked by the event dispatcher whenever
480 // standard input becomes readable. It grabs the next line of
481 // input characters, adds them to a command being assembled, and
482 // executes the command if it's complete.
483 //
484 // Results:
485 // None.
486 //
487 // Side effects:
488 // Could be almost arbitrary, depending on the command that's
489 // typed.
490 //
491 //--------------------------------------------------------------------------
492 //
493
494 // ARGSUSED
495 static void
496 StdinProc( ClientData PL_UNUSED( clientData ), int PL_UNUSED( mask ) )
497 {
498 #define BUFFER_SIZE 4000
499 char input[BUFFER_SIZE + 1];
500 static int gotPartial = 0;
501 char *cmd;
502 int code, count;
503 const char *res;
504
505 #if !defined ( __WIN32__ )
506 count = (int) read( fileno( stdin ), input, BUFFER_SIZE );
507 #else
508 count = fread( input, BUFFER_SIZE, sizeof ( char ), stdin );
509 #endif
510 if ( count <= 0 )
511 {
512 if ( !gotPartial )
513 {
514 if ( tty )
515 {
516 Tcl_Eval( interp, "exit" );
517 exit( 1 );
518 }
519 else
520 {
521 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
522 Tk_DeleteFileHandler( 0 );
523 #endif
524 }
525 return;
526 }
527 else
528 {
529 count = 0;
530 }
531 }
532 cmd = Tcl_DStringAppend( &command, input, count );
533 if ( count != 0 )
534 {
535 if ( ( input[count - 1] != '\n' ) && ( input[count - 1] != ';' ) )
536 {
537 gotPartial = 1;
538 goto prompt;
539 }
540 if ( !Tcl_CommandComplete( cmd ) )
541 {
542 gotPartial = 1;
543 goto prompt;
544 }
545 }
546 gotPartial = 0;
547
548 //
549 // Disable the stdin file handler while evaluating the command;
550 // otherwise if the command re-enters the event loop we might
551 // process commands from stdin before the current command is
552 // finished. Among other things, this will trash the text of the
553 // command being evaluated.
554 //
555 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
556 Tk_CreateFileHandler( 0, 0, StdinProc, (ClientData) 0 );
557 #endif
558 code = Tcl_RecordAndEval( interp, cmd, 0 );
559 #if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
560 Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
561 #endif
562 Tcl_DStringFree( &command );
563 res = Tcl_GetStringResult( interp );
564 if ( *res != 0 )
565 {
566 if ( ( code != TCL_OK ) || ( tty ) )
567 {
568 printf( "%s\n", res );
569 }
570 }
571
572 //
573 // Output a prompt.
574 //
575
576 prompt:
577 if ( tty )
578 {
579 Prompt( interp, gotPartial );
580 }
581 }
582
583 //
584 //--------------------------------------------------------------------------
585 //
586 // Prompt --
587 //
588 // Issue a prompt on standard output, or invoke a script
589 // to issue the prompt.
590 //
591 // Results:
592 // None.
593 //
594 // Side effects:
595 // A prompt gets output, and a Tcl script may be evaluated
596 // in interp.
597 //
598 //--------------------------------------------------------------------------
599 //
600
601 static void
602 Prompt( interploc, partial )
603 Tcl_Interp * interploc; // Interpreter to use for prompting.
604 int partial; // Non-zero means there already
605 // exists a partial command, so use
606 // the secondary prompt.
607 {
608 const char *promptCmd;
609 int code;
610
611 promptCmd = Tcl_GetVar( interploc,
612 partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY );
613 if ( promptCmd == NULL )
614 {
615 defaultPrompt:
616 if ( !partial )
617 {
618 fputs( "% ", stdout );
619 }
620 }
621 else
622 {
623 code = Tcl_Eval( interploc, promptCmd );
624 if ( code != TCL_OK )
625 {
626 Tcl_AddErrorInfo( interploc,
627 "\n (script that generates prompt)" );
628 fprintf( stderr, "%s\n", Tcl_GetStringResult( interploc ) );
629 goto defaultPrompt;
630 }
631 }
632 fflush( stdout );
633 }