PLplot 5.15.0
pltcl.c
Go to the documentation of this file.
1// Main program for Tcl-interface to PLplot. Allows interpretive
2// execution of plotting primitives without regard to output driver.
3//
4// Maurice LeBrun
5// IFS, University of Texas at Austin
6// 19-Jun-1994
7//
8// Copyright (C) 2004 Joao Cardoso
9//
10// This file is part of PLplot.
11//
12// PLplot is free software; you can redistribute it and/or modify
13// it under the terms of the GNU Library General Public License as published
14// by the Free Software Foundation; either version 2 of the License, or
15// (at your option) any later version.
16//
17// PLplot is distributed in the hope that it will be useful,
18// but WITHOUT ANY WARRANTY; without even the implied warranty of
19// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20// GNU Library General Public License for more details.
21//
22// You should have received a copy of the GNU Library General Public License
23// along with PLplot; if not, write to the Free Software
24// Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
25//
26//
27
28#include "plplotP.h"
29#include "pltcl.h"
30#ifdef HAVE_ITCL
31# ifndef HAVE_ITCLDECLS_H
32# define RESOURCE_INCLUDED
33# endif
34# include <itcl.h>
35#endif
36
37static int
38AppInit( Tcl_Interp *interp );
39
40//--------------------------------------------------------------------------
41// main --
42//
43// Just a stub routine to call pltclMain. The latter is nice to have when
44// building extended tclsh's, since then you don't have to rely on sucking
45// the Tcl main out of libtcl (which doesn't work correctly on all
46// systems/compilers/linkers/etc). Hopefully in the future Tcl will
47// supply a sufficiently capable tclMain() type function that can be used
48// instead.
49//--------------------------------------------------------------------------
50
51int
52main( int argc, char **argv )
53{
54 exit( pltclMain( argc, argv, NULL, AppInit ) );
55}
56
57//--------------------------------------------------------------------------
58// plExitCmd
59//
60// PLplot/Tcl extension command -- handle exit.
61// The reason for overriding the normal exit command is so we can tell
62// the PLplot library to clean up.
63//--------------------------------------------------------------------------
64
65static int
66plExitCmd( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
67{
68 const char *tmp = Tcl_GetStringResult( interp );
69 (void) argc;
70 (void) argv;
71 (void) clientData;
72
73// Print error message if one given that is not of zero length.
74 if ( tmp != NULL && *tmp != '\0' )
75 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
76
77 plspause( 0 );
78 plend();
79
80 Tcl_UnsetVar( interp, "tcl_prompt1", 0 );
81 Tcl_Eval( interp, "tclexit" );
82
83 return TCL_OK;
84}
85
86//--------------------------------------------------------------------------
87// prPromptCmd
88//
89// PLplot/Tcl extension command -- print the prompt.
90// Allows much more flexible setting of the prompt.
91//--------------------------------------------------------------------------
92
93static int
94prPromptCmd( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
95{
97 char prompt[80];
98 (void) argc;
99 (void) argv;
100 (void) clientData;
101
102 plgpls( &pls );
103
104 if ( pls->ipls == 0 )
105 sprintf( prompt, "pltext; puts -nonewline \"pltcl> \"; flush stdout" );
106 else
107 sprintf( prompt, "pltext; puts -nonewline \"pltcl_%d> \"; flush stdout", pls->ipls );
108
109 Tcl_VarEval( interp, prompt, 0 );
110
111 return TCL_OK;
112}
113
114//
115//--------------------------------------------------------------------------
116//
117// AppInit --
118//
119// This procedure performs application-specific initialization.
120// Most applications, especially those that incorporate additional
121// packages, will have their own version of this procedure.
122//
123// Results:
124// Returns a standard Tcl completion code, and leaves an error
125// message in interp->result if an error occurs.
126//
127// Side effects:
128// Depends on the startup script.
129//
130//--------------------------------------------------------------------------
131//
132
133static int
134AppInit( Tcl_Interp *interp )
135{
136//
137// Call the init procedures for included packages. Each call should
138// look like this:
139//
140// if (Mod_Init(interp) == TCL_ERROR) {
141// return TCL_ERROR;
142// }
143//
144// where "Mod" is the name of the module.
145//
146 if ( Tcl_Init( interp ) == TCL_ERROR )
147 {
148 printf( "Error Tcl_Init\n" );
149 return TCL_ERROR;
150 }
151#ifdef HAVE_ITCL
152 if ( Itcl_Init( interp ) == TCL_ERROR )
153 {
154 return TCL_ERROR;
155 }
156#endif
157 if ( Pltcl_Init( interp ) == TCL_ERROR )
158 {
159 return TCL_ERROR;
160 }
161
162// Application-specific startup. That means: for use in pltcl ONLY.
163
164// Rename "exit" to "tclexit", and insert custom exit handler
165
166 Tcl_VarEval( interp, "rename exit tclexit", (char *) NULL );
167
168 Tcl_CreateCommand( interp, "exit", (Tcl_CmdProc *) plExitCmd,
169 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
170
171 Tcl_CreateCommand( interp, "pr_prompt", (Tcl_CmdProc *) prPromptCmd,
172 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
173
174// Custom prompt, to make sure we are in text mode when entering commands
175
176 Tcl_SetVar( interp, "tcl_prompt1", "pr_prompt", 0 );
177
178 return TCL_OK;
179}
void plgpls(PLStream **p_pls)
Definition: plcore.c:3693
static PLStream * pls[PL_NSTREAMS]
Definition: plcore.h:88
#define plspause
Definition: plplot.h:834
#define plend
Definition: plplot.h:709
int main(int argc, char **argv)
Definition: pltcl.c:52
static int AppInit(Tcl_Interp *interp)
Definition: pltcl.c:134
static int plExitCmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
Definition: pltcl.c:66
static int prPromptCmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
Definition: pltcl.c:94
PLDLLIMPEXP_TCLTK int Pltcl_Init(Tcl_Interp *interp)
Definition: tclAPI.c:633
PLDLLIMPEXP_TCLTK int pltclMain(int argc, char **argv, char *RcFileName, int(*AppInit)(Tcl_Interp *interp))
static int argc
Definition: qt.cpp:48
static char ** argv
Definition: qt.cpp:49
PLINT ipls
Definition: plstrm.h:527
static Tcl_Interp * interp
Definition: tkMain.c:120