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