PLplot 5.15.0
Loading...
Searching...
No Matches
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
77extern int isatty _ANSI_ARGS_( ( int fd ) );
78extern char * strcpy _ANSI_ARGS_( ( char *dst, CONST char *src ) );
79
80static const char *tclStartupScriptFileName = NULL;
81
82// pltcl enhancements
83
84static void
85plPrepOutputHandler( Tcl_Interp *interp, int code, int tty );
86
87// Other function prototypes
89const char *TclGetStartupScriptFileName( void );
90
91// These are globally visible and can be replaced
92
93void ( *tclErrorHandler )( Tcl_Interp *interp, int code, int tty ) = NULL;
94
95void ( *tclPrepOutputHandler )( Tcl_Interp *interp, int code, int tty )
97
98// Options data structure definition.
99
100static char *tclStartupScript = NULL;
101static 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
109 {
110 "f", // File to read & process
111 NULL,
112 NULL,
115 "-f",
116 "File from which to read commands"
117 },
118 {
119 "file", // File to read & process (alias)
120 NULL,
121 NULL,
124 "-file",
125 "File from which to read commands"
126 },
127 {
128 "e", // Script to run on startup
129 NULL,
130 NULL,
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//
166{
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//
188{
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
213int PLDLLEXPORT
214pltclMain( 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 );
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 {
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 {
372defaultPrompt:
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
473done:
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
502static void
503plPrepOutputHandler( Tcl_Interp *PL_UNUSED( interp ), int PL_UNUSED( code ), int PL_UNUSED( tty ) )
504{
505 pltext();
506}
static PLCHAR_VECTOR usage
Definition plargs.c:179
PLINT plMergeOpts(PLOptionTable *options, PLCHAR_VECTOR name, PLCHAR_VECTOR *notes)
Definition plargs.c:783
void plSetUsage(PLCHAR_VECTOR program_string, PLCHAR_VECTOR usage_string)
Definition plargs.c:1287
#define PLDLLEXPORT
Definition pldll.h:36
static PLINT * buffer
Definition plfill.c:74
#define PL_PARSE_FULL
Definition plplot.h:359
#define PL_PARSE_SKIP
Definition plplot.h:367
#define PL_UNUSED(x)
Definition plplot.h:138
#define plparseopts
Definition plplot.h:778
#define pltext
Definition plplot.h:855
#define PL_OPT_INVISIBLE
Definition plplot.h:344
#define PL_OPT_STRING
Definition plplot.h:353
static int argc
Definition qt.cpp:48
static char ** argv
Definition qt.cpp:49
static const char * pltcl_notes[]
Definition tclMain.c:101
const char * TclGetStartupScriptFileName(void)
Definition tclMain.c:187
void(* tclPrepOutputHandler)(Tcl_Interp *interp, int code, int tty)
Definition tclMain.c:95
void(* tclErrorHandler)(Tcl_Interp *interp, int code, int tty)
Definition tclMain.c:93
static char * tclStartupScript
Definition tclMain.c:100
static void plPrepOutputHandler(Tcl_Interp *interp, int code, int tty)
int PLDLLEXPORT pltclMain(int argc, char **argv, char *PL_UNUSED(RcFileName), int(*appInitProc)(Tcl_Interp *interp))
Definition tclMain.c:214
static PLOptionTable options[]
Definition tclMain.c:108
static const char * tclStartupScriptFileName
Definition tclMain.c:80
#define TclFormatInt(buf, n)
Definition tclMain.c:51
void TclSetStartupScriptFileName(char *fileName)
Definition tclMain.c:165
int isatty _ANSI_ARGS_((int fd))
static Tcl_Interp * interp
Definition tkMain.c:120
static const char * fileName
Definition tkMain.c:134
static int tty
Definition tkMain.c:123