PLplot: tclMain.c Source File

PLplot 5.15.0

tclMain.c
Go to the documentation of this file.
1 // Modified version of tclMain.c, from Tcl 8.3.2.
2 // Maurice LeBrun
3 // Jan 2 2001
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 // Based on previous version of tclMain.c, from Tcl 7.3.
25 // Modifications include:
26 // 1. Tcl_Main() changed to pltclMain().
27 // 2. Changes to work with ANSI C
28 // 3. Changes to support user-installable error or output handlers.
29 // 4. PLplot argument parsing routine called to handle arguments.
30 // 5. Added define of _POSIX_SOURCE and eliminated include of tclInt.h.
31 //
32 // Original comments follow.
33 //
34
35 //
36 // tclMain.c --
37 //
38 // Main program for Tcl shells and other Tcl-based applications.
39 //
40 // Copyright (c) 1988-1994 The Regents of the University of California.
41 // Copyright (c) 1994-1997 Sun Microsystems, Inc.
42 //
43 // See the file "license.terms" for information on usage and redistribution
44 // of this file, and for a DISCLAIMER OF ALL WARRANTIES.
45 //
46
47 #include "pltcl.h"
48 // Required for definition of PL_UNUSED macro
49 #include "plplotP.h"
50
51 #define TclFormatInt( buf, n ) sprintf( ( buf ), "%ld", (long) ( n ) )
52
53 # undef TCL_STORAGE_CLASS
54 # define TCL_STORAGE_CLASS DLLEXPORT
55
56 //
57 // The following code ensures that tclLink.c is linked whenever
58 // Tcl is linked. Without this code there's no reference to the
59 // code in that file from anywhere in Tcl, so it may not be
60 // linked into the application.
61 //
62
63 // Experiments show this is no longer required, and in any case
64 // it screws up using the Tcl stub library. So comment out (AWI).
65 //EXTERN int Tcl_LinkVar( );
66 //int ( *tclDummyLinkVarPtr )() = Tcl_LinkVar;
67
68 //
69 // Declarations for various library procedures and variables (don't want
70 // to include tclPort.h here, because people might copy this file out of
71 // the Tcl source directory to make their own modified versions).
72 // Note: "exit" should really be declared here, but there's no way to
73 // declare it without causing conflicts with other definitions elsewher
74 // on some systems, so it's better just to leave it out.
75 //
76
77 extern int isatty _ANSI_ARGS_( ( int fd ) );
78 extern char * strcpy _ANSI_ARGS_( ( char *dst, CONST char *src ) );
79
80 static const char *tclStartupScriptFileName = NULL;
81
82 // pltcl enhancements
83
84 static void
85 plPrepOutputHandler( Tcl_Interp *interp, int code, int tty );
86
87 // Other function prototypes
88 void TclSetStartupScriptFileName( char *fileName );
89 const char *TclGetStartupScriptFileName( void );
90
91 // These are globally visible and can be replaced
92
93 void ( *tclErrorHandler )( Tcl_Interp *interp, int code, int tty ) = NULL;
94
95 void ( *tclPrepOutputHandler )( Tcl_Interp *interp, int code, int tty )
96 = plPrepOutputHandler;
97
98 // Options data structure definition.
99
100 static char *tclStartupScript = NULL;
101 static const char *pltcl_notes[] = {
102 "Specifying the filename on the command line is compatible with modern",
103 "tclsh syntax. Old tclsh's used the -f syntax, which is still supported.",
104 "You may use either syntax but not both.",
105 NULL
106 };
107
108 static PLOptionTable options[] = {
109 {
110 "f", // File to read & process
111 NULL,
112 NULL,
113 &tclStartupScriptFileName,
114 PL_OPT_STRING,
115 "-f",
116 "File from which to read commands"
117 },
118 {
119 "file", // File to read & process (alias)
120 NULL,
121 NULL,
122 &tclStartupScriptFileName,
123 PL_OPT_STRING | PL_OPT_INVISIBLE,
124 "-file",
125 "File from which to read commands"
126 },
127 {
128 "e", // Script to run on startup
129 NULL,
130 NULL,
131 &tclStartupScript,
132 PL_OPT_STRING,
133 "-e",
134 "Script to execute on startup"
135 },
136 {
137 NULL, // option
138 NULL, // handler
139 NULL, // client data
140 NULL, // address of variable to set
141 0, // mode flag
142 NULL, // short syntax
143 NULL
144 } // long syntax
145 };
146
147
148 //
149 //--------------------------------------------------------------------------
150 //
151 // TclSetStartupScriptFileName --
152 //
153 // Primes the startup script file name, used to override the
154 // command line processing.
155 //
156 // Results:
157 // None.
158 //
159 // Side effects:
160 // This procedure initializes the file name of the Tcl script to
161 // run at startup.
162 //
163 //--------------------------------------------------------------------------
164 //
165 void TclSetStartupScriptFileName( char *fileName )
166 {
167 tclStartupScriptFileName = fileName;
168 }
169
170
171 //
172 //--------------------------------------------------------------------------
173 //
174 // TclGetStartupScriptFileName --
175 //
176 // Gets the startup script file name, used to override the
177 // command line processing.
178 //
179 // Results:
180 // The startup script file name, NULL if none has been set.
181 //
182 // Side effects:
183 // None.
184 //
185 //--------------------------------------------------------------------------
186 //
187 const char *TclGetStartupScriptFileName( void )
188 {
189 return tclStartupScriptFileName;
190 }
191
192
193
194 //
195 //--------------------------------------------------------------------------
196 //
197 // Tcl_Main --
198 //
199 // Main program for tclsh and most other Tcl-based applications.
200 //
201 // Results:
202 // None. This procedure never returns (it exits the process when
203 // it's done.
204 //
205 // Side effects:
206 // This procedure initializes the Tcl world and then starts
207 // interpreting commands; almost anything could happen, depending
208 // on the script being interpreted.
209 //
210 //--------------------------------------------------------------------------
211 //
212
213 int PLDLLEXPORT
214 pltclMain( int argc, char **argv, char * PL_UNUSED( RcFileName ) /* OBSOLETE */,
215 int ( *appInitProc )( Tcl_Interp *interp ) )
216 {
217 Tcl_Obj *resultPtr;
218 Tcl_Obj *commandPtr = NULL;
219 char buffer[1000], *args;
220 int code, gotPartial, tty, length;
221 int exitCode = 0;
222 Tcl_Channel inChannel, outChannel, errChannel;
223 Tcl_Interp *interp;
224 Tcl_DString argString;
225
226 char usage[500];
227
228 Tcl_FindExecutable( argv[0] );
229 interp = Tcl_CreateInterp();
230 Tcl_InitMemory( interp ); //no-op if TCL_MEM_DEBUG undefined
231
232 // First process plplot-specific args using the PLplot parser.
233
234 sprintf( usage, "\nUsage:\n %s [filename] [options]\n", argv[0] );
235 plSetUsage( NULL, usage );
236 plMergeOpts( options, "pltcl options", pltcl_notes );
237 plparseopts( &argc, argv, PL_PARSE_FULL | PL_PARSE_SKIP );
238
239 //
240 // Make (remaining) command-line arguments available in the Tcl variables
241 // "argc" and "argv". If the first argument doesn't start with a "-" then
242 // strip it off and use it as the name of a script file to process.
243 //
244
245 if ( tclStartupScriptFileName == NULL )
246 {
247 if ( ( argc > 1 ) && ( argv[1][0] != '-' ) )
248 {
249 tclStartupScriptFileName = argv[1];
250 argc--;
251 argv++;
252 }
253 }
254 args = Tcl_Merge( argc - 1, ( CONST char * CONST * )argv + 1 );
255 Tcl_ExternalToUtfDString( NULL, args, -1, &argString );
256 Tcl_SetVar( interp, "argv", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
257 Tcl_DStringFree( &argString );
258 ckfree( args );
259
260 if ( tclStartupScriptFileName == NULL )
261 {
262 Tcl_ExternalToUtfDString( NULL, argv[0], -1, &argString );
263 }
264 else
265 {
266 tclStartupScriptFileName = Tcl_ExternalToUtfDString( NULL,
267 tclStartupScriptFileName, -1, &argString );
268 }
269
270 TclFormatInt( buffer, argc - 1 );
271 Tcl_SetVar( interp, "argc", buffer, TCL_GLOBAL_ONLY );
272 Tcl_SetVar( interp, "argv0", Tcl_DStringValue( &argString ), TCL_GLOBAL_ONLY );
273
274 //
275 // Set the "tcl_interactive" variable.
276 //
277
278 tty = isatty( 0 );
279 Tcl_SetVar( interp, "tcl_interactive",
280 ( ( tclStartupScriptFileName == NULL ) && tty ) ? "1" : "0",
281 TCL_GLOBAL_ONLY );
282
283 //
284 // Invoke application-specific initialization.
285 //
286
287 if ( ( *appInitProc )( interp ) != TCL_OK )
288 {
289 errChannel = Tcl_GetStdChannel( TCL_STDERR );
290 if ( errChannel )
291 {
292 Tcl_WriteChars( errChannel,
293 "application-specific initialization failed: ", -1 );
294 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
295 Tcl_WriteChars( errChannel, "\n", 1 );
296 }
297 }
298
299 //
300 // Process the startup script, if any.
301 //
302
303 if ( tclStartupScript != NULL )
304 {
305 code = Tcl_VarEval( interp, tclStartupScript, (char *) NULL );
306 if ( code != TCL_OK )
307 {
308 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
309 exitCode = 1;
310 }
311 }
312
313 //
314 // If a script file was specified then just source that file
315 // and quit.
316 //
317
318 if ( tclStartupScriptFileName != NULL )
319 {
320 code = Tcl_EvalFile( interp, tclStartupScriptFileName );
321 if ( code != TCL_OK )
322 {
323 errChannel = Tcl_GetStdChannel( TCL_STDERR );
324 if ( errChannel )
325 {
326 //
327 // The following statement guarantees that the errorInfo
328 // variable is set properly.
329 //
330
331 Tcl_AddErrorInfo( interp, "" );
332 Tcl_WriteObj( errChannel, Tcl_GetVar2Ex( interp, "errorInfo",
333 NULL, TCL_GLOBAL_ONLY ) );
334 Tcl_WriteChars( errChannel, "\n", 1 );
335 }
336 exitCode = 1;
337 }
338 goto done;
339 }
340 Tcl_DStringFree( &argString );
341
342 //
343 // We're running interactively. Source a user-specific startup
344 // file if the application specified one and if the file exists.
345 //
346
347 Tcl_SourceRCFile( interp );
348
349 //
350 // Process commands from stdin until there's an end-of-file. Note
351 // that we need to fetch the standard channels again after every
352 // eval, since they may have been changed.
353 //
354
355 commandPtr = Tcl_NewObj();
356 Tcl_IncrRefCount( commandPtr );
357
358 inChannel = Tcl_GetStdChannel( TCL_STDIN );
359 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
360 gotPartial = 0;
361 while ( 1 )
362 {
363 if ( tty )
364 {
365 Tcl_Obj *promptCmdPtr;
366
367 promptCmdPtr = Tcl_GetVar2Ex( interp,
368 ( gotPartial ? "tcl_prompt2" : "tcl_prompt1" ),
369 NULL, TCL_GLOBAL_ONLY );
370 if ( promptCmdPtr == NULL )
371 {
372 defaultPrompt:
373 if ( !gotPartial && outChannel )
374 {
375 Tcl_WriteChars( outChannel, "% ", 2 );
376 }
377 }
378 else
379 {
380 code = Tcl_EvalObjEx( interp, promptCmdPtr, 0 );
381 inChannel = Tcl_GetStdChannel( TCL_STDIN );
382 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
383 errChannel = Tcl_GetStdChannel( TCL_STDERR );
384 if ( code != TCL_OK )
385 {
386 if ( errChannel )
387 {
388 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
389 Tcl_WriteChars( errChannel, "\n", 1 );
390 }
391 Tcl_AddErrorInfo( interp,
392 "\n (script that generates prompt)" );
393 goto defaultPrompt;
394 }
395 }
396 if ( outChannel )
397 {
398 Tcl_Flush( outChannel );
399 }
400 }
401 if ( !inChannel )
402 {
403 goto done;
404 }
405 length = Tcl_GetsObj( inChannel, commandPtr );
406 if ( length < 0 )
407 {
408 goto done;
409 }
410 if ( ( length == 0 ) && Tcl_Eof( inChannel ) && ( !gotPartial ) )
411 {
412 goto done;
413 }
414
415 //
416 // Add the newline removed by Tcl_GetsObj back to the string.
417 //
418
419 Tcl_AppendToObj( commandPtr, "\n", 1 );
420 if ( !Tcl_CommandComplete( Tcl_GetString( commandPtr ) ) )
421 {
422 gotPartial = 1;
423 continue;
424 }
425
426 gotPartial = 0;
427 code = Tcl_RecordAndEvalObj( interp, commandPtr, 0 );
428 inChannel = Tcl_GetStdChannel( TCL_STDIN );
429 outChannel = Tcl_GetStdChannel( TCL_STDOUT );
430 errChannel = Tcl_GetStdChannel( TCL_STDERR );
431 Tcl_DecrRefCount( commandPtr );
432 commandPtr = Tcl_NewObj();
433 Tcl_IncrRefCount( commandPtr );
434
435 // User defined function to deal with tcl command output
436 // Deprecated; for backward compatibility only
437 if ( ( ( code != TCL_OK ) || tty ) && tclErrorHandler )
438 ( *tclErrorHandler )( interp, code, tty );
439 else
440 {
441 // User defined function to prepare for tcl output
442 // This is the new way
443 if ( ( ( code != TCL_OK ) || tty ) && tclPrepOutputHandler )
444 ( *tclPrepOutputHandler )( interp, code, tty );
445 // Back to the stock tcl code
446 if ( code != TCL_OK )
447 {
448 if ( errChannel )
449 {
450 Tcl_WriteObj( errChannel, Tcl_GetObjResult( interp ) );
451 Tcl_WriteChars( errChannel, "\n", 1 );
452 }
453 }
454 else if ( tty )
455 {
456 resultPtr = Tcl_GetObjResult( interp );
457 Tcl_GetStringFromObj( resultPtr, &length );
458 if ( ( length > 0 ) && outChannel )
459 {
460 Tcl_WriteObj( outChannel, resultPtr );
461 Tcl_WriteChars( outChannel, "\n", 1 );
462 }
463 }
464 }
465 }
466
467 //
468 // Rather than calling exit, invoke the "exit" command so that
469 // users can replace "exit" with some other command to do additional
470 // cleanup on exit. The Tcl_Eval call should never return.
471 //
472
473 done:
474 if ( commandPtr != NULL )
475 {
476 Tcl_DecrRefCount( commandPtr );
477 }
478 sprintf( buffer, "exit %d", exitCode );
479 Tcl_Eval( interp, buffer );
480 return 0; // to silence warnings
481 }
482
483 //
484 //--------------------------------------------------------------------------
485 //
486 // plPrepOutputHandler --
487 //
488 // Prepares for output during command parsing. We use it here to
489 // ensure we are on the text screen before issuing the error message,
490 // otherwise it may disappear.
491 //
492 // Results:
493 // None.
494 //
495 // Side effects:
496 // For some graphics devices, a switch between graphics and text modes
497 // is done.
498 //
499 //--------------------------------------------------------------------------
500 //
501
502 static void
503 plPrepOutputHandler( Tcl_Interp *PL_UNUSED( interp ), int PL_UNUSED( code ), int PL_UNUSED( tty ) )
504 {
505 pltext();
506 }
plplotP.h
plMergeOpts
PLINT plMergeOpts(PLOptionTable *options, PLCHAR_VECTOR name, PLCHAR_VECTOR *notes)
Definition: plargs.c:783
argv
static char ** argv
Definition: qt.cpp:49
TclSetStartupScriptFileName
void TclSetStartupScriptFileName(char *fileName)
Definition: tclMain.c:165
usage
static PLCHAR_VECTOR usage
Definition: plargs.c:179
tty
static int tty
Definition: tkMain.c:123
pltclMain
int PLDLLEXPORT pltclMain(int argc, char **argv, char *PL_UNUSED(RcFileName), int(*appInitProc)(Tcl_Interp *interp))
Definition: tclMain.c:214
argc
static int argc
Definition: qt.cpp:48
pltcl.h
PLOptionTable
Definition: plplot.h:395
plparseopts
#define plparseopts
Definition: plplot.h:778
plplotc.plSetUsage
def plSetUsage
Definition: plplotc.py:8456
tclStartupScript
static char * tclStartupScript
Definition: tclMain.c:100
TclGetStartupScriptFileName
const char * TclGetStartupScriptFileName(void)
Definition: tclMain.c:187
fileName
static const char * fileName
Definition: tkMain.c:134
TclFormatInt
#define TclFormatInt(buf, n)
Definition: tclMain.c:51
pltcl_notes
static const char * pltcl_notes[]
Definition: tclMain.c:101
tclErrorHandler
void(* tclErrorHandler)(Tcl_Interp *interp, int code, int tty)
Definition: tclMain.c:93
buffer
static PLINT * buffer
Definition: plfill.c:74
PL_OPT_INVISIBLE
#define PL_OPT_INVISIBLE
Definition: plplot.h:344
pltext
#define pltext
Definition: plplot.h:855
options
static PLOptionTable options[]
Definition: tclMain.c:108
PL_OPT_STRING
#define PL_OPT_STRING
Definition: plplot.h:353
PL_UNUSED
#define PL_UNUSED(x)
Definition: plplot.h:138
PL_PARSE_FULL
#define PL_PARSE_FULL
Definition: plplot.h:359
PL_PARSE_SKIP
#define PL_PARSE_SKIP
Definition: plplot.h:367
tclStartupScriptFileName
static const char * tclStartupScriptFileName
Definition: tclMain.c:80
PLDLLEXPORT
#define PLDLLEXPORT
Definition: pldll.h:36
interp
static Tcl_Interp * interp
Definition: tkMain.c:120
tclPrepOutputHandler
void(* tclPrepOutputHandler)(Tcl_Interp *interp, int code, int tty)
Definition: tclMain.c:95
plPrepOutputHandler
static void plPrepOutputHandler(Tcl_Interp *interp, int code, int tty)
_ANSI_ARGS_
int isatty _ANSI_ARGS_((int fd))